diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,8 @@ +# 2019-03-25 0.10.0 + +* Add "kid" and allow specifying JOSEHeader +* Clean up docs and remove confusing JSON type alias + # 2018-01-04 0.9.0 * Switch from RSA and HsOpenSSL to x509-store diff --git a/jwt.cabal b/jwt.cabal --- a/jwt.cabal +++ b/jwt.cabal @@ -2,7 +2,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/ name: jwt -version: 0.9.0 +version: 0.10.0 synopsis: JSON Web Token (JWT) decoding and encoding license: MIT license-file: LICENSE diff --git a/src/Web/JWT.hs b/src/Web/JWT.hs --- a/src/Web/JWT.hs +++ b/src/Web/JWT.hs @@ -52,10 +52,6 @@ , stringOrURI , stringOrURIToText , secondsSinceEpoch - -- ** JWT header - , typ - , cty - , alg -- * Types , UnverifiedJWT @@ -63,7 +59,6 @@ , Signature , Signer(..) , JWT - , JSON , Algorithm(..) , JWTClaimsSet(..) , ClaimsMap(..) @@ -71,7 +66,7 @@ , NumericDate , StringOrURI , JWTHeader - , JOSEHeader + , JOSEHeader(..) -- * Deprecated , rsaKeySecret @@ -109,8 +104,6 @@ -- -- >>> :set -XOverloadedStrings -type JSON = T.Text - {-# DEPRECATED JWTHeader "Use JOSEHeader instead. JWTHeader will be removed in 1.0" #-} type JWTHeader = JOSEHeader @@ -196,16 +189,24 @@ -- -- See , alg :: Maybe Algorithm + -- | The "kid" (key ID) Header Parameter is a hint indicating which key + -- was used to secure the JWS. This parameter allows originators to + -- explicitly signal a change of key to recipients. The structure of + -- the "kid" value is unspecified. Its value MUST be a case-sensitive + -- string. Use of this Header Parameter is OPTIONAL. + -- + -- See + , kid :: Maybe T.Text } deriving (Eq, Show) instance Monoid JOSEHeader where mempty = - JOSEHeader Nothing Nothing Nothing + JOSEHeader Nothing Nothing Nothing Nothing mappend = (Semigroup.<>) instance Semigroup.Semigroup JOSEHeader where - JOSEHeader a b c <> JOSEHeader a' b' c' = - JOSEHeader (a <|> a') (b <|> b') (c <|> c') + JOSEHeader a b c d <> JOSEHeader a' b' c' d' = + JOSEHeader (a <|> a') (b <|> b') (c <|> c') (d <|> d') -- | The JWT Claims Set represents a JSON object whose members are the claims conveyed by the JWT. data JWTClaimsSet = JWTClaimsSet { @@ -255,21 +256,21 @@ -- , unregisteredClaims = Map.fromList [("http://example.com/is_root", (Bool True))] -- } -- key = hmacSecret "secret-key" --- in encodeSigned key cs +-- in encodeSigned key mempty cs -- @ -- > "eyJ0eXAiOiJKV1QiLCJhbGciOiJIUzI1NiJ9.eyJodHRwOi8vZXhhbXBsZS5jb20vaXNfcm9vdCI6dHJ1ZSwiaXNzIjoiRm9vIn0.vHQHuG3ujbnBUmEp-fSUtYxk27rLiP2hrNhxpyWhb2E" -encodeSigned :: Signer -> JWTClaimsSet -> JSON -encodeSigned signer claims' = dotted [header', claim, signature'] +encodeSigned :: Signer -> JOSEHeader -> JWTClaimsSet -> T.Text +encodeSigned signer header' claims' = dotted [header'', claim, signature'] where claim = encodeJWT claims' algo = case signer of HMACSecret _ -> HS256 RSAPrivateKey _ -> RS256 - header' = encodeJWT mempty { + header'' = encodeJWT header' { typ = Just "JWT" , alg = Just algo } - signature' = calculateDigest signer (dotted [header', claim]) + signature' = calculateDigest signer (dotted [header'', claim]) -- | Encode a claims set without signing it -- @@ -280,13 +281,13 @@ -- , iat = numericDate 1394700934 -- , unregisteredClaims = Map.fromList [("http://example.com/is_root", (Bool True))] -- } --- in encodeUnsigned cs +-- in encodeUnsigned cs mempty -- @ -- > "eyJ0eXAiOiJKV1QiLCJhbGciOiJIUzI1NiJ9.eyJpYXQiOjEzOTQ3MDA5MzQsImh0dHA6Ly9leGFtcGxlLmNvbS9pc19yb290Ijp0cnVlLCJpc3MiOiJGb28ifQ." -encodeUnsigned :: JWTClaimsSet -> JSON -encodeUnsigned claims' = dotted [header', claim, ""] +encodeUnsigned :: JWTClaimsSet -> JOSEHeader -> T.Text +encodeUnsigned claims' header' = dotted [header'', claim, ""] where claim = encodeJWT claims' - header' = encodeJWT mempty { + header'' = encodeJWT header' { typ = Just "JWT" , alg = Just HS256 } @@ -302,7 +303,7 @@ -- mJwt = decode input -- in fmap header mJwt -- :} --- Just (JOSEHeader {typ = Just "JWT", cty = Nothing, alg = Just HS256}) +-- Just (JOSEHeader {typ = Just "JWT", cty = Nothing, alg = Just HS256, kid = Nothing}) -- -- and -- @@ -313,7 +314,7 @@ -- in fmap claims mJwt -- :} -- Just (JWTClaimsSet {iss = Nothing, sub = Nothing, aud = Nothing, exp = Nothing, nbf = Nothing, iat = Nothing, jti = Nothing, unregisteredClaims = ClaimsMap {unClaimsMap = fromList [("some",String "payload")]}}) -decode :: JSON -> Maybe (JWT UnverifiedJWT) +decode :: T.Text -> Maybe (JWT UnverifiedJWT) decode input = do (h,c,s) <- extractElems $ T.splitOn "." input let header' = parseJWT h @@ -362,15 +363,15 @@ -- in signature =<< mJwt -- :} -- Just (Signature "Joh1R2dYzkRvDkqv3sygm5YyK8Gi4ShZqbhK2gxcs2U") -decodeAndVerifySignature :: Signer -> JSON -> Maybe (JWT VerifiedJWT) +decodeAndVerifySignature :: Signer -> T.Text -> Maybe (JWT VerifiedJWT) decodeAndVerifySignature signer input = verify signer =<< decode input -- | Try to extract the value for the issue claim field 'iss' from the web token in JSON form -tokenIssuer :: JSON -> Maybe StringOrURI +tokenIssuer :: T.Text -> Maybe StringOrURI tokenIssuer = decode >=> fmap pure claims >=> iss -- | Create a Secret using the given key. --- Consider using `binarySecret` instead if your key is not already a "Data.Text". +-- Consider using `HMACSecret` instead if your key is not already a "Data.Text". hmacSecret :: T.Text -> Signer hmacSecret = HMACSecret . TE.encodeUtf8 @@ -418,7 +419,7 @@ -- :} -- PrivateKey {private_pub = PublicKey {public_size = 256, public_n = 1846..., public_e = 65537}, private_d = 8823..., private_p = 135..., private_q = 1358..., private_dP = 1373..., private_dQ = 9100..., private_qinv = 8859...} -- -readRsaSecret :: BS.ByteString -> (Maybe PrivateKey) +readRsaSecret :: BS.ByteString -> Maybe PrivateKey readRsaSecret bs = case readKeyFileFromMemory bs of [(PrivKeyRSA k)] -> Just k @@ -544,13 +545,15 @@ (\o -> JOSEHeader <$> o .:? "typ" <*> o .:? "cty" - <*> o .:? "alg") + <*> o .:? "alg" + <*> o .:? "kid") instance ToJSON JOSEHeader where toJSON JOSEHeader{..} = object $ catMaybes [ fmap ("typ" .=) typ , fmap ("cty" .=) cty , fmap ("alg" .=) alg + , fmap ("kid" .=) kid ] instance ToJSON NumericDate where diff --git a/tests/src/Web/JWTTests.hs b/tests/src/Web/JWTTests.hs --- a/tests/src/Web/JWTTests.hs +++ b/tests/src/Web/JWTTests.hs @@ -113,7 +113,7 @@ iss = stringOrURI "Foo" , unregisteredClaims = ClaimsMap $ Map.fromList [("http://example.com/is_root", Bool True)] } - jwt = encodeUnsigned cs + jwt = encodeUnsigned cs mempty -- Verify the shape of the JWT, ensure the shape of the triple of --
.. let (h:c:s:_) = T.splitOn "." jwt @@ -127,7 +127,7 @@ iss = stringOrURI "Foo" , unregisteredClaims = ClaimsMap $ Map.fromList [("http://example.com/is_root", Bool True)] } - mJwt = decode $ encodeUnsigned cs + mJwt = decode $ encodeUnsigned cs mempty True @=? isJust mJwt let (Just unverified) = mJwt cs @=? claims unverified @@ -140,7 +140,7 @@ , unregisteredClaims = ClaimsMap $ Map.fromList [("http://example.com/is_root", Bool True)] } key = hmacSecret "secret-key" - mJwt = decode $ encodeSigned key cs + mJwt = decode $ encodeSigned key mempty cs let (Just claims') = fmap claims mJwt cs @=? claims' Just now @=? fmap secondsSinceEpoch (iat claims') @@ -152,7 +152,7 @@ , unregisteredClaims = ClaimsMap $ Map.fromList [("http://example.com/is_root", Bool True)] } key = hmacSecret "secret-key" - t = encodeSigned key cs + t = encodeSigned key mempty cs iss' @=? tokenIssuer t case_encodeDecodeJWTClaimsSetCustomClaims = do @@ -163,7 +163,7 @@ , unregisteredClaims = ClaimsMap $ Map.fromList [("http://example.com/is_root", Bool True)] } let secret' = hmacSecret "secret" - jwt = decodeAndVerifySignature secret' $ encodeSigned secret' cs + jwt = decodeAndVerifySignature secret' $ encodeSigned secret' mempty cs Just cs @=? fmap claims jwt case_encodeDecodeJWTClaimsSetWithSingleAud = do @@ -174,7 +174,7 @@ , iat = numericDate now } let secret' = hmacSecret "secret" - jwt = decodeAndVerifySignature secret' $ encodeSigned secret' cs + jwt = decodeAndVerifySignature secret' $ encodeSigned secret' mempty cs Just cs @=? fmap claims jwt case_encodeDecodeJWTClaimsSetWithMultipleAud = do @@ -185,7 +185,7 @@ , iat = numericDate now } let secret' = hmacSecret "secret" - jwt = decodeAndVerifySignature secret' $ encodeSigned secret' cs + jwt = decodeAndVerifySignature secret' $ encodeSigned secret' mempty cs Just cs @=? fmap claims jwt case_encodeDecodeJWTClaimsSetBinarySecret = do @@ -196,7 +196,7 @@ } secretKey <- BS.readFile "tests/jwt.secret.1" let secret' = HMACSecret secretKey - jwt = decodeAndVerifySignature secret' $ encodeSigned secret' cs + jwt = decodeAndVerifySignature secret' $ encodeSigned secret' mempty cs Just cs @=? fmap claims jwt prop_stringOrURIProp = f @@ -213,18 +213,18 @@ prop_encode_decode = f where f :: T.Text -> JWTClaimsSet -> Bool - f key claims' = let Just unverified = (decode $ encodeSigned (hmacSecret key) claims') + f key claims' = let Just unverified = (decode $ encodeSigned (hmacSecret key) mempty claims') in claims unverified == claims' prop_encode_decode_binary_secret = f where f :: BS.ByteString -> JWTClaimsSet -> Bool - f binary claims' = let Just unverified = (decode $ encodeSigned (HMACSecret binary) claims') + f binary claims' = let Just unverified = (decode $ encodeSigned (HMACSecret binary) mempty claims') in claims unverified == claims' prop_encode_decode_verify_signature = f where f :: T.Text -> JWTClaimsSet -> Bool f key' claims' = let key = hmacSecret key' - Just verified = (decodeAndVerifySignature key $ encodeSigned key claims') + Just verified = (decodeAndVerifySignature key $ encodeSigned key mempty claims') in claims verified == claims' diff --git a/tests/src/Web/JWTTestsCompat.hs b/tests/src/Web/JWTTestsCompat.hs --- a/tests/src/Web/JWTTestsCompat.hs +++ b/tests/src/Web/JWTTestsCompat.hs @@ -41,7 +41,7 @@ , unregisteredClaims = ClaimsMap $ Map.fromList [("http://example.com/is_root", Bool True)] } key = hmacSecret "secret-key" - mJwt = decode $ encodeSigned key cs + mJwt = decode $ encodeSigned key mempty cs let (Just claims') = fmap claims mJwt cs @=? claims' Just now @=? fmap secondsSinceEpoch (iat claims')