{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE StrictData #-}

module Network.QUIC.Connection.Types where

import Control.Concurrent
import Control.Concurrent.STM
import qualified Crypto.Token as CT
import Data.Array.IO
import Data.ByteString.Internal
import Data.IntMap.Strict (IntMap)
import qualified Data.IntMap.Strict as IntMap
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.X509 (CertificateChain)
import Foreign.Marshal.Alloc
import Foreign.Ptr (nullPtr)
import Network.Control (
    Rate,
    RxFlow,
    TxFlow,
    newRate,
    newRxFlow,
    newTxFlow,
 )
import Network.Socket (SockAddr, Socket)
import Network.TLS.QUIC
import System.Mem.Weak (Weak)

import Network.QUIC.Config
import Network.QUIC.Connector
import Network.QUIC.Crypto
import Network.QUIC.Imports
import Network.QUIC.Logger
import Network.QUIC.Parameters
import Network.QUIC.Qlog
import Network.QUIC.Recovery
import Network.QUIC.Stream
import Network.QUIC.Types

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

dummySecrets :: TrafficSecrets a
dummySecrets :: forall a. TrafficSecrets a
dummySecrets = (ByteString -> ClientTrafficSecret a
forall a. ByteString -> ClientTrafficSecret a
ClientTrafficSecret ByteString
"", ByteString -> ServerTrafficSecret a
forall a. ByteString -> ServerTrafficSecret a
ServerTrafficSecret ByteString
"")

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

data RoleInfo
    = ClientInfo
        { RoleInfo -> ByteString
clientInitialToken :: Token -- new or retry token
        , RoleInfo -> ResumptionInfo
resumptionInfo :: ResumptionInfo
        , RoleInfo -> Bool
incompatibleVN :: Bool
        , RoleInfo -> Bool
sockConnected :: Bool
        }
    | ServerInfo
        { RoleInfo -> TokenManager
tokenManager :: ~CT.TokenManager
        , RoleInfo -> CID -> Connection -> IO ()
registerCID :: CID -> Connection -> IO ()
        , RoleInfo -> CID -> IO ()
unregisterCID :: CID -> IO ()
        , RoleInfo -> Bool
askRetry :: Bool
        , RoleInfo -> IO ()
stopServer :: IO ()
        , RoleInfo -> Maybe CertificateChain
certChain :: Maybe CertificateChain
        }

defaultClientRoleInfo :: RoleInfo
defaultClientRoleInfo :: RoleInfo
defaultClientRoleInfo =
    ClientInfo
        { clientInitialToken :: ByteString
clientInitialToken = ByteString
emptyToken
        , resumptionInfo :: ResumptionInfo
resumptionInfo = ResumptionInfo
defaultResumptionInfo
        , incompatibleVN :: Bool
incompatibleVN = Bool
False
        , sockConnected :: Bool
sockConnected = Bool
False
        }

defaultServerRoleInfo :: RoleInfo
defaultServerRoleInfo :: RoleInfo
defaultServerRoleInfo =
    ServerInfo
        { tokenManager :: TokenManager
tokenManager = TokenManager
forall a. HasCallStack => a
undefined
        , registerCID :: CID -> Connection -> IO ()
registerCID = \CID
_ Connection
_ -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        , unregisterCID :: CID -> IO ()
unregisterCID = \CID
_ -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        , askRetry :: Bool
askRetry = Bool
False
        , stopServer :: IO ()
stopServer = () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        , certChain :: Maybe CertificateChain
certChain = Maybe CertificateChain
forall a. Maybe a
Nothing
        }

-- cidInfoSRT in CIDInfo is only used in client
-- which accepts stateless reset.
data CIDDB = CIDDB
    { CIDDB -> CIDInfo
usedCIDInfo :: CIDInfo
    , CIDDB -> IntMap CIDInfo
cidInfos :: IntMap CIDInfo
    , CIDDB -> Map CID Int
revInfos :: Map CID Int
    , CIDDB -> Int
nextSeqNum :: Int -- only for mine (new)
    , CIDDB -> Int
retirePriorTo :: Int
    , CIDDB -> Bool
triggeredByMe :: Bool -- only for peer's
    }
    deriving (Int -> CIDDB -> ShowS
[CIDDB] -> ShowS
CIDDB -> String
(Int -> CIDDB -> ShowS)
-> (CIDDB -> String) -> ([CIDDB] -> ShowS) -> Show CIDDB
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CIDDB -> ShowS
showsPrec :: Int -> CIDDB -> ShowS
$cshow :: CIDDB -> String
show :: CIDDB -> String
$cshowList :: [CIDDB] -> ShowS
showList :: [CIDDB] -> ShowS
Show)

newCIDDB :: CID -> CIDDB
newCIDDB :: CID -> CIDDB
newCIDDB CID
cid =
    CIDDB
        { usedCIDInfo :: CIDInfo
usedCIDInfo = CIDInfo
cidInfo
        , cidInfos :: IntMap CIDInfo
cidInfos = Int -> CIDInfo -> IntMap CIDInfo
forall a. Int -> a -> IntMap a
IntMap.singleton Int
0 CIDInfo
cidInfo
        , revInfos :: Map CID Int
revInfos = CID -> Int -> Map CID Int
forall k a. k -> a -> Map k a
Map.singleton CID
cid Int
0
        , nextSeqNum :: Int
nextSeqNum = Int
1
        , retirePriorTo :: Int
retirePriorTo = Int
1
        , triggeredByMe :: Bool
triggeredByMe = Bool
False
        }
  where
    cidInfo :: CIDInfo
cidInfo = Int -> CID -> StatelessResetToken -> CIDInfo
newCIDInfo Int
0 CID
cid (StatelessResetToken -> CIDInfo) -> StatelessResetToken -> CIDInfo
forall a b. (a -> b) -> a -> b
$ Bytes -> StatelessResetToken
StatelessResetToken Bytes
""

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

data MigrationState
    = NonMigration
    | MigrationStarted
    | SendChallenge PathInfo PathData
    | RecvResponse

{- FOURMOLU_DISABLE -}
instance Eq MigrationState where
    MigrationState
NonMigration     == :: MigrationState -> MigrationState -> Bool
== MigrationState
NonMigration     = Bool
True
    MigrationState
MigrationStarted == MigrationState
MigrationStarted = Bool
True
    MigrationState
RecvResponse     == MigrationState
RecvResponse     = Bool
True
    MigrationState
_                == MigrationState
_                = Bool
False
{- FOURMOLU_ENABLE -}

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

data Coder = Coder
    { Coder -> Buffer -> ByteString -> AssDat -> Int -> IO Int
encrypt :: Buffer -> PlainText -> AssDat -> PacketNumber -> IO Int
    , Coder -> Buffer -> ByteString -> AssDat -> Int -> IO Int
decrypt :: Buffer -> CipherText -> AssDat -> PacketNumber -> IO Int
    , Coder -> Maybe Supplement
supplement :: Maybe Supplement
    }

initialCoder :: Coder
initialCoder :: Coder
initialCoder =
    Coder
        { encrypt :: Buffer -> ByteString -> AssDat -> Int -> IO Int
encrypt = \Buffer
_ ByteString
_ AssDat
_ Int
_ -> Int -> IO Int
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (-Int
1)
        , decrypt :: Buffer -> ByteString -> AssDat -> Int -> IO Int
decrypt = \Buffer
_ ByteString
_ AssDat
_ Int
_ -> Int -> IO Int
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (-Int
1)
        , supplement :: Maybe Supplement
supplement = Maybe Supplement
forall a. Maybe a
Nothing
        }

data Coder1RTT = Coder1RTT
    { Coder1RTT -> Coder
coder1RTT :: Coder
    , Coder1RTT -> TrafficSecrets ApplicationSecret
secretN :: TrafficSecrets ApplicationSecret
    }

initialCoder1RTT :: Coder1RTT
initialCoder1RTT :: Coder1RTT
initialCoder1RTT =
    Coder1RTT
        { coder1RTT :: Coder
coder1RTT = Coder
initialCoder
        , secretN :: TrafficSecrets ApplicationSecret
secretN = (ByteString -> ClientTrafficSecret ApplicationSecret
forall a. ByteString -> ClientTrafficSecret a
ClientTrafficSecret ByteString
"", ByteString -> ServerTrafficSecret ApplicationSecret
forall a. ByteString -> ServerTrafficSecret a
ServerTrafficSecret ByteString
"")
        }

data Protector = Protector
    { Protector -> Buffer -> IO ()
setSample :: Buffer -> IO ()
    , Protector -> IO Buffer
getMask :: IO Buffer
    , Protector -> Sample -> Mask
unprotect :: Sample -> Mask
    }

initialProtector :: Protector
initialProtector :: Protector
initialProtector =
    Protector
        { setSample :: Buffer -> IO ()
setSample = \Buffer
_ -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        , getMask :: IO Buffer
getMask = Buffer -> IO Buffer
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Buffer
forall a. Ptr a
nullPtr
        , unprotect :: Sample -> Mask
unprotect = \Sample
_ -> ByteString -> Mask
Mask ByteString
""
        }

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

data Negotiated = Negotiated
    { Negotiated -> HandshakeMode13
tlsHandshakeMode :: HandshakeMode13
    , Negotiated -> Maybe ByteString
applicationProtocol :: Maybe NegotiatedProtocol
    , Negotiated -> ApplicationSecretInfo
applicationSecretInfo :: ApplicationSecretInfo
    }

initialNegotiated :: Negotiated
initialNegotiated :: Negotiated
initialNegotiated =
    Negotiated
        { tlsHandshakeMode :: HandshakeMode13
tlsHandshakeMode = HandshakeMode13
FullHandshake
        , applicationProtocol :: Maybe ByteString
applicationProtocol = Maybe ByteString
forall a. Maybe a
Nothing
        , applicationSecretInfo :: ApplicationSecretInfo
applicationSecretInfo = TrafficSecrets ApplicationSecret -> ApplicationSecretInfo
ApplicationSecretInfo TrafficSecrets ApplicationSecret
forall a. TrafficSecrets a
defaultTrafficSecrets
        }

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

newtype StreamIdBase = StreamIdBase {StreamIdBase -> Int
fromStreamIdBase :: Int}
    deriving (StreamIdBase -> StreamIdBase -> Bool
(StreamIdBase -> StreamIdBase -> Bool)
-> (StreamIdBase -> StreamIdBase -> Bool) -> Eq StreamIdBase
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: StreamIdBase -> StreamIdBase -> Bool
== :: StreamIdBase -> StreamIdBase -> Bool
$c/= :: StreamIdBase -> StreamIdBase -> Bool
/= :: StreamIdBase -> StreamIdBase -> Bool
Eq, Int -> StreamIdBase -> ShowS
[StreamIdBase] -> ShowS
StreamIdBase -> String
(Int -> StreamIdBase -> ShowS)
-> (StreamIdBase -> String)
-> ([StreamIdBase] -> ShowS)
-> Show StreamIdBase
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> StreamIdBase -> ShowS
showsPrec :: Int -> StreamIdBase -> ShowS
$cshow :: StreamIdBase -> String
show :: StreamIdBase -> String
$cshowList :: [StreamIdBase] -> ShowS
showList :: [StreamIdBase] -> ShowS
Show)

data Concurrency = Concurrency
    { Concurrency -> Int
currentStream :: StreamId
    , Concurrency -> StreamIdBase
maxStreams :: StreamIdBase
    }
    deriving (Int -> Concurrency -> ShowS
[Concurrency] -> ShowS
Concurrency -> String
(Int -> Concurrency -> ShowS)
-> (Concurrency -> String)
-> ([Concurrency] -> ShowS)
-> Show Concurrency
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Concurrency -> ShowS
showsPrec :: Int -> Concurrency -> ShowS
$cshow :: Concurrency -> String
show :: Concurrency -> String
$cshowList :: [Concurrency] -> ShowS
showList :: [Concurrency] -> ShowS
Show)

newConcurrency :: Role -> Direction -> Int -> Concurrency
newConcurrency :: Role -> Direction -> Int -> Concurrency
newConcurrency Role
rl Direction
dir Int
n = Int -> StreamIdBase -> Concurrency
Concurrency Int
ini (StreamIdBase -> Concurrency) -> StreamIdBase -> Concurrency
forall a b. (a -> b) -> a -> b
$ Int -> StreamIdBase
StreamIdBase Int
n
  where
    bidi :: Bool
bidi = Direction
dir Direction -> Direction -> Bool
forall a. Eq a => a -> a -> Bool
== Direction
Bidirectional
    ini :: Int
ini
        | Role
rl Role -> Role -> Bool
forall a. Eq a => a -> a -> Bool
== Role
Client = if Bool
bidi then Int
0 else Int
2
        | Bool
otherwise = if Bool
bidi then Int
1 else Int
3

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

type Send = Buffer -> Int -> IO ()
type Recv = IO ReceivedPacket

-- For migration, two SockAddr for the peer are contained.
data PeerInfo = PeerInfo
    { PeerInfo -> PathInfo
currPathInfo :: PathInfo
    , PeerInfo -> Maybe PathInfo
prevPathInfo :: Maybe PathInfo
    }

data PathInfo = PathInfo
    { PathInfo -> SockAddr
peerSockAddr :: SockAddr
    , PathInfo -> TVar Int
pathBytesTx :: TVar Int -- TVar for anti amplification
    , PathInfo -> TVar Int
pathBytesRx :: TVar Int -- TVar for anti amplification
    , PathInfo -> TVar Bool
addressValidated :: TVar Bool
    }

newPathInfo :: SockAddr -> IO PathInfo
newPathInfo :: SockAddr -> IO PathInfo
newPathInfo SockAddr
sa = SockAddr -> TVar Int -> TVar Int -> TVar Bool -> PathInfo
PathInfo SockAddr
sa (TVar Int -> TVar Int -> TVar Bool -> PathInfo)
-> IO (TVar Int) -> IO (TVar Int -> TVar Bool -> PathInfo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> IO (TVar Int)
forall a. a -> IO (TVar a)
newTVarIO Int
0 IO (TVar Int -> TVar Bool -> PathInfo)
-> IO (TVar Int) -> IO (TVar Bool -> PathInfo)
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> IO (TVar Int)
forall a. a -> IO (TVar a)
newTVarIO Int
0 IO (TVar Bool -> PathInfo) -> IO (TVar Bool) -> IO PathInfo
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Bool -> IO (TVar Bool)
forall a. a -> IO (TVar a)
newTVarIO Bool
False

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

{- FOURMOLU_DISABLE -}
-- | A quic connection to carry multiple streams.
data Connection = Connection
    { Connection -> ConnState
connState         :: ConnState
    , -- Actions
      Connection -> DebugLogger
connDebugLog      :: DebugLogger
    -- ^ A logger for debugging.
    , Connection -> QLogger
connQLog          :: QLogger
    , Connection -> Hooks
connHooks         :: Hooks
    , Connection -> Send
connSend          :: ~Send -- ~ for testing
    , Connection -> Recv
connRecv          :: ~Recv -- ~ for testing
    -- Manage
    , Connection -> RecvQ
connRecvQ         :: RecvQ
    , Connection -> IORef Socket
connSocket        :: IORef Socket
    , Connection -> CID -> StatelessResetToken
genStatelessResetToken :: CID -> StatelessResetToken
    , Connection -> IORef (Map Word64 (Weak ThreadId))
readers           :: IORef (Map Word64 (Weak ThreadId))
    , Connection -> ThreadId
mainThreadId      :: ThreadId
    , Connection -> Rate
controlRate       :: Rate
    , -- Info
      Connection -> IORef RoleInfo
roleInfo          :: IORef RoleInfo
    , Connection -> IORef VersionInfo
quicVersionInfo   :: IORef VersionInfo
    , Connection -> VersionInfo
origVersionInfo   :: VersionInfo -- chosenVersion is client's ver in Initial
    -- Mine
    , Connection -> Parameters
myParameters      :: Parameters
    , Connection -> IORef CIDDB
myCIDDB           :: IORef CIDDB
    , -- Peer
      Connection -> IORef Parameters
peerParameters    :: IORef Parameters
    , Connection -> TVar CIDDB
peerCIDDB         :: TVar CIDDB
    , Connection -> IORef PeerInfo
peerInfo          :: IORef PeerInfo
    , -- Queues
      Connection -> InputQ
inputQ            :: InputQ
    , Connection -> CryptoQ
cryptoQ           :: CryptoQ
    , Connection -> OutputQ
outputQ           :: OutputQ
    , Connection -> Rate
outputRate        :: Rate
    , Connection -> Shared
shared            :: Shared
    , Connection -> IORef Int
delayedAckCount   :: IORef Int
    , Connection -> IORef (IO ())
delayedAckCancel  :: IORef (IO ())
    , -- State
      Connection -> IORef Int
peerPacketNumber  :: IORef PacketNumber -- for RTT1
    , Connection -> IORef StreamTable
streamTable       :: IORef StreamTable
    , Connection -> TVar Concurrency
myStreamId        :: TVar Concurrency -- C:0 S:1
    , Connection -> TVar Concurrency
myUniStreamId     :: TVar Concurrency -- C:2 S:3
    , Connection -> IORef Concurrency
peerStreamId      :: IORef Concurrency -- C:1 S:0
    , Connection -> IORef Concurrency
peerUniStreamId   :: IORef Concurrency -- C:3 S:2
    , Connection -> TVar TxFlow
flowTx            :: TVar TxFlow
    , Connection -> IORef RxFlow
flowRx            :: IORef RxFlow
    , Connection -> TVar MigrationState
migrationState    :: TVar MigrationState
    , Connection -> IORef Bool
sentRetirePriorTo :: IORef Bool
    , Connection -> IORef Microseconds
minIdleTimeout    :: IORef Microseconds
    , Connection -> IORef Int
bytesTx           :: IORef Int
    , Connection -> IORef Int
bytesRx           :: IORef Int
    , -- TLS
      Connection -> Array EncryptionLevel (TVar [ReceivedPacket])
pendingQ          :: Array EncryptionLevel (TVar [ReceivedPacket])
    , Connection -> IOArray EncryptionLevel Cipher
ciphers           :: IOArray EncryptionLevel Cipher
    , Connection -> IOArray EncryptionLevel Coder
coders            :: IOArray EncryptionLevel Coder
    , Connection -> IOArray Bool Coder1RTT
coders1RTT        :: IOArray Bool Coder1RTT
    , Connection -> IOArray EncryptionLevel Protector
protectors        :: IOArray EncryptionLevel Protector
    , Connection -> IORef (Bool, Int)
currentKeyPhase   :: IORef (Bool, PacketNumber)
    , Connection -> IORef Negotiated
negotiated        :: IORef Negotiated
    , Connection -> IORef AuthCIDs
connMyAuthCIDs    :: IORef AuthCIDs
    , Connection -> IORef AuthCIDs
connPeerAuthCIDs  :: IORef AuthCIDs
    , -- Resources
      Connection -> Buffer
encodeBuf         :: Buffer
    , Connection -> SizedBuffer
encryptRes        :: SizedBuffer
    , Connection -> Buffer
decryptBuf        :: Buffer
    , Connection -> IORef (IO ())
connResources     :: IORef (IO ())
    , -- Recovery
      Connection -> LDCC
connLDCC          :: LDCC
    }
{- FOURMOLU_ENABLE -}

instance KeepQlog Connection where
    keepQlog :: Connection -> QLogger
keepQlog Connection
conn = Connection -> QLogger
connQLog Connection
conn

instance Connector Connection where
    getRole :: Connection -> Role
getRole = ConnState -> Role
role (ConnState -> Role)
-> (Connection -> ConnState) -> Connection -> Role
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Connection -> ConnState
connState
    getEncryptionLevel :: Connection -> IO EncryptionLevel
getEncryptionLevel = TVar EncryptionLevel -> IO EncryptionLevel
forall a. TVar a -> IO a
readTVarIO (TVar EncryptionLevel -> IO EncryptionLevel)
-> (Connection -> TVar EncryptionLevel)
-> Connection
-> IO EncryptionLevel
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConnState -> TVar EncryptionLevel
encryptionLevel (ConnState -> TVar EncryptionLevel)
-> (Connection -> ConnState) -> Connection -> TVar EncryptionLevel
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Connection -> ConnState
connState
    getMaxPacketSize :: Connection -> IO Int
getMaxPacketSize = IORef Int -> IO Int
forall a. IORef a -> IO a
readIORef (IORef Int -> IO Int)
-> (Connection -> IORef Int) -> Connection -> IO Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConnState -> IORef Int
maxPacketSize (ConnState -> IORef Int)
-> (Connection -> ConnState) -> Connection -> IORef Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Connection -> ConnState
connState
    getConnectionState :: Connection -> IO ConnectionState
getConnectionState = TVar ConnectionState -> IO ConnectionState
forall a. TVar a -> IO a
readTVarIO (TVar ConnectionState -> IO ConnectionState)
-> (Connection -> TVar ConnectionState)
-> Connection
-> IO ConnectionState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConnState -> TVar ConnectionState
connectionState (ConnState -> TVar ConnectionState)
-> (Connection -> ConnState) -> Connection -> TVar ConnectionState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Connection -> ConnState
connState
    getPacketNumber :: Connection -> IO Int
getPacketNumber = IORef Int -> IO Int
forall a. IORef a -> IO a
readIORef (IORef Int -> IO Int)
-> (Connection -> IORef Int) -> Connection -> IO Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConnState -> IORef Int
packetNumber (ConnState -> IORef Int)
-> (Connection -> ConnState) -> Connection -> IORef Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Connection -> ConnState
connState
    getAlive :: Connection -> IO Bool
getAlive = IORef Bool -> IO Bool
forall a. IORef a -> IO a
readIORef (IORef Bool -> IO Bool)
-> (Connection -> IORef Bool) -> Connection -> IO Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConnState -> IORef Bool
connectionAlive (ConnState -> IORef Bool)
-> (Connection -> ConnState) -> Connection -> IORef Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Connection -> ConnState
connState

setDead :: Connection -> IO ()
setDead :: Connection -> IO ()
setDead Connection
conn = IORef Bool -> Bool -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (ConnState -> IORef Bool
connectionAlive (ConnState -> IORef Bool) -> ConnState -> IORef Bool
forall a b. (a -> b) -> a -> b
$ Connection -> ConnState
connState Connection
conn) Bool
False

makePendingQ :: IO (Array EncryptionLevel (TVar [ReceivedPacket]))
makePendingQ :: IO (Array EncryptionLevel (TVar [ReceivedPacket]))
makePendingQ = do
    TVar [ReceivedPacket]
q1 <- [ReceivedPacket] -> IO (TVar [ReceivedPacket])
forall a. a -> IO (TVar a)
newTVarIO []
    TVar [ReceivedPacket]
q2 <- [ReceivedPacket] -> IO (TVar [ReceivedPacket])
forall a. a -> IO (TVar a)
newTVarIO []
    TVar [ReceivedPacket]
q3 <- [ReceivedPacket] -> IO (TVar [ReceivedPacket])
forall a. a -> IO (TVar a)
newTVarIO []
    let lst :: [(EncryptionLevel, TVar [ReceivedPacket])]
lst = [(EncryptionLevel
RTT0Level, TVar [ReceivedPacket]
q1), (EncryptionLevel
HandshakeLevel, TVar [ReceivedPacket]
q2), (EncryptionLevel
RTT1Level, TVar [ReceivedPacket]
q3)]
        arr :: Array EncryptionLevel (TVar [ReceivedPacket])
arr = (EncryptionLevel, EncryptionLevel)
-> [(EncryptionLevel, TVar [ReceivedPacket])]
-> Array EncryptionLevel (TVar [ReceivedPacket])
forall i e. Ix i => (i, i) -> [(i, e)] -> Array i e
array (EncryptionLevel
RTT0Level, EncryptionLevel
RTT1Level) [(EncryptionLevel, TVar [ReceivedPacket])]
lst
    Array EncryptionLevel (TVar [ReceivedPacket])
-> IO (Array EncryptionLevel (TVar [ReceivedPacket]))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Array EncryptionLevel (TVar [ReceivedPacket])
arr

{- FOURMOLU_DISABLE -}
newConnection
    :: Role
    -> Parameters
    -> VersionInfo
    -> AuthCIDs
    -> AuthCIDs
    -> DebugLogger
    -> QLogger
    -> Hooks
    -> IORef Socket
    -> IORef PeerInfo
    -> RecvQ
    -> Send
    -> Recv
    -> (CID -> StatelessResetToken)
    -> IO Connection
newConnection :: Role
-> Parameters
-> VersionInfo
-> AuthCIDs
-> AuthCIDs
-> DebugLogger
-> QLogger
-> Hooks
-> IORef Socket
-> IORef PeerInfo
-> RecvQ
-> Send
-> Recv
-> (CID -> StatelessResetToken)
-> IO Connection
newConnection Role
rl Parameters
myParameters VersionInfo
origVersionInfo AuthCIDs
myAuthCIDs AuthCIDs
peerAuthCIDs DebugLogger
connDebugLog QLogger
connQLog Hooks
connHooks IORef Socket
connSocket IORef PeerInfo
peerInfo RecvQ
connRecvQ ~Send
connSend ~Recv
connRecv CID -> StatelessResetToken
genStatelessResetToken = do
    ConnState
connState         <- Role -> IO ConnState
newConnState Role
rl
    -- Manage
    IORef (Map Word64 (Weak ThreadId))
readers           <- Map Word64 (Weak ThreadId)
-> IO (IORef (Map Word64 (Weak ThreadId)))
forall a. a -> IO (IORef a)
newIORef Map Word64 (Weak ThreadId)
forall k a. Map k a
Map.empty
    ThreadId
mainThreadId      <- IO ThreadId
myThreadId
    Rate
controlRate       <- IO Rate
newRate
    -- Info
    IORef RoleInfo
roleInfo          <- RoleInfo -> IO (IORef RoleInfo)
forall a. a -> IO (IORef a)
newIORef RoleInfo
roleinfo
    IORef VersionInfo
quicVersionInfo   <- VersionInfo -> IO (IORef VersionInfo)
forall a. a -> IO (IORef a)
newIORef VersionInfo
origVersionInfo
    -- Mine
    IORef CIDDB
myCIDDB           <- CIDDB -> IO (IORef CIDDB)
forall a. a -> IO (IORef a)
newIORef (CID -> CIDDB
newCIDDB CID
myCID)
    -- Peer
    IORef Parameters
peerParameters    <- Parameters -> IO (IORef Parameters)
forall a. a -> IO (IORef a)
newIORef Parameters
baseParameters
    TVar CIDDB
peerCIDDB         <- CIDDB -> IO (TVar CIDDB)
forall a. a -> IO (TVar a)
newTVarIO (CID -> CIDDB
newCIDDB CID
peerCID)
    -- Queus
    InputQ
inputQ            <- IO InputQ
forall a. IO (TQueue a)
newTQueueIO
    CryptoQ
cryptoQ           <- IO CryptoQ
forall a. IO (TQueue a)
newTQueueIO
    OutputQ
outputQ           <- IO OutputQ
forall a. IO (TQueue a)
newTQueueIO
    Rate
outputRate        <- IO Rate
newRate
    Shared
shared            <- IO Shared
newShared
    IORef Int
delayedAckCount   <- Int -> IO (IORef Int)
forall a. a -> IO (IORef a)
newIORef Int
0
    IORef (IO ())
delayedAckCancel  <- IO () -> IO (IORef (IO ()))
forall a. a -> IO (IORef a)
newIORef (() -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ())
    -- State
    IORef Int
peerPacketNumber  <- Int -> IO (IORef Int)
forall a. a -> IO (IORef a)
newIORef Int
0
    IORef StreamTable
streamTable       <- StreamTable -> IO (IORef StreamTable)
forall a. a -> IO (IORef a)
newIORef StreamTable
emptyStreamTable
    TVar Concurrency
myStreamId        <- Concurrency -> IO (TVar Concurrency)
forall a. a -> IO (TVar a)
newTVarIO (Role -> Direction -> Int -> Concurrency
newConcurrency Role
rl Direction
Bidirectional Int
0)
    TVar Concurrency
myUniStreamId     <- Concurrency -> IO (TVar Concurrency)
forall a. a -> IO (TVar a)
newTVarIO (Role -> Direction -> Int -> Concurrency
newConcurrency Role
rl Direction
Unidirectional Int
0)
    IORef Concurrency
peerStreamId      <- Concurrency -> IO (IORef Concurrency)
forall a. a -> IO (IORef a)
newIORef Concurrency
peerConcurrency
    IORef Concurrency
peerUniStreamId   <- Concurrency -> IO (IORef Concurrency)
forall a. a -> IO (IORef a)
newIORef Concurrency
peerUniConcurrency
    TVar TxFlow
flowTx            <- TxFlow -> IO (TVar TxFlow)
forall a. a -> IO (TVar a)
newTVarIO (Int -> TxFlow
newTxFlow Int
0) -- limit is set in Handshake
    IORef RxFlow
flowRx            <- RxFlow -> IO (IORef RxFlow)
forall a. a -> IO (IORef a)
newIORef (Int -> RxFlow
newRxFlow (Int -> RxFlow) -> Int -> RxFlow
forall a b. (a -> b) -> a -> b
$ Parameters -> Int
initialMaxData Parameters
myParameters)
    TVar MigrationState
migrationState    <- MigrationState -> IO (TVar MigrationState)
forall a. a -> IO (TVar a)
newTVarIO MigrationState
NonMigration
    IORef Bool
sentRetirePriorTo <- Bool -> IO (IORef Bool)
forall a. a -> IO (IORef a)
newIORef Bool
False
    IORef Microseconds
minIdleTimeout    <- Microseconds -> IO (IORef Microseconds)
forall a. a -> IO (IORef a)
newIORef (Milliseconds -> Microseconds
milliToMicro (Milliseconds -> Microseconds) -> Milliseconds -> Microseconds
forall a b. (a -> b) -> a -> b
$ Parameters -> Milliseconds
maxIdleTimeout Parameters
myParameters)
    IORef Int
bytesTx           <- Int -> IO (IORef Int)
forall a. a -> IO (IORef a)
newIORef Int
0
    IORef Int
bytesRx           <- Int -> IO (IORef Int)
forall a. a -> IO (IORef a)
newIORef Int
0
    -- TLS
    Array EncryptionLevel (TVar [ReceivedPacket])
pendingQ          <- IO (Array EncryptionLevel (TVar [ReceivedPacket]))
makePendingQ
    IOArray EncryptionLevel Cipher
ciphers           <- (EncryptionLevel, EncryptionLevel)
-> Cipher -> IO (IOArray EncryptionLevel Cipher)
forall i. Ix i => (i, i) -> Cipher -> IO (IOArray i Cipher)
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
(i, i) -> e -> m (a i e)
newArray (EncryptionLevel
InitialLevel, EncryptionLevel
RTT1Level) Cipher
defaultCipher
    IOArray EncryptionLevel Coder
coders            <- (EncryptionLevel, EncryptionLevel)
-> Coder -> IO (IOArray EncryptionLevel Coder)
forall i. Ix i => (i, i) -> Coder -> IO (IOArray i Coder)
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
(i, i) -> e -> m (a i e)
newArray (EncryptionLevel
InitialLevel, EncryptionLevel
HandshakeLevel) Coder
initialCoder
    IOArray Bool Coder1RTT
coders1RTT        <- (Bool, Bool) -> Coder1RTT -> IO (IOArray Bool Coder1RTT)
forall i. Ix i => (i, i) -> Coder1RTT -> IO (IOArray i Coder1RTT)
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
(i, i) -> e -> m (a i e)
newArray (Bool
False, Bool
True) Coder1RTT
initialCoder1RTT
    IOArray EncryptionLevel Protector
protectors        <- (EncryptionLevel, EncryptionLevel)
-> Protector -> IO (IOArray EncryptionLevel Protector)
forall i. Ix i => (i, i) -> Protector -> IO (IOArray i Protector)
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
(i, i) -> e -> m (a i e)
newArray (EncryptionLevel
InitialLevel, EncryptionLevel
RTT1Level) Protector
initialProtector
    IORef (Bool, Int)
currentKeyPhase   <- (Bool, Int) -> IO (IORef (Bool, Int))
forall a. a -> IO (IORef a)
newIORef (Bool
False, Int
0)
    IORef Negotiated
negotiated        <- Negotiated -> IO (IORef Negotiated)
forall a. a -> IO (IORef a)
newIORef Negotiated
initialNegotiated
    IORef AuthCIDs
connMyAuthCIDs    <- AuthCIDs -> IO (IORef AuthCIDs)
forall a. a -> IO (IORef a)
newIORef AuthCIDs
myAuthCIDs
    IORef AuthCIDs
connPeerAuthCIDs  <- AuthCIDs -> IO (IORef AuthCIDs)
forall a. a -> IO (IORef a)
newIORef AuthCIDs
peerAuthCIDs
    -- Resources
    Buffer
encodeBuf         <- Int -> IO Buffer
forall a. Int -> IO (Ptr a)
mallocBytes Int
bufsiz -- used sender or closere
    Buffer
encryptBuf        <- Int -> IO Buffer
forall a. Int -> IO (Ptr a)
mallocBytes Int
bufsiz
    let encryptRes :: SizedBuffer
encryptRes = Buffer -> Int -> SizedBuffer
SizedBuffer Buffer
encryptBuf Int
bufsiz -- used sender
    Buffer
decryptBuf        <- Int -> IO Buffer
forall a. Int -> IO (Ptr a)
mallocBytes Int
bufsiz -- used receiver
    IORef (IO ())
connResources     <- IO () -> IO (IORef (IO ()))
forall a. a -> IO (IORef a)
newIORef (Buffer -> IO ()
forall a. Ptr a -> IO ()
free Buffer
encodeBuf IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Buffer -> IO ()
forall a. Ptr a -> IO ()
free Buffer
encryptBuf IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Buffer -> IO ()
forall a. Ptr a -> IO ()
free Buffer
decryptBuf)
    -- Recovery
    let put :: PlainPacket -> IO ()
put PlainPacket
x = STM () -> IO ()
forall a. STM a -> IO a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ OutputQ -> Output -> STM ()
forall a. TQueue a -> a -> STM ()
writeTQueue OutputQ
outputQ (Output -> STM ()) -> Output -> STM ()
forall a b. (a -> b) -> a -> b
$ PlainPacket -> Output
OutRetrans PlainPacket
x
    LDCC
connLDCC          <- ConnState -> QLogger -> (PlainPacket -> IO ()) -> IO LDCC
newLDCC ConnState
connState QLogger
connQLog PlainPacket -> IO ()
put
    Connection -> IO Connection
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Connection{Recv
Buffer
Array EncryptionLevel (TVar [ReceivedPacket])
IOArray Bool Coder1RTT
IOArray EncryptionLevel Cipher
IOArray EncryptionLevel Protector
IOArray EncryptionLevel Coder
ThreadId
TVar TxFlow
TVar Concurrency
TVar MigrationState
TVar CIDDB
IORef Bool
IORef Int
IORef (IO ())
IORef (Bool, Int)
IORef (Map Word64 (Weak ThreadId))
IORef Socket
IORef RxFlow
IORef Microseconds
IORef VersionInfo
IORef AuthCIDs
IORef Parameters
IORef StreamTable
IORef PeerInfo
IORef Concurrency
IORef Negotiated
IORef CIDDB
IORef RoleInfo
Rate
OutputQ
CryptoQ
InputQ
VersionInfo
RecvQ
SizedBuffer
ConnState
Parameters
LDCC
Hooks
Shared
Send
DebugLogger
CID -> StatelessResetToken
QLogger
connState :: ConnState
connDebugLog :: DebugLogger
connQLog :: QLogger
connHooks :: Hooks
connSend :: Send
connRecv :: Recv
connRecvQ :: RecvQ
connSocket :: IORef Socket
genStatelessResetToken :: CID -> StatelessResetToken
readers :: IORef (Map Word64 (Weak ThreadId))
mainThreadId :: ThreadId
controlRate :: Rate
roleInfo :: IORef RoleInfo
quicVersionInfo :: IORef VersionInfo
origVersionInfo :: VersionInfo
myParameters :: Parameters
myCIDDB :: IORef CIDDB
peerParameters :: IORef Parameters
peerCIDDB :: TVar CIDDB
peerInfo :: IORef PeerInfo
inputQ :: InputQ
cryptoQ :: CryptoQ
outputQ :: OutputQ
outputRate :: Rate
shared :: Shared
delayedAckCount :: IORef Int
delayedAckCancel :: IORef (IO ())
peerPacketNumber :: IORef Int
streamTable :: IORef StreamTable
myStreamId :: TVar Concurrency
myUniStreamId :: TVar Concurrency
peerStreamId :: IORef Concurrency
peerUniStreamId :: IORef Concurrency
flowTx :: TVar TxFlow
flowRx :: IORef RxFlow
migrationState :: TVar MigrationState
sentRetirePriorTo :: IORef Bool
minIdleTimeout :: IORef Microseconds
bytesTx :: IORef Int
bytesRx :: IORef Int
pendingQ :: Array EncryptionLevel (TVar [ReceivedPacket])
ciphers :: IOArray EncryptionLevel Cipher
coders :: IOArray EncryptionLevel Coder
coders1RTT :: IOArray Bool Coder1RTT
protectors :: IOArray EncryptionLevel Protector
currentKeyPhase :: IORef (Bool, Int)
negotiated :: IORef Negotiated
connMyAuthCIDs :: IORef AuthCIDs
connPeerAuthCIDs :: IORef AuthCIDs
encodeBuf :: Buffer
encryptRes :: SizedBuffer
decryptBuf :: Buffer
connResources :: IORef (IO ())
connLDCC :: LDCC
myParameters :: Parameters
origVersionInfo :: VersionInfo
connDebugLog :: DebugLogger
connQLog :: QLogger
connHooks :: Hooks
connSocket :: IORef Socket
peerInfo :: IORef PeerInfo
connRecvQ :: RecvQ
connSend :: Send
connRecv :: Recv
genStatelessResetToken :: CID -> StatelessResetToken
connState :: ConnState
readers :: IORef (Map Word64 (Weak ThreadId))
mainThreadId :: ThreadId
controlRate :: Rate
roleInfo :: IORef RoleInfo
quicVersionInfo :: IORef VersionInfo
myCIDDB :: IORef CIDDB
peerParameters :: IORef Parameters
peerCIDDB :: TVar CIDDB
inputQ :: InputQ
cryptoQ :: CryptoQ
outputQ :: OutputQ
outputRate :: Rate
shared :: Shared
delayedAckCount :: IORef Int
delayedAckCancel :: IORef (IO ())
peerPacketNumber :: IORef Int
streamTable :: IORef StreamTable
myStreamId :: TVar Concurrency
myUniStreamId :: TVar Concurrency
peerStreamId :: IORef Concurrency
peerUniStreamId :: IORef Concurrency
flowTx :: TVar TxFlow
flowRx :: IORef RxFlow
migrationState :: TVar MigrationState
sentRetirePriorTo :: IORef Bool
minIdleTimeout :: IORef Microseconds
bytesTx :: IORef Int
bytesRx :: IORef Int
pendingQ :: Array EncryptionLevel (TVar [ReceivedPacket])
ciphers :: IOArray EncryptionLevel Cipher
coders :: IOArray EncryptionLevel Coder
coders1RTT :: IOArray Bool Coder1RTT
protectors :: IOArray EncryptionLevel Protector
currentKeyPhase :: IORef (Bool, Int)
negotiated :: IORef Negotiated
connMyAuthCIDs :: IORef AuthCIDs
connPeerAuthCIDs :: IORef AuthCIDs
encodeBuf :: Buffer
encryptRes :: SizedBuffer
decryptBuf :: Buffer
connResources :: IORef (IO ())
connLDCC :: LDCC
..}
  where
    isclient :: Bool
isclient = Role
rl Role -> Role -> Bool
forall a. Eq a => a -> a -> Bool
== Role
Client
    roleinfo :: RoleInfo
roleinfo
        | Bool
isclient = RoleInfo
defaultClientRoleInfo
        | Bool
otherwise = RoleInfo
defaultServerRoleInfo
    myCID :: CID
myCID = Maybe CID -> CID
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe CID -> CID) -> Maybe CID -> CID
forall a b. (a -> b) -> a -> b
$ AuthCIDs -> Maybe CID
initSrcCID AuthCIDs
myAuthCIDs
    peerCID :: CID
peerCID = Maybe CID -> CID
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe CID -> CID) -> Maybe CID -> CID
forall a b. (a -> b) -> a -> b
$ AuthCIDs -> Maybe CID
initSrcCID AuthCIDs
peerAuthCIDs
    peer :: Role
peer
        | Bool
isclient = Role
Server
        | Bool
otherwise = Role
Client
    peerConcurrency :: Concurrency
peerConcurrency = Role -> Direction -> Int -> Concurrency
newConcurrency Role
peer Direction
Bidirectional (Parameters -> Int
initialMaxStreamsBidi Parameters
myParameters)
    peerUniConcurrency :: Concurrency
peerUniConcurrency = Role -> Direction -> Int -> Concurrency
newConcurrency Role
peer Direction
Unidirectional (Parameters -> Int
initialMaxStreamsUni Parameters
myParameters)
    bufsiz :: Int
bufsiz = Int
maximumUdpPayloadSize
{- FOURMOLU_ENABLE -}

defaultTrafficSecrets :: (ClientTrafficSecret a, ServerTrafficSecret a)
defaultTrafficSecrets :: forall a. TrafficSecrets a
defaultTrafficSecrets = (ByteString -> ClientTrafficSecret a
forall a. ByteString -> ClientTrafficSecret a
ClientTrafficSecret ByteString
"", ByteString -> ServerTrafficSecret a
forall a. ByteString -> ServerTrafficSecret a
ServerTrafficSecret ByteString
"")

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

clientConnection
    :: ClientConfig
    -> VersionInfo
    -> AuthCIDs
    -> AuthCIDs
    -> DebugLogger
    -> QLogger
    -> Hooks
    -> IORef Socket
    -> IORef PeerInfo
    -> RecvQ
    -> Send
    -> Recv
    -> (CID -> StatelessResetToken)
    -> IO Connection
clientConnection :: ClientConfig
-> VersionInfo
-> AuthCIDs
-> AuthCIDs
-> DebugLogger
-> QLogger
-> Hooks
-> IORef Socket
-> IORef PeerInfo
-> RecvQ
-> Send
-> Recv
-> (CID -> StatelessResetToken)
-> IO Connection
clientConnection ClientConfig{Bool
String
[Group]
[Cipher]
[Version]
Maybe Int
Maybe String
Credentials
ClientHooks
Version
ResumptionInfo
Parameters
Hooks
String -> IO ()
Version -> IO (Maybe [ByteString])
ccVersion :: Version
ccVersions :: [Version]
ccCiphers :: [Cipher]
ccGroups :: [Group]
ccParameters :: Parameters
ccKeyLog :: String -> IO ()
ccQLog :: Maybe String
ccCredentials :: Credentials
ccHooks :: Hooks
ccTlsHooks :: ClientHooks
ccUse0RTT :: Bool
ccServerName :: String
ccPortName :: String
ccALPN :: Version -> IO (Maybe [ByteString])
ccValidate :: Bool
ccResumption :: ResumptionInfo
ccPacketSize :: Maybe Int
ccDebugLog :: Bool
ccSockConnected :: Bool
ccWatchDog :: Bool
ccServerNameOverride :: Maybe String
ccServerNameOverride :: ClientConfig -> Maybe String
ccWatchDog :: ClientConfig -> Bool
ccSockConnected :: ClientConfig -> Bool
ccDebugLog :: ClientConfig -> Bool
ccPacketSize :: ClientConfig -> Maybe Int
ccResumption :: ClientConfig -> ResumptionInfo
ccValidate :: ClientConfig -> Bool
ccALPN :: ClientConfig -> Version -> IO (Maybe [ByteString])
ccPortName :: ClientConfig -> String
ccServerName :: ClientConfig -> String
ccUse0RTT :: ClientConfig -> Bool
ccTlsHooks :: ClientConfig -> ClientHooks
ccHooks :: ClientConfig -> Hooks
ccCredentials :: ClientConfig -> Credentials
ccQLog :: ClientConfig -> Maybe String
ccKeyLog :: ClientConfig -> String -> IO ()
ccParameters :: ClientConfig -> Parameters
ccGroups :: ClientConfig -> [Group]
ccCiphers :: ClientConfig -> [Cipher]
ccVersions :: ClientConfig -> [Version]
ccVersion :: ClientConfig -> Version
..} VersionInfo
verInfo AuthCIDs
myAuthCIDs AuthCIDs
peerAuthCIDs =
    Role
-> Parameters
-> VersionInfo
-> AuthCIDs
-> AuthCIDs
-> DebugLogger
-> QLogger
-> Hooks
-> IORef Socket
-> IORef PeerInfo
-> RecvQ
-> Send
-> Recv
-> (CID -> StatelessResetToken)
-> IO Connection
newConnection Role
Client Parameters
ccParameters VersionInfo
verInfo AuthCIDs
myAuthCIDs AuthCIDs
peerAuthCIDs

serverConnection
    :: ServerConfig
    -> VersionInfo
    -> AuthCIDs
    -> AuthCIDs
    -> DebugLogger
    -> QLogger
    -> Hooks
    -> IORef Socket
    -> IORef PeerInfo
    -> RecvQ
    -> Send
    -> Recv
    -> (CID -> StatelessResetToken)
    -> IO Connection
serverConnection :: ServerConfig
-> VersionInfo
-> AuthCIDs
-> AuthCIDs
-> DebugLogger
-> QLogger
-> Hooks
-> IORef Socket
-> IORef PeerInfo
-> RecvQ
-> Send
-> Recv
-> (CID -> StatelessResetToken)
-> IO Connection
serverConnection ServerConfig{Bool
Int
[(IP, PortNumber)]
[Group]
[Cipher]
[Version]
Maybe String
Maybe (Version -> [ByteString] -> IO ByteString)
SessionManager
Credentials
ServerHooks
Parameters
Hooks
String -> IO ()
scVersions :: [Version]
scCiphers :: [Cipher]
scGroups :: [Group]
scParameters :: Parameters
scKeyLog :: String -> IO ()
scQLog :: Maybe String
scCredentials :: Credentials
scHooks :: Hooks
scTlsHooks :: ServerHooks
scUse0RTT :: Bool
scAddresses :: [(IP, PortNumber)]
scALPN :: Maybe (Version -> [ByteString] -> IO ByteString)
scRequireRetry :: Bool
scSessionManager :: SessionManager
scDebugLog :: Maybe String
scTicketLifetime :: Int
scTicketLifetime :: ServerConfig -> Int
scDebugLog :: ServerConfig -> Maybe String
scSessionManager :: ServerConfig -> SessionManager
scRequireRetry :: ServerConfig -> Bool
scALPN :: ServerConfig -> Maybe (Version -> [ByteString] -> IO ByteString)
scAddresses :: ServerConfig -> [(IP, PortNumber)]
scUse0RTT :: ServerConfig -> Bool
scTlsHooks :: ServerConfig -> ServerHooks
scHooks :: ServerConfig -> Hooks
scCredentials :: ServerConfig -> Credentials
scQLog :: ServerConfig -> Maybe String
scKeyLog :: ServerConfig -> String -> IO ()
scParameters :: ServerConfig -> Parameters
scGroups :: ServerConfig -> [Group]
scCiphers :: ServerConfig -> [Cipher]
scVersions :: ServerConfig -> [Version]
..} VersionInfo
verInfo AuthCIDs
myAuthCIDs AuthCIDs
peerAuthCIDs =
    Role
-> Parameters
-> VersionInfo
-> AuthCIDs
-> AuthCIDs
-> DebugLogger
-> QLogger
-> Hooks
-> IORef Socket
-> IORef PeerInfo
-> RecvQ
-> Send
-> Recv
-> (CID -> StatelessResetToken)
-> IO Connection
newConnection Role
Server Parameters
scParameters VersionInfo
verInfo AuthCIDs
myAuthCIDs AuthCIDs
peerAuthCIDs

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

newtype Input = InpStream Stream deriving (Int -> Input -> ShowS
[Input] -> ShowS
Input -> String
(Int -> Input -> ShowS)
-> (Input -> String) -> ([Input] -> ShowS) -> Show Input
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Input -> ShowS
showsPrec :: Int -> Input -> ShowS
$cshow :: Input -> String
show :: Input -> String
$cshowList :: [Input] -> ShowS
showList :: [Input] -> ShowS
Show)
data Crypto = InpHandshake EncryptionLevel ByteString deriving (Int -> Crypto -> ShowS
[Crypto] -> ShowS
Crypto -> String
(Int -> Crypto -> ShowS)
-> (Crypto -> String) -> ([Crypto] -> ShowS) -> Show Crypto
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Crypto -> ShowS
showsPrec :: Int -> Crypto -> ShowS
$cshow :: Crypto -> String
show :: Crypto -> String
$cshowList :: [Crypto] -> ShowS
showList :: [Crypto] -> ShowS
Show)

data Output
    = OutControl EncryptionLevel [Frame]
    | OutHandshake [(EncryptionLevel, ByteString)]
    | OutRetrans PlainPacket

type InputQ = TQueue Input
type CryptoQ = TQueue Crypto
type OutputQ = TQueue Output

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

type SendStreamQ = TQueue TxStreamData

data Shared = Shared
    { Shared -> IORef Bool
sharedCloseSent :: IORef Bool
    , Shared -> IORef Bool
sharedCloseReceived :: IORef Bool
    , Shared -> IORef Bool
shared1RTTReady :: IORef Bool
    , Shared -> SendStreamQ
sharedSendStreamQ :: SendStreamQ
    }

newShared :: IO Shared
newShared :: IO Shared
newShared =
    IORef Bool -> IORef Bool -> IORef Bool -> SendStreamQ -> Shared
Shared
        (IORef Bool -> IORef Bool -> IORef Bool -> SendStreamQ -> Shared)
-> IO (IORef Bool)
-> IO (IORef Bool -> IORef Bool -> SendStreamQ -> Shared)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool -> IO (IORef Bool)
forall a. a -> IO (IORef a)
newIORef Bool
False
        IO (IORef Bool -> IORef Bool -> SendStreamQ -> Shared)
-> IO (IORef Bool) -> IO (IORef Bool -> SendStreamQ -> Shared)
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Bool -> IO (IORef Bool)
forall a. a -> IO (IORef a)
newIORef Bool
False
        IO (IORef Bool -> SendStreamQ -> Shared)
-> IO (IORef Bool) -> IO (SendStreamQ -> Shared)
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Bool -> IO (IORef Bool)
forall a. a -> IO (IORef a)
newIORef Bool
False
        IO (SendStreamQ -> Shared) -> IO SendStreamQ -> IO Shared
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> IO SendStreamQ
forall a. IO (TQueue a)
newTQueueIO