Removes lenses and uses simpler approach to generate JWT claims. Also fixes the setVar to avoid the ::unknown type cast from insertableValue

This commit is contained in:
Diogo Biazus
2015-10-18 17:14:11 -04:00
parent 7ef5b7b43a
commit 8b5f4e8556
2 changed files with 15 additions and 19 deletions
-6
View File
@@ -53,8 +53,6 @@ executable postgrest
, mtl
, cassava
, jwt
, lens
, lens-aeson >= 1.0.0.5
, parsec
, errors
, bifunctors
@@ -88,8 +86,6 @@ library
, hasql-postgres
, http-types
, jwt
, lens
, lens-aeson >= 1.0.0.5
, mtl
, network
, network-uri
@@ -181,8 +177,6 @@ Test-Suite spec
, process
, heredoc
, jwt
, lens
, lens-aeson >= 1.0.0.5
, parsec
, errors
, bifunctors
+15 -13
View File
@@ -7,17 +7,16 @@ module PostgREST.Auth (
import Control.Applicative
import Data.Aeson
import Data.Map (fromList, toList)
import Data.Maybe (fromMaybe)
import Data.Aeson.Types (emptyObject, emptyArray)
import Data.Vector as V (null, head)
import Data.Map as M (fromList, toList)
import Data.Monoid
import Data.String.Conversions (cs)
import Data.Text (Text)
import PostgREST.PgQuery (pgFmtLit, pgFmtIdent, insertableValue)
import PostgREST.PgQuery (pgFmtLit, pgFmtIdent, unquoted)
import Prelude
import qualified Web.JWT as JWT
import qualified Data.HashMap.Lazy as HashMap
import Data.Aeson.Lens
import Control.Lens.Operators
import qualified Data.HashMap.Lazy as H
setJWTEnv :: Text -> Text -> Maybe [Text]
setJWTEnv secret input = setDBEnv $ jwtClaims secret input
@@ -28,7 +27,8 @@ setDBEnv maybeClaims =
where
setVar ("role", String val) = setRole val
setVar (k, val) = "set local postgrest.claims." <> pgFmtIdent k <>
" = " <> insertableValue val <> ";"
" = " <> valueToVariable val <> ";"
valueToVariable = pgFmtLit . unquoted
setRole :: Text -> Text
setRole role = "set local role " <> cs (pgFmtLit role) <> ";"
@@ -40,9 +40,11 @@ jwtClaims secret input = claims
decoded = JWT.decodeAndVerifySignature (JWT.secret secret) input
tokenJWT :: Text -> Value -> Text
tokenJWT secret claims = JWT.encodeSigned JWT.HS256 (JWT.secret secret) claimsSet
where
claimsSet = JWT.def {
JWT.unregisteredClaims = Data.Map.fromList claimsList
}
claimsList = fromMaybe [] $ HashMap.toList <$> (claims ^? nth 0 . _Object)
tokenJWT secret (Array a) = JWT.encodeSigned JWT.HS256 (JWT.secret secret)
JWT.def { JWT.unregisteredClaims = fromHashMap o }
where
Object o = if V.null a then emptyObject else V.head a
tokenJWT secret _ = tokenJWT secret emptyArray
fromHashMap :: Object -> JWT.ClaimsMap
fromHashMap = M.fromList . H.toList