Generate and Decode JWTs in Haskell with jose-jwt

Main.hs

{-# LANGUAGE FlexibleContexts  #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}


module Main where

import qualified Data.Aeson.Encode     as A
import           Data.ByteString.Lazy  (toStrict)
import           Data.Either
import           Data.Time.Clock
import           Data.Time.Clock.POSIX
import           Jose.Jwa
import           Jose.Jwk
import           Jose.Jws
import           Jose.Jwt

-- Get a Jwk
privateJwk :: IO Jwk
privateJwk = do
  (_, privKey) <- generateRsaKeyPair 256 (KeyId "mykey") Sig (Just (Signed RS256))
  return privKey

-- Make some claims
makeJwtClaims :: IO JwtClaims
makeJwtClaims = do
  currentUTC <- getCurrentTime
  let laterDate =  IntDate $ utcTimeToPOSIXSeconds $ addUTCTime (60 * 60 * 24 * 14) currentUTC
  return $
    JwtClaims (Just "issuer")
              (Just "sub")
              (Just ["aud1", "aud2"])
              (Just laterDate)
              Nothing
              Nothing
              (Just "jti")

-- Create a Payload
makePayload :: JwtClaims -> Payload
makePayload claims = Claims $ toStrict $ A.encode claims

-- Test Encode and Decode a Jwt
encodeDecodePrint :: IO ()
encodeDecodePrint = do
  jwk    <- privateJwk
  claims <- makeJwtClaims
  let encAlg  = JwsEncoding RS256
      payload = makePayload claims
  eitherJwt <- encode [jwk] encAlg payload
  case eitherJwt of
    Right jwt -> do
      print jwt
      eitherContent <- decode [jwk] (Just encAlg) (unJwt jwt)
      either (\_ -> print "Decode Failure")
             (\(Jws (_, bs)) -> print bs)
             eitherContent
    _ -> print "Encode failure"





main = privateJwk >>= print