summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorStefanSaasen <>2018-04-16 07:52:00 (GMT)
committerhdiff <hdiff@hdiff.luite.com>2018-04-16 07:52:00 (GMT)
commitcd3a582cd12197a8c0f4db8a5e78c0ab2541963c (patch)
tree67b35871f8ec53abfab057b90bf92dc52a0e41a4
parent497526a6fd877d414c7497d1b55985faf3769993 (diff)
version 0.8.0HEAD0.8.0master
-rw-r--r--CHANGELOG.md7
-rw-r--r--README.md7
-rw-r--r--doctests.hs1
-rw-r--r--jwt.cabal9
-rw-r--r--src/Web/JWT.hs209
-rw-r--r--stack.yaml4
-rw-r--r--tests/src/Data/ByteString/ExtendedTests.hs3
-rw-r--r--tests/src/Data/Text/ExtendedTests.hs2
-rw-r--r--tests/src/Web/JWTInteropTests.hs9
-rw-r--r--tests/src/Web/JWTTests.hs82
-rw-r--r--tests/src/Web/JWTTestsCompat.hs18
11 files changed, 221 insertions, 130 deletions
diff --git a/CHANGELOG.md b/CHANGELOG.md
index 4ac8e64..cf5e5e7 100644
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -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
diff --git a/README.md b/README.md
index 64de678..4718358 100644
--- a/README.md
+++ b/README.md
@@ -10,10 +10,7 @@ From http://self-issued.info/docs/draft-ietf-oauth-json-web-token.html
> 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)
-
-
+Status](https://travis-ci.org/juretta/haskell-jwt.svg?branch=master)](https://travis-ci.org/juretta/haskell-jwt) \ No newline at end of file
diff --git a/doctests.hs b/doctests.hs
index 3a43043..ff533a0 100644
--- a/doctests.hs
+++ b/doctests.hs
@@ -1,3 +1,4 @@
import Test.DocTest
+main :: IO ()
main = doctest ["-isrc", "src/Web"]
diff --git a/jwt.cabal b/jwt.cabal
index 9069646..d9dea45 100644
--- a/jwt.cabal
+++ b/jwt.cabal
@@ -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 @@ description:
extra-source-files:
CHANGELOG.md
README.md
+ stack.yaml
tests/jwt.secret.1
source-repository head
@@ -40,12 +41,13 @@ library
, 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 @@ test-suite testsuite
, 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
diff --git a/src/Web/JWT.hs b/src/Web/JWT.hs
index b10cc56..f93050a 100644
--- a/src/Web/JWT.hs
+++ b/src/Web/JWT.hs
@@ -13,11 +13,11 @@ Maintainer: Stefan Saasen <stefan@saasen.me>
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 @@ module Web.JWT
-- * Utility functions
-- ** Common
, tokenIssuer
- , secret
- , binarySecret
+ , hmacSecret
+ , rsaKeySecret
-- ** JWT structure
, claims
, header
@@ -61,19 +61,17 @@ module Web.JWT
, 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.ByteString.Extended as BS
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 Crypto.MAC.HMAC
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 @@ type JSON = T.Text
{-# 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 @@ instance Show StringOrURI where
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 @@ data JOSEHeader = JOSEHeader {
-- | 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 @@ data JWTClaimsSet = JWTClaimsSet {
} 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 @@ encodeSigned algo secret claims = dotted [header, claim, signature]
-- @
-- > "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 @@ encodeUnsigned claims = dotted [header, claim, ""]
-- 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 @@ decode input = do
-- 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 @@ verify secret' (Unverified header' claims' unverifiedSignature originalClaim) =
-- >>> :{
-- 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 @@ tokenIssuer = decode >=> fmap pure claims >=> iss
-- | 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 @@ dotted = T.intercalate "."
-- =================================================================================
-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 @@ instance ToJSON JWTClaimsSet where
, 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 FromJSON NumericDate where
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
diff --git a/stack.yaml b/stack.yaml
new file mode 100644
index 0000000..404152d
--- /dev/null
+++ b/stack.yaml
@@ -0,0 +1,4 @@
+packages:
+- '.'
+extra-deps: []
+resolver: lts-9.6
diff --git a/tests/src/Data/ByteString/ExtendedTests.hs b/tests/src/Data/ByteString/ExtendedTests.hs
index c42971b..7dd6a12 100644
--- a/tests/src/Data/ByteString/ExtendedTests.hs
+++ b/tests/src/Data/ByteString/ExtendedTests.hs
@@ -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
diff --git a/tests/src/Data/Text/ExtendedTests.hs b/tests/src/Data/Text/ExtendedTests.hs
index 9927d3c..17bf917 100644
--- a/tests/src/Data/Text/ExtendedTests.hs
+++ b/tests/src/Data/Text/ExtendedTests.hs
@@ -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
diff --git a/tests/src/Web/JWTInteropTests.hs b/tests/src/Web/JWTInteropTests.hs
index 6d45f0a..c25d754 100644
--- a/tests/src/Web/JWTInteropTests.hs
+++ b/tests/src/Web/JWTInteropTests.hs
@@ -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 @@ module Web.JWTInteropTests (
) 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_sub = shouldBeMaybeStringOrUri "sub" sub
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 @@ instance Arbitrary JWTClaimsSet where
<*> 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)
diff --git a/tests/src/Web/JWTTests.hs b/tests/src/Web/JWTTests.hs
index 9408506..171283b 100644
--- a/tests/src/Web/JWTTests.hs
+++ b/tests/src/Web/JWTTests.hs
@@ -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 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.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 @@ case_decodeJWT = do
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 @@ case_decodeAndVerifyJWTAlgoNone = do
}
-}
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_decodeInvalidInput = do
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_encodeJWTNoMac = do
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_encodeDecodeJWTNoMac = do
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_stringOrURIToText= f
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 @@ instance Arbitrary JWTClaimsSet where
<*> 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)
diff --git a/tests/src/Web/JWTTestsCompat.hs b/tests/src/Web/JWTTestsCompat.hs
index 4c4da57..da4c4dc 100644
--- a/tests/src/Web/JWTTestsCompat.hs
+++ b/tests/src/Web/JWTTestsCompat.hs
@@ -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 @@ module Web.JWTTestsCompat
, 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_intDateDeriveOrd = do
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')