diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -4,6 +4,18 @@ [PVP](https://pvp.haskell.org/) and is versioned independently of the other Shōmei packages. +## 0.3.0.0 — 2026-11-05 + +- **Breaking:** internal dependency bounds follow the 0.3 API series. + +- **Breaking:** `VerifierSettings` requires a finite positive `maxTokenLifetime` and an explicit + optional legacy actor deadline. Verification rejects nonpositive/excess lifetimes independently + of clock skew. The core-config adapter derives its ceiling from issuance TTLs. +- Actor claims default to single-subject objects. Finite legacy reading/emission settings support + a coordinated rollout; a legacy mint's expiry plus skew must fit before the reader cutoff. +- A present malformed actor fails verification instead of losing its delegation identity. + Direct extension bags cannot inject reserved claims. `sid` remains the correlation identifier. + ## 0.2.0.0 — 2026-08-27 - **Breaking:** requires `shomei-core ^>=0.2.0.0`. diff --git a/shomei-jwt.cabal b/shomei-jwt.cabal --- a/shomei-jwt.cabal +++ b/shomei-jwt.cabal @@ -1,7 +1,7 @@ -cabal-version: 3.0 -name: shomei-jwt -version: 0.2.0.0 -synopsis: JWT access-token signing/verification and JWKS publishing +cabal-version: 3.0 +name: shomei-jwt +version: 0.3.0.0 +synopsis: JWT access-token signing/verification and JWKS publishing description: Interprets Shōmei's signing-key effects with jose. Signs and verifies ES256 (or, configurably, RS256) access tokens and OpenID Connect ID tokens, @@ -11,28 +11,33 @@ only on shomei-core, so it can be used without Shōmei's HTTP or PostgreSQL layers. -homepage: https://github.com/shinzui/shomei -bug-reports: https://github.com/shinzui/shomei/issues -license: MIT -license-file: LICENSE -author: Nadeem Bitar -maintainer: nadeem@gmail.com -copyright: 2026 Nadeem Bitar -category: Web, Security -tested-with: GHC ==9.12.4 +homepage: https://github.com/shinzui/shomei +bug-reports: https://github.com/shinzui/shomei/issues +license: MIT +license-file: LICENSE +author: Nadeem Bitar +maintainer: nadeem@gmail.com +copyright: 2026 Nadeem Bitar +category: Web, Security +tested-with: ghc ==9.12.4 extra-doc-files: CHANGELOG.md source-repository head - type: git + type: git location: https://github.com/shinzui/shomei.git common warnings ghc-options: - -Wall -Wcompat -Widentities -Wincomplete-record-updates - -Wincomplete-uni-patterns -Wpartial-fields -Wredundant-constraints + -Wall + -Wcompat + -Widentities + -Wincomplete-record-updates + -Wincomplete-uni-patterns + -Wpartial-fields + -Wredundant-constraints common shared - default-language: GHC2024 + default-language: GHC2024 default-extensions: BlockArguments DeriveAnyClass @@ -45,8 +50,8 @@ TemplateHaskell library - import: warnings, shared - hs-source-dirs: src + import: warnings, shared + hs-source-dirs: src exposed-modules: Shomei.SigningKey.Jwks.Jwt Shomei.SigningKey.Key.Jwt @@ -56,28 +61,28 @@ Shomei.SigningKey.Verify.Jwt build-depends: - , aeson >=2.1 && <2.3 - , base >=4.18 && <5 - , base64-bytestring >=1.2 && <1.3 - , bytestring >=0.11 && <0.13 - , containers >=0.6 && <0.9 - , crypton >=1.1.0 && <1.2 - , effectful >=2.5 && <2.8 - , effectful-core >=2.5 && <2.8 - , jose >=0.13 && <0.14 - , lens >=5.2 && <5.4 - , monad-time >=0.4 && <0.5 - , mtl >=2.3 && <2.4 - , ram >=0.22 && <0.23 - , shomei-core ^>=0.2.0.0 - , text >=2.0 && <2.2 - , time >=1.12 && <1.15 + aeson >=2.1 && <2.3, + base >=4.18 && <5, + base64-bytestring >=1.2 && <1.3, + bytestring >=0.11 && <0.13, + containers >=0.6 && <0.9, + crypton >=1.1.0 && <1.2, + effectful >=2.5 && <2.8, + effectful-core >=2.5 && <2.8, + jose >=0.13 && <0.14, + lens >=5.2 && <5.4, + monad-time >=0.4 && <0.5, + mtl >=2.3 && <2.4, + ram >=0.22 && <0.23, + shomei-core ^>=0.3.0.0, + text >=2.0 && <2.2, + time >=1.12 && <1.15, test-suite shomei-jwt-test - import: warnings, shared - type: exitcode-stdio-1.0 + import: warnings, shared + type: exitcode-stdio-1.0 hs-source-dirs: test - main-is: Main.hs + main-is: Main.hs other-modules: Shomei.SigningKey.Interpreter.JwtSpec Shomei.SigningKey.Jwks.JwtSpec @@ -91,17 +96,17 @@ Shomei.SigningKey.Verify.JwtSpec build-depends: - , aeson >=2.1 && <2.3 - , base >=4.18 && <5 - , bytestring >=0.11 && <0.13 - , containers >=0.6 && <0.9 - , effectful >=2.5 && <2.8 - , jose >=0.13 && <0.14 - , lens >=5.2 && <5.4 - , ram >=0.22 && <0.23 - , shomei-core ^>=0.2.0.0 - , shomei-jwt ^>=0.2.0.0 - , tasty >=1.4 && <1.6 - , tasty-hunit >=0.10 && <0.11 - , text >=2.0 && <2.2 - , time >=1.12 && <1.15 + aeson >=2.1 && <2.3, + base >=4.18 && <5, + bytestring >=0.11 && <0.13, + containers >=0.6 && <0.9, + effectful >=2.5 && <2.8, + jose >=0.13 && <0.14, + lens >=5.2 && <5.4, + ram >=0.22 && <0.23, + shomei-core ^>=0.3.0.0, + shomei-jwt ^>=0.3.0.0, + tasty >=1.4 && <1.6, + tasty-hunit >=0.10 && <0.11, + text >=2.0 && <2.2, + time >=1.12 && <1.15, diff --git a/src/Shomei/SigningKey/Sign/Jwt.hs b/src/Shomei/SigningKey/Sign/Jwt.hs --- a/src/Shomei/SigningKey/Sign/Jwt.hs +++ b/src/Shomei/SigningKey/Sign/Jwt.hs @@ -16,6 +16,7 @@ claimsFromIdToken, wholeSeconds, signAccessToken, + signAccessTokenWith, signIdToken, runTokenSignerJwt, ) @@ -59,7 +60,7 @@ import Effectful.Dispatch.Dynamic (interpret_) import Shomei.Authorization.Claims.Domain (AuthClaims (..)) import Shomei.Authorization.Claims.Domain qualified as Domain -import Shomei.Config (ShomeiConfig) +import Shomei.Config (ShomeiConfig (..), SigningKeyConfig (..)) import Shomei.Id (idText) import Shomei.OAuth.IdToken.Domain (IdToken (IdToken), IdTokenClaims (..)) import Shomei.Prelude @@ -83,7 +84,10 @@ -- directly; session id, scopes, roles, and permissions travel as the custom claims -- @sid@, @scopes@, @roles@, @permissions@. claimsFromAuth :: AuthClaims -> ClaimsSet -claimsFromAuth ac = +claimsFromAuth = claimsFromAuthWithActorFormat False + +claimsFromAuthWithActorFormat :: Bool -> AuthClaims -> ClaimsSet +claimsFromAuthWithActorFormat legacy ac = withActor $ -- 'addExtra' seeds the custom claims into the base FIRST, then every claim in -- 'Domain.reservedClaimKeys' is written through a registered slot or a managed @@ -108,11 +112,11 @@ & addClaim "permissions" (Aeson.toJSON (Set.toList ac.permissions)) & addClaim "auth_time" (Aeson.toJSON (NumericDate (wholeSeconds ac.authTime))) where - addExtra obj cs = KeyMap.foldrWithKey (\k v -> addClaim (Key.toText k) v) cs obj + addExtra obj cs = KeyMap.foldrWithKey (\k v -> if Key.toText k `elem` Domain.reservedClaimKeys then id else addClaim (Key.toText k) v) cs obj -- Add the @act@ claim only for delegated tokens, leaving ordinary tokens -- byte-identical to before this field existed. withActor cs = case ac.actor of - Just uid -> cs & addClaim "act" (Aeson.String (idText uid)) + Just uid -> cs & addClaim "act" (if legacy then Aeson.String (idText uid) else Aeson.object ["sub" Aeson..= idText uid]) Nothing -> cs -- | The JWS algorithm to sign with for a given key, chosen directly from the key @@ -131,7 +135,22 @@ -- for EC) rather than negotiated by @makeJWSHeader@, and the key's @kid@ is copied -- into the header by hand so a verifier can select the right key. signAccessToken :: JWK -> AuthClaims -> IO (Either JWTError AccessToken) -signAccessToken jwk ac = do +signAccessToken = signAccessTokenWithActorFormat False + +-- | During a rolling upgrade the explicit legacy emitter expires at the same finite +-- deadline as legacy reading. A legacy token's expiry plus skew must fit inside +-- that window; later mints automatically use objects so no fresh legacy token +-- outlives the reader's cutoff. +signAccessTokenWith :: ShomeiConfig -> JWK -> AuthClaims -> IO (Either JWTError AccessToken) +signAccessTokenWith cfg jwk ac = do + now <- getCurrentTime + let lastValid = utcTimeToPOSIXSeconds ac.expiresAt + fromIntegral cfg.signingKeyConfig.allowedClockSkewSeconds + fits deadline = utcTimeToPOSIXSeconds now < deadline && lastValid < deadline + legacy = cfg.signingKeyConfig.emitLegacyActor && maybe False fits (fromIntegral <$> cfg.signingKeyConfig.legacyActorUntilUnix) + signAccessTokenWithActorFormat legacy jwk ac + +signAccessTokenWithActorFormat :: Bool -> JWK -> AuthClaims -> IO (Either JWTError AccessToken) +signAccessTokenWithActorFormat legacy jwk ac = do let hdr = newJWSHeaderProtected (algForKey jwk) & JWS.kid @@ -139,7 +158,7 @@ & JWS.typ ?~ newHeaderParamProtected "at+jwt" result <- runJOSE @JWTError $ do - signed <- signClaims jwk hdr (claimsFromAuth ac) + signed <- signClaims jwk hdr (claimsFromAuthWithActorFormat legacy ac) pure (encodeCompact (signed :: SignedJWT)) pure $ case result of Left e -> Left e @@ -203,9 +222,9 @@ ShomeiConfig -> Eff (TokenSigner : es) a -> Eff es a -runTokenSignerJwt jwk _cfg = interpret_ \case +runTokenSignerJwt jwk cfg = interpret_ \case SignAccessToken ac -> do - r <- liftIO (signAccessToken jwk ac) + r <- liftIO (signAccessTokenWith cfg jwk ac) case r of Right tok -> pure tok Left e -> liftIO (throwIO (userError ("token signing failed: " <> show e))) diff --git a/src/Shomei/SigningKey/Verify/Jwt.hs b/src/Shomei/SigningKey/Verify/Jwt.hs --- a/src/Shomei/SigningKey/Verify/Jwt.hs +++ b/src/Shomei/SigningKey/Verify/Jwt.hs @@ -13,6 +13,7 @@ module Shomei.SigningKey.Verify.Jwt ( VerifierSettings (..), verifierSettingsFromConfig, + validateVerifierSettings, KidSelectingKeys (..), checkStringOrUri, verifyTokenWith, @@ -58,12 +59,13 @@ import Data.Set qualified as Set import Data.Text qualified as Text import Data.Text.Encoding qualified as Text -import Data.Time (NominalDiffTime) +import Data.Time (NominalDiffTime, diffUTCTime) +import Data.Time.Clock.POSIX (posixSecondsToUTCTime) import Effectful (Eff, IOE, (:>)) import Effectful.Dispatch.Dynamic (interpret_) import Shomei.Authorization.Claims.Domain (AuthClaims (..)) import Shomei.Authorization.Claims.Domain qualified as Domain -import Shomei.Config (ShomeiConfig (..), SigningKeyConfig (..)) +import Shomei.Config (ImpersonationConfig (..), MachineTokenConfig (..), ShomeiConfig (..), SigningKeyConfig (..)) import Shomei.Error (TokenError (..)) import Shomei.Id (parseId) import Shomei.Prelude @@ -82,7 +84,9 @@ { issuer :: !Domain.Issuer, audience :: !Domain.Audience, allowedClockSkew :: !NominalDiffTime, - requireTokenType :: !Bool + requireTokenType :: !Bool, + maxTokenLifetime :: !NominalDiffTime, + legacyActorDeadline :: !(Maybe UTCTime) } deriving stock (Eq, Show) @@ -92,13 +96,23 @@ { issuer = cfg.issuer, audience = cfg.audience, allowedClockSkew = fromIntegral cfg.signingKeyConfig.allowedClockSkewSeconds, - requireTokenType = False + requireTokenType = False, + maxTokenLifetime = maximum [cfg.accessTokenTTL, cfg.machineTokenConfig.machineTokenTTL, cfg.impersonationConfig.impersonationSessionTTL], + legacyActorDeadline = posixSecondsToUTCTime . fromIntegral <$> cfg.signingKeyConfig.legacyActorUntilUnix } -- | A verification key store that returns only the key named by the protected -- @kid@ header. Missing and unknown identifiers deliberately return no keys. newtype KidSelectingKeys = KidSelectingKeys JWKSet +-- | Validate once before serving requests in standalone consumers. +validateVerifierSettings :: VerifierSettings -> Either Text () +validateVerifierSettings settings = do + checkStringOrUri (issuerText settings.issuer) + checkStringOrUri (audienceText settings.audience) + when (settings.maxTokenLifetime <= 0) (Left "maxTokenLifetime must be positive and finite") + when (settings.allowedClockSkew < 0) (Left "allowedClockSkew must be nonnegative") + instance (Applicative m, HasKid h) => VerificationKeyStore m (h p) payload KidSelectingKeys where getVerificationKeys hdr _payload (KidSelectingKeys (JWKSet keys)) = pure case preview (kid . _Just . param) hdr of @@ -115,7 +129,9 @@ -- | Verify with explicit policy. The protected @kid@ chooses exactly one public -- key and the accepted JWS algorithms are pinned to Shōmei's ES256/RS256 set. verifyTokenWith :: VerifierSettings -> JWKSet -> Text -> IO (Either TokenError AuthClaims) +verifyTokenWith settings _ _ | Left _ <- validateVerifierSettings settings = pure (Left TokenMalformed) verifyTokenWith verifierSettings jwks raw = do + verificationTime <- getCurrentTime let bytes = BSL.fromStrict (Text.encodeUtf8 raw) matches wanted = maybe (const False) (==) (preview stringOrUri wanted) settings = @@ -138,7 +154,7 @@ pure case result of Left (JWSError NoUsableKeys) -> Left (TokenKeyNotFound headerKid) Left err -> Left (jwtErrorToTokenError err) - Right claims -> checkTokenType verifierSettings headerType *> claimsToAuth claims + Right claims -> checkTokenType verifierSettings headerType *> claimsToAuth verifierSettings verificationTime claims -- | THE core/Servant contract. Existing callers receive the hardened verifier -- through the unchanged public function. @@ -190,8 +206,8 @@ | otherwise -> Left (TokenOtherError ("typ " <> tokenType <> " is not at+jwt")) -- | Decode a verified jose 'ClaimsSet' back into Shōmei's 'AuthClaims'. -claimsToAuth :: ClaimsSet -> Either TokenError AuthClaims -claimsToAuth cs = do +claimsToAuth :: VerifierSettings -> UTCTime -> ClaimsSet -> Either TokenError AuthClaims +claimsToAuth settings verificationTime cs = do subTxt <- note "missing sub" (cs ^. claimSub >>= soText) subj <- mapLeft (const TokenMalformed) (parseId subTxt) sidTxt <- note "missing sid" (lookupString "sid") @@ -200,6 +216,7 @@ audTxt <- exactAudience (cs ^. claimAud) issuedAt' <- note "missing iat" (dateOf (cs ^. claimIat)) expiresAt' <- note "missing exp" (dateOf (cs ^. claimExp)) + when (expiresAt' <= issuedAt' || diffUTCTime expiresAt' issuedAt' > settings.maxTokenLifetime) (Left TokenMalformed) authTime' <- case Map.lookup "auth_time" claims of Nothing -> Right issuedAt' Just value -> case parseEither Aeson.parseJSON value of @@ -223,9 +240,15 @@ ] -- The @act@ claim is present only on delegated (impersonation) tokens. Absent -- → 'Nothing'; present but unparseable → a malformed token. - actor' <- case lookupString "act" of + actor' <- case Map.lookup "act" claims of Nothing -> Right Nothing - Just actTxt -> Just <$> mapLeft (const TokenMalformed) (parseId actTxt) + Just (Aeson.String actTxt) + | maybe False (verificationTime <) settings.legacyActorDeadline -> parseActor actTxt + Just (Aeson.Object actorObject) + | KeyMap.size actorObject == 1, + Just (Aeson.String actTxt) <- KeyMap.lookup "sub" actorObject -> + parseActor actTxt + Just _ -> Left TokenMalformed pure AuthClaims { subject = subj, @@ -242,6 +265,7 @@ extraClaims = extra } where + parseActor actTxt = Just <$> mapLeft (const TokenMalformed) (parseId actTxt) note msg = maybe (Left (TokenOtherError msg)) Right mapLeft f = either (Left . f) Right -- jose serialises a StringOrURI (whether arbitrary string or URI) as a JSON diff --git a/test/Shomei/SigningKey/Sign/RsaCustomClaimSpec.hs b/test/Shomei/SigningKey/Sign/RsaCustomClaimSpec.hs --- a/test/Shomei/SigningKey/Sign/RsaCustomClaimSpec.hs +++ b/test/Shomei/SigningKey/Sign/RsaCustomClaimSpec.hs @@ -72,8 +72,8 @@ Right ac' -> idText ac'.subject @?= idText base.subject Left e -> assertFailure ("verify failed: " <> show e), testCase "configSigningAlgorithm parses RS256 and rejects unknown text" $ do - let rs = testConfig {signingKeyConfig = SigningKeyConfig {algorithm = "RS256", refreshIntervalSeconds = 60, allowedClockSkewSeconds = 30}} - bad = testConfig {signingKeyConfig = SigningKeyConfig {algorithm = "nope", refreshIntervalSeconds = 60, allowedClockSkewSeconds = 30}} + let rs = testConfig {signingKeyConfig = testConfig.signingKeyConfig {algorithm = "RS256"}} + bad = testConfig {signingKeyConfig = testConfig.signingKeyConfig {algorithm = "nope"}} configSigningAlgorithm rs @?= Right RS256 assertBool "unknown signing algorithms must be a boot error" (isLeft (configSigningAlgorithm bad)) ] diff --git a/test/Shomei/SigningKey/TestSupport.hs b/test/Shomei/SigningKey/TestSupport.hs --- a/test/Shomei/SigningKey/TestSupport.hs +++ b/test/Shomei/SigningKey/TestSupport.hs @@ -28,7 +28,7 @@ testAudience = Audience "shomei-clients" testConfig :: ShomeiConfig -testConfig = defaultShomeiConfig testIssuer testAudience +testConfig = (defaultShomeiConfig testIssuer testAudience) {accessTokenTTL = 3600} -- | Build claims valid from @t@ for one hour, with two scopes and one role. mkClaims :: ShomeiConfig -> UTCTime -> IO AuthClaims diff --git a/test/Shomei/SigningKey/Verify/JwtSpec.hs b/test/Shomei/SigningKey/Verify/JwtSpec.hs --- a/test/Shomei/SigningKey/Verify/JwtSpec.hs +++ b/test/Shomei/SigningKey/Verify/JwtSpec.hs @@ -4,6 +4,7 @@ module Shomei.SigningKey.Verify.JwtSpec (tests) where import Control.Lens ((%~), (&), (.~), (?~), (^.)) +import Control.Monad (forM_) import Crypto.JOSE.Compact (encodeCompact) import Crypto.JOSE.Error (runJOSE) import Crypto.JOSE.Header (newHeaderParamProtected) @@ -15,10 +16,12 @@ ( Audience (Audience), ClaimsSet, JWTError, + NumericDate (..), SignedJWT, StringOrURI, addClaim, claimAud, + claimNbf, signClaims, unregisteredClaims, ) @@ -35,14 +38,17 @@ import Data.Text qualified as Text import Data.Text.Encoding qualified as Text import Data.Time (addUTCTime, getCurrentTime) +import Data.Time.Clock.POSIX (utcTimeToPOSIXSeconds) import Shomei.Authorization.Claims.Domain (AuthClaims (..), mkExtraClaims) +import Shomei.Config (ShomeiConfig (..), SigningKeyConfig (..)) import Shomei.Error (TokenError (..)) +import Shomei.Id (genUserId, idText) import Shomei.Session.Token.Domain (AccessToken (AccessToken)) import Shomei.SigningKey.Domain qualified as Domain import Shomei.SigningKey.Key.Jwt (generateSigningKey, generateSigningKeyFor, keyKid) -import Shomei.SigningKey.Sign.Jwt (claimsFromAuth, signAccessToken) +import Shomei.SigningKey.Sign.Jwt (claimsFromAuth, signAccessToken, signAccessTokenWith) import Shomei.SigningKey.TestSupport (mkClaims, mkClaimsWith, publicJwks, testConfig) -import Shomei.SigningKey.Verify.Jwt (verifyToken) +import Shomei.SigningKey.Verify.Jwt (VerifierSettings (..), verifierSettingsFromConfig, verifyToken, verifyTokenWith) import Test.Tasty (TestTree, testGroup) import Test.Tasty.HUnit (assertBool, assertFailure, testCase, (@?=)) @@ -50,9 +56,74 @@ tests = testGroup "Verify" - [ testCase "accepts an iat within the configured 30-second skew" $ do + [ testCase "actor object emission and bounded legacy compatibility preserve delegation" $ do jwk <- generateSigningKey now <- getCurrentTime + base <- mkClaims testConfig now + uid <- genUserId + let claims = base {actor = Just uid} + deadline = ceiling (utcTimeToPOSIXSeconds (addUTCTime 7200 now)) + legacyCfg = testConfig {signingKeyConfig = testConfig.signingKeyConfig {legacyActorUntilUnix = Just deadline, emitLegacyActor = True}} + expiredCfg = legacyCfg {signingKeyConfig = legacyCfg.signingKeyConfig {legacyActorUntilUnix = Just (deadline - 7300)}} + actorObject = Aeson.object ["sub" Aeson..= idText uid] + objectWire <- signAccessOrFail jwk claims + payload <- decodeSegment 1 objectWire + KeyMap.lookup "act" payload @?= Just actorObject + legacyToken <- either (assertFailure . show) pure =<< signAccessTokenWith legacyCfg jwk claims + let AccessToken legacyWire = legacyToken + legacyPayload <- decodeSegment 1 legacyWire + KeyMap.lookup "act" legacyPayload @?= Just (String (idText uid)) + forM_ [objectWire, legacyWire] \wire -> do + verified <- verifyToken (publicJwks jwk []) legacyCfg wire + case verified of + Right ac -> ac.actor @?= Just uid + Left err -> assertFailure (show err) + verifyToken (publicJwks jwk []) testConfig legacyWire >>= (@?= Left TokenMalformed) + verifyToken (publicJwks jwk []) expiredCfg legacyWire >>= (@?= Left TokenMalformed) + AccessToken automatic <- either (assertFailure . show) pure =<< signAccessTokenWith expiredCfg jwk claims + automaticPayload <- decodeSegment 1 automatic + KeyMap.lookup "act" automaticPayload @?= Just actorObject + let tooShort = legacyCfg {signingKeyConfig = legacyCfg.signingKeyConfig {legacyActorUntilUnix = Just (deadline - 7140)}} + AccessToken bounded <- either (assertFailure . show) pure =<< signAccessTokenWith tooShort jwk claims + boundedPayload <- decodeSegment 1 bounded + KeyMap.lookup "act" boundedPayload @?= Just actorObject, + testCase "accepted lifetime is positive and finite independently of clock skew" $ do + jwk <- generateSigningKey + now <- getCurrentTime + let settings = (verifierSettingsFromConfig testConfig) {maxTokenLifetime = 60, allowedClockSkew = 3600} + forM_ [0, -1, 61] \ttl -> do + claims <- mkClaimsWith testConfig now (addUTCTime ttl now) + wire <- signAccessOrFail jwk claims + verifyTokenWith settings (publicJwks jwk []) wire >>= (@?= Left TokenMalformed) + claims <- mkClaimsWith testConfig now (addUTCTime 60 now) + wire <- signAccessOrFail jwk claims + result <- verifyTokenWith settings (publicJwks jwk []) wire + case result of + Right _ -> pure () + Left err -> assertFailure (show err) + verifyTokenWith settings {maxTokenLifetime = 0} (publicJwks jwk []) wire >>= (@?= Left TokenMalformed), + testCase "a direct extension bag cannot inject actor or jti" $ do + jwk <- generateSigningKey + now <- getCurrentTime + base <- mkClaims testConfig now + uid <- genUserId + let claims = base {extraClaims = KeyMap.fromList [("act", Aeson.object ["sub" Aeson..= idText uid]), ("jti", String "forged")]} + wire <- signAccessOrFail jwk claims + payload <- decodeSegment 1 wire + KeyMap.lookup "act" payload @?= Nothing + KeyMap.lookup "jti" payload @?= Nothing + assertBool "sid remains the correlation identifier" (KeyMap.member "sid" payload), + testCase "a present malformed actor never verifies as an ordinary token" $ do + jwk <- generateSigningKey + now <- getCurrentTime + claims <- mkClaims testConfig now + forM_ [Aeson.object ["sub" Aeson..= String "invalid"], Aeson.toJSON (["actor"] :: [Text]), Number 1, Aeson.Null, String ""] \actorValue -> do + wire <- signClaimsOrFail jwk (addClaim "act" actorValue (claimsFromAuth claims)) + result <- verifyToken (publicJwks jwk []) testConfig wire + result @?= Left TokenMalformed, + testCase "accepts an iat within the configured 30-second skew" $ do + jwk <- generateSigningKey + now <- getCurrentTime claims <- mkClaimsWith testConfig (addUTCTime 10 now) (addUTCTime 3600 now) wire <- signAccessOrFail jwk claims result <- verifyToken (publicJwks jwk []) testConfig wire @@ -100,6 +171,18 @@ case result of Right verified -> verified.authTime @?= verified.issuedAt Left err -> assertFailure ("expected the legacy token to verify, got " <> show err), + testCase "signed future nbf is rejected while the configured skew is honored" $ do + jwk <- generateSigningKey + now <- getCurrentTime + claims <- mkClaims testConfig now + let wireAt offset = signClaimsWithHeaderOrFail jwk ES256 (Just (keyKid jwk)) (Just "at+jwt") (claimsFromAuth claims & claimNbf ?~ NumericDate (addUTCTime offset now)) + future <- wireAt 120 + verifyToken (publicJwks jwk []) testConfig future >>= (@?= Left (TokenOtherError "token not yet valid")) + withinSkew <- wireAt 10 + accepted <- verifyToken (publicJwks jwk []) testConfig withinSkew + case accepted of + Right _ -> pure () + Left _ -> assertFailure "nbf inside configured skew was rejected", testCase "drops nbf and jti from the extension claim bag" $ do let extras = mkExtraClaims (KeyMap.fromList [("nbf", Number 1), ("jti", String "forged")]) assertBool "nbf must be reserved" (not (KeyMap.member "nbf" extras))