From dd7a9c2bde9042d787f6ec21969f98305afe0a0d Mon Sep 17 00:00:00 2001 From: Anon Ray Date: Fri, 24 Jan 2020 18:41:14 +0530 Subject: [PATCH 1/4] fix JWK cache-control header regression (fix #3655) - fix when header parsing fails on startup, do not exit - change qualified import of aeson in Auth.JWT from A to J to be consistent with the rest of the codebase --- server/src-lib/Hasura/Server/Auth.hs | 39 +++-- server/src-lib/Hasura/Server/Auth/JWT.hs | 141 +++++++++--------- .../src-lib/Hasura/Server/Auth/JWT/Logging.hs | 86 +++++++---- 3 files changed, 153 insertions(+), 113 deletions(-) diff --git a/server/src-lib/Hasura/Server/Auth.hs b/server/src-lib/Hasura/Server/Auth.hs index 0588c5620b3ca..423710550f391 100644 --- a/server/src-lib/Hasura/Server/Auth.hs +++ b/server/src-lib/Hasura/Server/Auth.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE RecordWildCards #-} module Hasura.Server.Auth ( getUserInfo , getUserInfoWithExpTime @@ -119,6 +120,7 @@ mkAuthMode mAdminSecret mWebHook mJwtSecret mUnAuthRole httpManager logger = "Fatal Error: --unauthorized-role (HASURA_GRAPHQL_UNAUTHORIZED_ROLE) is not allowed" <> " when --auth-hook (HASURA_GRAPHQL_AUTH_HOOK) is set" +-- | Given the 'JWTConfig' (the user input of JWT configuration), create the 'JWTCtx' (the runtime JWT config used) mkJwtCtx :: ( HasVersion , MonadIO m @@ -128,20 +130,37 @@ mkJwtCtx -> H.Manager -> Logger Hasura -> m JWTCtx -mkJwtCtx conf httpManager logger = do - jwkRef <- case jcKeyOrUrl conf of +mkJwtCtx JWTConfig{..} httpManager logger = do + jwkRef <- case jcKeyOrUrl of Left jwk -> liftIO $ newIORef (JWKSet [jwk]) - Right url -> do + Right url -> getJwkFromUrl url + let claimsFmt = fromMaybe JCFJson jcClaimsFormat + return $ JWTCtx jwkRef jcClaimNs jcAudience claimsFmt jcIssuer + where + -- if we can't find any expiry time for the JWK (either in @Expires@ header or @Cache-Control@ + -- header), do not start a background thread for refreshing the JWK + getJwkFromUrl url = do ref <- liftIO $ newIORef $ JWKSet [] - mTime <- updateJwkRef logger httpManager url ref - case mTime of - Nothing -> return ref - Just t -> do - jwkRefreshCtrl logger httpManager url ref t + maybeExpiry <- withJwkError $ updateJwkRef logger httpManager url ref + case maybeExpiry of + Nothing -> return ref + Just time -> do + jwkRefreshCtrl logger httpManager url ref time return ref - let claimsFmt = fromMaybe JCFJson (jcClaimsFormat conf) - return $ JWTCtx jwkRef (jcClaimNs conf) (jcAudience conf) claimsFmt (jcIssuer conf) + withJwkError act = do + res <- runExceptT act + case res of + Right r -> return r + Left err -> case err of + -- when fetching JWK initially, except expiry parsing error, all errors are critical + JFEHttpException _ msg -> throwError msg + JFEHttpError _ _ _ e -> throwError e + JFEJwkParseError _ e -> throwError e + JFEExpiryParseError _ _ -> return Nothing + + +-- | Form the 'UserInfo' from the response from webhook mkUserInfoFromResp :: (MonadIO m, MonadError QErr m) => Logger Hasura diff --git a/server/src-lib/Hasura/Server/Auth/JWT.hs b/server/src-lib/Hasura/Server/Auth/JWT.hs index 68a84a5bcfbcb..1537ec9e6246b 100644 --- a/server/src-lib/Hasura/Server/Auth/JWT.hs +++ b/server/src-lib/Hasura/Server/Auth/JWT.hs @@ -5,6 +5,7 @@ module Hasura.Server.Auth.JWT , JWTCtx (..) , Jose.JWKSet (..) , JWTClaimsFormat (..) + , JwkFetchError (..) , updateJwkRef , jwkRefreshCtrl , defaultClaimNs @@ -13,7 +14,7 @@ module Hasura.Server.Auth.JWT import Control.Exception (try) import Control.Lens import Control.Monad (when) -import Data.IORef (IORef, modifyIORef, readIORef) +import Data.IORef (IORef, readIORef, writeIORef) import Data.List (find) import Data.Parser.CacheControl (parseMaxAge) import Data.Time.Clock (NominalDiffTime, UTCTime, diffUTCTime, @@ -32,9 +33,9 @@ import Hasura.Server.Version (HasVersion) import qualified Control.Concurrent as C import qualified Crypto.JWT as Jose -import qualified Data.Aeson as A -import qualified Data.Aeson.Casing as A -import qualified Data.Aeson.TH as A +import qualified Data.Aeson as J +import qualified Data.Aeson.Casing as J +import qualified Data.Aeson.TH as J import qualified Data.ByteString.Lazy as BL import qualified Data.ByteString.Lazy.Char8 as BLC import qualified Data.CaseInsensitive as CI @@ -54,9 +55,8 @@ data JWTClaimsFormat | JCFStringifiedJson deriving (Show, Eq) -$(A.deriveJSON A.defaultOptions { A.sumEncoding = A.ObjectWithSingleField - , A.constructorTagModifier = A.snakeCase . drop 3 - } ''JWTClaimsFormat) +$(J.deriveJSON J.defaultOptions { J.sumEncoding = J.ObjectWithSingleField + , J.constructorTagModifier = J.snakeCase . drop 3 } ''JWTClaimsFormat) data JWTConfig = JWTConfig @@ -86,7 +86,7 @@ data HasuraClaims { _cmAllowedRoles :: ![RoleName] , _cmDefaultRole :: !RoleName } deriving (Show, Eq) -$(A.deriveJSON (A.aesonDrop 3 A.snakeCase) ''HasuraClaims) +$(J.deriveJSON (J.aesonDrop 3 J.snakeCase) ''HasuraClaims) allowedRolesClaim :: T.Text allowedRolesClaim = "x-hasura-allowed-roles" @@ -124,16 +124,15 @@ jwkRefreshCtrl logger manager url ref time = C.threadDelay delay where logNotice = do - let err = JwkRefreshLog LevelInfo (JLNInfo "retrying again in 60 secs") Nothing + let err = JwkRefreshLog LevelInfo (Just "retrying again in 60 secs") Nothing liftIO $ unLogger logger err aSecond = 1000 * 1000 - -- | Given a JWK url, fetch JWK from it and update the IORef updateJwkRef :: ( HasVersion , MonadIO m - , MonadError T.Text m + , MonadError JwkFetchError m ) => Logger Hasura -> HTTP.Manager @@ -143,22 +142,21 @@ updateJwkRef updateJwkRef (Logger logger) manager url jwkRef = do let options = wreqOptions manager [] urlT = T.pack $ show url - infoMsg = JLNInfo $ "refreshing JWK from endpoint: " <> urlT - liftIO $ logger $ JwkRefreshLog LevelInfo infoMsg Nothing + infoMsg = "refreshing JWK from endpoint: " <> urlT + liftIO $ logger $ JwkRefreshLog LevelInfo (Just infoMsg) Nothing res <- liftIO $ try $ Wreq.getWith options $ show url resp <- either logAndThrowHttp return res let status = resp ^. Wreq.responseStatus respBody = resp ^. Wreq.responseBody when (status ^. Wreq.statusCode /= 200) $ do - let respBodyT = Just $ CS.cs respBody - errMsg = "Non-200 response on fetching JWK from: " <> urlT - httpErr = Just (JwkRefreshHttpError (Just status) urlT Nothing respBodyT) - logAndThrow errMsg httpErr + let errMsg = "Non-200 response on fetching JWK from: " <> urlT + err = JFEHttpError url status respBody errMsg + logAndThrow err - let parseErr e = "Error parsing JWK from url (" <> urlT <> "): " <> T.pack e - jwkset <- either (\e -> logAndThrow (parseErr e) Nothing) return $ A.eitherDecode respBody - liftIO $ modifyIORef jwkRef (const jwkset) + let parseErr e = JFEJwkParseError (T.pack e) $ "Error parsing JWK from url: " <> urlT + jwkset <- either (logAndThrow . parseErr) return $ J.eitherDecode respBody + liftIO $ writeIORef jwkRef jwkset -- first check for Cache-Control header to get max-age, if not found, look for Expires header let cacheHeader = resp ^? Wreq.responseHeader "Cache-Control" @@ -170,41 +168,44 @@ updateJwkRef (Logger logger) manager url jwkRef = do where getTimeFromExpiresHeader header = do let maybeExpires = parseTimeM True defaultTimeLocale timeFmt $ CS.cs header - expires <- maybe (logAndThrow parseTimeErr Nothing) return maybeExpires + expires <- either (logAndThrowInfo . parseTimeErr . T.pack) return maybeExpires currTime <- liftIO getCurrentTime return $ diffUTCTime expires currTime getTimeFromCacheControlHeader header = case parseCacheControlHeader (bsToTxt header) of - Left e -> logAndThrow e Nothing + Left e -> logAndThrowInfo e Right maxAge -> return $ Just $ fromInteger maxAge - parseCacheControlHeader = fmapL (const parseCacheControlErr) . parseMaxAge + parseCacheControlHeader = fmapL (parseCacheControlErr . T.pack) . parseMaxAge + + parseCacheControlErr e = + JFEExpiryParseError e "Failed parsing Cache-Control header from JWK response. Could not find max-age or s-maxage" + parseTimeErr e = + JFEExpiryParseError e "Failed parsing Expires header from JWK response. Value of header is not a valid timestamp" - parseCacheControlErr = - "Failed parsing Cache-Control header from JWK response. Could not find max-age or s-maxage" - parseTimeErr = - "Failed parsing Expires header from JWK response. Value of header is not a valid timestamp" + timeFmt = "%a, %d %b %Y %T GMT" - logAndThrow - :: (MonadIO m, MonadError T.Text m) - => T.Text -> Maybe JwkRefreshHttpError -> m a - logAndThrow err httpErr = do - liftIO $ logger $ JwkRefreshLog (LevelOther "critical") (JLNError err) httpErr + logAndThrowInfo :: (MonadIO m, MonadError JwkFetchError m) => JwkFetchError -> m a + logAndThrowInfo err = do + liftIO $ logger $ JwkRefreshLog LevelInfo Nothing (Just err) throwError err - logAndThrowHttp :: (MonadIO m, MonadError T.Text m) => HTTP.HttpException -> m a - logAndThrowHttp err = do - let httpErr = JwkRefreshHttpError Nothing (T.pack $ show url) (Just $ HttpException err) Nothing - errMsg = "Error fetching JWK: " <> T.pack (getHttpExceptionMsg err) - logAndThrow errMsg (Just httpErr) + logAndThrow :: (MonadIO m, MonadError JwkFetchError m) => JwkFetchError -> m a + logAndThrow err = do + liftIO $ logger $ JwkRefreshLog (LevelOther "critical") Nothing (Just err) + throwError err + + logAndThrowHttp :: (MonadIO m, MonadError JwkFetchError m) => HTTP.HttpException -> m a + logAndThrowHttp httpEx = do + let errMsg = "Error fetching JWK: " <> T.pack (getHttpExceptionMsg httpEx) + err = JFEHttpException (HttpException httpEx) errMsg + logAndThrow err getHttpExceptionMsg = \case HTTP.HttpExceptionRequest _ reason -> show reason HTTP.InvalidUrlException _ reason -> show reason - timeFmt = "%a, %d %b %Y %T GMT" - -- | Process the request headers to verify the JWT and extract UserInfo from it processJwt @@ -268,7 +269,7 @@ processAuthZHeader jwtCtx headers authzHeader = do Map.delete defaultRoleClaim . Map.delete allowedRolesClaim $ claimsMap -- transform the map of text:aeson-value -> text:text - metadata <- decodeJSON $ A.Object finalClaims + metadata <- decodeJSON $ J.Object finalClaims return $ (, expTimeM) $ mkUserInfo role $ mkUserVars $ Map.toList metadata @@ -281,12 +282,12 @@ processAuthZHeader jwtCtx headers authzHeader = do parseObjectFromString claimsFmt jVal = case (claimsFmt, jVal) of - (JCFStringifiedJson, A.String v) -> + (JCFStringifiedJson, J.String v) -> either (const $ claimsErr $ strngfyErr v) return - $ A.eitherDecodeStrict $ T.encodeUtf8 v + $ J.eitherDecodeStrict $ T.encodeUtf8 v (JCFStringifiedJson, _) -> claimsErr "expecting a string when claims_format is stringified_json" - (JCFJson, A.Object o) -> return o + (JCFJson, J.Object o) -> return o (JCFJson, _) -> claimsErr "expecting a json object when claims_format is json" @@ -302,9 +303,9 @@ processAuthZHeader jwtCtx headers authzHeader = do mUserRole = snd <$> find (\h -> fst h == CI.mk userRoleHeaderB) headers in maybe defaultRole RoleName $ mUserRole >>= mkNonEmptyText . bsToTxt - decodeJSON val = case A.fromJSON val of - A.Error e -> throw400 JWTInvalidClaims ("x-hasura-* claims: " <> T.pack e) - A.Success a -> return a + decodeJSON val = case J.fromJSON val of + J.Error e -> throw400 JWTInvalidClaims ("x-hasura-* claims: " <> T.pack e) + J.Success a -> return a liftJWTError :: (MonadError e' m) => (e -> e') -> ExceptT e m a -> m a liftJWTError ef action = do @@ -326,15 +327,15 @@ processAuthZHeader jwtCtx headers authzHeader = do -- parse x-hasura-allowed-roles, x-hasura-default-role from JWT claims parseHasuraClaims :: (MonadError QErr m) - => A.Object -> m HasuraClaims + => J.Object -> m HasuraClaims parseHasuraClaims claimsMap = do let mAllowedRolesV = Map.lookup allowedRolesClaim claimsMap allowedRolesV <- maybe missingAllowedRolesClaim return mAllowedRolesV - allowedRoles <- parseJwtClaim (A.fromJSON allowedRolesV) errMsg + allowedRoles <- parseJwtClaim (J.fromJSON allowedRolesV) errMsg let mDefaultRoleV = Map.lookup defaultRoleClaim claimsMap defaultRoleV <- maybe missingDefaultRoleClaim return mDefaultRoleV - defaultRole <- parseJwtClaim (A.fromJSON defaultRoleV) errMsg + defaultRole <- parseJwtClaim (J.fromJSON defaultRoleV) errMsg return $ HasuraClaims allowedRoles defaultRole @@ -349,11 +350,11 @@ parseHasuraClaims claimsMap = do errMsg _ = "invalid " <> allowedRolesClaim <> "; should be a list of roles" - parseJwtClaim :: (MonadError QErr m) => A.Result a -> (String -> Text) -> m a + parseJwtClaim :: (MonadError QErr m) => J.Result a -> (String -> Text) -> m a parseJwtClaim res errFn = case res of - A.Success val -> return val - A.Error e -> throw400 JWTInvalidClaims $ errFn e + J.Success val -> return val + J.Error e -> throw400 JWTInvalidClaims $ errFn e -- | Verify the JWT against given JWK @@ -381,33 +382,33 @@ verifyJwt ctx (RawJWT rawJWT) = do Just (Jose.Audience audiences) -> audience `elem` audiences -instance A.ToJSON JWTConfig where +instance J.ToJSON JWTConfig where toJSON (JWTConfig ty keyOrUrl claimNs aud claimsFmt iss) = case keyOrUrl of - Left _ -> mkObj ("key" A..= A.String "") - Right url -> mkObj ("jwk_url" A..= url) + Left _ -> mkObj ("key" J..= J.String "") + Right url -> mkObj ("jwk_url" J..= url) where - mkObj item = A.object [ "type" A..= ty - , "claims_namespace" A..= claimNs - , "claims_format" A..= claimsFmt - , "audience" A..= aud - , "issuer" A..= iss + mkObj item = J.object [ "type" J..= ty + , "claims_namespace" J..= claimNs + , "claims_format" J..= claimsFmt + , "audience" J..= aud + , "issuer" J..= iss , item ] -- | Parse from a json string like: -- | `{"type": "RS256", "key": ""}` -- | to JWTConfig -instance A.FromJSON JWTConfig where - - parseJSON = A.withObject "JWTConfig" $ \o -> do - keyType <- o A..: "type" - mRawKey <- o A..:? "key" - claimNs <- o A..:? "claims_namespace" - aud <- o A..:? "audience" - iss <- o A..:? "issuer" - jwkUrl <- o A..:? "jwk_url" - isStrngfd <- o A..:? "claims_format" +instance J.FromJSON JWTConfig where + + parseJSON = J.withObject "JWTConfig" $ \o -> do + keyType <- o J..: "type" + mRawKey <- o J..:? "key" + claimNs <- o J..:? "claims_namespace" + aud <- o J..:? "audience" + iss <- o J..:? "issuer" + jwkUrl <- o J..:? "jwk_url" + isStrngfd <- o J..:? "claims_format" case (mRawKey, jwkUrl) of (Nothing, Nothing) -> fail "key and jwk_url both cannot be empty" diff --git a/server/src-lib/Hasura/Server/Auth/JWT/Logging.hs b/server/src-lib/Hasura/Server/Auth/JWT/Logging.hs index 9025f69d246a4..f77cb5f6b58c5 100644 --- a/server/src-lib/Hasura/Server/Auth/JWT/Logging.hs +++ b/server/src-lib/Hasura/Server/Auth/JWT/Logging.hs @@ -1,60 +1,80 @@ module Hasura.Server.Auth.JWT.Logging ( JwkRefreshLog (..) - , JwkRefreshHttpError (..) - , JwkLogNotice (..) + , JwkFetchError (..) ) where import Data.Aeson +import Network.URI (URI) import Hasura.HTTP import Hasura.Logging (EngineLogType (..), Hasura, InternalLogTypes (..), LogLevel (..), ToEngineLog (..)) import Hasura.Prelude import Hasura.Server.Logging () -import Hasura.Server.Utils (httpExceptToJSON) +import qualified Data.ByteString.Lazy as BL import qualified Data.Text as T import qualified Network.HTTP.Types as HTTP -data JwkLogNotice - = JLNInfo !Text - | JLNError !Text +-- | Possible errors during fetching and parsing JWK +data JwkFetchError + = JFEHttpException !HttpException !Text + -- ^ Exception while making the HTTP request. Text is the error message + | JFEHttpError !URI !HTTP.Status !BL.ByteString !Text + -- ^ Non-2xx HTTP errors from the upstream server. Url, status, body and error message + | JFEJwkParseError !Text !Text + -- ^ Error parsing the JWK response itself. Text: Actual parse error and friendly error message + | JFEExpiryParseError !Text !Text + -- ^ Error parsing the expiry of the JWK. Text: Actual parse error and friendly error message deriving (Show) +instance ToJSON JwkFetchError where + toJSON = \case + JFEHttpException e _ -> + object [ "http_exception" .= e ] + + JFEHttpError url status body _ -> + object [ "status_code" .= HTTP.statusCode status + , "url" .= T.pack (show url) + , "response" .= bsToTxt (BL.toStrict body) + ] + + JFEJwkParseError e msg -> + object [ "parse_error" .= e, "message" .= msg ] + + JFEExpiryParseError e msg -> + object [ "parse_error" .= e, "message" .= msg ] + + +-- data JwkRefreshHttpError +-- = JwkRefreshHttpError +-- { jrheStatus :: !(Maybe HTTP.Status) +-- , jrheUrl :: !T.Text +-- , jrheHttpException :: !(Maybe HttpException) +-- , jrheResponse :: !(Maybe T.Text) +-- } deriving (Show) + +-- instance ToJSON JwkRefreshHttpError where +-- toJSON jhe = +-- object [ "status_code" .= (HTTP.statusCode <$> jrheStatus jhe) +-- , "url" .= jrheUrl jhe +-- , "response" .= jrheResponse jhe +-- , "http_exception" .= (httpExceptToJSON . unHttpException <$> jrheHttpException jhe) +-- ] + data JwkRefreshLog = JwkRefreshLog - { jrlLogLevel :: !LogLevel - , jrlNotice :: !JwkLogNotice - , jrlHttpError :: !(Maybe JwkRefreshHttpError) - } deriving (Show) - -data JwkRefreshHttpError - = JwkRefreshHttpError - { jrheStatus :: !(Maybe HTTP.Status) - , jrheUrl :: !T.Text - , jrheHttpException :: !(Maybe HttpException) - , jrheResponse :: !(Maybe T.Text) + { jrlLogLevel :: !LogLevel + , jrlMessage :: !(Maybe Text) + , jrlError :: !(Maybe JwkFetchError) } deriving (Show) -instance ToJSON JwkRefreshHttpError where - toJSON jhe = - object [ "status_code" .= (HTTP.statusCode <$> jrheStatus jhe) - , "url" .= jrheUrl jhe - , "response" .= jrheResponse jhe - , "http_exception" .= (httpExceptToJSON . unHttpException <$> jrheHttpException jhe) - ] - instance ToJSON JwkRefreshLog where - toJSON jrl = case jrlNotice jrl of - JLNInfo info -> - object [ "message" .= info - , "http_error" .= (toJSON <$> jrlHttpError jrl) - ] - JLNError err -> - object [ "error" .= err - , "http_error" .= (toJSON <$> jrlHttpError jrl) + toJSON (JwkRefreshLog _ msg err) = + object [ "message" .= msg + , "error" .= err ] instance ToEngineLog JwkRefreshLog Hasura where From 18b1778bc10af9b5144869adbf8e331cc13871b3 Mon Sep 17 00:00:00 2001 From: Anon Ray Date: Mon, 27 Jan 2020 12:00:48 +0530 Subject: [PATCH 2/4] remove pre-emptive refresh of JWKs - not sure why this was added, but I think it is not required --- server/src-lib/Hasura/Server/Auth/JWT.hs | 19 ++++++------------- .../src-lib/Hasura/Server/Auth/JWT/Logging.hs | 2 +- 2 files changed, 7 insertions(+), 14 deletions(-) diff --git a/server/src-lib/Hasura/Server/Auth/JWT.hs b/server/src-lib/Hasura/Server/Auth/JWT.hs index 1537ec9e6246b..ffb5cac0822a8 100644 --- a/server/src-lib/Hasura/Server/Auth/JWT.hs +++ b/server/src-lib/Hasura/Server/Auth/JWT.hs @@ -97,13 +97,6 @@ defaultRoleClaim = "x-hasura-default-role" defaultClaimNs :: T.Text defaultClaimNs = "https://hasura.io/jwt/claims" --- | if the time is greater than 100 seconds, should refresh the JWK 10 seonds --- before the expiry, else refresh at given seconds -computeDiffTime :: NominalDiffTime -> Int -computeDiffTime t = - let intTime = diffTimeToMicro t - in if intTime > 100 then intTime - 10 else intTime - -- | create a background thread to refresh the JWK jwkRefreshCtrl :: (HasVersion, MonadIO m) @@ -120,7 +113,7 @@ jwkRefreshCtrl logger manager url ref time = res <- runExceptT $ updateJwkRef logger manager url ref mTime <- either (const $ logNotice >> return Nothing) return res -- if can't parse time from header, defaults to 1 min - let delay = maybe (60 * aSecond) computeDiffTime mTime + let delay = maybe (60 * aSecond) diffTimeToMicro mTime C.threadDelay delay where logNotice = do @@ -167,8 +160,8 @@ updateJwkRef (Logger logger) manager url jwkRef = do where getTimeFromExpiresHeader header = do - let maybeExpires = parseTimeM True defaultTimeLocale timeFmt $ CS.cs header - expires <- either (logAndThrowInfo . parseTimeErr . T.pack) return maybeExpires + let maybeExpiry = parseTimeM True defaultTimeLocale timeFmt (CS.cs header) + expires <- maybe (logAndThrowInfo parseTimeErr) return maybeExpiry currTime <- liftIO getCurrentTime return $ diffUTCTime expires currTime @@ -180,9 +173,9 @@ updateJwkRef (Logger logger) manager url jwkRef = do parseCacheControlHeader = fmapL (parseCacheControlErr . T.pack) . parseMaxAge parseCacheControlErr e = - JFEExpiryParseError e "Failed parsing Cache-Control header from JWK response. Could not find max-age or s-maxage" - parseTimeErr e = - JFEExpiryParseError e "Failed parsing Expires header from JWK response. Value of header is not a valid timestamp" + JFEExpiryParseError (Just e) "Failed parsing Cache-Control header from JWK response. Could not find max-age or s-maxage" + parseTimeErr = + JFEExpiryParseError Nothing "Failed parsing Expires header from JWK response. Value of header is not a valid timestamp" timeFmt = "%a, %d %b %Y %T GMT" diff --git a/server/src-lib/Hasura/Server/Auth/JWT/Logging.hs b/server/src-lib/Hasura/Server/Auth/JWT/Logging.hs index f77cb5f6b58c5..8c62dc52920b8 100644 --- a/server/src-lib/Hasura/Server/Auth/JWT/Logging.hs +++ b/server/src-lib/Hasura/Server/Auth/JWT/Logging.hs @@ -26,7 +26,7 @@ data JwkFetchError -- ^ Non-2xx HTTP errors from the upstream server. Url, status, body and error message | JFEJwkParseError !Text !Text -- ^ Error parsing the JWK response itself. Text: Actual parse error and friendly error message - | JFEExpiryParseError !Text !Text + | JFEExpiryParseError !(Maybe Text) !Text -- ^ Error parsing the expiry of the JWK. Text: Actual parse error and friendly error message deriving (Show) From 32539bfe94c0a5f5ddc4a0a34b74b607b5e82fed Mon Sep 17 00:00:00 2001 From: Anon Ray Date: Tue, 28 Jan 2020 19:47:44 +0530 Subject: [PATCH 3/4] add tests --- .circleci/test-server.sh | 22 +++++++++++++ server/src-lib/Hasura/Server/Auth/JWT.hs | 11 ++++--- .../src-lib/Hasura/Server/Auth/JWT/Logging.hs | 33 +++++-------------- server/tests-py/jwk_server.py | 6 ++++ 4 files changed, 43 insertions(+), 29 deletions(-) diff --git a/.circleci/test-server.sh b/.circleci/test-server.sh index e33a5f49d3342..eabd8cd1b4fcc 100755 --- a/.circleci/test-server.sh +++ b/.circleci/test-server.sh @@ -561,6 +561,8 @@ wait_for_port 5001 cache_control_jwk_url='{"type": "RS256", "jwk_url": "http://localhost:5001/jwk-cache-control"}' expires_jwk_url='{"type": "RS256", "jwk_url": "http://localhost:5001/jwk-expires"}' +cc_nomaxage_jwk_url='{"type": "RS256", "jwk_url": "http://localhost:5001/jwk-cache-control?nomaxage"}' +cc_nocache_jwk_url='{"type": "RS256", "jwk_url": "http://localhost:5001/jwk-cache-control?nocache"}' # start HGE with cache control JWK URL export HASURA_GRAPHQL_JWT_SECRET=$cache_control_jwk_url @@ -596,6 +598,26 @@ pytest -n 1 -vv --hge-urls "$HGE_URL" --pg-urls "$HASURA_GRAPHQL_DATABASE_URL" - kill_hge_servers +# start HGE with nomaxage JWK URL +export HASURA_GRAPHQL_JWT_SECRET=$cc_nomaxage_jwk_url +run_hge_with_args serve +wait_for_port 8080 + +pytest -n 1 -vv --hge-urls "$HGE_URL" --pg-urls "$HASURA_GRAPHQL_DATABASE_URL" --hge-key="$HASURA_GRAPHQL_ADMIN_SECRET" --test-jwk-url test_jwk.py -k 'test_cache_control_header' + +kill_hge_servers +unset HASURA_GRAPHQL_JWT_SECRET + +# start HGE with nocache JWK URL +export HASURA_GRAPHQL_JWT_SECRET=$cc_nocache_jwk_url +run_hge_with_args serve +wait_for_port 8080 + +pytest -n 1 -vv --hge-urls "$HGE_URL" --pg-urls "$HASURA_GRAPHQL_DATABASE_URL" --hge-key="$HASURA_GRAPHQL_ADMIN_SECRET" --test-jwk-url test_jwk.py -k 'test_cache_control_header' + +kill_hge_servers +unset HASURA_GRAPHQL_JWT_SECRET + kill $JWKS_PID # end jwk url test diff --git a/server/src-lib/Hasura/Server/Auth/JWT.hs b/server/src-lib/Hasura/Server/Auth/JWT.hs index ffb5cac0822a8..59f7157f90277 100644 --- a/server/src-lib/Hasura/Server/Auth/JWT.hs +++ b/server/src-lib/Hasura/Server/Auth/JWT.hs @@ -141,9 +141,10 @@ updateJwkRef (Logger logger) manager url jwkRef = do resp <- either logAndThrowHttp return res let status = resp ^. Wreq.responseStatus respBody = resp ^. Wreq.responseBody + statusCode = status ^. Wreq.statusCode - when (status ^. Wreq.statusCode /= 200) $ do - let errMsg = "Non-200 response on fetching JWK from: " <> urlT + unless (statusCode >= 200 && statusCode < 300) $ do + let errMsg = "Non-2xx response on fetching JWK from: " <> urlT err = JFEHttpError url status respBody errMsg logAndThrow err @@ -173,9 +174,11 @@ updateJwkRef (Logger logger) manager url jwkRef = do parseCacheControlHeader = fmapL (parseCacheControlErr . T.pack) . parseMaxAge parseCacheControlErr e = - JFEExpiryParseError (Just e) "Failed parsing Cache-Control header from JWK response. Could not find max-age or s-maxage" + JFEExpiryParseError (Just e) + "Failed parsing Cache-Control header from JWK response. Could not find max-age or s-maxage" parseTimeErr = - JFEExpiryParseError Nothing "Failed parsing Expires header from JWK response. Value of header is not a valid timestamp" + JFEExpiryParseError Nothing + "Failed parsing Expires header from JWK response. Value of header is not a valid timestamp" timeFmt = "%a, %d %b %Y %T GMT" diff --git a/server/src-lib/Hasura/Server/Auth/JWT/Logging.hs b/server/src-lib/Hasura/Server/Auth/JWT/Logging.hs index 8c62dc52920b8..bd2216a50ac1e 100644 --- a/server/src-lib/Hasura/Server/Auth/JWT/Logging.hs +++ b/server/src-lib/Hasura/Server/Auth/JWT/Logging.hs @@ -17,17 +17,17 @@ import qualified Data.ByteString.Lazy as BL import qualified Data.Text as T import qualified Network.HTTP.Types as HTTP - -- | Possible errors during fetching and parsing JWK +-- (the 'Text' type at the end is a friendly error message) data JwkFetchError = JFEHttpException !HttpException !Text - -- ^ Exception while making the HTTP request. Text is the error message + -- ^ Exception while making the HTTP request | JFEHttpError !URI !HTTP.Status !BL.ByteString !Text - -- ^ Non-2xx HTTP errors from the upstream server. Url, status, body and error message + -- ^ Non-2xx HTTP errors from the upstream server | JFEJwkParseError !Text !Text - -- ^ Error parsing the JWK response itself. Text: Actual parse error and friendly error message - | JFEExpiryParseError !(Maybe Text) !Text - -- ^ Error parsing the expiry of the JWK. Text: Actual parse error and friendly error message + -- ^ Error parsing the JWK response itself + | JFEExpiryParseError !(Maybe Text) Text + -- ^ Error parsing the expiry of the JWK deriving (Show) instance ToJSON JwkFetchError where @@ -42,27 +42,10 @@ instance ToJSON JwkFetchError where ] JFEJwkParseError e msg -> - object [ "parse_error" .= e, "message" .= msg ] + object [ "error" .= e, "message" .= msg ] JFEExpiryParseError e msg -> - object [ "parse_error" .= e, "message" .= msg ] - - --- data JwkRefreshHttpError --- = JwkRefreshHttpError --- { jrheStatus :: !(Maybe HTTP.Status) --- , jrheUrl :: !T.Text --- , jrheHttpException :: !(Maybe HttpException) --- , jrheResponse :: !(Maybe T.Text) --- } deriving (Show) - --- instance ToJSON JwkRefreshHttpError where --- toJSON jhe = --- object [ "status_code" .= (HTTP.statusCode <$> jrheStatus jhe) --- , "url" .= jrheUrl jhe --- , "response" .= jrheResponse jhe --- , "http_exception" .= (httpExceptToJSON . unHttpException <$> jrheHttpException jhe) --- ] + object [ "error" .= e, "message" .= msg ] data JwkRefreshLog = JwkRefreshLog diff --git a/server/tests-py/jwk_server.py b/server/tests-py/jwk_server.py index e780baac8a0ed..7d9e1fbb09c1d 100644 --- a/server/tests-py/jwk_server.py +++ b/server/tests-py/jwk_server.py @@ -52,8 +52,14 @@ def get(self, request): if request.qs: if 'error' in request.qs and 'true' in request.qs['error']: header_val = 'invalid-header-value=42' + elif 'nocache' in request.qs: + header_val = 'no-cache' + elif 'nomaxage' in request.qs: + header_val = 'public, must-revalidate=123, no-transform' elif 'field' in request.qs and 'smaxage' in request.qs['field']: header_val = 's-maxage=' + self.expires_in_secs + if 'field' in request.qs and 'smaxage' in request.qs['field']: + header_val = 's-maxage=' + self.expires_in_secs resp = mkJSONResp(res) resp.headers['Cache-Control'] = header_val # HGE should always prefer Cache-Control over Expires header From d360920f35bb16354c8f20564c8b85634888d186 Mon Sep 17 00:00:00 2001 From: Anon Ray Date: Wed, 5 Feb 2020 11:17:26 +0530 Subject: [PATCH 4/4] add docs explaining behaviour of refreshing JWKs --- .../manual/auth/authentication/jwt.rst | 45 ++++++++++++++++--- 1 file changed, 38 insertions(+), 7 deletions(-) diff --git a/docs/graphql/manual/auth/authentication/jwt.rst b/docs/graphql/manual/auth/authentication/jwt.rst index 6626fea804fc5..9760da1f8ab1f 100644 --- a/docs/graphql/manual/auth/authentication/jwt.rst +++ b/docs/graphql/manual/auth/authentication/jwt.rst @@ -29,7 +29,7 @@ If the authorization passes, then all of the ``x-hasura-*`` values in the claim are used for the permissions system. .. admonition:: Prerequisite - + It is mandatory to first :doc:`secure your GraphQL endpoint <../../deployment/securing-graphql-endpoint>` for the JWT mode to take effect. @@ -164,14 +164,45 @@ https://tools.ietf.org/html/rfc7517. This is an optional field. You can also provide the key (certificate, PEM encoded public key) as a string - under the ``key`` field. -**Rotating JWKs**: +Rotating JWKs ++++++++++++++ + +Some providers rotate their JWKs (e.g. Firebase). If the provider sends + +1. ``max-age`` or ``s-maxage`` in ``Cache-Control`` header +2. or ``Expires`` header + +with the response of JWK, then the GraphQL engine will refresh the JWKs automatically. If the +provider does not send the above, the JWKs are not refreshed. + +Following is the behaviour in detail: + +**On startup**: + +1. GraphQL engine will fetch the JWK and will - + + 1. first, try to parse ``max-age`` or ``s-maxage`` directive in ``Cache-Control`` header. + 2. second, check if ``Expires`` header is present (if ``Cache-Control`` is not present), and try + to parse the value as a timestamp. + +2. If it is able to parse any of the above successfully, then it will use that parsed time to + refresh/refetch the JWKs again. If it is unable to parse, then it will not refresh the JWKs (it + assumes that if the above headers are not present, the provider doesn't rotate their JWKs). + +**While running**: + +1. While GraphQL engine is running with refreshing JWKs, in one of the refresh cycles it will - + + 1. first, try to parse ``max-age`` or ``s-maxage`` directive in ``Cache-Control`` header. + 2. second, check if ``Expires`` header is present (if ``Cache-Control`` is not present), and try + to parse the value as a timestamp. -Some providers rotate their JWKs (e.g. Firebase). If the provider sends an -``Expires`` header with the response of JWK, then the GraphQL engine will refresh -the JWKs automatically. If the provider does not send an ``Expires`` header, the -JWKs are not refreshed. +2. If it is able to parse any of the above successfully, then it will use that parsed time to + refresh/refetch the JWKs again. If it is unable to parse, then it will sleep for 1 minute and + will start another refresh cycle. -**Example**: +Example JWK URL ++++++++++++++++ - Auth0 publishes their JWK url at: ``https://.auth0.com``. But Auth0 has a bug. See known issues: :ref:`auth0-issues`.