jwt-0.1.0: JSON Web Token (JWT) decoding and encoding

Stabilityexperimental
MaintainerStefan Saasen <stefan@saasen.me>
Safe HaskellNone

Web.JWT

Contents

Description

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

Synopsis

Encoding & Decoding JWTs

decode :: JSON -> Maybe (JWT UnverifiedJWT)Source

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

decodeAndVerifySignature :: Secret -> Text -> Maybe (JWT VerifiedJWT)Source

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")

encodeSigned :: Algorithm -> Secret -> JWTClaimsSet -> JSONSource

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"

encodeUnsigned :: JWTClaimsSet -> JSONSource

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."

Utility functions

tokenIssuer :: JSON -> Maybe TextSource

Try to extract the value for the issue claim field iss from the web token in JSON form

secret :: Text -> SecretSource

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.

claims :: JWT r -> JWTClaimsSetSource

Extract the claims set from a JSON Web Token

header :: JWT r -> JWTHeaderSource

Extract the header from a JSON Web Token

signature :: JWT r -> Maybe SignatureSource

Extract the signature from a verified JSON Web Token

Types

data UnverifiedJWT Source

JSON Web Token without signature verification

data VerifiedJWT Source

JSON Web Token that has been successfully verified

data Secret Source

The secret used for calculating the message signature

Instances

data JWT r Source

The JSON Web Token

Instances

Show (JWT r) 

data Algorithm Source

Constructors

HS256

HMAC using SHA-256 hash algorithm

data JWTClaimsSet Source

The JWT Claims Set represents a JSON object whose members are the claims conveyed by the JWT.

Constructors

JWTClaimsSet 

Fields

iss :: Maybe Text

The iss (issuer) claim identifies the principal that issued the JWT.

sub :: Maybe Text

The sub (subject) claim identifies the principal that is the subject of the JWT.

aud :: Maybe Text

The aud (audience) claim identifies the audiences that the JWT is intended for

exp :: Maybe IntDate

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.

nbf :: Maybe IntDate

The nbf (not before) claim identifies the time before which the JWT MUST NOT be accepted for processing.

iat :: Maybe IntDate

The iat (issued at) claim identifies the time at which the JWT was issued.

jti :: Maybe Text

The jti (JWT ID) claim provides a unique identifier for the JWT.

unregisteredClaims :: ClaimsMap