jwt 0.11.0 → 0.12.0
raw patch · 6 files changed
+137/−63 lines, 6 filesdep +cryptondep +crypton-x509dep +crypton-x509-storedep ~aesondep ~bytestringdep ~containersPVP ok
version bump matches the API change (PVP)
Dependencies added: crypton, crypton-x509, crypton-x509-store, process
Dependency ranges changed: aeson, bytestring, containers, cryptonite, cryptostore, http-types, memory, network-uri, scientific, semigroups, text, time, unordered-containers, vector, x509, x509-store
API changes (from Hackage documentation)
Files
- CHANGELOG.md +10/−0
- README.md +0/−3
- doctests.hs +5/−2
- jwt.cabal +40/−23
- src/Web/JWT.hs +80/−34
- tests/src/Web/JWTInteropTests.hs +2/−1
CHANGELOG.md view
@@ -1,3 +1,13 @@+# 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
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://bitbucket.org/puffnfresh/haskell-jwt/addon/pipelines/home)
doctests.hs view
@@ -1,4 +1,7 @@-import Test.DocTest+import System.Exit (exitWith)+import System.Process (system) main :: IO ()-main = doctest ["-isrc", "src"]+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.11.0+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,28 +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- , cryptostore >= 0.2- , 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@@ -81,12 +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@@ -95,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 @@ -108,3 +124,4 @@ build-depends: base < 5 && >= 4.8 , jwt , doctest >= 0.20+ , process
src/Web/JWT.hs view
@@ -1,4 +1,3 @@-{-# LANGUAGE CPP #-} {-# LANGUAGE EmptyDataDecls #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GADTs #-}@@ -93,6 +92,8 @@ 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@@ -103,13 +104,6 @@ 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- {-# DEPRECATED JWTHeader "Use JOSEHeader instead. JWTHeader will be removed in 1.0" #-} type JWTHeader = JOSEHeader @@ -161,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 ":"@@ -268,7 +266,7 @@ -- key = hmacSecret . T.pack $ "secret-key" -- in encodeSigned key mempty cs -- :}--- "eyJ0eXAiOiJKV1QiLCJhbGciOiJIUzI1NiJ9.eyJodHRwOi8vZXhhbXBsZS5jb20vaXNfcm9vdCI6dHJ1ZSwiaXNzIjoiRm9vIn0.vHQHuG3ujbnBUmEp-fSUtYxk27rLiP2hrNhxpyWhb2E"+-- "eyJ0eXAiOiJKV1QiLCJhbGciOiJIUzI1NiJ9.eyJpc3MiOiJGb28iLCJodHRwOi8vZXhhbXBsZS5jb20vaXNfcm9vdCI6dHJ1ZX0.9uim_nuzFyiZ3qqJrzZRieGTOLRNOYlYvmhrqg8KYfQ" encodeSigned :: EncodeSigner -> JOSEHeader -> JWTClaimsSet -> T.Text encodeSigned signer header' claims' = dotted [header'', claim, signature'] where claim = encodeJWT claims'@@ -292,7 +290,7 @@ -- } -- in encodeUnsigned cs mempty -- :}--- "eyJ0eXAiOiJKV1QiLCJhbGciOiJIUzI1NiJ9.eyJpYXQiOjEzOTQ3MDA5MzQsImh0dHA6Ly9leGFtcGxlLmNvbS9pc19yb290Ijp0cnVlLCJpc3MiOiJGb28ifQ."+-- "eyJ0eXAiOiJKV1QiLCJhbGciOiJIUzI1NiJ9.eyJpc3MiOiJGb28iLCJpYXQiOjEzOTQ3MDA5MzQsImh0dHA6Ly9leGFtcGxlLmNvbS9pc19yb290Ijp0cnVlfQ." encodeUnsigned :: JWTClaimsSet -> JOSEHeader -> T.Text encodeUnsigned claims' header' = dotted [header'', claim, ""] where claim = encodeJWT claims'@@ -471,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@@ -555,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@@ -577,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"@@ -615,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)@@ -640,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
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