From 1d82191bf51a7d63b78ed35a6ec8004f4f34a125 Mon Sep 17 00:00:00 2001 From: Anon Ray Date: Fri, 27 Jul 2018 18:04:48 +0530 Subject: [PATCH 01/13] JWT Auth mode for server - Only supports HMAC-SHA256 right now - Cannot be present with webhook - Needs access key to be present - Needs to have better errors --- server/graphql-engine.cabal | 3 ++ server/src-exec/Main.hs | 33 ++++++++---- server/src-lib/Hasura/Server/App.hs | 5 +- server/src-lib/Hasura/Server/Auth.hs | 16 ++++-- server/src-lib/Hasura/Server/Auth/JWT.hs | 64 ++++++++++++++++++++++++ server/src-lib/Hasura/Server/Init.hs | 26 ++++++---- server/stack.yaml | 1 + 7 files changed, 122 insertions(+), 26 deletions(-) create mode 100644 server/src-lib/Hasura/Server/Auth/JWT.hs diff --git a/server/graphql-engine.cabal b/server/graphql-engine.cabal index 085d3e72c362f..a3ae747258f90 100644 --- a/server/graphql-engine.cabal +++ b/server/graphql-engine.cabal @@ -67,6 +67,8 @@ library -- hashing for logging , cryptonite + -- for jwt verification + , jose -- Server related , warp @@ -124,6 +126,7 @@ library exposed-modules: Hasura.Server.App , Hasura.Server.Auth , Hasura.Server.Init + , Hasura.Server.JWT , Hasura.Server.Middleware , Hasura.Server.Logging , Hasura.Server.Query diff --git a/server/src-exec/Main.hs b/server/src-exec/Main.hs index aab9e8169cc5c..43df822ec8c39 100644 --- a/server/src-exec/Main.hs +++ b/server/src-exec/Main.hs @@ -46,6 +46,7 @@ data ServeOptions , soAccessKey :: !(Maybe AccessKey) , soCorsConfig :: !CorsConfigFlags , soWebHook :: !(Maybe T.Text) + , soJwtSecret :: !(Maybe T.Text) , soEnableConsole :: !Bool } deriving (Show, Eq) @@ -77,6 +78,7 @@ parseRavenMode = subparser <*> parseAccessKey <*> parseCorsConfig <*> parseWebHook + <*> parseJwtSecret <*> parseEnableConsole parseArgs :: IO RavenOptions @@ -93,15 +95,24 @@ printJSON = BLC.putStrLn . A.encode printYaml :: (A.ToJSON a) => a -> IO () printYaml = BC.putStrLn . Y.encode -mkAuthMode :: Maybe AccessKey -> Maybe T.Text -> Either String AuthMode -mkAuthMode mAccessKey mWebHook = - case (mAccessKey, mWebHook) of - (Nothing, Nothing) -> return AMNoAuth - (Just key, Nothing) -> return $ AMAccessKey key - (Nothing, Just _) -> throwError $ +mkAuthMode :: Maybe AccessKey -> Maybe T.Text -> Maybe T.Text -> Either String AuthMode +mkAuthMode mAccessKey mWebHook mJwtSecret = + case (mAccessKey, mWebHook, mJwtSecret) of + (Nothing, Nothing, Nothing) -> return AMNoAuth + (Just key, Nothing, Nothing) -> return $ AMAccessKey key + (Just key, Just hook, Nothing) -> return $ AMAccessKeyAndHook key hook + (Just key, Nothing, Just secret) -> return $ AMAccessKeyAndJWT key secret + + (Nothing, Just _, Nothing) -> throwError $ "Fatal Error : --auth-hook (HASURA_GRAPHQL_AUTH_HOOK)" ++ " requires --access-key (HASURA_GRAPHQL_ACCESS_KEY) to be set" - (Just key, Just hook) -> return $ AMAccessKeyAndHook key hook + (Nothing, Nothing, Just _) -> throwError $ + "Fatal Error : --jwt-secret (HASURA_GRAPHQL_JWT_SECRET)" + ++ " requires --access-key (HASURA_GRAPHQL_ACCESS_KEY) to be set" + (Nothing, Just _, Just _) -> throwError + "Fatal Error: Both webhook and JWT mode cannot be enabled at the same time" + (Just _, Just _, Just _) -> throwError + "Fatal Error: Both webhook and JWT mode cannot be enabled at the same time" main :: IO () main = do @@ -113,12 +124,12 @@ main = do loggerCtx <- mkLoggerCtx defaultLoggerSettings httpManager <- HTTP.newManager HTTP.tlsManagerSettings case ravenMode of - ROServe (ServeOptions port cp isoL mRootDir mAccessKey corsCfg mWebHook enableConsole) -> do - + ROServe (ServeOptions port cp isoL mRootDir mAccessKey corsCfg mWebHook mJwtSecret enableConsole) -> do mFinalAccessKey <- considerEnv "HASURA_GRAPHQL_ACCESS_KEY" mAccessKey - mFinalWebHook <- considerEnv "HASURA_GRAPHQL_AUTH_HOOK" mWebHook + mFinalWebHook <- considerEnv "HASURA_GRAPHQL_AUTH_HOOK" mWebHook + mFinalJwtSecret <- considerEnv "HASURA_GRAPHQL_JWT_SECRET" mJwtSecret am <- either ((>> exitFailure) . putStrLn) return $ - mkAuthMode mFinalAccessKey mFinalWebHook + mkAuthMode mFinalAccessKey mFinalWebHook mFinalJwtSecret finalCorsDomain <- fromMaybe "*" <$> considerEnv "HASURA_GRAPHQL_CORS_DOMAIN" (ccDomain corsCfg) let finalCorsCfg = CorsConfigG finalCorsDomain $ ccDisabled corsCfg diff --git a/server/src-lib/Hasura/Server/App.hs b/server/src-lib/Hasura/Server/App.hs index 330ba74b1f4d8..a826fd0ae4783 100644 --- a/server/src-lib/Hasura/Server/App.hs +++ b/server/src-lib/Hasura/Server/App.hs @@ -2,6 +2,7 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE OverloadedStrings #-} + {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TemplateHaskell #-} @@ -32,6 +33,7 @@ import qualified Hasura.GraphQL.Schema as GS import qualified Hasura.GraphQL.Transport.HTTP as GH import qualified Hasura.GraphQL.Transport.HTTP.Protocol as GH import qualified Hasura.GraphQL.Transport.WebSocket as WS +import qualified Hasura.Logging as L import qualified Network.Wai as Wai import qualified Network.Wai.Handler.WebSockets as WS import qualified Network.WebSockets as WS @@ -41,6 +43,7 @@ import Hasura.RQL.DDL.Schema.Table --import Hasura.RQL.DML.Explain import Hasura.RQL.DML.QueryTemplate import Hasura.RQL.Types +import Hasura.Server.Auth (AuthMode, getUserInfo) import Hasura.Server.Init import Hasura.Server.Logging import Hasura.Server.Middleware (corsMiddleware, @@ -50,8 +53,6 @@ import Hasura.Server.Utils import Hasura.Server.Version import Hasura.SQL.Types -import qualified Hasura.Logging as L -import Hasura.Server.Auth (AuthMode, getUserInfo) consoleTmplt :: M.Template diff --git a/server/src-lib/Hasura/Server/Auth.hs b/server/src-lib/Hasura/Server/Auth.hs index a83fde0fbec80..66eed4a7a8e63 100644 --- a/server/src-lib/Hasura/Server/Auth.hs +++ b/server/src-lib/Hasura/Server/Auth.hs @@ -8,6 +8,9 @@ module Hasura.Server.Auth ( getUserInfo , AuthMode(..) + , processJwt + , RawJWT + , SharedSecret ) where import Control.Exception (try) @@ -26,6 +29,7 @@ import qualified Network.Wreq as Wreq import Hasura.Prelude import Hasura.RQL.Types +import Hasura.Server.Auth.JWT bsToTxt :: B.ByteString -> T.Text bsToTxt = TE.decodeUtf8With TE.lenientDecode @@ -34,6 +38,7 @@ data AuthMode = AMNoAuth | AMAccessKey !T.Text | AMAccessKeyAndHook !T.Text !T.Text + | AMAccessKeyAndJWT !T.Text !T.Text deriving (Show, Eq) httpToQErr :: H.HttpException -> QErr @@ -109,12 +114,15 @@ getUserInfo manager rawHeaders = \case Nothing -> throw401 "x-hasura-access-key required, but not found" AMAccessKeyAndHook accKey hook -> - maybe - (userInfoFromWebhook manager hook rawHeaders) - (userInfoWhenAccessKey accKey) $ - getHeader accessKeyHeader + whenAccessKeyAbsent accKey (userInfoFromWebhook manager hook rawHeaders) + + AMAccessKeyAndJWT accKey jwtSecret -> + whenAccessKeyAbsent accKey (processJwt jwtSecret rawHeaders) where + -- when access key is absent, run the action to retrieve UserInfo, otherwise accesskey override + whenAccessKeyAbsent ak action = + maybe action (userInfoWhenAccessKey ak) $ getHeader accessKeyHeader headers = M.fromList $ filter (T.isPrefixOf "x-hasura-" . fst) $ diff --git a/server/src-lib/Hasura/Server/Auth/JWT.hs b/server/src-lib/Hasura/Server/Auth/JWT.hs new file mode 100644 index 0000000000000..17b10eb9f2da2 --- /dev/null +++ b/server/src-lib/Hasura/Server/Auth/JWT.hs @@ -0,0 +1,64 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedStrings #-} + +module Hasura.Server.Auth.JWT + ( processJwt + , RawJWT + , SharedSecret + ) where + +import Control.Lens +import Crypto.JWT +import Data.List (find) +import Hasura.Prelude +import Hasura.RQL.Types +import Hasura.Server.Utils (userRoleHeader) + +import qualified Data.Aeson as A +import qualified Data.ByteString.Lazy as BL +import qualified Data.ByteString.Lazy.Char8 as BLC +import qualified Data.CaseInsensitive as CI +import qualified Data.HashMap.Strict as Map +import qualified Data.Text as T +import qualified Data.Text.Encoding as TE +import qualified Network.HTTP.Types as HTTP + + +type SharedSecret = T.Text +type RawJWT = BL.ByteString + +processJwt :: (MonadIO m, MonadError QErr m) => SharedSecret -> HTTP.RequestHeaders -> m UserInfo +processJwt secret headers = do + let mAuthzHeader = find (\h -> fst h == CI.mk "Authorization") headers + (_, authzHeader) <- maybe (throw400 InvalidHeaders "cannot find Authorization header") return mAuthzHeader + let tokenParts = BLC.words $ BL.fromStrict authzHeader + when (length tokenParts /= 2) $ throw400 InvalidHeaders "malformed Authorization header" + let jwt = tokenParts !! 1 + eClaims <- liftIO $ runExceptT $ verifyJwt secret jwt + claims <- liftJWTError eClaims + ourMap <- mapM parseJSONToTxt $ claims ^. unregisteredClaims + let mRole = Map.lookup userRoleHeader ourMap + role <- maybe (throw400 InvalidHeaders "role info missing") return mRole + let restUserInfo = Map.filterWithKey (\_ -> T.isPrefixOf "x-hasura-") $ Map.delete userRoleHeader ourMap + return $ UserInfo (RoleName role) restUserInfo + + where + liftJWTError :: (MonadError QErr m) => Either JWTError ClaimsSet -> m ClaimsSet + liftJWTError = + either (\e -> throw400 InvalidHeaders $ "Invalid JWT: " <> T.pack (show e)) return + + parseJSONToTxt (A.String t) = return t + parseJSONToTxt _ = throw400 InvalidHeaders "x-hasura-* values cannot be JSON. should be string" + + +verifyJwt :: SharedSecret -> RawJWT -> ExceptT JWTError IO ClaimsSet +verifyJwt secret rawJWT = do + let secret' = BL.fromStrict . TE.encodeUtf8 $ secret + when (BL.length secret' < 32) $ throwError $ JWSError KeySizeTooSmall + let jwkey = fromOctets secret' -- turn raw secret into symmetric JWK + jwt <- decodeCompact rawJWT -- decode JWT + verifyClaims config jwkey jwt + where + audCheck = const True -- should be a proper audience check + config = defaultJWTValidationSettings audCheck diff --git a/server/src-lib/Hasura/Server/Init.hs b/server/src-lib/Hasura/Server/Init.hs index 7edce99164471..70227b7685e8a 100644 --- a/server/src-lib/Hasura/Server/Init.hs +++ b/server/src-lib/Hasura/Server/Init.hs @@ -44,6 +44,16 @@ data RawConnInfo = , connOptions :: !(Maybe String) } deriving (Eq, Read, Show) +data CorsConfigG a + = CorsConfigG + { ccDomain :: !a + , ccDisabled :: !Bool + } deriving (Show, Eq) + +type CorsConfigFlags = CorsConfigG (Maybe T.Text) +type CorsConfig = CorsConfigG T.Text + + parseRawConnInfo :: Parser RawConnInfo parseRawConnInfo = RawConnInfo @@ -150,15 +160,6 @@ parseAccessKey = optional $ strOption ( long "access-key" <> help "Secret access key, required to access this instance" ) -data CorsConfigG a - = CorsConfigG - { ccDomain :: !a - , ccDisabled :: !Bool - } deriving (Show, Eq) - -type CorsConfigFlags = CorsConfigG (Maybe T.Text) -type CorsConfig = CorsConfigG T.Text - parseCorsConfig :: Parser CorsConfigFlags parseCorsConfig = CorsConfigG @@ -176,6 +177,13 @@ parseWebHook = optional $ strOption ( long "auth-hook" <> help "The authentication webhook, required to authenticate requests" ) +parseJwtSecret :: Parser (Maybe T.Text) +parseJwtSecret = optional $ strOption ( long "jwt-secret" <> + metavar "HMAC-SHA256 SHARED SECRET" <> + help "The shared secret for HMAC-SHA256" + ) + + parseEnableConsole :: Parser Bool parseEnableConsole = switch ( long "enable-console" <> help "Enable API Console" diff --git a/server/stack.yaml b/server/stack.yaml index 1dec4df0ca515..2d8da42e28af6 100644 --- a/server/stack.yaml +++ b/server/stack.yaml @@ -19,6 +19,7 @@ extra-deps: commit: 77995388cab656f9180b851f33f3d603cf1017c7 - git: https://github.com/hasura/graphql-parser-hs.git commit: eae59812ec537b3756c3ddb5f59a7cc59508869b +- jose-0.7.0.0 # Override default flag values for local packages and extra-deps flags: {} From 8f9b3c491999d8c4d7cdd90a68f33d1a5999180a Mon Sep 17 00:00:00 2001 From: Anon Ray Date: Mon, 30 Jul 2018 14:41:07 +0530 Subject: [PATCH 02/13] implement JWT specific errors --- server/graphql-engine.cabal | 3 +- server/src-lib/Hasura/RQL/Types/Error.hs | 53 ++++++++++-------- server/src-lib/Hasura/Server/Auth/JWT.hs | 71 ++++++++++++++++++------ 3 files changed, 85 insertions(+), 42 deletions(-) diff --git a/server/graphql-engine.cabal b/server/graphql-engine.cabal index a3ae747258f90..fb13bea9595d4 100644 --- a/server/graphql-engine.cabal +++ b/server/graphql-engine.cabal @@ -51,6 +51,7 @@ library , wai-extra , containers , monad-control + , monad-time , wai-logger , fast-logger , wai @@ -125,8 +126,8 @@ library exposed-modules: Hasura.Server.App , Hasura.Server.Auth + , Hasura.Server.Auth.JWT , Hasura.Server.Init - , Hasura.Server.JWT , Hasura.Server.Middleware , Hasura.Server.Logging , Hasura.Server.Query diff --git a/server/src-lib/Hasura/RQL/Types/Error.hs b/server/src-lib/Hasura/RQL/Types/Error.hs index 33db692041d04..b71a9896f0777 100644 --- a/server/src-lib/Hasura/RQL/Types/Error.hs +++ b/server/src-lib/Hasura/RQL/Types/Error.hs @@ -67,35 +67,42 @@ data Code | AlreadyUntracked | InvalidParams | AlreadyInit + -- JWT Auth errors + | JWTRoleClaimMissing + | JWTInvalidClaims + | JWTInvalid -- Graphql error | NoTables | ValidationFailed deriving (Eq) instance Show Code where - show NotNullViolation = "not-null-violation" - show PermissionDenied = "permission-denied" - show NotExists = "not-exists" - show AlreadyExists = "already-exists" - show AlreadyTracked = "already-tracked" - show AlreadyUntracked = "already-untracked" - show PostgresError = "postgres-error" - show NotSupported = "not-supported" - show DependencyError = "dependency-error" - show InvalidHeaders = "invalid-headers" - show InvalidJSON = "invalid-json" - show AccessDenied = "access-denied" - show ParseFailed = "parse-failed" - show ConstraintError = "constraint-error" - show PermissionError = "permission-error" - show NotFound = "not-found" - show Unexpected = "unexpected" - show UnexpectedPayload = "unexpected-payload" - show NoUpdate = "no-update" - show InvalidParams = "invalid-params" - show AlreadyInit = "already-initialised" - show NoTables = "no-tables" - show ValidationFailed = "validation-failed" + show NotNullViolation = "not-null-violation" + show PermissionDenied = "permission-denied" + show NotExists = "not-exists" + show AlreadyExists = "already-exists" + show AlreadyTracked = "already-tracked" + show AlreadyUntracked = "already-untracked" + show PostgresError = "postgres-error" + show NotSupported = "not-supported" + show DependencyError = "dependency-error" + show InvalidHeaders = "invalid-headers" + show InvalidJSON = "invalid-json" + show AccessDenied = "access-denied" + show ParseFailed = "parse-failed" + show ConstraintError = "constraint-error" + show PermissionError = "permission-error" + show NotFound = "not-found" + show Unexpected = "unexpected" + show UnexpectedPayload = "unexpected-payload" + show NoUpdate = "no-update" + show InvalidParams = "invalid-params" + show AlreadyInit = "already-initialised" + show NoTables = "no-tables" + show ValidationFailed = "validation-failed" + show JWTRoleClaimMissing = "jwt-role-claim-missing" + show JWTInvalidClaims = "jwt-invalid-claims" + show JWTInvalid = "invalid-jwt" data QErr = QErr diff --git a/server/src-lib/Hasura/Server/Auth/JWT.hs b/server/src-lib/Hasura/Server/Auth/JWT.hs index 17b10eb9f2da2..d83588b4703de 100644 --- a/server/src-lib/Hasura/Server/Auth/JWT.hs +++ b/server/src-lib/Hasura/Server/Auth/JWT.hs @@ -11,6 +11,7 @@ module Hasura.Server.Auth.JWT import Control.Lens import Crypto.JWT import Data.List (find) +import Data.Time.Clock (getCurrentTime) import Hasura.Prelude import Hasura.RQL.Types import Hasura.Server.Utils (userRoleHeader) @@ -28,37 +29,71 @@ import qualified Network.HTTP.Types as HTTP type SharedSecret = T.Text type RawJWT = BL.ByteString -processJwt :: (MonadIO m, MonadError QErr m) => SharedSecret -> HTTP.RequestHeaders -> m UserInfo +processJwt + :: ( MonadIO m + , MonadError QErr m) + => SharedSecret + -> HTTP.RequestHeaders + -> m UserInfo processJwt secret headers = do + + -- try to parse JWT token from Authorization header let mAuthzHeader = find (\h -> fst h == CI.mk "Authorization") headers - (_, authzHeader) <- maybe (throw400 InvalidHeaders "cannot find Authorization header") return mAuthzHeader + (_, authzHeader) <- maybe missingAuthzHeader return mAuthzHeader let tokenParts = BLC.words $ BL.fromStrict authzHeader - when (length tokenParts /= 2) $ throw400 InvalidHeaders "malformed Authorization header" + when (length tokenParts /= 2) malformedAuthzHeader + + -- verify the JWT let jwt = tokenParts !! 1 - eClaims <- liftIO $ runExceptT $ verifyJwt secret jwt - claims <- liftJWTError eClaims - ourMap <- mapM parseJSONToTxt $ claims ^. unregisteredClaims - let mRole = Map.lookup userRoleHeader ourMap - role <- maybe (throw400 InvalidHeaders "role info missing") return mRole - let restUserInfo = Map.filterWithKey (\_ -> T.isPrefixOf "x-hasura-") $ Map.delete userRoleHeader ourMap - return $ UserInfo (RoleName role) restUserInfo + claims <- liftJWTError invalidJWTError $ verifyJwt secret jwt + + -- transform the map of text:aeson-value -> text:text + claimsMap <- mapM parseJSONToTxt $ claims ^. unregisteredClaims + + -- throw error if role is not in claims + let mRole = Map.lookup userRoleHeader claimsMap + role <- maybe missingRoleClaim return mRole + + -- filter only x-hasura claims to form UserInfo + let metadata = Map.filterWithKey (\_ -> T.isPrefixOf "x-hasura-") $ + Map.delete userRoleHeader claimsMap + return $ UserInfo (RoleName role) metadata where - liftJWTError :: (MonadError QErr m) => Either JWTError ClaimsSet -> m ClaimsSet - liftJWTError = - either (\e -> throw400 InvalidHeaders $ "Invalid JWT: " <> T.pack (show e)) return + liftJWTError :: (MonadError e' m) => (e -> e') -> ExceptT e m a -> m a + liftJWTError ef action = do + res <- runExceptT action + either (throwError . ef) return res + + invalidJWTError e = + err400 JWTInvalid $ "Could not verify JWT: " <> T.pack (show e) parseJSONToTxt (A.String t) = return t - parseJSONToTxt _ = throw400 InvalidHeaders "x-hasura-* values cannot be JSON. should be string" + parseJSONToTxt _ = + throw400 JWTInvalidClaims "x-hasura-* values cannot be JSON. should be string" + + missingRoleClaim = + throw400 JWTRoleClaimMissing "Your JWT claim should contain x-hasura-role" + malformedAuthzHeader = + throw400 InvalidHeaders "Malformed Authorization header" + missingAuthzHeader = + throw400 InvalidHeaders "Missing Authorization header in JWT authentication mode" -verifyJwt :: SharedSecret -> RawJWT -> ExceptT JWTError IO ClaimsSet +verifyJwt + :: ( MonadError JWTError m + , MonadIO m + ) + => SharedSecret + -> RawJWT + -> m ClaimsSet verifyJwt secret rawJWT = do let secret' = BL.fromStrict . TE.encodeUtf8 $ secret when (BL.length secret' < 32) $ throwError $ JWSError KeySizeTooSmall - let jwkey = fromOctets secret' -- turn raw secret into symmetric JWK + let jwkey = fromOctets secret' -- turn raw secret into symmetric JWK jwt <- decodeCompact rawJWT -- decode JWT - verifyClaims config jwkey jwt + t <- liftIO getCurrentTime + verifyClaimsAt config jwkey t jwt where - audCheck = const True -- should be a proper audience check + audCheck = const True -- should be a proper audience check config = defaultJWTValidationSettings audCheck From 556c4f5bb0df1a66883fbe7f095f68272f02791d Mon Sep 17 00:00:00 2001 From: Anon Ray Date: Mon, 30 Jul 2018 17:36:57 +0530 Subject: [PATCH 03/13] Improve auth mode types - Use type synonyms instead of Text everywhere --- server/src-exec/Main.hs | 9 +++++++-- server/src-lib/Hasura/Server/Auth.hs | 13 +++++++++---- server/src-lib/Hasura/Server/Init.hs | 29 ++++++++++++++-------------- 3 files changed, 31 insertions(+), 20 deletions(-) diff --git a/server/src-exec/Main.hs b/server/src-exec/Main.hs index 43df822ec8c39..b38187f356b16 100644 --- a/server/src-exec/Main.hs +++ b/server/src-exec/Main.hs @@ -25,8 +25,13 @@ import Hasura.Logging (defaultLoggerSettings, mkLoggerCtx) import Hasura.Prelude import Hasura.RQL.DDL.Metadata (fetchMetadata) import Hasura.Server.App (mkWaiApp) +<<<<<<< HEAD import Hasura.Server.Auth (AuthMode (..)) import Hasura.Server.CheckUpdates (checkForUpdates) +======= +import Hasura.Server.Auth (AccessKey, AuthMode (..), + SharedSecret, Webhook) +>>>>>>> Improve auth mode types import Hasura.Server.Init import qualified Database.PG.Query as Q @@ -45,8 +50,8 @@ data ServeOptions , soRootDir :: !(Maybe String) , soAccessKey :: !(Maybe AccessKey) , soCorsConfig :: !CorsConfigFlags - , soWebHook :: !(Maybe T.Text) - , soJwtSecret :: !(Maybe T.Text) + , soWebHook :: !(Maybe Webhook) + , soJwtSecret :: !(Maybe SharedSecret) , soEnableConsole :: !Bool } deriving (Show, Eq) diff --git a/server/src-lib/Hasura/Server/Auth.hs b/server/src-lib/Hasura/Server/Auth.hs index 66eed4a7a8e63..0cebd9b07de95 100644 --- a/server/src-lib/Hasura/Server/Auth.hs +++ b/server/src-lib/Hasura/Server/Auth.hs @@ -8,9 +8,11 @@ module Hasura.Server.Auth ( getUserInfo , AuthMode(..) - , processJwt + , AccessKey + , Webhook , RawJWT , SharedSecret + , processJwt ) where import Control.Exception (try) @@ -34,11 +36,14 @@ import Hasura.Server.Auth.JWT bsToTxt :: B.ByteString -> T.Text bsToTxt = TE.decodeUtf8With TE.lenientDecode +type AccessKey = T.Text +type Webhook = T.Text + data AuthMode = AMNoAuth - | AMAccessKey !T.Text - | AMAccessKeyAndHook !T.Text !T.Text - | AMAccessKeyAndJWT !T.Text !T.Text + | AMAccessKey !AccessKey + | AMAccessKeyAndHook !AccessKey !Webhook + | AMAccessKeyAndJWT !AccessKey !SharedSecret deriving (Show, Eq) httpToQErr :: H.HttpException -> QErr diff --git a/server/src-lib/Hasura/Server/Init.hs b/server/src-lib/Hasura/Server/Init.hs index 70227b7685e8a..d269f92ef3576 100644 --- a/server/src-lib/Hasura/Server/Init.hs +++ b/server/src-lib/Hasura/Server/Init.hs @@ -12,8 +12,10 @@ import qualified Data.Text as T import Hasura.Prelude import Hasura.RQL.DDL.Utils +import Hasura.Server.Auth import Hasura.Server.Utils + data InitError = InitError !String deriving (Show, Eq) @@ -24,7 +26,6 @@ instance Q.FromPGConnErr InitError where instance Q.FromPGTxErr InitError where fromPGTxErr = InitError . show -type AccessKey = T.Text initErrExit :: (Show e) => e -> IO a initErrExit e = print e >> exitFailure @@ -160,30 +161,30 @@ parseAccessKey = optional $ strOption ( long "access-key" <> help "Secret access key, required to access this instance" ) -parseCorsConfig :: Parser CorsConfigFlags -parseCorsConfig = - CorsConfigG - <$> optional (strOption ( long "cors-domain" <> - metavar "CORS DOMAIN" <> - help "The domain, including scheme and port, to allow CORS for" - )) - <*> switch ( long "disable-cors" <> - help "Disable CORS handling" - ) - -parseWebHook :: Parser (Maybe T.Text) +parseWebHook :: Parser (Maybe Webhook) parseWebHook = optional $ strOption ( long "auth-hook" <> metavar "AUTHENTICATION WEB HOOK" <> help "The authentication webhook, required to authenticate requests" ) -parseJwtSecret :: Parser (Maybe T.Text) +parseJwtSecret :: Parser (Maybe SharedSecret) parseJwtSecret = optional $ strOption ( long "jwt-secret" <> metavar "HMAC-SHA256 SHARED SECRET" <> help "The shared secret for HMAC-SHA256" ) +parseCorsConfig :: Parser CorsConfigFlags +parseCorsConfig = + CorsConfigG + <$> optional (strOption ( long "cors-domain" <> + metavar "CORS DOMAIN" <> + help "The domain, including scheme and port, to allow CORS for" + )) + <*> switch ( long "disable-cors" <> + help "Disable CORS handling" + ) + parseEnableConsole :: Parser Bool parseEnableConsole = switch ( long "enable-console" <> help "Enable API Console" From 1ba7d1e94faebd294a5c7328ad66aa53d5f26b15 Mon Sep 17 00:00:00 2001 From: Anon Ray Date: Mon, 30 Jul 2018 19:33:38 +0530 Subject: [PATCH 04/13] Fix an issue parsing x-hasura-* claims from JWT --- server/src-lib/Hasura/Server/Auth/JWT.hs | 26 ++++++++++++++-------- server/src-lib/Hasura/Server/Init.hs | 28 ++++++++++++++---------- 2 files changed, 33 insertions(+), 21 deletions(-) diff --git a/server/src-lib/Hasura/Server/Auth/JWT.hs b/server/src-lib/Hasura/Server/Auth/JWT.hs index d83588b4703de..7c5cc342db3d2 100644 --- a/server/src-lib/Hasura/Server/Auth/JWT.hs +++ b/server/src-lib/Hasura/Server/Auth/JWT.hs @@ -29,6 +29,7 @@ import qualified Network.HTTP.Types as HTTP type SharedSecret = T.Text type RawJWT = BL.ByteString + processJwt :: ( MonadIO m , MonadError QErr m) @@ -47,16 +48,20 @@ processJwt secret headers = do let jwt = tokenParts !! 1 claims <- liftJWTError invalidJWTError $ verifyJwt secret jwt + -- filter only x-hasura claims + let claimsMap = Map.filterWithKey (\k _ -> T.isPrefixOf "x-hasura-" k) $ + claims ^. unregisteredClaims + -- transform the map of text:aeson-value -> text:text - claimsMap <- mapM parseJSONToTxt $ claims ^. unregisteredClaims + metadataWithRole <- decodeJSON $ A.Object claimsMap -- throw error if role is not in claims - let mRole = Map.lookup userRoleHeader claimsMap + let mRole = Map.lookup userRoleHeader metadataWithRole role <- maybe missingRoleClaim return mRole - -- filter only x-hasura claims to form UserInfo - let metadata = Map.filterWithKey (\_ -> T.isPrefixOf "x-hasura-") $ - Map.delete userRoleHeader claimsMap + -- delete the x-hasura-role key from this map + let metadata = Map.delete userRoleHeader metadataWithRole + return $ UserInfo (RoleName role) metadata where @@ -65,13 +70,13 @@ processJwt secret headers = do res <- runExceptT action either (throwError . ef) return res + decodeJSON val = case A.fromJSON val of + A.Error e -> throw400 JWTInvalidClaims ("x-hasura-* claims: " <> T.pack e) + A.Success a -> return a + invalidJWTError e = err400 JWTInvalid $ "Could not verify JWT: " <> T.pack (show e) - parseJSONToTxt (A.String t) = return t - parseJSONToTxt _ = - throw400 JWTInvalidClaims "x-hasura-* values cannot be JSON. should be string" - missingRoleClaim = throw400 JWTRoleClaimMissing "Your JWT claim should contain x-hasura-role" malformedAuthzHeader = @@ -89,6 +94,9 @@ verifyJwt -> m ClaimsSet verifyJwt secret rawJWT = do let secret' = BL.fromStrict . TE.encodeUtf8 $ secret + -- this will work with HS256 algo, on HS384 and higher there will + -- JWSInvalidSignature error + -- https://github.com/frasertweedale/hs-jose/issues/46 when (BL.length secret' < 32) $ throwError $ JWSError KeySizeTooSmall let jwkey = fromOctets secret' -- turn raw secret into symmetric JWK jwt <- decodeCompact rawJWT -- decode JWT diff --git a/server/src-lib/Hasura/Server/Init.hs b/server/src-lib/Hasura/Server/Init.hs index d269f92ef3576..be1d33181434c 100644 --- a/server/src-lib/Hasura/Server/Init.hs +++ b/server/src-lib/Hasura/Server/Init.hs @@ -156,22 +156,26 @@ parseServerPort = help "Port on which graphql-engine should be served") parseAccessKey :: Parser (Maybe AccessKey) -parseAccessKey = optional $ strOption ( long "access-key" <> - metavar "SECRET ACCESS KEY" <> - help "Secret access key, required to access this instance" - ) +parseAccessKey = + optional $ strOption ( long "access-key" <> + metavar "SECRET ACCESS KEY" <> + help "Secret access key, required to access this instance" + ) parseWebHook :: Parser (Maybe Webhook) -parseWebHook = optional $ strOption ( long "auth-hook" <> - metavar "AUTHENTICATION WEB HOOK" <> - help "The authentication webhook, required to authenticate requests" - ) +parseWebHook = + optional $ strOption ( long "auth-hook" <> + metavar "AUTHENTICATION WEB HOOK" <> + help "The authentication webhook, required to authenticate requests" + ) parseJwtSecret :: Parser (Maybe SharedSecret) -parseJwtSecret = optional $ strOption ( long "jwt-secret" <> - metavar "HMAC-SHA256 SHARED SECRET" <> - help "The shared secret for HMAC-SHA256" - ) +parseJwtSecret = + optional $ strOption ( long "jwt-secret" <> + metavar "HMAC-SHA256 SHARED SECRET" <> + help ("The shared secret for verifying HMAC-SHA256 " + <> "signed JWTs (must be >= 32 characters)") + ) parseCorsConfig :: Parser CorsConfigFlags From e1fbf500b1b9e1caeecb84f916b0721ec2ba3af2 Mon Sep 17 00:00:00 2001 From: Anon Ray Date: Wed, 1 Aug 2018 04:45:23 +0530 Subject: [PATCH 05/13] add support for RSA JWK; add JWT secret as JSON - JWT keys are passed as JSON string passing flag to serve command, or as env variable HASURA_GRAPHQL_JWT_SECRET - Support for RSA JWKs --- server/graphql-engine.cabal | 2 + server/src-exec/Main.hs | 15 ++-- server/src-lib/Hasura/RQL/Types/Error.hs | 2 + server/src-lib/Hasura/Server/Auth.hs | 6 +- server/src-lib/Hasura/Server/Auth/JWT.hs | 100 +++++++++++++++++++---- server/src-lib/Hasura/Server/Init.hs | 2 +- 6 files changed, 98 insertions(+), 29 deletions(-) diff --git a/server/graphql-engine.cabal b/server/graphql-engine.cabal index fb13bea9595d4..a554caea4231a 100644 --- a/server/graphql-engine.cabal +++ b/server/graphql-engine.cabal @@ -70,6 +70,8 @@ library , cryptonite -- for jwt verification , jose + , pem + , x509 -- Server related , warp diff --git a/server/src-exec/Main.hs b/server/src-exec/Main.hs index b38187f356b16..de0cc1a973295 100644 --- a/server/src-exec/Main.hs +++ b/server/src-exec/Main.hs @@ -16,6 +16,7 @@ import qualified Data.ByteString.Char8 as BC import qualified Data.ByteString.Lazy as BL import qualified Data.ByteString.Lazy.Char8 as BLC import qualified Data.Text as T +import qualified Data.Text.Encoding as TE import qualified Data.Yaml as Y import qualified Network.HTTP.Client as HTTP import qualified Network.HTTP.Client.TLS as HTTP @@ -25,13 +26,8 @@ import Hasura.Logging (defaultLoggerSettings, mkLoggerCtx) import Hasura.Prelude import Hasura.RQL.DDL.Metadata (fetchMetadata) import Hasura.Server.App (mkWaiApp) -<<<<<<< HEAD -import Hasura.Server.Auth (AuthMode (..)) +import Hasura.Server.Auth (AccessKey, AuthMode (..), Webhook) import Hasura.Server.CheckUpdates (checkForUpdates) -======= -import Hasura.Server.Auth (AccessKey, AuthMode (..), - SharedSecret, Webhook) ->>>>>>> Improve auth mode types import Hasura.Server.Init import qualified Database.PG.Query as Q @@ -51,7 +47,7 @@ data ServeOptions , soAccessKey :: !(Maybe AccessKey) , soCorsConfig :: !CorsConfigFlags , soWebHook :: !(Maybe Webhook) - , soJwtSecret :: !(Maybe SharedSecret) + , soJwtSecret :: !(Maybe Text) , soEnableConsole :: !Bool } deriving (Show, Eq) @@ -106,7 +102,10 @@ mkAuthMode mAccessKey mWebHook mJwtSecret = (Nothing, Nothing, Nothing) -> return AMNoAuth (Just key, Nothing, Nothing) -> return $ AMAccessKey key (Just key, Just hook, Nothing) -> return $ AMAccessKeyAndHook key hook - (Just key, Nothing, Just secret) -> return $ AMAccessKeyAndJWT key secret + (Just key, Nothing, Just jwtConf) -> do + -- the JWT Conf as JSON string; try to parse it + config <- A.eitherDecodeStrict $ TE.encodeUtf8 jwtConf + return $ AMAccessKeyAndJWT key config (Nothing, Just _, Nothing) -> throwError $ "Fatal Error : --auth-hook (HASURA_GRAPHQL_AUTH_HOOK)" diff --git a/server/src-lib/Hasura/RQL/Types/Error.hs b/server/src-lib/Hasura/RQL/Types/Error.hs index b71a9896f0777..e484919798b8d 100644 --- a/server/src-lib/Hasura/RQL/Types/Error.hs +++ b/server/src-lib/Hasura/RQL/Types/Error.hs @@ -71,6 +71,7 @@ data Code | JWTRoleClaimMissing | JWTInvalidClaims | JWTInvalid + | JWTInvalidKey -- Graphql error | NoTables | ValidationFailed @@ -103,6 +104,7 @@ instance Show Code where show JWTRoleClaimMissing = "jwt-role-claim-missing" show JWTInvalidClaims = "jwt-invalid-claims" show JWTInvalid = "invalid-jwt" + show JWTInvalidKey = "invalid-jwt-key" data QErr = QErr diff --git a/server/src-lib/Hasura/Server/Auth.hs b/server/src-lib/Hasura/Server/Auth.hs index 0cebd9b07de95..0aedd3c165dfb 100644 --- a/server/src-lib/Hasura/Server/Auth.hs +++ b/server/src-lib/Hasura/Server/Auth.hs @@ -11,7 +11,7 @@ module Hasura.Server.Auth , AccessKey , Webhook , RawJWT - , SharedSecret + , JWTConfig (..) , processJwt ) where @@ -43,7 +43,7 @@ data AuthMode = AMNoAuth | AMAccessKey !AccessKey | AMAccessKeyAndHook !AccessKey !Webhook - | AMAccessKeyAndJWT !AccessKey !SharedSecret + | AMAccessKeyAndJWT !AccessKey !JWTConfig deriving (Show, Eq) httpToQErr :: H.HttpException -> QErr @@ -122,7 +122,7 @@ getUserInfo manager rawHeaders = \case whenAccessKeyAbsent accKey (userInfoFromWebhook manager hook rawHeaders) AMAccessKeyAndJWT accKey jwtSecret -> - whenAccessKeyAbsent accKey (processJwt jwtSecret rawHeaders) + whenAccessKeyAbsent accKey (processJwt (jcKey jwtSecret) rawHeaders) where -- when access key is absent, run the action to retrieve UserInfo, otherwise accesskey override diff --git a/server/src-lib/Hasura/Server/Auth/JWT.hs b/server/src-lib/Hasura/Server/Auth/JWT.hs index 7c5cc342db3d2..2ba7a3602a88f 100644 --- a/server/src-lib/Hasura/Server/Auth/JWT.hs +++ b/server/src-lib/Hasura/Server/Auth/JWT.hs @@ -5,11 +5,13 @@ module Hasura.Server.Auth.JWT ( processJwt , RawJWT - , SharedSecret + , JWTConfig (..) ) where import Control.Lens +import Crypto.JOSE.Types (Base64Integer (..)) import Crypto.JWT +import Crypto.PubKey.RSA (PublicKey (..)) import Data.List (find) import Data.Time.Clock (getCurrentTime) import Hasura.Prelude @@ -21,22 +23,23 @@ import qualified Data.ByteString.Lazy as BL import qualified Data.ByteString.Lazy.Char8 as BLC import qualified Data.CaseInsensitive as CI import qualified Data.HashMap.Strict as Map +import qualified Data.PEM as PEM import qualified Data.Text as T import qualified Data.Text.Encoding as TE +import qualified Data.X509 as X509 import qualified Network.HTTP.Types as HTTP -type SharedSecret = T.Text type RawJWT = BL.ByteString - +-- | Process the request headers to verify the JWT and extract UserInfo from it processJwt :: ( MonadIO m , MonadError QErr m) - => SharedSecret + => JWK -> HTTP.RequestHeaders -> m UserInfo -processJwt secret headers = do +processJwt key headers = do -- try to parse JWT token from Authorization header let mAuthzHeader = find (\h -> fst h == CI.mk "Authorization") headers @@ -46,7 +49,7 @@ processJwt secret headers = do -- verify the JWT let jwt = tokenParts !! 1 - claims <- liftJWTError invalidJWTError $ verifyJwt secret jwt + claims <- liftJWTError invalidJWTError $ verifyJwt key jwt -- filter only x-hasura claims let claimsMap = Map.filterWithKey (\k _ -> T.isPrefixOf "x-hasura-" k) $ @@ -89,19 +92,82 @@ verifyJwt :: ( MonadError JWTError m , MonadIO m ) - => SharedSecret + => JWK -> RawJWT -> m ClaimsSet -verifyJwt secret rawJWT = do - let secret' = BL.fromStrict . TE.encodeUtf8 $ secret - -- this will work with HS256 algo, on HS384 and higher there will - -- JWSInvalidSignature error - -- https://github.com/frasertweedale/hs-jose/issues/46 - when (BL.length secret' < 32) $ throwError $ JWSError KeySizeTooSmall - let jwkey = fromOctets secret' -- turn raw secret into symmetric JWK - jwt <- decodeCompact rawJWT -- decode JWT +verifyJwt key rawJWT = do + jwt <- decodeCompact rawJWT -- decode JWT t <- liftIO getCurrentTime - verifyClaimsAt config jwkey t jwt + verifyClaimsAt config key t jwt where - audCheck = const True -- should be a proper audience check + audCheck = const True -- we ignore the audience check? config = defaultJWTValidationSettings audCheck + + +-- HGE's own representation of various JWKs +data JWTConfig + = JWTConfig + { jcType :: !T.Text + , jcKey :: !JWK + } deriving (Show, Eq) + +-- | Parse from a {"key": "RS256", "key": } to JWTConfig +instance A.FromJSON JWTConfig where + + parseJSON = A.withObject "foo" $ \o -> do + keyType <- o A..: "type" + rawKey <- o A..: "key" + case keyType of + "HS256" -> parseHmacKey keyType rawKey 256 + "HS384" -> parseHmacKey keyType rawKey 384 + "HS512" -> parseHmacKey keyType rawKey 512 + "RS256" -> parseRsaKey keyType rawKey + "RS384" -> parseRsaKey keyType rawKey + "RS512" -> parseRsaKey keyType rawKey + -- TODO: support ES256, ES384, ES512, PS256, PS384 + _ -> invalidJwk ("Key type: " <> T.unpack keyType <> " not supported") + where + parseHmacKey ktype key size = do + let secret = BL.fromStrict $ TE.encodeUtf8 key + when (BL.length secret < size `div` 8) $ + invalidJwk "Key size too small" + return $ JWTConfig ktype $ fromOctets secret + + parseRsaKey ktype key = do + let res = fromRawPem (BL.fromStrict $ TE.encodeUtf8 key) + case res of + Left e -> invalidJwk ("Could not decode PEM: " <> T.unpack e) + Right a -> return $ JWTConfig ktype a + + invalidJwk msg = fail ("Invalid JWK: " <> msg) + + +-- | Helper functions to decode PEM bytestring to RSA public key + +fromRawPem :: BL.ByteString -> Either Text JWK +fromRawPem k = fromCertRaw k >>= certToJwk + +fromCertRaw :: BL.ByteString -> Either Text X509.Certificate +fromCertRaw s = do + -- try to parse bytestring to a [PEM] + pems <- fmapL T.pack $ PEM.pemParseLBS s + -- fail if [PEM] is empty + pem <- getAtleastOnePem pems + -- decode the bytestring to a certificate + signedExactCert <- fmapL T.pack $ X509.decodeSignedCertificate $ + PEM.pemContent pem + return $ X509.signedObject $ X509.getSigned signedExactCert + where + fmapL fn (Left e) = Left $ fn e + fmapL _ (Right x) = pure x + + getAtleastOnePem [] = Left "No pem found" + getAtleastOnePem (x:_) = Right x + +certToJwk :: X509.Certificate -> Either Text JWK +certToJwk cert = do + let X509.PubKeyRSA (PublicKey _ n e) = X509.certPubKey cert + jwk' = fromKeyMaterial $ RSAKeyMaterial $ rsaKeyParams n e + return $ jwk' & jwkKeyOps .~ Just [Verify] + where + rsaKeyParams n e = RSAKeyParameters (Base64Integer n) (Base64Integer e) Nothing diff --git a/server/src-lib/Hasura/Server/Init.hs b/server/src-lib/Hasura/Server/Init.hs index be1d33181434c..00b5124ddbe89 100644 --- a/server/src-lib/Hasura/Server/Init.hs +++ b/server/src-lib/Hasura/Server/Init.hs @@ -169,7 +169,7 @@ parseWebHook = help "The authentication webhook, required to authenticate requests" ) -parseJwtSecret :: Parser (Maybe SharedSecret) +parseJwtSecret :: Parser (Maybe Text) parseJwtSecret = optional $ strOption ( long "jwt-secret" <> metavar "HMAC-SHA256 SHARED SECRET" <> From ec495d6a10e52920ecbad71675cffb50c5ab43e9 Mon Sep 17 00:00:00 2001 From: Anon Ray Date: Fri, 3 Aug 2018 19:29:38 +0530 Subject: [PATCH 06/13] support RSA JWKs in PKCS8/PKCS1/X509 format --- server/graphql-engine.cabal | 2 + server/src-lib/Hasura/Server/Auth/JWT.hs | 86 +++++++++++++++++++----- 2 files changed, 70 insertions(+), 18 deletions(-) diff --git a/server/graphql-engine.cabal b/server/graphql-engine.cabal index a554caea4231a..73b12165a8bc8 100644 --- a/server/graphql-engine.cabal +++ b/server/graphql-engine.cabal @@ -72,6 +72,8 @@ library , jose , pem , x509 + , asn1-encoding + , asn1-types -- Server related , warp diff --git a/server/src-lib/Hasura/Server/Auth/JWT.hs b/server/src-lib/Hasura/Server/Auth/JWT.hs index 2ba7a3602a88f..8538c6641db0c 100644 --- a/server/src-lib/Hasura/Server/Auth/JWT.hs +++ b/server/src-lib/Hasura/Server/Auth/JWT.hs @@ -12,13 +12,20 @@ import Control.Lens import Crypto.JOSE.Types (Base64Integer (..)) import Crypto.JWT import Crypto.PubKey.RSA (PublicKey (..)) +import Data.ASN1.BinaryEncoding (DER (..)) +import Data.ASN1.Encoding (decodeASN1') +import Data.ASN1.Types (ASN1 (End, IntVal, Start), + ASN1ConstructionType (Sequence), + fromASN1) import Data.List (find) import Data.Time.Clock (getCurrentTime) +--import Debug.Trace import Hasura.Prelude import Hasura.RQL.Types import Hasura.Server.Utils (userRoleHeader) import qualified Data.Aeson as A +-- import qualified Data.ByteString.Base64 as B64 import qualified Data.ByteString.Lazy as BL import qualified Data.ByteString.Lazy.Char8 as BLC import qualified Data.CaseInsensitive as CI @@ -111,7 +118,8 @@ data JWTConfig , jcKey :: !JWK } deriving (Show, Eq) --- | Parse from a {"key": "RS256", "key": } to JWTConfig +-- | Parse from a json string like `{"type": "RS256", "key": }` to +-- | JWTConfig instance A.FromJSON JWTConfig where parseJSON = A.withObject "foo" $ \o -> do @@ -135,39 +143,81 @@ instance A.FromJSON JWTConfig where parseRsaKey ktype key = do let res = fromRawPem (BL.fromStrict $ TE.encodeUtf8 key) - case res of - Left e -> invalidJwk ("Could not decode PEM: " <> T.unpack e) - Right a -> return $ JWTConfig ktype a + err e = "Could not decode PEM: " <> T.unpack e + either (invalidJwk . err) (return . JWTConfig ktype) res invalidJwk msg = fail ("Invalid JWK: " <> msg) -- | Helper functions to decode PEM bytestring to RSA public key +-- try PKCS first, then x509 fromRawPem :: BL.ByteString -> Either Text JWK -fromRawPem k = fromCertRaw k >>= certToJwk +fromRawPem bs = -- pubKeyToJwk <=< fromPkcsPem + case fromPkcsPem bs of + Right pk -> pubKeyToJwk pk + Left e -> + case fromX509Pem bs of + Right pk1 -> pubKeyToJwk pk1 + Left e1 -> Left (e <> " " <> e1) + +-- decode a PKCS1 or PKCS8 PEM to obtain the public key +fromPkcsPem :: BL.ByteString -> Either Text PublicKey +fromPkcsPem bs = do + pems <- fmapL T.pack $ PEM.pemParseLBS bs + pem <- getAtleastOnePem pems + res <- fmapL asn1ErrToText $ decodeASN1' DER $ PEM.pemContent pem + -- trace ("ASN1 decodes: " ++ show res) (return ()) + case res of + -- PKCS#1 format + [Start Sequence, IntVal n, IntVal e, End Sequence] -> + return $ PublicKey (calculateSize n) n e + -- try and see if its a PKCS#8 format + asn1 -> do + (pub, []) <- fmapL T.pack $ fromASN1 asn1 + case pub of + X509.PubKeyRSA pk -> return pk + _ -> Left "Could not decode RSA public key" + where + asn1ErrToText = T.pack . show -fromCertRaw :: BL.ByteString -> Either Text X509.Certificate -fromCertRaw s = do +-- decode a x509 certificate containing the RSA public key +fromX509Pem :: BL.ByteString -> Either Text PublicKey +fromX509Pem s = do -- try to parse bytestring to a [PEM] pems <- fmapL T.pack $ PEM.pemParseLBS s -- fail if [PEM] is empty pem <- getAtleastOnePem pems + -- decode the bytestring to a certificate signedExactCert <- fmapL T.pack $ X509.decodeSignedCertificate $ PEM.pemContent pem - return $ X509.signedObject $ X509.getSigned signedExactCert - where - fmapL fn (Left e) = Left $ fn e - fmapL _ (Right x) = pure x + let cert = X509.signedObject $ X509.getSigned signedExactCert + pubKey = X509.certPubKey cert - getAtleastOnePem [] = Left "No pem found" - getAtleastOnePem (x:_) = Right x + case pubKey of + X509.PubKeyRSA pk -> return pk + _ -> Left "Could not decode RSA public key from x509 cert" -certToJwk :: X509.Certificate -> Either Text JWK -certToJwk cert = do - let X509.PubKeyRSA (PublicKey _ n e) = X509.certPubKey cert - jwk' = fromKeyMaterial $ RSAKeyMaterial $ rsaKeyParams n e + +pubKeyToJwk :: PublicKey -> Either Text JWK +pubKeyToJwk (PublicKey _ n e) = do + let jwk' = fromKeyMaterial $ RSAKeyMaterial rsaKeyParams return $ jwk' & jwkKeyOps .~ Just [Verify] where - rsaKeyParams n e = RSAKeyParameters (Base64Integer n) (Base64Integer e) Nothing + rsaKeyParams = RSAKeyParameters (Base64Integer n) (Base64Integer e) Nothing + + +fmapL :: (a -> a') -> Either a b -> Either a' b +fmapL fn (Left e) = Left (fn e) +fmapL _ (Right x) = pure x + +getAtleastOnePem :: [PEM.PEM] -> Either Text PEM.PEM +getAtleastOnePem [] = Left "No pem found" +getAtleastOnePem (x:_) = Right x + +calculateSize :: Integer -> Int +calculateSize = go 1 + where + go i n | 2 ^ (i * 8) > n = i + | otherwise = go (i + 1) n From bc90347b9af5b4f1125e0461762f8e891e3b266e Mon Sep 17 00:00:00 2001 From: Anon Ray Date: Mon, 6 Aug 2018 12:27:53 +0530 Subject: [PATCH 07/13] minor refactor and fix help text for jwt secret --- server/src-lib/Hasura/Server/Auth/JWT.hs | 35 ++++++++++---------- server/src-lib/Hasura/Server/CheckUpdates.hs | 2 +- server/src-lib/Hasura/Server/Init.hs | 11 ++++-- 3 files changed, 27 insertions(+), 21 deletions(-) diff --git a/server/src-lib/Hasura/Server/Auth/JWT.hs b/server/src-lib/Hasura/Server/Auth/JWT.hs index 8538c6641db0c..3056cb208483d 100644 --- a/server/src-lib/Hasura/Server/Auth/JWT.hs +++ b/server/src-lib/Hasura/Server/Auth/JWT.hs @@ -9,6 +9,7 @@ module Hasura.Server.Auth.JWT ) where import Control.Lens +import Control.Monad (when) import Crypto.JOSE.Types (Base64Integer (..)) import Crypto.JWT import Crypto.PubKey.RSA (PublicKey (..)) @@ -19,13 +20,11 @@ import Data.ASN1.Types (ASN1 (End, IntVal, Start), fromASN1) import Data.List (find) import Data.Time.Clock (getCurrentTime) ---import Debug.Trace import Hasura.Prelude import Hasura.RQL.Types import Hasura.Server.Utils (userRoleHeader) import qualified Data.Aeson as A --- import qualified Data.ByteString.Base64 as B64 import qualified Data.ByteString.Lazy as BL import qualified Data.ByteString.Lazy.Char8 as BLC import qualified Data.CaseInsensitive as CI @@ -162,50 +161,52 @@ fromRawPem bs = -- pubKeyToJwk <=< fromPkcsPem Left e1 -> Left (e <> " " <> e1) -- decode a PKCS1 or PKCS8 PEM to obtain the public key -fromPkcsPem :: BL.ByteString -> Either Text PublicKey +fromPkcsPem :: BL.ByteString -> Either Text X509.PubKey fromPkcsPem bs = do pems <- fmapL T.pack $ PEM.pemParseLBS bs pem <- getAtleastOnePem pems res <- fmapL asn1ErrToText $ decodeASN1' DER $ PEM.pemContent pem - -- trace ("ASN1 decodes: " ++ show res) (return ()) case res of -- PKCS#1 format [Start Sequence, IntVal n, IntVal e, End Sequence] -> - return $ PublicKey (calculateSize n) n e + return $ X509.PubKeyRSA $ PublicKey (calculateSize n) n e -- try and see if its a PKCS#8 format asn1 -> do - (pub, []) <- fmapL T.pack $ fromASN1 asn1 - case pub of - X509.PubKeyRSA pk -> return pk - _ -> Left "Could not decode RSA public key" + (pub, xs) <- fmapL T.pack $ fromASN1 asn1 + unless (null xs) (Left "Could not decode public key") + return pub where asn1ErrToText = T.pack . show + -- decode a x509 certificate containing the RSA public key -fromX509Pem :: BL.ByteString -> Either Text PublicKey +fromX509Pem :: BL.ByteString -> Either Text X509.PubKey fromX509Pem s = do -- try to parse bytestring to a [PEM] pems <- fmapL T.pack $ PEM.pemParseLBS s -- fail if [PEM] is empty pem <- getAtleastOnePem pems - -- decode the bytestring to a certificate signedExactCert <- fmapL T.pack $ X509.decodeSignedCertificate $ PEM.pemContent pem let cert = X509.signedObject $ X509.getSigned signedExactCert pubKey = X509.certPubKey cert - case pubKey of - X509.PubKeyRSA pk -> return pk + X509.PubKeyRSA pk -> return $ X509.PubKeyRSA pk _ -> Left "Could not decode RSA public key from x509 cert" -pubKeyToJwk :: PublicKey -> Either Text JWK -pubKeyToJwk (PublicKey _ n e) = do - let jwk' = fromKeyMaterial $ RSAKeyMaterial rsaKeyParams +pubKeyToJwk :: X509.PubKey -> Either Text JWK +pubKeyToJwk pubKey = do + jwk' <- mkJwk return $ jwk' & jwkKeyOps .~ Just [Verify] where - rsaKeyParams = RSAKeyParameters (Base64Integer n) (Base64Integer e) Nothing + mkJwk = case pubKey of + X509.PubKeyRSA (PublicKey _ n e) -> + return $ fromKeyMaterial $ RSAKeyMaterial (rsaKeyParams n e) + _ -> Left "This key type is not supported" + rsaKeyParams n e = + RSAKeyParameters (Base64Integer n) (Base64Integer e) Nothing fmapL :: (a -> a') -> Either a b -> Either a' b diff --git a/server/src-lib/Hasura/Server/CheckUpdates.hs b/server/src-lib/Hasura/Server/CheckUpdates.hs index f4611fd49bf33..2487882d38d21 100644 --- a/server/src-lib/Hasura/Server/CheckUpdates.hs +++ b/server/src-lib/Hasura/Server/CheckUpdates.hs @@ -25,7 +25,7 @@ import Hasura.Server.Version (currentVersion) newtype UpdateInfo = UpdateInfo - { uiLatest :: T.Text + { _uiLatest :: T.Text } deriving (Show, Eq) $(A.deriveJSON (A.aesonDrop 2 A.snakeCase) ''UpdateInfo) diff --git a/server/src-lib/Hasura/Server/Init.hs b/server/src-lib/Hasura/Server/Init.hs index 00b5124ddbe89..f2e778af8aa78 100644 --- a/server/src-lib/Hasura/Server/Init.hs +++ b/server/src-lib/Hasura/Server/Init.hs @@ -169,14 +169,19 @@ parseWebHook = help "The authentication webhook, required to authenticate requests" ) + parseJwtSecret :: Parser (Maybe Text) parseJwtSecret = optional $ strOption ( long "jwt-secret" <> - metavar "HMAC-SHA256 SHARED SECRET" <> - help ("The shared secret for verifying HMAC-SHA256 " - <> "signed JWTs (must be >= 32 characters)") + metavar "JWK" <> + help jwtSecretHelp ) +jwtSecretHelp :: String +jwtSecretHelp = "The JSON containing type and the JWK used for verifying. e.g: " + <> "`{\"type\": \"HS256\", \"key\": \"\"}`," + <> "`{\"type\": \"RS256\", \"key\": \"\"}`" + parseCorsConfig :: Parser CorsConfigFlags parseCorsConfig = From 7bf4e0a2934bf7f2e35c91b38f4a62a56944fdea Mon Sep 17 00:00:00 2001 From: Anon Ray Date: Thu, 9 Aug 2018 16:50:16 +0530 Subject: [PATCH 08/13] code review fix for JWT support - pattern match on Authorization header rather than detecting length etc. --- server/src-lib/Hasura/Server/Auth/JWT.hs | 15 +++++++++------ 1 file changed, 9 insertions(+), 6 deletions(-) diff --git a/server/src-lib/Hasura/Server/Auth/JWT.hs b/server/src-lib/Hasura/Server/Auth/JWT.hs index 4669c5dd6e052..e81bc1935b692 100644 --- a/server/src-lib/Hasura/Server/Auth/JWT.hs +++ b/server/src-lib/Hasura/Server/Auth/JWT.hs @@ -46,15 +46,10 @@ processJwt -> HTTP.RequestHeaders -> m UserInfo processJwt key headers = do - -- try to parse JWT token from Authorization header - let mAuthzHeader = find (\h -> fst h == CI.mk "Authorization") headers - (_, authzHeader) <- maybe missingAuthzHeader return mAuthzHeader - let tokenParts = BLC.words $ BL.fromStrict authzHeader - when (length tokenParts /= 2) malformedAuthzHeader + jwt <- parseAuthzHeader -- verify the JWT - let jwt = tokenParts !! 1 claims <- liftJWTError invalidJWTError $ verifyJwt key jwt -- filter only x-hasura claims @@ -74,6 +69,14 @@ processJwt key headers = do return $ UserInfo (RoleName role) metadata where + parseAuthzHeader = do + let mAuthzHeader = find (\h -> fst h == CI.mk "Authorization") headers + (_, authzHeader) <- maybe missingAuthzHeader return mAuthzHeader + let tokenParts = BLC.words $ BL.fromStrict authzHeader + case tokenParts of + ["Bearer", jwt] -> return jwt + _ -> malformedAuthzHeader + liftJWTError :: (MonadError e' m) => (e -> e') -> ExceptT e m a -> m a liftJWTError ef action = do res <- runExceptT action From 9c6ee8373deb01158e52eca941be6032a4d14e7f Mon Sep 17 00:00:00 2001 From: Anon Ray Date: Wed, 22 Aug 2018 15:24:09 +0530 Subject: [PATCH 09/13] bug fix in jwt metadata handling not deleting user role from UserInfo metadata headers, and deleting access key --- server/src-lib/Hasura/Server/Auth/JWT.hs | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/server/src-lib/Hasura/Server/Auth/JWT.hs b/server/src-lib/Hasura/Server/Auth/JWT.hs index e81bc1935b692..4ce36d2affa91 100644 --- a/server/src-lib/Hasura/Server/Auth/JWT.hs +++ b/server/src-lib/Hasura/Server/Auth/JWT.hs @@ -22,7 +22,7 @@ import Data.List (find) import Data.Time.Clock (getCurrentTime) import Hasura.Prelude import Hasura.RQL.Types -import Hasura.Server.Utils (userRoleHeader) +import Hasura.Server.Utils (accessKeyHeader, userRoleHeader) import qualified Data.Aeson as A import qualified Data.ByteString.Lazy as BL @@ -57,16 +57,16 @@ processJwt key headers = do claims ^. unregisteredClaims -- transform the map of text:aeson-value -> text:text - metadataWithRole <- decodeJSON $ A.Object claimsMap + metadata <- decodeJSON $ A.Object claimsMap -- throw error if role is not in claims - let mRole = Map.lookup userRoleHeader metadataWithRole + let mRole = Map.lookup userRoleHeader metadata role <- maybe missingRoleClaim return mRole - -- delete the x-hasura-role key from this map - let metadata = Map.delete userRoleHeader metadataWithRole + -- delete the x-hasura-access-key from this map + let finalMetadata = Map.delete accessKeyHeader metadata - return $ UserInfo (RoleName role) metadata + return $ UserInfo (RoleName role) finalMetadata where parseAuthzHeader = do From ea77dbf062f1db79c4da6c9471130d54633c7d12 Mon Sep 17 00:00:00 2001 From: Anon Ray Date: Fri, 24 Aug 2018 18:03:41 +0530 Subject: [PATCH 10/13] add support for x-hasura-allowed-roles in JWT mode --- server/src-lib/Hasura/Server/Auth.hs | 38 +++--- server/src-lib/Hasura/Server/Auth/JWT.hs | 153 +++++++++++++++++------ server/src-lib/Hasura/Server/Utils.hs | 7 ++ 3 files changed, 134 insertions(+), 64 deletions(-) diff --git a/server/src-lib/Hasura/Server/Auth.hs b/server/src-lib/Hasura/Server/Auth.hs index 3351cd4fa56aa..9deefeed28fb1 100644 --- a/server/src-lib/Hasura/Server/Auth.hs +++ b/server/src-lib/Hasura/Server/Auth.hs @@ -16,30 +16,26 @@ module Hasura.Server.Auth , processJwt ) where -import Control.Exception (try) +import Control.Exception (try) import Control.Lens import Data.Aeson -import Data.CaseInsensitive (CI (..), original) - -import qualified Data.ByteString as B -import qualified Data.ByteString.Lazy as BL -import qualified Data.HashMap.Strict as M -import qualified Data.Text as T -import qualified Data.Text.Encoding as TE -import qualified Data.Text.Encoding.Error as TE -import qualified Network.HTTP.Client as H -import qualified Network.HTTP.Types as N -import qualified Network.Wreq as Wreq +import Data.CaseInsensitive (CI (..), original) + +import qualified Data.ByteString.Lazy as BL +import qualified Data.HashMap.Strict as M +import qualified Data.Text as T +import qualified Network.HTTP.Client as H +import qualified Network.HTTP.Types as N +import qualified Network.Wreq as Wreq import Hasura.Prelude import Hasura.RQL.Types import Hasura.Server.Auth.JWT import Hasura.Server.Logging +import Hasura.Server.Utils -import qualified Hasura.Logging as L +import qualified Hasura.Logging as L -bsToTxt :: B.ByteString -> T.Text -bsToTxt = TE.decodeUtf8With TE.lenientDecode type AccessKey = T.Text type Webhook = T.Text @@ -53,8 +49,6 @@ data AuthMode type WebHookLogger = WebHookLog -> IO () -userRoleHeader :: T.Text -userRoleHeader = "x-hasura-role" mkUserInfoFromResp :: (MonadIO m, MonadError QErr m) @@ -128,8 +122,6 @@ userInfoFromWebhook logger manager urlT reqHeaders = do , "Cache-Control", "Connection", "DNT" ] -accessKeyHeader :: T.Text -accessKeyHeader = "x-hasura-access-key" getUserInfo :: (MonadIO m, MonadError QErr m) @@ -145,13 +137,13 @@ getUserInfo logger manager rawHeaders = \case AMAccessKey accKey -> case getHeader accessKeyHeader of Just givenAccKey -> userInfoWhenAccessKey accKey givenAccKey - Nothing -> throw401 "x-hasura-access-key required, but not found" + Nothing -> throw401 $ accessKeyHeader <> " required, but not found" AMAccessKeyAndHook accKey hook -> whenAccessKeyAbsent accKey (userInfoFromWebhook logger manager hook rawHeaders) AMAccessKeyAndJWT accKey jwtSecret -> - whenAccessKeyAbsent accKey (processJwt (jcKey jwtSecret) rawHeaders) + whenAccessKeyAbsent accKey (processJwt jwtSecret rawHeaders) where -- when access key is absent, run the action to retrieve UserInfo, otherwise @@ -168,10 +160,10 @@ getUserInfo logger manager rawHeaders = \case getHeader h = M.lookup h headers userInfoFromHeaders = - case M.lookup "x-hasura-role" headers of + case M.lookup userRoleHeader headers of Just v -> UserInfo (RoleName v) headers Nothing -> UserInfo adminRole M.empty userInfoWhenAccessKey key reqKey = do - when (reqKey /= key) $ throw401 "invalid x-hasura-access-key" + when (reqKey /= key) $ throw401 $ "invalid " <> accessKeyHeader return userInfoFromHeaders diff --git a/server/src-lib/Hasura/Server/Auth/JWT.hs b/server/src-lib/Hasura/Server/Auth/JWT.hs index 4ce36d2affa91..c5d051227bed0 100644 --- a/server/src-lib/Hasura/Server/Auth/JWT.hs +++ b/server/src-lib/Hasura/Server/Auth/JWT.hs @@ -1,6 +1,7 @@ -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedStrings #-} module Hasura.Server.Auth.JWT ( processJwt @@ -10,6 +11,7 @@ module Hasura.Server.Auth.JWT import Control.Lens import Control.Monad (when) + import Crypto.JOSE.Types (Base64Integer (..)) import Crypto.JWT import Crypto.PubKey.RSA (PublicKey (..)) @@ -22,7 +24,8 @@ import Data.List (find) import Data.Time.Clock (getCurrentTime) import Hasura.Prelude import Hasura.RQL.Types -import Hasura.Server.Utils (accessKeyHeader, userRoleHeader) +import Hasura.Server.Utils (accessKeyHeader, bsToTxt, + userRoleHeader) import qualified Data.Aeson as A import qualified Data.ByteString.Lazy as BL @@ -38,35 +41,35 @@ import qualified Network.HTTP.Types as HTTP type RawJWT = BL.ByteString +newtype AllowedRoles + = AllowedRoles { getAllowedRoles :: [RoleName] } + deriving (Show, Eq, A.FromJSON) + + -- | Process the request headers to verify the JWT and extract UserInfo from it processJwt :: ( MonadIO m , MonadError QErr m) - => JWK + => JWTConfig -> HTTP.RequestHeaders -> m UserInfo -processJwt key headers = do +processJwt conf headers = do -- try to parse JWT token from Authorization header jwt <- parseAuthzHeader -- verify the JWT - claims <- liftJWTError invalidJWTError $ verifyJwt key jwt + claims <- liftJWTError invalidJWTError $ verifyJwt (jcKey conf) jwt -- filter only x-hasura claims let claimsMap = Map.filterWithKey (\k _ -> T.isPrefixOf "x-hasura-" k) $ claims ^. unregisteredClaims - -- transform the map of text:aeson-value -> text:text - metadata <- decodeJSON $ A.Object claimsMap - - -- throw error if role is not in claims - let mRole = Map.lookup userRoleHeader metadata - role <- maybe missingRoleClaim return mRole + allowedRoles <- parseAllowedRoles claimsMap + (role, metadata) <- parseRoleAndMetadata conf headers allowedRoles claimsMap -- delete the x-hasura-access-key from this map let finalMetadata = Map.delete accessKeyHeader metadata - - return $ UserInfo (RoleName role) finalMetadata + return $ UserInfo role finalMetadata where parseAuthzHeader = do @@ -82,21 +85,87 @@ processJwt key headers = do res <- runExceptT action either (throwError . ef) return res - decodeJSON val = case A.fromJSON val of - A.Error e -> throw400 JWTInvalidClaims ("x-hasura-* claims: " <> T.pack e) - A.Success a -> return a - invalidJWTError e = err400 JWTInvalid $ "Could not verify JWT: " <> T.pack (show e) - missingRoleClaim = - throw400 JWTRoleClaimMissing "Your JWT claim should contain x-hasura-role" malformedAuthzHeader = throw400 InvalidHeaders "Malformed Authorization header" missingAuthzHeader = throw400 InvalidHeaders "Missing Authorization header in JWT authentication mode" +-- parse x-hasura-allowed-roles from JWT claims +parseAllowedRoles + :: (MonadError QErr m) + => A.Object -> m (Maybe [RoleName]) +parseAllowedRoles claimsMap = do + let allowedRoles = Map.lookup "x-hasura-allowed-roles" claimsMap + case A.fromJSON <$> allowedRoles of + Nothing -> return Nothing + Just ar -> parseRes ar + where + parseRes r = + case r of + A.Success val -> return val + A.Error _ -> throw400 JWTInvalidClaims "invalid x-hasura-allowed-roles; should be a list of roles" + + +-- | Meat of the logic of JWT authz. Determine if x-hasura-allowed-roles is +-- | there, then parse that and assert if user's current role is in that list. User's +-- | current role comes from request header x-hasura-role if found or defaults to +-- | one mentioned in JWTConfig. +-- | If x-hasura-allowed-roles is not present, then the JWT claim should contain +-- | x-hasura-role +-- | Finally, return the deduced role and the claim converted to metadata +parseRoleAndMetadata + :: (MonadError QErr m) + => JWTConfig + -> HTTP.RequestHeaders + -> Maybe [RoleName] -- allowed roles + -> A.Object -- the JWT claims + -> m (RoleName, Map.HashMap T.Text T.Text) +parseRoleAndMetadata conf headers mAllowedRoles claimsMap = + case mAllowedRoles of + Just allowedRoles -> do + -- if allowed roles present, check if current role is part of that. + -- current role: check if role is present in header, else pick default + -- role from jwt config + when (getCurrentRole `notElem` allowedRoles) currRoleNotAllowed + let finalClaims = Map.delete "x-hasura-allowed-roles" claimsMap + -- transform the map of text:aeson-value -> text:text + metadata <- decodeJSON $ A.Object finalClaims + let md = Map.insert "x-hasura-role" (getRoleTxt getCurrentRole) metadata + return (getCurrentRole, md) + + -- no allowed roles present, convert the claims and try to assert user role + -- is present + Nothing -> do + -- transform the map of text:aeson-value -> text:text + metadata <- decodeJSON $ A.Object claimsMap + let mRole = Map.lookup userRoleHeader metadata + -- throw error if role is not in claims + role <- maybe missingRoleClaim return mRole + return (RoleName role, metadata) + + where + -- see if there is a x-hasura-role header, or else pick the default role + -- from conf + getCurrentRole = + let userRoleHeaderB = TE.encodeUtf8 userRoleHeader + mUserRole = snd <$> find (\h -> fst h == CI.mk userRoleHeaderB) headers + in RoleName $ maybe (jcDefaultRole conf) bsToTxt mUserRole + + decodeJSON val = case A.fromJSON val of + A.Error e -> throw400 JWTInvalidClaims ("x-hasura-* claims: " <> T.pack e) + A.Success a -> return a + + currRoleNotAllowed = + throw400 AccessDenied "Your current role is not in allowed roles" + missingRoleClaim = + let msg = "JWT claim does not contain " <> userRoleHeader <> " or x-hasura-allowed-roles" + in throw400 JWTRoleClaimMissing msg + +-- | Verify the JWT against given JWK verifyJwt :: ( MonadError JWTError m , MonadIO m @@ -106,48 +175,50 @@ verifyJwt -> m ClaimsSet verifyJwt key rawJWT = do jwt <- decodeCompact rawJWT -- decode JWT - t <- liftIO getCurrentTime + t <- liftIO getCurrentTime verifyClaimsAt config key t jwt where audCheck = const True -- we ignore the audience check? config = defaultJWTValidationSettings audCheck --- HGE's own representation of various JWKs +-- | HGE's own representation of various JWKs data JWTConfig = JWTConfig - { jcType :: !T.Text - , jcKey :: !JWK + { jcType :: !T.Text + , jcKey :: !JWK + , jcDefaultRole :: !T.Text } deriving (Show, Eq) -- | Parse from a json string like: --- | `{"type": "RS256", "key": ""}` +-- | `{"type": "RS256", "key": "", "default_role": "user"}` -- | to JWTConfig instance A.FromJSON JWTConfig where parseJSON = A.withObject "JWTConfig" $ \o -> do keyType <- o A..: "type" rawKey <- o A..: "key" + defaultRole <- o A..: "default_role" case keyType of - "HS256" -> parseHmacKey keyType rawKey 256 - "HS384" -> parseHmacKey keyType rawKey 384 - "HS512" -> parseHmacKey keyType rawKey 512 - "RS256" -> parseRsaKey keyType rawKey - "RS384" -> parseRsaKey keyType rawKey - "RS512" -> parseRsaKey keyType rawKey + "HS256" -> parseHmacKey rawKey 256 keyType defaultRole + "HS384" -> parseHmacKey rawKey 384 keyType defaultRole + "HS512" -> parseHmacKey rawKey 512 keyType defaultRole + "RS256" -> parseRsaKey rawKey keyType defaultRole + "RS384" -> parseRsaKey rawKey keyType defaultRole + "RS512" -> parseRsaKey rawKey keyType defaultRole -- TODO: support ES256, ES384, ES512, PS256, PS384 _ -> invalidJwk ("Key type: " <> T.unpack keyType <> " not supported") where - parseHmacKey ktype key size = do + parseHmacKey key size ktype role = do let secret = BL.fromStrict $ TE.encodeUtf8 key when (BL.length secret < size `div` 8) $ invalidJwk "Key size too small" - return $ JWTConfig ktype $ fromOctets secret + return $ JWTConfig ktype (fromOctets secret) role - parseRsaKey ktype key = do + parseRsaKey key ktype role = do let res = fromRawPem (BL.fromStrict $ TE.encodeUtf8 key) err e = "Could not decode PEM: " <> T.unpack e - either (invalidJwk . err) (return . JWTConfig ktype) res + either (invalidJwk . err) (\k -> return $ JWTConfig ktype k role) res invalidJwk msg = fail ("Invalid JWK: " <> msg) @@ -168,7 +239,7 @@ fromRawPem bs = -- pubKeyToJwk <=< fromPkcsPem fromPkcsPem :: BL.ByteString -> Either Text X509.PubKey fromPkcsPem bs = do pems <- fmapL T.pack $ PEM.pemParseLBS bs - pem <- getAtleastOnePem pems + pem <- getAtleastOne "No pem found" pems res <- fmapL asn1ErrToText $ decodeASN1' DER $ PEM.pemContent pem case res of -- PKCS#1 format @@ -189,7 +260,7 @@ fromX509Pem s = do -- try to parse bytestring to a [PEM] pems <- fmapL T.pack $ PEM.pemParseLBS s -- fail if [PEM] is empty - pem <- getAtleastOnePem pems + pem <- getAtleastOne "No pem found" pems -- decode the bytestring to a certificate signedExactCert <- fmapL T.pack $ X509.decodeSignedCertificate $ PEM.pemContent pem @@ -217,9 +288,9 @@ fmapL :: (a -> a') -> Either a b -> Either a' b fmapL fn (Left e) = Left (fn e) fmapL _ (Right x) = pure x -getAtleastOnePem :: [PEM.PEM] -> Either Text PEM.PEM -getAtleastOnePem [] = Left "No pem found" -getAtleastOnePem (x:_) = Right x +getAtleastOne :: Text -> [a] -> Either Text a +getAtleastOne err [] = Left err +getAtleastOne _ (x:_) = Right x calculateSize :: Integer -> Int calculateSize = go 1 diff --git a/server/src-lib/Hasura/Server/Utils.hs b/server/src-lib/Hasura/Server/Utils.hs index 69e708e0decf1..b7931a850cc35 100644 --- a/server/src-lib/Hasura/Server/Utils.hs +++ b/server/src-lib/Hasura/Server/Utils.hs @@ -9,12 +9,16 @@ import Network.URI import System.Exit import System.Process +import qualified Data.ByteString as B import qualified Data.Text as T +import qualified Data.Text.Encoding as TE +import qualified Data.Text.Encoding.Error as TE import qualified Data.Text.IO as TI import qualified Language.Haskell.TH.Syntax as TH import Hasura.Prelude + dropAndSnakeCase :: T.Text -> T.Text dropAndSnakeCase = T.drop 9 . toSnakeCase . T.toLower @@ -36,6 +40,9 @@ userRoleHeader = "x-hasura-role" accessKeyHeader :: T.Text accessKeyHeader = "x-hasura-access-key" +bsToTxt :: B.ByteString -> T.Text +bsToTxt = TE.decodeUtf8With TE.lenientDecode + -- Parsing postgres database url -- from: https://github.com/futurice/postgresql-simple-url/ parseDatabaseUrl :: String -> Maybe String -> Maybe Q.ConnInfo From 08515acc4d807f40089afd5461a968b3f410bad0 Mon Sep 17 00:00:00 2001 From: Anon Ray Date: Tue, 28 Aug 2018 16:17:01 +0530 Subject: [PATCH 11/13] minor refactor in jwt auth --- server/src-lib/Hasura/Server/Auth/JWT.hs | 23 +++++++++-------------- 1 file changed, 9 insertions(+), 14 deletions(-) diff --git a/server/src-lib/Hasura/Server/Auth/JWT.hs b/server/src-lib/Hasura/Server/Auth/JWT.hs index c5d051227bed0..9e3ee27df667a 100644 --- a/server/src-lib/Hasura/Server/Auth/JWT.hs +++ b/server/src-lib/Hasura/Server/Auth/JWT.hs @@ -1,7 +1,6 @@ -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE GeneralizedNewtypeDeriving #-} -{-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedStrings #-} module Hasura.Server.Auth.JWT ( processJwt @@ -41,10 +40,6 @@ import qualified Network.HTTP.Types as HTTP type RawJWT = BL.ByteString -newtype AllowedRoles - = AllowedRoles { getAllowedRoles :: [RoleName] } - deriving (Show, Eq, A.FromJSON) - -- | Process the request headers to verify the JWT and extract UserInfo from it processJwt @@ -64,7 +59,9 @@ processJwt conf headers = do let claimsMap = Map.filterWithKey (\k _ -> T.isPrefixOf "x-hasura-" k) $ claims ^. unregisteredClaims + -- try to parse x-hasura-allowed-roles allowedRoles <- parseAllowedRoles claimsMap + -- deduce the role and metadata from given conf, headers and jwt claims (role, metadata) <- parseRoleAndMetadata conf headers allowedRoles claimsMap -- delete the x-hasura-access-key from this map @@ -99,9 +96,7 @@ parseAllowedRoles => A.Object -> m (Maybe [RoleName]) parseAllowedRoles claimsMap = do let allowedRoles = Map.lookup "x-hasura-allowed-roles" claimsMap - case A.fromJSON <$> allowedRoles of - Nothing -> return Nothing - Just ar -> parseRes ar + mapM parseRes $ A.fromJSON <$> allowedRoles where parseRes r = case r of @@ -152,7 +147,7 @@ parseRoleAndMetadata conf headers mAllowedRoles claimsMap = getCurrentRole = let userRoleHeaderB = TE.encodeUtf8 userRoleHeader mUserRole = snd <$> find (\h -> fst h == CI.mk userRoleHeaderB) headers - in RoleName $ maybe (jcDefaultRole conf) bsToTxt mUserRole + in maybe (jcDefaultRole conf) (RoleName . bsToTxt) mUserRole decodeJSON val = case A.fromJSON val of A.Error e -> throw400 JWTInvalidClaims ("x-hasura-* claims: " <> T.pack e) @@ -187,7 +182,7 @@ data JWTConfig = JWTConfig { jcType :: !T.Text , jcKey :: !JWK - , jcDefaultRole :: !T.Text + , jcDefaultRole :: !RoleName } deriving (Show, Eq) -- | Parse from a json string like: @@ -207,7 +202,7 @@ instance A.FromJSON JWTConfig where "RS384" -> parseRsaKey rawKey keyType defaultRole "RS512" -> parseRsaKey rawKey keyType defaultRole -- TODO: support ES256, ES384, ES512, PS256, PS384 - _ -> invalidJwk ("Key type: " <> T.unpack keyType <> " not supported") + _ -> invalidJwk ("Key type: " <> T.unpack keyType <> " is not supported") where parseHmacKey key size ktype role = do let secret = BL.fromStrict $ TE.encodeUtf8 key From 1b2ad21f161ef24234a3ce417d24cac5880679ef Mon Sep 17 00:00:00 2001 From: Anon Ray Date: Tue, 28 Aug 2018 22:16:05 +0530 Subject: [PATCH 12/13] default role, when using allowed roles, should come from the jwt claims --- server/src-lib/Hasura/RQL/Types/Error.hs | 2 +- server/src-lib/Hasura/Server/Auth/JWT.hs | 173 +++++++++++------------ 2 files changed, 86 insertions(+), 89 deletions(-) diff --git a/server/src-lib/Hasura/RQL/Types/Error.hs b/server/src-lib/Hasura/RQL/Types/Error.hs index 28bb63cd8626c..2974359f24ffe 100644 --- a/server/src-lib/Hasura/RQL/Types/Error.hs +++ b/server/src-lib/Hasura/RQL/Types/Error.hs @@ -105,7 +105,7 @@ instance Show Code where show AlreadyInit = "already-initialised" show NoTables = "no-tables" show ValidationFailed = "validation-failed" - show JWTRoleClaimMissing = "jwt-role-claim-missing" + show JWTRoleClaimMissing = "jwt-missing-role-claims" show JWTInvalidClaims = "jwt-invalid-claims" show JWTInvalid = "invalid-jwt" show JWTInvalidKey = "invalid-jwt-key" diff --git a/server/src-lib/Hasura/Server/Auth/JWT.hs b/server/src-lib/Hasura/Server/Auth/JWT.hs index 9e3ee27df667a..8e4f02d109f1a 100644 --- a/server/src-lib/Hasura/Server/Auth/JWT.hs +++ b/server/src-lib/Hasura/Server/Auth/JWT.hs @@ -1,6 +1,7 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TemplateHaskell #-} module Hasura.Server.Auth.JWT ( processJwt @@ -27,6 +28,9 @@ import Hasura.Server.Utils (accessKeyHeader, bsToTxt, userRoleHeader) import qualified Data.Aeson as A +import qualified Data.Aeson.Casing as A +import qualified Data.Aeson.TH as A + import qualified Data.ByteString.Lazy as BL import qualified Data.ByteString.Lazy.Char8 as BLC import qualified Data.CaseInsensitive as CI @@ -40,6 +44,25 @@ import qualified Network.HTTP.Types as HTTP type RawJWT = BL.ByteString +data HasuraClaims + = HasuraClaims + { _cmAllowedRoles :: ![RoleName] + , _cmDefaultRole :: !RoleName + } deriving (Show, Eq) +$(A.deriveJSON (A.aesonDrop 3 A.snakeCase) ''HasuraClaims) + +-- | HGE's own representation of various JWKs +data JWTConfig + = JWTConfig + { jcType :: !T.Text + , jcKey :: !JWK + } deriving (Show, Eq) + +allowedRolesClaim :: T.Text +allowedRolesClaim = "x-hasura-allowed-roles" + +defaultRoleClaim :: T.Text +defaultRoleClaim = "x-hasura-default-role" -- | Process the request headers to verify the JWT and extract UserInfo from it processJwt @@ -59,14 +82,21 @@ processJwt conf headers = do let claimsMap = Map.filterWithKey (\k _ -> T.isPrefixOf "x-hasura-" k) $ claims ^. unregisteredClaims - -- try to parse x-hasura-allowed-roles - allowedRoles <- parseAllowedRoles claimsMap - -- deduce the role and metadata from given conf, headers and jwt claims - (role, metadata) <- parseRoleAndMetadata conf headers allowedRoles claimsMap + HasuraClaims allowedRoles defaultRole <- parseHasuraClaims claimsMap + let role = getCurrentRole defaultRole + + when (role `notElem` allowedRoles) currRoleNotAllowed + let finalClaims = + Map.delete defaultRoleClaim . Map.delete allowedRolesClaim $ claimsMap + + -- transform the map of text:aeson-value -> text:text + metadata <- decodeJSON $ A.Object finalClaims + + -- delete the x-hasura-access-key from this map, and insert x-hasura-role + let hasuraMd = Map.insert userRoleHeader (getRoleTxt role) $ + Map.delete accessKeyHeader metadata - -- delete the x-hasura-access-key from this map - let finalMetadata = Map.delete accessKeyHeader metadata - return $ UserInfo role finalMetadata + return $ UserInfo role hasuraMd where parseAuthzHeader = do @@ -77,6 +107,16 @@ processJwt conf headers = do ["Bearer", jwt] -> return jwt _ -> malformedAuthzHeader + -- see if there is a x-hasura-role header, or else pick the default role + getCurrentRole defaultRole = + let userRoleHeaderB = TE.encodeUtf8 userRoleHeader + mUserRole = snd <$> find (\h -> fst h == CI.mk userRoleHeaderB) headers + in maybe defaultRole (RoleName . bsToTxt) mUserRole + + decodeJSON val = case A.fromJSON val of + A.Error e -> throw400 JWTInvalidClaims ("x-hasura-* claims: " <> T.pack e) + A.Success a -> return a + liftJWTError :: (MonadError e' m) => (e -> e') -> ExceptT e m a -> m a liftJWTError ef action = do res <- runExceptT action @@ -89,76 +129,42 @@ processJwt conf headers = do throw400 InvalidHeaders "Malformed Authorization header" missingAuthzHeader = throw400 InvalidHeaders "Missing Authorization header in JWT authentication mode" + currRoleNotAllowed = + throw400 AccessDenied "Your current role is not in allowed roles" + --- parse x-hasura-allowed-roles from JWT claims -parseAllowedRoles +-- parse x-hasura-allowed-roles, x-hasura-default-role from JWT claims +parseHasuraClaims :: (MonadError QErr m) - => A.Object -> m (Maybe [RoleName]) -parseAllowedRoles claimsMap = do - let allowedRoles = Map.lookup "x-hasura-allowed-roles" claimsMap - mapM parseRes $ A.fromJSON <$> allowedRoles - where - parseRes r = - case r of - A.Success val -> return val - A.Error _ -> throw400 JWTInvalidClaims "invalid x-hasura-allowed-roles; should be a list of roles" + => A.Object -> m HasuraClaims +parseHasuraClaims claimsMap = do + let mAllowedRolesV = Map.lookup allowedRolesClaim claimsMap + allowedRolesV <- maybe missingAllowedRolesClaim return mAllowedRolesV + allowedRoles <- parseJwtClaim (A.fromJSON allowedRolesV) errMsg + let mDefaultRoleV = Map.lookup defaultRoleClaim claimsMap + defaultRoleV <- maybe missingDefaultRoleClaim return mDefaultRoleV + defaultRole <- parseJwtClaim (A.fromJSON defaultRoleV) errMsg --- | Meat of the logic of JWT authz. Determine if x-hasura-allowed-roles is --- | there, then parse that and assert if user's current role is in that list. User's --- | current role comes from request header x-hasura-role if found or defaults to --- | one mentioned in JWTConfig. --- | If x-hasura-allowed-roles is not present, then the JWT claim should contain --- | x-hasura-role --- | Finally, return the deduced role and the claim converted to metadata -parseRoleAndMetadata - :: (MonadError QErr m) - => JWTConfig - -> HTTP.RequestHeaders - -> Maybe [RoleName] -- allowed roles - -> A.Object -- the JWT claims - -> m (RoleName, Map.HashMap T.Text T.Text) -parseRoleAndMetadata conf headers mAllowedRoles claimsMap = - case mAllowedRoles of - Just allowedRoles -> do - -- if allowed roles present, check if current role is part of that. - -- current role: check if role is present in header, else pick default - -- role from jwt config - when (getCurrentRole `notElem` allowedRoles) currRoleNotAllowed - let finalClaims = Map.delete "x-hasura-allowed-roles" claimsMap - -- transform the map of text:aeson-value -> text:text - metadata <- decodeJSON $ A.Object finalClaims - let md = Map.insert "x-hasura-role" (getRoleTxt getCurrentRole) metadata - return (getCurrentRole, md) - - -- no allowed roles present, convert the claims and try to assert user role - -- is present - Nothing -> do - -- transform the map of text:aeson-value -> text:text - metadata <- decodeJSON $ A.Object claimsMap - let mRole = Map.lookup userRoleHeader metadata - -- throw error if role is not in claims - role <- maybe missingRoleClaim return mRole - return (RoleName role, metadata) + return $ HasuraClaims allowedRoles defaultRole where - -- see if there is a x-hasura-role header, or else pick the default role - -- from conf - getCurrentRole = - let userRoleHeaderB = TE.encodeUtf8 userRoleHeader - mUserRole = snd <$> find (\h -> fst h == CI.mk userRoleHeaderB) headers - in maybe (jcDefaultRole conf) (RoleName . bsToTxt) mUserRole - - decodeJSON val = case A.fromJSON val of - A.Error e -> throw400 JWTInvalidClaims ("x-hasura-* claims: " <> T.pack e) - A.Success a -> return a + missingAllowedRolesClaim = + let msg = "JWT claim does not contain " <> allowedRolesClaim + in throw400 JWTRoleClaimMissing msg - currRoleNotAllowed = - throw400 AccessDenied "Your current role is not in allowed roles" - missingRoleClaim = - let msg = "JWT claim does not contain " <> userRoleHeader <> " or x-hasura-allowed-roles" + missingDefaultRoleClaim = + let msg = "JWT claim does not contain " <> defaultRoleClaim in throw400 JWTRoleClaimMissing msg + errMsg _ = "invalid " <> allowedRolesClaim <> "; should be a list of roles" + + parseJwtClaim :: (MonadError QErr m) => A.Result a -> (String -> Text) -> m a + parseJwtClaim res errFn = + case res of + A.Success val -> return val + A.Error e -> throw400 JWTInvalidClaims $ errFn e + -- | Verify the JWT against given JWK verifyJwt @@ -177,43 +183,34 @@ verifyJwt key rawJWT = do config = defaultJWTValidationSettings audCheck --- | HGE's own representation of various JWKs -data JWTConfig - = JWTConfig - { jcType :: !T.Text - , jcKey :: !JWK - , jcDefaultRole :: !RoleName - } deriving (Show, Eq) - -- | Parse from a json string like: --- | `{"type": "RS256", "key": "", "default_role": "user"}` +-- | `{"type": "RS256", "key": ""}` -- | to JWTConfig instance A.FromJSON JWTConfig where parseJSON = A.withObject "JWTConfig" $ \o -> do keyType <- o A..: "type" rawKey <- o A..: "key" - defaultRole <- o A..: "default_role" case keyType of - "HS256" -> parseHmacKey rawKey 256 keyType defaultRole - "HS384" -> parseHmacKey rawKey 384 keyType defaultRole - "HS512" -> parseHmacKey rawKey 512 keyType defaultRole - "RS256" -> parseRsaKey rawKey keyType defaultRole - "RS384" -> parseRsaKey rawKey keyType defaultRole - "RS512" -> parseRsaKey rawKey keyType defaultRole + "HS256" -> parseHmacKey rawKey 256 keyType + "HS384" -> parseHmacKey rawKey 384 keyType + "HS512" -> parseHmacKey rawKey 512 keyType + "RS256" -> parseRsaKey rawKey keyType + "RS384" -> parseRsaKey rawKey keyType + "RS512" -> parseRsaKey rawKey keyType -- TODO: support ES256, ES384, ES512, PS256, PS384 _ -> invalidJwk ("Key type: " <> T.unpack keyType <> " is not supported") where - parseHmacKey key size ktype role = do + parseHmacKey key size ktype = do let secret = BL.fromStrict $ TE.encodeUtf8 key when (BL.length secret < size `div` 8) $ invalidJwk "Key size too small" - return $ JWTConfig ktype (fromOctets secret) role + return $ JWTConfig ktype (fromOctets secret) - parseRsaKey key ktype role = do + parseRsaKey key ktype = do let res = fromRawPem (BL.fromStrict $ TE.encodeUtf8 key) err e = "Could not decode PEM: " <> T.unpack e - either (invalidJwk . err) (\k -> return $ JWTConfig ktype k role) res + either (invalidJwk . err) (return . JWTConfig ktype) res invalidJwk msg = fail ("Invalid JWK: " <> msg) From d59e3f42029cf2b3c848c481660078a565676dac Mon Sep 17 00:00:00 2001 From: Anon Ray Date: Thu, 30 Aug 2018 13:32:16 +0530 Subject: [PATCH 13/13] change access key and webhook to newtypes --- server/src-exec/Main.hs | 11 ++++++----- server/src-lib/Hasura/Server/Auth.hs | 21 ++++++++++++++------- server/src-lib/Hasura/Server/Init.hs | 18 ++++++++++-------- 3 files changed, 30 insertions(+), 20 deletions(-) diff --git a/server/src-exec/Main.hs b/server/src-exec/Main.hs index de0cc1a973295..0f0081bdd74c9 100644 --- a/server/src-exec/Main.hs +++ b/server/src-exec/Main.hs @@ -26,7 +26,8 @@ import Hasura.Logging (defaultLoggerSettings, mkLoggerCtx) import Hasura.Prelude import Hasura.RQL.DDL.Metadata (fetchMetadata) import Hasura.Server.App (mkWaiApp) -import Hasura.Server.Auth (AccessKey, AuthMode (..), Webhook) +import Hasura.Server.Auth (AccessKey (..), AuthMode (..), + Webhook (..)) import Hasura.Server.CheckUpdates (checkForUpdates) import Hasura.Server.Init @@ -96,7 +97,7 @@ printJSON = BLC.putStrLn . A.encode printYaml :: (A.ToJSON a) => a -> IO () printYaml = BC.putStrLn . Y.encode -mkAuthMode :: Maybe AccessKey -> Maybe T.Text -> Maybe T.Text -> Either String AuthMode +mkAuthMode :: Maybe AccessKey -> Maybe Webhook -> Maybe T.Text -> Either String AuthMode mkAuthMode mAccessKey mWebHook mJwtSecret = case (mAccessKey, mWebHook, mJwtSecret) of (Nothing, Nothing, Nothing) -> return AMNoAuth @@ -129,11 +130,11 @@ main = do httpManager <- HTTP.newManager HTTP.tlsManagerSettings case ravenMode of ROServe (ServeOptions port cp isoL mRootDir mAccessKey corsCfg mWebHook mJwtSecret enableConsole) -> do - mFinalAccessKey <- considerEnv "HASURA_GRAPHQL_ACCESS_KEY" mAccessKey - mFinalWebHook <- considerEnv "HASURA_GRAPHQL_AUTH_HOOK" mWebHook + mFinalAccessKey <- considerEnv "HASURA_GRAPHQL_ACCESS_KEY" $ getAccessKey <$> mAccessKey + mFinalWebHook <- considerEnv "HASURA_GRAPHQL_AUTH_HOOK" $ getWebhook <$> mWebHook mFinalJwtSecret <- considerEnv "HASURA_GRAPHQL_JWT_SECRET" mJwtSecret am <- either ((>> exitFailure) . putStrLn) return $ - mkAuthMode mFinalAccessKey mFinalWebHook mFinalJwtSecret + mkAuthMode (AccessKey <$> mFinalAccessKey) (Webhook <$> mFinalWebHook) mFinalJwtSecret finalCorsDomain <- fromMaybe "*" <$> considerEnv "HASURA_GRAPHQL_CORS_DOMAIN" (ccDomain corsCfg) let finalCorsCfg = CorsConfigG finalCorsDomain $ ccDisabled corsCfg diff --git a/server/src-lib/Hasura/Server/Auth.hs b/server/src-lib/Hasura/Server/Auth.hs index 9deefeed28fb1..b1437d9bf6fb1 100644 --- a/server/src-lib/Hasura/Server/Auth.hs +++ b/server/src-lib/Hasura/Server/Auth.hs @@ -9,8 +9,8 @@ module Hasura.Server.Auth ( getUserInfo , AuthMode(..) - , AccessKey - , Webhook + , AccessKey (..) + , Webhook (..) , RawJWT , JWTConfig (..) , processJwt @@ -37,8 +37,13 @@ import Hasura.Server.Utils import qualified Hasura.Logging as L -type AccessKey = T.Text -type Webhook = T.Text +newtype AccessKey + = AccessKey { getAccessKey :: T.Text } + deriving (Show, Eq) + +newtype Webhook + = Webhook {getWebhook :: T.Text} + deriving (Show, Eq) data AuthMode = AMNoAuth @@ -94,16 +99,17 @@ userInfoFromWebhook :: (MonadIO m, MonadError QErr m) => WebHookLogger -> H.Manager - -> T.Text + -> Webhook -> [N.Header] -> m UserInfo -userInfoFromWebhook logger manager urlT reqHeaders = do +userInfoFromWebhook logger manager hook reqHeaders = do let options = Wreq.defaults & Wreq.headers .~ filteredHeaders & Wreq.checkResponse ?~ (\_ _ -> return ()) & Wreq.manager .~ Right manager + urlT = getWebhook hook res <- liftIO $ try $ Wreq.getWith options $ T.unpack urlT resp <- either logAndThrow return res let status = resp ^. Wreq.responseStatus @@ -112,6 +118,7 @@ userInfoFromWebhook logger manager urlT reqHeaders = do mkUserInfoFromResp logger urlT status respBody where logAndThrow err = do + let urlT = getWebhook hook liftIO $ logger $ WebHookLog L.LevelError Nothing urlT (Just err) Nothing throw500 "Internal Server Error" @@ -165,5 +172,5 @@ getUserInfo logger manager rawHeaders = \case Nothing -> UserInfo adminRole M.empty userInfoWhenAccessKey key reqKey = do - when (reqKey /= key) $ throw401 $ "invalid " <> accessKeyHeader + when (reqKey /= getAccessKey key) $ throw401 $ "invalid " <> accessKeyHeader return userInfoFromHeaders diff --git a/server/src-lib/Hasura/Server/Init.hs b/server/src-lib/Hasura/Server/Init.hs index f2e778af8aa78..276b67cb8cdbf 100644 --- a/server/src-lib/Hasura/Server/Init.hs +++ b/server/src-lib/Hasura/Server/Init.hs @@ -157,17 +157,19 @@ parseServerPort = parseAccessKey :: Parser (Maybe AccessKey) parseAccessKey = - optional $ strOption ( long "access-key" <> - metavar "SECRET ACCESS KEY" <> - help "Secret access key, required to access this instance" - ) + optional $ AccessKey <$> + strOption ( long "access-key" <> + metavar "SECRET ACCESS KEY" <> + help "Secret access key, required to access this instance" + ) parseWebHook :: Parser (Maybe Webhook) parseWebHook = - optional $ strOption ( long "auth-hook" <> - metavar "AUTHENTICATION WEB HOOK" <> - help "The authentication webhook, required to authenticate requests" - ) + optional $ Webhook <$> + strOption ( long "auth-hook" <> + metavar "AUTHENTICATION WEB HOOK" <> + help "The authentication webhook, required to authenticate requests" + ) parseJwtSecret :: Parser (Maybe Text)