diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 --- /dev/null +++ b/CHANGELOG.md @@ -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 diff --git a/changelog b/changelog deleted file mode 100644 --- a/changelog +++ /dev/null @@ -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 diff --git a/doctests.hs b/doctests.hs --- a/doctests.hs +++ b/doctests.hs @@ -1,1 +1,3 @@ -{-# OPTIONS_GHC -F -pgmF doctest-discover #-} +import Test.DocTest + +main = doctest ["-isrc", "src/Web"] 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.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 diff --git a/src/Data/Text/Extended.hs b/src/Data/Text/Extended.hs --- a/src/Data/Text/Extended.hs +++ b/src/Data/Text/Extended.hs @@ -5,7 +5,6 @@ , constTimeCompare ) where -import Control.Applicative ((<$>)) import Data.Bits import Data.Char import Data.Function (on) diff --git a/src/Web/Base64.hs b/src/Web/Base64.hs deleted file mode 100644 --- a/src/Web/Base64.hs +++ /dev/null @@ -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 diff --git a/src/Web/JWT.hs b/src/Web/JWT.hs --- a/src/Web/JWT.hs +++ b/src/Web/JWT.hs @@ -12,7 +12,7 @@ Maintainer: Stefan Saasen Stability: experimental -This implementation of JWT is based on (Version 30) +This implementation of JWT is based on 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 diff --git a/tests/src/TestRunner.hs b/tests/src/TestRunner.hs --- a/tests/src/TestRunner.hs +++ b/tests/src/TestRunner.hs @@ -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 ] diff --git a/tests/src/Web/Base64Tests.hs b/tests/src/Web/Base64Tests.hs deleted file mode 100644 --- a/tests/src/Web/Base64Tests.hs +++ /dev/null @@ -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) diff --git a/tests/src/Web/JWTInteropTests.hs b/tests/src/Web/JWTInteropTests.hs --- a/tests/src/Web/JWTInteropTests.hs +++ b/tests/src/Web/JWTInteropTests.hs @@ -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 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 @@ -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 diff --git a/tests/src/Web/JWTTestsCompat.hs b/tests/src/Web/JWTTestsCompat.hs new file mode 100644 --- /dev/null +++ b/tests/src/Web/JWTTestsCompat.hs @@ -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') +