jimmy/postgrest
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

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

Browse Source
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
Download Patch File Download Diff File Expand all files Collapse all files
postgrest.cabal
-6
View File
@@ -53,8 +53,6 @@ executable postgrest
, mtl , mtl
, cassava , cassava
, jwt , jwt
, lens
, lens-aeson >= 1.0.0.5
, parsec , parsec
, errors , errors
, bifunctors , bifunctors
@@ -88,8 +86,6 @@ library
, hasql-postgres , hasql-postgres
, http-types , http-types
, jwt , jwt
, lens
, lens-aeson >= 1.0.0.5
, mtl , mtl
, network , network
, network-uri , network-uri
@@ -181,8 +177,6 @@ Test-Suite spec
, process , process
, heredoc , heredoc
, jwt , jwt
, lens
, lens-aeson >= 1.0.0.5
, parsec , parsec
, errors , errors
, bifunctors , bifunctors
src/PostgREST/Auth.hs
+15 -13
View File
@@ -7,17 +7,16 @@ module PostgREST.Auth (
import Control.Applicative import Control.Applicative
import Data.Aeson import Data.Aeson
import Data.Map (fromList, toList) import Data.Aeson.Types (emptyObject, emptyArray)
import Data.Maybe (fromMaybe) import Data.Vector as V (null, head)
import Data.Map as M (fromList, toList)
import Data.Monoid import Data.Monoid
import Data.String.Conversions (cs) import Data.String.Conversions (cs)
import Data.Text (Text) import Data.Text (Text)
import PostgREST.PgQuery (pgFmtLit, pgFmtIdent, insertableValue) import PostgREST.PgQuery (pgFmtLit, pgFmtIdent, unquoted)
import Prelude import Prelude
import qualified Web.JWT as JWT import qualified Web.JWT as JWT
import qualified Data.HashMap.Lazy as HashMap import qualified Data.HashMap.Lazy as H
import Data.Aeson.Lens
import Control.Lens.Operators
setJWTEnv :: Text -> Text -> Maybe [Text] setJWTEnv :: Text -> Text -> Maybe [Text]
setJWTEnv secret input = setDBEnv $ jwtClaims secret input setJWTEnv secret input = setDBEnv $ jwtClaims secret input
@@ -28,7 +27,8 @@ setDBEnv maybeClaims =
where where
setVar ("role", String val) = setRole val setVar ("role", String val) = setRole val
setVar (k, val) = "set local postgrest.claims." <> pgFmtIdent k <> setVar (k, val) = "set local postgrest.claims." <> pgFmtIdent k <>
" = " <> insertableValue val <> ";" " = " <> valueToVariable val <> ";"
valueToVariable = pgFmtLit . unquoted
setRole :: Text -> Text setRole :: Text -> Text
setRole role = "set local role " <> cs (pgFmtLit role) <> ";" setRole role = "set local role " <> cs (pgFmtLit role) <> ";"
@@ -40,9 +40,11 @@ jwtClaims secret input = claims
decoded = JWT.decodeAndVerifySignature (JWT.secret secret) input decoded = JWT.decodeAndVerifySignature (JWT.secret secret) input
tokenJWT :: Text -> Value -> Text tokenJWT :: Text -> Value -> Text
tokenJWT secret claims = JWT.encodeSigned JWT.HS256 (JWT.secret secret) claimsSet tokenJWT secret (Array a) = JWT.encodeSigned JWT.HS256 (JWT.secret secret)
where JWT.def { JWT.unregisteredClaims = fromHashMap o }
claimsSet = JWT.def { where
JWT.unregisteredClaims = Data.Map.fromList claimsList Object o = if V.null a then emptyObject else V.head a
} tokenJWT secret _ = tokenJWT secret emptyArray
claimsList = fromMaybe [] $ HashMap.toList <$> (claims ^? nth 0 . _Object)
fromHashMap :: Object -> JWT.ClaimsMap
fromHashMap = M.fromList . H.toList