{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE RecordWildCards #-}

module Network.QUIC.Types.Resumption where

import Codec.Serialise
import GHC.Generics
import Network.TLS hiding (Version)
import Network.TLS.QUIC

import Network.QUIC.Types.Frame
import Network.QUIC.Types.Packet

type SessionEstablish = SessionID -> SessionData -> IO (Maybe Ticket)

-- | Information about resumption
data ResumptionInfo = ResumptionInfo
    { ResumptionInfo -> Version
resumptionVersion :: Version
    , ResumptionInfo -> [(Token, SessionData)]
resumptionSession :: [(SessionID, SessionData)]
    , ResumptionInfo -> Token
resumptionToken :: Token
    , ResumptionInfo -> Bool
resumptionRetry :: Bool
    , ResumptionInfo -> Int
resumptionActiveConnectionIdLimit :: Int
    , ResumptionInfo -> Int
resumptionInitialMaxData :: Int
    , ResumptionInfo -> Int
resumptionInitialMaxStreamDataBidiLocal :: Int
    , ResumptionInfo -> Int
resumptionInitialMaxStreamDataBidiRemote :: Int
    , ResumptionInfo -> Int
resumptionInitialMaxStreamDataUni :: Int
    , ResumptionInfo -> Int
resumptionInitialMaxStreamsBidi :: Int
    , ResumptionInfo -> Int
resumptionInitialMaxStreamsUni :: Int
    }
    deriving (ResumptionInfo -> ResumptionInfo -> Bool
(ResumptionInfo -> ResumptionInfo -> Bool)
-> (ResumptionInfo -> ResumptionInfo -> Bool) -> Eq ResumptionInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ResumptionInfo -> ResumptionInfo -> Bool
== :: ResumptionInfo -> ResumptionInfo -> Bool
$c/= :: ResumptionInfo -> ResumptionInfo -> Bool
/= :: ResumptionInfo -> ResumptionInfo -> Bool
Eq, Int -> ResumptionInfo -> ShowS
[ResumptionInfo] -> ShowS
ResumptionInfo -> String
(Int -> ResumptionInfo -> ShowS)
-> (ResumptionInfo -> String)
-> ([ResumptionInfo] -> ShowS)
-> Show ResumptionInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ResumptionInfo -> ShowS
showsPrec :: Int -> ResumptionInfo -> ShowS
$cshow :: ResumptionInfo -> String
show :: ResumptionInfo -> String
$cshowList :: [ResumptionInfo] -> ShowS
showList :: [ResumptionInfo] -> ShowS
Show, (forall x. ResumptionInfo -> Rep ResumptionInfo x)
-> (forall x. Rep ResumptionInfo x -> ResumptionInfo)
-> Generic ResumptionInfo
forall x. Rep ResumptionInfo x -> ResumptionInfo
forall x. ResumptionInfo -> Rep ResumptionInfo x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ResumptionInfo -> Rep ResumptionInfo x
from :: forall x. ResumptionInfo -> Rep ResumptionInfo x
$cto :: forall x. Rep ResumptionInfo x -> ResumptionInfo
to :: forall x. Rep ResumptionInfo x -> ResumptionInfo
Generic)

instance Serialise ResumptionInfo

defaultResumptionInfo :: ResumptionInfo
defaultResumptionInfo :: ResumptionInfo
defaultResumptionInfo =
    ResumptionInfo
        { resumptionVersion :: Version
resumptionVersion = Version
Version1
        , resumptionSession :: [(Token, SessionData)]
resumptionSession = []
        , resumptionToken :: Token
resumptionToken = Token
emptyToken
        , resumptionRetry :: Bool
resumptionRetry = Bool
False
        , resumptionActiveConnectionIdLimit :: Int
resumptionActiveConnectionIdLimit = Int
2 -- see baseParameters
        , resumptionInitialMaxData :: Int
resumptionInitialMaxData = Int
0
        , resumptionInitialMaxStreamDataBidiLocal :: Int
resumptionInitialMaxStreamDataBidiLocal = Int
0
        , resumptionInitialMaxStreamDataBidiRemote :: Int
resumptionInitialMaxStreamDataBidiRemote = Int
0
        , resumptionInitialMaxStreamDataUni :: Int
resumptionInitialMaxStreamDataUni = Int
0
        , resumptionInitialMaxStreamsBidi :: Int
resumptionInitialMaxStreamsBidi = Int
0
        , resumptionInitialMaxStreamsUni :: Int
resumptionInitialMaxStreamsUni = Int
0
        }

-- | Is 0RTT possible?
is0RTTPossible :: ResumptionInfo -> Bool
is0RTTPossible :: ResumptionInfo -> Bool
is0RTTPossible ResumptionInfo{Bool
Int
[(Token, SessionData)]
Token
Version
resumptionVersion :: ResumptionInfo -> Version
resumptionSession :: ResumptionInfo -> [(Token, SessionData)]
resumptionToken :: ResumptionInfo -> Token
resumptionRetry :: ResumptionInfo -> Bool
resumptionActiveConnectionIdLimit :: ResumptionInfo -> Int
resumptionInitialMaxData :: ResumptionInfo -> Int
resumptionInitialMaxStreamDataBidiLocal :: ResumptionInfo -> Int
resumptionInitialMaxStreamDataBidiRemote :: ResumptionInfo -> Int
resumptionInitialMaxStreamDataUni :: ResumptionInfo -> Int
resumptionInitialMaxStreamsBidi :: ResumptionInfo -> Int
resumptionInitialMaxStreamsUni :: ResumptionInfo -> Int
resumptionVersion :: Version
resumptionSession :: [(Token, SessionData)]
resumptionToken :: Token
resumptionRetry :: Bool
resumptionActiveConnectionIdLimit :: Int
resumptionInitialMaxData :: Int
resumptionInitialMaxStreamDataBidiLocal :: Int
resumptionInitialMaxStreamDataBidiRemote :: Int
resumptionInitialMaxStreamDataUni :: Int
resumptionInitialMaxStreamsBidi :: Int
resumptionInitialMaxStreamsUni :: Int
..} =
    Bool
rtt0OK Bool -> Bool -> Bool
&& (Bool -> Bool
not Bool
resumptionRetry Bool -> Bool -> Bool
|| Token
resumptionToken Token -> Token -> Bool
forall a. Eq a => a -> a -> Bool
/= Token
emptyToken)
  where
    rtt0OK :: Bool
rtt0OK =
        ((Token, SessionData) -> Bool) -> [(Token, SessionData)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any
            (\(Token
_, SessionData
sd) -> SessionData -> Int
sessionMaxEarlyDataSize SessionData
sd Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
quicMaxEarlyDataSize)
            [(Token, SessionData)]
resumptionSession

-- | Is resumption possible?
isResumptionPossible :: ResumptionInfo -> Bool
isResumptionPossible :: ResumptionInfo -> Bool
isResumptionPossible ResumptionInfo{Bool
Int
[(Token, SessionData)]
Token
Version
resumptionVersion :: ResumptionInfo -> Version
resumptionSession :: ResumptionInfo -> [(Token, SessionData)]
resumptionToken :: ResumptionInfo -> Token
resumptionRetry :: ResumptionInfo -> Bool
resumptionActiveConnectionIdLimit :: ResumptionInfo -> Int
resumptionInitialMaxData :: ResumptionInfo -> Int
resumptionInitialMaxStreamDataBidiLocal :: ResumptionInfo -> Int
resumptionInitialMaxStreamDataBidiRemote :: ResumptionInfo -> Int
resumptionInitialMaxStreamDataUni :: ResumptionInfo -> Int
resumptionInitialMaxStreamsBidi :: ResumptionInfo -> Int
resumptionInitialMaxStreamsUni :: ResumptionInfo -> Int
resumptionVersion :: Version
resumptionSession :: [(Token, SessionData)]
resumptionToken :: Token
resumptionRetry :: Bool
resumptionActiveConnectionIdLimit :: Int
resumptionInitialMaxData :: Int
resumptionInitialMaxStreamDataBidiLocal :: Int
resumptionInitialMaxStreamDataBidiRemote :: Int
resumptionInitialMaxStreamDataUni :: Int
resumptionInitialMaxStreamsBidi :: Int
resumptionInitialMaxStreamsUni :: Int
..} = Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [(Token, SessionData)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Token, SessionData)]
resumptionSession