--   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 DerivingStrategies #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}

-- | Representation of registered claims
module Libjwt.RegisteredClaims
  ( Iss(..)
  , Sub(..)
  , Aud(..)
  , Exp(..)
  , Nbf(..)
  , Iat(..)
  , Jti(..)
  )
where

import           Libjwt.NumericDate
import           Libjwt.Encoding
import           Libjwt.Decoding

import           Control.Applicative            ( (<|>) )
import           Data.Coerce                    ( coerce )

import           Data.Default

import           Data.Proxy

import           Data.UUID                      ( UUID )

-- | /iss/ (Issuer) claim
newtype Iss = Iss (Maybe String)
  deriving stock (Int -> Iss -> ShowS
[Iss] -> ShowS
Iss -> String
(Int -> Iss -> ShowS)
-> (Iss -> String) -> ([Iss] -> ShowS) -> Show Iss
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Iss] -> ShowS
$cshowList :: [Iss] -> ShowS
show :: Iss -> String
$cshow :: Iss -> String
showsPrec :: Int -> Iss -> ShowS
$cshowsPrec :: Int -> Iss -> ShowS
Show, Iss -> Iss -> Bool
(Iss -> Iss -> Bool) -> (Iss -> Iss -> Bool) -> Eq Iss
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Iss -> Iss -> Bool
$c/= :: Iss -> Iss -> Bool
== :: Iss -> Iss -> Bool
$c== :: Iss -> Iss -> Bool
Eq)

-- | /sub/ (Subject) claim
newtype Sub = Sub (Maybe String)
  deriving stock (Int -> Sub -> ShowS
[Sub] -> ShowS
Sub -> String
(Int -> Sub -> ShowS)
-> (Sub -> String) -> ([Sub] -> ShowS) -> Show Sub
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Sub] -> ShowS
$cshowList :: [Sub] -> ShowS
show :: Sub -> String
$cshow :: Sub -> String
showsPrec :: Int -> Sub -> ShowS
$cshowsPrec :: Int -> Sub -> ShowS
Show, Sub -> Sub -> Bool
(Sub -> Sub -> Bool) -> (Sub -> Sub -> Bool) -> Eq Sub
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Sub -> Sub -> Bool
$c/= :: Sub -> Sub -> Bool
== :: Sub -> Sub -> Bool
$c== :: Sub -> Sub -> Bool
Eq)

-- | /aud/ (Audience) claim
newtype Aud = Aud [String]
  deriving stock (Int -> Aud -> ShowS
[Aud] -> ShowS
Aud -> String
(Int -> Aud -> ShowS)
-> (Aud -> String) -> ([Aud] -> ShowS) -> Show Aud
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Aud] -> ShowS
$cshowList :: [Aud] -> ShowS
show :: Aud -> String
$cshow :: Aud -> String
showsPrec :: Int -> Aud -> ShowS
$cshowsPrec :: Int -> Aud -> ShowS
Show, Aud -> Aud -> Bool
(Aud -> Aud -> Bool) -> (Aud -> Aud -> Bool) -> Eq Aud
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Aud -> Aud -> Bool
$c/= :: Aud -> Aud -> Bool
== :: Aud -> Aud -> Bool
$c== :: Aud -> Aud -> Bool
Eq)
  deriving newtype (b -> Aud -> Aud
NonEmpty Aud -> Aud
Aud -> Aud -> Aud
(Aud -> Aud -> Aud)
-> (NonEmpty Aud -> Aud)
-> (forall b. Integral b => b -> Aud -> Aud)
-> Semigroup Aud
forall b. Integral b => b -> Aud -> Aud
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: b -> Aud -> Aud
$cstimes :: forall b. Integral b => b -> Aud -> Aud
sconcat :: NonEmpty Aud -> Aud
$csconcat :: NonEmpty Aud -> Aud
<> :: Aud -> Aud -> Aud
$c<> :: Aud -> Aud -> Aud
Semigroup, Semigroup Aud
Aud
Semigroup Aud
-> Aud -> (Aud -> Aud -> Aud) -> ([Aud] -> Aud) -> Monoid Aud
[Aud] -> Aud
Aud -> Aud -> Aud
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
mconcat :: [Aud] -> Aud
$cmconcat :: [Aud] -> Aud
mappend :: Aud -> Aud -> Aud
$cmappend :: Aud -> Aud -> Aud
mempty :: Aud
$cmempty :: Aud
$cp1Monoid :: Semigroup Aud
Monoid)

-- | /exp/ (Expiration Time) claim
newtype Exp = Exp (Maybe NumericDate)
  deriving stock (Int -> Exp -> ShowS
[Exp] -> ShowS
Exp -> String
(Int -> Exp -> ShowS)
-> (Exp -> String) -> ([Exp] -> ShowS) -> Show Exp
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Exp] -> ShowS
$cshowList :: [Exp] -> ShowS
show :: Exp -> String
$cshow :: Exp -> String
showsPrec :: Int -> Exp -> ShowS
$cshowsPrec :: Int -> Exp -> ShowS
Show, Exp -> Exp -> Bool
(Exp -> Exp -> Bool) -> (Exp -> Exp -> Bool) -> Eq Exp
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Exp -> Exp -> Bool
$c/= :: Exp -> Exp -> Bool
== :: Exp -> Exp -> Bool
$c== :: Exp -> Exp -> Bool
Eq)

instance Ord Exp where
  Exp Maybe NumericDate
_        <= :: Exp -> Exp -> Bool
<= Exp Maybe NumericDate
Nothing  = Bool
True
  Exp Maybe NumericDate
Nothing  <= Exp Maybe NumericDate
_        = Bool
False
  Exp (Just NumericDate
a) <= Exp (Just NumericDate
b) = NumericDate
a NumericDate -> NumericDate -> Bool
forall a. Ord a => a -> a -> Bool
<= NumericDate
b

-- | /nbf/ (Not Before) claim
newtype Nbf = Nbf (Maybe NumericDate)
  deriving stock (Int -> Nbf -> ShowS
[Nbf] -> ShowS
Nbf -> String
(Int -> Nbf -> ShowS)
-> (Nbf -> String) -> ([Nbf] -> ShowS) -> Show Nbf
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Nbf] -> ShowS
$cshowList :: [Nbf] -> ShowS
show :: Nbf -> String
$cshow :: Nbf -> String
showsPrec :: Int -> Nbf -> ShowS
$cshowsPrec :: Int -> Nbf -> ShowS
Show, Nbf -> Nbf -> Bool
(Nbf -> Nbf -> Bool) -> (Nbf -> Nbf -> Bool) -> Eq Nbf
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Nbf -> Nbf -> Bool
$c/= :: Nbf -> Nbf -> Bool
== :: Nbf -> Nbf -> Bool
$c== :: Nbf -> Nbf -> Bool
Eq, Eq Nbf
Eq Nbf
-> (Nbf -> Nbf -> Ordering)
-> (Nbf -> Nbf -> Bool)
-> (Nbf -> Nbf -> Bool)
-> (Nbf -> Nbf -> Bool)
-> (Nbf -> Nbf -> Bool)
-> (Nbf -> Nbf -> Nbf)
-> (Nbf -> Nbf -> Nbf)
-> Ord Nbf
Nbf -> Nbf -> Bool
Nbf -> Nbf -> Ordering
Nbf -> Nbf -> Nbf
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Nbf -> Nbf -> Nbf
$cmin :: Nbf -> Nbf -> Nbf
max :: Nbf -> Nbf -> Nbf
$cmax :: Nbf -> Nbf -> Nbf
>= :: Nbf -> Nbf -> Bool
$c>= :: Nbf -> Nbf -> Bool
> :: Nbf -> Nbf -> Bool
$c> :: Nbf -> Nbf -> Bool
<= :: Nbf -> Nbf -> Bool
$c<= :: Nbf -> Nbf -> Bool
< :: Nbf -> Nbf -> Bool
$c< :: Nbf -> Nbf -> Bool
compare :: Nbf -> Nbf -> Ordering
$ccompare :: Nbf -> Nbf -> Ordering
$cp1Ord :: Eq Nbf
Ord)

-- | /iat/ (Issued At) claim
newtype Iat = Iat (Maybe NumericDate)
  deriving stock (Int -> Iat -> ShowS
[Iat] -> ShowS
Iat -> String
(Int -> Iat -> ShowS)
-> (Iat -> String) -> ([Iat] -> ShowS) -> Show Iat
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Iat] -> ShowS
$cshowList :: [Iat] -> ShowS
show :: Iat -> String
$cshow :: Iat -> String
showsPrec :: Int -> Iat -> ShowS
$cshowsPrec :: Int -> Iat -> ShowS
Show, Iat -> Iat -> Bool
(Iat -> Iat -> Bool) -> (Iat -> Iat -> Bool) -> Eq Iat
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Iat -> Iat -> Bool
$c/= :: Iat -> Iat -> Bool
== :: Iat -> Iat -> Bool
$c== :: Iat -> Iat -> Bool
Eq, Eq Iat
Eq Iat
-> (Iat -> Iat -> Ordering)
-> (Iat -> Iat -> Bool)
-> (Iat -> Iat -> Bool)
-> (Iat -> Iat -> Bool)
-> (Iat -> Iat -> Bool)
-> (Iat -> Iat -> Iat)
-> (Iat -> Iat -> Iat)
-> Ord Iat
Iat -> Iat -> Bool
Iat -> Iat -> Ordering
Iat -> Iat -> Iat
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Iat -> Iat -> Iat
$cmin :: Iat -> Iat -> Iat
max :: Iat -> Iat -> Iat
$cmax :: Iat -> Iat -> Iat
>= :: Iat -> Iat -> Bool
$c>= :: Iat -> Iat -> Bool
> :: Iat -> Iat -> Bool
$c> :: Iat -> Iat -> Bool
<= :: Iat -> Iat -> Bool
$c<= :: Iat -> Iat -> Bool
< :: Iat -> Iat -> Bool
$c< :: Iat -> Iat -> Bool
compare :: Iat -> Iat -> Ordering
$ccompare :: Iat -> Iat -> Ordering
$cp1Ord :: Eq Iat
Ord)

-- | /jti/ (JWT ID) claim
newtype Jti = Jti (Maybe UUID)
  deriving stock (Int -> Jti -> ShowS
[Jti] -> ShowS
Jti -> String
(Int -> Jti -> ShowS)
-> (Jti -> String) -> ([Jti] -> ShowS) -> Show Jti
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Jti] -> ShowS
$cshowList :: [Jti] -> ShowS
show :: Jti -> String
$cshow :: Jti -> String
showsPrec :: Int -> Jti -> ShowS
$cshowsPrec :: Int -> Jti -> ShowS
Show, Jti -> Jti -> Bool
(Jti -> Jti -> Bool) -> (Jti -> Jti -> Bool) -> Eq Jti
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Jti -> Jti -> Bool
$c/= :: Jti -> Jti -> Bool
== :: Jti -> Jti -> Bool
$c== :: Jti -> Jti -> Bool
Eq)

instance Encode Iss where
  encode :: Iss -> JwtT -> EncodeResult
encode (Iss Maybe String
iss) = String -> Maybe String -> JwtT -> EncodeResult
forall t. ClaimEncoder t => String -> t -> JwtT -> EncodeResult
encodeClaim String
"iss" Maybe String
iss

instance Decode Iss where
  decode :: JwtT -> JwtIO Iss
decode =
    JwtIO (Maybe String) -> JwtIO Iss
coerce (JwtIO (Maybe String) -> JwtIO Iss)
-> (JwtT -> JwtIO (Maybe String)) -> JwtT -> JwtIO Iss
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DecodeResult String -> JwtIO (Maybe String)
forall t. DecodeResult t -> JwtIO (Maybe t)
getOptional (DecodeResult String -> JwtIO (Maybe String))
-> (JwtT -> DecodeResult String) -> JwtT -> JwtIO (Maybe String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Proxy String -> JwtT -> DecodeResult String
forall t (proxy :: * -> *).
ClaimDecoder t =>
String -> proxy t -> JwtT -> DecodeResult t
decodeClaimProxied String
"iss" (Proxy String
forall k (t :: k). Proxy t
Proxy :: Proxy String)

instance Encode Sub where
  encode :: Sub -> JwtT -> EncodeResult
encode (Sub Maybe String
sub) = String -> Maybe String -> JwtT -> EncodeResult
forall t. ClaimEncoder t => String -> t -> JwtT -> EncodeResult
encodeClaim String
"sub" Maybe String
sub

instance Decode Sub where
  decode :: JwtT -> JwtIO Sub
decode =
    JwtIO (Maybe String) -> JwtIO Sub
coerce (JwtIO (Maybe String) -> JwtIO Sub)
-> (JwtT -> JwtIO (Maybe String)) -> JwtT -> JwtIO Sub
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DecodeResult String -> JwtIO (Maybe String)
forall t. DecodeResult t -> JwtIO (Maybe t)
getOptional (DecodeResult String -> JwtIO (Maybe String))
-> (JwtT -> DecodeResult String) -> JwtT -> JwtIO (Maybe String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Proxy String -> JwtT -> DecodeResult String
forall t (proxy :: * -> *).
ClaimDecoder t =>
String -> proxy t -> JwtT -> DecodeResult t
decodeClaimProxied String
"sub" (Proxy String
forall k (t :: k). Proxy t
Proxy :: Proxy String)

instance Encode Aud where
  encode :: Aud -> JwtT -> EncodeResult
encode (Aud [String]
aud) = String -> [String] -> JwtT -> EncodeResult
forall t. ClaimEncoder t => String -> t -> JwtT -> EncodeResult
encodeClaim String
"aud" [String]
aud

instance Decode Aud where
  decode :: JwtT -> JwtIO Aud
decode JwtT
jwt = JwtIO [String] -> JwtIO Aud
coerce (JwtIO [String] -> JwtIO Aud) -> JwtIO [String] -> JwtIO Aud
forall a b. (a -> b) -> a -> b
$ DecodeResult [String] -> JwtIO [String]
forall a. Monoid a => DecodeResult a -> JwtIO a
getOrEmpty (DecodeResult [String] -> JwtIO [String])
-> DecodeResult [String] -> JwtIO [String]
forall a b. (a -> b) -> a -> b
$ DecodeResult [String]
tryDecodeList DecodeResult [String]
-> DecodeResult [String] -> DecodeResult [String]
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> String -> [String]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> [String])
-> DecodeResult String -> DecodeResult [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DecodeResult String
tryDecodeSingle
   where
    tryDecodeList :: DecodeResult [String]
tryDecodeList   = String -> Proxy [String] -> JwtT -> DecodeResult [String]
forall t (proxy :: * -> *).
ClaimDecoder t =>
String -> proxy t -> JwtT -> DecodeResult t
decodeClaimProxied String
"aud" (Proxy [String]
forall k (t :: k). Proxy t
Proxy :: Proxy [String]) JwtT
jwt
    tryDecodeSingle :: DecodeResult String
tryDecodeSingle = String -> Proxy String -> JwtT -> DecodeResult String
forall t (proxy :: * -> *).
ClaimDecoder t =>
String -> proxy t -> JwtT -> DecodeResult t
decodeClaimProxied String
"aud" (Proxy String
forall k (t :: k). Proxy t
Proxy :: Proxy String) JwtT
jwt

instance Encode Exp where
  encode :: Exp -> JwtT -> EncodeResult
encode (Exp Maybe NumericDate
exp) = String -> Maybe NumericDate -> JwtT -> EncodeResult
forall t. ClaimEncoder t => String -> t -> JwtT -> EncodeResult
encodeClaim String
"exp" Maybe NumericDate
exp

instance Decode Exp where
  decode :: JwtT -> JwtIO Exp
decode =
    JwtIO (Maybe NumericDate) -> JwtIO Exp
coerce (JwtIO (Maybe NumericDate) -> JwtIO Exp)
-> (JwtT -> JwtIO (Maybe NumericDate)) -> JwtT -> JwtIO Exp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DecodeResult NumericDate -> JwtIO (Maybe NumericDate)
forall t. DecodeResult t -> JwtIO (Maybe t)
getOptional (DecodeResult NumericDate -> JwtIO (Maybe NumericDate))
-> (JwtT -> DecodeResult NumericDate)
-> JwtT
-> JwtIO (Maybe NumericDate)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Proxy NumericDate -> JwtT -> DecodeResult NumericDate
forall t (proxy :: * -> *).
ClaimDecoder t =>
String -> proxy t -> JwtT -> DecodeResult t
decodeClaimProxied String
"exp" (Proxy NumericDate
forall k (t :: k). Proxy t
Proxy :: Proxy NumericDate)

instance Encode Nbf where
  encode :: Nbf -> JwtT -> EncodeResult
encode (Nbf Maybe NumericDate
nbf) = String -> Maybe NumericDate -> JwtT -> EncodeResult
forall t. ClaimEncoder t => String -> t -> JwtT -> EncodeResult
encodeClaim String
"nbf" Maybe NumericDate
nbf

instance Decode Nbf where
  decode :: JwtT -> JwtIO Nbf
decode =
    JwtIO (Maybe NumericDate) -> JwtIO Nbf
coerce (JwtIO (Maybe NumericDate) -> JwtIO Nbf)
-> (JwtT -> JwtIO (Maybe NumericDate)) -> JwtT -> JwtIO Nbf
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DecodeResult NumericDate -> JwtIO (Maybe NumericDate)
forall t. DecodeResult t -> JwtIO (Maybe t)
getOptional (DecodeResult NumericDate -> JwtIO (Maybe NumericDate))
-> (JwtT -> DecodeResult NumericDate)
-> JwtT
-> JwtIO (Maybe NumericDate)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Proxy NumericDate -> JwtT -> DecodeResult NumericDate
forall t (proxy :: * -> *).
ClaimDecoder t =>
String -> proxy t -> JwtT -> DecodeResult t
decodeClaimProxied String
"nbf" (Proxy NumericDate
forall k (t :: k). Proxy t
Proxy :: Proxy NumericDate)

instance Encode Iat where
  encode :: Iat -> JwtT -> EncodeResult
encode (Iat Maybe NumericDate
iat) = String -> Maybe NumericDate -> JwtT -> EncodeResult
forall t. ClaimEncoder t => String -> t -> JwtT -> EncodeResult
encodeClaim String
"iat" Maybe NumericDate
iat

instance Decode Iat where
  decode :: JwtT -> JwtIO Iat
decode =
    JwtIO (Maybe NumericDate) -> JwtIO Iat
coerce (JwtIO (Maybe NumericDate) -> JwtIO Iat)
-> (JwtT -> JwtIO (Maybe NumericDate)) -> JwtT -> JwtIO Iat
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DecodeResult NumericDate -> JwtIO (Maybe NumericDate)
forall t. DecodeResult t -> JwtIO (Maybe t)
getOptional (DecodeResult NumericDate -> JwtIO (Maybe NumericDate))
-> (JwtT -> DecodeResult NumericDate)
-> JwtT
-> JwtIO (Maybe NumericDate)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Proxy NumericDate -> JwtT -> DecodeResult NumericDate
forall t (proxy :: * -> *).
ClaimDecoder t =>
String -> proxy t -> JwtT -> DecodeResult t
decodeClaimProxied String
"iat" (Proxy NumericDate
forall k (t :: k). Proxy t
Proxy :: Proxy NumericDate)

instance Encode Jti where
  encode :: Jti -> JwtT -> EncodeResult
encode (Jti Maybe UUID
jti) = String -> Maybe UUID -> JwtT -> EncodeResult
forall t. ClaimEncoder t => String -> t -> JwtT -> EncodeResult
encodeClaim String
"jti" Maybe UUID
jti

instance Decode Jti where
  decode :: JwtT -> JwtIO Jti
decode =
    JwtIO (Maybe UUID) -> JwtIO Jti
coerce (JwtIO (Maybe UUID) -> JwtIO Jti)
-> (JwtT -> JwtIO (Maybe UUID)) -> JwtT -> JwtIO Jti
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DecodeResult UUID -> JwtIO (Maybe UUID)
forall t. DecodeResult t -> JwtIO (Maybe t)
getOptional (DecodeResult UUID -> JwtIO (Maybe UUID))
-> (JwtT -> DecodeResult UUID) -> JwtT -> JwtIO (Maybe UUID)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Proxy UUID -> JwtT -> DecodeResult UUID
forall t (proxy :: * -> *).
ClaimDecoder t =>
String -> proxy t -> JwtT -> DecodeResult t
decodeClaimProxied String
"jti" (Proxy UUID
forall k (t :: k). Proxy t
Proxy :: Proxy UUID)

instance Default Iss where
  def :: Iss
def = Maybe String -> Iss
Iss Maybe String
forall a. Maybe a
Nothing

instance Default Sub where
  def :: Sub
def = Maybe String -> Sub
Sub Maybe String
forall a. Maybe a
Nothing

instance Default Exp where
  def :: Exp
def = Maybe NumericDate -> Exp
Exp Maybe NumericDate
forall a. Maybe a
Nothing

instance Default Nbf where
  def :: Nbf
def = Maybe NumericDate -> Nbf
Nbf Maybe NumericDate
forall a. Maybe a
Nothing

instance Default Iat where
  def :: Iat
def = Maybe NumericDate -> Iat
Iat Maybe NumericDate
forall a. Maybe a
Nothing

instance Default Jti where
  def :: Jti
def = Maybe UUID -> Jti
Jti Maybe UUID
forall a. Maybe a
Nothing