diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -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. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/jwt.cabal b/jwt.cabal new file mode 100644 --- /dev/null +++ b/jwt.cabal @@ -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 diff --git a/src/Web/JWT.hs b/src/Web/JWT.hs new file mode 100644 --- /dev/null +++ b/src/Web/JWT.hs @@ -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 +Stability: experimental + +This implementation of JWT is based on (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 diff --git a/tests/src/TestRunner.hs b/tests/src/TestRunner.hs new file mode 100644 --- /dev/null +++ b/tests/src/TestRunner.hs @@ -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 + ] + diff --git a/tests/src/Web/JWTTests.hs b/tests/src/Web/JWTTests.hs new file mode 100644 --- /dev/null +++ b/tests/src/Web/JWTTests.hs @@ -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)