{-# LANGUAGE DeriveGeneric #-}
{-# OPTIONS_GHC -Wno-orphans #-}

module Network.QUIC.Packet.Token (
    CryptoToken (..),
    isRetryToken,
    generateToken,
    generateRetryToken,
    encryptToken,
    decryptToken,
) where

import Codec.Serialise
import qualified Crypto.Token as CT
import qualified Data.ByteString.Lazy as BL
import Data.UnixTime
import GHC.Generics

import Network.QUIC.Imports
import Network.QUIC.Types

----------------------------------------------------------------

data CryptoToken = CryptoToken
    { CryptoToken -> Version
tokenQUICVersion :: Version
    , CryptoToken -> Word32
tokenLifeTime :: Word32
    , CryptoToken -> TimeMicrosecond
tokenCreatedTime :: TimeMicrosecond
    , CryptoToken -> Maybe (CID, CID, CID)
tokenCIDs :: Maybe (CID, CID, CID) -- local, remote, orig local
    }
    deriving ((forall x. CryptoToken -> Rep CryptoToken x)
-> (forall x. Rep CryptoToken x -> CryptoToken)
-> Generic CryptoToken
forall x. Rep CryptoToken x -> CryptoToken
forall x. CryptoToken -> Rep CryptoToken x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. CryptoToken -> Rep CryptoToken x
from :: forall x. CryptoToken -> Rep CryptoToken x
$cto :: forall x. Rep CryptoToken x -> CryptoToken
to :: forall x. Rep CryptoToken x -> CryptoToken
Generic)

instance Serialise UnixTime
instance Serialise CryptoToken

isRetryToken :: CryptoToken -> Bool
isRetryToken :: CryptoToken -> Bool
isRetryToken CryptoToken
token = Maybe (CID, CID, CID) -> Bool
forall a. Maybe a -> Bool
isJust (Maybe (CID, CID, CID) -> Bool) -> Maybe (CID, CID, CID) -> Bool
forall a b. (a -> b) -> a -> b
$ CryptoToken -> Maybe (CID, CID, CID)
tokenCIDs CryptoToken
token

----------------------------------------------------------------

generateToken :: Version -> Int -> IO CryptoToken
generateToken :: Version -> Int -> IO CryptoToken
generateToken Version
ver Int
life = do
    TimeMicrosecond
t <- IO TimeMicrosecond
getTimeMicrosecond
    CryptoToken -> IO CryptoToken
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (CryptoToken -> IO CryptoToken) -> CryptoToken -> IO CryptoToken
forall a b. (a -> b) -> a -> b
$ Version
-> Word32
-> TimeMicrosecond
-> Maybe (CID, CID, CID)
-> CryptoToken
CryptoToken Version
ver (Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
life) TimeMicrosecond
t Maybe (CID, CID, CID)
forall a. Maybe a
Nothing

generateRetryToken :: Version -> Int -> CID -> CID -> CID -> IO CryptoToken
generateRetryToken :: Version -> Int -> CID -> CID -> CID -> IO CryptoToken
generateRetryToken Version
ver Int
life CID
l CID
r CID
o = do
    TimeMicrosecond
t <- IO TimeMicrosecond
getTimeMicrosecond
    CryptoToken -> IO CryptoToken
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (CryptoToken -> IO CryptoToken) -> CryptoToken -> IO CryptoToken
forall a b. (a -> b) -> a -> b
$ Version
-> Word32
-> TimeMicrosecond
-> Maybe (CID, CID, CID)
-> CryptoToken
CryptoToken Version
ver (Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
life) TimeMicrosecond
t (Maybe (CID, CID, CID) -> CryptoToken)
-> Maybe (CID, CID, CID) -> CryptoToken
forall a b. (a -> b) -> a -> b
$ (CID, CID, CID) -> Maybe (CID, CID, CID)
forall a. a -> Maybe a
Just (CID
l, CID
r, CID
o)

----------------------------------------------------------------

encryptToken :: CT.TokenManager -> CryptoToken -> IO Token
encryptToken :: TokenManager -> CryptoToken -> IO Token
encryptToken TokenManager
mgr CryptoToken
ct = TokenManager -> Token -> IO Token
CT.encryptToken TokenManager
mgr (CryptoToken -> Token
encodeCryptoToken CryptoToken
ct)

decryptToken :: CT.TokenManager -> Token -> IO (Maybe CryptoToken)
decryptToken :: TokenManager -> Token -> IO (Maybe CryptoToken)
decryptToken TokenManager
mgr Token
token =
    (Maybe Token -> (Token -> Maybe CryptoToken) -> Maybe CryptoToken
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Token -> Maybe CryptoToken
decodeCryptoToken) (Maybe Token -> Maybe CryptoToken)
-> IO (Maybe Token) -> IO (Maybe CryptoToken)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TokenManager -> Token -> IO (Maybe Token)
CT.decryptToken TokenManager
mgr Token
token

----------------------------------------------------------------

encodeCryptoToken :: CryptoToken -> Token
encodeCryptoToken :: CryptoToken -> Token
encodeCryptoToken = ByteString -> Token
BL.toStrict (ByteString -> Token)
-> (CryptoToken -> ByteString) -> CryptoToken -> Token
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CryptoToken -> ByteString
forall a. Serialise a => a -> ByteString
serialise

decodeCryptoToken :: Token -> Maybe CryptoToken
decodeCryptoToken :: Token -> Maybe CryptoToken
decodeCryptoToken Token
token = case ByteString -> Either DeserialiseFailure CryptoToken
forall a. Serialise a => ByteString -> Either DeserialiseFailure a
deserialiseOrFail (Token -> ByteString
BL.fromStrict Token
token) of
    Left DeserialiseFailure{} -> Maybe CryptoToken
forall a. Maybe a
Nothing
    Right CryptoToken
x -> CryptoToken -> Maybe CryptoToken
forall a. a -> Maybe a
Just CryptoToken
x