jwt 0.4.2 → 0.4.3

raw patch · 7 files changed

+57/−257 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 +28/−6
• tests/src/TestRunner.hs +2/−0
• tests/src/Web/Base64Tests.hs +0/−56
• tests/src/Web/JWTTests.hs +0/−192

@@ -1,3 +1,11 @@+2015-01-17 0.4.3+================++      * 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.+ 2014-10-15 0.4.2 ================ 

@@ -2,7 +2,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/  name:                jwt-version:             0.4.2+version:             0.4.3 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@@ -66,7 +66,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

@@ -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)

@@ -12,7 +12,7 @@ Maintainer:  Stefan Saasen <stefan@saasen.me> Stability:   experimental -This implementation of JWT is based on <http://self-issued.info/docs/draft-ietf-oauth-json-web-token.html> (Version 16)+This implementation of JWT is based on <http://tools.ietf.org/html/draft-ietf-oauth-json-web-token-30> (Version 30) but currently only implements the minimum required to work with the Atlassian Connect framework.  Known limitations:@@ -23,6 +23,9 @@    ('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     (@@ -47,6 +50,7 @@     -- ** JWT claims set     , intDate     , stringOrURI+    , stringOrURIToText     , secondsSinceEpoch     -- ** JWT header     , typ@@ -72,6 +76,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@@ -93,10 +98,19 @@ 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 @@ -128,7 +142,7 @@  -- | 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)+newtype IntDate = IntDate Integer deriving (Show, Eq, Ord)  -- | Return the seconds since 1970-01-01T0:0:0Z UTC for the given 'IntDate' secondsSinceEpoch :: IntDate -> NominalDiffTime@@ -345,10 +359,18 @@ -- | 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.Text -> Maybe StringOrURI stringOrURI t | URI.isURI $ T.unpack t = U <$> URI.parseURI (T.unpack 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 (U uri) = T.pack $ URI.uriToString id uri (""::String)+ -- =================================================================================  encodeJWT :: ToJSON a => a -> T.Text@@ -445,7 +467,7 @@ -- There are three use cases supported by the set of decoding/verification -- functions: ----- (1) Plaintext JWTs (<http://tools.ietf.org/html/draft-ietf-oauth-json-web-token-16#section-6>).+-- (1) Unsecured JWTs (<http://tools.ietf.org/html/draft-ietf-oauth-json-web-token-30#section-6>). --      This is supported by the decode function 'decode'. --      As a client you don't care about signing or encrypting so you only get back a 'JWT' 'UnverifiedJWT'. --      I.e. the type makes it clear that no signature verification was attempted.

@@ -2,6 +2,7 @@  import qualified Web.JWTTests import qualified Web.Base64Tests+import qualified Data.Text.AdditionsTests import           Test.Tasty  main :: IO ()@@ -11,5 +12,6 @@ tests = testGroup "JWT Tests" [                     Web.JWTTests.defaultTestGroup                   , Web.Base64Tests.defaultTestGroup+                  , Data.Text.AdditionsTests.defaultTestGroup                 ] 

@@ -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)

@@ -1,192 +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_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 unverified) = mJwt-    cs @=? claims unverified-    Just now @=? fmap secondsSinceEpoch (iat (claims unverified))--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---prop_stringOrURIProp = f-    where f :: StringOrURI -> Bool-          f sou = let s = stringOrURI $ T.pack $ show sou-                  in Just sou == s--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)