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

module Crypto.Paseto.Token
  ( Footer (..)

  , ImplicitAssertion (..)

  , Payload (..)

  , Token (..)
  , SomeToken (..)
  , toSomeToken
  ) where

import Crypto.Paseto.Mode ( Purpose (..), Version (..) )
import Data.ByteArray ( constEq )
import Data.ByteString ( ByteString )
import Prelude

-- | Footer consisting of unencrypted free-form data.
--
-- The footer's contents may be JSON or some other structured data, but it
-- doesn't have to be.
--
-- When a PASETO token is constructed, the footer is authenticated, but not
-- encrypted (i.e. its integrity is protected, but it is not made
-- confidential). In authenticated encryption schemes, this is referred to as
-- \"associated data\".
--
-- Note that this type's 'Eq' instance performs a constant-time equality
-- check.
newtype Footer = Footer
  { Footer -> ByteString
unFooter :: ByteString }
  deriving newtype (Int -> Footer -> ShowS
[Footer] -> ShowS
Footer -> String
(Int -> Footer -> ShowS)
-> (Footer -> String) -> ([Footer] -> ShowS) -> Show Footer
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Footer -> ShowS
showsPrec :: Int -> Footer -> ShowS
$cshow :: Footer -> String
show :: Footer -> String
$cshowList :: [Footer] -> ShowS
showList :: [Footer] -> ShowS
Show)

instance Eq Footer where
  Footer ByteString
x == :: Footer -> Footer -> Bool
== Footer ByteString
y = ByteString
x ByteString -> ByteString -> Bool
forall bs1 bs2.
(ByteArrayAccess bs1, ByteArrayAccess bs2) =>
bs1 -> bs2 -> Bool
`constEq` ByteString
y

-- | Unencrypted authenticated data which is not stored in the PASETO token.
--
-- When a PASETO token is constructed, the implicit assertion is
-- authenticated, but it is not stored in the token. This is useful if one
-- wants to associate some data that should remain confidential.
--
-- Note that this type's 'Eq' instance performs a constant-time equality
-- check.
newtype ImplicitAssertion = ImplicitAssertion
  { ImplicitAssertion -> ByteString
unImplicitAssertion :: ByteString }
  deriving newtype (Int -> ImplicitAssertion -> ShowS
[ImplicitAssertion] -> ShowS
ImplicitAssertion -> String
(Int -> ImplicitAssertion -> ShowS)
-> (ImplicitAssertion -> String)
-> ([ImplicitAssertion] -> ShowS)
-> Show ImplicitAssertion
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ImplicitAssertion -> ShowS
showsPrec :: Int -> ImplicitAssertion -> ShowS
$cshow :: ImplicitAssertion -> String
show :: ImplicitAssertion -> String
$cshowList :: [ImplicitAssertion] -> ShowS
showList :: [ImplicitAssertion] -> ShowS
Show)

instance Eq ImplicitAssertion where
  ImplicitAssertion ByteString
x == :: ImplicitAssertion -> ImplicitAssertion -> Bool
== ImplicitAssertion ByteString
y = ByteString
x ByteString -> ByteString -> Bool
forall bs1 bs2.
(ByteArrayAccess bs1, ByteArrayAccess bs2) =>
bs1 -> bs2 -> Bool
`constEq` ByteString
y

-- | Raw PASETO token payload.
--
-- Note that this type's 'Eq' instance performs a constant-time equality
-- check.
newtype Payload = Payload
  { Payload -> ByteString
unPayload :: ByteString }
  deriving newtype (Int -> Payload -> ShowS
[Payload] -> ShowS
Payload -> String
(Int -> Payload -> ShowS)
-> (Payload -> String) -> ([Payload] -> ShowS) -> Show Payload
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Payload -> ShowS
showsPrec :: Int -> Payload -> ShowS
$cshow :: Payload -> String
show :: Payload -> String
$cshowList :: [Payload] -> ShowS
showList :: [Payload] -> ShowS
Show)

instance Eq Payload where
  Payload ByteString
x == :: Payload -> Payload -> Bool
== Payload ByteString
y = ByteString
x ByteString -> ByteString -> Bool
forall bs1 bs2.
(ByteArrayAccess bs1, ByteArrayAccess bs2) =>
bs1 -> bs2 -> Bool
`constEq` ByteString
y

-- | PASETO token parameterized by its protocol 'Version' and 'Purpose'.
data Token v p where
  -- | PASETO version 3 local token.
  TokenV3Local
    :: !Payload
    -- ^ Encrypted token payload.
    -> !(Maybe Footer)
    -- ^ Optional footer (associated data).
    -> Token V3 Local

  -- | PASETO version 3 public token.
  TokenV3Public
    :: !Payload
    -- ^ Signed token payload.
    -> !(Maybe Footer)
    -- ^ Optional footer (associated data).
    -> Token V3 Public

  -- | PASETO version 4 local token.
  TokenV4Local
    :: !Payload
    -- ^ Encrypted token payload.
    -> !(Maybe Footer)
    -- ^ Optional footer (associated data).
    -> Token V4 Local

  -- | PASETO version 4 public token.
  TokenV4Public
    :: !Payload
    -- ^ Signed token payload.
    -> !(Maybe Footer)
    -- ^ Optional footer (associated data).
    -> Token V4 Public

deriving instance Show (Token v p)

instance Eq (Token v p) where
  TokenV3Local Payload
px Maybe Footer
fx == :: Token v p -> Token v p -> Bool
== TokenV3Local Payload
py Maybe Footer
fy = Payload
px Payload -> Payload -> Bool
forall a. Eq a => a -> a -> Bool
== Payload
py Bool -> Bool -> Bool
&& Maybe Footer
fx Maybe Footer -> Maybe Footer -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe Footer
fy
  TokenV3Public Payload
px Maybe Footer
fx == TokenV3Public Payload
py Maybe Footer
fy = Payload
px Payload -> Payload -> Bool
forall a. Eq a => a -> a -> Bool
== Payload
py Bool -> Bool -> Bool
&& Maybe Footer
fx Maybe Footer -> Maybe Footer -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe Footer
fy
  TokenV4Local Payload
px Maybe Footer
fx == TokenV4Local Payload
py Maybe Footer
fy = Payload
px Payload -> Payload -> Bool
forall a. Eq a => a -> a -> Bool
== Payload
py Bool -> Bool -> Bool
&& Maybe Footer
fx Maybe Footer -> Maybe Footer -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe Footer
fy
  TokenV4Public Payload
px Maybe Footer
fx == TokenV4Public Payload
py Maybe Footer
fy = Payload
px Payload -> Payload -> Bool
forall a. Eq a => a -> a -> Bool
== Payload
py Bool -> Bool -> Bool
&& Maybe Footer
fx Maybe Footer -> Maybe Footer -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe Footer
fy

-- | Some kind of PASETO token.
data SomeToken
  = SomeTokenV3Local !(Token V3 Local)
  | SomeTokenV3Public !(Token V3 Public)
  | SomeTokenV4Local !(Token V4 Local)
  | SomeTokenV4Public !(Token V4 Public)
  deriving stock (Int -> SomeToken -> ShowS
[SomeToken] -> ShowS
SomeToken -> String
(Int -> SomeToken -> ShowS)
-> (SomeToken -> String)
-> ([SomeToken] -> ShowS)
-> Show SomeToken
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SomeToken -> ShowS
showsPrec :: Int -> SomeToken -> ShowS
$cshow :: SomeToken -> String
show :: SomeToken -> String
$cshowList :: [SomeToken] -> ShowS
showList :: [SomeToken] -> ShowS
Show, SomeToken -> SomeToken -> Bool
(SomeToken -> SomeToken -> Bool)
-> (SomeToken -> SomeToken -> Bool) -> Eq SomeToken
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SomeToken -> SomeToken -> Bool
== :: SomeToken -> SomeToken -> Bool
$c/= :: SomeToken -> SomeToken -> Bool
/= :: SomeToken -> SomeToken -> Bool
Eq)

-- | Convert a 'Token' to a 'SomeToken'.
toSomeToken :: Token v p -> SomeToken
toSomeToken :: forall (v :: Version) (p :: Purpose). Token v p -> SomeToken
toSomeToken Token v p
t =
  case Token v p
t of
    TokenV3Local Payload
_ Maybe Footer
_ -> Token 'V3 'Local -> SomeToken
SomeTokenV3Local Token v p
Token 'V3 'Local
t
    TokenV3Public Payload
_ Maybe Footer
_ -> Token 'V3 'Public -> SomeToken
SomeTokenV3Public Token v p
Token 'V3 'Public
t
    TokenV4Local Payload
_ Maybe Footer
_ -> Token 'V4 'Local -> SomeToken
SomeTokenV4Local Token v p
Token 'V4 'Local
t
    TokenV4Public Payload
_ Maybe Footer
_ -> Token 'V4 'Public -> SomeToken
SomeTokenV4Public Token v p
Token 'V4 'Public
t