jwt 0.10.1 → 0.12.0
raw patch · 8 files changed
Files
- CHANGELOG.md +17/−0
- README.md +0/−3
- doctests.hs +5/−2
- jwt.cabal +42/−23
- src/Web/JWT.hs +167/−81
- stack.yaml +2/−0
- tests/src/Web/JWTInteropTests.hs +2/−1
- tests/src/Web/JWTTests.hs +40/−15
CHANGELOG.md view
@@ -1,3 +1,20 @@+# 2026-09-26 0.12.0++* Fix bug where fractional NumericDate's were being parsed incorrectly.+ [#4](https://github.com/puffnfresh/haskell-jwt/issues/4).+* Pull updates in cryptostore, fixing build with crypton.+* Stabilize ordering of keys, both in the header and in claims, resolving+ [#2](https://github.com/puffnfresh/haskell-jwt/issues/2).+* Fix and reenable doctests.+* Drop support for aeson < 2.++# 2021-12-11 0.11.0++* Added support for RSA256 Public Key verification. This in turn means that some +methods are available to verify that are not available to encode; causing a +breaking API change. The `toVerify` method and the new `EncodeSigner` and `VerifySigner` +are the major changes.+ # 2021-12-02 0.10.1 * Add support for Aeson 2.x
README.md view
@@ -11,6 +11,3 @@ > and/or encrypted. See the [Web.JWT module](http://hackage.haskell.org/package/jwt/docs/Web-JWT.html) documentation to get started.--[](https://travis-ci.org/juretta/haskell-jwt)
doctests.hs view
@@ -1,4 +1,7 @@-import Test.DocTest+import System.Exit (exitWith)+import System.Process (system) main :: IO ()-main = doctest ["-isrc", "src/Web"]+main = do+ exitWith =<< system "cabal repl --with-ghc=doctest"+ -- See README of doctest https://hackage.haskell.org/package/doctest
jwt.cabal view
@@ -2,17 +2,17 @@ -- documentation, see http://haskell.org/cabal/users-guide/ name: jwt-version: 0.10.1+version: 0.12.0 synopsis: JSON Web Token (JWT) decoding and encoding license: MIT license-file: LICENSE author: Brian McKenna maintainer: brian@brianmckenna.org-homepage: https://bitbucket.org/puffnfresh/haskell-jwt-bug-reports: https://bitbucket.org/puffnfresh/haskell-jwt/issues+homepage: https://github.com/puffnfresh/haskell-jwt+bug-reports: https://github.com/puffnfresh/haskell-jwt/issues category: Web build-type: Simple-cabal-version: >=1.16+cabal-version: 1.16 description: JSON Web Token (JWT) is a compact URL-safe means of representing claims to be transferred between two parties.@@ -27,27 +27,39 @@ source-repository head type: git- location: https://bitbucket.org/puffnfresh/haskell-jwt.git+ location: https://github.com/puffnfresh/haskell-jwt.git +-- Drop this when cryptostore does+flag use_crypton+ description: Use crypton instead of cryptonite+ manual: True+ default: False+ library exposed-modules: Web.JWT other-modules: Data.Text.Extended, Data.ByteString.Extended build-depends: base >= 4.8 && < 5- , cryptonite >= 0.6- , memory >= 0.8- , bytestring >= 0.10- , text >= 0.11- , aeson >= 0.7- , containers >= 0.5- , unordered-containers >= 0.2- , scientific >= 0.2- , http-types >= 0.8- , time >= 1.1- , vector >= 0.7.1- , semigroups >= 0.15.4- , network-uri- , x509- , x509-store+ , cryptostore >= 0.5.0.0 && < 0.6+ , memory >= 0.8 && < 0.19+ , bytestring >= 0.10 && < 0.13+ , text >= 0.11 && < 2.2+ , aeson >= 2 && < 2.4+ , containers >= 0.5 && < 0.9+ , unordered-containers >= 0.2 && < 0.3+ , scientific >= 0.2 && < 0.4+ , http-types >= 0.8 && < 0.13+ , time >= 1.1 && < 1.17+ , vector >= 0.7.1 && < 0.14+ , semigroups >= 0.15.4 && < 0.21+ , network-uri >= 2.6 && < 2.7+ if flag(use_crypton)+ build-depends: crypton >= 0.31 && < 2.2+ , crypton-x509 < 1.10+ , crypton-x509-store < 1.10+ else+ build-depends: cryptonite >= 0.6 && < 0.31+ , x509 < 1.8+ , x509-store < 1.7 hs-source-dirs: src default-language: Haskell2010@@ -80,11 +92,11 @@ , lens , HUnit , QuickCheck >= 2.4.0.1- , cryptonite+ , cryptostore , memory , bytestring >= 0.10 , text >= 0.11- , aeson+ , aeson >= 2 , scientific >= 0.2 , containers , unordered-containers@@ -93,6 +105,12 @@ , vector >= 0.7.1 , semigroups >= 0.15.4 , network-uri+ if flag(use_crypton)+ build-depends: crypton+ , crypton-x509+ , crypton-x509-store+ else+ build-depends: cryptonite , x509 , x509-store @@ -105,4 +123,5 @@ ghc-options: -threaded build-depends: base < 5 && >= 4.8 , jwt- , doctest >= 0.9.11+ , doctest >= 0.20+ , process
src/Web/JWT.hs view
@@ -1,4 +1,3 @@-{-# LANGUAGE CPP #-} {-# LANGUAGE EmptyDataDecls #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GADTs #-}@@ -42,6 +41,8 @@ , tokenIssuer , hmacSecret , readRsaSecret+ , readRsaPublicKey+ , toVerify -- ** JWT structure , claims , header@@ -58,7 +59,8 @@ , UnverifiedJWT , VerifiedJWT , Signature- , Signer(..)+ , VerifySigner(..)+ , EncodeSigner(..) , JWT , Algorithm(..) , JWTClaimsSet(..)@@ -84,40 +86,34 @@ import Control.Monad import Crypto.Hash.Algorithms import Crypto.MAC.HMAC-import Crypto.PubKey.RSA (PrivateKey)-import Crypto.PubKey.RSA.PKCS15 (sign)+import Crypto.PubKey.RSA (PrivateKey, PublicKey)+import qualified Crypto.PubKey.RSA.PKCS15 as RSA+import Crypto.Store.X509 (readPubKeyFileFromMemory) import Data.ByteArray.Encoding import Data.Aeson hiding (decode, encode) import qualified Data.Aeson as JSON+import qualified Data.Aeson.Key as Key+import qualified Data.Aeson.KeyMap as KeyMap import qualified Data.Map as Map import Data.Maybe import Data.Scientific import qualified Data.Semigroup as Semigroup import Data.Time.Clock (NominalDiffTime)-import Data.X509 (PrivKey (PrivKeyRSA))+import Data.X509 (PrivKey (PrivKeyRSA), PubKey (PubKeyRSA)) import Data.X509.Memory (readKeyFileFromMemory) import qualified Network.URI as URI import Prelude hiding (exp) -#if MIN_VERSION_aeson(2,0,0)-import qualified Data.Aeson.Key as Key-import qualified Data.Aeson.KeyMap as KeyMap-#else-import qualified Data.HashMap.Strict as KeyMap-#endif---- $setup--- The code examples in this module require GHC's `OverloadedStrings`--- extension:------ >>> :set -XOverloadedStrings- {-# DEPRECATED JWTHeader "Use JOSEHeader instead. JWTHeader will be removed in 1.0" #-} type JWTHeader = JOSEHeader -data Signer = HMACSecret BS.ByteString- | RSAPrivateKey PrivateKey+data VerifySigner = VerifyHMACSecret BS.ByteString+ | VerifyRSAPrivateKey PrivateKey+ | VerifyRSAPublicKey PublicKey +data EncodeSigner = EncodeHMACSecret BS.ByteString+ | EncodeRSAPrivateKey PrivateKey+ newtype Signature = Signature T.Text deriving (Show) instance Eq Signature where@@ -159,12 +155,16 @@ -- | A JSON numeric value representing the number of seconds from -- 1970-01-01T0:0:0Z UTC until the specified UTC date/time.-newtype NumericDate = NumericDate Integer deriving (Show, Eq, Ord)-+--+-- Per RFC 7519 section 2, may be fractional.+newtype NumericDate = NumericDate Scientific deriving (Show, Eq, Ord) --- | Return the seconds since 1970-01-01T0:0:0Z UTC for the given 'IntDate'+-- | Convert the given 'NumericDate' into seconds since 1970-01-01T0:0:0Z.+--+-- >>> secondsSinceEpoch $ NumericDate 1777605333.111222+-- 1777605333.111222s secondsSinceEpoch :: NumericDate -> NominalDiffTime-secondsSinceEpoch (NumericDate s) = fromInteger s+secondsSinceEpoch (NumericDate s) = realToFrac s -- | A JSON string value, with the additional requirement that while -- arbitrary string values MAY be used, any value containing a ":"@@ -257,22 +257,22 @@ -- | Encode a claims set using the given secret ----- @+-- >>> :{ -- let -- cs = mempty { -- mempty returns a default JWTClaimsSet--- iss = stringOrURI "Foo"--- , unregisteredClaims = Map.fromList [("http://example.com/is_root", (Bool True))]+-- iss = stringOrURI . T.pack $ "Foo"+-- , unregisteredClaims = ClaimsMap $ Map.fromList [(T.pack "http://example.com/is_root", (Bool True))] -- }--- key = hmacSecret "secret-key"+-- key = hmacSecret . T.pack $ "secret-key" -- in encodeSigned key mempty cs--- @--- > "eyJ0eXAiOiJKV1QiLCJhbGciOiJIUzI1NiJ9.eyJodHRwOi8vZXhhbXBsZS5jb20vaXNfcm9vdCI6dHJ1ZSwiaXNzIjoiRm9vIn0.vHQHuG3ujbnBUmEp-fSUtYxk27rLiP2hrNhxpyWhb2E"-encodeSigned :: Signer -> JOSEHeader -> JWTClaimsSet -> T.Text+-- :}+-- "eyJ0eXAiOiJKV1QiLCJhbGciOiJIUzI1NiJ9.eyJpc3MiOiJGb28iLCJodHRwOi8vZXhhbXBsZS5jb20vaXNfcm9vdCI6dHJ1ZX0.9uim_nuzFyiZ3qqJrzZRieGTOLRNOYlYvmhrqg8KYfQ"+encodeSigned :: EncodeSigner -> JOSEHeader -> JWTClaimsSet -> T.Text encodeSigned signer header' claims' = dotted [header'', claim, signature'] where claim = encodeJWT claims' algo = case signer of- HMACSecret _ -> HS256- RSAPrivateKey _ -> RS256+ EncodeHMACSecret _ -> HS256+ EncodeRSAPrivateKey _ -> RS256 header'' = encodeJWT header' { typ = Just "JWT"@@ -282,16 +282,15 @@ -- | Encode a claims set without signing it ----- @--- let--- cs = mempty { -- mempty returns a default JWTClaimsSet--- iss = stringOrURI "Foo"--- , iat = numericDate 1394700934--- , unregisteredClaims = Map.fromList [("http://example.com/is_root", (Bool True))]--- }+-- >>> :{+-- let cs = mempty+-- { iss = stringOrURI . Data.Text.pack $ "Foo"+-- , iat = numericDate 1394700934+-- , unregisteredClaims = ClaimsMap $ Data.Map.fromList [(Data.Text.pack "http://example.com/is_root", (Bool True))]+-- } -- in encodeUnsigned cs mempty--- @--- > "eyJ0eXAiOiJKV1QiLCJhbGciOiJIUzI1NiJ9.eyJpYXQiOjEzOTQ3MDA5MzQsImh0dHA6Ly9leGFtcGxlLmNvbS9pc19yb290Ijp0cnVlLCJpc3MiOiJGb28ifQ."+-- :}+-- "eyJ0eXAiOiJKV1QiLCJhbGciOiJIUzI1NiJ9.eyJpc3MiOiJGb28iLCJpYXQiOjEzOTQ3MDA5MzQsImh0dHA6Ly9leGFtcGxlLmNvbS9pc19yb290Ijp0cnVlfQ." encodeUnsigned :: JWTClaimsSet -> JOSEHeader -> T.Text encodeUnsigned claims' header' = dotted [header'', claim, ""] where claim = encodeJWT claims'@@ -307,7 +306,7 @@ -- -- >>> :{ -- let--- input = "eyJ0eXAiOiJKV1QiLCJhbGciOiJIUzI1NiJ9.eyJzb21lIjoicGF5bG9hZCJ9.Joh1R2dYzkRvDkqv3sygm5YyK8Gi4ShZqbhK2gxcs2U" :: T.Text+-- input = Data.Text.pack "eyJ0eXAiOiJKV1QiLCJhbGciOiJIUzI1NiJ9.eyJzb21lIjoicGF5bG9hZCJ9.Joh1R2dYzkRvDkqv3sygm5YyK8Gi4ShZqbhK2gxcs2U" -- mJwt = decode input -- in fmap header mJwt -- :}@@ -317,7 +316,7 @@ -- -- >>> :{ -- let--- input = "eyJ0eXAiOiJKV1QiLCJhbGciOiJIUzI1NiJ9.eyJzb21lIjoicGF5bG9hZCJ9.Joh1R2dYzkRvDkqv3sygm5YyK8Gi4ShZqbhK2gxcs2U" :: T.Text+-- input = T.pack "eyJ0eXAiOiJKV1QiLCJhbGciOiJIUzI1NiJ9.eyJzb21lIjoicGF5bG9hZCJ9.Joh1R2dYzkRvDkqv3sygm5YyK8Gi4ShZqbhK2gxcs2U" -- mJwt = decode input -- in fmap claims mJwt -- :}@@ -346,17 +345,16 @@ -- -- >>> :{ -- let--- input = "eyJ0eXAiOiJKV1QiLCJhbGciOiJIUzI1NiJ9.eyJzb21lIjoicGF5bG9hZCJ9.Joh1R2dYzkRvDkqv3sygm5YyK8Gi4ShZqbhK2gxcs2U" :: T.Text+-- input = T.pack "eyJ0eXAiOiJKV1QiLCJhbGciOiJIUzI1NiJ9.eyJzb21lIjoicGF5bG9hZCJ9.Joh1R2dYzkRvDkqv3sygm5YyK8Gi4ShZqbhK2gxcs2U" -- mUnverifiedJwt = decode input--- mVerifiedJwt = verify (hmacSecret "secret") =<< mUnverifiedJwt+-- mVerifiedJwt = verify (toVerify . hmacSecret . T.pack $ "secret") =<< mUnverifiedJwt -- in signature =<< mVerifiedJwt -- :} -- Just (Signature "Joh1R2dYzkRvDkqv3sygm5YyK8Gi4ShZqbhK2gxcs2U")-verify :: Signer -> JWT UnverifiedJWT -> Maybe (JWT VerifiedJWT)+verify :: VerifySigner -> JWT UnverifiedJWT -> Maybe (JWT VerifiedJWT) verify signer (Unverified header' claims' unverifiedSignature originalClaim) = do- let calculatedSignature = Signature $ calculateDigest signer originalClaim- guard (unverifiedSignature == calculatedSignature)- pure $ Verified header' claims' calculatedSignature+ guard (verifyDigest signer unverifiedSignature originalClaim)+ pure $ Verified header' claims' unverifiedSignature -- | Decode a claims set and verify that the signature matches by using the supplied secret. -- The algorithm is based on the supplied header value.@@ -366,12 +364,12 @@ -- -- >>> :{ -- let--- input = "eyJ0eXAiOiJKV1QiLCJhbGciOiJIUzI1NiJ9.eyJzb21lIjoicGF5bG9hZCJ9.Joh1R2dYzkRvDkqv3sygm5YyK8Gi4ShZqbhK2gxcs2U" :: T.Text--- mJwt = decodeAndVerifySignature (hmacSecret "secret") input+-- input = T.pack "eyJ0eXAiOiJKV1QiLCJhbGciOiJIUzI1NiJ9.eyJzb21lIjoicGF5bG9hZCJ9.Joh1R2dYzkRvDkqv3sygm5YyK8Gi4ShZqbhK2gxcs2U"+-- mJwt = decodeAndVerifySignature (toVerify . hmacSecret . T.pack $ "secret") input -- in signature =<< mJwt -- :} -- Just (Signature "Joh1R2dYzkRvDkqv3sygm5YyK8Gi4ShZqbhK2gxcs2U")-decodeAndVerifySignature :: Signer -> T.Text -> Maybe (JWT VerifiedJWT)+decodeAndVerifySignature :: VerifySigner -> 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@@ -380,14 +378,20 @@ -- | Create a Secret using the given key. -- Consider using `HMACSecret` instead if your key is not already a "Data.Text".-hmacSecret :: T.Text -> Signer-hmacSecret = HMACSecret . TE.encodeUtf8+hmacSecret :: T.Text -> EncodeSigner+hmacSecret = EncodeHMACSecret . TE.encodeUtf8 +-- | Converts an EncodeSigner into a VerifySigner+-- If you can encode then you can always verify; but the reverse is not always true.+toVerify :: EncodeSigner -> VerifySigner+toVerify (EncodeHMACSecret s) = VerifyHMACSecret s+toVerify (EncodeRSAPrivateKey pk) = VerifyRSAPrivateKey pk+ -- | Create an RSAPrivateKey from PEM contents -- -- Please, consider using 'readRsaSecret' instead.-rsaKeySecret :: String -> IO (Maybe Signer)-rsaKeySecret = pure . fmap RSAPrivateKey . readRsaSecret . C8.pack+rsaKeySecret :: String -> IO (Maybe EncodeSigner)+rsaKeySecret = pure . fmap EncodeRSAPrivateKey . readRsaSecret . C8.pack -- | Create an RSA 'PrivateKey' from PEM contents --@@ -433,6 +437,30 @@ [(PrivKeyRSA k)] -> Just k _ -> Nothing ++-- | Create an RSA 'PublicKey' from PEM contents+--+-- > readRsaPublicKey <$> BS.readFile "foo.pub"+-- >>> :{+-- fromJust . readRsaPublicKey . Data.ByteString.Char8.pack $ Data.List.unlines+-- [ "-----BEGIN PUBLIC KEY-----"+-- , "MIIBIjANBgkqhkiG9w0BAQEFAAOCAQ8AMIIBCgKCAQEA12d4M6f3QQ9E52fVjoJ7"+-- , "HorKvi1A83f4YL4e7TU0Lj/73+afrRBtnAdl8dIrnYHLWRdL9T4+yw7+AimQgj1R"+-- , "zZO5FQN/qVxygkPeMKAZ53nObi2NyBbQYmRrBjx7rOz7UddI5qo/ApTWNrSBjDKK"+-- , "1splbuO2BoTrsHlsSoJDWps/5SwpEF4GGkn5c4nZRnpnayUZqolp+HwDK2Dys9MO"+-- , "GEIsUil1+k/76T96pBnPf6mf3X0IacTCNjJcztSaHCPWre1q45miQUGVlTmhfg/6"+-- , "L8xmNRxz4BZdv8Nv6STfRTsn6PqiaabD0vITVsF1AapdHohmPMwe+lG5ebUJEh8p"+-- , "HQIDAQAB"+-- , "-----END PUBLIC KEY-----"+-- ]+-- :}+-- PublicKey {public_size = 256, public_n = 27192258298637073499814714121384917708820189127612408586659742012541332375187297990620494295383503839337630959589643433993051132285579261506578281787130221431792495554016841577295914249477128682873612830754668313951998800261326356221445367133271958375798088350587817966390021082924122322621635687775325677158394714044356852489350530339926527334843762933075425870780010358838296108179073735084189560997222261973170469403371017667139302904425235800700389626242339763391588052694912470921008842459564204534000688115202764921141372629345213727775126077560633656612484128950350759146471467728292335666402631045889956718877, public_e = 65537}+readRsaPublicKey :: BS.ByteString -> Maybe PublicKey+readRsaPublicKey bs =+ case readPubKeyFileFromMemory bs of+ [(PubKeyRSA k)] -> Just k+ _ -> Nothing+ -- | Convert the `NominalDiffTime` into an IntDate. Returns a Nothing if the -- argument is invalid (e.g. the NominalDiffTime must be convertible into a -- positive Integer representing the seconds since epoch).@@ -441,11 +469,10 @@ intDate = numericDate -- | Convert the `NominalDiffTime` into an NumericDate. Returns a Nothing if the--- argument is invalid (e.g. the NominalDiffTime must be convertible into a--- positive Integer representing the seconds since epoch).+-- argument is invalid (e.g. negative NominalDiffTime). numericDate :: NominalDiffTime -> Maybe NumericDate numericDate i | i < 0 = Nothing-numericDate i = Just $ NumericDate $ round i+numericDate i = Just $ NumericDate $ normalize $ realToFrac i -- | Convert a `T.Text` into a 'StringOrURI`. Returns a Nothing if the -- String cannot be converted (e.g. if the String contains a ':' but is@@ -485,21 +512,31 @@ -- ================================================================================= -calculateDigest :: Signer -> T.Text -> T.Text-calculateDigest (HMACSecret key) msg =+calculateDigest :: EncodeSigner -> T.Text -> T.Text+calculateDigest (EncodeHMACSecret key) msg = TE.decodeUtf8 $ convertToBase Base64URLUnpadded (hmac key (TE.encodeUtf8 msg) :: HMAC SHA256) -calculateDigest (RSAPrivateKey key) msg = TE.decodeUtf8+calculateDigest (EncodeRSAPrivateKey key) msg = TE.decodeUtf8 $ convertToBase Base64URLUnpadded $ sign' $ TE.encodeUtf8 msg where sign' :: BS.ByteString -> BS.ByteString- sign' bs = case sign Nothing (Just SHA256) key bs of+ sign' bs = case RSA.sign Nothing (Just SHA256) key bs of Right sig -> sig Left _ -> error "impossible" -- This function can only fail with @SignatureTooLong@, -- which is impossible because we use a hash. +verifyDigest :: VerifySigner -> Signature -> T.Text -> Bool+verifyDigest (VerifyHMACSecret key) unverifiedSig msg = unverifiedSig == Signature (calculateDigest (EncodeHMACSecret key) msg)+verifyDigest (VerifyRSAPrivateKey pk) unverifiedSig msg = unverifiedSig == Signature (calculateDigest (EncodeRSAPrivateKey pk) msg)+verifyDigest (VerifyRSAPublicKey pk) (Signature base64Sig) msg =+ let+ decodedSig =+ convertFromBase Base64URLUnpadded (TE.encodeUtf8 base64Sig)+ in+ either (pure False) (RSA.verify (Just SHA256) pk (TE.encodeUtf8 msg)) decodedSig+ -- ================================================================================= newtype ClaimsMap = ClaimsMap { unClaimsMap :: Map.Map T.Text Value }@@ -515,13 +552,7 @@ ClaimsMap $ a Semigroup.<> b fromHashMap :: Object -> ClaimsMap-fromHashMap = ClaimsMap . Map.fromList . map (first toText) . KeyMap.toList- where-#if MIN_VERSION_aeson(2,0,0)- toText = Key.toText-#else- toText = id-#endif+fromHashMap = ClaimsMap . Map.fromList . map (first Key.toText) . KeyMap.toList removeRegisteredClaims :: ClaimsMap -> ClaimsMap removeRegisteredClaims (ClaimsMap input) = ClaimsMap $ Map.differenceWithKey (\_ _ _ -> Nothing) input registeredClaims@@ -537,13 +568,19 @@ , fmap ("nbf" .=) nbf , fmap ("iat" .=) iat , fmap ("jti" .=) jti- ] ++ map (first fromText) (Map.toList $ unClaimsMap $ removeRegisteredClaims unregisteredClaims)- where-#if MIN_VERSION_aeson(2,0,0)- fromText = Key.fromText-#else- fromText = id-#endif+ ] ++ map (first Key.fromText)+ (Map.toList $ unClaimsMap $ removeRegisteredClaims unregisteredClaims)+ -- See [NOTE] Encoding VS Value, and json objects keys ordering+ toEncoding JWTClaimsSet{..} = pairs . mconcat $ catMaybes [+ fmap ("iss" .=) iss+ , fmap ("sub" .=) sub+ , either ("aud" .=) ("aud" .=) <$> aud+ , fmap ("exp" .=) exp+ , fmap ("nbf" .=) nbf+ , fmap ("iat" .=) iat+ , fmap ("jti" .=) jti+ ] ++ map (uncurry (.=) . first Key.fromText)+ (Map.toList $ unClaimsMap $ removeRegisteredClaims unregisteredClaims) instance FromJSON JWTClaimsSet where parseJSON = withObject "JWTClaimsSet"@@ -575,13 +612,59 @@ , fmap ("alg" .=) alg , fmap ("kid" .=) kid ]+ -- See [NOTE] Encoding VS Value, and json objects keys ordering+ toEncoding JOSEHeader{..} = pairs . mconcat . catMaybes $ [+ fmap ("typ" .=) typ+ , fmap ("cty" .=) cty+ , fmap ("alg" .=) alg+ , fmap ("kid" .=) kid+ ] +{- [NOTE] Encoding VS Value, and json objects keys ordering++Unlike Encoding, aeson's Value may, and will, reorder keys.++This can cause annoying issues, where the JWT encodings that we produce may "wobble"+across (non-breaking) updates in dependencies (particularly, in unordered-containers).++One such issue was reported at https://github.com/puffnfresh/haskell-jwt/issues/2 .+Both encodings are technically correct and valid -- yet, this broke somebody's test+and ate people's time.++Another occurrence manifested in doctests of this very module. There, it is especially+vexing, because doctests showcase API usage primarily (and as a bonus, double-duty as tests).+I.e. doctests are not the place to be explicitly handling multiple valid outputs+(the in-code "expected value" may validly be this, or that, depending on what exact versions+of dependencies we're compiling with), all the while exemplifying how to get any JWT output+in the first place. But, where?++In ToJSON class, there's an optional toEncoding method that can stabilize the ordering.+-}+ instance ToJSON NumericDate where- toJSON (NumericDate i) = Number $ scientific (fromIntegral i) 0+ toJSON (NumericDate i) = Number i +-- | Per the RFC, supports fractional durations.+--+-- At the same time, exp=1e999999999 should not blow up programs.+--+-- >>> eitherDecode "1777605333" :: Either String NumericDate+-- Right (NumericDate 1.777605333e9)+--+-- >>> eitherDecode "1777605333.005" :: Either String NumericDate+-- Right (NumericDate 1.777605333005e9)+--+-- >>> eitherDecode "1777605333e9999" :: Either String NumericDate+-- Left "Error in $: NumericDate too far into future" instance FromJSON NumericDate where- parseJSON (Number x) = return $ NumericDate $ coefficient x- parseJSON _ = mzero+ parseJSON = withScientific "exp claim"+ $ (. normalize)+ $ \x -> do+ -- this is withBoundedScientific; prevents huge exponent DoS.+ -- 10'000 nominal years is ~3.1e11 seconds.+ when (base10Exponent x > 12) $+ fail "NumericDate too far into future"+ return $ NumericDate x instance ToJSON Algorithm where toJSON HS256 = String ("HS256"::T.Text)@@ -600,6 +683,9 @@ parseJSON (String s) | URI.isURI $ T.unpack s = return $ U $ fromMaybe URI.nullURI $ URI.parseURI $ T.unpack s parseJSON (String s) = return $ S s parseJSON _ = mzero++-- $setup+-- >>> :seti -XOverloadedStrings -- $docDecoding -- There are three use cases supported by the set of decoding/verification
stack.yaml view
@@ -3,3 +3,5 @@ extra-deps: - aeson-2.0.0.0 - lens-aeson-1.1.2+ - cryptostore-0.2.1.0+ - doctest-0.20.0
tests/src/Web/JWTInteropTests.hs view
@@ -24,6 +24,7 @@ import Prelude hiding (exp) import Control.Lens+import qualified Data.Aeson.Key as Key import Data.Aeson.Lens import Data.Aeson.Types import qualified Data.Map as Map@@ -56,7 +57,7 @@ shouldBeMaybeStringOrUri :: ToJSON a => T.Text -> (a -> Maybe StringOrURI) -> a -> Bool shouldBeMaybeStringOrUri key' f claims' = - let json = toJSON claims' ^? key key'+ let json = toJSON claims' ^? key (Key.fromText key') in json == (fmap (String . stringOrURIToText) $ f claims') prop_encode_decode_aud :: JWTClaimsSet -> Bool
tests/src/Web/JWTTests.hs view
@@ -12,16 +12,19 @@ import Test.Tasty.TH import Test.Tasty.HUnit import Test.Tasty.QuickCheck-import qualified Test.QuickCheck as QC+import qualified Test.QuickCheck as QC import qualified Data.Map as Map import qualified Data.Text as T import qualified Data.Text.Lazy as TL-import qualified Data.ByteString as BS+import qualified Data.ByteString as BS import Data.Aeson.Types import Data.Maybe import Data.String (fromString) import Data.Time import Web.JWT+import qualified Crypto.PubKey.RSA as RSA+import qualified Crypto.Random.Types as CT+import qualified Data.ByteArray as BA defaultTestGroup :: TestTree defaultTestGroup = $(testGroupGenerator)@@ -57,13 +60,13 @@ case_verify = do -- Generated with ruby-jwt let input = "eyJ0eXAiOiJKV1QiLCJhbGciOiJIUzI1NiJ9.eyJzb21lIjoicGF5bG9hZCJ9.Joh1R2dYzkRvDkqv3sygm5YyK8Gi4ShZqbhK2gxcs2U"- mVerified = verify (hmacSecret "secret") =<< decode input+ mVerified = verify (toVerify . hmacSecret $ "secret") =<< decode input True @=? isJust mVerified case_decodeAndVerifyJWT = do -- Generated with ruby-jwt let input = "eyJ0eXAiOiJKV1QiLCJhbGciOiJIUzI1NiJ9.eyJzb21lIjoicGF5bG9hZCJ9.Joh1R2dYzkRvDkqv3sygm5YyK8Gi4ShZqbhK2gxcs2U"- mJwt = decodeAndVerifySignature (hmacSecret "secret") input+ mJwt = decodeAndVerifySignature (toVerify . hmacSecret $ "secret") input True @=? isJust mJwt let (Just verified) = mJwt Just HS256 @=? alg (header verified)@@ -89,13 +92,13 @@ } -} let input = "eyJhbGciOiJub25lIiwidHlwIjoiSldUIn0.eyJpc3MiOiJodHRwczovL2p3dC1pZHAuZXhhbXBsZS5jb20iLCJzdWIiOiJtYWlsdG86bWlrZUBleGFtcGxlLmNvbSIsIm5iZiI6MTQyNTk4MDc1NSwiZXhwIjoxNDI1OTg0MzU1LCJpYXQiOjE0MjU5ODA3NTUsImp0aSI6ImlkMTIzNDU2IiwidHlwIjoiaHR0cHM6Ly9leGFtcGxlLmNvbS9yZWdpc3RlciJ9."- mJwt = decodeAndVerifySignature (hmacSecret "secretkey") input+ mJwt = decodeAndVerifySignature (toVerify . hmacSecret $ "secretkey") input False @=? isJust mJwt case_decodeAndVerifyJWTFailing = do -- Generated with ruby-jwt, modified to be invalid let input = "eyJ0eXAiOiJKV1QiLCJhbGciOiJIUzI1NiJ9.eyJzb21lIjoicGF5bG9hZCJ9.Joh1R2dYzkRvDkqv3sygm5YyK8Gi4ShZqbhK2gxcs2u"- mJwt = decodeAndVerifySignature (hmacSecret "secret") input+ mJwt = decodeAndVerifySignature (toVerify . hmacSecret $ "secret") input False @=? isJust mJwt case_decodeInvalidInput = do@@ -105,7 +108,7 @@ case_decodeAndVerifySignatureInvalidInput = do let inputs = ["", "a.", "a.b"]- result = map (decodeAndVerifySignature (hmacSecret "secret")) inputs+ result = map (decodeAndVerifySignature (toVerify . hmacSecret $ "secret")) inputs True @=? all isNothing result case_encodeJWTNoMac = do@@ -162,8 +165,8 @@ , iat = numericDate now , unregisteredClaims = ClaimsMap $ Map.fromList [("http://example.com/is_root", Bool True)] }- let secret' = hmacSecret "secret"- jwt = decodeAndVerifySignature secret' $ encodeSigned secret' mempty cs+ let secret' = hmacSecret "secret"+ jwt = decodeAndVerifySignature (toVerify secret') $ encodeSigned secret' mempty cs Just cs @=? fmap claims jwt case_encodeDecodeJWTClaimsSetWithSingleAud = do@@ -174,7 +177,7 @@ , iat = numericDate now } let secret' = hmacSecret "secret"- jwt = decodeAndVerifySignature secret' $ encodeSigned secret' mempty cs+ jwt = decodeAndVerifySignature (toVerify secret') $ encodeSigned secret' mempty cs Just cs @=? fmap claims jwt case_encodeDecodeJWTClaimsSetWithMultipleAud = do@@ -185,7 +188,7 @@ , iat = numericDate now } let secret' = hmacSecret "secret"- jwt = decodeAndVerifySignature secret' $ encodeSigned secret' mempty cs+ jwt = decodeAndVerifySignature (toVerify secret') $ encodeSigned secret' mempty cs Just cs @=? fmap claims jwt case_encodeDecodeJWTClaimsSetBinarySecret = do@@ -195,8 +198,8 @@ , iat = numericDate now } secretKey <- BS.readFile "tests/jwt.secret.1"- let secret' = HMACSecret secretKey- jwt = decodeAndVerifySignature secret' $ encodeSigned secret' mempty cs+ let secret' = EncodeHMACSecret secretKey+ jwt = decodeAndVerifySignature (toVerify secret') $ encodeSigned secret' mempty cs Just cs @=? fmap claims jwt prop_stringOrURIProp = f@@ -218,15 +221,37 @@ prop_encode_decode_binary_secret = f where f :: BS.ByteString -> JWTClaimsSet -> Bool- f binary claims' = let Just unverified = (decode $ encodeSigned (HMACSecret binary) mempty claims')+ f binary claims' = let Just unverified = (decode $ encodeSigned (EncodeHMACSecret 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 mempty claims')+ Just verified = (decodeAndVerifySignature (toVerify key) $ encodeSigned key mempty claims') in claims verified == claims' +-- Generating a keypair takes over a second. Let's only do this a few times.+prop_rsa_verify_with_public_key = withMaxSuccess 20 f+ where f :: Keypair -> JWTClaimsSet -> Bool+ f kp claims' = let encodeSigner = EncodeRSAPrivateKey . kpPrivate $ kp+ verifySigner = VerifyRSAPublicKey . kpPublic $ kp+ signedToken = encodeSigned encodeSigner mempty claims'+ in isJust $ decodeAndVerifySignature verifySigner signedToken++data Keypair = Keypair+ { kpPrivate :: RSA.PrivateKey+ , kpPublic :: RSA.PublicKey+ } deriving (Show)++instance Arbitrary (Keypair) where+ arbitrary = do+ (pubKey, privateKey) <- RSA.generate 256 3+ return $ Keypair { kpPrivate = privateKey, kpPublic = pubKey }++instance CT.MonadRandom Gen where+ getRandomBytes size = do+ bytes <- vector size+ return . BA.pack $ bytes instance Arbitrary JWTClaimsSet where arbitrary = JWTClaimsSet <$> arbitrary