diff --git a/CHANGELOG.md b/CHANGELOG.md index 2220192..b4f3fa5 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,5 +1,12 @@ ## Version NEXT +- Generalised the types of `signJWT`, `verifyJWT` and related + functions to accept custom JWS header types. Added new type + synonym `SignedJWTWithHeader h`. This change could break some + applications by introducing ambiguity. The solution will be + to add a type annotation or apply a function like `fixType = id :: + SignedJWT -> SignedJWT` to specify the header type. ([#122][]). + - Add `Crypto.JOSE.JWK.negotiateJWSAlg` which chooses the cryptographically strongest JWS algorithm for a given key, restricted to a given set of algorithms. ([#118][]) @@ -71,6 +78,7 @@ [#106]: https://github.com/frasertweedale/hs-jose/issues/106 [#107]: https://github.com/frasertweedale/hs-jose/issues/107 [#118]: https://github.com/frasertweedale/hs-jose/issues/118 +[#122]: https://github.com/frasertweedale/hs-jose/issues/122 ## Older versions diff --git a/src/Crypto/JWT.hs b/src/Crypto/JWT.hs index 7f5c205..c5c5c83 100644 --- a/src/Crypto/JWT.hs +++ b/src/Crypto/JWT.hs @@ -43,8 +43,9 @@ module Crypto.JWT -- * API -- ** Creating a JWT SignedJWT - , signClaims + , SignedJWTWithHeader , signJWT + , signClaims -- ** Validating a JWT and extracting claims , defaultJWTValidationSettings @@ -151,8 +152,8 @@ verify k s = 'runJOSE' $ do let k' = 'fromOctets' k -- turn raw secret into symmetric JWK audCheck = const True -- should be a proper audience check - jwt <- 'decodeCompact' s -- decode JWT - 'verifyClaims' ('defaultJWTValidationSettings' audCheck) k' jwt + jwt <- 'decodeCompact' s -- decode JWT + 'verifyClaims' ('defaultJWTValidationSettings' audCheck) k' (jwt :: 'SignedJWT') @ -} @@ -617,10 +618,16 @@ validateIssClaim conf = unless (view issuerPredicate conf iss) (throwing_ _JWTNotInIssuer) ) . preview (claimIss . _Just) --- | A digitally signed or MACed JWT +-- | A digitally signed or MAC'd JWT, with the JWS header type fixed +-- at 'JWSHeader'. -- -type SignedJWT = CompactJWS JWSHeader +type SignedJWT = SignedJWTWithHeader JWSHeader +-- | A digitally signed or MAC'd JWT, with caller-specified JWS +-- header type. For information about defining custom header types +-- see /Defining additional header parameters/ in "Crypto.JOSE.JWS". +-- +type SignedJWTWithHeader h = CompactJWS h newtype WrappedUTCTime = WrappedUTCTime { getUTCTime :: UTCTime } @@ -656,13 +663,14 @@ verifyJWT , HasIssuerPredicate a , HasCheckIssuedAt a , HasValidationSettings a + , HasJWSHeader h, HasParams h , AsError e, AsJWTError e, MonadError e m - , VerificationKeyStore m (JWSHeader ()) payload k + , VerificationKeyStore m (h ()) payload k , HasClaimsSet payload, FromJSON payload ) => a -> k - -> SignedJWT + -> SignedJWTWithHeader h -> m payload verifyJWT conf k jws = -- It is important, for security reasons, that the signature get @@ -679,12 +687,13 @@ verifyClaims , HasIssuerPredicate a , HasCheckIssuedAt a , HasValidationSettings a + , HasJWSHeader h, HasParams h , AsError e, AsJWTError e, MonadError e m - , VerificationKeyStore m (JWSHeader ()) ClaimsSet k + , VerificationKeyStore m (h ()) ClaimsSet k ) => a -> k - -> SignedJWT + -> SignedJWTWithHeader h -> m ClaimsSet verifyClaims = verifyJWT @@ -698,14 +707,15 @@ verifyJWTAt , HasIssuerPredicate a , HasCheckIssuedAt a , HasValidationSettings a + , HasJWSHeader h, HasParams h , AsError e, AsJWTError e, MonadError e m - , VerificationKeyStore (ReaderT WrappedUTCTime m) (JWSHeader ()) payload k + , VerificationKeyStore (ReaderT WrappedUTCTime m) (h ()) payload k , HasClaimsSet payload, FromJSON payload ) => a -> k -> UTCTime - -> SignedJWT + -> SignedJWTWithHeader h -> m payload verifyJWTAt a k t jwt = runReaderT (verifyJWT a k jwt) (WrappedUTCTime t) @@ -718,13 +728,14 @@ verifyClaimsAt , HasIssuerPredicate a , HasCheckIssuedAt a , HasValidationSettings a + , HasJWSHeader h, HasParams h , AsError e, AsJWTError e, MonadError e m - , VerificationKeyStore (ReaderT WrappedUTCTime m) (JWSHeader ()) ClaimsSet k + , VerificationKeyStore (ReaderT WrappedUTCTime m) (h ()) ClaimsSet k ) => a -> k -> UTCTime - -> SignedJWT + -> SignedJWTWithHeader h -> m ClaimsSet verifyClaimsAt = verifyJWTAt @@ -738,11 +749,17 @@ verifyClaimsAt = verifyJWTAt -- signJWT :: ( MonadRandom m, MonadError e m, AsError e + , HasJWSHeader h, HasParams h , ToJSON payload ) => JWK - -> JWSHeader () + -- ^ Signing key + -> h () + -- ^ JWS Header. Commonly this will be 'JWSHeader'. If your application + -- uses additional header fields, see /Defining additional header parameters/ + -- in "Crypto.JOSE.JWS". -> payload - -> m SignedJWT + -- ^ The payload ('ClaimsSet' or a subtype). + -> m (SignedJWTWithHeader h) signJWT k h c = signJWS (encode c) (Identity (h, k)) -- | Create a JWS JWT. Specialisation of 'signJWT' with payload type fixed @@ -752,9 +769,10 @@ signJWT k h c = signJWS (encode c) (Identity (h, k)) -- ("Issued At") Claim. The payload is encoded as-is. -- signClaims - :: (MonadRandom m, MonadError e m, AsError e) + :: ( MonadRandom m, MonadError e m, AsError e + , HasJWSHeader h, HasParams h ) => JWK - -> JWSHeader () + -> h () -> ClaimsSet - -> m SignedJWT + -> m (SignedJWTWithHeader h) signClaims = signJWT diff --git a/test/Examples.hs b/test/Examples.hs index a1be73e..656a6d7 100644 --- a/test/Examples.hs +++ b/test/Examples.hs @@ -42,7 +42,7 @@ fromX509VerifySpec = (do es256jwk <- errorOrJWK jwt <- decodeCompact es256token - verifyClaimsAt valSettings es256jwk now jwt) `shouldBe` + verifyClaimsAt valSettings es256jwk now (jwt :: SignedJWT)) `shouldBe` Right expectedClaims _ -> pure () diff --git a/test/JWT.hs b/test/JWT.hs index b97e164..aa72f17 100644 --- a/test/JWT.hs +++ b/test/JWT.hs @@ -88,6 +88,7 @@ spec = do (defaultJWTValidationSettings (const False)) headMay [] = Nothing headMay (h:_) = Just h + fixType = id :: SignedJWT -> SignedJWT describe "JWT Claims Set" $ do it "parses from JSON correctly" $ do @@ -339,9 +340,9 @@ spec = do 192,205,154,245,103,208,128,163] now = utcTime "2010-01-01 00:00:00" settings = defaultJWTValidationSettings (const True) - runReaderT (decodeCompact exampleJWT >>= verifyClaims settings k) now + runReaderT (decodeCompact exampleJWT >>= verifyClaims settings k . fixType) now `shouldBe` (Right exampleClaimsSet :: Either JWTError ClaimsSet) - runReaderT (decodeCompact exampleJWT >>= verifyJWT settings k) now + runReaderT (decodeCompact exampleJWT >>= verifyJWT settings k . fixType) now `shouldBe` (Right super :: Either JWTError Super) describe "RFC 7519 ยง6.1. Example Unsecured JWT" $ do @@ -357,17 +358,17 @@ spec = do describe "when the current time is prior to the Expiration Time" $ it "can be decoded and validated" $ - runReaderT (jwt >>= verifyClaims conf k) (utcTime "2010-01-01 00:00:00") + runReaderT (jwt >>= verifyClaims conf k . fixType) (utcTime "2010-01-01 00:00:00") `shouldBe` (Right exampleClaimsSet :: Either JWTError ClaimsSet) describe "when the current time is after the Expiration Time" $ it "can be decoded, but not validated" $ - runReaderT (jwt >>= verifyClaims conf k) (utcTime "2012-01-01 00:00:00") + runReaderT (jwt >>= verifyClaims conf k . fixType) (utcTime "2012-01-01 00:00:00") `shouldBe` Left JWTExpired describe "when signature is invalid and token is expired" $ it "fails on sig validation (claim validation not reached)" $ do let jwt' = decodeCompact (exampleJWT <> "badsig") - (runReaderT (jwt' >>= verifyClaims conf k) (utcTime "2012-01-01 00:00:00") + (runReaderT (jwt' >>= verifyClaims conf k . fixType) (utcTime "2012-01-01 00:00:00") :: Either JWTError ClaimsSet) `shouldSatisfy` is (_Left . _JWSInvalidSignature)