jwt 0.5.2 → 0.5.3

raw patch · 6 files changed

+421/−1 lines, 6 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

changelog +7/−0
jwt.cabal +3/−1
tests/src/Data/Text/AdditionsTests.hs +30/−0
tests/src/Web/Base64Tests.hs +56/−0
tests/src/Web/JWTInteropTests.hs +102/−0
tests/src/Web/JWTTests.hs +223/−0

changelog view

@@ -1,3 +1,10 @@+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 ================

jwt.cabal view

@@ -2,7 +2,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/  name:                jwt-version:             0.5.2+version:             0.5.3 synopsis:            JSON Web Token (JWT) decoding and encoding license:             MIT license-file:        LICENSE@@ -68,6 +68,8 @@   default-language:    Haskell2010   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.AdditionsTests   hs-source-dirs:      tests/src, src   build-depends:       base < 5 && >= 4.4                      , tasty >= 0.7

+ tests/src/Data/Text/AdditionsTests.hs view

@@ -0,0 +1,30 @@+{-# LANGUAGE OverloadedStrings   #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TemplateHaskell     #-}+module Data.Text.AdditionsTests+  (+    main+  , defaultTestGroup+) where++import           Control.Applicative+import           Data.String           (fromString)+import qualified Data.Text             as T+import           Data.Text.Additions+import qualified Test.QuickCheck       as QC+import           Test.Tasty+import           Test.Tasty.QuickCheck+import           Test.Tasty.TH++defaultTestGroup :: TestTree+defaultTestGroup = $(testGroupGenerator)++main :: IO ()+main = defaultMain defaultTestGroup++prop_constTimeCompare :: T.Text -> T.Text -> Bool+prop_constTimeCompare a b = (a == b) == (a `constTimeCompare` b)++instance Arbitrary T.Text where+    arbitrary = fromString <$> (arbitrary :: QC.Gen String)+

+ tests/src/Web/Base64Tests.hs view

@@ -0,0 +1,56 @@+{-# 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/JWTInteropTests.hs view

@@ -0,0 +1,102 @@+{-# LANGUAGE FlexibleInstances    #-}+{-# LANGUAGE OverloadedStrings    #-}+{-# LANGUAGE ScopedTypeVariables  #-}+{-# LANGUAGE TemplateHaskell      #-}+{-# LANGUAGE TypeSynonymInstances #-}+{-|+Tests that verify that the shape of the JSON used is matching the spec.++It's not sufficient to just ensure that++`fromJSON . toJSON = id`++This would only verify that an isomorphism exists but wouldn't tests 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+JWT compliant library can decode it.+-}+module Web.JWTInteropTests (+    main+  , defaultTestGroup+) where++import           Prelude hiding (exp)+import           Control.Applicative+import           Control.Lens+import           Data.Aeson.Lens+import           Data.Aeson.Types+import qualified Data.Map              as Map+import           Data.Maybe+import           Data.String           (IsString, fromString)+import qualified Data.Text             as T+import qualified Data.Text.Lazy        as TL+import           Data.Time+import qualified Data.Vector           as Vector+import qualified Test.QuickCheck       as QC+import           Test.Tasty+import           Test.Tasty.HUnit+import           Test.Tasty.QuickCheck+import           Test.Tasty.TH+import           Web.JWT++defaultTestGroup :: TestTree+defaultTestGroup = $(testGroupGenerator)++main :: IO ()+main = defaultMain defaultTestGroup++prop_encode_decode_jti :: JWTClaimsSet -> Bool+prop_encode_decode_jti = shouldBeMaybeStringOrUri "jti" jti++prop_encode_decode_sub :: JWTClaimsSet -> Bool+prop_encode_decode_sub = shouldBeMaybeStringOrUri "sub" sub++prop_encode_decode_iss :: JWTClaimsSet -> Bool+prop_encode_decode_iss = shouldBeMaybeStringOrUri "iss" iss++shouldBeMaybeStringOrUri key' f claims' = +    let json = toJSON claims' ^? key key'+    in json == (fmap (String . stringOrURIToText) $ f claims')++prop_encode_decode_aud :: JWTClaimsSet -> Bool+prop_encode_decode_aud claims' =+    let json = toJSON claims' ^? key "aud"+    in json == (case aud claims' of+                      Just (Left s)   -> Just $ String $ stringOrURIToText s                                    -- aud is just a single element+                      Just (Right xs) -> Just $ Array $ fmap (String . stringOrURIToText) $ Vector.fromList xs  -- aud is a list of elements+                      Nothing         -> Nothing                                                                -- aud is absent+               )++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)

+ tests/src/Web/JWTTests.hs view

@@ -0,0 +1,223 @@+{-# 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)