Add role-claim-key config value

This commit is contained in:
steve-chavez
2018-04-30 11:31:06 -05:00
committed by Steve Chávez
parent 5c87fe2704
commit f033c2c4b5
10 changed files with 147 additions and 29 deletions
+8 -3
View File
@@ -148,18 +148,23 @@ main = do
port = configPort conf
proxy = configProxyUri conf
pgSettings = toS (configDatabase conf) -- is the db-uri
roleClaimKey = configRoleClaimKey conf
appSettings =
setHost ((fromString . toS) host) -- Warp settings
. setPort port
. setServerName (toS $ "postgrest/" <> prettyVersion)
. setTimeout 3600 $
defaultSettings
--
-- Checks that the provided proxy uri is formated correctly,
-- does not test if it works here.
-- Checks that the provided proxy uri is formated correctly
when (isMalformedProxyUri $ toS <$> proxy) $
panic
"Malformed proxy uri, a correct example: https://example.com:8443/basePath"
-- Checks that the provided jspath is valid
when (isLeft roleClaimKey) $
panic $ show roleClaimKey
putStrLn $ ("Listening on port " :: Text) <> show (configPort conf)
--
-- create connection pool with the provided settings, returns either
+1 -1
View File
@@ -78,7 +78,7 @@ postgrest conf refDbStructure pool getTime worker =
response <- case userApiRequest (configSchema conf) req body of
Left err -> return $ apiRequestError err
Right apiRequest -> do
eClaims <- jwtClaims jwtSecret (configJwtAudience conf) (toS $ iJWT apiRequest) time
eClaims <- jwtClaims jwtSecret (configJwtAudience conf) (toS $ iJWT apiRequest) time (rightToMaybe $ configRoleClaimKey conf)
let authed = containsRole eClaims
proc = case (iTarget apiRequest, iPayload apiRequest, iPreferSingleObjectParameter apiRequest) of
+30 -18
View File
@@ -1,4 +1,5 @@
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE LambdaCase #-}
{-|
Module : PostgREST.Auth
Description : PostgREST authorization functions.
@@ -19,9 +20,11 @@ module PostgREST.Auth (
) where
import Control.Lens.Operators
import Data.Aeson (Value (..), decode, toJSON)
import qualified Data.Aeson as JSON
import qualified Data.HashMap.Strict as M
import Data.Time.Clock (UTCTime)
import Data.Time.Clock (UTCTime)
import Data.Vector as V
import PostgREST.Types
import Protolude
import qualified Crypto.JOSE.Types as JOSE.Types
@@ -32,16 +35,16 @@ import Crypto.JWT
-}
data JWTAttempt = JWTInvalid JWTError
| JWTMissingSecret
| JWTClaims (M.HashMap Text Value)
| JWTClaims (M.HashMap Text JSON.Value)
deriving (Eq, Show)
{-|
Receives the JWT secret and audience (from config) and a JWT and returns a map
of JWT claims.
-}
jwtClaims :: Maybe JWK -> Maybe StringOrURI -> LByteString -> UTCTime -> IO JWTAttempt
jwtClaims _ _ "" _ = return $ JWTClaims M.empty
jwtClaims secret audience payload time =
jwtClaims :: Maybe JWK -> Maybe StringOrURI -> LByteString -> UTCTime -> Maybe JSPath -> IO JWTAttempt
jwtClaims _ _ "" _ _ = return $ JWTClaims M.empty
jwtClaims secret audience payload time jspath =
case secret of
Nothing -> return JWTMissingSecret
Just s -> do
@@ -51,7 +54,26 @@ jwtClaims secret audience payload time =
verifyClaimsAt validation s time jwt
return $ case eJwt of
Left e -> JWTInvalid e
Right jwt -> JWTClaims . claims2map $ jwt
Right jwt -> JWTClaims $ claims2map jwt jspath
{-|
Turn JWT ClaimSet into something easier to work with,
also here the jspath is applied to put the "role" in the map
-}
claims2map :: ClaimsSet -> Maybe JSPath -> M.HashMap Text JSON.Value
claims2map claims jspath = (\case
val@(JSON.Object o) ->
let role = maybe M.empty (M.singleton "role") $
walkJSPath (Just val) =<< jspath in
M.delete "role" o `M.union` role -- mutating the map
_ -> M.empty
) $ JSON.toJSON claims
walkJSPath :: Maybe JSON.Value -> JSPath -> Maybe JSON.Value
walkJSPath x [] = x
walkJSPath (Just (JSON.Object o)) (JSPKey key:rest) = walkJSPath (M.lookup key o) rest
walkJSPath (Just (JSON.Array ar)) (JSPIdx idx:rest) = walkJSPath (ar V.!? idx) rest
walkJSPath _ _ = Nothing
{-|
Whether a response from jwtClaims contains a role claim
@@ -60,19 +82,9 @@ containsRole :: JWTAttempt -> Bool
containsRole (JWTClaims claims) = M.member "role" claims
containsRole _ = False
{-|
Internal helper used to turn JWT ClaimSet into something
easier to work with
-}
claims2map :: ClaimsSet -> M.HashMap Text Value
claims2map = val2map . toJSON
where
val2map (Object o) = o
val2map _ = M.empty
parseJWK :: ByteString -> JWK
parseJWK str =
fromMaybe (hs256jwk str) (decode (toS str) :: Maybe JWK)
fromMaybe (hs256jwk str) (JSON.decode (toS str) :: Maybe JWK)
{-|
Internal helper to generate HMAC-SHA256. When the jwt key in the
+12 -1
View File
@@ -25,7 +25,6 @@ module PostgREST.Config ( prettyVersion
)
where
import PostgREST.Types (PgVersion(..))
import Control.Applicative
import Control.Monad (fail)
import Control.Lens (preview)
@@ -52,6 +51,9 @@ import Network.Wai
import Network.Wai.Middleware.Cors (CorsResourcePolicy (..))
import Options.Applicative hiding (str)
import Paths_postgrest (version)
import PostgREST.Parsers (pRoleClaimKey)
import PostgREST.Types (PgVersion(..), ApiRequestError(..),
JSPath, JSPathExp(..))
import Protolude hiding (hPutStrLn, take,
intercalate, (<>))
import System.IO (hPrint)
@@ -78,6 +80,7 @@ data AppConfig = AppConfig {
, configReqCheck :: Maybe Text
, configQuiet :: Bool
, configSettings :: [(Text, Text)]
, configRoleClaimKey :: Either ApiRequestError JSPath
}
defaultCorsPolicy :: CorsResourcePolicy
@@ -139,6 +142,7 @@ readOptions = do
<*> (mfilter (/= "") <$> C.key "pre-request")
<*> pure False
<*> (fmap parsedPairToTextPair <$> C.subassocs "app.settings")
<*> (maybe (Right [JSPKey "role"]) parseRoleClaimKey <$> C.key "role-claim-key")
case mAppConf of
Nothing -> do
@@ -174,6 +178,10 @@ readOptions = do
coerceBool (String b) = readMaybe $ toS b
coerceBool _ = Nothing
parseRoleClaimKey :: Value -> Either ApiRequestError JSPath
parseRoleClaimKey (String s) = pRoleClaimKey s
parseRoleClaimKey v = pRoleClaimKey $ show v
opts = info (helper <*> pathParser) $
fullDesc
<> progDesc (
@@ -218,6 +226,9 @@ readOptions = do
|
|## stored proc to exec immediately after auth
|# pre-request = "stored_proc_name"
|
|## jspath to the role claim key
|# role-claim-key = ".role"
|]
pathParser :: Parser FilePath
+2 -2
View File
@@ -5,7 +5,7 @@
module PostgREST.Middleware where
import Crypto.JWT
import Data.Aeson (Value (..))
import qualified Data.Aeson as JSON
import qualified Data.HashMap.Strict as M
import qualified Hasql.Transaction as H
@@ -44,7 +44,7 @@ runWithClaims conf eClaims app req =
setSchemaSql = ["set schema " <> pgFmtLit (configSchema conf) <> ";"] :: [Text]
-- role claim defaults to anon if not specified in jwt
claimsWithRole = M.union claims (M.singleton "role" anon)
anon = String . toS $ configAnonRole conf
anon = JSON.String . toS $ configAnonRole conf
customReqCheck = (\f -> "select " <> toS f <> "();") <$> configReqCheck conf
where
unauthed message = simpleError
+23
View File
@@ -12,6 +12,7 @@ import PostgREST.RangeQuery (NonnegRange)
import PostgREST.Types
import Text.ParserCombinators.Parsec hiding (many, (<|>))
import Text.Parsec.Error
import Text.Read (read)
pRequestSelect :: Text -> Either ApiRequestError [Tree SelectItem]
pRequestSelect selStr =
@@ -212,3 +213,25 @@ mapError = mapLeft translateError
message = show $ errorPos e
details = strip $ replace "\n" " " $ toS
$ showErrorMessages "or" "unknown parse error" "expecting" "unexpected" "end of input" (errorMessages e)
-- Used for the config value "role-claim-key"
pRoleClaimKey :: Text -> Either ApiRequestError JSPath
pRoleClaimKey selStr =
mapError $ parse pJSPath ("failed to parse role-claim-key value (" <> toS selStr <> ")") (toS selStr)
pJSPath :: Parser JSPath
pJSPath = toJSPath <$> (period *> pPath `sepBy` period <* eof)
where
toJSPath :: [(Text, Maybe Int)] -> JSPath
toJSPath = concatMap (\(key, idx) -> JSPKey key : maybeToList (JSPIdx <$> idx))
period = char '.' <?> "period (.)"
pPath :: Parser (Text, Maybe Int)
pPath = (,) <$> pJSPKey <*> optionMaybe pJSPIdx
pJSPKey :: Parser Text
pJSPKey = toS <$> (many1 (alphaNum <|> oneOf "_$@") <|> pQuoted) <?> "attribute name [a..z0..9_$@])"
where
pQuoted = char '"' *> many (noneOf "\"") <* char '"'
pJSPIdx :: Parser Int
pJSPIdx = char '[' *> (read <$> many1 digit) <* char ']' <?> "array index [0..n]"
+5
View File
@@ -317,3 +317,8 @@ data PgVersion = PgVersion {
sourceCTEName :: SqlFragment
sourceCTEName = "pg_source"
-- | full jspath, e.g. .property[0].attr.detail
type JSPath = [JSPathExp]
-- | jspath expression, e.g. .property, .property[0] or ."property-dash"
data JSPathExp = JSPKey Text | JSPIdx Int deriving (Eq, Show)
+3
View File
@@ -17,6 +17,7 @@ import System.Process (readProcess)
import Text.Heredoc
import PostgREST.Config (AppConfig(..))
import PostgREST.Types (JSPathExp(..))
import Test.Hspec hiding (pendingWith)
import Test.Hspec.Wai
@@ -76,6 +77,8 @@ _baseCfg = -- Connection Settings
[ ("app.settings.app_host", "localhost")
, ("app.settings.external_api_secret", "0123456789abcdef")
]
-- Default role claim key
(Right [JSPKey "role"])
testCfg :: Text -> AppConfig
testCfg testDbConn = _baseCfg { configDatabase = testDbConn }
+55 -4
View File
@@ -40,9 +40,10 @@ pgrStopAll(){ pkill -f "$(stack path --local-install-root)/bin/postgrest"; }
rootStatus(){
curl -s -o /dev/null -w '%{http_code}' "http://localhost:$pgrPort/"
}
authorsStatus(){
curl -s -o /dev/null -w '%{http_code}' \
-H "Authorization: Bearer $( cat "$1" )" \
-H "Authorization: Bearer $1" \
"http://localhost:$pgrPort/authors_only"
}
@@ -68,7 +69,7 @@ readSecretFromFile(){
if pgrStarted
then
authorsJwt="./secrets/${1%.*}.jwt"
httpStatus="$( authorsStatus "$authorsJwt" )"
httpStatus="$( authorsStatus $(cat "$authorsJwt") )"
if test "$httpStatus" -eq 200
then
ok "authentication with $2 secret read from a file"
@@ -81,6 +82,44 @@ readSecretFromFile(){
pgrStop
}
reqWithRoleClaimKey(){
export ROLE_CLAIM_KEY=$1
pgrStart "./configs/role-claim-key.config"
while pgrStarted && test "$( rootStatus )" -ne 200
do
# wait for the server to start
sleep 0.1 \
|| sleep 1 # fallback: subsecond sleep is not standard and may fail
done
authorsJwt=$(psql -qtAX postgrest_test -c "select jwt.sign('$2', 'reallyreallyreallyreallyverysafe');")
httpStatus="$( authorsStatus "$authorsJwt" )"
if test "$httpStatus" -eq $3
then
ok "request with \"$1\" role-claim-key for $2 jwt gave $3"
else
ko "request with \"$1\" role-claim-key for $2 jwt gave $httpStatus"
fi
pgrStop
}
invalidRoleClaimKey(){
export ROLE_CLAIM_KEY=$1
pgrStart "./configs/role-claim-key.config"
while pgrStarted && test "$( rootStatus )" -ne 200
do
# wait for the server to start
sleep 0.1 \
|| sleep 1 # fallback: subsecond sleep is not standard and may fail
done
if pgrStarted
then
ko "invalid jspath \"$1\" accepted"
else
ok "invalid jspath \"$1\" rejected"
fi
pgrStop
}
# PRE: curl must be available
test -n "$(command -v curl)" || bailOut 'curl is not available'
@@ -89,8 +128,7 @@ psql -l 1>/dev/null 2>/dev/null || bailOut 'postgres is not running'
setUp
totalTests=12
echo "1..$totalTests"
echo "Running IO tests.."
readSecretFromFile word.noeol 'simple (no EOL)'
readSecretFromFile word.txt 'simple'
@@ -106,6 +144,19 @@ readSecretFromFile ascii.b64 'Base64 (ASCII)'
readSecretFromFile utf8.b64 'Base64 (UTF-8)'
readSecretFromFile binary.b64 'Base64 (binary)'
reqWithRoleClaimKey '.postgrest.a_role' '{"postgrest":{"a_role":"postgrest_test_author"}}' 200
reqWithRoleClaimKey '.customObject.manyRoles[1]' '{"customObject":{"manyRoles": ["other", "postgrest_test_author"]}}' 200
reqWithRoleClaimKey '."https://www.example.com/roles"[0].value' '{"https://www.example.com/roles":[{"value":"postgrest_test_author"}]}' 200
reqWithRoleClaimKey '.myDomain[3]' '{"myDomain":["other","postgrest_test_author"]}' 401
reqWithRoleClaimKey '.myRole' '{"role":"postgrest_test_author"}' 401
invalidRoleClaimKey 'role.other'
invalidRoleClaimKey '.role##'
invalidRoleClaimKey '.my_role;;domain'
invalidRoleClaimKey '.#$%&$%/'
invalidRoleClaimKey ''
invalidRoleClaimKey 1234
cleanUp
exit $failedTests
@@ -0,0 +1,8 @@
db-uri = "postgres:///postgrest_test"
db-schema = "test"
db-anon-role = "postgrest_test_anonymous"
db-pool = 1
server-host = "*4"
server-port = 49421
role-claim-key = "$(ROLE_CLAIM_KEY)"
jwt-secret = "reallyreallyreallyreallyverysafe"