jwt 0.5.1 → 0.5.2
raw patch · 7 files changed
+41/−284 lines, 7 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
Files
- changelog +8/−0
- jwt.cabal +2/−3
- src/Data/Text/Additions.hs +17/−0
- src/Web/JWT.hs +12/−2
- tests/src/TestRunner.hs +2/−0
- tests/src/Web/Base64Tests.hs +0/−56
- tests/src/Web/JWTTests.hs +0/−223
changelog view
@@ -1,3 +1,11 @@+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 ================
jwt.cabal view
@@ -2,7 +2,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/ name: jwt-version: 0.5.1+version: 0.5.2 synopsis: JSON Web Token (JWT) decoding and encoding license: MIT license-file: LICENSE@@ -33,7 +33,7 @@ library exposed-modules: Web.JWT- other-modules: Web.Base64+ other-modules: Web.Base64, Data.Text.Additions build-depends: base >= 4.6 && < 4.8 , cryptohash >= 0.11 , base64-bytestring >= 1.0@@ -68,7 +68,6 @@ default-language: Haskell2010 type: exitcode-stdio-1.0 main-is: TestRunner.hs- other-modules: Web.JWTTests, Web.Base64Tests hs-source-dirs: tests/src, src build-depends: base < 5 && >= 4.4 , tasty >= 0.7
+ src/Data/Text/Additions.hs view
@@ -0,0 +1,17 @@+{-# LANGUAGE OverloadedStrings #-}++module Data.Text.Additions (+ constTimeCompare+) where++import Control.Applicative ((<$>))+import Data.Bits+import Data.Char+import Data.Function (on)+import Data.List (foldl')+import qualified Data.Text as T++constTimeCompare :: T.Text -> T.Text -> Bool+constTimeCompare l r = T.length l == T.length r && comp' l r+ where+ comp' a b = 0 == foldl' (.|.) 0 (uncurry (on xor ord) <$> T.zip a b)
src/Web/JWT.hs view
@@ -77,6 +77,7 @@ import qualified Data.ByteString.Lazy.Char8 as BL (fromStrict, toStrict) import qualified Data.Text as T import qualified Data.Text.Encoding as TE+import qualified Data.Text.Additions as TA import Control.Applicative import Control.Monad@@ -98,9 +99,18 @@ type JSON = T.Text -- | The secret used for calculating the message signature-newtype Secret = Secret T.Text deriving (Eq, Show)+newtype Secret = Secret T.Text -newtype Signature = Signature T.Text deriving (Eq, Show)+instance Eq Secret where+ (Secret s1) == (Secret s2) = s1 `TA.constTimeCompare` s2++instance Show Secret where+ show _ = "<secret>"++newtype Signature = Signature T.Text deriving (Show)++instance Eq Signature where+ (Signature s1) == (Signature s2) = s1 `TA.constTimeCompare` s2 -- | JSON Web Token without signature verification data UnverifiedJWT
tests/src/TestRunner.hs view
@@ -3,6 +3,7 @@ import qualified Web.JWTTests import qualified Web.JWTInteropTests import qualified Web.Base64Tests+import qualified Data.Text.AdditionsTests import Test.Tasty main :: IO ()@@ -13,5 +14,6 @@ Web.JWTTests.defaultTestGroup , Web.JWTInteropTests.defaultTestGroup , Web.Base64Tests.defaultTestGroup+ , Data.Text.AdditionsTests.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/JWTTests.hs
@@ -1,223 +0,0 @@-{-# LANGUAGE BangPatterns, OverloadedStrings, ScopedTypeVariables, TemplateHaskell #-}-{-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-}-module Web.JWTTests- (- 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_stringOrURIString = do- let str = "foo bar baz 2312j!@&^#^*!(*@"- sou = stringOrURI str- Just str @=? fmap (T.pack . show) sou--case_stringOrURI= do- let str = "http://user@example.com:8900/foo/bar?baz=t;"- 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- LT @=? i1 `compare` i2---case_decodeJWT = do- -- Generated with ruby-jwt- let input = "eyJ0eXAiOiJKV1QiLCJhbGciOiJIUzI1NiJ9.eyJzb21lIjoicGF5bG9hZCJ9.Joh1R2dYzkRvDkqv3sygm5YyK8Gi4ShZqbhK2gxcs2U"- mJwt = decode input- True @=? isJust mJwt- True @=? isJust (fmap signature mJwt)- let (Just unverified) = mJwt- Just HS256 @=? alg (header unverified)- Just "payload" @=? Map.lookup "some" (unregisteredClaims $ claims unverified)--case_verify = do- -- Generated with ruby-jwt- let input = "eyJ0eXAiOiJKV1QiLCJhbGciOiJIUzI1NiJ9.eyJzb21lIjoicGF5bG9hZCJ9.Joh1R2dYzkRvDkqv3sygm5YyK8Gi4ShZqbhK2gxcs2U"- mVerified = verify (secret "secret") =<< decode input- True @=? isJust mVerified--case_decodeAndVerifyJWT = do- -- Generated with ruby-jwt- let input = "eyJ0eXAiOiJKV1QiLCJhbGciOiJIUzI1NiJ9.eyJzb21lIjoicGF5bG9hZCJ9.Joh1R2dYzkRvDkqv3sygm5YyK8Gi4ShZqbhK2gxcs2U"- mJwt = decodeAndVerifySignature (secret "secret") input- True @=? isJust mJwt- let (Just verified) = mJwt- Just HS256 @=? alg (header verified)- Just "payload" @=? Map.lookup "some" (unregisteredClaims $ claims verified)--case_decodeAndVerifyJWTFailing = do- -- Generated with ruby-jwt, modified to be invalid- let input = "eyJ0eXAiOiJKV1QiLCJhbGciOiJIUzI1NiJ9.eyJzb21lIjoicGF5bG9hZCJ9.Joh1R2dYzkRvDkqv3sygm5YyK8Gi4ShZqbhK2gxcs2u"- mJwt = decodeAndVerifySignature (secret "secret") input- False @=? isJust mJwt--case_decodeInvalidInput = do- let inputs = ["", "a.", "a.b"]- result = map decode inputs- True @=? all isNothing result--case_decodeAndVerifySignatureInvalidInput = do- let inputs = ["", "a.", "a.b"]- result = map (decodeAndVerifySignature (secret "secret")) inputs- True @=? all isNothing result--case_encodeJWTNoMac = do- let cs = def {- iss = stringOrURI "Foo"- , unregisteredClaims = Map.fromList [("http://example.com/is_root", Bool True)]- }- jwt = encodeUnsigned cs- -- Verify the shape of the JWT, ensure the shape of the triple of- -- <header>.<claims>.<signature>- let (h:c:s:_) = T.splitOn "." jwt- False @=? T.null h- False @=? T.null c- True @=? T.null s---case_encodeDecodeJWTNoMac = do- let cs = def {- iss = stringOrURI "Foo"- , unregisteredClaims = Map.fromList [("http://example.com/is_root", Bool True)]- }- mJwt = decode $ encodeUnsigned cs- True @=? isJust mJwt- let (Just unverified) = mJwt- cs @=? claims unverified--case_encodeDecodeJWT = 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')--case_tokenIssuer = do- let iss' = stringOrURI "Foo"- cs = def {- iss = iss'- , unregisteredClaims = Map.fromList [("http://example.com/is_root", Bool True)]- }- key = secret "secret-key"- t = encodeSigned HS256 key cs- iss' @=? tokenIssuer t--case_encodeDecodeJWTClaimsSetCustomClaims = do- let now = 1234- cs = def {- iss = stringOrURI "Foo"- , iat = intDate now- , unregisteredClaims = Map.fromList [("http://example.com/is_root", Bool True)]- }- let secret' = secret "secret"- jwt = decodeAndVerifySignature secret' $ encodeSigned HS256 secret' cs- Just cs @=? fmap claims jwt--case_encodeDecodeJWTClaimsSetWithSingleAud = do- let now = 1234- cs = def {- iss = stringOrURI "Foo"- , aud = Left <$> stringOrURI "single-audience"- , iat = intDate now- }- let secret' = secret "secret"- jwt = decodeAndVerifySignature secret' $ encodeSigned HS256 secret' cs- Just cs @=? fmap claims jwt--case_encodeDecodeJWTClaimsSetWithMultipleAud = do- let now = 1234- cs = def {- iss = stringOrURI "Foo"- , aud = Right <$> (:[]) <$> stringOrURI "audience"- , iat = intDate now- }- let secret' = secret "secret"- 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- in Just sou == s--prop_stringOrURIToText= f- where f :: T.Text -> Bool- f t = let mSou = stringOrURI t- in case mSou of- 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'---instance Arbitrary JWTClaimsSet where- arbitrary = JWTClaimsSet <$> arbitrary- <*> arbitrary- <*> arbitrary- <*> arbitrary- <*> arbitrary- <*> arbitrary- <*> arbitrary- <*> arbitrary--type ClaimsMap = Map.Map T.Text Value-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 NominalDiffTime where- arbitrary = arbitrarySizedFractional- shrink = shrinkRealFrac--instance Arbitrary StringOrURI where- arbitrary = fmap (f . stringOrURI) (arbitrary :: QC.Gen T.Text)- where- f = fromMaybe (fromJust $ stringOrURI "http://example.com")--instance Arbitrary T.Text where- arbitrary = fromString <$> (arbitrary :: QC.Gen String)--instance Arbitrary TL.Text where- arbitrary = fromString <$> (arbitrary :: QC.Gen String)