{-# LANGUAGE DataKinds #-}
{-# LANGUAGE GADTs #-}

-- | PASETO token encoding and decoding in accordance with the
-- [message format](https://github.com/paseto-standard/paseto-spec/tree/af79f25908227555404e7462ccdd8ce106049469/docs#paseto-message-format)
-- defined in the specification.
module Crypto.Paseto.Token.Encoding
  ( -- * Encoding
    encode
  , encodeSomeToken

    -- * Decoding
  , CommonDecodingError (..)
  , renderCommonDecodingError
  , V3LocalDecodingError (..)
  , renderV3LocalDecodingError
  , decodeTokenV3Local
  , V3PublicDecodingError (..)
  , renderV3PublicDecodingError
  , decodeTokenV3Public
  , V4LocalDecodingError (..)
  , renderV4LocalDecodingError
  , decodeTokenV4Local
  , V4PublicDecodingError (..)
  , renderV4PublicDecodingError
  , decodeTokenV4Public

    -- * Validated token
  , ValidatedToken (..)
  ) where

import Crypto.Paseto.Keys ( SymmetricKey (..), VerificationKey (..) )
import Crypto.Paseto.Mode ( Purpose (..), Version (..) )
import qualified Crypto.Paseto.Protocol.V3 as V3
import qualified Crypto.Paseto.Protocol.V4 as V4
import Crypto.Paseto.Token
  ( Footer (..), ImplicitAssertion, Payload (..), SomeToken (..), Token (..) )
import Crypto.Paseto.Token.Claims ( Claims )
import Crypto.Paseto.Token.Parser
  ( parseTokenV3Local
  , parseTokenV3Public
  , parseTokenV4Local
  , parseTokenV4Public
  )
import Crypto.Paseto.Token.Validation
  ( ValidationError, ValidationRule, renderValidationErrors, validate )
import Data.Bifunctor ( first )
import qualified Data.ByteString.Base64.URL as B64URL
import Data.List.NonEmpty ( NonEmpty )
import Data.Text ( Text )
import qualified Data.Text as T
import Data.Text.Encoding ( decodeUtf8 )
import Prelude
import Text.Parsec ( ParseError )

-- | Encode a PASETO token as human-readable text according to the
-- [message format](https://github.com/paseto-standard/paseto-spec/tree/af79f25908227555404e7462ccdd8ce106049469/docs#paseto-message-format)
-- defined in the specification.
encode :: Token v p -> Text
encode :: forall (v :: Version) (p :: Purpose). Token v p -> Text
encode Token v p
t =
  case Token v p
t of
    TokenV3Local (Payload ByteString
payload) Maybe Footer
mbFooter ->
      ByteString -> Text
decodeUtf8 ByteString
V3.v3LocalTokenHeader
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ByteString -> Text
decodeUtf8 (ByteString -> ByteString
B64URL.encodeUnpadded ByteString
payload)
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> case Maybe Footer
mbFooter of
          Maybe Footer
Nothing -> Text
""
          Just (Footer ByteString
footer) -> Text
"." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ByteString -> Text
decodeUtf8 (ByteString -> ByteString
B64URL.encodeUnpadded ByteString
footer)
    TokenV3Public (Payload ByteString
payload) Maybe Footer
mbFooter ->
      ByteString -> Text
decodeUtf8 ByteString
V3.v3PublicTokenHeader
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ByteString -> Text
decodeUtf8 (ByteString -> ByteString
B64URL.encodeUnpadded ByteString
payload)
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> case Maybe Footer
mbFooter of
          Maybe Footer
Nothing -> Text
""
          Just (Footer ByteString
footer) -> Text
"." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ByteString -> Text
decodeUtf8 (ByteString -> ByteString
B64URL.encodeUnpadded ByteString
footer)
    TokenV4Local (Payload ByteString
payload) Maybe Footer
mbFooter ->
      ByteString -> Text
decodeUtf8 ByteString
V4.v4LocalTokenHeader
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ByteString -> Text
decodeUtf8 (ByteString -> ByteString
B64URL.encodeUnpadded ByteString
payload)
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> case Maybe Footer
mbFooter of
          Maybe Footer
Nothing -> Text
""
          Just (Footer ByteString
footer) -> Text
"." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ByteString -> Text
decodeUtf8 (ByteString -> ByteString
B64URL.encodeUnpadded ByteString
footer)
    TokenV4Public (Payload ByteString
payload) Maybe Footer
mbFooter ->
      ByteString -> Text
decodeUtf8 ByteString
V4.v4PublicTokenHeader
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ByteString -> Text
decodeUtf8 (ByteString -> ByteString
B64URL.encodeUnpadded ByteString
payload)
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> case Maybe Footer
mbFooter of
          Maybe Footer
Nothing -> Text
""
          Just (Footer ByteString
footer) -> Text
"." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ByteString -> Text
decodeUtf8 (ByteString -> ByteString
B64URL.encodeUnpadded ByteString
footer)

-- | Encode a PASETO token as human-readable text according to the
-- [message format](https://github.com/paseto-standard/paseto-spec/tree/af79f25908227555404e7462ccdd8ce106049469/docs#paseto-message-format)
-- defined in the specification.
encodeSomeToken :: SomeToken -> Text
encodeSomeToken :: SomeToken -> Text
encodeSomeToken SomeToken
t =
  case SomeToken
t of
    SomeTokenV3Local Token 'V3 'Local
x -> Token 'V3 'Local -> Text
forall (v :: Version) (p :: Purpose). Token v p -> Text
encode Token 'V3 'Local
x
    SomeTokenV3Public Token 'V3 'Public
x -> Token 'V3 'Public -> Text
forall (v :: Version) (p :: Purpose). Token v p -> Text
encode Token 'V3 'Public
x
    SomeTokenV4Local Token 'V4 'Local
x -> Token 'V4 'Local -> Text
forall (v :: Version) (p :: Purpose). Token v p -> Text
encode Token 'V4 'Local
x
    SomeTokenV4Public Token 'V4 'Public
x -> Token 'V4 'Public -> Text
forall (v :: Version) (p :: Purpose). Token v p -> Text
encode Token 'V4 'Public
x

-- | PASETO token which has been decoded and validated.
data ValidatedToken v p = ValidatedToken
  { -- | Validated token.
    forall (v :: Version) (p :: Purpose).
ValidatedToken v p -> Token v p
vtToken :: !(Token v p)
  , -- | Validated token's claims.
    forall (v :: Version) (p :: Purpose). ValidatedToken v p -> Claims
vtClaims :: !Claims
  } deriving stock (Int -> ValidatedToken v p -> ShowS
[ValidatedToken v p] -> ShowS
ValidatedToken v p -> String
(Int -> ValidatedToken v p -> ShowS)
-> (ValidatedToken v p -> String)
-> ([ValidatedToken v p] -> ShowS)
-> Show (ValidatedToken v p)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (v :: Version) (p :: Purpose).
Int -> ValidatedToken v p -> ShowS
forall (v :: Version) (p :: Purpose). [ValidatedToken v p] -> ShowS
forall (v :: Version) (p :: Purpose). ValidatedToken v p -> String
$cshowsPrec :: forall (v :: Version) (p :: Purpose).
Int -> ValidatedToken v p -> ShowS
showsPrec :: Int -> ValidatedToken v p -> ShowS
$cshow :: forall (v :: Version) (p :: Purpose). ValidatedToken v p -> String
show :: ValidatedToken v p -> String
$cshowList :: forall (v :: Version) (p :: Purpose). [ValidatedToken v p] -> ShowS
showList :: [ValidatedToken v p] -> ShowS
Show, ValidatedToken v p -> ValidatedToken v p -> Bool
(ValidatedToken v p -> ValidatedToken v p -> Bool)
-> (ValidatedToken v p -> ValidatedToken v p -> Bool)
-> Eq (ValidatedToken v p)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (v :: Version) (p :: Purpose).
ValidatedToken v p -> ValidatedToken v p -> Bool
$c== :: forall (v :: Version) (p :: Purpose).
ValidatedToken v p -> ValidatedToken v p -> Bool
== :: ValidatedToken v p -> ValidatedToken v p -> Bool
$c/= :: forall (v :: Version) (p :: Purpose).
ValidatedToken v p -> ValidatedToken v p -> Bool
/= :: ValidatedToken v p -> ValidatedToken v p -> Bool
Eq)

-- | Common error decoding a PASETO token.
data CommonDecodingError
  = -- | Error parsing the token.
    CommonDecodingParseError !ParseError
  | -- | Token claims validation error.
    CommonDecodingClaimsValidationError !(NonEmpty ValidationError)
  deriving stock (Int -> CommonDecodingError -> ShowS
[CommonDecodingError] -> ShowS
CommonDecodingError -> String
(Int -> CommonDecodingError -> ShowS)
-> (CommonDecodingError -> String)
-> ([CommonDecodingError] -> ShowS)
-> Show CommonDecodingError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CommonDecodingError -> ShowS
showsPrec :: Int -> CommonDecodingError -> ShowS
$cshow :: CommonDecodingError -> String
show :: CommonDecodingError -> String
$cshowList :: [CommonDecodingError] -> ShowS
showList :: [CommonDecodingError] -> ShowS
Show, CommonDecodingError -> CommonDecodingError -> Bool
(CommonDecodingError -> CommonDecodingError -> Bool)
-> (CommonDecodingError -> CommonDecodingError -> Bool)
-> Eq CommonDecodingError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CommonDecodingError -> CommonDecodingError -> Bool
== :: CommonDecodingError -> CommonDecodingError -> Bool
$c/= :: CommonDecodingError -> CommonDecodingError -> Bool
/= :: CommonDecodingError -> CommonDecodingError -> Bool
Eq)

-- | Render a 'CommonDecodingError' as 'Text'.
renderCommonDecodingError :: CommonDecodingError -> Text
renderCommonDecodingError :: CommonDecodingError -> Text
renderCommonDecodingError CommonDecodingError
err =
  case CommonDecodingError
err of
    CommonDecodingParseError ParseError
e -> String -> Text
T.pack (ParseError -> String
forall a. Show a => a -> String
show ParseError
e)
    CommonDecodingClaimsValidationError NonEmpty ValidationError
e -> NonEmpty ValidationError -> Text
renderValidationErrors NonEmpty ValidationError
e

assertValid :: [ValidationRule] -> Claims -> Either CommonDecodingError ()
assertValid :: [ValidationRule] -> Claims -> Either CommonDecodingError ()
assertValid [ValidationRule]
rs Claims
cs =
  case [ValidationRule] -> Claims -> Either (NonEmpty ValidationError) ()
validate [ValidationRule]
rs Claims
cs of
    Left NonEmpty ValidationError
err -> CommonDecodingError -> Either CommonDecodingError ()
forall a b. a -> Either a b
Left (NonEmpty ValidationError -> CommonDecodingError
CommonDecodingClaimsValidationError NonEmpty ValidationError
err)
    Right ()
_ -> () -> Either CommonDecodingError ()
forall a b. b -> Either a b
Right ()

-- | Error decoding a version 3 local PASETO token.
data V3LocalDecodingError
  = -- | Common decoding error.
    V3LocalDecodingCommonError !CommonDecodingError
  | -- | Decryption error.
    V3LocalDecodingDecryptionError !V3.DecryptionError
  deriving stock (Int -> V3LocalDecodingError -> ShowS
[V3LocalDecodingError] -> ShowS
V3LocalDecodingError -> String
(Int -> V3LocalDecodingError -> ShowS)
-> (V3LocalDecodingError -> String)
-> ([V3LocalDecodingError] -> ShowS)
-> Show V3LocalDecodingError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> V3LocalDecodingError -> ShowS
showsPrec :: Int -> V3LocalDecodingError -> ShowS
$cshow :: V3LocalDecodingError -> String
show :: V3LocalDecodingError -> String
$cshowList :: [V3LocalDecodingError] -> ShowS
showList :: [V3LocalDecodingError] -> ShowS
Show, V3LocalDecodingError -> V3LocalDecodingError -> Bool
(V3LocalDecodingError -> V3LocalDecodingError -> Bool)
-> (V3LocalDecodingError -> V3LocalDecodingError -> Bool)
-> Eq V3LocalDecodingError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: V3LocalDecodingError -> V3LocalDecodingError -> Bool
== :: V3LocalDecodingError -> V3LocalDecodingError -> Bool
$c/= :: V3LocalDecodingError -> V3LocalDecodingError -> Bool
/= :: V3LocalDecodingError -> V3LocalDecodingError -> Bool
Eq)

-- | Render a 'V3LocalDecodingError' as 'Text'.
renderV3LocalDecodingError :: V3LocalDecodingError -> Text
renderV3LocalDecodingError :: V3LocalDecodingError -> Text
renderV3LocalDecodingError V3LocalDecodingError
err =
  case V3LocalDecodingError
err of
    V3LocalDecodingCommonError CommonDecodingError
e -> CommonDecodingError -> Text
renderCommonDecodingError CommonDecodingError
e
    V3LocalDecodingDecryptionError DecryptionError
e -> DecryptionError -> Text
V3.renderDecryptionError DecryptionError
e

-- | Parse, 'V3.decrypt', and 'validate' a version 3 local PASETO token.
decodeTokenV3Local
  :: SymmetricKey V3
  -- ^ Symmetric key.
  -> [ValidationRule]
  -- ^ Validation rules.
  -> Maybe Footer
  -- ^ Optional footer to authenticate.
  -> Maybe ImplicitAssertion
  -- ^ Optional implicit assertion to authenticate.
  -> Text
  -- ^ Encoded PASETO token.
  -> Either V3LocalDecodingError (ValidatedToken V3 Local)
decodeTokenV3Local :: SymmetricKey 'V3
-> [ValidationRule]
-> Maybe Footer
-> Maybe ImplicitAssertion
-> Text
-> Either V3LocalDecodingError (ValidatedToken 'V3 'Local)
decodeTokenV3Local SymmetricKey 'V3
k [ValidationRule]
rs Maybe Footer
f Maybe ImplicitAssertion
i Text
t = do
  Token 'V3 'Local
parsed <-
    (ParseError -> V3LocalDecodingError)
-> Either ParseError (Token 'V3 'Local)
-> Either V3LocalDecodingError (Token 'V3 'Local)
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first
      (CommonDecodingError -> V3LocalDecodingError
V3LocalDecodingCommonError (CommonDecodingError -> V3LocalDecodingError)
-> (ParseError -> CommonDecodingError)
-> ParseError
-> V3LocalDecodingError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParseError -> CommonDecodingError
CommonDecodingParseError)
      (Text -> Either ParseError (Token 'V3 'Local)
parseTokenV3Local Text
t)
  Claims
claims <-
    case SymmetricKey 'V3
-> Token 'V3 'Local
-> Maybe Footer
-> Maybe ImplicitAssertion
-> Either DecryptionError Claims
V3.decrypt SymmetricKey 'V3
k Token 'V3 'Local
parsed Maybe Footer
f Maybe ImplicitAssertion
i of
      Left DecryptionError
err -> V3LocalDecodingError -> Either V3LocalDecodingError Claims
forall a b. a -> Either a b
Left (DecryptionError -> V3LocalDecodingError
V3LocalDecodingDecryptionError DecryptionError
err)
      Right Claims
x -> Claims -> Either V3LocalDecodingError Claims
forall a b. b -> Either a b
Right Claims
x
  (CommonDecodingError -> V3LocalDecodingError)
-> Either CommonDecodingError () -> Either V3LocalDecodingError ()
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first CommonDecodingError -> V3LocalDecodingError
V3LocalDecodingCommonError ([ValidationRule] -> Claims -> Either CommonDecodingError ()
assertValid [ValidationRule]
rs Claims
claims)
  ValidatedToken 'V3 'Local
-> Either V3LocalDecodingError (ValidatedToken 'V3 'Local)
forall a b. b -> Either a b
Right ValidatedToken
    { vtToken :: Token 'V3 'Local
vtToken = Token 'V3 'Local
parsed
    , vtClaims :: Claims
vtClaims = Claims
claims
    }

-- | Error decoding a version 3 public PASETO token.
data V3PublicDecodingError
  = -- | Common decoding error.
    V3PublicDecodingCommonError !CommonDecodingError
  | -- | Cryptographic signature verification error.
    V3PublicDecodingVerificationError !V3.VerificationError
  deriving stock (Int -> V3PublicDecodingError -> ShowS
[V3PublicDecodingError] -> ShowS
V3PublicDecodingError -> String
(Int -> V3PublicDecodingError -> ShowS)
-> (V3PublicDecodingError -> String)
-> ([V3PublicDecodingError] -> ShowS)
-> Show V3PublicDecodingError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> V3PublicDecodingError -> ShowS
showsPrec :: Int -> V3PublicDecodingError -> ShowS
$cshow :: V3PublicDecodingError -> String
show :: V3PublicDecodingError -> String
$cshowList :: [V3PublicDecodingError] -> ShowS
showList :: [V3PublicDecodingError] -> ShowS
Show, V3PublicDecodingError -> V3PublicDecodingError -> Bool
(V3PublicDecodingError -> V3PublicDecodingError -> Bool)
-> (V3PublicDecodingError -> V3PublicDecodingError -> Bool)
-> Eq V3PublicDecodingError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: V3PublicDecodingError -> V3PublicDecodingError -> Bool
== :: V3PublicDecodingError -> V3PublicDecodingError -> Bool
$c/= :: V3PublicDecodingError -> V3PublicDecodingError -> Bool
/= :: V3PublicDecodingError -> V3PublicDecodingError -> Bool
Eq)

-- | Render a 'V3PublicDecodingError' as 'Text'.
renderV3PublicDecodingError :: V3PublicDecodingError -> Text
renderV3PublicDecodingError :: V3PublicDecodingError -> Text
renderV3PublicDecodingError V3PublicDecodingError
err =
  case V3PublicDecodingError
err of
    V3PublicDecodingCommonError CommonDecodingError
e -> CommonDecodingError -> Text
renderCommonDecodingError CommonDecodingError
e
    V3PublicDecodingVerificationError VerificationError
e -> VerificationError -> Text
V3.renderVerificationError VerificationError
e

-- | Parse, 'V3.verify', and 'validate' a version 3 public PASETO token.
decodeTokenV3Public
  :: VerificationKey V3
  -- ^ Verification key.
  -> [ValidationRule]
  -- ^ Validation rules.
  -> Maybe Footer
  -- ^ Optional footer to authenticate.
  -> Maybe ImplicitAssertion
  -- ^ Optional implicit assertion to authenticate.
  -> Text
  -- ^ Encoded PASETO token.
  -> Either V3PublicDecodingError (ValidatedToken V3 Public)
decodeTokenV3Public :: VerificationKey 'V3
-> [ValidationRule]
-> Maybe Footer
-> Maybe ImplicitAssertion
-> Text
-> Either V3PublicDecodingError (ValidatedToken 'V3 'Public)
decodeTokenV3Public VerificationKey 'V3
vk [ValidationRule]
rs Maybe Footer
f Maybe ImplicitAssertion
i Text
t = do
  Token 'V3 'Public
parsed <-
    (ParseError -> V3PublicDecodingError)
-> Either ParseError (Token 'V3 'Public)
-> Either V3PublicDecodingError (Token 'V3 'Public)
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first
      (CommonDecodingError -> V3PublicDecodingError
V3PublicDecodingCommonError (CommonDecodingError -> V3PublicDecodingError)
-> (ParseError -> CommonDecodingError)
-> ParseError
-> V3PublicDecodingError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParseError -> CommonDecodingError
CommonDecodingParseError)
      (Text -> Either ParseError (Token 'V3 'Public)
parseTokenV3Public Text
t)
  Claims
claims <-
    case VerificationKey 'V3
-> Token 'V3 'Public
-> Maybe Footer
-> Maybe ImplicitAssertion
-> Either VerificationError Claims
V3.verify VerificationKey 'V3
vk Token 'V3 'Public
parsed Maybe Footer
f Maybe ImplicitAssertion
i of
      Left VerificationError
err -> V3PublicDecodingError -> Either V3PublicDecodingError Claims
forall a b. a -> Either a b
Left (VerificationError -> V3PublicDecodingError
V3PublicDecodingVerificationError VerificationError
err)
      Right Claims
x -> Claims -> Either V3PublicDecodingError Claims
forall a b. b -> Either a b
Right Claims
x
  (CommonDecodingError -> V3PublicDecodingError)
-> Either CommonDecodingError () -> Either V3PublicDecodingError ()
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first CommonDecodingError -> V3PublicDecodingError
V3PublicDecodingCommonError ([ValidationRule] -> Claims -> Either CommonDecodingError ()
assertValid [ValidationRule]
rs Claims
claims)
  ValidatedToken 'V3 'Public
-> Either V3PublicDecodingError (ValidatedToken 'V3 'Public)
forall a b. b -> Either a b
Right ValidatedToken
    { vtToken :: Token 'V3 'Public
vtToken = Token 'V3 'Public
parsed
    , vtClaims :: Claims
vtClaims = Claims
claims
    }

-- | Error decoding a version 4 local PASETO token.
data V4LocalDecodingError
  = -- | Common decoding error.
    V4LocalDecodingCommonError !CommonDecodingError
  | -- | Decryption error.
    V4LocalDecodingDecryptionError !V4.DecryptionError
  deriving stock (Int -> V4LocalDecodingError -> ShowS
[V4LocalDecodingError] -> ShowS
V4LocalDecodingError -> String
(Int -> V4LocalDecodingError -> ShowS)
-> (V4LocalDecodingError -> String)
-> ([V4LocalDecodingError] -> ShowS)
-> Show V4LocalDecodingError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> V4LocalDecodingError -> ShowS
showsPrec :: Int -> V4LocalDecodingError -> ShowS
$cshow :: V4LocalDecodingError -> String
show :: V4LocalDecodingError -> String
$cshowList :: [V4LocalDecodingError] -> ShowS
showList :: [V4LocalDecodingError] -> ShowS
Show, V4LocalDecodingError -> V4LocalDecodingError -> Bool
(V4LocalDecodingError -> V4LocalDecodingError -> Bool)
-> (V4LocalDecodingError -> V4LocalDecodingError -> Bool)
-> Eq V4LocalDecodingError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: V4LocalDecodingError -> V4LocalDecodingError -> Bool
== :: V4LocalDecodingError -> V4LocalDecodingError -> Bool
$c/= :: V4LocalDecodingError -> V4LocalDecodingError -> Bool
/= :: V4LocalDecodingError -> V4LocalDecodingError -> Bool
Eq)

-- | Render a 'V4LocalDecodingError' as 'Text'.
renderV4LocalDecodingError :: V4LocalDecodingError -> Text
renderV4LocalDecodingError :: V4LocalDecodingError -> Text
renderV4LocalDecodingError V4LocalDecodingError
err =
  case V4LocalDecodingError
err of
    V4LocalDecodingCommonError CommonDecodingError
e -> CommonDecodingError -> Text
renderCommonDecodingError CommonDecodingError
e
    V4LocalDecodingDecryptionError DecryptionError
e -> DecryptionError -> Text
V4.renderDecryptionError DecryptionError
e

-- | Parse, 'V4.decrypt', and 'validate' a version 4 local PASETO token.
decodeTokenV4Local
  :: SymmetricKey V4
  -- ^ Symmetric key.
  -> [ValidationRule]
  -- ^ Validation rules.
  -> Maybe Footer
  -- ^ Optional footer to authenticate.
  -> Maybe ImplicitAssertion
  -- ^ Optional implicit assertion to authenticate.
  -> Text
  -- ^ Encoded PASETO token.
  -> Either V4LocalDecodingError (ValidatedToken V4 Local)
decodeTokenV4Local :: SymmetricKey 'V4
-> [ValidationRule]
-> Maybe Footer
-> Maybe ImplicitAssertion
-> Text
-> Either V4LocalDecodingError (ValidatedToken 'V4 'Local)
decodeTokenV4Local SymmetricKey 'V4
k [ValidationRule]
rs Maybe Footer
f Maybe ImplicitAssertion
i Text
t = do
  Token 'V4 'Local
parsed <-
    (ParseError -> V4LocalDecodingError)
-> Either ParseError (Token 'V4 'Local)
-> Either V4LocalDecodingError (Token 'V4 'Local)
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first
      (CommonDecodingError -> V4LocalDecodingError
V4LocalDecodingCommonError (CommonDecodingError -> V4LocalDecodingError)
-> (ParseError -> CommonDecodingError)
-> ParseError
-> V4LocalDecodingError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParseError -> CommonDecodingError
CommonDecodingParseError)
      (Text -> Either ParseError (Token 'V4 'Local)
parseTokenV4Local Text
t)
  Claims
claims <-
    case SymmetricKey 'V4
-> Token 'V4 'Local
-> Maybe Footer
-> Maybe ImplicitAssertion
-> Either DecryptionError Claims
V4.decrypt SymmetricKey 'V4
k Token 'V4 'Local
parsed Maybe Footer
f Maybe ImplicitAssertion
i of
      Left DecryptionError
err -> V4LocalDecodingError -> Either V4LocalDecodingError Claims
forall a b. a -> Either a b
Left (DecryptionError -> V4LocalDecodingError
V4LocalDecodingDecryptionError DecryptionError
err)
      Right Claims
x -> Claims -> Either V4LocalDecodingError Claims
forall a b. b -> Either a b
Right Claims
x
  (CommonDecodingError -> V4LocalDecodingError)
-> Either CommonDecodingError () -> Either V4LocalDecodingError ()
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first CommonDecodingError -> V4LocalDecodingError
V4LocalDecodingCommonError ([ValidationRule] -> Claims -> Either CommonDecodingError ()
assertValid [ValidationRule]
rs Claims
claims)
  ValidatedToken 'V4 'Local
-> Either V4LocalDecodingError (ValidatedToken 'V4 'Local)
forall a b. b -> Either a b
Right ValidatedToken
    { vtToken :: Token 'V4 'Local
vtToken = Token 'V4 'Local
parsed
    , vtClaims :: Claims
vtClaims = Claims
claims
    }

-- | Error decoding a version 4 public PASETO token.
data V4PublicDecodingError
  = -- | Common decoding error.
    V4PublicDecodingCommonError !CommonDecodingError
  | -- | Cryptographic signature verification error.
    V4PublicDecodingVerificationError !V4.VerificationError
  deriving stock (Int -> V4PublicDecodingError -> ShowS
[V4PublicDecodingError] -> ShowS
V4PublicDecodingError -> String
(Int -> V4PublicDecodingError -> ShowS)
-> (V4PublicDecodingError -> String)
-> ([V4PublicDecodingError] -> ShowS)
-> Show V4PublicDecodingError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> V4PublicDecodingError -> ShowS
showsPrec :: Int -> V4PublicDecodingError -> ShowS
$cshow :: V4PublicDecodingError -> String
show :: V4PublicDecodingError -> String
$cshowList :: [V4PublicDecodingError] -> ShowS
showList :: [V4PublicDecodingError] -> ShowS
Show, V4PublicDecodingError -> V4PublicDecodingError -> Bool
(V4PublicDecodingError -> V4PublicDecodingError -> Bool)
-> (V4PublicDecodingError -> V4PublicDecodingError -> Bool)
-> Eq V4PublicDecodingError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: V4PublicDecodingError -> V4PublicDecodingError -> Bool
== :: V4PublicDecodingError -> V4PublicDecodingError -> Bool
$c/= :: V4PublicDecodingError -> V4PublicDecodingError -> Bool
/= :: V4PublicDecodingError -> V4PublicDecodingError -> Bool
Eq)

-- | Render a 'V4PublicDecodingError' as 'Text'.
renderV4PublicDecodingError :: V4PublicDecodingError -> Text
renderV4PublicDecodingError :: V4PublicDecodingError -> Text
renderV4PublicDecodingError V4PublicDecodingError
err =
  case V4PublicDecodingError
err of
    V4PublicDecodingCommonError CommonDecodingError
e -> CommonDecodingError -> Text
renderCommonDecodingError CommonDecodingError
e
    V4PublicDecodingVerificationError VerificationError
e -> VerificationError -> Text
V4.renderVerificationError VerificationError
e

-- | Parse, 'V4.verify', and 'validate' a version 4 public PASETO token.
decodeTokenV4Public
  :: VerificationKey V4
  -- ^ Verification key.
  -> [ValidationRule]
  -- ^ Validation rules.
  -> Maybe Footer
  -- ^ Optional footer to authenticate.
  -> Maybe ImplicitAssertion
  -- ^ Optional implicit assertion to authenticate.
  -> Text
  -- ^ Encoded PASETO token.
  -> Either V4PublicDecodingError (ValidatedToken V4 Public)
decodeTokenV4Public :: VerificationKey 'V4
-> [ValidationRule]
-> Maybe Footer
-> Maybe ImplicitAssertion
-> Text
-> Either V4PublicDecodingError (ValidatedToken 'V4 'Public)
decodeTokenV4Public VerificationKey 'V4
vk [ValidationRule]
rs Maybe Footer
f Maybe ImplicitAssertion
i Text
t = do
  Token 'V4 'Public
parsed <-
    (ParseError -> V4PublicDecodingError)
-> Either ParseError (Token 'V4 'Public)
-> Either V4PublicDecodingError (Token 'V4 'Public)
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first
      (CommonDecodingError -> V4PublicDecodingError
V4PublicDecodingCommonError (CommonDecodingError -> V4PublicDecodingError)
-> (ParseError -> CommonDecodingError)
-> ParseError
-> V4PublicDecodingError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParseError -> CommonDecodingError
CommonDecodingParseError)
      (Text -> Either ParseError (Token 'V4 'Public)
parseTokenV4Public Text
t)
  Claims
claims <-
    case VerificationKey 'V4
-> Token 'V4 'Public
-> Maybe Footer
-> Maybe ImplicitAssertion
-> Either VerificationError Claims
V4.verify VerificationKey 'V4
vk Token 'V4 'Public
parsed Maybe Footer
f Maybe ImplicitAssertion
i of
      Left VerificationError
err -> V4PublicDecodingError -> Either V4PublicDecodingError Claims
forall a b. a -> Either a b
Left (VerificationError -> V4PublicDecodingError
V4PublicDecodingVerificationError VerificationError
err)
      Right Claims
x -> Claims -> Either V4PublicDecodingError Claims
forall a b. b -> Either a b
Right Claims
x
  (CommonDecodingError -> V4PublicDecodingError)
-> Either CommonDecodingError () -> Either V4PublicDecodingError ()
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first CommonDecodingError -> V4PublicDecodingError
V4PublicDecodingCommonError ([ValidationRule] -> Claims -> Either CommonDecodingError ()
assertValid [ValidationRule]
rs Claims
claims)
  ValidatedToken 'V4 'Public
-> Either V4PublicDecodingError (ValidatedToken 'V4 'Public)
forall a b. b -> Either a b
Right ValidatedToken
    { vtToken :: Token 'V4 'Public
vtToken = Token 'V4 'Public
parsed
    , vtClaims :: Claims
vtClaims = Claims
claims
    }