diff --git a/changelog b/changelog --- a/changelog +++ b/changelog @@ -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 ================ 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.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 diff --git a/src/Data/Text/Additions.hs b/src/Data/Text/Additions.hs new file mode 100644 --- /dev/null +++ b/src/Data/Text/Additions.hs @@ -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) 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 16) +This implementation of JWT is based on (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 _ = "" + +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 (). +-- (1) Unsecured JWTs (). -- 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. diff --git a/tests/src/TestRunner.hs b/tests/src/TestRunner.hs --- a/tests/src/TestRunner.hs +++ b/tests/src/TestRunner.hs @@ -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 ] 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/JWTTests.hs b/tests/src/Web/JWTTests.hs deleted file mode 100644 --- a/tests/src/Web/JWTTests.hs +++ /dev/null @@ -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 - --
.. - 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)