jwt 0.6.0 → 0.7.0
raw patch · 12 files changed
+255/−290 lines, 12 filesdep +cryptonitedep +memorydep −base64-bytestringdep −cryptohashdep −doctest-discoverdep ~basedep ~network-uri
Dependencies added: cryptonite, memory
Dependencies removed: base64-bytestring, cryptohash, doctest-discover, network
Dependency ranges changed: base, network-uri
Files
- CHANGELOG.md +86/−0
- changelog +0/−88
- doctests.hs +3/−1
- jwt.cabal +17/−35
- src/Data/Text/Extended.hs +0/−1
- src/Web/Base64.hs +0/−30
- src/Web/JWT.hs +70/−51
- tests/src/TestRunner.hs +2/−2
- tests/src/Web/Base64Tests.hs +0/−56
- tests/src/Web/JWTInteropTests.hs +4/−4
- tests/src/Web/JWTTests.hs +19/−22
- tests/src/Web/JWTTestsCompat.hs +54/−0
+ CHANGELOG.md view
@@ -0,0 +1,86 @@+# 2016-02-20 0.7.0++ * Update JWT to match RFC 7519. This is a backward compatible change with+ deprecation warnings added for types and functions to be removed in the+ future.+ * Add NumericDate as a replacement for IntDate (and numericDate as a + replacement for intDate)+ * Add JOSEHeader as a replacement for JWTHeader.+ * Use Stack and LTS 4.0+ * Use cryptonite instead of cryptohash (Thanks to Greg V)+ * Remove Web.Base64 in favour of using `memory` (Thanks to Greg V)++# 2015-04-22 0.6.0++ * Execute doctests in addition to the testsuite when using 'make test'.+ * Export `ClaimsMap` type alias (fixes #12)+ * Allow base 4.8+ * Lowered required cabal library version (to 1.16) to workaround build+ issues in a consumer project.+ * Add 7.10.1 to the travis config++# 2015-01-19 0.5.3++ * Add the missing `other-modules` field to the .cabal file so that + all the tests are present in the source distribution. Thanks to + Richard Wallace for reporting this.++# 2015-01-17 0.5.2++ * Tim McLean pointed out that comparing signatures may be susceptible to+ a timing attack in the way the signatures were compared (using the default+ Eq instance). Both `Signature` and `Secret` now have an `Eq` instance that+ uses a constant time comparison function. Thanks Tim for reporting this.++# 2015-01-03 0.5.1++ * Fix the encoding of the `aud` part of the claim.+ Thanks to Aaron Levin for reporting and implementing the change.+ In addition to the fix we now also verify the shape fo the generated+ payload.++# 2014-12-01 0.5.0++ * Rev. 17 of the JWT Draft changed the audience claim from being an+ optional String to being either an optional `StringOrURI`s or an optional list of+ `StringOrURI`s. Thanks to Aaron Levin for reporting and implementing the+ change. This change breaks backwards compatibility (in regard to 0.4.x).++# 2014-10-15 0.4.2++ * Fix the build problems introduced in 0.4.1 to work with the + split network package. Thanks to Richard Wallace for+ fixing this and to Jeremy Shaw for reporting this at the same time.++# 2014-09-17 0.4.1++ * Update jwt.cabal to work with the new split network package.+ Thanks to Jeremy Shaw for reporting this.++# 2014-08-02 0.4.0++ * Change the upper boundary of base from 4.7 to 4.8 (#5)++# 2014-06-02 0.3.0++ * Add verify function (thanks to Robert Massaioli) to allow verifying an+ already decoded JWT token++# 2014-03-10 0.2.1++ * Add Decoding/Encoding sections+ * Make the examples runnable by doctest+ * Fix hlint warnings+ * Add 'secondsSinceEpoch' to extract the seconds from epoch from an IntDate++# 2014-03-10 0.2.0++ * Export the IntDate and StringOrURI types #5a1137b++# 2014-03-03 0.1.1++ * Verify that invalid input to the decode* functions fails as expected++# 2014-03-03 0.1.0++ * Initial release
− changelog
@@ -1,88 +0,0 @@-2015-04-22 0.6.0-================-- * Execute doctests in addition to the testsuite when using 'make test'.- * Export `ClaimsMap` type alias (fixes #12)- * Allow base 4.8- * Lowered required cabal library version (to 1.16) to workaround build- issues in a consumer project.- * Add 7.10.1 to the travis config--2015-01-19 0.5.3-================-- * Add the missing `other-modules` field to the .cabal file so that - all the tests are present in the source distribution. Thanks to - Richard Wallace for reporting this.--2015-01-17 0.5.2-================-- * Tim McLean pointed out that comparing signatures may be susceptible to- a timing attack in the way the signatures were compared (using the default- Eq instance). Both `Signature` and `Secret` now have an `Eq` instance that- uses a constant time comparison function. Thanks Tim for reporting this.--2015-01-03 0.5.1-================-- * Fix the encoding of the `aud` part of the claim.- Thanks to Aaron Levin for reporting and implementing the change.- In addition to the fix we now also verify the shape fo the generated- payload.--2014-12-01 0.5.0-================-- * Rev. 17 of the JWT Draft changed the audience claim from being an- optional String to being either an optional `StringOrURI`s or an optional list of- `StringOrURI`s. Thanks to Aaron Levin for reporting and implementing the- change. This change breaks backwards compatibility (in regard to 0.4.x).--2014-10-15 0.4.2-================-- * Fix the build problems introduced in 0.4.1 to work with the - split network package. Thanks to Richard Wallace for- fixing this and to Jeremy Shaw for reporting this at the same time.--2014-09-17 0.4.1-================-- * Update jwt.cabal to work with the new split network package.- Thanks to Jeremy Shaw for reporting this.--2014-08-02 0.4.0-================-- * Change the upper boundary of base from 4.7 to 4.8 (#5)--2014-06-02 0.3.0-================-- * Add verify function (thanks to Robert Massaioli) to allow verifying an- already decoded JWT token--2014-03-10 0.2.1-=================-- * Add Decoding/Encoding sections- * Make the examples runnable by doctest- * Fix hlint warnings- * Add 'secondsSinceEpoch' to extract the seconds from epoch from an IntDate---2014-03-10 0.2.0-=================-- * Export the IntDate and StringOrURI types #5a1137b--2014-03-03 0.1.1-=================-- * Verify that invalid input to the decode* functions fails as expected--2014-03-03 0.1.0-=================-- * Initial release
doctests.hs view
@@ -1,1 +1,3 @@-{-# OPTIONS_GHC -F -pgmF doctest-discover #-}+import Test.DocTest++main = doctest ["-isrc", "src/Web"]
jwt.cabal view
@@ -2,7 +2,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/ name: jwt-version: 0.6.0+version: 0.7.0 synopsis: JSON Web Token (JWT) decoding and encoding license: MIT license-file: LICENSE@@ -20,27 +20,19 @@ To get started, see the documentation for the "Web.JWT" module. extra-source-files:- changelog+ CHANGELOG.md README.md source-repository head type: git location: https://ssaasen@bitbucket.org/ssaasen/haskell-jwt.git -flag network-uri- description: Get Network.URI from the network-uri package- default: True--flag doctests- description: Run the doctests tests when executing 'cabal test'- default: False- library exposed-modules: Web.JWT- other-modules: Web.Base64, Data.Text.Extended+ other-modules: Data.Text.Extended build-depends: base >= 4.6 && < 4.9- , cryptohash >= 0.11- , base64-bytestring >= 1.0+ , cryptonite >= 0.6+ , memory >= 0.8 , bytestring >= 0.10 , text >= 0.11 , aeson >= 0.7@@ -52,13 +44,7 @@ , time >= 1.1 , vector >= 0.7.1 , semigroups >= 0.15.4-- if flag(network-uri)- build-depends: network-uri >= 2.6- , network >= 2.6- else- build-depends: network-uri >= 2.4 && < 2.6- , network >= 2.4 && < 2.6+ , network-uri hs-source-dirs: src default-language: Haskell2010@@ -73,7 +59,12 @@ type: exitcode-stdio-1.0 main-is: TestRunner.hs -- Make sure the tests are listed here so that they will be part of the source distribution- other-modules: Web.Base64Tests, Web.JWTInteropTests, Web.JWTTests, Data.Text.ExtendedTests+ other-modules: Web.JWT+ , Web.JWTInteropTests+ , Web.JWTTests+ , Web.JWTTestsCompat+ , Data.Text.Extended+ , Data.Text.ExtendedTests hs-source-dirs: tests/src, src build-depends: base < 5 && >= 4.4 , tasty >= 0.7@@ -84,8 +75,8 @@ , lens , HUnit , QuickCheck >= 2.4.0.1- , cryptohash- , base64-bytestring >= 1.0+ , cryptonite+ , memory , bytestring >= 0.10 , text >= 0.11 , aeson@@ -97,24 +88,15 @@ , time >= 1.1 , vector >= 0.7.1 , semigroups >= 0.15.4+ , network-uri - if flag(network-uri)- build-depends: network-uri >= 2.6- , network >= 2.6- else- build-depends: network-uri >= 2.4 && < 2.6- , network >= 2.4 && < 2.6 cpp-options: -DTEST test-suite doctests default-language: Haskell2010 type: exitcode-stdio-1.0 main-is: doctests.hs- if flag(doctests)- buildable: True- build-depends: base < 5 && >= 4.4+ ghc-options: -threaded+ build-depends: base < 5 && >= 4.4 , jwt , doctest >= 0.9.11- , doctest-discover- else- buildable: False
src/Data/Text/Extended.hs view
@@ -5,7 +5,6 @@ , constTimeCompare ) where -import Control.Applicative ((<$>)) import Data.Bits import Data.Char import Data.Function (on)
− src/Web/Base64.hs
@@ -1,30 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}--module Web.Base64 (- base64Encode- , base64Encode'- , base64Decode- , removePaddingBase64Encoding-) where---import qualified Data.ByteString.Char8 as B-import qualified Data.Text as T-import qualified Data.Text.Encoding as TE-import qualified Data.ByteString.Base64.URL as BASE64--base64Decode :: T.Text -> T.Text-base64Decode = operateOnText BASE64.decodeLenient--base64Encode :: T.Text -> T.Text-base64Encode = removePaddingBase64Encoding . operateOnText BASE64.encode--base64Encode' :: B.ByteString -> T.Text-base64Encode' = removePaddingBase64Encoding . TE.decodeUtf8 . BASE64.encode--removePaddingBase64Encoding :: T.Text -> T.Text-removePaddingBase64Encoding = T.dropWhileEnd (=='=')---operateOnText :: (B.ByteString -> B.ByteString) -> T.Text -> T.Text-operateOnText f = TE.decodeUtf8 . f . TE.encodeUtf8
src/Web/JWT.hs view
@@ -12,7 +12,7 @@ Maintainer: Stefan Saasen <stefan@saasen.me> Stability: experimental -This implementation of JWT is based on <http://tools.ietf.org/html/draft-ietf-oauth-json-web-token-30> (Version 30)+This implementation of JWT is based on <https://tools.ietf.org/html/rfc7519> but currently only implements the minimum required to work with the Atlassian Connect framework. Known limitations:@@ -23,9 +23,6 @@ ('exp', 'nbf', 'iat'). * Registered claims are not validated-- * This implementation uses the term `JWTHeader` instead of `JOSEHeader` (changed in version 23 of the JWT draft).- Future versions will move to the offical term once that has stabilised. -} module Web.JWT (@@ -50,6 +47,7 @@ -- ** JWT claims set , auds , intDate+ , numericDate , stringOrURI , stringOrURIToText , secondsSinceEpoch@@ -69,8 +67,10 @@ , JWTClaimsSet(..) , ClaimsMap , IntDate+ , NumericDate , StringOrURI , JWTHeader+ , JOSEHeader , module Data.Default ) where@@ -81,8 +81,9 @@ import Control.Applicative import Control.Monad-import qualified Crypto.Hash.SHA256 as SHA-import qualified Crypto.MAC.HMAC as HMAC+import Crypto.Hash.Algorithms+import Crypto.MAC.HMAC+import Data.ByteArray.Encoding import Data.Aeson hiding (decode, encode) import qualified Data.Aeson as JSON import Data.Default@@ -92,12 +93,19 @@ import Data.Scientific import Data.Time.Clock (NominalDiffTime) import qualified Network.URI as URI-import Web.Base64 import Prelude hiding (exp) +-- $setup+-- The code examples in this module require GHC's `OverloadedStrings`+-- extension:+--+-- >>> :set -XOverloadedStrings type JSON = T.Text +{-# DEPRECATED JWTHeader "Use JOSEHeader instead. JWTHeader will be removed in 1.0" #-}+type JWTHeader = JOSEHeader+ -- | The secret used for calculating the message signature newtype Secret = Secret T.Text @@ -132,7 +140,7 @@ claims (Verified _ c _) = c -- | Extract the header from a JSON Web Token-header :: JWT r -> JWTHeader+header :: JWT r -> JOSEHeader header (Unverified h _ _ _) = h header (Verified h _ _) = h @@ -143,11 +151,17 @@ -- | A JSON numeric value representing the number of seconds from -- 1970-01-01T0:0:0Z UTC until the specified UTC date/time.-newtype IntDate = IntDate Integer deriving (Show, Eq, Ord)+{-# DEPRECATED IntDate "Use NumericDate instead. IntDate will be removed in 1.0" #-}+type IntDate = NumericDate +-- | 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)++ -- | Return the seconds since 1970-01-01T0:0:0Z UTC for the given 'IntDate'-secondsSinceEpoch :: IntDate -> NominalDiffTime-secondsSinceEpoch (IntDate s) = fromInteger s+secondsSinceEpoch :: NumericDate -> NominalDiffTime+secondsSinceEpoch (NumericDate s) = fromInteger s -- | A JSON string value, with the additional requirement that while -- arbitrary string values MAY be used, any value containing a ":"@@ -160,12 +174,11 @@ show (S s) = T.unpack s show (U u) = show u - data Algorithm = HS256 -- ^ HMAC using SHA-256 hash algorithm deriving (Eq, Show) --- | JWT Header, describes the cryptographic operations applied to the JWT-data JWTHeader = JWTHeader {+-- | JOSE Header, describes the cryptographic operations applied to the JWT+data JOSEHeader = JOSEHeader { -- | The typ (type) Header Parameter defined by [JWS] and [JWE] is used to -- declare the MIME Media Type [IANA.MediaTypes] of this complete JWT in -- contexts where this is useful to the application.@@ -182,8 +195,8 @@ , alg :: Maybe Algorithm } deriving (Eq, Show) -instance Default JWTHeader where- def = JWTHeader Nothing Nothing Nothing+instance Default JOSEHeader where+ def = JOSEHeader Nothing Nothing Nothing -- | The JWT Claims Set represents a JSON object whose members are the claims conveyed by the JWT. data JWTClaimsSet = JWTClaimsSet {@@ -220,11 +233,9 @@ def = JWTClaimsSet Nothing Nothing Nothing Nothing Nothing Nothing Nothing Map.empty -- -- | Encode a claims set using the given secret ----- >>> :{+-- @ -- let -- cs = def { -- def returns a default JWTClaimsSet -- iss = stringOrURI "Foo"@@ -232,8 +243,8 @@ -- } -- key = secret "secret-key" -- in encodeSigned HS256 key cs--- :}--- "eyJ0eXAiOiJKV1QiLCJhbGciOiJIUzI1NiJ9.eyJodHRwOi8vZXhhbXBsZS5jb20vaXNfcm9vdCI6dHJ1ZSwiaXNzIjoiRm9vIn0.vHQHuG3ujbnBUmEp-fSUtYxk27rLiP2hrNhxpyWhb2E"+-- @+-- > "eyJ0eXAiOiJKV1QiLCJhbGciOiJIUzI1NiJ9.eyJodHRwOi8vZXhhbXBsZS5jb20vaXNfcm9vdCI6dHJ1ZSwiaXNzIjoiRm9vIn0.vHQHuG3ujbnBUmEp-fSUtYxk27rLiP2hrNhxpyWhb2E" encodeSigned :: Algorithm -> Secret -> JWTClaimsSet -> JSON encodeSigned algo secret claims = dotted [header, claim, signature] where claim = encodeJWT claims@@ -245,16 +256,16 @@ -- | Encode a claims set without signing it ----- >>> :{+-- @ -- let -- cs = def { -- def returns a default JWTClaimsSet -- iss = stringOrURI "Foo"--- , iat = intDate 1394700934+-- , iat = numericDate 1394700934 -- , unregisteredClaims = Map.fromList [("http://example.com/is_root", (Bool True))] -- } -- in encodeUnsigned cs--- :}--- "eyJ0eXAiOiJKV1QiLCJhbGciOiJIUzI1NiJ9.eyJpYXQiOjEzOTQ3MDA5MzQsImh0dHA6Ly9leGFtcGxlLmNvbS9pc19yb290Ijp0cnVlLCJpc3MiOiJGb28ifQ."+-- @+-- > "eyJ0eXAiOiJKV1QiLCJhbGciOiJIUzI1NiJ9.eyJpYXQiOjEzOTQ3MDA5MzQsImh0dHA6Ly9leGFtcGxlLmNvbS9pc19yb290Ijp0cnVlLCJpc3MiOiJGb28ifQ." encodeUnsigned :: JWTClaimsSet -> JSON encodeUnsigned claims = dotted [header, claim, ""] where claim = encodeJWT claims@@ -263,7 +274,6 @@ , alg = Just HS256 } - -- | Decode a claims set without verifying the signature. This is useful if -- information from the claim set is required in order to verify the claim -- (e.g. the secret needs to be retrieved based on unverified information@@ -275,7 +285,7 @@ -- mJwt = decode input -- in fmap header mJwt -- :}--- Just (JWTHeader {typ = Just "JWT", cty = Nothing, alg = Just HS256})+-- Just (JOSEHeader {typ = Just "JWT", cty = Nothing, alg = Just HS256}) -- -- and --@@ -294,7 +304,7 @@ Unverified <$> header' <*> claims' <*> (pure . Signature $ s) <*> (pure . dotted $ [h,c]) where extractElems (h:c:s:_) = Just (h,c,s)- extractElems _ = Nothing+ extractElems _ = Nothing -- | Using a known secret and a decoded claims set verify that the signature is correct -- and return a verified JWT token as a result.@@ -353,23 +363,30 @@ -- | 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).+{-# DEPRECATED intDate "Use numericDate instead. intDate will be removed in 1.0" #-} intDate :: NominalDiffTime -> Maybe IntDate-intDate i | i < 0 = Nothing-intDate i = Just $ IntDate $ round i+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).+numericDate :: NominalDiffTime -> Maybe NumericDate+numericDate i | i < 0 = Nothing+numericDate i = Just $ NumericDate $ round 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 -- *not* a valid URI). stringOrURI :: T.Text -> Maybe StringOrURI stringOrURI t | URI.isURI $ T.unpack t = U <$> URI.parseURI (T.unpack t)-stringOrURI t = Just (S t)+stringOrURI t = Just (S t) -- | Convert a `StringOrURI` into a `T.Text`. Returns the T.Text -- representing the String as-is or a Text representation of the URI -- otherwise. stringOrURIToText :: StringOrURI -> T.Text-stringOrURIToText (S t) = t+stringOrURIToText (S t) = t stringOrURIToText (U uri) = T.pack $ URI.uriToString id uri (""::String) -- | Convert the `aud` claim in a `JWTClaimsSet` into a `[StringOrURI]`@@ -382,10 +399,12 @@ -- ================================================================================= encodeJWT :: ToJSON a => a -> T.Text-encodeJWT = base64Encode . TE.decodeUtf8 . BL.toStrict . JSON.encode+encodeJWT = TE.decodeUtf8 . convertToBase Base64URLUnpadded . BL.toStrict . JSON.encode parseJWT :: FromJSON a => T.Text -> Maybe a-parseJWT = JSON.decode . BL.fromStrict . TE.encodeUtf8 . base64Decode+parseJWT x = case convertFromBase Base64URLUnpadded $ TE.encodeUtf8 x of+ Left _ -> Nothing+ Right s -> JSON.decode $ BL.fromStrict s dotted :: [T.Text] -> T.Text dotted = T.intercalate "."@@ -394,8 +413,9 @@ -- ================================================================================= calculateDigest :: Algorithm -> Secret -> T.Text -> T.Text-calculateDigest HS256 (Secret key) msg = base64Encode' $ HMAC.hmac SHA.hash 64 (bs key) (bs msg)- where bs = TE.encodeUtf8+calculateDigest HS256 (Secret key) msg = TE.decodeUtf8 $ convertToBase Base64URLUnpadded (hmac (bs key) (bs msg) :: HMAC SHA256)+ where + bs = TE.encodeUtf8 -- ================================================================================= @@ -406,7 +426,8 @@ removeRegisteredClaims :: ClaimsMap -> ClaimsMap removeRegisteredClaims input = Map.differenceWithKey (\_ _ _ -> Nothing) input registeredClaims- where registeredClaims = Map.fromList $ map (\e -> (e, Null)) ["iss", "sub", "aud", "exp", "nbf", "iat", "jti"]+ where + registeredClaims = Map.fromList $ map (\e -> (e, Null)) ["iss", "sub", "aud", "exp", "nbf", "iat", "jti"] instance ToJSON JWTClaimsSet where toJSON JWTClaimsSet{..} = object $ catMaybes [@@ -419,7 +440,6 @@ , fmap ("jti" .=) jti ] ++ Map.toList (removeRegisteredClaims unregisteredClaims) - instance FromJSON JWTClaimsSet where parseJSON = withObject "JWTClaimsSet" (\o -> JWTClaimsSet@@ -435,26 +455,25 @@ <*> o .:? "jti" <*> pure (removeRegisteredClaims $ fromHashMap o)) --instance FromJSON JWTHeader where- parseJSON = withObject "JWTHeader"- (\o -> JWTHeader+instance FromJSON JOSEHeader where+ parseJSON = withObject "JOSEHeader"+ (\o -> JOSEHeader <$> o .:? "typ" <*> o .:? "cty" <*> o .:? "alg") -instance ToJSON JWTHeader where- toJSON JWTHeader{..} = object $ catMaybes [+instance ToJSON JOSEHeader where+ toJSON JOSEHeader{..} = object $ catMaybes [ fmap ("typ" .=) typ , fmap ("cty" .=) cty , fmap ("alg" .=) alg ] -instance ToJSON IntDate where- toJSON (IntDate i) = Number $ scientific (fromIntegral i) 0+instance ToJSON NumericDate where+ toJSON (NumericDate i) = Number $ scientific (fromIntegral i) 0 -instance FromJSON IntDate where- parseJSON (Number x) = return $ IntDate $ coefficient x+instance FromJSON NumericDate where+ parseJSON (Number x) = return $ NumericDate $ coefficient x parseJSON _ = mzero instance ToJSON Algorithm where@@ -465,13 +484,13 @@ parseJSON _ = mzero instance ToJSON StringOrURI where- toJSON (S s) = String s+ toJSON (S s) = String s toJSON (U uri) = String $ T.pack $ URI.uriToString id uri "" instance FromJSON StringOrURI where 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+ parseJSON (String s) = return $ S s+ parseJSON _ = mzero -- $docDecoding -- There are three use cases supported by the set of decoding/verification
tests/src/TestRunner.hs view
@@ -1,8 +1,8 @@ module Main where import qualified Web.JWTTests+import qualified Web.JWTTestsCompat import qualified Web.JWTInteropTests-import qualified Web.Base64Tests import qualified Data.Text.ExtendedTests import Test.Tasty @@ -12,8 +12,8 @@ tests :: TestTree tests = testGroup "JWT Tests" [ Web.JWTTests.defaultTestGroup+ , Web.JWTTestsCompat.defaultTestGroup , Web.JWTInteropTests.defaultTestGroup- , Web.Base64Tests.defaultTestGroup , Data.Text.ExtendedTests.defaultTestGroup ]
− tests/src/Web/Base64Tests.hs
@@ -1,56 +0,0 @@-{-# LANGUAGE BangPatterns, OverloadedStrings, ScopedTypeVariables, TemplateHaskell #-}-{-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-}-module Web.Base64Tests- (- main- , defaultTestGroup-) where--import Control.Applicative-import Test.Tasty-import Test.Tasty.TH-import Test.Tasty.HUnit-import Test.Tasty.QuickCheck-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 Data.Aeson.Types-import Data.Maybe-import Data.String (fromString, IsString)-import Web.Base64--defaultTestGroup :: TestTree-defaultTestGroup = $(testGroupGenerator)--main :: IO ()-main = defaultMain defaultTestGroup----case_base64EncodeString = do- let header = "{\"typ\":\"JWT\",\r\n \"alg\":\"HS256\"}"- "eyJ0eXAiOiJKV1QiLA0KICJhbGciOiJIUzI1NiJ9" @=? base64Encode header--case_base64EncodeStringNoPadding = do- let header = "sdjkfhaks jdhfak sjldhfa lkjsdf"- "c2Rqa2ZoYWtzIGpkaGZhayBzamxkaGZhIGxranNkZg" @=? base64Encode header--case_base64EncodeDecodeStringNoPadding = do- let header = "sdjkfhaks jdhfak sjldhfa lkjsdf"- header @=? base64Decode (base64Encode header)--case_base64DecodeString = do- let str = "eyJ0eXAiOiJKV1QiLA0KICJhbGciOiJIUzI1NiJ9"- "{\"typ\":\"JWT\",\r\n \"alg\":\"HS256\"}" @=? base64Decode str--prop_base64_encode_decode = f- where f :: T.Text -> Bool- f input = base64Decode (base64Encode input) == input---instance Arbitrary T.Text where- arbitrary = fromString <$> (arbitrary :: QC.Gen String)--instance Arbitrary TL.Text where- arbitrary = fromString <$> (arbitrary :: QC.Gen String)
tests/src/Web/JWTInteropTests.hs view
@@ -10,7 +10,7 @@ `fromJSON . toJSON = id` -This would only verify that an isomorphism exists but wouldn't tests the specific shape we expect.+This would only verify that an isomorphism exists but wouldn't test the specific shape we expect. While the above would be sufficent if the haskell-jwt library would be used on the sender and receiver side, interoperability couldn't be guaranteed. We need to ensure that the JSON conforms to the spec so that every@@ -81,9 +81,9 @@ instance Arbitrary ClaimsMap where arbitrary = return Map.empty -instance Arbitrary IntDate where- arbitrary = fmap (f . intDate) (arbitrary :: QC.Gen NominalDiffTime)- where f = fromMaybe (fromJust $ intDate 1)+instance Arbitrary NumericDate where+ arbitrary = fmap (f . numericDate) (arbitrary :: QC.Gen NominalDiffTime)+ where f = fromMaybe (fromJust $ numericDate 1) instance Arbitrary NominalDiffTime where arbitrary = arbitrarySizedFractional
tests/src/Web/JWTTests.hs view
@@ -37,13 +37,11 @@ sou = stringOrURI str Just str @=? fmap (T.pack . show) sou --case_intDateDeriveOrd = do- let i1 = intDate 1231231231 -- Tue 6 Jan 2009 19:40:31 AEDT- i2 = intDate 1231232231 -- Tue 6 Jan 2009 19:57:11 AEDT+case_numericDateDeriveOrd = do+ let i1 = numericDate 1231231231 -- Tue 6 Jan 2009 19:40:31 AEDT+ i2 = numericDate 1231232231 -- Tue 6 Jan 2009 19:57:11 AEDT LT @=? i1 `compare` i2 - case_decodeJWT = do -- Generated with ruby-jwt let input = "eyJ0eXAiOiJKV1QiLCJhbGciOiJIUzI1NiJ9.eyJzb21lIjoicGF5bG9hZCJ9.Joh1R2dYzkRvDkqv3sygm5YyK8Gi4ShZqbhK2gxcs2U"@@ -136,7 +134,7 @@ let now = 1394573404 cs = def { iss = stringOrURI "Foo"- , iat = intDate now+ , iat = numericDate now , unregisteredClaims = Map.fromList [("http://example.com/is_root", Bool True)] } key = secret "secret-key"@@ -159,7 +157,7 @@ let now = 1234 cs = def { iss = stringOrURI "Foo"- , iat = intDate now+ , iat = numericDate now , unregisteredClaims = Map.fromList [("http://example.com/is_root", Bool True)] } let secret' = secret "secret"@@ -171,7 +169,7 @@ cs = def { iss = stringOrURI "Foo" , aud = Left <$> stringOrURI "single-audience"- , iat = intDate now+ , iat = numericDate now } let secret' = secret "secret" jwt = decodeAndVerifySignature secret' $ encodeSigned HS256 secret' cs@@ -182,7 +180,7 @@ cs = def { iss = stringOrURI "Foo" , aud = Right <$> (:[]) <$> stringOrURI "audience"- , iat = intDate now+ , iat = numericDate now } let secret' = secret "secret" jwt = decodeAndVerifySignature secret' $ encodeSigned HS256 secret' cs@@ -200,17 +198,16 @@ Just sou -> stringOrURIToText sou == t Nothing -> True -prop_encode_decode_prop = f- where f :: JWTClaimsSet -> Bool- f claims' = let Just unverified = (decode $ encodeSigned HS256 (secret "secret") claims')- in claims unverified == claims'--prop_encode_decode_verify_signature_prop = f- where f :: JWTClaimsSet -> Bool- f claims' = let key = secret "secret"- Just verified = (decodeAndVerifySignature key $ encodeSigned HS256 key claims')- in claims verified == claims'+prop_encode_decode = f+ where f :: T.Text -> JWTClaimsSet -> Bool+ f key claims' = let Just unverified = (decode $ encodeSigned HS256 (secret key) claims')+ in claims unverified == claims' +prop_encode_decode_verify_signature = f+ where f :: T.Text -> JWTClaimsSet -> Bool+ f key' claims' = let key = secret key'+ Just verified = (decodeAndVerifySignature key $ encodeSigned HS256 key claims')+ in claims verified == claims' instance Arbitrary JWTClaimsSet where arbitrary = JWTClaimsSet <$> arbitrary@@ -225,9 +222,9 @@ instance Arbitrary ClaimsMap where arbitrary = return Map.empty -instance Arbitrary IntDate where- arbitrary = fmap (f . intDate) (arbitrary :: QC.Gen NominalDiffTime)- where f = fromMaybe (fromJust $ intDate 1)+instance Arbitrary NumericDate where+ arbitrary = fmap (f . numericDate) (arbitrary :: QC.Gen NominalDiffTime)+ where f = fromMaybe (fromJust $ numericDate 1) instance Arbitrary NominalDiffTime where arbitrary = arbitrarySizedFractional
+ tests/src/Web/JWTTestsCompat.hs view
@@ -0,0 +1,54 @@+{-# LANGUAGE BangPatterns, OverloadedStrings, ScopedTypeVariables, TemplateHaskell #-}+{-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-}++{- +- Turn of deprecation warnings as these tests deliberately use +- deprecated types/functions to ensure that the library is backward compatible +-}+{-# OPTIONS_GHC -fno-warn-warnings-deprecations #-}++module Web.JWTTestsCompat+ (+ main+ , defaultTestGroup+) where++import Control.Applicative+import Test.Tasty+import Test.Tasty.TH+import Test.Tasty.HUnit+import Test.Tasty.QuickCheck+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 Data.Aeson.Types+import Data.Maybe+import Data.String (fromString, IsString)+import Data.Time+import Web.JWT++defaultTestGroup :: TestTree+defaultTestGroup = $(testGroupGenerator)++main :: IO ()+main = defaultMain defaultTestGroup++case_intDateDeriveOrd = do+ let i1 = intDate 1231231231 -- Tue 6 Jan 2009 19:40:31 AEDT+ i2 = intDate 1231232231 -- Tue 6 Jan 2009 19:57:11 AEDT+ LT @=? i1 `compare` i2++case_encodeDecodeJWTIntDateIat = do+ let now = 1394573404+ cs = def {+ iss = stringOrURI "Foo"+ , iat = intDate now+ , unregisteredClaims = Map.fromList [("http://example.com/is_root", Bool True)]+ }+ key = secret "secret-key"+ mJwt = decode $ encodeSigned HS256 key cs+ let (Just claims') = fmap claims mJwt+ cs @=? claims'+ Just now @=? fmap secondsSinceEpoch (iat claims')+