diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,86 +1,91 @@ +# 2016-04-11 0.7.1 + +* Add `binarySecret` function to enable providing a secret based on a `ByteString` + (fixes #21 - Thanks to Joe Nelson for reporting this). + # 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) +* 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 +* 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. +* 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. +* 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. +* 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). +* 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. +* 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. +* 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) +* 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 +* 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 +* 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 +* Export the IntDate and StringOrURI types #5a1137b # 2014-03-03 0.1.1 - * Verify that invalid input to the decode* functions fails as expected +* Verify that invalid input to the decode\* functions fails as expected # 2014-03-03 0.1.0 - * Initial release +* Initial release 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.7.0 +version: 0.7.1 synopsis: JSON Web Token (JWT) decoding and encoding license: MIT license-file: LICENSE @@ -22,6 +22,7 @@ extra-source-files: CHANGELOG.md README.md + tests/jwt.secret.1 source-repository head type: git @@ -29,7 +30,7 @@ library exposed-modules: Web.JWT - other-modules: Data.Text.Extended + other-modules: Data.Text.Extended, Data.ByteString.Extended build-depends: base >= 4.6 && < 4.9 , cryptonite >= 0.6 , memory >= 0.8 diff --git a/src/Data/ByteString/Extended.hs b/src/Data/ByteString/Extended.hs new file mode 100644 --- /dev/null +++ b/src/Data/ByteString/Extended.hs @@ -0,0 +1,14 @@ +module Data.ByteString.Extended ( + module Data.ByteString + , constTimeCompare +) where + +import Data.Bits +import Data.ByteString +import qualified Data.List as L +import Prelude hiding (length, zip, zipWith) + +constTimeCompare :: ByteString -> ByteString -> Bool +constTimeCompare l r = length l == length r && comp' l r + where + comp' a b = 0 == L.foldl' (.|.) 0 (uncurry xor <$> zip a b) diff --git a/src/Web/JWT.hs b/src/Web/JWT.hs --- a/src/Web/JWT.hs +++ b/src/Web/JWT.hs @@ -40,6 +40,7 @@ -- ** Common , tokenIssuer , secret + , binarySecret -- ** JWT structure , claims , header @@ -76,6 +77,7 @@ ) where import qualified Data.ByteString.Lazy.Char8 as BL (fromStrict, toStrict) +import qualified Data.ByteString.Extended as BS import qualified Data.Text.Extended as T import qualified Data.Text.Encoding as TE @@ -107,10 +109,10 @@ type JWTHeader = JOSEHeader -- | The secret used for calculating the message signature -newtype Secret = Secret T.Text +newtype Secret = Secret BS.ByteString instance Eq Secret where - (Secret s1) == (Secret s2) = s1 `T.constTimeCompare` s2 + (Secret s1) == (Secret s2) = s1 `BS.constTimeCompare` s2 instance Show Secret where show _ = "" @@ -353,13 +355,15 @@ tokenIssuer :: JSON -> Maybe StringOrURI tokenIssuer = decode >=> fmap pure claims >=> iss --- | Create a Secret using the given key --- This will currently simply wrap the given key appropriately buy may --- return a Nothing in the future if the key needs to adhere to a specific --- format and the given key is invalid. +-- | Create a Secret using the given key. +-- Consider using `binarySecret` instead if your key is not already a "Data.Text". secret :: T.Text -> Secret -secret = Secret +secret = Secret . TE.encodeUtf8 +-- | Create a Secret using the given key. +binarySecret :: BS.ByteString -> Secret +binarySecret = Secret + -- | 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). @@ -413,7 +417,7 @@ -- ================================================================================= calculateDigest :: Algorithm -> Secret -> T.Text -> T.Text -calculateDigest HS256 (Secret key) msg = TE.decodeUtf8 $ convertToBase Base64URLUnpadded (hmac (bs key) (bs msg) :: HMAC SHA256) +calculateDigest HS256 (Secret key) msg = TE.decodeUtf8 $ convertToBase Base64URLUnpadded (hmac key (bs msg) :: HMAC SHA256) where bs = TE.encodeUtf8 diff --git a/tests/jwt.secret.1 b/tests/jwt.secret.1 new file mode 100644 Binary files /dev/null and b/tests/jwt.secret.1 differ diff --git a/tests/src/TestRunner.hs b/tests/src/TestRunner.hs --- a/tests/src/TestRunner.hs +++ b/tests/src/TestRunner.hs @@ -3,6 +3,7 @@ import qualified Web.JWTTests import qualified Web.JWTTestsCompat import qualified Web.JWTInteropTests +import qualified Data.ByteString.ExtendedTests import qualified Data.Text.ExtendedTests import Test.Tasty @@ -15,5 +16,6 @@ , Web.JWTTestsCompat.defaultTestGroup , Web.JWTInteropTests.defaultTestGroup , Data.Text.ExtendedTests.defaultTestGroup + , Data.ByteString.ExtendedTests.defaultTestGroup ] 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 @@ -14,7 +14,9 @@ import qualified Test.QuickCheck as QC import qualified Data.Map as Map import qualified Data.Text as T +import qualified Data.Text.Encoding as TE import qualified Data.Text.Lazy as TL +import qualified Data.ByteString as BS import Data.Aeson.Types import Data.Maybe import Data.String (fromString, IsString) @@ -186,6 +188,17 @@ jwt = decodeAndVerifySignature secret' $ encodeSigned HS256 secret' cs Just cs @=? fmap claims jwt +case_encodeDecodeJWTClaimsSetBinarySecret = do + let now = 1234 + cs = def { + iss = stringOrURI "Foo" + , iat = numericDate now + } + secretKey <- BS.readFile "tests/jwt.secret.1" + let secret' = binarySecret secretKey + jwt = decodeAndVerifySignature secret' $ encodeSigned HS256 secret' cs + Just cs @=? fmap claims jwt + prop_stringOrURIProp = f where f :: StringOrURI -> Bool f sou = let s = stringOrURI $ T.pack $ show sou @@ -203,12 +216,18 @@ f key claims' = let Just unverified = (decode $ encodeSigned HS256 (secret key) claims') in claims unverified == claims' +prop_encode_decode_binary_secret = f + where f :: BS.ByteString -> JWTClaimsSet -> Bool + f binary claims' = let Just unverified = (decode $ encodeSigned HS256 (binarySecret binary) 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 <*> arbitrary @@ -234,6 +253,10 @@ arbitrary = fmap (f . stringOrURI) (arbitrary :: QC.Gen T.Text) where f = fromMaybe (fromJust $ stringOrURI "http://example.com") + +instance Arbitrary BS.ByteString where + arbitrary = BS.pack <$> arbitrary + shrink xs = BS.pack <$> shrink (BS.unpack xs) instance Arbitrary T.Text where arbitrary = fromString <$> (arbitrary :: QC.Gen String)