jwt-0.7.2/src/0000755000000000000000000000000012510212027011271 5ustar0000000000000000jwt-0.7.2/src/Data/0000755000000000000000000000000012722235237012157 5ustar0000000000000000jwt-0.7.2/src/Data/ByteString/0000755000000000000000000000000012722235237014251 5ustar0000000000000000jwt-0.7.2/src/Data/Text/0000755000000000000000000000000012702673714013107 5ustar0000000000000000jwt-0.7.2/src/Web/0000755000000000000000000000000012723537471012031 5ustar0000000000000000jwt-0.7.2/tests/0000755000000000000000000000000012722235237011661 5ustar0000000000000000jwt-0.7.2/tests/src/0000755000000000000000000000000012722235237012450 5ustar0000000000000000jwt-0.7.2/tests/src/Data/0000755000000000000000000000000012722235237013321 5ustar0000000000000000jwt-0.7.2/tests/src/Data/ByteString/0000755000000000000000000000000012722235237015413 5ustar0000000000000000jwt-0.7.2/tests/src/Data/Text/0000755000000000000000000000000012510212027014230 5ustar0000000000000000jwt-0.7.2/tests/src/Web/0000755000000000000000000000000012723537471013173 5ustar0000000000000000jwt-0.7.2/src/Web/JWT.hs0000644000000000000000000004634012723537471013040 0ustar0000000000000000{-# LANGUAGE EmptyDataDecls #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE StandaloneDeriving #-} {-| Module: Web.JWT License: MIT Maintainer: Stefan Saasen Stability: experimental This implementation of JWT is based on but currently only implements the minimum required to work with the Atlassian Connect framework. Known limitations: * Only HMAC SHA-256 algorithm is currently a supported signature algorithm * There is currently no verification of time related information ('exp', 'nbf', 'iat'). * Registered claims are not validated -} module Web.JWT ( -- * Encoding & Decoding JWTs -- ** Decoding -- $docDecoding decode , verify , decodeAndVerifySignature -- ** Encoding , encodeSigned , encodeUnsigned -- * Utility functions -- ** Common , tokenIssuer , secret , binarySecret -- ** JWT structure , claims , header , signature -- ** JWT claims set , auds , intDate , numericDate , stringOrURI , stringOrURIToText , secondsSinceEpoch -- ** JWT header , typ , cty , alg -- * Types , UnverifiedJWT , VerifiedJWT , Signature , Secret , JWT , JSON , Algorithm(..) , JWTClaimsSet(..) , ClaimsMap , IntDate , NumericDate , StringOrURI , JWTHeader , JOSEHeader , module Data.Default ) where import qualified Data.ByteString.Lazy.Char8 as BL (fromStrict, toStrict) import qualified Data.ByteString.Extended as BS import qualified Data.Text.Extended as T import qualified Data.Text.Encoding as TE import Control.Applicative import Control.Monad import Crypto.Hash.Algorithms 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 Prelude hiding (exp) -- $setup -- The code examples in this module require GHC's `OverloadedStrings` -- extension: -- -- >>> :set -XOverloadedStrings 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 _ = "" newtype Signature = Signature T.Text deriving (Show) instance Eq Signature where (Signature s1) == (Signature s2) = s1 `T.constTimeCompare` s2 -- | JSON Web Token without signature verification data UnverifiedJWT -- | JSON Web Token that has been successfully verified data VerifiedJWT -- | The JSON Web Token data JWT r where Unverified :: JWTHeader -> JWTClaimsSet -> Signature -> T.Text -> JWT UnverifiedJWT Verified :: JWTHeader -> JWTClaimsSet -> Signature -> JWT VerifiedJWT deriving instance Show (JWT r) -- | Extract the claims set from a JSON Web Token claims :: JWT r -> JWTClaimsSet claims (Unverified _ c _ _) = c claims (Verified _ c _) = c -- | Extract the header from a JSON Web Token header :: JWT r -> JOSEHeader header (Unverified h _ _ _) = h header (Verified h _ _) = h -- | Extract the signature from a verified JSON Web Token signature :: JWT r -> Maybe Signature signature Unverified{} = Nothing signature (Verified _ _ s) = Just s -- | A JSON numeric value representing the number of seconds from -- 1970-01-01T0:0:0Z UTC until the specified UTC date/time. {-# DEPRECATED IntDate "Use NumericDate instead. IntDate will be removed in 1.0" #-} type IntDate = NumericDate -- | A JSON numeric value representing the number of seconds from -- 1970-01-01T0:0:0Z UTC until the specified UTC date/time. newtype NumericDate = NumericDate Integer deriving (Show, Eq, Ord) -- | Return the seconds since 1970-01-01T0:0:0Z UTC for the given 'IntDate' secondsSinceEpoch :: NumericDate -> NominalDiffTime secondsSinceEpoch (NumericDate s) = fromInteger s -- | A JSON string value, with the additional requirement that while -- arbitrary string values MAY be used, any value containing a ":" -- character MUST be a URI [RFC3986]. StringOrURI values are -- compared as case-sensitive strings with no transformations or -- canonicalizations applied. data StringOrURI = S T.Text | U URI.URI deriving (Eq) instance Show StringOrURI where show (S s) = T.unpack s show (U u) = show u data Algorithm = HS256 -- ^ HMAC using SHA-256 hash algorithm deriving (Eq, Show) -- | JOSE Header, describes the cryptographic operations applied to the JWT data JOSEHeader = JOSEHeader { -- | The typ (type) Header Parameter defined by [JWS] and [JWE] is used to -- declare the MIME Media Type [IANA.MediaTypes] of this complete JWT in -- contexts where this is useful to the application. -- This parameter has no effect upon the JWT processing. typ :: Maybe T.Text -- | 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. -- -- See , alg :: Maybe Algorithm } deriving (Eq, Show) instance Default JOSEHeader where def = JOSEHeader Nothing Nothing Nothing -- | The JWT Claims Set represents a JSON object whose members are the claims conveyed by the JWT. data JWTClaimsSet = JWTClaimsSet { -- Registered Claim Names -- http://self-issued.info/docs/draft-ietf-oauth-json-web-token.html#ClaimsContents -- | The iss (issuer) claim identifies the principal that issued the JWT. iss :: Maybe StringOrURI -- | The sub (subject) claim identifies the principal that is the subject of the JWT. , sub :: Maybe StringOrURI -- | The aud (audience) claim identifies the audiences that the JWT is intended for according to draft 18 of the JWT spec, the aud claim is option and may be present in singular or as a list. , aud :: Maybe (Either StringOrURI [StringOrURI]) -- | The exp (expiration time) claim identifies the expiration time on or after which the JWT MUST NOT be accepted for processing. Its value MUST be a number containing an IntDate value. , exp :: Maybe IntDate -- | The nbf (not before) claim identifies the time before which the JWT MUST NOT be accepted for processing. , nbf :: Maybe IntDate -- | The iat (issued at) claim identifies the time at which the JWT was issued. , iat :: Maybe IntDate -- | The jti (JWT ID) claim provides a unique identifier for the JWT. , jti :: Maybe StringOrURI , unregisteredClaims :: ClaimsMap } deriving (Show, Eq) instance Default JWTClaimsSet where def = JWTClaimsSet Nothing Nothing Nothing Nothing Nothing Nothing Nothing Map.empty -- | Encode a claims set using the given secret -- -- @ -- let -- cs = def { -- def 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 -- @ -- > "eyJ0eXAiOiJKV1QiLCJhbGciOiJIUzI1NiJ9.eyJodHRwOi8vZXhhbXBsZS5jb20vaXNfcm9vdCI6dHJ1ZSwiaXNzIjoiRm9vIn0.vHQHuG3ujbnBUmEp-fSUtYxk27rLiP2hrNhxpyWhb2E" encodeSigned :: Algorithm -> Secret -> JWTClaimsSet -> JSON encodeSigned algo secret claims = dotted [header, claim, signature] where claim = encodeJWT claims header = encodeJWT def { typ = Just "JWT" , alg = Just algo } signature = calculateDigest algo secret (dotted [header, claim]) -- | Encode a claims set without signing it -- -- @ -- let -- cs = def { -- def returns a default JWTClaimsSet -- iss = stringOrURI "Foo" -- , iat = numericDate 1394700934 -- , unregisteredClaims = Map.fromList [("http://example.com/is_root", (Bool True))] -- } -- in encodeUnsigned cs -- @ -- > "eyJ0eXAiOiJKV1QiLCJhbGciOiJIUzI1NiJ9.eyJpYXQiOjEzOTQ3MDA5MzQsImh0dHA6Ly9leGFtcGxlLmNvbS9pc19yb290Ijp0cnVlLCJpc3MiOiJGb28ifQ." encodeUnsigned :: JWTClaimsSet -> JSON encodeUnsigned claims = dotted [header, claim, ""] where claim = encodeJWT claims header = encodeJWT def { typ = Just "JWT" , alg = Just HS256 } -- | Decode a claims set without verifying the signature. This is useful if -- information from the claim set is required in order to verify the claim -- (e.g. the secret needs to be retrieved based on unverified information -- from the claims set). -- -- >>> :{ -- let -- input = "eyJ0eXAiOiJKV1QiLCJhbGciOiJIUzI1NiJ9.eyJzb21lIjoicGF5bG9hZCJ9.Joh1R2dYzkRvDkqv3sygm5YyK8Gi4ShZqbhK2gxcs2U" :: T.Text -- mJwt = decode input -- in fmap header mJwt -- :} -- Just (JOSEHeader {typ = Just "JWT", cty = Nothing, alg = Just HS256}) -- -- and -- -- >>> :{ -- let -- input = "eyJ0eXAiOiJKV1QiLCJhbGciOiJIUzI1NiJ9.eyJzb21lIjoicGF5bG9hZCJ9.Joh1R2dYzkRvDkqv3sygm5YyK8Gi4ShZqbhK2gxcs2U" :: T.Text -- 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")]}) decode :: JSON -> Maybe (JWT UnverifiedJWT) decode input = do (h,c,s) <- extractElems $ T.splitOn "." input let header' = parseJWT h claims' = parseJWT c Unverified <$> header' <*> claims' <*> (pure . Signature $ s) <*> (pure . dotted $ [h,c]) where extractElems (h:c:s:_) = Just (h,c,s) extractElems _ = Nothing -- | Using a known secret and a decoded claims set verify that the signature is correct -- and return a verified JWT token as a result. -- -- This will return a VerifiedJWT if and only if the signature can be verified using the -- given secret. -- -- The separation between decode and verify is very useful if you are communicating with -- multiple different services with different secrets and it allows you to lookup the -- correct secret for the unverified JWT before trying to verify it. If this is not an -- isuse for you (there will only ever be one secret) then you should just use -- 'decodeAndVerifySignature'. -- -- >>> :{ -- let -- input = "eyJ0eXAiOiJKV1QiLCJhbGciOiJIUzI1NiJ9.eyJzb21lIjoicGF5bG9hZCJ9.Joh1R2dYzkRvDkqv3sygm5YyK8Gi4ShZqbhK2gxcs2U" :: T.Text -- mUnverifiedJwt = decode input -- mVerifiedJwt = verify (secret "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 guard (unverifiedSignature == calculatedSignature) pure $ Verified header' claims' calculatedSignature -- | Decode a claims set and verify that the signature matches by using the supplied secret. -- The algorithm is based on the supplied header value. -- -- This will return a VerifiedJWT if and only if the signature can be verified -- using the given secret. -- -- >>> :{ -- let -- input = "eyJ0eXAiOiJKV1QiLCJhbGciOiJIUzI1NiJ9.eyJzb21lIjoicGF5bG9hZCJ9.Joh1R2dYzkRvDkqv3sygm5YyK8Gi4ShZqbhK2gxcs2U" :: T.Text -- mJwt = decodeAndVerifySignature (secret "secret") input -- in signature =<< mJwt -- :} -- Just (Signature "Joh1R2dYzkRvDkqv3sygm5YyK8Gi4ShZqbhK2gxcs2U") decodeAndVerifySignature :: Secret -> JSON -> Maybe (JWT VerifiedJWT) decodeAndVerifySignature secret' input = verify secret' =<< decode input -- | Try to extract the value for the issue claim field 'iss' from the web token in JSON form tokenIssuer :: JSON -> Maybe StringOrURI 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 -- | Create a Secret using the given key. binarySecret :: BS.ByteString -> Secret binarySecret = Secret -- | Convert the `NominalDiffTime` into an IntDate. Returns a Nothing if the -- argument is invalid (e.g. the NominalDiffTime must be convertible into a -- positive Integer representing the seconds since epoch). {-# DEPRECATED intDate "Use numericDate instead. intDate will be removed in 1.0" #-} intDate :: NominalDiffTime -> Maybe IntDate intDate = numericDate -- | Convert the `NominalDiffTime` into an NumericDate. Returns a Nothing if the -- argument is invalid (e.g. the NominalDiffTime must be convertible into a -- positive Integer representing the seconds since epoch). numericDate :: NominalDiffTime -> Maybe NumericDate numericDate i | i < 0 = Nothing numericDate i = Just $ NumericDate $ round i -- | 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 | 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) -- | Convert the `aud` claim in a `JWTClaimsSet` into a `[StringOrURI]` auds :: JWTClaimsSet -> [StringOrURI] auds jwt = case aud jwt of Nothing -> [] Just (Left a) -> [a] Just (Right as) -> as -- ================================================================================= encodeJWT :: ToJSON a => a -> T.Text encodeJWT = TE.decodeUtf8 . convertToBase Base64URLUnpadded . BL.toStrict . JSON.encode parseJWT :: FromJSON a => T.Text -> Maybe a parseJWT x = case convertFromBase Base64URLUnpadded $ TE.encodeUtf8 x of Left _ -> Nothing Right s -> JSON.decode $ BL.fromStrict s dotted :: [T.Text] -> T.Text 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 -- ================================================================================= type ClaimsMap = Map.Map T.Text Value fromHashMap :: Object -> ClaimsMap fromHashMap = Map.fromList . StrictMap.toList removeRegisteredClaims :: ClaimsMap -> ClaimsMap removeRegisteredClaims input = Map.differenceWithKey (\_ _ _ -> Nothing) input registeredClaims where registeredClaims = Map.fromList $ map (\e -> (e, Null)) ["iss", "sub", "aud", "exp", "nbf", "iat", "jti"] instance ToJSON JWTClaimsSet where toJSON JWTClaimsSet{..} = object $ catMaybes [ fmap ("iss" .=) iss , fmap ("sub" .=) sub , either ("aud" .=) ("aud" .=) <$> aud , fmap ("exp" .=) exp , fmap ("nbf" .=) nbf , fmap ("iat" .=) iat , fmap ("jti" .=) jti ] ++ Map.toList (removeRegisteredClaims unregisteredClaims) instance FromJSON JWTClaimsSet where parseJSON = withObject "JWTClaimsSet" (\o -> JWTClaimsSet <$> o .:? "iss" <*> o .:? "sub" <*> case StrictMap.lookup "aud" o of (Just as@(JSON.Array _)) -> Just <$> Right <$> parseJSON as (Just (JSON.String t)) -> pure $ Left <$> stringOrURI t _ -> pure Nothing <*> o .:? "exp" <*> o .:? "nbf" <*> o .:? "iat" <*> o .:? "jti" <*> pure (removeRegisteredClaims $ fromHashMap o)) instance FromJSON JOSEHeader where parseJSON = withObject "JOSEHeader" (\o -> JOSEHeader <$> o .:? "typ" <*> o .:? "cty" <*> o .:? "alg") instance ToJSON JOSEHeader where toJSON JOSEHeader{..} = object $ catMaybes [ fmap ("typ" .=) typ , fmap ("cty" .=) cty , fmap ("alg" .=) alg ] instance ToJSON NumericDate where toJSON (NumericDate i) = Number $ scientific (fromIntegral i) 0 instance FromJSON NumericDate where parseJSON (Number x) = return $ NumericDate $ coefficient x parseJSON _ = mzero instance ToJSON Algorithm where toJSON HS256 = String ("HS256"::T.Text) instance FromJSON Algorithm where parseJSON (String "HS256") = return HS256 parseJSON _ = mzero instance ToJSON StringOrURI where toJSON (S s) = String s toJSON (U uri) = String $ T.pack $ URI.uriToString id uri "" instance FromJSON StringOrURI where parseJSON (String s) | URI.isURI $ T.unpack s = return $ U $ fromMaybe URI.nullURI $ URI.parseURI $ T.unpack s parseJSON (String s) = return $ S s parseJSON _ = mzero -- $docDecoding -- There are three use cases supported by the set of decoding/verification -- functions: -- -- (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. -- -- (2) Signed JWTs you want to verify using a known secret. -- This is what 'decodeAndVerifySignature' supports, given a secret -- and JSON it will return a 'JWT' 'VerifiedJWT' if the signature can be -- verified. -- -- (3) Signed JWTs that need to be verified using a secret that depends on -- information contained in the JWT. E.g. the secret depends on -- some claim, therefore the JWT needs to be decoded first and after -- retrieving the appropriate secret value, verified in a subsequent step. -- This is supported by using the `verify` function which given -- a 'JWT' 'UnverifiedJWT' and a secret will return a 'JWT' 'VerifiedJWT' iff the -- signature can be verified. jwt-0.7.2/src/Data/Text/Extended.hs0000644000000000000000000000100612702673714015200 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} module Data.Text.Extended ( module Data.Text , constTimeCompare ) where import Data.Bits import Data.Char import Data.Function (on) import qualified Data.List as L import Data.Text import Prelude hiding (length, zip) constTimeCompare :: Text -> Text -> Bool constTimeCompare l r = length l == length r && comp' l r where comp' a b = 0 == L.foldl' (.|.) 0 (uncurry (on xor ord) <$> zip a b) jwt-0.7.2/src/Data/ByteString/Extended.hs0000644000000000000000000000066312722235237016352 0ustar0000000000000000module Data.ByteString.Extended ( module Data.ByteString , constTimeCompare ) where import Data.Bits import Data.ByteString import qualified Data.List as L import Prelude hiding (length, zip, zipWith) constTimeCompare :: ByteString -> ByteString -> Bool constTimeCompare l r = length l == length r && comp' l r where comp' a b = 0 == L.foldl' (.|.) 0 (uncurry xor <$> zip a b) jwt-0.7.2/doctests.hs0000644000000000000000000000007112722235237012701 0ustar0000000000000000import Test.DocTest main = doctest ["-isrc", "src/Web"] jwt-0.7.2/tests/src/TestRunner.hs0000644000000000000000000000117712722235237015123 0ustar0000000000000000module Main where import qualified Web.JWTTests import qualified Web.JWTTestsCompat import qualified Web.JWTInteropTests import qualified Data.ByteString.ExtendedTests import qualified Data.Text.ExtendedTests import Test.Tasty main :: IO () main = defaultMain tests tests :: TestTree tests = testGroup "JWT Tests" [ Web.JWTTests.defaultTestGroup , Web.JWTTestsCompat.defaultTestGroup , Web.JWTInteropTests.defaultTestGroup , Data.Text.ExtendedTests.defaultTestGroup , Data.ByteString.ExtendedTests.defaultTestGroup ] jwt-0.7.2/src/Web/JWT.hs0000644000000000000000000004634012723537471013040 0ustar0000000000000000{-# LANGUAGE EmptyDataDecls #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE StandaloneDeriving #-} {-| Module: Web.JWT License: MIT Maintainer: Stefan Saasen Stability: experimental This implementation of JWT is based on but currently only implements the minimum required to work with the Atlassian Connect framework. Known limitations: * Only HMAC SHA-256 algorithm is currently a supported signature algorithm * There is currently no verification of time related information ('exp', 'nbf', 'iat'). * Registered claims are not validated -} module Web.JWT ( -- * Encoding & Decoding JWTs -- ** Decoding -- $docDecoding decode , verify , decodeAndVerifySignature -- ** Encoding , encodeSigned , encodeUnsigned -- * Utility functions -- ** Common , tokenIssuer , secret , binarySecret -- ** JWT structure , claims , header , signature -- ** JWT claims set , auds , intDate , numericDate , stringOrURI , stringOrURIToText , secondsSinceEpoch -- ** JWT header , typ , cty , alg -- * Types , UnverifiedJWT , VerifiedJWT , Signature , Secret , JWT , JSON , Algorithm(..) , JWTClaimsSet(..) , ClaimsMap , IntDate , NumericDate , StringOrURI , JWTHeader , JOSEHeader , module Data.Default ) where import qualified Data.ByteString.Lazy.Char8 as BL (fromStrict, toStrict) import qualified Data.ByteString.Extended as BS import qualified Data.Text.Extended as T import qualified Data.Text.Encoding as TE import Control.Applicative import Control.Monad import Crypto.Hash.Algorithms 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 Prelude hiding (exp) -- $setup -- The code examples in this module require GHC's `OverloadedStrings` -- extension: -- -- >>> :set -XOverloadedStrings 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 _ = "" newtype Signature = Signature T.Text deriving (Show) instance Eq Signature where (Signature s1) == (Signature s2) = s1 `T.constTimeCompare` s2 -- | JSON Web Token without signature verification data UnverifiedJWT -- | JSON Web Token that has been successfully verified data VerifiedJWT -- | The JSON Web Token data JWT r where Unverified :: JWTHeader -> JWTClaimsSet -> Signature -> T.Text -> JWT UnverifiedJWT Verified :: JWTHeader -> JWTClaimsSet -> Signature -> JWT VerifiedJWT deriving instance Show (JWT r) -- | Extract the claims set from a JSON Web Token claims :: JWT r -> JWTClaimsSet claims (Unverified _ c _ _) = c claims (Verified _ c _) = c -- | Extract the header from a JSON Web Token header :: JWT r -> JOSEHeader header (Unverified h _ _ _) = h header (Verified h _ _) = h -- | Extract the signature from a verified JSON Web Token signature :: JWT r -> Maybe Signature signature Unverified{} = Nothing signature (Verified _ _ s) = Just s -- | A JSON numeric value representing the number of seconds from -- 1970-01-01T0:0:0Z UTC until the specified UTC date/time. {-# DEPRECATED IntDate "Use NumericDate instead. IntDate will be removed in 1.0" #-} type IntDate = NumericDate -- | A JSON numeric value representing the number of seconds from -- 1970-01-01T0:0:0Z UTC until the specified UTC date/time. newtype NumericDate = NumericDate Integer deriving (Show, Eq, Ord) -- | Return the seconds since 1970-01-01T0:0:0Z UTC for the given 'IntDate' secondsSinceEpoch :: NumericDate -> NominalDiffTime secondsSinceEpoch (NumericDate s) = fromInteger s -- | A JSON string value, with the additional requirement that while -- arbitrary string values MAY be used, any value containing a ":" -- character MUST be a URI [RFC3986]. StringOrURI values are -- compared as case-sensitive strings with no transformations or -- canonicalizations applied. data StringOrURI = S T.Text | U URI.URI deriving (Eq) instance Show StringOrURI where show (S s) = T.unpack s show (U u) = show u data Algorithm = HS256 -- ^ HMAC using SHA-256 hash algorithm deriving (Eq, Show) -- | JOSE Header, describes the cryptographic operations applied to the JWT data JOSEHeader = JOSEHeader { -- | The typ (type) Header Parameter defined by [JWS] and [JWE] is used to -- declare the MIME Media Type [IANA.MediaTypes] of this complete JWT in -- contexts where this is useful to the application. -- This parameter has no effect upon the JWT processing. typ :: Maybe T.Text -- | 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. -- -- See , alg :: Maybe Algorithm } deriving (Eq, Show) instance Default JOSEHeader where def = JOSEHeader Nothing Nothing Nothing -- | The JWT Claims Set represents a JSON object whose members are the claims conveyed by the JWT. data JWTClaimsSet = JWTClaimsSet { -- Registered Claim Names -- http://self-issued.info/docs/draft-ietf-oauth-json-web-token.html#ClaimsContents -- | The iss (issuer) claim identifies the principal that issued the JWT. iss :: Maybe StringOrURI -- | The sub (subject) claim identifies the principal that is the subject of the JWT. , sub :: Maybe StringOrURI -- | The aud (audience) claim identifies the audiences that the JWT is intended for according to draft 18 of the JWT spec, the aud claim is option and may be present in singular or as a list. , aud :: Maybe (Either StringOrURI [StringOrURI]) -- | The exp (expiration time) claim identifies the expiration time on or after which the JWT MUST NOT be accepted for processing. Its value MUST be a number containing an IntDate value. , exp :: Maybe IntDate -- | The nbf (not before) claim identifies the time before which the JWT MUST NOT be accepted for processing. , nbf :: Maybe IntDate -- | The iat (issued at) claim identifies the time at which the JWT was issued. , iat :: Maybe IntDate -- | The jti (JWT ID) claim provides a unique identifier for the JWT. , jti :: Maybe StringOrURI , unregisteredClaims :: ClaimsMap } deriving (Show, Eq) instance Default JWTClaimsSet where def = JWTClaimsSet Nothing Nothing Nothing Nothing Nothing Nothing Nothing Map.empty -- | Encode a claims set using the given secret -- -- @ -- let -- cs = def { -- def 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 -- @ -- > "eyJ0eXAiOiJKV1QiLCJhbGciOiJIUzI1NiJ9.eyJodHRwOi8vZXhhbXBsZS5jb20vaXNfcm9vdCI6dHJ1ZSwiaXNzIjoiRm9vIn0.vHQHuG3ujbnBUmEp-fSUtYxk27rLiP2hrNhxpyWhb2E" encodeSigned :: Algorithm -> Secret -> JWTClaimsSet -> JSON encodeSigned algo secret claims = dotted [header, claim, signature] where claim = encodeJWT claims header = encodeJWT def { typ = Just "JWT" , alg = Just algo } signature = calculateDigest algo secret (dotted [header, claim]) -- | Encode a claims set without signing it -- -- @ -- let -- cs = def { -- def returns a default JWTClaimsSet -- iss = stringOrURI "Foo" -- , iat = numericDate 1394700934 -- , unregisteredClaims = Map.fromList [("http://example.com/is_root", (Bool True))] -- } -- in encodeUnsigned cs -- @ -- > "eyJ0eXAiOiJKV1QiLCJhbGciOiJIUzI1NiJ9.eyJpYXQiOjEzOTQ3MDA5MzQsImh0dHA6Ly9leGFtcGxlLmNvbS9pc19yb290Ijp0cnVlLCJpc3MiOiJGb28ifQ." encodeUnsigned :: JWTClaimsSet -> JSON encodeUnsigned claims = dotted [header, claim, ""] where claim = encodeJWT claims header = encodeJWT def { typ = Just "JWT" , alg = Just HS256 } -- | Decode a claims set without verifying the signature. This is useful if -- information from the claim set is required in order to verify the claim -- (e.g. the secret needs to be retrieved based on unverified information -- from the claims set). -- -- >>> :{ -- let -- input = "eyJ0eXAiOiJKV1QiLCJhbGciOiJIUzI1NiJ9.eyJzb21lIjoicGF5bG9hZCJ9.Joh1R2dYzkRvDkqv3sygm5YyK8Gi4ShZqbhK2gxcs2U" :: T.Text -- mJwt = decode input -- in fmap header mJwt -- :} -- Just (JOSEHeader {typ = Just "JWT", cty = Nothing, alg = Just HS256}) -- -- and -- -- >>> :{ -- let -- input = "eyJ0eXAiOiJKV1QiLCJhbGciOiJIUzI1NiJ9.eyJzb21lIjoicGF5bG9hZCJ9.Joh1R2dYzkRvDkqv3sygm5YyK8Gi4ShZqbhK2gxcs2U" :: T.Text -- 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")]}) decode :: JSON -> Maybe (JWT UnverifiedJWT) decode input = do (h,c,s) <- extractElems $ T.splitOn "." input let header' = parseJWT h claims' = parseJWT c Unverified <$> header' <*> claims' <*> (pure . Signature $ s) <*> (pure . dotted $ [h,c]) where extractElems (h:c:s:_) = Just (h,c,s) extractElems _ = Nothing -- | Using a known secret and a decoded claims set verify that the signature is correct -- and return a verified JWT token as a result. -- -- This will return a VerifiedJWT if and only if the signature can be verified using the -- given secret. -- -- The separation between decode and verify is very useful if you are communicating with -- multiple different services with different secrets and it allows you to lookup the -- correct secret for the unverified JWT before trying to verify it. If this is not an -- isuse for you (there will only ever be one secret) then you should just use -- 'decodeAndVerifySignature'. -- -- >>> :{ -- let -- input = "eyJ0eXAiOiJKV1QiLCJhbGciOiJIUzI1NiJ9.eyJzb21lIjoicGF5bG9hZCJ9.Joh1R2dYzkRvDkqv3sygm5YyK8Gi4ShZqbhK2gxcs2U" :: T.Text -- mUnverifiedJwt = decode input -- mVerifiedJwt = verify (secret "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 guard (unverifiedSignature == calculatedSignature) pure $ Verified header' claims' calculatedSignature -- | Decode a claims set and verify that the signature matches by using the supplied secret. -- The algorithm is based on the supplied header value. -- -- This will return a VerifiedJWT if and only if the signature can be verified -- using the given secret. -- -- >>> :{ -- let -- input = "eyJ0eXAiOiJKV1QiLCJhbGciOiJIUzI1NiJ9.eyJzb21lIjoicGF5bG9hZCJ9.Joh1R2dYzkRvDkqv3sygm5YyK8Gi4ShZqbhK2gxcs2U" :: T.Text -- mJwt = decodeAndVerifySignature (secret "secret") input -- in signature =<< mJwt -- :} -- Just (Signature "Joh1R2dYzkRvDkqv3sygm5YyK8Gi4ShZqbhK2gxcs2U") decodeAndVerifySignature :: Secret -> JSON -> Maybe (JWT VerifiedJWT) decodeAndVerifySignature secret' input = verify secret' =<< decode input -- | Try to extract the value for the issue claim field 'iss' from the web token in JSON form tokenIssuer :: JSON -> Maybe StringOrURI 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 -- | Create a Secret using the given key. binarySecret :: BS.ByteString -> Secret binarySecret = Secret -- | Convert the `NominalDiffTime` into an IntDate. Returns a Nothing if the -- argument is invalid (e.g. the NominalDiffTime must be convertible into a -- positive Integer representing the seconds since epoch). {-# DEPRECATED intDate "Use numericDate instead. intDate will be removed in 1.0" #-} intDate :: NominalDiffTime -> Maybe IntDate intDate = numericDate -- | Convert the `NominalDiffTime` into an NumericDate. Returns a Nothing if the -- argument is invalid (e.g. the NominalDiffTime must be convertible into a -- positive Integer representing the seconds since epoch). numericDate :: NominalDiffTime -> Maybe NumericDate numericDate i | i < 0 = Nothing numericDate i = Just $ NumericDate $ round i -- | 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 | 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) -- | Convert the `aud` claim in a `JWTClaimsSet` into a `[StringOrURI]` auds :: JWTClaimsSet -> [StringOrURI] auds jwt = case aud jwt of Nothing -> [] Just (Left a) -> [a] Just (Right as) -> as -- ================================================================================= encodeJWT :: ToJSON a => a -> T.Text encodeJWT = TE.decodeUtf8 . convertToBase Base64URLUnpadded . BL.toStrict . JSON.encode parseJWT :: FromJSON a => T.Text -> Maybe a parseJWT x = case convertFromBase Base64URLUnpadded $ TE.encodeUtf8 x of Left _ -> Nothing Right s -> JSON.decode $ BL.fromStrict s dotted :: [T.Text] -> T.Text 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 -- ================================================================================= type ClaimsMap = Map.Map T.Text Value fromHashMap :: Object -> ClaimsMap fromHashMap = Map.fromList . StrictMap.toList removeRegisteredClaims :: ClaimsMap -> ClaimsMap removeRegisteredClaims input = Map.differenceWithKey (\_ _ _ -> Nothing) input registeredClaims where registeredClaims = Map.fromList $ map (\e -> (e, Null)) ["iss", "sub", "aud", "exp", "nbf", "iat", "jti"] instance ToJSON JWTClaimsSet where toJSON JWTClaimsSet{..} = object $ catMaybes [ fmap ("iss" .=) iss , fmap ("sub" .=) sub , either ("aud" .=) ("aud" .=) <$> aud , fmap ("exp" .=) exp , fmap ("nbf" .=) nbf , fmap ("iat" .=) iat , fmap ("jti" .=) jti ] ++ Map.toList (removeRegisteredClaims unregisteredClaims) instance FromJSON JWTClaimsSet where parseJSON = withObject "JWTClaimsSet" (\o -> JWTClaimsSet <$> o .:? "iss" <*> o .:? "sub" <*> case StrictMap.lookup "aud" o of (Just as@(JSON.Array _)) -> Just <$> Right <$> parseJSON as (Just (JSON.String t)) -> pure $ Left <$> stringOrURI t _ -> pure Nothing <*> o .:? "exp" <*> o .:? "nbf" <*> o .:? "iat" <*> o .:? "jti" <*> pure (removeRegisteredClaims $ fromHashMap o)) instance FromJSON JOSEHeader where parseJSON = withObject "JOSEHeader" (\o -> JOSEHeader <$> o .:? "typ" <*> o .:? "cty" <*> o .:? "alg") instance ToJSON JOSEHeader where toJSON JOSEHeader{..} = object $ catMaybes [ fmap ("typ" .=) typ , fmap ("cty" .=) cty , fmap ("alg" .=) alg ] instance ToJSON NumericDate where toJSON (NumericDate i) = Number $ scientific (fromIntegral i) 0 instance FromJSON NumericDate where parseJSON (Number x) = return $ NumericDate $ coefficient x parseJSON _ = mzero instance ToJSON Algorithm where toJSON HS256 = String ("HS256"::T.Text) instance FromJSON Algorithm where parseJSON (String "HS256") = return HS256 parseJSON _ = mzero instance ToJSON StringOrURI where toJSON (S s) = String s toJSON (U uri) = String $ T.pack $ URI.uriToString id uri "" instance FromJSON StringOrURI where parseJSON (String s) | URI.isURI $ T.unpack s = return $ U $ fromMaybe URI.nullURI $ URI.parseURI $ T.unpack s parseJSON (String s) = return $ S s parseJSON _ = mzero -- $docDecoding -- There are three use cases supported by the set of decoding/verification -- functions: -- -- (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. -- -- (2) Signed JWTs you want to verify using a known secret. -- This is what 'decodeAndVerifySignature' supports, given a secret -- and JSON it will return a 'JWT' 'VerifiedJWT' if the signature can be -- verified. -- -- (3) Signed JWTs that need to be verified using a secret that depends on -- information contained in the JWT. E.g. the secret depends on -- some claim, therefore the JWT needs to be decoded first and after -- retrieving the appropriate secret value, verified in a subsequent step. -- This is supported by using the `verify` function which given -- a 'JWT' 'UnverifiedJWT' and a secret will return a 'JWT' 'VerifiedJWT' iff the -- signature can be verified. jwt-0.7.2/tests/src/Web/JWTInteropTests.hs0000644000000000000000000000727412722235237016563 0ustar0000000000000000{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE OverlappingInstances #-} {-# 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 test 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 instance Arbitrary ClaimsMap where arbitrary = return Map.empty instance Arbitrary NumericDate where arbitrary = fmap (f . numericDate) (arbitrary :: QC.Gen NominalDiffTime) where f = fromMaybe (fromJust $ numericDate 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) jwt-0.7.2/tests/src/Web/JWTTests.hs0000644000000000000000000002237212723537471015224 0ustar0000000000000000{-# LANGUAGE BangPatterns, OverloadedStrings, ScopedTypeVariables, TemplateHaskell #-} {-# LANGUAGE TypeSynonymInstances, FlexibleInstances, OverlappingInstances #-} 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.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.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_numericDateDeriveOrd = do let i1 = numericDate 1231231231 -- Tue 6 Jan 2009 19:40:31 AEDT i2 = numericDate 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) -- It must be impossible to get a VerifiedJWT if alg is "none" case_decodeAndVerifyJWTAlgoNone = do {- - Header: { "alg": "none", "typ": "JWT" } Payload: { "iss": "https://jwt-idp.example.com", "sub": "mailto:mike@example.com", "nbf": 1425980755, "exp": 1425984355, "iat": 1425980755, "jti": "id123456", "typ": "https://example.com/register" } -} let input = "eyJhbGciOiJub25lIiwidHlwIjoiSldUIn0.eyJpc3MiOiJodHRwczovL2p3dC1pZHAuZXhhbXBsZS5jb20iLCJzdWIiOiJtYWlsdG86bWlrZUBleGFtcGxlLmNvbSIsIm5iZiI6MTQyNTk4MDc1NSwiZXhwIjoxNDI1OTg0MzU1LCJpYXQiOjE0MjU5ODA3NTUsImp0aSI6ImlkMTIzNDU2IiwidHlwIjoiaHR0cHM6Ly9leGFtcGxlLmNvbS9yZWdpc3RlciJ9." mJwt = decodeAndVerifySignature (secret "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 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 = numericDate 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 = numericDate 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 = numericDate 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 = numericDate now } let secret' = secret "secret" jwt = decodeAndVerifySignature secret' $ encodeSigned HS256 secret' cs Just cs @=? fmap claims jwt case_encodeDecodeJWTClaimsSetBinarySecret = do let now = 1234 cs = def { iss = stringOrURI "Foo" , iat = numericDate now } secretKey <- BS.readFile "tests/jwt.secret.1" let secret' = binarySecret secretKey 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 = f where f :: T.Text -> JWTClaimsSet -> Bool f key claims' = let Just unverified = (decode $ encodeSigned HS256 (secret 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') 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') in claims verified == claims' instance Arbitrary JWTClaimsSet where arbitrary = JWTClaimsSet <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary instance Arbitrary ClaimsMap where arbitrary = return Map.empty instance Arbitrary NumericDate where arbitrary = fmap (f . numericDate) (arbitrary :: QC.Gen NominalDiffTime) where f = fromMaybe (fromJust $ numericDate 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 BS.ByteString where arbitrary = BS.pack <$> arbitrary shrink xs = BS.pack <$> shrink (BS.unpack xs) instance Arbitrary T.Text where arbitrary = fromString <$> (arbitrary :: QC.Gen String) instance Arbitrary TL.Text where arbitrary = fromString <$> (arbitrary :: QC.Gen String) jwt-0.7.2/tests/src/Web/JWTTestsCompat.hs0000644000000000000000000000320112723537471016356 0ustar0000000000000000{-# LANGUAGE BangPatterns, OverloadedStrings, ScopedTypeVariables, TemplateHaskell #-} {-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-} {- - Turn of deprecation warnings as these tests deliberately use - deprecated types/functions to ensure that the library is backward compatible -} {-# OPTIONS_GHC -fno-warn-warnings-deprecations #-} module Web.JWTTestsCompat ( 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_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_encodeDecodeJWTIntDateIat = 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') jwt-0.7.2/src/Data/Text/Extended.hs0000644000000000000000000000100612702673714015200 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} module Data.Text.Extended ( module Data.Text , constTimeCompare ) where import Data.Bits import Data.Char import Data.Function (on) import qualified Data.List as L import Data.Text import Prelude hiding (length, zip) constTimeCompare :: Text -> Text -> Bool constTimeCompare l r = length l == length r && comp' l r where comp' a b = 0 == L.foldl' (.|.) 0 (uncurry (on xor ord) <$> zip a b) jwt-0.7.2/tests/src/Data/Text/ExtendedTests.hs0000644000000000000000000000143312510212027017350 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TemplateHaskell #-} 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 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 `T.constTimeCompare` b) instance Arbitrary T.Text where arbitrary = fromString <$> (arbitrary :: QC.Gen String) jwt-0.7.2/tests/src/Data/ByteString/ExtendedTests.hs0000644000000000000000000000153512722235237020536 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TemplateHaskell #-} 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 import Test.Tasty.TH defaultTestGroup :: TestTree defaultTestGroup = $(testGroupGenerator) main :: IO () main = defaultMain defaultTestGroup prop_constTimeCompare :: BS.ByteString -> BS.ByteString -> Bool prop_constTimeCompare a b = (a == b) == (a `BS.constTimeCompare` b) instance Arbitrary BS.ByteString where arbitrary = BS.pack <$> arbitrary shrink xs = BS.pack <$> shrink (BS.unpack xs) jwt-0.7.2/LICENSE0000644000000000000000000000207012304600470011512 0ustar0000000000000000The MIT License (MIT) Copyright (c) 2014 Stefan Saasen Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. jwt-0.7.2/Setup.hs0000644000000000000000000000005612304600470012143 0ustar0000000000000000import Distribution.Simple main = defaultMain jwt-0.7.2/jwt.cabal0000644000000000000000000000756212724003734012316 0ustar0000000000000000-- Initial atlassian-jwt.cabal generated by cabal init. For further -- documentation, see http://haskell.org/cabal/users-guide/ name: jwt version: 0.7.2 synopsis: JSON Web Token (JWT) decoding and encoding license: MIT license-file: LICENSE author: Stefan Saasen maintainer: stefan@saasen.me homepage: https://bitbucket.org/ssaasen/haskell-jwt bug-reports: https://bitbucket.org/ssaasen/haskell-jwt/issues category: Web build-type: Simple cabal-version: >=1.16 description: JSON Web Token (JWT) is a compact URL-safe means of representing claims to be transferred between two parties. . To get started, see the documentation for the "Web.JWT" module. extra-source-files: CHANGELOG.md README.md tests/jwt.secret.1 source-repository head type: git location: https://ssaasen@bitbucket.org/ssaasen/haskell-jwt.git library exposed-modules: Web.JWT other-modules: Data.Text.Extended, Data.ByteString.Extended build-depends: base >= 4.6 && < 5 , cryptonite >= 0.6 , memory >= 0.8 , bytestring >= 0.10 , text >= 0.11 , aeson >= 0.7 , 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 hs-source-dirs: src default-language: Haskell2010 ghc-options: -Wall --Werror -fno-warn-unused-do-bind -fno-warn-orphans -fno-warn-name-shadowing test-suite testsuite 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.JWT , Web.JWTInteropTests , Web.JWTTests , Web.JWTTestsCompat , Data.Text.Extended , Data.Text.ExtendedTests , Data.ByteString.ExtendedTests hs-source-dirs: tests/src, src build-depends: base < 5 && >= 4.4 , tasty >= 0.7 , tasty-th >= 0.1 , tasty-hunit >= 0.4 , tasty-quickcheck >= 0.3 , lens-aeson , lens , HUnit , QuickCheck >= 2.4.0.1 , cryptonite , memory , bytestring >= 0.10 , text >= 0.11 , aeson , scientific >= 0.2 , containers , unordered-containers , data-default , http-types , time >= 1.1 , vector >= 0.7.1 , semigroups >= 0.15.4 , network-uri cpp-options: -DTEST test-suite doctests default-language: Haskell2010 type: exitcode-stdio-1.0 main-is: doctests.hs ghc-options: -threaded build-depends: base < 5 && >= 4.4 , jwt , doctest >= 0.9.11 jwt-0.7.2/CHANGELOG.md0000644000000000000000000000607312724003726012334 0ustar0000000000000000# 2016-06-02 0.7.2 * Add missing Data.ByteString.ExtendedTests (Thanks to nomeata for reporting this). * Support GHC 8 by raising the upper bound of base (GHC8 ships with base-4.9) (Thanks to Utku Demir). # 2016-04-11 0.7.1 * Add `binarySecret` function to enable providing a secret based on a `ByteString` (fixes #21 - Thanks to Joe Nelson for reporting this). # 2016-02-20 0.7.0 * Update JWT to match RFC 7519. This is a backward compatible change with deprecation warnings added for types and functions to be removed in the future. * Add NumericDate as a replacement for IntDate (and numericDate as a replacement for intDate) * Add JOSEHeader as a replacement for JWTHeader. * Use Stack and LTS 4.0 * Use cryptonite instead of cryptohash (Thanks to Greg V) * Remove Web.Base64 in favour of using `memory` (Thanks to Greg V) # 2015-04-22 0.6.0 * Execute doctests in addition to the testsuite when using 'make test'. * Export `ClaimsMap` type alias (fixes #12) * Allow base 4.8 * Lowered required cabal library version (to 1.16) to workaround build issues in a consumer project. * Add 7.10.1 to the travis config # 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 * 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. # 2015-01-03 0.5.1 * Fix the encoding of the `aud` part of the claim. Thanks to Aaron Levin for reporting and implementing the change. In addition to the fix we now also verify the shape fo the generated payload. # 2014-12-01 0.5.0 * Rev. 17 of the JWT Draft changed the audience claim from being an optional String to being either an optional `StringOrURI`s or an optional list of `StringOrURI`s. Thanks to Aaron Levin for reporting and implementing the change. This change breaks backwards compatibility (in regard to 0.4.x). # 2014-10-15 0.4.2 * Fix the build problems introduced in 0.4.1 to work with the split network package. Thanks to Richard Wallace for fixing this and to Jeremy Shaw for reporting this at the same time. # 2014-09-17 0.4.1 * Update jwt.cabal to work with the new split network package. Thanks to Jeremy Shaw for reporting this. # 2014-08-02 0.4.0 * Change the upper boundary of base from 4.7 to 4.8 (#5) # 2014-06-02 0.3.0 * Add verify function (thanks to Robert Massaioli) to allow verifying an already decoded JWT token # 2014-03-10 0.2.1 * Add Decoding/Encoding sections * Make the examples runnable by doctest * Fix hlint warnings * Add 'secondsSinceEpoch' to extract the seconds from epoch from an IntDate # 2014-03-10 0.2.0 * Export the IntDate and StringOrURI types #5a1137b # 2014-03-03 0.1.1 * Verify that invalid input to the decode\* functions fails as expected # 2014-03-03 0.1.0 * Initial release jwt-0.7.2/README.md0000644000000000000000000000153412510212027011764 0ustar0000000000000000# Haskell JSON Web Token (JWT) JSON Web Token (JWT) is a compact URL-safe means of representing claims to be transferred between two parties. From http://self-issued.info/docs/draft-ietf-oauth-json-web-token.html > JSON Web Token (JWT) is a compact URL-safe means of representing claims to be transferred > between two parties. The claims in a JWT are encoded as a JavaScript Object Notation (JSON) > object that is used as the payload of a JSON Web Signature (JWS) structure or as the plaintext > 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. [![Build Status](https://travis-ci.org/juretta/haskell-jwt.svg?branch=master)](https://travis-ci.org/juretta/haskell-jwt) jwt-0.7.2/tests/jwt.secret.10000644000000000000000000000010012722235237014022 0ustar0000000000000000çr'ÞÖÕסØ*îS²Cœn󱳆qX„_·hwìØf¤Å —.Xé"îË8»r‰[ÚéþgŽ¥©