--   This Source Code Form is subject to the terms of the Mozilla Public
--   License, v. 2.0. If a copy of the MPL was not distributed with this
--   file, You can obtain one at http://mozilla.org/MPL/2.0/.

{-# OPTIONS_HADDOCK show-extensions #-}

{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}

-- | JWT payload structure and convenient builders.
module Libjwt.Payload
  ( Payload(..)
  , withIssuer
  , issuedBy
  , withSubject
  , issuedTo
  , withRecipient
  , intendedFor
  , withAudience
  , setTtl
  , expiresAt
  , notBefore
  , notBeforeNow
  , notUntil
  , issuedNow
  , withJwtId
  , JwtBuilder
  , jwtPayload
  )
where

import           Libjwt.Encoding
import           Libjwt.Decoding
import           Libjwt.NumericDate
import           Libjwt.RegisteredClaims
import           Libjwt.PrivateClaims

import           Control.Monad.Time

import           Control.Monad.Trans.Reader

import           Data.Default

import           Data.Function                  ( (&) )
import           Data.Monoid

import           Data.Time.Clock

import           Data.UUID                      ( UUID )

import           Prelude                 hiding ( exp )

-- | JWT payload representation
data Payload pc ns = ClaimsSet { Payload pc ns -> Iss
iss :: Iss -- ^ /iss/ (Issuer) claim
                               , Payload pc ns -> Sub
sub :: Sub -- ^ /sub/ (Subject) claim
                               , Payload pc ns -> Aud
aud :: Aud -- ^ /aud/ (Audience) claim
                               , Payload pc ns -> Exp
exp :: Exp -- ^ /exp/ (Expiration Time) claim
                               , Payload pc ns -> Nbf
nbf :: Nbf -- ^ /nbf/ (Not Before) claim
                               , Payload pc ns -> Iat
iat :: Iat -- ^ /iat/ (Issued At) claim
                               , Payload pc ns -> Jti
jti :: Jti -- ^ /jti/ (JWT ID) claim
                               , Payload pc ns -> PrivateClaims pc ns
privateClaims :: PrivateClaims pc ns -- ^ private claims
                               }
deriving stock instance Show (PrivateClaims pc ns) => Show (Payload pc ns)
deriving stock instance Eq (PrivateClaims pc ns) => Eq (Payload pc ns)

instance (pc ~ Empty, ns ~ 'NoNs) => Default (Payload pc ns) where
  def :: Payload pc ns
def = ClaimsSet :: forall (pc :: [Claim *]) (ns :: Namespace).
Iss
-> Sub
-> Aud
-> Exp
-> Nbf
-> Iat
-> Jti
-> PrivateClaims pc ns
-> Payload pc ns
ClaimsSet { iss :: Iss
iss           = Iss
forall a. Default a => a
def
                  , sub :: Sub
sub           = Sub
forall a. Default a => a
def
                  , aud :: Aud
aud           = Aud
forall a. Monoid a => a
mempty
                  , exp :: Exp
exp           = Exp
forall a. Default a => a
def
                  , nbf :: Nbf
nbf           = Nbf
forall a. Default a => a
def
                  , iat :: Iat
iat           = Iat
forall a. Default a => a
def
                  , jti :: Jti
jti           = Jti
forall a. Default a => a
def
                  , privateClaims :: PrivateClaims pc ns
privateClaims = PrivateClaims pc ns
forall a. Default a => a
def
                  }

instance Encode (PrivateClaims pc ns) => Encode (Payload pc ns) where
  encode :: Payload pc ns -> JwtT -> EncodeResult
encode ClaimsSet { Iss
iss :: Iss
iss :: forall (pc :: [Claim *]) (ns :: Namespace). Payload pc ns -> Iss
iss, Sub
sub :: Sub
sub :: forall (pc :: [Claim *]) (ns :: Namespace). Payload pc ns -> Sub
sub, Aud
aud :: Aud
aud :: forall (pc :: [Claim *]) (ns :: Namespace). Payload pc ns -> Aud
aud, Exp
exp :: Exp
exp :: forall (pc :: [Claim *]) (ns :: Namespace). Payload pc ns -> Exp
exp, Nbf
nbf :: Nbf
nbf :: forall (pc :: [Claim *]) (ns :: Namespace). Payload pc ns -> Nbf
nbf, Iat
iat :: Iat
iat :: forall (pc :: [Claim *]) (ns :: Namespace). Payload pc ns -> Iat
iat, Jti
jti :: Jti
jti :: forall (pc :: [Claim *]) (ns :: Namespace). Payload pc ns -> Jti
jti, PrivateClaims pc ns
privateClaims :: PrivateClaims pc ns
privateClaims :: forall (pc :: [Claim *]) (ns :: Namespace).
Payload pc ns -> PrivateClaims pc ns
privateClaims } JwtT
jwt =
    Iss -> JwtT -> EncodeResult
forall c. Encode c => c -> JwtT -> EncodeResult
encode Iss
iss JwtT
jwt
      EncodeResult -> EncodeResult -> EncodeResult
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Sub -> JwtT -> EncodeResult
forall c. Encode c => c -> JwtT -> EncodeResult
encode Sub
sub           JwtT
jwt
      EncodeResult -> EncodeResult -> EncodeResult
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Aud -> JwtT -> EncodeResult
forall c. Encode c => c -> JwtT -> EncodeResult
encode Aud
aud           JwtT
jwt
      EncodeResult -> EncodeResult -> EncodeResult
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Exp -> JwtT -> EncodeResult
forall c. Encode c => c -> JwtT -> EncodeResult
encode Exp
exp           JwtT
jwt
      EncodeResult -> EncodeResult -> EncodeResult
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Nbf -> JwtT -> EncodeResult
forall c. Encode c => c -> JwtT -> EncodeResult
encode Nbf
nbf           JwtT
jwt
      EncodeResult -> EncodeResult -> EncodeResult
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Iat -> JwtT -> EncodeResult
forall c. Encode c => c -> JwtT -> EncodeResult
encode Iat
iat           JwtT
jwt
      EncodeResult -> EncodeResult -> EncodeResult
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Jti -> JwtT -> EncodeResult
forall c. Encode c => c -> JwtT -> EncodeResult
encode Jti
jti           JwtT
jwt
      EncodeResult -> EncodeResult -> EncodeResult
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> PrivateClaims pc ns -> JwtT -> EncodeResult
forall c. Encode c => c -> JwtT -> EncodeResult
encode PrivateClaims pc ns
privateClaims JwtT
jwt

instance Decode (PrivateClaims pc ns) => Decode (Payload pc ns) where
  decode :: JwtT -> JwtIO (Payload pc ns)
decode JwtT
jwt =
    Iss
-> Sub
-> Aud
-> Exp
-> Nbf
-> Iat
-> Jti
-> PrivateClaims pc ns
-> Payload pc ns
forall (pc :: [Claim *]) (ns :: Namespace).
Iss
-> Sub
-> Aud
-> Exp
-> Nbf
-> Iat
-> Jti
-> PrivateClaims pc ns
-> Payload pc ns
ClaimsSet
      (Iss
 -> Sub
 -> Aud
 -> Exp
 -> Nbf
 -> Iat
 -> Jti
 -> PrivateClaims pc ns
 -> Payload pc ns)
-> JwtIO Iss
-> JwtIO
     (Sub
      -> Aud
      -> Exp
      -> Nbf
      -> Iat
      -> Jti
      -> PrivateClaims pc ns
      -> Payload pc ns)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> JwtT -> JwtIO Iss
forall c. Decode c => JwtT -> JwtIO c
decode JwtT
jwt
      JwtIO
  (Sub
   -> Aud
   -> Exp
   -> Nbf
   -> Iat
   -> Jti
   -> PrivateClaims pc ns
   -> Payload pc ns)
-> JwtIO Sub
-> JwtIO
     (Aud
      -> Exp
      -> Nbf
      -> Iat
      -> Jti
      -> PrivateClaims pc ns
      -> Payload pc ns)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> JwtT -> JwtIO Sub
forall c. Decode c => JwtT -> JwtIO c
decode JwtT
jwt
      JwtIO
  (Aud
   -> Exp
   -> Nbf
   -> Iat
   -> Jti
   -> PrivateClaims pc ns
   -> Payload pc ns)
-> JwtIO Aud
-> JwtIO
     (Exp -> Nbf -> Iat -> Jti -> PrivateClaims pc ns -> Payload pc ns)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> JwtT -> JwtIO Aud
forall c. Decode c => JwtT -> JwtIO c
decode JwtT
jwt
      JwtIO
  (Exp -> Nbf -> Iat -> Jti -> PrivateClaims pc ns -> Payload pc ns)
-> JwtIO Exp
-> JwtIO
     (Nbf -> Iat -> Jti -> PrivateClaims pc ns -> Payload pc ns)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> JwtT -> JwtIO Exp
forall c. Decode c => JwtT -> JwtIO c
decode JwtT
jwt
      JwtIO (Nbf -> Iat -> Jti -> PrivateClaims pc ns -> Payload pc ns)
-> JwtIO Nbf
-> JwtIO (Iat -> Jti -> PrivateClaims pc ns -> Payload pc ns)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> JwtT -> JwtIO Nbf
forall c. Decode c => JwtT -> JwtIO c
decode JwtT
jwt
      JwtIO (Iat -> Jti -> PrivateClaims pc ns -> Payload pc ns)
-> JwtIO Iat -> JwtIO (Jti -> PrivateClaims pc ns -> Payload pc ns)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> JwtT -> JwtIO Iat
forall c. Decode c => JwtT -> JwtIO c
decode JwtT
jwt
      JwtIO (Jti -> PrivateClaims pc ns -> Payload pc ns)
-> JwtIO Jti -> JwtIO (PrivateClaims pc ns -> Payload pc ns)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> JwtT -> JwtIO Jti
forall c. Decode c => JwtT -> JwtIO c
decode JwtT
jwt
      JwtIO (PrivateClaims pc ns -> Payload pc ns)
-> JwtIO (PrivateClaims pc ns) -> JwtIO (Payload pc ns)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> JwtT -> JwtIO (PrivateClaims pc ns)
forall c. Decode c => JwtT -> JwtIO c
decode JwtT
jwt

newtype JwtBuilder any1 any2 = JwtBuilder { JwtBuilder any1 any2
-> Ap (Reader UTCTime) (Endo (Payload any1 any2))
steps :: Ap (Reader UTCTime) (Endo (Payload any1 any2)) }
  deriving newtype (b -> JwtBuilder any1 any2 -> JwtBuilder any1 any2
NonEmpty (JwtBuilder any1 any2) -> JwtBuilder any1 any2
JwtBuilder any1 any2
-> JwtBuilder any1 any2 -> JwtBuilder any1 any2
(JwtBuilder any1 any2
 -> JwtBuilder any1 any2 -> JwtBuilder any1 any2)
-> (NonEmpty (JwtBuilder any1 any2) -> JwtBuilder any1 any2)
-> (forall b.
    Integral b =>
    b -> JwtBuilder any1 any2 -> JwtBuilder any1 any2)
-> Semigroup (JwtBuilder any1 any2)
forall (any1 :: [Claim *]) (any2 :: Namespace).
NonEmpty (JwtBuilder any1 any2) -> JwtBuilder any1 any2
forall (any1 :: [Claim *]) (any2 :: Namespace).
JwtBuilder any1 any2
-> JwtBuilder any1 any2 -> JwtBuilder any1 any2
forall (any1 :: [Claim *]) (any2 :: Namespace) b.
Integral b =>
b -> JwtBuilder any1 any2 -> JwtBuilder any1 any2
forall b.
Integral b =>
b -> JwtBuilder any1 any2 -> JwtBuilder any1 any2
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: b -> JwtBuilder any1 any2 -> JwtBuilder any1 any2
$cstimes :: forall (any1 :: [Claim *]) (any2 :: Namespace) b.
Integral b =>
b -> JwtBuilder any1 any2 -> JwtBuilder any1 any2
sconcat :: NonEmpty (JwtBuilder any1 any2) -> JwtBuilder any1 any2
$csconcat :: forall (any1 :: [Claim *]) (any2 :: Namespace).
NonEmpty (JwtBuilder any1 any2) -> JwtBuilder any1 any2
<> :: JwtBuilder any1 any2
-> JwtBuilder any1 any2 -> JwtBuilder any1 any2
$c<> :: forall (any1 :: [Claim *]) (any2 :: Namespace).
JwtBuilder any1 any2
-> JwtBuilder any1 any2 -> JwtBuilder any1 any2
Semigroup, Semigroup (JwtBuilder any1 any2)
JwtBuilder any1 any2
Semigroup (JwtBuilder any1 any2)
-> JwtBuilder any1 any2
-> (JwtBuilder any1 any2
    -> JwtBuilder any1 any2 -> JwtBuilder any1 any2)
-> ([JwtBuilder any1 any2] -> JwtBuilder any1 any2)
-> Monoid (JwtBuilder any1 any2)
[JwtBuilder any1 any2] -> JwtBuilder any1 any2
JwtBuilder any1 any2
-> JwtBuilder any1 any2 -> JwtBuilder any1 any2
forall (any1 :: [Claim *]) (any2 :: Namespace).
Semigroup (JwtBuilder any1 any2)
forall (any1 :: [Claim *]) (any2 :: Namespace).
JwtBuilder any1 any2
forall (any1 :: [Claim *]) (any2 :: Namespace).
[JwtBuilder any1 any2] -> JwtBuilder any1 any2
forall (any1 :: [Claim *]) (any2 :: Namespace).
JwtBuilder any1 any2
-> JwtBuilder any1 any2 -> JwtBuilder any1 any2
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
mconcat :: [JwtBuilder any1 any2] -> JwtBuilder any1 any2
$cmconcat :: forall (any1 :: [Claim *]) (any2 :: Namespace).
[JwtBuilder any1 any2] -> JwtBuilder any1 any2
mappend :: JwtBuilder any1 any2
-> JwtBuilder any1 any2 -> JwtBuilder any1 any2
$cmappend :: forall (any1 :: [Claim *]) (any2 :: Namespace).
JwtBuilder any1 any2
-> JwtBuilder any1 any2 -> JwtBuilder any1 any2
mempty :: JwtBuilder any1 any2
$cmempty :: forall (any1 :: [Claim *]) (any2 :: Namespace).
JwtBuilder any1 any2
$cp1Monoid :: forall (any1 :: [Claim *]) (any2 :: Namespace).
Semigroup (JwtBuilder any1 any2)
Monoid)

-- | Create a payload from the builder and the value representing private claims
--
--   For example:
-- 
-- @
-- jwtPayload
--   ('withIssuer' "myApp" <> 'withRecipient' "https://myApp.com" <> 'setTtl' 300)
--   ( #userName v'->>' "John Doe"
--   , #isRoot v'->>' False
--   , #userId v'->>' (12345 :: Int)
--   )
-- @
-- 
--  The resulting payload will be the equivalent of:
-- 
-- > {
-- >   "aud": [
-- >     "https://myApp.com"
-- >   ],
-- >   "exp": 1599499073,
-- >   "iat": 1599498773,
-- >   "isRoot": false,
-- >   "iss": "myApp",
-- >   "userId": 12345,
-- >   "userName": "JohnDoe"
-- > }
--
-- An identical payload can be constructed from the following record type:
--
-- @
-- data MyClaims = MyClaims { userName :: String
--                          , isRoot :: Bool
--                          , userId :: Int
--                          }
--   deriving stock (Eq, Show, Generic)
-- 
-- instance 'ToPrivateClaims' UserClaims
-- 
-- jwtPayload
--   ('withIssuer' "myApp" <> 'withRecipient' "https://myApp.com" <> 'setTtl' 300)
--   MyClaims { userName = "John Doe"
--            , isRoot   = False
--            , userId   = 12345
--            }
-- @
-- 
--  If you want to assign a /namespace/ to your private claims, you can do:
-- 
-- @
-- jwtPayload
--     (withIssuer "myApp" <> withRecipient "https://myApp.com" <> setTtl 300)
--   $ 'withNs'
--       ('Ns' @"https://myApp.com")
--       MyClaims
--         { userId    = 12345
--         , userName  = "JohnDoe"
--         , isRoot    = False
--         }
-- @
--
--  The resulting payload will be the equivalent of:
-- 
-- > {
-- >   "aud": [
-- >     "https://myApp.com"
-- >   ],
-- >   "exp": 1599499073,
-- >   "iat": 1599498773,
-- >   "https://myApp.com/isRoot": false,
-- >   "iss": "myApp",
-- >   "https://myApp.com/userId": 12345,
-- >   "https://myApp.com/userName": "JohnDoe"
-- > }
jwtPayload
  :: (MonadTime m, ToPrivateClaims a, Claims a ~ b, OutNs a ~ ns)
  => JwtBuilder b ns
  -> a
  -> m (Payload b ns)
jwtPayload :: JwtBuilder b ns -> a -> m (Payload b ns)
jwtPayload JwtBuilder b ns
builder a
a =
  Payload b ns -> (Payload b ns -> Payload b ns) -> Payload b ns
forall a b. a -> (a -> b) -> b
(&) Payload b ns
initial ((Payload b ns -> Payload b ns) -> Payload b ns)
-> (UTCTime -> Payload b ns -> Payload b ns)
-> UTCTime
-> Payload b ns
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Endo (Payload b ns) -> Payload b ns -> Payload b ns
forall a. Endo a -> a -> a
appEndo (Endo (Payload b ns) -> Payload b ns -> Payload b ns)
-> (UTCTime -> Endo (Payload b ns))
-> UTCTime
-> Payload b ns
-> Payload b ns
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Reader UTCTime (Endo (Payload b ns))
-> UTCTime -> Endo (Payload b ns)
forall r a. Reader r a -> r -> a
runReader (Ap (Reader UTCTime) (Endo (Payload b ns))
-> Reader UTCTime (Endo (Payload b ns))
forall k (f :: k -> *) (a :: k). Ap f a -> f a
getAp (Ap (Reader UTCTime) (Endo (Payload b ns))
 -> Reader UTCTime (Endo (Payload b ns)))
-> Ap (Reader UTCTime) (Endo (Payload b ns))
-> Reader UTCTime (Endo (Payload b ns))
forall a b. (a -> b) -> a -> b
$ JwtBuilder b ns -> Ap (Reader UTCTime) (Endo (Payload b ns))
forall (any1 :: [Claim *]) (any2 :: Namespace).
JwtBuilder any1 any2
-> Ap (Reader UTCTime) (Endo (Payload any1 any2))
steps JwtBuilder b ns
builder) (UTCTime -> Payload b ns) -> m UTCTime -> m (Payload b ns)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m UTCTime
forall (m :: * -> *). MonadTime m => m UTCTime
currentTime
  where initial :: Payload b ns
initial = Payload Empty 'NoNs
forall a. Default a => a
def { privateClaims :: PrivateClaims b ns
privateClaims = a -> PrivateClaims (Claims a) (OutNs a)
forall a.
ToPrivateClaims a =>
a -> PrivateClaims (Claims a) (OutNs a)
toPrivateClaims a
a }

step :: (Payload any1 any2 -> Payload any1 any2) -> JwtBuilder any1 any2
step :: (Payload any1 any2 -> Payload any1 any2) -> JwtBuilder any1 any2
step = Ap (Reader UTCTime) (Endo (Payload any1 any2))
-> JwtBuilder any1 any2
forall (any1 :: [Claim *]) (any2 :: Namespace).
Ap (Reader UTCTime) (Endo (Payload any1 any2))
-> JwtBuilder any1 any2
JwtBuilder (Ap (Reader UTCTime) (Endo (Payload any1 any2))
 -> JwtBuilder any1 any2)
-> ((Payload any1 any2 -> Payload any1 any2)
    -> Ap (Reader UTCTime) (Endo (Payload any1 any2)))
-> (Payload any1 any2 -> Payload any1 any2)
-> JwtBuilder any1 any2
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Reader UTCTime (Endo (Payload any1 any2))
-> Ap (Reader UTCTime) (Endo (Payload any1 any2))
forall k (f :: k -> *) (a :: k). f a -> Ap f a
Ap (Reader UTCTime (Endo (Payload any1 any2))
 -> Ap (Reader UTCTime) (Endo (Payload any1 any2)))
-> ((Payload any1 any2 -> Payload any1 any2)
    -> Reader UTCTime (Endo (Payload any1 any2)))
-> (Payload any1 any2 -> Payload any1 any2)
-> Ap (Reader UTCTime) (Endo (Payload any1 any2))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Endo (Payload any1 any2)
-> Reader UTCTime (Endo (Payload any1 any2))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Endo (Payload any1 any2)
 -> Reader UTCTime (Endo (Payload any1 any2)))
-> ((Payload any1 any2 -> Payload any1 any2)
    -> Endo (Payload any1 any2))
-> (Payload any1 any2 -> Payload any1 any2)
-> Reader UTCTime (Endo (Payload any1 any2))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Payload any1 any2 -> Payload any1 any2)
-> Endo (Payload any1 any2)
forall a. (a -> a) -> Endo a
Endo

stepWithCurrentTime
  :: (NumericDate -> Payload any1 any2 -> Payload any1 any2)
  -> JwtBuilder any1 any2
stepWithCurrentTime :: (NumericDate -> Payload any1 any2 -> Payload any1 any2)
-> JwtBuilder any1 any2
stepWithCurrentTime NumericDate -> Payload any1 any2 -> Payload any1 any2
f = Ap (Reader UTCTime) (Endo (Payload any1 any2))
-> JwtBuilder any1 any2
forall (any1 :: [Claim *]) (any2 :: Namespace).
Ap (Reader UTCTime) (Endo (Payload any1 any2))
-> JwtBuilder any1 any2
JwtBuilder (Ap (Reader UTCTime) (Endo (Payload any1 any2))
 -> JwtBuilder any1 any2)
-> (Reader UTCTime (Endo (Payload any1 any2))
    -> Ap (Reader UTCTime) (Endo (Payload any1 any2)))
-> Reader UTCTime (Endo (Payload any1 any2))
-> JwtBuilder any1 any2
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Reader UTCTime (Endo (Payload any1 any2))
-> Ap (Reader UTCTime) (Endo (Payload any1 any2))
forall k (f :: k -> *) (a :: k). f a -> Ap f a
Ap (Reader UTCTime (Endo (Payload any1 any2)) -> JwtBuilder any1 any2)
-> Reader UTCTime (Endo (Payload any1 any2))
-> JwtBuilder any1 any2
forall a b. (a -> b) -> a -> b
$ (NumericDate -> Endo (Payload any1 any2))
-> ReaderT UTCTime Identity NumericDate
-> Reader UTCTime (Endo (Payload any1 any2))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Payload any1 any2 -> Payload any1 any2)
-> Endo (Payload any1 any2)
forall a. (a -> a) -> Endo a
Endo ((Payload any1 any2 -> Payload any1 any2)
 -> Endo (Payload any1 any2))
-> (NumericDate -> Payload any1 any2 -> Payload any1 any2)
-> NumericDate
-> Endo (Payload any1 any2)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NumericDate -> Payload any1 any2 -> Payload any1 any2
f) ReaderT UTCTime Identity NumericDate
forall (m :: * -> *). MonadTime m => m NumericDate
now

-- | Set /iss/ claim
withIssuer :: String -> JwtBuilder any1 any2
withIssuer :: String -> JwtBuilder any1 any2
withIssuer String
issuer = (Payload any1 any2 -> Payload any1 any2) -> JwtBuilder any1 any2
forall (any1 :: [Claim *]) (any2 :: Namespace).
(Payload any1 any2 -> Payload any1 any2) -> JwtBuilder any1 any2
step ((Payload any1 any2 -> Payload any1 any2) -> JwtBuilder any1 any2)
-> (Payload any1 any2 -> Payload any1 any2) -> JwtBuilder any1 any2
forall a b. (a -> b) -> a -> b
$ \Payload any1 any2
p -> Payload any1 any2
p { iss :: Iss
iss = Maybe String -> Iss
Iss (Maybe String -> Iss) -> Maybe String -> Iss
forall a b. (a -> b) -> a -> b
$ String -> Maybe String
forall a. a -> Maybe a
Just String
issuer }

-- | Set /iss/ claim
issuedBy :: String -> JwtBuilder any1 any2
issuedBy :: String -> JwtBuilder any1 any2
issuedBy = String -> JwtBuilder any1 any2
forall (any1 :: [Claim *]) (any2 :: Namespace).
String -> JwtBuilder any1 any2
withIssuer

-- | Set /sub/ claim
withSubject :: String -> JwtBuilder any1 any2
withSubject :: String -> JwtBuilder any1 any2
withSubject String
subject = (Payload any1 any2 -> Payload any1 any2) -> JwtBuilder any1 any2
forall (any1 :: [Claim *]) (any2 :: Namespace).
(Payload any1 any2 -> Payload any1 any2) -> JwtBuilder any1 any2
step ((Payload any1 any2 -> Payload any1 any2) -> JwtBuilder any1 any2)
-> (Payload any1 any2 -> Payload any1 any2) -> JwtBuilder any1 any2
forall a b. (a -> b) -> a -> b
$ \Payload any1 any2
p -> Payload any1 any2
p { sub :: Sub
sub = Maybe String -> Sub
Sub (Maybe String -> Sub) -> Maybe String -> Sub
forall a b. (a -> b) -> a -> b
$ String -> Maybe String
forall a. a -> Maybe a
Just String
subject }

-- | Set /sub/ claim
issuedTo :: String -> JwtBuilder any1 any2
issuedTo :: String -> JwtBuilder any1 any2
issuedTo = String -> JwtBuilder any1 any2
forall (any1 :: [Claim *]) (any2 :: Namespace).
String -> JwtBuilder any1 any2
withSubject

-- | Append one item to /aud/ claim
withRecipient :: String -> JwtBuilder any1 any2
withRecipient :: String -> JwtBuilder any1 any2
withRecipient String
recipient = (Payload any1 any2 -> Payload any1 any2) -> JwtBuilder any1 any2
forall (any1 :: [Claim *]) (any2 :: Namespace).
(Payload any1 any2 -> Payload any1 any2) -> JwtBuilder any1 any2
step ((Payload any1 any2 -> Payload any1 any2) -> JwtBuilder any1 any2)
-> (Payload any1 any2 -> Payload any1 any2) -> JwtBuilder any1 any2
forall a b. (a -> b) -> a -> b
$ \Payload any1 any2
p -> Payload any1 any2
p { aud :: Aud
aud = [String] -> Aud
Aud [String
recipient] Aud -> Aud -> Aud
forall a. Semigroup a => a -> a -> a
<> Payload any1 any2 -> Aud
forall (pc :: [Claim *]) (ns :: Namespace). Payload pc ns -> Aud
aud Payload any1 any2
p }

-- | Append one item to /aud/ claim
intendedFor :: String -> JwtBuilder any1 any2
intendedFor :: String -> JwtBuilder any1 any2
intendedFor = String -> JwtBuilder any1 any2
forall (any1 :: [Claim *]) (any2 :: Namespace).
String -> JwtBuilder any1 any2
withRecipient

-- | Set /aud/ claim
withAudience :: [String] -> JwtBuilder any1 any2
withAudience :: [String] -> JwtBuilder any1 any2
withAudience [String]
audience = (Payload any1 any2 -> Payload any1 any2) -> JwtBuilder any1 any2
forall (any1 :: [Claim *]) (any2 :: Namespace).
(Payload any1 any2 -> Payload any1 any2) -> JwtBuilder any1 any2
step ((Payload any1 any2 -> Payload any1 any2) -> JwtBuilder any1 any2)
-> (Payload any1 any2 -> Payload any1 any2) -> JwtBuilder any1 any2
forall a b. (a -> b) -> a -> b
$ \Payload any1 any2
p -> Payload any1 any2
p { aud :: Aud
aud = [String] -> Aud
Aud [String]
audience }

-- | Set /exp/ claim
expiresAt :: UTCTime -> JwtBuilder any1 any2
expiresAt :: UTCTime -> JwtBuilder any1 any2
expiresAt UTCTime
time = (Payload any1 any2 -> Payload any1 any2) -> JwtBuilder any1 any2
forall (any1 :: [Claim *]) (any2 :: Namespace).
(Payload any1 any2 -> Payload any1 any2) -> JwtBuilder any1 any2
step ((Payload any1 any2 -> Payload any1 any2) -> JwtBuilder any1 any2)
-> (Payload any1 any2 -> Payload any1 any2) -> JwtBuilder any1 any2
forall a b. (a -> b) -> a -> b
$ \Payload any1 any2
p -> Payload any1 any2
p { exp :: Exp
exp = Maybe NumericDate -> Exp
Exp (Maybe NumericDate -> Exp) -> Maybe NumericDate -> Exp
forall a b. (a -> b) -> a -> b
$ NumericDate -> Maybe NumericDate
forall a. a -> Maybe a
Just (NumericDate -> Maybe NumericDate)
-> NumericDate -> Maybe NumericDate
forall a b. (a -> b) -> a -> b
$ UTCTime -> NumericDate
fromUTC UTCTime
time }

-- | Set /nbf/ claim
notBefore :: UTCTime -> JwtBuilder any1 any2
notBefore :: UTCTime -> JwtBuilder any1 any2
notBefore UTCTime
time = (Payload any1 any2 -> Payload any1 any2) -> JwtBuilder any1 any2
forall (any1 :: [Claim *]) (any2 :: Namespace).
(Payload any1 any2 -> Payload any1 any2) -> JwtBuilder any1 any2
step ((Payload any1 any2 -> Payload any1 any2) -> JwtBuilder any1 any2)
-> (Payload any1 any2 -> Payload any1 any2) -> JwtBuilder any1 any2
forall a b. (a -> b) -> a -> b
$ \Payload any1 any2
p -> Payload any1 any2
p { nbf :: Nbf
nbf = Maybe NumericDate -> Nbf
Nbf (Maybe NumericDate -> Nbf) -> Maybe NumericDate -> Nbf
forall a b. (a -> b) -> a -> b
$ NumericDate -> Maybe NumericDate
forall a. a -> Maybe a
Just (NumericDate -> Maybe NumericDate)
-> NumericDate -> Maybe NumericDate
forall a b. (a -> b) -> a -> b
$ UTCTime -> NumericDate
fromUTC UTCTime
time }

-- | Set /nbf/ claim to 'currentTime'
notBeforeNow :: JwtBuilder any1 any2
notBeforeNow :: JwtBuilder any1 any2
notBeforeNow = (NumericDate -> Payload any1 any2 -> Payload any1 any2)
-> JwtBuilder any1 any2
forall (any1 :: [Claim *]) (any2 :: Namespace).
(NumericDate -> Payload any1 any2 -> Payload any1 any2)
-> JwtBuilder any1 any2
stepWithCurrentTime ((NumericDate -> Payload any1 any2 -> Payload any1 any2)
 -> JwtBuilder any1 any2)
-> (NumericDate -> Payload any1 any2 -> Payload any1 any2)
-> JwtBuilder any1 any2
forall a b. (a -> b) -> a -> b
$ \NumericDate
t Payload any1 any2
p -> Payload any1 any2
p { nbf :: Nbf
nbf = Maybe NumericDate -> Nbf
Nbf (Maybe NumericDate -> Nbf) -> Maybe NumericDate -> Nbf
forall a b. (a -> b) -> a -> b
$ NumericDate -> Maybe NumericDate
forall a. a -> Maybe a
Just NumericDate
t }

-- | Set /nbf/ claim to 'currentTime' plus the argument
notUntil :: NominalDiffTime -> JwtBuilder any1 any2
notUntil :: NominalDiffTime -> JwtBuilder any1 any2
notUntil NominalDiffTime
s =
  (NumericDate -> Payload any1 any2 -> Payload any1 any2)
-> JwtBuilder any1 any2
forall (any1 :: [Claim *]) (any2 :: Namespace).
(NumericDate -> Payload any1 any2 -> Payload any1 any2)
-> JwtBuilder any1 any2
stepWithCurrentTime ((NumericDate -> Payload any1 any2 -> Payload any1 any2)
 -> JwtBuilder any1 any2)
-> (NumericDate -> Payload any1 any2 -> Payload any1 any2)
-> JwtBuilder any1 any2
forall a b. (a -> b) -> a -> b
$ \NumericDate
t Payload any1 any2
p -> Payload any1 any2
p { nbf :: Nbf
nbf = Maybe NumericDate -> Nbf
Nbf (Maybe NumericDate -> Nbf) -> Maybe NumericDate -> Nbf
forall a b. (a -> b) -> a -> b
$ NumericDate -> Maybe NumericDate
forall a. a -> Maybe a
Just (NumericDate -> Maybe NumericDate)
-> NumericDate -> Maybe NumericDate
forall a b. (a -> b) -> a -> b
$ NumericDate
t NumericDate -> NominalDiffTime -> NumericDate
`plusSeconds` NominalDiffTime
s }

-- | Set /iat/ claim to 'currentTime'
issuedNow :: JwtBuilder any1 any2
issuedNow :: JwtBuilder any1 any2
issuedNow = (NumericDate -> Payload any1 any2 -> Payload any1 any2)
-> JwtBuilder any1 any2
forall (any1 :: [Claim *]) (any2 :: Namespace).
(NumericDate -> Payload any1 any2 -> Payload any1 any2)
-> JwtBuilder any1 any2
stepWithCurrentTime ((NumericDate -> Payload any1 any2 -> Payload any1 any2)
 -> JwtBuilder any1 any2)
-> (NumericDate -> Payload any1 any2 -> Payload any1 any2)
-> JwtBuilder any1 any2
forall a b. (a -> b) -> a -> b
$ \NumericDate
t Payload any1 any2
p -> Payload any1 any2
p { iat :: Iat
iat = Maybe NumericDate -> Iat
Iat (Maybe NumericDate -> Iat) -> Maybe NumericDate -> Iat
forall a b. (a -> b) -> a -> b
$ NumericDate -> Maybe NumericDate
forall a. a -> Maybe a
Just NumericDate
t }

-- | Set /iat/ claim to 'currentTime' and /exp/ claim to 'currentTime' plus the argument
setTtl :: NominalDiffTime -> JwtBuilder any1 any2
setTtl :: NominalDiffTime -> JwtBuilder any1 any2
setTtl NominalDiffTime
ttl = JwtBuilder any1 any2
forall (any1 :: [Claim *]) (any2 :: Namespace).
JwtBuilder any1 any2
issuedNow JwtBuilder any1 any2
-> JwtBuilder any1 any2 -> JwtBuilder any1 any2
forall a. Semigroup a => a -> a -> a
<> (NumericDate -> Payload any1 any2 -> Payload any1 any2)
-> JwtBuilder any1 any2
forall (any1 :: [Claim *]) (any2 :: Namespace).
(NumericDate -> Payload any1 any2 -> Payload any1 any2)
-> JwtBuilder any1 any2
stepWithCurrentTime
  (\NumericDate
t Payload any1 any2
p -> Payload any1 any2
p { exp :: Exp
exp = Maybe NumericDate -> Exp
Exp (Maybe NumericDate -> Exp) -> Maybe NumericDate -> Exp
forall a b. (a -> b) -> a -> b
$ NumericDate -> Maybe NumericDate
forall a. a -> Maybe a
Just (NumericDate -> Maybe NumericDate)
-> NumericDate -> Maybe NumericDate
forall a b. (a -> b) -> a -> b
$ NumericDate
t NumericDate -> NominalDiffTime -> NumericDate
`plusSeconds` NominalDiffTime
ttl })

-- | Set /jti/ claim
withJwtId :: UUID -> JwtBuilder any1 any2
withJwtId :: UUID -> JwtBuilder any1 any2
withJwtId UUID
jwtId = (Payload any1 any2 -> Payload any1 any2) -> JwtBuilder any1 any2
forall (any1 :: [Claim *]) (any2 :: Namespace).
(Payload any1 any2 -> Payload any1 any2) -> JwtBuilder any1 any2
step ((Payload any1 any2 -> Payload any1 any2) -> JwtBuilder any1 any2)
-> (Payload any1 any2 -> Payload any1 any2) -> JwtBuilder any1 any2
forall a b. (a -> b) -> a -> b
$ \Payload any1 any2
p -> Payload any1 any2
p { jti :: Jti
jti = Maybe UUID -> Jti
Jti (Maybe UUID -> Jti) -> Maybe UUID -> Jti
forall a b. (a -> b) -> a -> b
$ UUID -> Maybe UUID
forall a. a -> Maybe a
Just UUID
jwtId }