{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE ViewPatterns #-}

-- | PASETO token claim.
module Crypto.Paseto.Token.Claim
  ( -- * Claim value types
    Issuer (..)
  , Subject (..)
  , Audience (..)
  , Expiration (..)
  , renderExpiration
  , NotBefore (..)
  , renderNotBefore
  , IssuedAt (..)
  , renderIssuedAt
  , TokenIdentifier (..)

    -- * Claim key
  , ClaimKey
      ( IssuerClaimKey
      , SubjectClaimKey
      , AudienceClaimKey
      , ExpirationClaimKey
      , NotBeforeClaimKey
      , IssuedAtClaimKey
      , TokenIdentifierClaimKey
      , CustomClaimKey
      )
  , renderClaimKey
  , parseClaimKey
  , registeredClaimKeys
    -- ** Unregistered claim key
  , UnregisteredClaimKey
  , mkUnregisteredClaimKey
  , renderUnregisteredClaimKey

    -- * Claim
  , Claim (..)
  , claimKey
  , claimToPair
  , claimFromJson
  ) where

import Data.Aeson ( FromJSON (..), ToJSON (..) )
import qualified Data.Aeson as Aeson
import qualified Data.Aeson.Key as Aeson
import qualified Data.Aeson.Types as Aeson
import Data.Set ( Set )
import qualified Data.Set as Set
import Data.Text ( Text )
import qualified Data.Text as T
import Data.Time.Clock ( UTCTime )
import Data.Time.Format.ISO8601 ( iso8601Show )
import Prelude

------------------------------------------------------------------------------
-- Claim value types
------------------------------------------------------------------------------

-- | Issuer of a token.
newtype Issuer = Issuer
  { Issuer -> Text
unIssuer :: Text }
  deriving newtype (Int -> Issuer -> ShowS
[Issuer] -> ShowS
Issuer -> String
(Int -> Issuer -> ShowS)
-> (Issuer -> String) -> ([Issuer] -> ShowS) -> Show Issuer
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Issuer -> ShowS
showsPrec :: Int -> Issuer -> ShowS
$cshow :: Issuer -> String
show :: Issuer -> String
$cshowList :: [Issuer] -> ShowS
showList :: [Issuer] -> ShowS
Show, Issuer -> Issuer -> Bool
(Issuer -> Issuer -> Bool)
-> (Issuer -> Issuer -> Bool) -> Eq Issuer
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Issuer -> Issuer -> Bool
== :: Issuer -> Issuer -> Bool
$c/= :: Issuer -> Issuer -> Bool
/= :: Issuer -> Issuer -> Bool
Eq, [Issuer] -> Value
[Issuer] -> Encoding
Issuer -> Bool
Issuer -> Value
Issuer -> Encoding
(Issuer -> Value)
-> (Issuer -> Encoding)
-> ([Issuer] -> Value)
-> ([Issuer] -> Encoding)
-> (Issuer -> Bool)
-> ToJSON Issuer
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: Issuer -> Value
toJSON :: Issuer -> Value
$ctoEncoding :: Issuer -> Encoding
toEncoding :: Issuer -> Encoding
$ctoJSONList :: [Issuer] -> Value
toJSONList :: [Issuer] -> Value
$ctoEncodingList :: [Issuer] -> Encoding
toEncodingList :: [Issuer] -> Encoding
$comitField :: Issuer -> Bool
omitField :: Issuer -> Bool
ToJSON, Maybe Issuer
Value -> Parser [Issuer]
Value -> Parser Issuer
(Value -> Parser Issuer)
-> (Value -> Parser [Issuer]) -> Maybe Issuer -> FromJSON Issuer
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser Issuer
parseJSON :: Value -> Parser Issuer
$cparseJSONList :: Value -> Parser [Issuer]
parseJSONList :: Value -> Parser [Issuer]
$comittedField :: Maybe Issuer
omittedField :: Maybe Issuer
FromJSON)

-- | Subject of a token.
newtype Subject = Subject
  { Subject -> Text
unSubject :: Text }
  deriving newtype (Int -> Subject -> ShowS
[Subject] -> ShowS
Subject -> String
(Int -> Subject -> ShowS)
-> (Subject -> String) -> ([Subject] -> ShowS) -> Show Subject
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Subject -> ShowS
showsPrec :: Int -> Subject -> ShowS
$cshow :: Subject -> String
show :: Subject -> String
$cshowList :: [Subject] -> ShowS
showList :: [Subject] -> ShowS
Show, Subject -> Subject -> Bool
(Subject -> Subject -> Bool)
-> (Subject -> Subject -> Bool) -> Eq Subject
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Subject -> Subject -> Bool
== :: Subject -> Subject -> Bool
$c/= :: Subject -> Subject -> Bool
/= :: Subject -> Subject -> Bool
Eq, [Subject] -> Value
[Subject] -> Encoding
Subject -> Bool
Subject -> Value
Subject -> Encoding
(Subject -> Value)
-> (Subject -> Encoding)
-> ([Subject] -> Value)
-> ([Subject] -> Encoding)
-> (Subject -> Bool)
-> ToJSON Subject
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: Subject -> Value
toJSON :: Subject -> Value
$ctoEncoding :: Subject -> Encoding
toEncoding :: Subject -> Encoding
$ctoJSONList :: [Subject] -> Value
toJSONList :: [Subject] -> Value
$ctoEncodingList :: [Subject] -> Encoding
toEncodingList :: [Subject] -> Encoding
$comitField :: Subject -> Bool
omitField :: Subject -> Bool
ToJSON, Maybe Subject
Value -> Parser [Subject]
Value -> Parser Subject
(Value -> Parser Subject)
-> (Value -> Parser [Subject]) -> Maybe Subject -> FromJSON Subject
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser Subject
parseJSON :: Value -> Parser Subject
$cparseJSONList :: Value -> Parser [Subject]
parseJSONList :: Value -> Parser [Subject]
$comittedField :: Maybe Subject
omittedField :: Maybe Subject
FromJSON)

-- | Recipient for which a token is intended.
newtype Audience = Audience
  { Audience -> Text
unAudience :: Text }
  deriving newtype (Int -> Audience -> ShowS
[Audience] -> ShowS
Audience -> String
(Int -> Audience -> ShowS)
-> (Audience -> String) -> ([Audience] -> ShowS) -> Show Audience
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Audience -> ShowS
showsPrec :: Int -> Audience -> ShowS
$cshow :: Audience -> String
show :: Audience -> String
$cshowList :: [Audience] -> ShowS
showList :: [Audience] -> ShowS
Show, Audience -> Audience -> Bool
(Audience -> Audience -> Bool)
-> (Audience -> Audience -> Bool) -> Eq Audience
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Audience -> Audience -> Bool
== :: Audience -> Audience -> Bool
$c/= :: Audience -> Audience -> Bool
/= :: Audience -> Audience -> Bool
Eq, [Audience] -> Value
[Audience] -> Encoding
Audience -> Bool
Audience -> Value
Audience -> Encoding
(Audience -> Value)
-> (Audience -> Encoding)
-> ([Audience] -> Value)
-> ([Audience] -> Encoding)
-> (Audience -> Bool)
-> ToJSON Audience
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: Audience -> Value
toJSON :: Audience -> Value
$ctoEncoding :: Audience -> Encoding
toEncoding :: Audience -> Encoding
$ctoJSONList :: [Audience] -> Value
toJSONList :: [Audience] -> Value
$ctoEncodingList :: [Audience] -> Encoding
toEncodingList :: [Audience] -> Encoding
$comitField :: Audience -> Bool
omitField :: Audience -> Bool
ToJSON, Maybe Audience
Value -> Parser [Audience]
Value -> Parser Audience
(Value -> Parser Audience)
-> (Value -> Parser [Audience])
-> Maybe Audience
-> FromJSON Audience
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser Audience
parseJSON :: Value -> Parser Audience
$cparseJSONList :: Value -> Parser [Audience]
parseJSONList :: Value -> Parser [Audience]
$comittedField :: Maybe Audience
omittedField :: Maybe Audience
FromJSON)

-- | Time after which a token expires.
newtype Expiration = Expiration
  { Expiration -> UTCTime
unExpiration :: UTCTime }
  deriving newtype (Int -> Expiration -> ShowS
[Expiration] -> ShowS
Expiration -> String
(Int -> Expiration -> ShowS)
-> (Expiration -> String)
-> ([Expiration] -> ShowS)
-> Show Expiration
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Expiration -> ShowS
showsPrec :: Int -> Expiration -> ShowS
$cshow :: Expiration -> String
show :: Expiration -> String
$cshowList :: [Expiration] -> ShowS
showList :: [Expiration] -> ShowS
Show, Expiration -> Expiration -> Bool
(Expiration -> Expiration -> Bool)
-> (Expiration -> Expiration -> Bool) -> Eq Expiration
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Expiration -> Expiration -> Bool
== :: Expiration -> Expiration -> Bool
$c/= :: Expiration -> Expiration -> Bool
/= :: Expiration -> Expiration -> Bool
Eq, [Expiration] -> Value
[Expiration] -> Encoding
Expiration -> Bool
Expiration -> Value
Expiration -> Encoding
(Expiration -> Value)
-> (Expiration -> Encoding)
-> ([Expiration] -> Value)
-> ([Expiration] -> Encoding)
-> (Expiration -> Bool)
-> ToJSON Expiration
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: Expiration -> Value
toJSON :: Expiration -> Value
$ctoEncoding :: Expiration -> Encoding
toEncoding :: Expiration -> Encoding
$ctoJSONList :: [Expiration] -> Value
toJSONList :: [Expiration] -> Value
$ctoEncodingList :: [Expiration] -> Encoding
toEncodingList :: [Expiration] -> Encoding
$comitField :: Expiration -> Bool
omitField :: Expiration -> Bool
ToJSON, Maybe Expiration
Value -> Parser [Expiration]
Value -> Parser Expiration
(Value -> Parser Expiration)
-> (Value -> Parser [Expiration])
-> Maybe Expiration
-> FromJSON Expiration
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser Expiration
parseJSON :: Value -> Parser Expiration
$cparseJSONList :: Value -> Parser [Expiration]
parseJSONList :: Value -> Parser [Expiration]
$comittedField :: Maybe Expiration
omittedField :: Maybe Expiration
FromJSON)

-- | Render an 'Expiration' as 'Text'.
renderExpiration :: Expiration -> Text
renderExpiration :: Expiration -> Text
renderExpiration (Expiration UTCTime
t) = String -> Text
T.pack (UTCTime -> String
forall t. ISO8601 t => t -> String
iso8601Show UTCTime
t)

-- | Time from which a token should be considered valid.
newtype NotBefore = NotBefore
  { NotBefore -> UTCTime
unNotBefore :: UTCTime }
  deriving newtype (Int -> NotBefore -> ShowS
[NotBefore] -> ShowS
NotBefore -> String
(Int -> NotBefore -> ShowS)
-> (NotBefore -> String)
-> ([NotBefore] -> ShowS)
-> Show NotBefore
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> NotBefore -> ShowS
showsPrec :: Int -> NotBefore -> ShowS
$cshow :: NotBefore -> String
show :: NotBefore -> String
$cshowList :: [NotBefore] -> ShowS
showList :: [NotBefore] -> ShowS
Show, NotBefore -> NotBefore -> Bool
(NotBefore -> NotBefore -> Bool)
-> (NotBefore -> NotBefore -> Bool) -> Eq NotBefore
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: NotBefore -> NotBefore -> Bool
== :: NotBefore -> NotBefore -> Bool
$c/= :: NotBefore -> NotBefore -> Bool
/= :: NotBefore -> NotBefore -> Bool
Eq, [NotBefore] -> Value
[NotBefore] -> Encoding
NotBefore -> Bool
NotBefore -> Value
NotBefore -> Encoding
(NotBefore -> Value)
-> (NotBefore -> Encoding)
-> ([NotBefore] -> Value)
-> ([NotBefore] -> Encoding)
-> (NotBefore -> Bool)
-> ToJSON NotBefore
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: NotBefore -> Value
toJSON :: NotBefore -> Value
$ctoEncoding :: NotBefore -> Encoding
toEncoding :: NotBefore -> Encoding
$ctoJSONList :: [NotBefore] -> Value
toJSONList :: [NotBefore] -> Value
$ctoEncodingList :: [NotBefore] -> Encoding
toEncodingList :: [NotBefore] -> Encoding
$comitField :: NotBefore -> Bool
omitField :: NotBefore -> Bool
ToJSON, Maybe NotBefore
Value -> Parser [NotBefore]
Value -> Parser NotBefore
(Value -> Parser NotBefore)
-> (Value -> Parser [NotBefore])
-> Maybe NotBefore
-> FromJSON NotBefore
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser NotBefore
parseJSON :: Value -> Parser NotBefore
$cparseJSONList :: Value -> Parser [NotBefore]
parseJSONList :: Value -> Parser [NotBefore]
$comittedField :: Maybe NotBefore
omittedField :: Maybe NotBefore
FromJSON)

-- | Render a 'NotBefore' as 'Text'.
renderNotBefore :: NotBefore -> Text
renderNotBefore :: NotBefore -> Text
renderNotBefore (NotBefore UTCTime
t) = String -> Text
T.pack (UTCTime -> String
forall t. ISO8601 t => t -> String
iso8601Show UTCTime
t)

-- | Time at which a token was issued.
newtype IssuedAt = IssuedAt
  { IssuedAt -> UTCTime
unIssuedAt :: UTCTime }
  deriving newtype (Int -> IssuedAt -> ShowS
[IssuedAt] -> ShowS
IssuedAt -> String
(Int -> IssuedAt -> ShowS)
-> (IssuedAt -> String) -> ([IssuedAt] -> ShowS) -> Show IssuedAt
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> IssuedAt -> ShowS
showsPrec :: Int -> IssuedAt -> ShowS
$cshow :: IssuedAt -> String
show :: IssuedAt -> String
$cshowList :: [IssuedAt] -> ShowS
showList :: [IssuedAt] -> ShowS
Show, IssuedAt -> IssuedAt -> Bool
(IssuedAt -> IssuedAt -> Bool)
-> (IssuedAt -> IssuedAt -> Bool) -> Eq IssuedAt
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: IssuedAt -> IssuedAt -> Bool
== :: IssuedAt -> IssuedAt -> Bool
$c/= :: IssuedAt -> IssuedAt -> Bool
/= :: IssuedAt -> IssuedAt -> Bool
Eq, [IssuedAt] -> Value
[IssuedAt] -> Encoding
IssuedAt -> Bool
IssuedAt -> Value
IssuedAt -> Encoding
(IssuedAt -> Value)
-> (IssuedAt -> Encoding)
-> ([IssuedAt] -> Value)
-> ([IssuedAt] -> Encoding)
-> (IssuedAt -> Bool)
-> ToJSON IssuedAt
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: IssuedAt -> Value
toJSON :: IssuedAt -> Value
$ctoEncoding :: IssuedAt -> Encoding
toEncoding :: IssuedAt -> Encoding
$ctoJSONList :: [IssuedAt] -> Value
toJSONList :: [IssuedAt] -> Value
$ctoEncodingList :: [IssuedAt] -> Encoding
toEncodingList :: [IssuedAt] -> Encoding
$comitField :: IssuedAt -> Bool
omitField :: IssuedAt -> Bool
ToJSON, Maybe IssuedAt
Value -> Parser [IssuedAt]
Value -> Parser IssuedAt
(Value -> Parser IssuedAt)
-> (Value -> Parser [IssuedAt])
-> Maybe IssuedAt
-> FromJSON IssuedAt
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser IssuedAt
parseJSON :: Value -> Parser IssuedAt
$cparseJSONList :: Value -> Parser [IssuedAt]
parseJSONList :: Value -> Parser [IssuedAt]
$comittedField :: Maybe IssuedAt
omittedField :: Maybe IssuedAt
FromJSON)

-- | Render an 'IssuedAt' as 'Text'.
renderIssuedAt :: IssuedAt -> Text
renderIssuedAt :: IssuedAt -> Text
renderIssuedAt (IssuedAt UTCTime
t) = String -> Text
T.pack (UTCTime -> String
forall t. ISO8601 t => t -> String
iso8601Show UTCTime
t)

-- | Token identifier.
newtype TokenIdentifier = TokenIdentifier
  { TokenIdentifier -> Text
unTokenIdentifier :: Text }
  deriving newtype (Int -> TokenIdentifier -> ShowS
[TokenIdentifier] -> ShowS
TokenIdentifier -> String
(Int -> TokenIdentifier -> ShowS)
-> (TokenIdentifier -> String)
-> ([TokenIdentifier] -> ShowS)
-> Show TokenIdentifier
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TokenIdentifier -> ShowS
showsPrec :: Int -> TokenIdentifier -> ShowS
$cshow :: TokenIdentifier -> String
show :: TokenIdentifier -> String
$cshowList :: [TokenIdentifier] -> ShowS
showList :: [TokenIdentifier] -> ShowS
Show, TokenIdentifier -> TokenIdentifier -> Bool
(TokenIdentifier -> TokenIdentifier -> Bool)
-> (TokenIdentifier -> TokenIdentifier -> Bool)
-> Eq TokenIdentifier
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TokenIdentifier -> TokenIdentifier -> Bool
== :: TokenIdentifier -> TokenIdentifier -> Bool
$c/= :: TokenIdentifier -> TokenIdentifier -> Bool
/= :: TokenIdentifier -> TokenIdentifier -> Bool
Eq, [TokenIdentifier] -> Value
[TokenIdentifier] -> Encoding
TokenIdentifier -> Bool
TokenIdentifier -> Value
TokenIdentifier -> Encoding
(TokenIdentifier -> Value)
-> (TokenIdentifier -> Encoding)
-> ([TokenIdentifier] -> Value)
-> ([TokenIdentifier] -> Encoding)
-> (TokenIdentifier -> Bool)
-> ToJSON TokenIdentifier
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: TokenIdentifier -> Value
toJSON :: TokenIdentifier -> Value
$ctoEncoding :: TokenIdentifier -> Encoding
toEncoding :: TokenIdentifier -> Encoding
$ctoJSONList :: [TokenIdentifier] -> Value
toJSONList :: [TokenIdentifier] -> Value
$ctoEncodingList :: [TokenIdentifier] -> Encoding
toEncodingList :: [TokenIdentifier] -> Encoding
$comitField :: TokenIdentifier -> Bool
omitField :: TokenIdentifier -> Bool
ToJSON, Maybe TokenIdentifier
Value -> Parser [TokenIdentifier]
Value -> Parser TokenIdentifier
(Value -> Parser TokenIdentifier)
-> (Value -> Parser [TokenIdentifier])
-> Maybe TokenIdentifier
-> FromJSON TokenIdentifier
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser TokenIdentifier
parseJSON :: Value -> Parser TokenIdentifier
$cparseJSONList :: Value -> Parser [TokenIdentifier]
parseJSONList :: Value -> Parser [TokenIdentifier]
$comittedField :: Maybe TokenIdentifier
omittedField :: Maybe TokenIdentifier
FromJSON)

------------------------------------------------------------------------------
-- Claim key
------------------------------------------------------------------------------

-- | Token claim key.
newtype ClaimKey = MkClaimKey Text
  deriving newtype (Int -> ClaimKey -> ShowS
[ClaimKey] -> ShowS
ClaimKey -> String
(Int -> ClaimKey -> ShowS)
-> (ClaimKey -> String) -> ([ClaimKey] -> ShowS) -> Show ClaimKey
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ClaimKey -> ShowS
showsPrec :: Int -> ClaimKey -> ShowS
$cshow :: ClaimKey -> String
show :: ClaimKey -> String
$cshowList :: [ClaimKey] -> ShowS
showList :: [ClaimKey] -> ShowS
Show, ClaimKey -> ClaimKey -> Bool
(ClaimKey -> ClaimKey -> Bool)
-> (ClaimKey -> ClaimKey -> Bool) -> Eq ClaimKey
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ClaimKey -> ClaimKey -> Bool
== :: ClaimKey -> ClaimKey -> Bool
$c/= :: ClaimKey -> ClaimKey -> Bool
/= :: ClaimKey -> ClaimKey -> Bool
Eq)

instance Ord ClaimKey where
  ClaimKey
x compare :: ClaimKey -> ClaimKey -> Ordering
`compare` ClaimKey
y = ClaimKey -> Text
renderClaimKey ClaimKey
x Text -> Text -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` ClaimKey -> Text
renderClaimKey ClaimKey
y

-- | Render a 'ClaimKey' as 'Text'.
renderClaimKey :: ClaimKey -> Text
renderClaimKey :: ClaimKey -> Text
renderClaimKey (MkClaimKey Text
t) = Text
t

-- | Parse a 'ClaimKey' from 'Text'.
parseClaimKey :: Text -> ClaimKey
parseClaimKey :: Text -> ClaimKey
parseClaimKey = Text -> ClaimKey
MkClaimKey

pattern IssuerClaimKey :: ClaimKey
pattern $mIssuerClaimKey :: forall {r}. ClaimKey -> ((# #) -> r) -> ((# #) -> r) -> r
$bIssuerClaimKey :: ClaimKey
IssuerClaimKey = MkClaimKey "iss"

pattern SubjectClaimKey :: ClaimKey
pattern $mSubjectClaimKey :: forall {r}. ClaimKey -> ((# #) -> r) -> ((# #) -> r) -> r
$bSubjectClaimKey :: ClaimKey
SubjectClaimKey = MkClaimKey "sub"

pattern AudienceClaimKey :: ClaimKey
pattern $mAudienceClaimKey :: forall {r}. ClaimKey -> ((# #) -> r) -> ((# #) -> r) -> r
$bAudienceClaimKey :: ClaimKey
AudienceClaimKey = MkClaimKey "aud"

pattern ExpirationClaimKey :: ClaimKey
pattern $mExpirationClaimKey :: forall {r}. ClaimKey -> ((# #) -> r) -> ((# #) -> r) -> r
$bExpirationClaimKey :: ClaimKey
ExpirationClaimKey = MkClaimKey "exp"

pattern NotBeforeClaimKey :: ClaimKey
pattern $mNotBeforeClaimKey :: forall {r}. ClaimKey -> ((# #) -> r) -> ((# #) -> r) -> r
$bNotBeforeClaimKey :: ClaimKey
NotBeforeClaimKey = MkClaimKey "nbf"

pattern IssuedAtClaimKey :: ClaimKey
pattern $mIssuedAtClaimKey :: forall {r}. ClaimKey -> ((# #) -> r) -> ((# #) -> r) -> r
$bIssuedAtClaimKey :: ClaimKey
IssuedAtClaimKey = MkClaimKey "iat"

pattern TokenIdentifierClaimKey :: ClaimKey
pattern $mTokenIdentifierClaimKey :: forall {r}. ClaimKey -> ((# #) -> r) -> ((# #) -> r) -> r
$bTokenIdentifierClaimKey :: ClaimKey
TokenIdentifierClaimKey = MkClaimKey "jti"

pattern CustomClaimKey :: UnregisteredClaimKey -> ClaimKey
pattern $mCustomClaimKey :: forall {r}.
ClaimKey -> (UnregisteredClaimKey -> r) -> ((# #) -> r) -> r
$bCustomClaimKey :: UnregisteredClaimKey -> ClaimKey
CustomClaimKey k <- (mkUnregisteredClaimKey . renderClaimKey -> Just k) where
  CustomClaimKey (UnregisteredClaimKey Text
k) = Text -> ClaimKey
MkClaimKey Text
k

{-# COMPLETE IssuerClaimKey, SubjectClaimKey, AudienceClaimKey, ExpirationClaimKey, NotBeforeClaimKey, IssuedAtClaimKey, TokenIdentifierClaimKey, CustomClaimKey #-}

-- | Registered claims as defined by the
-- [PASETO specification](https://github.com/paseto-standard/paseto-spec/blob/af79f25908227555404e7462ccdd8ce106049469/docs/02-Implementation-Guide/04-Claims.md#registered-claims).
registeredClaimKeys :: Set ClaimKey
registeredClaimKeys :: Set ClaimKey
registeredClaimKeys =
  [ClaimKey] -> Set ClaimKey
forall a. Ord a => [a] -> Set a
Set.fromList
    [ ClaimKey
IssuerClaimKey
    , ClaimKey
SubjectClaimKey
    , ClaimKey
AudienceClaimKey
    , ClaimKey
ExpirationClaimKey
    , ClaimKey
NotBeforeClaimKey
    , ClaimKey
IssuedAtClaimKey
    , ClaimKey
TokenIdentifierClaimKey
    ]

------------------------------------------------------------------------------
-- Unregistered claim key
------------------------------------------------------------------------------

-- | Unregistered claim key.
newtype UnregisteredClaimKey = UnregisteredClaimKey Text
  deriving newtype (Int -> UnregisteredClaimKey -> ShowS
[UnregisteredClaimKey] -> ShowS
UnregisteredClaimKey -> String
(Int -> UnregisteredClaimKey -> ShowS)
-> (UnregisteredClaimKey -> String)
-> ([UnregisteredClaimKey] -> ShowS)
-> Show UnregisteredClaimKey
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> UnregisteredClaimKey -> ShowS
showsPrec :: Int -> UnregisteredClaimKey -> ShowS
$cshow :: UnregisteredClaimKey -> String
show :: UnregisteredClaimKey -> String
$cshowList :: [UnregisteredClaimKey] -> ShowS
showList :: [UnregisteredClaimKey] -> ShowS
Show, UnregisteredClaimKey -> UnregisteredClaimKey -> Bool
(UnregisteredClaimKey -> UnregisteredClaimKey -> Bool)
-> (UnregisteredClaimKey -> UnregisteredClaimKey -> Bool)
-> Eq UnregisteredClaimKey
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: UnregisteredClaimKey -> UnregisteredClaimKey -> Bool
== :: UnregisteredClaimKey -> UnregisteredClaimKey -> Bool
$c/= :: UnregisteredClaimKey -> UnregisteredClaimKey -> Bool
/= :: UnregisteredClaimKey -> UnregisteredClaimKey -> Bool
Eq)

-- | Construct an unregistered claim key.
--
-- If the provided @Text@ key matches that of a registered claim
-- ('registeredClaimKeys'), this function will return 'Nothing'.
mkUnregisteredClaimKey :: Text -> Maybe UnregisteredClaimKey
mkUnregisteredClaimKey :: Text -> Maybe UnregisteredClaimKey
mkUnregisteredClaimKey Text
t
  | ClaimKey -> Set ClaimKey -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member (Text -> ClaimKey
MkClaimKey Text
t) Set ClaimKey
registeredClaimKeys = Maybe UnregisteredClaimKey
forall a. Maybe a
Nothing
  | Bool
otherwise = UnregisteredClaimKey -> Maybe UnregisteredClaimKey
forall a. a -> Maybe a
Just (Text -> UnregisteredClaimKey
UnregisteredClaimKey Text
t)

-- | Render an 'UnregisteredClaimKey' as 'Text'.
renderUnregisteredClaimKey :: UnregisteredClaimKey -> Text
renderUnregisteredClaimKey :: UnregisteredClaimKey -> Text
renderUnregisteredClaimKey (UnregisteredClaimKey Text
t) = Text
t

------------------------------------------------------------------------------
-- Claim
------------------------------------------------------------------------------

-- | Token claim.
data Claim
  = IssuerClaim !Issuer
  | SubjectClaim !Subject
  | AudienceClaim !Audience
  | ExpirationClaim !Expiration
  | NotBeforeClaim !NotBefore
  | IssuedAtClaim !IssuedAt
  | TokenIdentifierClaim !TokenIdentifier
  | CustomClaim
      -- | Claim key.
      !UnregisteredClaimKey
      -- | Claim value.
      !Aeson.Value
  deriving stock (Int -> Claim -> ShowS
[Claim] -> ShowS
Claim -> String
(Int -> Claim -> ShowS)
-> (Claim -> String) -> ([Claim] -> ShowS) -> Show Claim
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Claim -> ShowS
showsPrec :: Int -> Claim -> ShowS
$cshow :: Claim -> String
show :: Claim -> String
$cshowList :: [Claim] -> ShowS
showList :: [Claim] -> ShowS
Show, Claim -> Claim -> Bool
(Claim -> Claim -> Bool) -> (Claim -> Claim -> Bool) -> Eq Claim
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Claim -> Claim -> Bool
== :: Claim -> Claim -> Bool
$c/= :: Claim -> Claim -> Bool
/= :: Claim -> Claim -> Bool
Eq)

-- | Get the JSON object key which corresponds to a 'Claim'.
claimKey :: Claim -> ClaimKey
claimKey :: Claim -> ClaimKey
claimKey Claim
c =
  case Claim
c of
    IssuerClaim Issuer
_ -> ClaimKey
IssuerClaimKey
    SubjectClaim Subject
_ -> ClaimKey
SubjectClaimKey
    AudienceClaim Audience
_ -> ClaimKey
AudienceClaimKey
    ExpirationClaim Expiration
_ -> ClaimKey
ExpirationClaimKey
    NotBeforeClaim NotBefore
_ -> ClaimKey
NotBeforeClaimKey
    IssuedAtClaim IssuedAt
_ -> ClaimKey
IssuedAtClaimKey
    TokenIdentifierClaim TokenIdentifier
_ -> ClaimKey
TokenIdentifierClaimKey
    CustomClaim UnregisteredClaimKey
k Value
_ -> UnregisteredClaimKey -> ClaimKey
CustomClaimKey UnregisteredClaimKey
k

claimToPair :: Claim -> Aeson.Pair
claimToPair :: Claim -> Pair
claimToPair Claim
c = (,) (Text -> Key
Aeson.fromText (Text -> Key) -> (ClaimKey -> Text) -> ClaimKey -> Key
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ClaimKey -> Text
renderClaimKey (ClaimKey -> Key) -> ClaimKey -> Key
forall a b. (a -> b) -> a -> b
$ Claim -> ClaimKey
claimKey Claim
c) (Value -> Pair) -> Value -> Pair
forall a b. (a -> b) -> a -> b
$
  case Claim
c of
    IssuerClaim Issuer
v -> Issuer -> Value
forall a. ToJSON a => a -> Value
toJSON Issuer
v
    SubjectClaim Subject
v -> Subject -> Value
forall a. ToJSON a => a -> Value
toJSON Subject
v
    AudienceClaim Audience
v -> Audience -> Value
forall a. ToJSON a => a -> Value
toJSON Audience
v
    ExpirationClaim Expiration
v -> Expiration -> Value
forall a. ToJSON a => a -> Value
toJSON Expiration
v
    NotBeforeClaim NotBefore
v -> NotBefore -> Value
forall a. ToJSON a => a -> Value
toJSON NotBefore
v
    IssuedAtClaim IssuedAt
v -> IssuedAt -> Value
forall a. ToJSON a => a -> Value
toJSON IssuedAt
v
    TokenIdentifierClaim TokenIdentifier
v -> TokenIdentifier -> Value
forall a. ToJSON a => a -> Value
toJSON TokenIdentifier
v
    CustomClaim UnregisteredClaimKey
_ Value
v -> Value
v

claimFromJson :: Aeson.Key -> Aeson.Value -> Aeson.Parser Claim
claimFromJson :: Key -> Value -> Parser Claim
claimFromJson Key
k Value
v =
  case Text -> ClaimKey
parseClaimKey (Key -> Text
Aeson.toText Key
k) of
    ClaimKey
IssuerClaimKey -> Issuer -> Claim
IssuerClaim (Issuer -> Claim) -> Parser Issuer -> Parser Claim
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser Issuer
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v
    ClaimKey
SubjectClaimKey -> Subject -> Claim
SubjectClaim (Subject -> Claim) -> Parser Subject -> Parser Claim
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser Subject
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v
    ClaimKey
AudienceClaimKey -> Audience -> Claim
AudienceClaim (Audience -> Claim) -> Parser Audience -> Parser Claim
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser Audience
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v
    ClaimKey
ExpirationClaimKey -> Expiration -> Claim
ExpirationClaim (Expiration -> Claim) -> Parser Expiration -> Parser Claim
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser Expiration
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v
    ClaimKey
NotBeforeClaimKey -> NotBefore -> Claim
NotBeforeClaim (NotBefore -> Claim) -> Parser NotBefore -> Parser Claim
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser NotBefore
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v
    ClaimKey
IssuedAtClaimKey -> IssuedAt -> Claim
IssuedAtClaim (IssuedAt -> Claim) -> Parser IssuedAt -> Parser Claim
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser IssuedAt
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v
    ClaimKey
TokenIdentifierClaimKey -> TokenIdentifier -> Claim
TokenIdentifierClaim (TokenIdentifier -> Claim)
-> Parser TokenIdentifier -> Parser Claim
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser TokenIdentifier
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v
    CustomClaimKey UnregisteredClaimKey
x -> UnregisteredClaimKey -> Value -> Claim
CustomClaim UnregisteredClaimKey
x (Value -> Claim) -> Parser Value -> Parser Claim
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser Value
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v