From 465170c7d6c51dace3faf68fbb4040353d5571c0 Mon Sep 17 00:00:00 2001 From: Wolfgang Walther Date: Sun, 16 Jun 2024 12:33:59 +0200 Subject: [PATCH] refactor: Use jose-jwt instead of hs-jose This removes one more dependency on Template Haskell. --- nix/overlays/haskell-packages.nix | 2 + postgrest.cabal | 2 +- src/PostgREST/Auth.hs | 64 +++++++++++++++++++++++-------- src/PostgREST/Config.hs | 40 +++++++------------ 4 files changed, 65 insertions(+), 43 deletions(-) diff --git a/nix/overlays/haskell-packages.nix b/nix/overlays/haskell-packages.nix index 804f97c52..c7a6a19c9 100644 --- a/nix/overlays/haskell-packages.nix +++ b/nix/overlays/haskell-packages.nix @@ -59,6 +59,8 @@ let hasql-pool = lib.dontCheck prev.hasql-pool_1_0_1; + jose-jwt = prev.jose-jwt_0_10_0; + postgresql-libpq = lib.dontCheck (prev.postgresql-libpq.override { postgresql = super.libpq; diff --git a/postgrest.cabal b/postgrest.cabal index b57a4bfda..1b75df152 100644 --- a/postgrest.cabal +++ b/postgrest.cabal @@ -115,7 +115,7 @@ library , heredoc >= 0.2 && < 0.3 , http-types >= 0.12.2 && < 0.13 , insert-ordered-containers >= 0.2.2 && < 0.3 - , jose >= 0.8.5.1 && < 0.12 + , jose-jwt >= 0.9.6 && < 0.11 , lens >= 4.14 && < 5.3 , lens-aeson >= 1.0.1 && < 1.3 , mtl >= 2.2.2 && < 2.4 diff --git a/src/PostgREST/Auth.hs b/src/PostgREST/Auth.hs index 37e4fad67..46afa801c 100644 --- a/src/PostgREST/Auth.hs +++ b/src/PostgREST/Auth.hs @@ -19,7 +19,6 @@ module PostgREST.Auth , middleware ) where -import qualified Crypto.JWT as JWT import qualified Data.Aeson as JSON import qualified Data.Aeson.Key as K import qualified Data.Aeson.KeyMap as KM @@ -30,11 +29,12 @@ import qualified Data.Cache as C import qualified Data.Scientific as Sci import qualified Data.Vault.Lazy as Vault import qualified Data.Vector as V +import qualified Jose.Jwk as JWT +import qualified Jose.Jwt as JWT import qualified Network.HTTP.Types.Header as HTTP import qualified Network.Wai as Wai import qualified Network.Wai.Middleware.HttpAuth as Wai -import Control.Lens (set) import Control.Monad.Except (liftEither) import Data.Either.Combinators (mapLeft) import Data.List (lookup) @@ -54,25 +54,57 @@ import Protolude -- | Receives the JWT secret and audience (from config) and a JWT and returns a -- JSON object of JWT claims. -parseToken :: Monad m => - AppConfig -> LByteString -> UTCTime -> ExceptT Error m JSON.Value +parseToken :: AppConfig -> ByteString -> UTCTime -> ExceptT Error IO JSON.Value parseToken _ "" _ = return JSON.emptyObject parseToken AppConfig{..} token time = do secret <- liftEither . maybeToRight JwtTokenMissing $ configJWKS - eitherClaims <- - lift . runExceptT $ - JWT.verifyClaimsAt validation secret time =<< JWT.decodeCompact token - liftEither . mapLeft jwtClaimsError $ JSON.toJSON <$> eitherClaims + eitherContent <- liftIO $ JWT.decode (JWT.keys secret) Nothing token + content <- liftEither . mapLeft jwtDecodeError $ eitherContent + liftEither $ verifyClaims content where - validation = - JWT.defaultJWTValidationSettings audienceCheck & set JWT.allowedSkew 30 + -- TODO: Improve errors, those were just taken as-is from hs-jose to avoid + -- breaking changes. + jwtDecodeError :: JWT.JwtError -> Error + jwtDecodeError (JWT.KeyError _) = JwtTokenInvalid "JWSError JWSInvalidSignature" + jwtDecodeError JWT.BadCrypto = JwtTokenInvalid "JWSError (CompactDecodeError Invalid number of parts: Expected 3 parts; got 2)" + jwtDecodeError (JWT.BadAlgorithm _) = JwtTokenInvalid "JWSError JWSNoSignatures" + jwtDecodeError e = JwtTokenInvalid $ show e - audienceCheck :: JWT.StringOrURI -> Bool - audienceCheck = maybe (const True) (==) configJwtAudience + verifyClaims :: JWT.JwtContent -> Either Error JSON.Value + verifyClaims (JWT.Jws (_, claims)) = case JSON.decodeStrict claims of + Nothing -> Left $ JwtTokenInvalid "Parsing claims failed" + Just (JSON.Object mclaims) + | failedExpClaim mclaims -> Left $ JwtTokenInvalid "JWT expired" + | failedNbfClaim mclaims -> Left $ JwtTokenInvalid "JWTNotYetValid" + | failedIatClaim mclaims -> Left $ JwtTokenInvalid "JWTIssuedAtFuture" + | failedAudClaim mclaims -> Left $ JwtTokenInvalid "JWTNotInAudience" + Just jclaims -> Right jclaims + -- TODO: We could enable JWE support here (encrypted tokens) + verifyClaims _ = Left $ JwtTokenInvalid "Unsupported token type" - jwtClaimsError :: JWT.JWTError -> Error - jwtClaimsError JWT.JWTExpired = JwtTokenInvalid "JWT expired" - jwtClaimsError e = JwtTokenInvalid $ show e + allowedSkewSeconds = 30 :: Int64 + now = floor . nominalDiffTimeToSeconds $ utcTimeToPOSIXSeconds time + sciToInt = fromMaybe 0 . Sci.toBoundedInteger + + failedExpClaim :: KM.KeyMap JSON.Value -> Bool + failedExpClaim mclaims = case KM.lookup "exp" mclaims of + Just (JSON.Number secs) -> now > (sciToInt secs + allowedSkewSeconds) + _ -> False + + failedNbfClaim :: KM.KeyMap JSON.Value -> Bool + failedNbfClaim mclaims = case KM.lookup "nbf" mclaims of + Just (JSON.Number secs) -> now < (sciToInt secs - allowedSkewSeconds) + _ -> False + + failedIatClaim :: KM.KeyMap JSON.Value -> Bool + failedIatClaim mclaims = case KM.lookup "iat" mclaims of + Just (JSON.Number secs) -> now < (sciToInt secs - allowedSkewSeconds) + _ -> False + + failedAudClaim :: KM.KeyMap JSON.Value -> Bool + failedAudClaim mclaims = case KM.lookup "aud" mclaims of + Just (JSON.String str) -> maybe (const False) (/=) configJwtAudience str + _ -> False parseClaims :: Monad m => AppConfig -> JSON.Value -> ExceptT Error m AuthResult @@ -105,7 +137,7 @@ middleware appState app req respond = do time <- getTime appState let token = fromMaybe "" $ Wai.extractBearerAuth =<< lookup HTTP.hAuthorization (Wai.requestHeaders req) - parseJwt = runExceptT $ parseToken conf (LBS.fromStrict token) time >>= parseClaims conf + parseJwt = runExceptT $ parseToken conf token time >>= parseClaims conf -- If DbPlanEnabled -> calculate JWT validation time -- If JwtCacheMaxLifetime -> cache JWT validation result diff --git a/src/PostgREST/Config.hs b/src/PostgREST/Config.hs index 4a885c7f6..bc729775f 100644 --- a/src/PostgREST/Config.hs +++ b/src/PostgREST/Config.hs @@ -28,27 +28,24 @@ module PostgREST.Config , addTargetSessionAttrs ) where -import qualified Crypto.JOSE.Types as JOSE -import qualified Crypto.JWT as JWT import qualified Data.Aeson as JSON import qualified Data.ByteString as BS import qualified Data.ByteString.Base64 as B64 -import qualified Data.ByteString.Lazy as LBS import qualified Data.CaseInsensitive as CI import qualified Data.Configurator as C import qualified Data.Map.Strict as M import qualified Data.Text as T import qualified Data.Text.Encoding as T +import qualified Jose.Jwa as JWT +import qualified Jose.Jwk as JWT -import Control.Lens (preview) import Control.Monad (fail) -import Crypto.JWT (JWK, JWKSet, StringOrURI, stringOrUri) -import Data.Aeson (toJSON) import Data.Either.Combinators (mapLeft) import Data.List (lookup) import Data.List.NonEmpty (fromList, toList) import Data.Maybe (fromJust) import Data.Scientific (floatingOrInteger) +import Jose.Jwk (Jwk, JwkSet) import Network.URI (escapeURIString, isUnescapedInURIComponent) import Numeric (readOct, showOct) @@ -92,8 +89,8 @@ data AppConfig = AppConfig , configDbTxRollbackAll :: Bool , configDbUri :: Text , configFilePath :: Maybe FilePath - , configJWKS :: Maybe JWKSet - , configJwtAudience :: Maybe StringOrURI + , configJWKS :: Maybe JwkSet + , configJwtAudience :: Maybe Text , configJwtRoleClaimKey :: JSPath , configJwtSecret :: Maybe BS.ByteString , configJwtSecretIsBase64 :: Bool @@ -163,7 +160,7 @@ toText conf = ,("db-pre-config", q . maybe mempty dumpQi . configDbPreConfig) ,("db-tx-end", q . showTxEnd) ,("db-uri", q . configDbUri) - ,("jwt-aud", T.decodeUtf8 . LBS.toStrict . JSON.encode . maybe "" toJSON . configJwtAudience) + ,("jwt-aud", q . fromMaybe mempty . configJwtAudience) ,("jwt-role-claim-key", q . T.intercalate mempty . fmap dumpJSPath . configJwtRoleClaimKey) ,("jwt-secret", q . T.decodeUtf8 . showJwtSecret) ,("jwt-secret-is-base64", T.toLower . show . configJwtSecretIsBase64) @@ -267,7 +264,7 @@ parser optPath env dbSettings roleSettings roleIsolationLvl = <*> (fromMaybe "postgresql://" <$> optString "db-uri") <*> pure optPath <*> pure Nothing - <*> parseJwtAudience "jwt-aud" + <*> optString "jwt-aud" <*> parseRoleClaimKey "jwt-role-claim-key" "role-claim-key" <*> (fmap encodeUtf8 <$> optString "jwt-secret") <*> (fromMaybe False <$> optWithAlias @@ -326,14 +323,6 @@ parser optPath env dbSettings roleSettings roleIsolationLvl = Just val | isMalformedProxyUri val -> fail "Malformed proxy uri, a correct example: https://example.com:8443/basePath" | otherwise -> pure $ Just val - parseJwtAudience :: C.Key -> C.Parser C.Config (Maybe StringOrURI) - parseJwtAudience k = - optString k >>= \case - Nothing -> pure Nothing -- no audience in config file - Just aud -> case preview stringOrUri (T.unpack aud) of - Nothing -> fail "Invalid Jwt audience. Check your configuration." - aud' -> pure aud' - parseLogLevel :: C.Key -> C.Parser C.Config LogLevel parseLogLevel k = optString k >>= \case @@ -447,24 +436,23 @@ decodeSecret conf@AppConfig{..} = decodeB64 = B64.decode . encodeUtf8 . T.strip . replaceUrlChars . decodeUtf8 replaceUrlChars = T.replace "_" "/" . T.replace "-" "+" . T.replace "." "=" --- | Parse `jwt-secret` configuration option and turn into a JWKSet. +-- | Parse `jwt-secret` configuration option and turn into a JWKS. -- -- There are three ways to specify `jwt-secret`: text secret, JSON Web Key --- (JWK), or JSON Web Key Set (JWKS). The first two are converted into a JWKSet +-- (JWK), or JSON Web Key Set (JWKS). The first two are converted into a JwkSet -- with one key and the last is converted as is. decodeJWKS :: AppConfig -> AppConfig decodeJWKS conf = conf { configJWKS = parseSecret <$> configJwtSecret conf } -parseSecret :: ByteString -> JWKSet +parseSecret :: ByteString -> JwkSet parseSecret bytes = - fromMaybe (maybe secret (\jwk' -> JWT.JWKSet [jwk']) maybeJWK) + fromMaybe (maybe secret (\jwk' -> JWT.JwkSet [jwk']) maybeJWK) maybeJWKSet where - maybeJWKSet = JSON.decodeStrict bytes :: Maybe JWKSet - maybeJWK = JSON.decodeStrict bytes :: Maybe JWK - secret = JWT.JWKSet [JWT.fromKeyMaterial keyMaterial] - keyMaterial = JWT.OctKeyMaterial . JWT.OctKeyParameters $ JOSE.Base64Octets bytes + maybeJWKSet = JSON.decodeStrict bytes :: Maybe JwkSet + maybeJWK = JSON.decodeStrict bytes :: Maybe Jwk + secret = JWT.JwkSet [JWT.SymmetricJwk bytes Nothing (Just JWT.Sig) (Just $ JWT.Signed JWT.HS256)] -- | Read database uri from a separate file if `db-uri` is a filepath. readDbUriFile :: Maybe Text -> AppConfig -> IO AppConfig