jwt (empty) → 0.1.0
raw patch · 6 files changed
+669/−0 lines, 6 filesdep +HUnitdep +QuickCheckdep +aesonsetup-changed
Dependencies added: HUnit, QuickCheck, aeson, base, base64-bytestring, bytestring, containers, cryptohash, data-default, http-types, network, scientific, tasty, tasty-hspec, tasty-hunit, tasty-quickcheck, tasty-th, text, unordered-containers
Files
- LICENSE +21/−0
- Setup.hs +2/−0
- jwt.cabal +75/−0
- src/Web/JWT.hs +395/−0
- tests/src/TestRunner.hs +13/−0
- tests/src/Web/JWTTests.hs +163/−0
+ LICENSE view
@@ -0,0 +1,21 @@+The 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.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ jwt.cabal view
@@ -0,0 +1,75 @@+-- Initial atlassian-jwt.cabal generated by cabal init. For further+-- documentation, see http://haskell.org/cabal/users-guide/++name: jwt+version: 0.1.0+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.18+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.++source-repository head+ type: git+ location: https://ssaasen@bitbucket.org/ssaasen/haskell-jwt.git++library+ exposed-modules: Web.JWT+ build-depends: base >= 4.6 && < 4.7+ , cryptohash >= 0.11+ , base64-bytestring >= 1.0+ , 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+ , network >= 2.4++ 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+ other-modules: Web.JWTTests+ hs-source-dirs: tests/src, src+ build-depends: base < 5 && >= 4.4+ , tasty >= 0.7+ , tasty-th >= 0.1+ , tasty-hspec >= 0.1+ , tasty-hunit >= 0.4+ , tasty-quickcheck >= 0.3+ , HUnit+ , QuickCheck >= 2.4.0.1+ , cryptohash+ , base64-bytestring >= 1.0+ , bytestring >= 0.10+ , text >= 0.11+ , aeson+ , scientific >= 0.2+ , containers+ , unordered-containers+ , data-default+ , http-types+ , network++ cpp-options: -DTEST
+ src/Web/JWT.hs view
@@ -0,0 +1,395 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE EmptyDataDecls #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE StandaloneDeriving #-}++-- TODO:+-- * StringOrUri is not valdiated++{-|+Module: Web.JWT+License: MIT+Maintainer: Stefan Saasen <stefan@saasen.me>+Stability: experimental++This implementation of JWT is based on <http://self-issued.info/docs/draft-ietf-oauth-json-web-token.html> (Version 16)+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+ decode+ , decodeAndVerifySignature+ , encodeSigned+ , encodeUnsigned++ -- * Utility functions+ , tokenIssuer+ , secret+ , claims+ , header+ , signature+ , module Data.Default++ -- * Types+ , UnverifiedJWT+ , VerifiedJWT+ , Signature+ , Secret+ , JWT+ , JSON+ , Algorithm(..)+ , JWTClaimsSet(..)++#ifdef TEST+ , IntDate(..)+ , JWTHeader(..)+ , base64Encode+ , base64Decode+#endif+ ) where++import qualified Data.ByteString.Char8 as B+import qualified Data.ByteString.Lazy.Char8 as BL (fromStrict, toStrict)+import qualified Data.Text as T+import qualified Data.Text.Encoding as TE++import Control.Applicative+import Control.Monad+import qualified Crypto.Hash.SHA256 as SHA+import qualified Crypto.MAC.HMAC as HMAC+import Data.Aeson hiding (decode, encode)+import qualified Data.Aeson as JSON+import qualified Data.ByteString.Base64.URL as BASE64+import Data.Default+import qualified Data.HashMap.Strict as StrictMap+import qualified Data.Map as Map+import Data.Maybe+import Data.Scientific+import Prelude hiding (exp)+++type JSON = T.Text++-- | The secret used for calculating the message signature+newtype Secret = Secret T.Text deriving (Eq, Show)++newtype Signature = Signature T.Text deriving (Eq, Show)++-- | 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 -> 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 -> JWTHeader+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.+newtype IntDate = IntDate Integer deriving (Eq, Show)++data Algorithm = HS256 -- ^ HMAC using SHA-256 hash algorithm+ deriving (Eq, Show)++-- | JWT Header, describes the cryptographic operations applied to the JWT+data JWTHeader = JWTHeader {+ typ :: Maybe T.Text+ , cty :: Maybe T.Text+ , alg :: Maybe Algorithm+} deriving (Eq, Show)++instance Default JWTHeader where+ def = JWTHeader 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 T.Text++ -- | The sub (subject) claim identifies the principal that is the subject of the JWT.+ , sub :: Maybe T.Text++ -- | The aud (audience) claim identifies the audiences that the JWT is intended for+ , aud :: Maybe T.Text++ -- | 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 T.Text++ , unregisteredClaims :: ClaimsMap++} deriving (Eq, Show)+++instance Default JWTClaimsSet where+ def = JWTClaimsSet Nothing Nothing Nothing Nothing Nothing Nothing Nothing Map.empty+++-- | Encode a claims set using the given secret+--+-- > {-# LANGUAGE OverloadedStrings #-}+-- >+-- > let cs = def { -- def returns a default JWTClaimsSet+-- > iss = Just "Foo"+-- > , unregisteredClaims = Map.fromList [("http://example.com/is_root", (Bool True))]+-- > }+-- > key = secret "secret-key"+-- > jwt = encodeSigned HS256 key cs+--+-- This yields:+--+-- > >>> jwt+-- > "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+--+-- > {-# LANGUAGE OverloadedStrings #-}+-- >+-- > let cs = def { -- def returns a default JWTClaimsSet+-- > iss = Just "Foo"+-- > , unregisteredClaims = Map.fromList [("http://example.com/is_root", (Bool True))]+-- > }+-- > jwt = encodeUnsigned cs+--+-- This yields:+--+-- > >>> jwt+-- > "eyJ0eXAiOiJKV1QiLCJhbGciOiJIUzI1NiJ9.eyJodHRwOi8vZXhhbXBsZS5jb20vaXNfcm9vdCI6dHJ1ZSwiaXNzIjoiRm9vIn0."+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).+--+-- > import qualified Data.Text as T+-- > let input = "eyJ0eXAiOiJKV1QiLCJhbGciOiJIUzI1NiJ9.eyJzb21lIjoicGF5bG9hZCJ9.Joh1R2dYzkRvDkqv3sygm5YyK8Gi4ShZqbhK2gxcs2U" :: T.Text+-- > mJwt = decode input+-- > mHeader = fmap header mJwt+-- > mClaims = fmap claims mJwt+-- > mSignature = join $ fmap signature mJwt+--+-- This yields:+--+-- > >>> mHeader+-- > Just (JWTHeader {typ = Just "JWT", cty = Nothing, alg = Just HS256})+--+-- and+--+-- > >>> mClaims+-- > Just (JWTClaimsSet {iss = Nothing, sub = Nothing, aud = Nothing,+-- > exp = Nothing, nbf = Nothing, iat = Nothing, jti = Nothing,+-- > unregisteredClaims = fromList [("some",String "payload")]})+--+-- and+--+-- > >>> mSignature+-- > Nothing+decode :: JSON -> Maybe (JWT UnverifiedJWT)+decode input = let (h:c:_) = T.splitOn "." input+ header' = parseJWT h+ claims' = parseJWT c+ in Unverified <$> header' <*> claims'+++-- | 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.+--+-- > import qualified Data.Text as T+-- > let input = "eyJ0eXAiOiJKV1QiLCJhbGciOiJIUzI1NiJ9.eyJzb21lIjoicGF5bG9hZCJ9.Joh1R2dYzkRvDkqv3sygm5YyK8Gi4ShZqbhK2gxcs2U" :: T.Text+-- > mJwt = decodeAndVerifySignature (secret "secret") input+-- > mSignature = join $ fmap signature mJwt+--+-- This yields:+--+-- > >>> mJwt+-- > Just (Verified (JWTHeader {typ = Just "JWT", cty = Nothing, alg = Just HS256})+-- > (JWTClaimsSet {iss = Nothing, sub = Nothing, aud = Nothing, exp = Nothing,+-- > nbf = Nothing, iat = Nothing, jti = Nothing,+-- > unregisteredClaims = fromList [("some",String "payload")]})+-- > (Signature "Joh1R2dYzkRvDkqv3sygm5YyK8Gi4ShZqbhK2gxcs2U"))+--+-- and+--+-- > >>> mSignature+-- > Just (Signature "Joh1R2dYzkRvDkqv3sygm5YyK8Gi4ShZqbhK2gxcs2U")+decodeAndVerifySignature :: Secret -> T.Text -> Maybe (JWT VerifiedJWT)+decodeAndVerifySignature secret' input = do+ let (h:c:s:_) = T.splitOn "." input+ header' <- parseJWT h+ claims' <- parseJWT c+ algo <- fmap alg header'+ let sign = if Just s == calculateMessageDigest h c algo then pure $ Signature s else mzero+ Verified <$> header' <*> claims' <*> sign+ where+ calculateMessageDigest header' claims' (Just algo') = Just $ calculateDigest algo' secret' (dotted [header', claims'])+ calculateMessageDigest _ _ Nothing = Nothing++-- | Try to extract the value for the issue claim field 'iss' from the web token in JSON form+tokenIssuer :: JSON -> Maybe T.Text+tokenIssuer = decode >=> fmap pure claims >=> iss++-- | Create a Secret using the given key+-- This will currently simply wrap the given key appropriately buy may+-- return a Nothing in the future if the key needs to adhere to a specific+-- format and the given key is invalid.+secret :: T.Text -> Secret+secret = Secret++-- =================================================================================++encodeJWT :: ToJSON a => a -> T.Text+encodeJWT = base64Encode . TE.decodeUtf8 . BL.toStrict . JSON.encode++parseJWT :: FromJSON a => T.Text -> Maybe a+parseJWT = JSON.decode . BL.fromStrict . TE.encodeUtf8 . base64Decode++dotted :: [T.Text] -> T.Text+dotted = T.intercalate "."+++-- =================================================================================+++base64Decode :: T.Text -> T.Text+base64Decode = operateOnText BASE64.decodeLenient++base64Encode :: T.Text -> T.Text+base64Encode = removePaddingBase64Encoding . operateOnText BASE64.encode++operateOnText :: (B.ByteString -> B.ByteString) -> T.Text -> T.Text+operateOnText f = TE.decodeUtf8 . f . TE.encodeUtf8++removePaddingBase64Encoding :: T.Text -> T.Text+removePaddingBase64Encoding = T.dropWhileEnd (=='=')++calculateDigest :: Algorithm -> Secret -> T.Text -> T.Text+calculateDigest _ (Secret key) msg = base64Encode' $ HMAC.hmac SHA.hash 64 (bs key) (bs msg)+ where bs = TE.encodeUtf8+ base64Encode' = removePaddingBase64Encoding . TE.decodeUtf8 . BASE64.encode++-- =================================================================================++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+ , fmap ("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"+ <*> o .:? "aud"+ <*> o .:? "exp"+ <*> o .:? "nbf"+ <*> o .:? "iat"+ <*> o .:? "jti"+ <*> pure (removeRegisteredClaims $ fromHashMap o))++++instance FromJSON JWTHeader where+ parseJSON = withObject "JWTHeader"+ (\o -> JWTHeader+ <$> o .:? "typ"+ <*> o .:? "cty"+ <*> o .:? "alg")++instance ToJSON JWTHeader where+ toJSON JWTHeader{..} = object $ catMaybes [+ fmap ("typ" .=) typ+ , fmap ("cty" .=) cty+ , fmap ("alg" .=) alg+ ]++instance ToJSON IntDate where+ toJSON (IntDate ts) = Number $ scientific (fromIntegral ts) 0++instance FromJSON IntDate where+ parseJSON (Number x) = return $ IntDate $ 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
+ tests/src/TestRunner.hs view
@@ -0,0 +1,13 @@+module Main where++import qualified Web.JWTTests+import Test.Tasty++main :: IO ()+main = defaultMain tests++tests :: TestTree+tests = testGroup "JWT Tests" [+ Web.JWTTests.defaultTestGroup+ ]+
+ tests/src/Web/JWTTests.hs view
@@ -0,0 +1,163 @@+{-# LANGUAGE BangPatterns, OverloadedStrings, ScopedTypeVariables, TemplateHaskell #-}+{-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-}+module Web.JWTTests+ (+ main+ , defaultTestGroup+) where++import Control.Applicative+import Test.Tasty+import Test.Tasty.TH+import Test.Tasty.HUnit+import Test.Tasty.QuickCheck+import qualified Test.QuickCheck as QC+import qualified Data.Map as Map+import qualified Data.Text as T+import qualified Data.Text.Lazy as TL+import Data.Aeson.Types+import Data.Maybe+import Data.String (fromString, IsString)+import Web.JWT++defaultTestGroup :: TestTree+defaultTestGroup = $(testGroupGenerator)++main :: IO ()+main = defaultMain defaultTestGroup+++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_decodeAndVerifyJWT = do+ -- Generated with ruby-jwt+ let input = "eyJ0eXAiOiJKV1QiLCJhbGciOiJIUzI1NiJ9.eyJzb21lIjoicGF5bG9hZCJ9.Joh1R2dYzkRvDkqv3sygm5YyK8Gi4ShZqbhK2gxcs2U"+ mJwt = decodeAndVerifySignature (secret "secret") input+ True @=? isJust mJwt+ let (Just verified) = mJwt+ (Just HS256) @=? (alg $ header verified)+ (Just "payload") @=? (Map.lookup "some" $ unregisteredClaims $ claims verified)++case_decodeAndVerifyJWTFailing = do+ -- Generated with ruby-jwt, modified to be invalid+ let input = "eyJ0eXAiOiJKV1QiLCJhbGciOiJIUzI1NiJ9.eyJzb21lIjoicGF5bG9hZCJ9.Joh1R2dYzkRvDkqv3sygm5YyK8Gi4ShZqbhK2gxcs2u"+ mJwt = decodeAndVerifySignature (secret "secret") input+ False @=? isJust mJwt++case_encodeJWTNoMac = do+ let cs = def {+ iss = Just "Foo"+ , unregisteredClaims = Map.fromList [("http://example.com/is_root", (Bool True))]+ }+ jwt = encodeUnsigned cs+ -- Verified using https://py-jwt-decoder.appspot.com/+ "eyJ0eXAiOiJKV1QiLCJhbGciOiJIUzI1NiJ9.eyJodHRwOi8vZXhhbXBsZS5jb20vaXNfcm9vdCI6dHJ1ZSwiaXNzIjoiRm9vIn0." @=? jwt++case_encodeDecodeJWTNoMac = do+ let cs = def {+ iss = Just "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 cs = def {+ iss = Just "Foo"+ , unregisteredClaims = Map.fromList [("http://example.com/is_root", (Bool True))]+ }+ key = secret "secret-key"+ mJwt = decode $ encodeSigned HS256 key cs+ True @=? (isJust mJwt)+ let (Just unverified) = mJwt+ cs @=? claims unverified++case_tokenIssuer = do+ let cs = def {+ iss = Just "Foo"+ , unregisteredClaims = Map.fromList [("http://example.com/is_root", (Bool True))]+ }+ key = secret "secret-key"+ t = encodeSigned HS256 key cs+ Just "Foo" @=? tokenIssuer t+++case_encodeJWTClaimsSet = do+ let cs = def {+ iss = Just "Foo"+ }+ -- This is a valid JWT string that can be decoded with the given secret using the ruby JWT library+ "eyJ0eXAiOiJKV1QiLCJhbGciOiJIUzI1NiJ9.eyJpc3MiOiJGb28ifQ.dfhkuexBONtkewFjLNz9mZlFc82GvRkaZKD8Pd53zJ8" @=? encodeSigned HS256 (secret "secret") cs++case_encodeJWTClaimsSetCustomClaims = do+ let cs = def {+ iss = Just "Foo"+ , unregisteredClaims = Map.fromList [("http://example.com/is_root", (Bool True))]+ }+ -- The expected string can be decoded using the ruby-jwt library+ "eyJ0eXAiOiJKV1QiLCJhbGciOiJIUzI1NiJ9.eyJodHRwOi8vZXhhbXBsZS5jb20vaXNfcm9vdCI6dHJ1ZSwiaXNzIjoiRm9vIn0.UVp4TIg8-OmY_vNHbyxMPx7v0P6jCY4rqYVWVcjdXQk" @=? encodeSigned HS256 (secret "secret") cs++case_base64EncodeString = do+ let header = "{\"typ\":\"JWT\",\r\n \"alg\":\"HS256\"}"+ "eyJ0eXAiOiJKV1QiLA0KICJhbGciOiJIUzI1NiJ9" @=? base64Encode header++case_base64EncodeStringNoPadding = do+ let header = "sdjkfhaks jdhfak sjldhfa lkjsdf"+ "c2Rqa2ZoYWtzIGpkaGZhayBzamxkaGZhIGxranNkZg" @=? base64Encode header++case_base64EncodeDecodeStringNoPadding = do+ let header = "sdjkfhaks jdhfak sjldhfa lkjsdf"+ header @=? (base64Decode $ base64Encode header)++case_base64DecodeString = do+ let str = "eyJ0eXAiOiJKV1QiLA0KICJhbGciOiJIUzI1NiJ9"+ "{\"typ\":\"JWT\",\r\n \"alg\":\"HS256\"}" @=? base64Decode str++prop_base64_encode_decode = f+ where f :: T.Text -> Bool+ f input = (base64Decode $ base64Encode input) == input++prop_encode_decode_prop = f+ where f :: JWTClaimsSet -> Bool+ f claims' = let Just unverified = (decode $ encodeSigned HS256 (secret "secret") claims')+ in claims unverified == claims'++prop_encode_decode_verify_signature_prop = f+ where f :: JWTClaimsSet -> Bool+ f claims' = let key = secret "secret"+ Just verified = (decodeAndVerifySignature key $ encodeSigned HS256 key claims')+ in claims verified == claims'+++instance Arbitrary JWTClaimsSet where+ arbitrary = JWTClaimsSet <$> arbitrary+ <*> arbitrary+ <*> arbitrary+ <*> arbitrary+ <*> arbitrary+ <*> arbitrary+ <*> arbitrary+ <*> arbitrary++type ClaimsMap = Map.Map T.Text Value+instance Arbitrary ClaimsMap where+ arbitrary = return Map.empty++instance Arbitrary IntDate where+ arbitrary = IntDate <$> (arbitrary :: QC.Gen Integer)++instance Arbitrary T.Text where+ arbitrary = fromString <$> (arbitrary :: QC.Gen String)++instance Arbitrary TL.Text where+ arbitrary = fromString <$> (arbitrary :: QC.Gen String)