jwt 0.7.2 → 0.8.0

raw patch · 11 files changed

+220/−129 lines, 11 filesdep +HsOpenSSLdep +RSAdep −data-defaultdep ~basePVP ok

version bump matches the API change (PVP)

Dependencies added: HsOpenSSL, RSA

Dependencies removed: data-default

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

• CHANGELOG.md +7/−0
• README.md +1/−4
• doctests.hs +1/−0
• jwt.cabal +6/−3
• src/Web/JWT.hs +148/−61
• stack.yaml +4/−0
• tests/src/Data/ByteString/ExtendedTests.hs +1/−2
• tests/src/Data/Text/ExtendedTests.hs +1/−1
• tests/src/Web/JWTInteropTests.hs +4/−5
• tests/src/Web/JWTTests.hs +41/−41
• tests/src/Web/JWTTestsCompat.hs +6/−12

@@ -1,3 +1,10 @@+# 2018-03-21 0.8.0++* Support RS256 algorithm+* Add Monoid for ClaimsMap++Thanks to Patrick Brisbin and Brian McKenna for adding support for RS256.+ # 2016-06-02 0.7.2  * Add missing Data.ByteString.ExtendedTests (Thanks to nomeata for reporting

@@ -10,10 +10,7 @@ > of a JSON Web Encryption (JWE) structure, enabling the claims to be digitally signed or MACed  > and/or encrypted. -See the [Web.JWT module](http://hackage.haskell.org/package/jwt/docs/Web-JWT.html) documentation  to get started.-+See the [Web.JWT module](http://hackage.haskell.org/package/jwt/docs/Web-JWT.html) documentation to get started.  [![Build Status](https://travis-ci.org/juretta/haskell-jwt.svg?branch=master)](https://travis-ci.org/juretta/haskell-jwt)--

@@ -1,3 +1,4 @@ import Test.DocTest +main :: IO () main = doctest ["-isrc", "src/Web"]

@@ -2,7 +2,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/  name:                jwt-version:             0.7.2+version:             0.8.0 synopsis:            JSON Web Token (JWT) decoding and encoding license:             MIT license-file:        LICENSE@@ -22,6 +22,7 @@ extra-source-files:     CHANGELOG.md     README.md+    stack.yaml     tests/jwt.secret.1  source-repository head@@ -40,12 +41,13 @@                      , containers               >= 0.5                      , unordered-containers     >= 0.2                      , scientific               >= 0.2-                     , data-default             >= 0.5                      , http-types               >= 0.8                      , time                     >= 1.1                      , vector                   >= 0.7.1                      , semigroups               >= 0.15.4                      , network-uri+                     , RSA+                     , HsOpenSSL    hs-source-dirs:      src   default-language:    Haskell2010@@ -85,12 +87,13 @@                      , scientific               >= 0.2                      , containers                      , unordered-containers-                     , data-default                      , http-types                      , time                     >= 1.1                      , vector                   >= 0.7.1                      , semigroups               >= 0.15.4                      , network-uri+                     , RSA+                     , HsOpenSSL    cpp-options: -DTEST 

@@ -13,11 +13,11 @@ Stability:   experimental  This implementation of JWT is based on <https://tools.ietf.org/html/rfc7519>-but currently only implements the minimum required to work with the Atlassian Connect framework.+but currently only implements the minimum required to work with the Atlassian Connect framework and GitHub App  Known limitations: -   * Only HMAC SHA-256 algorithm is currently a supported signature algorithm+   * Only HMAC SHA-256 and RSA SHA-256 algorithms are currently a supported signature algorithm     * There is currently no verification of time related information    ('exp', 'nbf', 'iat').@@ -39,8 +39,8 @@     -- * Utility functions     -- ** Common     , tokenIssuer-    , secret-    , binarySecret+    , hmacSecret+    , rsaKeySecret     -- ** JWT structure     , claims     , header@@ -61,19 +61,17 @@     , UnverifiedJWT     , VerifiedJWT     , Signature-    , Secret+    , Signer(..)     , JWT     , JSON     , Algorithm(..)     , JWTClaimsSet(..)-    , ClaimsMap+    , ClaimsMap(..)     , IntDate     , NumericDate     , StringOrURI     , JWTHeader     , JOSEHeader--    , module Data.Default     ) where  import qualified Data.ByteString.Lazy.Char8 as BL (fromStrict, toStrict)@@ -81,6 +79,7 @@ import qualified Data.Text.Extended         as T import qualified Data.Text.Encoding         as TE +import           Codec.Crypto.RSA           (PrivateKey(..), PublicKey(..), sign) import           Control.Applicative import           Control.Monad import           Crypto.Hash.Algorithms@@ -88,13 +87,28 @@ import           Data.ByteArray.Encoding import           Data.Aeson                 hiding (decode, encode) import qualified Data.Aeson                 as JSON-import           Data.Default import qualified Data.HashMap.Strict        as StrictMap import qualified Data.Map                   as Map import           Data.Maybe import           Data.Scientific import           Data.Time.Clock            (NominalDiffTime) import qualified Network.URI                as URI+import           OpenSSL.EVP.PKey           (toKeyPair)+import           OpenSSL.PEM                (PemPasswordSupply(..), readPrivateKey)+import           OpenSSL.RSA+    ( RSAKeyPair+    , RSAPubKey+    , rsaCopyPublic+    , rsaD+    , rsaDMP1+    , rsaDMQ1+    , rsaE+    , rsaIQMP+    , rsaN+    , rsaP+    , rsaQ+    , rsaSize+    ) import           Prelude                    hiding (exp)  -- $setup@@ -108,14 +122,8 @@ {-# DEPRECATED JWTHeader "Use JOSEHeader instead. JWTHeader will be removed in 1.0" #-} type JWTHeader = JOSEHeader --- | The secret used for calculating the message signature-newtype Secret = Secret BS.ByteString--instance Eq Secret where-    (Secret s1) == (Secret s2) = s1 `BS.constTimeCompare` s2--instance Show Secret where-    show _ = "<secret>"+data Signer = HMACSecret BS.ByteString+            | RSAPrivateKey PrivateKey  newtype Signature = Signature T.Text deriving (Show) @@ -177,6 +185,7 @@     show (U u) = show u  data Algorithm = HS256 -- ^ HMAC using SHA-256 hash algorithm+               | RS256 -- ^ RSA using SHA-256 hash algorithm                  deriving (Eq, Show)  -- | JOSE Header, describes the cryptographic operations applied to the JWT@@ -189,16 +198,19 @@     -- | The cty (content type) Header Parameter defined by [JWS] and [JWE] is     -- used by this specification to convey structural information about the JWT.   , cty :: Maybe T.Text-    -- | The alg (algorithm) used for signing the JWT. The HS256 (HMAC using SHA-256)-    -- is the only required algorithm and the only one supported in this implementation-    -- in addition to "none" which means that no signature will be used.+    -- | The alg (algorithm) used for signing the JWT. The HS256 (HMAC using+    -- SHA-256) is the only required algorithm in addition to "none" which means+    -- that no signature will be used.     --     -- See <http://tools.ietf.org/html/draft-ietf-jose-json-web-algorithms-23#page-6>   , alg :: Maybe Algorithm } deriving (Eq, Show) -instance Default JOSEHeader where-    def = JOSEHeader Nothing Nothing Nothing+instance Monoid JOSEHeader where+    mempty =+      JOSEHeader Nothing Nothing Nothing+    mappend (JOSEHeader a b c) (JOSEHeader a' b' c') =+      JOSEHeader (a <|> a') (b <|> b') (c <|> c')  -- | The JWT Claims Set represents a JSON object whose members are the claims conveyed by the JWT. data JWTClaimsSet = JWTClaimsSet {@@ -230,37 +242,42 @@  } deriving (Show, Eq) --instance Default JWTClaimsSet where-    def = JWTClaimsSet Nothing Nothing Nothing Nothing Nothing Nothing Nothing Map.empty-+instance Monoid JWTClaimsSet where+  mempty =+    JWTClaimsSet Nothing Nothing Nothing Nothing Nothing Nothing Nothing $ ClaimsMap Map.empty+  mappend (JWTClaimsSet a b c d e f g h) (JWTClaimsSet a' b' c' d' e' f' g' h') =+    JWTClaimsSet (a <|> a') (b <|> b') (c <|> c') (d <|> d') (e <|> e') (f <|> f') (g <|> g') (mappend h h')  -- | Encode a claims set using the given secret -- --  @ --  let---      cs = def { -- def returns a default JWTClaimsSet+--      cs = mempty { -- mempty returns a default JWTClaimsSet --         iss = stringOrURI "Foo" --       , unregisteredClaims = Map.fromList [("http://example.com/is_root", (Bool True))] --      }---      key = secret "secret-key"---  in encodeSigned HS256 key cs+--      key = hmacSecret "secret-key"+--  in encodeSigned key cs -- @ -- > "eyJ0eXAiOiJKV1QiLCJhbGciOiJIUzI1NiJ9.eyJodHRwOi8vZXhhbXBsZS5jb20vaXNfcm9vdCI6dHJ1ZSwiaXNzIjoiRm9vIn0.vHQHuG3ujbnBUmEp-fSUtYxk27rLiP2hrNhxpyWhb2E"-encodeSigned :: Algorithm -> Secret -> JWTClaimsSet -> JSON-encodeSigned algo secret claims = dotted [header, claim, signature]-    where claim     = encodeJWT claims-          header    = encodeJWT def {+encodeSigned :: Signer -> JWTClaimsSet -> JSON+encodeSigned signer claims' = dotted [header', claim, signature']+    where claim     = encodeJWT claims'+          algo      = case signer of+                        HMACSecret _    -> HS256+                        RSAPrivateKey _ -> RS256++          header'   = encodeJWT mempty {                         typ = Just "JWT"                       , alg = Just algo                       }-          signature = calculateDigest algo secret (dotted [header, claim])+          signature' = calculateDigest signer (dotted [header', claim])  -- | Encode a claims set without signing it -- --  @ --  let---      cs = def { -- def returns a default JWTClaimsSet+--      cs = mempty { -- mempty returns a default JWTClaimsSet --      iss = stringOrURI "Foo" --    , iat = numericDate 1394700934 --    , unregisteredClaims = Map.fromList [("http://example.com/is_root", (Bool True))]@@ -269,9 +286,9 @@ --  @ -- > "eyJ0eXAiOiJKV1QiLCJhbGciOiJIUzI1NiJ9.eyJpYXQiOjEzOTQ3MDA5MzQsImh0dHA6Ly9leGFtcGxlLmNvbS9pc19yb290Ijp0cnVlLCJpc3MiOiJGb28ifQ." encodeUnsigned :: JWTClaimsSet -> JSON-encodeUnsigned claims = dotted [header, claim, ""]-    where claim     = encodeJWT claims-          header    = encodeJWT def {+encodeUnsigned claims' = dotted [header', claim, ""]+    where claim     = encodeJWT claims'+          header'   = encodeJWT mempty {                         typ = Just "JWT"                       , alg = Just HS256                       }@@ -297,7 +314,7 @@ --      mJwt = decode input --  in fmap claims mJwt -- :}--- Just (JWTClaimsSet {iss = Nothing, sub = Nothing, aud = Nothing, exp = Nothing, nbf = Nothing, iat = Nothing, jti = Nothing, unregisteredClaims = fromList [("some",String "payload")]})+-- Just (JWTClaimsSet {iss = Nothing, sub = Nothing, aud = Nothing, exp = Nothing, nbf = Nothing, iat = Nothing, jti = Nothing, unregisteredClaims = ClaimsMap {unClaimsMap = fromList [("some",String "payload")]}}) decode :: JSON -> Maybe (JWT UnverifiedJWT) decode input = do     (h,c,s) <- extractElems $ T.splitOn "." input@@ -324,14 +341,13 @@ --  let --      input = "eyJ0eXAiOiJKV1QiLCJhbGciOiJIUzI1NiJ9.eyJzb21lIjoicGF5bG9hZCJ9.Joh1R2dYzkRvDkqv3sygm5YyK8Gi4ShZqbhK2gxcs2U" :: T.Text --      mUnverifiedJwt = decode input---      mVerifiedJwt = verify (secret "secret") =<< mUnverifiedJwt+--      mVerifiedJwt = verify (hmacSecret "secret") =<< mUnverifiedJwt --  in signature =<< mVerifiedJwt -- :} -- Just (Signature "Joh1R2dYzkRvDkqv3sygm5YyK8Gi4ShZqbhK2gxcs2U")-verify :: Secret -> JWT UnverifiedJWT -> Maybe (JWT VerifiedJWT)-verify secret' (Unverified header' claims' unverifiedSignature originalClaim) = do-   algo <- alg header'-   let calculatedSignature = Signature $ calculateDigest algo secret' originalClaim+verify :: Signer -> JWT UnverifiedJWT -> Maybe (JWT VerifiedJWT)+verify signer (Unverified header' claims' unverifiedSignature originalClaim) = do+   let calculatedSignature = Signature $ calculateDigest signer originalClaim    guard (unverifiedSignature == calculatedSignature)    pure $ Verified header' claims' calculatedSignature @@ -344,12 +360,12 @@ -- >>> :{ --  let --      input = "eyJ0eXAiOiJKV1QiLCJhbGciOiJIUzI1NiJ9.eyJzb21lIjoicGF5bG9hZCJ9.Joh1R2dYzkRvDkqv3sygm5YyK8Gi4ShZqbhK2gxcs2U" :: T.Text---      mJwt = decodeAndVerifySignature (secret "secret") input+--      mJwt = decodeAndVerifySignature (hmacSecret "secret") input --  in signature =<< mJwt -- :} -- Just (Signature "Joh1R2dYzkRvDkqv3sygm5YyK8Gi4ShZqbhK2gxcs2U")-decodeAndVerifySignature :: Secret -> JSON -> Maybe (JWT VerifiedJWT)-decodeAndVerifySignature secret' input = verify secret' =<< decode input+decodeAndVerifySignature :: Signer -> JSON -> Maybe (JWT VerifiedJWT)+decodeAndVerifySignature signer input = verify signer =<< decode input  -- | Try to extract the value for the issue claim field 'iss' from the web token in JSON form tokenIssuer :: JSON -> Maybe StringOrURI@@ -357,12 +373,68 @@  -- | 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 . TE.encodeUtf8+hmacSecret :: T.Text -> Signer+hmacSecret = HMACSecret . TE.encodeUtf8 --- | Create a Secret using the given key.-binarySecret :: BS.ByteString -> Secret-binarySecret = Secret+-- | Create an RSAPrivateKey from PEM contents+--+-- > rsaKeySecret =<< readFile "foo.pem"+--+-- >>> :{+--   -- A random example key created with `ssh-keygen -t rsa`+--   fmap (\(Just (RSAPrivateKey pk)) -> pk) $ rsaKeySecret $ unlines+--       [ "-----BEGIN RSA PRIVATE KEY-----"+--       , "MIIEowIBAAKCAQEAkkmgbLluo5HommstpHr1h53uWfuN3CwYYYR6I6a2MzAHIMIv"+--       , "8Ak2ha+N2UDeYsfVhZ/DOnE+PMm2RpYSaiYT0l2a7ZkmRSbcyvVFt3XLePJbmUgo"+--       , "ieyccS4uYHeqRggdWH9His3JaR2N71N9iU0+mY5nu2+15iYw3naT/PSx01IzBqHN"+--       , "Zie1z3FYX09FgOs31mcR8VWj8DefxbKE08AW+vDMT2AmUC2b+Gqk6SqRz29HuPBs"+--       , "yyV4Xl9CgzcCWjuXTv6mevDygo5RVZg34U6L1iFRgwwHbrLcd2N97wlKz+OiDSgM"+--       , "sbZWA0i2D9ZsDR9rdEdXzUIw6toIRYZfeI9QYQIDAQABAoIBAEXkh5Fqx0G/ZLLi"+--       , "olwDo2u4OTkkxxJ6vutYsEJ4VHUAbWdpYB3/SN12kv9JzvbDI3FEc7JoiKPifAQd"+--       , "j47HwpCvyGXc1jwT5UnTBgwxa5XNtZX2s+ex9Mzek6njgqcTGXI+3Z+j0qc2R6og"+--       , "6cm/7jjPoSAcr3vWo2KmpO4muw+LbYoSGo0Jydoa5cGtkmDfsjjrMw7mDoRttdhw"+--       , "WdhS+q2aJPFI7q7itoYUd7KLe3nOeM0zd35Pc8Qc6jGk+JZxQdXrb/NrSNgAATcN"+--       , "GGS226Q444N0pAfc188IDcAtQPSJpzbs/1+TPzE4ov/lpHTr91hXr3RLyVgYBI01"+--       , "jrggfAECgYEAwaC4iDSZQ+8eUx/zR973Lu9mvQxC2BZn6QcOtBcIRBdGRlXfhwuD"+--       , "UgwVZ2M3atH5ZXFuQ7pRtJtj7KCFy7HUFAJC15RCfLjx+n39bISNp5NOJEdI+UM+"+--       , "G2xMHv5ywkULV7Jxb+tSgsYIvJ0tBjACkif8ahNjgVJmgMSOgdHR2pkCgYEAwWkN"+--       , "uquRqKekx4gx1gJYV7Y6tPWcsZpEcgSS7AGNJ4UuGZGGHdStpUoJICn2cFUngYNz"+--       , "eJXOg+VhQJMqQx9c+u85mg/tJluGaw95tBAafspwvhKewlO9OhQeVInPbXMUwrJ0"+--       , "PS3XV7c74nxm6Nn4QHlM07orn3lOiWxZF8BBSQkCgYATjwSU3ZtNvW22v9d3PxKA"+--       , "7zXVitOFuF2usEPP9TOkjSVQHYSCw6r0MrxGwULry2IB2T9mH//42mlxkZVySfg+"+--       , "PSw7UoKUzqnCv89Fku4sKzkNeRXp99ziMEJQLyuwbAEFTsUepQqkoxRm2QmfQmJA"+--       , "GUHqBSNcANLR1wj+HA+yoQKBgQCBlqj7RQ+AaGsQwiFaGhIlGtU1AEgv+4QWvRfQ"+--       , "B64TJ7neqdGp1SFP2U5J/bPASl4A+hl5Vy6a0ysZQEGV3cLH41e98SPdin+C5kiO"+--       , "LCgEghGOWR2EaOUlr+sui3OvCueDGFynzTo27G+0bdPp+nnKgTvHtTqbTIUhsLX1"+--       , "IvzbOQKBgH4q36jgBb9T3hjXtWyrytlmFtBdw0i+UiMvMlnOqujGhcnOk5UMyxOQ"+--       , "sQI+/31jIGbmlE7YaYykR1FH3LzAjO4J1+m7vv5fIRdG8+sI01xTc8UAdbmWtK+5"+--       , "TK1oLP43BHH5gRAfIlXj2qmap5lEG6If/xYB4MOs8Bui5iKaJlM5"+--       , "-----END RSA PRIVATE KEY-----"+--       ]+-- :}+-- PrivateKey {private_pub = PublicKey {public_size = 256, public_n = 1846..., public_e = 65537}, private_d = 8823..., private_p = 135..., private_q = 1358..., private_dP = 1373..., private_dQ = 9100..., private_qinv = 8859...}+--+rsaKeySecret :: String -> IO (Maybe Signer)+rsaKeySecret k = do+    mKeyPair <- toKeyPair <$> readPrivateKey k PwNone+    mPublicKey <- mapM rsaCopyPublic mKeyPair+    return $ RSAPrivateKey <$>+        (fromRSAKey <$> mKeyPair <*> mPublicKey)+  where+    fromRSAKey :: RSAKeyPair -> RSAPubKey -> PrivateKey+    fromRSAKey kp pk = PrivateKey+        { private_pub = PublicKey+            { public_size = rsaSize pk+            , public_n = rsaN pk+            , public_e = rsaE pk+            }+        , private_d = rsaD kp+        , private_p = rsaP kp+        , private_q = rsaQ kp+        , private_dP = fromMaybe 0 $ rsaDMP1 kp+        , private_dQ = fromMaybe 0 $ rsaDMQ1 kp+        , private_qinv = fromMaybe 0 $ rsaIQMP kp+        }  -- | Convert the `NominalDiffTime` into an IntDate. Returns a Nothing if the -- argument is invalid (e.g. the NominalDiffTime must be convertible into a@@ -416,21 +488,34 @@  -- ================================================================================= -calculateDigest :: Algorithm -> Secret -> T.Text -> T.Text-calculateDigest HS256 (Secret key) msg = TE.decodeUtf8 $ convertToBase Base64URLUnpadded (hmac key (bs msg) :: HMAC SHA256)-    where -        bs = TE.encodeUtf8+calculateDigest :: Signer -> T.Text -> T.Text+calculateDigest (HMACSecret key) msg =+    TE.decodeUtf8 $ convertToBase Base64URLUnpadded (hmac key (TE.encodeUtf8 msg) :: HMAC SHA256) +calculateDigest (RSAPrivateKey key) msg = TE.decodeUtf8+    $ convertToBase Base64URLUnpadded+    $ BL.toStrict+    $ sign key+    $ BL.fromStrict+    $ TE.encodeUtf8 msg+ -- ================================================================================= -type ClaimsMap = Map.Map T.Text Value+newtype ClaimsMap = ClaimsMap { unClaimsMap :: Map.Map T.Text Value }+    deriving (Eq, Show) +instance Monoid ClaimsMap where+  mempty =+    ClaimsMap mempty+  mappend (ClaimsMap a) (ClaimsMap b) =+    ClaimsMap $ mappend a b+ fromHashMap :: Object -> ClaimsMap-fromHashMap = Map.fromList . StrictMap.toList+fromHashMap = ClaimsMap . Map.fromList . StrictMap.toList  removeRegisteredClaims :: ClaimsMap -> ClaimsMap-removeRegisteredClaims input = Map.differenceWithKey (\_ _ _ -> Nothing) input registeredClaims-    where +removeRegisteredClaims (ClaimsMap input) = ClaimsMap $ Map.differenceWithKey (\_ _ _ -> Nothing) input registeredClaims+    where         registeredClaims = Map.fromList $ map (\e -> (e, Null)) ["iss", "sub", "aud", "exp", "nbf", "iat", "jti"]  instance ToJSON JWTClaimsSet where@@ -442,7 +527,7 @@                 , fmap ("nbf" .=) nbf                 , fmap ("iat" .=) iat                 , fmap ("jti" .=) jti-            ] ++ Map.toList (removeRegisteredClaims unregisteredClaims)+            ] ++ Map.toList (unClaimsMap $ removeRegisteredClaims unregisteredClaims)  instance FromJSON JWTClaimsSet where         parseJSON = withObject "JWTClaimsSet"@@ -482,9 +567,11 @@  instance ToJSON Algorithm where     toJSON HS256 = String ("HS256"::T.Text)+    toJSON RS256 = String ("RS256"::T.Text)  instance FromJSON Algorithm where     parseJSON (String "HS256") = return HS256+    parseJSON (String "RS256") = return RS256     parseJSON _                = mzero  instance ToJSON StringOrURI where

@@ -0,0 +1,4 @@+packages:+- '.'+extra-deps: []+resolver: lts-9.6

@@ -1,15 +1,14 @@ {-# LANGUAGE OverloadedStrings   #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TemplateHaskell     #-}+{-# OPTIONS_GHC -fno-warn-orphans #-} module Data.ByteString.ExtendedTests   (     main   , defaultTestGroup ) where -import           Control.Applicative import qualified Data.ByteString.Extended as BS-import           Data.String              (fromString) import qualified Test.QuickCheck          as QC import           Test.Tasty import           Test.Tasty.QuickCheck

@@ -1,13 +1,13 @@ {-# LANGUAGE OverloadedStrings   #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TemplateHaskell     #-}+{-# OPTIONS_GHC -fno-warn-orphans #-} module Data.Text.ExtendedTests   (     main   , defaultTestGroup ) where -import           Control.Applicative import           Data.String           (fromString) import qualified Data.Text.Extended    as T import qualified Test.QuickCheck       as QC

@@ -1,9 +1,9 @@ {-# LANGUAGE FlexibleInstances    #-}-{-# LANGUAGE OverlappingInstances #-} {-# LANGUAGE OverloadedStrings    #-} {-# LANGUAGE ScopedTypeVariables  #-} {-# LANGUAGE TemplateHaskell      #-} {-# LANGUAGE TypeSynonymInstances #-}+{-# OPTIONS_GHC -fno-warn-orphans #-} {-| Tests that verify that the shape of the JSON used is matching the spec. @@ -23,20 +23,18 @@ ) 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           Data.String           (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@@ -56,6 +54,7 @@ prop_encode_decode_iss :: JWTClaimsSet -> Bool prop_encode_decode_iss = shouldBeMaybeStringOrUri "iss" iss +shouldBeMaybeStringOrUri :: ToJSON a => T.Text -> (a -> Maybe StringOrURI) -> a -> Bool shouldBeMaybeStringOrUri key' f claims' =      let json = toJSON claims' ^? key key'     in json == (fmap (String . stringOrURIToText) $ f claims')@@ -80,7 +79,7 @@                              <*> arbitrary  instance Arbitrary ClaimsMap where-    arbitrary = return Map.empty+    arbitrary = return $ ClaimsMap Map.empty  instance Arbitrary NumericDate where     arbitrary = fmap (f . numericDate) (arbitrary :: QC.Gen NominalDiffTime)

@@ -1,12 +1,13 @@ {-# LANGUAGE BangPatterns, OverloadedStrings, ScopedTypeVariables, TemplateHaskell #-}-{-# LANGUAGE TypeSynonymInstances, FlexibleInstances, OverlappingInstances #-}+{-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-}+{-# OPTIONS_GHC -fno-warn-missing-signatures #-}+{-# OPTIONS_GHC -fno-warn-orphans #-} module Web.JWTTests   (     main   , defaultTestGroup ) where -import           Control.Applicative import           Test.Tasty import           Test.Tasty.TH import           Test.Tasty.HUnit@@ -14,12 +15,11 @@ 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)+import           Data.String (fromString) import           Data.Time import           Web.JWT @@ -52,22 +52,22 @@     True @=? isJust (fmap signature mJwt)     let (Just unverified) = mJwt     Just HS256 @=? alg (header unverified)-    Just "payload" @=? Map.lookup "some" (unregisteredClaims $ claims unverified)+    Just "payload" @=? Map.lookup "some" (unClaimsMap $ unregisteredClaims $ claims unverified)  case_verify = do     -- Generated with ruby-jwt     let input = "eyJ0eXAiOiJKV1QiLCJhbGciOiJIUzI1NiJ9.eyJzb21lIjoicGF5bG9hZCJ9.Joh1R2dYzkRvDkqv3sygm5YyK8Gi4ShZqbhK2gxcs2U"-        mVerified = verify (secret "secret") =<< decode input+        mVerified = verify (hmacSecret "secret") =<< decode input     True @=? isJust mVerified  case_decodeAndVerifyJWT = do     -- Generated with ruby-jwt     let input = "eyJ0eXAiOiJKV1QiLCJhbGciOiJIUzI1NiJ9.eyJzb21lIjoicGF5bG9hZCJ9.Joh1R2dYzkRvDkqv3sygm5YyK8Gi4ShZqbhK2gxcs2U"-        mJwt = decodeAndVerifySignature (secret "secret") input+        mJwt = decodeAndVerifySignature (hmacSecret "secret") input     True @=? isJust mJwt     let (Just verified) = mJwt     Just HS256 @=? alg (header verified)-    Just "payload" @=? Map.lookup "some" (unregisteredClaims $ claims verified)+    Just "payload" @=? Map.lookup "some" (unClaimsMap $ unregisteredClaims $ claims verified)  -- It must be impossible to get a VerifiedJWT if alg is "none" case_decodeAndVerifyJWTAlgoNone = do@@ -89,13 +89,13 @@             }     -}     let input = "eyJhbGciOiJub25lIiwidHlwIjoiSldUIn0.eyJpc3MiOiJodHRwczovL2p3dC1pZHAuZXhhbXBsZS5jb20iLCJzdWIiOiJtYWlsdG86bWlrZUBleGFtcGxlLmNvbSIsIm5iZiI6MTQyNTk4MDc1NSwiZXhwIjoxNDI1OTg0MzU1LCJpYXQiOjE0MjU5ODA3NTUsImp0aSI6ImlkMTIzNDU2IiwidHlwIjoiaHR0cHM6Ly9leGFtcGxlLmNvbS9yZWdpc3RlciJ9."-        mJwt = decodeAndVerifySignature (secret "secretkey") input+        mJwt = decodeAndVerifySignature (hmacSecret "secretkey") input     False @=? isJust mJwt  case_decodeAndVerifyJWTFailing = do     -- Generated with ruby-jwt, modified to be invalid     let input = "eyJ0eXAiOiJKV1QiLCJhbGciOiJIUzI1NiJ9.eyJzb21lIjoicGF5bG9hZCJ9.Joh1R2dYzkRvDkqv3sygm5YyK8Gi4ShZqbhK2gxcs2u"-        mJwt = decodeAndVerifySignature (secret "secret") input+        mJwt = decodeAndVerifySignature (hmacSecret "secret") input     False @=? isJust mJwt  case_decodeInvalidInput = do@@ -105,13 +105,13 @@  case_decodeAndVerifySignatureInvalidInput = do     let inputs = ["", "a.", "a.b"]-        result = map (decodeAndVerifySignature (secret "secret")) inputs+        result = map (decodeAndVerifySignature (hmacSecret "secret")) inputs     True @=? all isNothing result  case_encodeJWTNoMac = do-    let cs = def {+    let cs = mempty {         iss = stringOrURI "Foo"-      , unregisteredClaims = Map.fromList [("http://example.com/is_root", Bool True)]+      , unregisteredClaims = ClaimsMap $ 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@@ -123,9 +123,9 @@   case_encodeDecodeJWTNoMac = do-    let cs = def {+    let cs = mempty {         iss = stringOrURI "Foo"-      , unregisteredClaims = Map.fromList [("http://example.com/is_root", Bool True)]+      , unregisteredClaims = ClaimsMap $ Map.fromList [("http://example.com/is_root", Bool True)]     }         mJwt = decode $ encodeUnsigned cs     True @=? isJust mJwt@@ -134,69 +134,69 @@  case_encodeDecodeJWT = do     let now = 1394573404-        cs = def {+        cs = mempty {         iss = stringOrURI "Foo"       , iat = numericDate now-      , unregisteredClaims = Map.fromList [("http://example.com/is_root", Bool True)]+      , unregisteredClaims = ClaimsMap $ Map.fromList [("http://example.com/is_root", Bool True)]     }-        key = secret "secret-key"-        mJwt = decode $ encodeSigned HS256 key cs+        key = hmacSecret "secret-key"+        mJwt = decode $ encodeSigned 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 {+        cs = mempty {         iss = iss'-      , unregisteredClaims = Map.fromList [("http://example.com/is_root", Bool True)]+      , unregisteredClaims = ClaimsMap $ Map.fromList [("http://example.com/is_root", Bool True)]     }-        key = secret "secret-key"-        t   = encodeSigned HS256 key cs+        key = hmacSecret "secret-key"+        t   = encodeSigned key cs     iss' @=? tokenIssuer t  case_encodeDecodeJWTClaimsSetCustomClaims = do     let now = 1234-        cs = def {+        cs = mempty {         iss = stringOrURI "Foo"       , iat = numericDate now-      , unregisteredClaims = Map.fromList [("http://example.com/is_root", Bool True)]+      , unregisteredClaims = ClaimsMap $ Map.fromList [("http://example.com/is_root", Bool True)]     }-    let secret' = secret "secret"-        jwt = decodeAndVerifySignature secret' $ encodeSigned HS256 secret' cs+    let secret' = hmacSecret "secret"+        jwt = decodeAndVerifySignature secret' $ encodeSigned secret' cs     Just cs @=? fmap claims jwt  case_encodeDecodeJWTClaimsSetWithSingleAud = do     let now = 1234-        cs = def {+        cs = mempty {             iss = stringOrURI "Foo"           , aud = Left <$> stringOrURI "single-audience"           , iat = numericDate now         }-    let secret' = secret "secret"-        jwt = decodeAndVerifySignature secret' $ encodeSigned HS256 secret' cs+    let secret' = hmacSecret "secret"+        jwt = decodeAndVerifySignature secret' $ encodeSigned secret' cs     Just cs @=? fmap claims jwt  case_encodeDecodeJWTClaimsSetWithMultipleAud = do     let now = 1234-        cs = def {+        cs = mempty {             iss = stringOrURI "Foo"           , aud = Right <$> (:[]) <$> stringOrURI "audience"           , iat = numericDate now         }-    let secret' = secret "secret"-        jwt = decodeAndVerifySignature secret' $ encodeSigned HS256 secret' cs+    let secret' = hmacSecret "secret"+        jwt = decodeAndVerifySignature secret' $ encodeSigned secret' cs     Just cs @=? fmap claims jwt  case_encodeDecodeJWTClaimsSetBinarySecret = do     let now = 1234-        cs = def {+        cs = mempty {             iss = stringOrURI "Foo"           , iat = numericDate now         }     secretKey <- BS.readFile "tests/jwt.secret.1"-    let secret' = binarySecret secretKey-        jwt = decodeAndVerifySignature secret' $ encodeSigned HS256 secret' cs+    let secret' = HMACSecret secretKey+        jwt = decodeAndVerifySignature secret' $ encodeSigned secret' cs     Just cs @=? fmap claims jwt  prop_stringOrURIProp = f@@ -213,18 +213,18 @@  prop_encode_decode = f     where f :: T.Text -> JWTClaimsSet -> Bool-          f key claims' = let Just unverified = (decode $ encodeSigned HS256 (secret key) claims')+          f key claims' = let Just unverified = (decode $ encodeSigned (hmacSecret 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')+          f binary claims' = let Just unverified = (decode $ encodeSigned (HMACSecret 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')+          f key' claims' = let key = hmacSecret key'+                               Just verified = (decodeAndVerifySignature key $ encodeSigned key claims')                            in claims verified == claims'  @@ -239,7 +239,7 @@                              <*> arbitrary  instance Arbitrary ClaimsMap where-    arbitrary = return Map.empty+    arbitrary = return $ ClaimsMap Map.empty  instance Arbitrary NumericDate where     arbitrary = fmap (f . numericDate) (arbitrary :: QC.Gen NominalDiffTime)

@@ -1,5 +1,7 @@ {-# LANGUAGE BangPatterns, OverloadedStrings, ScopedTypeVariables, TemplateHaskell #-} {-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-}+{-# OPTIONS_GHC -fno-warn-missing-signatures #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}  {-  - Turn of deprecation warnings as these tests deliberately use @@ -13,19 +15,11 @@   , 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@@ -41,13 +35,13 @@  case_encodeDecodeJWTIntDateIat = do     let now = 1394573404-        cs = def {+        cs = mempty {         iss = stringOrURI "Foo"       , iat = intDate now-      , unregisteredClaims = Map.fromList [("http://example.com/is_root", Bool True)]+      , unregisteredClaims = ClaimsMap $ Map.fromList [("http://example.com/is_root", Bool True)]     }-        key = secret "secret-key"-        mJwt = decode $ encodeSigned HS256 key cs+        key = hmacSecret "secret-key"+        mJwt = decode $ encodeSigned key cs     let (Just claims') = fmap claims mJwt     cs @=? claims'     Just now @=? fmap secondsSinceEpoch (iat claims')