{-# LANGUAGE CPP #-}
{-# LANGUAGE RecordWildCards #-}

module Network.QUIC.Connection.Crypto (
    setEncryptionLevel,
    waitEncryptionLevel,
    putOffCrypto,
    --
    getCipher,
    setCipher,
    getTLSMode,
    getApplicationProtocol,
    setNegotiated,
    --
    dropSecrets,
    --
    initializeCoder,
    initializeCoder1RTT,
    updateCoder1RTT,
    getCoder,
    getProtector,
    --
    getCurrentKeyPhase,
    setCurrentKeyPhase,
) where

import Network.TLS.QUIC
import UnliftIO.STM

import Network.QUIC.Connection.Misc
import Network.QUIC.Connection.Types
import Network.QUIC.Connector
import Network.QUIC.Crypto
import Network.QUIC.Imports
import Network.QUIC.Types

useFusion :: Bool
#ifdef USE_FUSION
useFusion :: Bool
useFusion = Bool
True
#else
useFusion = False
#endif

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

setEncryptionLevel :: Connection -> EncryptionLevel -> IO ()
setEncryptionLevel :: Connection -> EncryptionLevel -> IO ()
setEncryptionLevel Connection{Recv
Buffer
Array EncryptionLevel (TVar [ReceivedPacket])
IOArray Bool Coder1RTT
IOArray EncryptionLevel Cipher
IOArray EncryptionLevel Protector
IOArray EncryptionLevel Coder
ThreadId
TVar Bool
TVar Int
TVar TxFlow
TVar Concurrency
TVar MigrationState
TVar CIDDB
IORef Int
IORef (IO ())
IORef (Bool, Int)
IORef RxFlow
IORef UDPSocket
IORef Microseconds
IORef VersionInfo
IORef AuthCIDs
IORef Parameters
IORef StreamTable
IORef Concurrency
IORef Negotiated
IORef CIDDB
IORef RoleInfo
Rate
OutputQLim
MigrationQ
OutputQ
CryptoQ
InputQ
VersionInfo
RecvQ
SizedBuffer
ConnState
Parameters
LDCC
Hooks
Shared
Send
DebugLogger
QLogger
connState :: ConnState
connDebugLog :: DebugLogger
connQLog :: QLogger
connHooks :: Hooks
connSend :: Send
connRecv :: Recv
connRecvQ :: RecvQ
udpSocket :: IORef UDPSocket
readers :: IORef (IO ())
mainThreadId :: ThreadId
controlRate :: Rate
roleInfo :: IORef RoleInfo
quicVersionInfo :: IORef VersionInfo
origVersionInfo :: VersionInfo
myParameters :: Parameters
myCIDDB :: IORef CIDDB
peerParameters :: IORef Parameters
peerCIDDB :: TVar CIDDB
inputQ :: InputQ
cryptoQ :: CryptoQ
outputQ :: OutputQ
outputQLim :: OutputQLim
migrationQ :: MigrationQ
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
minIdleTimeout :: IORef Microseconds
bytesTx :: TVar Int
bytesRx :: TVar Int
addressValidated :: TVar Bool
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
connResources :: IORef (IO ())
encodeBuf :: Buffer
encryptRes :: SizedBuffer
decryptBuf :: Buffer
connLDCC :: LDCC
connState :: Connection -> ConnState
connDebugLog :: Connection -> DebugLogger
connQLog :: Connection -> QLogger
connHooks :: Connection -> Hooks
connSend :: Connection -> Send
connRecv :: Connection -> Recv
connRecvQ :: Connection -> RecvQ
udpSocket :: Connection -> IORef UDPSocket
readers :: Connection -> IORef (IO ())
mainThreadId :: Connection -> ThreadId
controlRate :: Connection -> Rate
roleInfo :: Connection -> IORef RoleInfo
quicVersionInfo :: Connection -> IORef VersionInfo
origVersionInfo :: Connection -> VersionInfo
myParameters :: Connection -> Parameters
myCIDDB :: Connection -> IORef CIDDB
peerParameters :: Connection -> IORef Parameters
peerCIDDB :: Connection -> TVar CIDDB
inputQ :: Connection -> InputQ
cryptoQ :: Connection -> CryptoQ
outputQ :: Connection -> OutputQ
outputQLim :: Connection -> OutputQLim
migrationQ :: Connection -> MigrationQ
shared :: Connection -> Shared
delayedAckCount :: Connection -> IORef Int
delayedAckCancel :: Connection -> IORef (IO ())
peerPacketNumber :: Connection -> IORef Int
streamTable :: Connection -> IORef StreamTable
myStreamId :: Connection -> TVar Concurrency
myUniStreamId :: Connection -> TVar Concurrency
peerStreamId :: Connection -> IORef Concurrency
peerUniStreamId :: Connection -> IORef Concurrency
flowTx :: Connection -> TVar TxFlow
flowRx :: Connection -> IORef RxFlow
migrationState :: Connection -> TVar MigrationState
minIdleTimeout :: Connection -> IORef Microseconds
bytesTx :: Connection -> TVar Int
bytesRx :: Connection -> TVar Int
addressValidated :: Connection -> TVar Bool
pendingQ :: Connection -> Array EncryptionLevel (TVar [ReceivedPacket])
ciphers :: Connection -> IOArray EncryptionLevel Cipher
coders :: Connection -> IOArray EncryptionLevel Coder
coders1RTT :: Connection -> IOArray Bool Coder1RTT
protectors :: Connection -> IOArray EncryptionLevel Protector
currentKeyPhase :: Connection -> IORef (Bool, Int)
negotiated :: Connection -> IORef Negotiated
connMyAuthCIDs :: Connection -> IORef AuthCIDs
connPeerAuthCIDs :: Connection -> IORef AuthCIDs
connResources :: Connection -> IORef (IO ())
encodeBuf :: Connection -> Buffer
encryptRes :: Connection -> SizedBuffer
decryptBuf :: Connection -> Buffer
connLDCC :: Connection -> LDCC
..} EncryptionLevel
lvl = do
    let q :: RecvQ
q = RecvQ
connRecvQ
    STM () -> IO ()
forall (m :: * -> *) a. MonadIO m => STM a -> m a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
        TVar EncryptionLevel -> EncryptionLevel -> STM ()
forall a. TVar a -> a -> STM ()
writeTVar (ConnState -> TVar EncryptionLevel
encryptionLevel ConnState
connState) EncryptionLevel
lvl
        case EncryptionLevel
lvl of
            EncryptionLevel
HandshakeLevel -> do
                TVar [ReceivedPacket] -> STM [ReceivedPacket]
forall a. TVar a -> STM a
readTVar (Array EncryptionLevel (TVar [ReceivedPacket])
pendingQ Array EncryptionLevel (TVar [ReceivedPacket])
-> EncryptionLevel -> TVar [ReceivedPacket]
forall i e. Ix i => Array i e -> i -> e
! EncryptionLevel
RTT0Level) STM [ReceivedPacket] -> ([ReceivedPacket] -> STM ()) -> STM ()
forall a b. STM a -> (a -> STM b) -> STM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (ReceivedPacket -> STM ()) -> [ReceivedPacket] -> STM ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (RecvQ -> ReceivedPacket -> STM ()
prependRecvQ RecvQ
q)
                TVar [ReceivedPacket] -> STM [ReceivedPacket]
forall a. TVar a -> STM a
readTVar (Array EncryptionLevel (TVar [ReceivedPacket])
pendingQ Array EncryptionLevel (TVar [ReceivedPacket])
-> EncryptionLevel -> TVar [ReceivedPacket]
forall i e. Ix i => Array i e -> i -> e
! EncryptionLevel
HandshakeLevel) STM [ReceivedPacket] -> ([ReceivedPacket] -> STM ()) -> STM ()
forall a b. STM a -> (a -> STM b) -> STM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (ReceivedPacket -> STM ()) -> [ReceivedPacket] -> STM ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (RecvQ -> ReceivedPacket -> STM ()
prependRecvQ RecvQ
q)
            EncryptionLevel
RTT1Level ->
                TVar [ReceivedPacket] -> STM [ReceivedPacket]
forall a. TVar a -> STM a
readTVar (Array EncryptionLevel (TVar [ReceivedPacket])
pendingQ Array EncryptionLevel (TVar [ReceivedPacket])
-> EncryptionLevel -> TVar [ReceivedPacket]
forall i e. Ix i => Array i e -> i -> e
! EncryptionLevel
RTT1Level) STM [ReceivedPacket] -> ([ReceivedPacket] -> STM ()) -> STM ()
forall a b. STM a -> (a -> STM b) -> STM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (ReceivedPacket -> STM ()) -> [ReceivedPacket] -> STM ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (RecvQ -> ReceivedPacket -> STM ()
prependRecvQ RecvQ
q)
            EncryptionLevel
_ -> () -> STM ()
forall a. a -> STM a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

putOffCrypto :: Connection -> EncryptionLevel -> ReceivedPacket -> IO ()
putOffCrypto :: Connection -> EncryptionLevel -> ReceivedPacket -> IO ()
putOffCrypto Connection{Recv
Buffer
Array EncryptionLevel (TVar [ReceivedPacket])
IOArray Bool Coder1RTT
IOArray EncryptionLevel Cipher
IOArray EncryptionLevel Protector
IOArray EncryptionLevel Coder
ThreadId
TVar Bool
TVar Int
TVar TxFlow
TVar Concurrency
TVar MigrationState
TVar CIDDB
IORef Int
IORef (IO ())
IORef (Bool, Int)
IORef RxFlow
IORef UDPSocket
IORef Microseconds
IORef VersionInfo
IORef AuthCIDs
IORef Parameters
IORef StreamTable
IORef Concurrency
IORef Negotiated
IORef CIDDB
IORef RoleInfo
Rate
OutputQLim
MigrationQ
OutputQ
CryptoQ
InputQ
VersionInfo
RecvQ
SizedBuffer
ConnState
Parameters
LDCC
Hooks
Shared
Send
DebugLogger
QLogger
connState :: Connection -> ConnState
connDebugLog :: Connection -> DebugLogger
connQLog :: Connection -> QLogger
connHooks :: Connection -> Hooks
connSend :: Connection -> Send
connRecv :: Connection -> Recv
connRecvQ :: Connection -> RecvQ
udpSocket :: Connection -> IORef UDPSocket
readers :: Connection -> IORef (IO ())
mainThreadId :: Connection -> ThreadId
controlRate :: Connection -> Rate
roleInfo :: Connection -> IORef RoleInfo
quicVersionInfo :: Connection -> IORef VersionInfo
origVersionInfo :: Connection -> VersionInfo
myParameters :: Connection -> Parameters
myCIDDB :: Connection -> IORef CIDDB
peerParameters :: Connection -> IORef Parameters
peerCIDDB :: Connection -> TVar CIDDB
inputQ :: Connection -> InputQ
cryptoQ :: Connection -> CryptoQ
outputQ :: Connection -> OutputQ
outputQLim :: Connection -> OutputQLim
migrationQ :: Connection -> MigrationQ
shared :: Connection -> Shared
delayedAckCount :: Connection -> IORef Int
delayedAckCancel :: Connection -> IORef (IO ())
peerPacketNumber :: Connection -> IORef Int
streamTable :: Connection -> IORef StreamTable
myStreamId :: Connection -> TVar Concurrency
myUniStreamId :: Connection -> TVar Concurrency
peerStreamId :: Connection -> IORef Concurrency
peerUniStreamId :: Connection -> IORef Concurrency
flowTx :: Connection -> TVar TxFlow
flowRx :: Connection -> IORef RxFlow
migrationState :: Connection -> TVar MigrationState
minIdleTimeout :: Connection -> IORef Microseconds
bytesTx :: Connection -> TVar Int
bytesRx :: Connection -> TVar Int
addressValidated :: Connection -> TVar Bool
pendingQ :: Connection -> Array EncryptionLevel (TVar [ReceivedPacket])
ciphers :: Connection -> IOArray EncryptionLevel Cipher
coders :: Connection -> IOArray EncryptionLevel Coder
coders1RTT :: Connection -> IOArray Bool Coder1RTT
protectors :: Connection -> IOArray EncryptionLevel Protector
currentKeyPhase :: Connection -> IORef (Bool, Int)
negotiated :: Connection -> IORef Negotiated
connMyAuthCIDs :: Connection -> IORef AuthCIDs
connPeerAuthCIDs :: Connection -> IORef AuthCIDs
connResources :: Connection -> IORef (IO ())
encodeBuf :: Connection -> Buffer
encryptRes :: Connection -> SizedBuffer
decryptBuf :: Connection -> Buffer
connLDCC :: Connection -> LDCC
connState :: ConnState
connDebugLog :: DebugLogger
connQLog :: QLogger
connHooks :: Hooks
connSend :: Send
connRecv :: Recv
connRecvQ :: RecvQ
udpSocket :: IORef UDPSocket
readers :: IORef (IO ())
mainThreadId :: ThreadId
controlRate :: Rate
roleInfo :: IORef RoleInfo
quicVersionInfo :: IORef VersionInfo
origVersionInfo :: VersionInfo
myParameters :: Parameters
myCIDDB :: IORef CIDDB
peerParameters :: IORef Parameters
peerCIDDB :: TVar CIDDB
inputQ :: InputQ
cryptoQ :: CryptoQ
outputQ :: OutputQ
outputQLim :: OutputQLim
migrationQ :: MigrationQ
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
minIdleTimeout :: IORef Microseconds
bytesTx :: TVar Int
bytesRx :: TVar Int
addressValidated :: TVar Bool
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
connResources :: IORef (IO ())
encodeBuf :: Buffer
encryptRes :: SizedBuffer
decryptBuf :: Buffer
connLDCC :: LDCC
..} EncryptionLevel
lvl ReceivedPacket
rpkt =
    STM () -> IO ()
forall (m :: * -> *) a. MonadIO m => STM a -> m a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ TVar [ReceivedPacket]
-> ([ReceivedPacket] -> [ReceivedPacket]) -> STM ()
forall a. TVar a -> (a -> a) -> STM ()
modifyTVar' (Array EncryptionLevel (TVar [ReceivedPacket])
pendingQ Array EncryptionLevel (TVar [ReceivedPacket])
-> EncryptionLevel -> TVar [ReceivedPacket]
forall i e. Ix i => Array i e -> i -> e
! EncryptionLevel
lvl) (ReceivedPacket
rpkt ReceivedPacket -> [ReceivedPacket] -> [ReceivedPacket]
forall a. a -> [a] -> [a]
:)

waitEncryptionLevel :: Connection -> EncryptionLevel -> IO ()
waitEncryptionLevel :: Connection -> EncryptionLevel -> IO ()
waitEncryptionLevel Connection{Recv
Buffer
Array EncryptionLevel (TVar [ReceivedPacket])
IOArray Bool Coder1RTT
IOArray EncryptionLevel Cipher
IOArray EncryptionLevel Protector
IOArray EncryptionLevel Coder
ThreadId
TVar Bool
TVar Int
TVar TxFlow
TVar Concurrency
TVar MigrationState
TVar CIDDB
IORef Int
IORef (IO ())
IORef (Bool, Int)
IORef RxFlow
IORef UDPSocket
IORef Microseconds
IORef VersionInfo
IORef AuthCIDs
IORef Parameters
IORef StreamTable
IORef Concurrency
IORef Negotiated
IORef CIDDB
IORef RoleInfo
Rate
OutputQLim
MigrationQ
OutputQ
CryptoQ
InputQ
VersionInfo
RecvQ
SizedBuffer
ConnState
Parameters
LDCC
Hooks
Shared
Send
DebugLogger
QLogger
connState :: Connection -> ConnState
connDebugLog :: Connection -> DebugLogger
connQLog :: Connection -> QLogger
connHooks :: Connection -> Hooks
connSend :: Connection -> Send
connRecv :: Connection -> Recv
connRecvQ :: Connection -> RecvQ
udpSocket :: Connection -> IORef UDPSocket
readers :: Connection -> IORef (IO ())
mainThreadId :: Connection -> ThreadId
controlRate :: Connection -> Rate
roleInfo :: Connection -> IORef RoleInfo
quicVersionInfo :: Connection -> IORef VersionInfo
origVersionInfo :: Connection -> VersionInfo
myParameters :: Connection -> Parameters
myCIDDB :: Connection -> IORef CIDDB
peerParameters :: Connection -> IORef Parameters
peerCIDDB :: Connection -> TVar CIDDB
inputQ :: Connection -> InputQ
cryptoQ :: Connection -> CryptoQ
outputQ :: Connection -> OutputQ
outputQLim :: Connection -> OutputQLim
migrationQ :: Connection -> MigrationQ
shared :: Connection -> Shared
delayedAckCount :: Connection -> IORef Int
delayedAckCancel :: Connection -> IORef (IO ())
peerPacketNumber :: Connection -> IORef Int
streamTable :: Connection -> IORef StreamTable
myStreamId :: Connection -> TVar Concurrency
myUniStreamId :: Connection -> TVar Concurrency
peerStreamId :: Connection -> IORef Concurrency
peerUniStreamId :: Connection -> IORef Concurrency
flowTx :: Connection -> TVar TxFlow
flowRx :: Connection -> IORef RxFlow
migrationState :: Connection -> TVar MigrationState
minIdleTimeout :: Connection -> IORef Microseconds
bytesTx :: Connection -> TVar Int
bytesRx :: Connection -> TVar Int
addressValidated :: Connection -> TVar Bool
pendingQ :: Connection -> Array EncryptionLevel (TVar [ReceivedPacket])
ciphers :: Connection -> IOArray EncryptionLevel Cipher
coders :: Connection -> IOArray EncryptionLevel Coder
coders1RTT :: Connection -> IOArray Bool Coder1RTT
protectors :: Connection -> IOArray EncryptionLevel Protector
currentKeyPhase :: Connection -> IORef (Bool, Int)
negotiated :: Connection -> IORef Negotiated
connMyAuthCIDs :: Connection -> IORef AuthCIDs
connPeerAuthCIDs :: Connection -> IORef AuthCIDs
connResources :: Connection -> IORef (IO ())
encodeBuf :: Connection -> Buffer
encryptRes :: Connection -> SizedBuffer
decryptBuf :: Connection -> Buffer
connLDCC :: Connection -> LDCC
connState :: ConnState
connDebugLog :: DebugLogger
connQLog :: QLogger
connHooks :: Hooks
connSend :: Send
connRecv :: Recv
connRecvQ :: RecvQ
udpSocket :: IORef UDPSocket
readers :: IORef (IO ())
mainThreadId :: ThreadId
controlRate :: Rate
roleInfo :: IORef RoleInfo
quicVersionInfo :: IORef VersionInfo
origVersionInfo :: VersionInfo
myParameters :: Parameters
myCIDDB :: IORef CIDDB
peerParameters :: IORef Parameters
peerCIDDB :: TVar CIDDB
inputQ :: InputQ
cryptoQ :: CryptoQ
outputQ :: OutputQ
outputQLim :: OutputQLim
migrationQ :: MigrationQ
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
minIdleTimeout :: IORef Microseconds
bytesTx :: TVar Int
bytesRx :: TVar Int
addressValidated :: TVar Bool
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
connResources :: IORef (IO ())
encodeBuf :: Buffer
encryptRes :: SizedBuffer
decryptBuf :: Buffer
connLDCC :: LDCC
..} EncryptionLevel
lvl = STM () -> IO ()
forall (m :: * -> *) a. MonadIO m => STM a -> m a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
    EncryptionLevel
l <- TVar EncryptionLevel -> STM EncryptionLevel
forall a. TVar a -> STM a
readTVar (TVar EncryptionLevel -> STM EncryptionLevel)
-> TVar EncryptionLevel -> STM EncryptionLevel
forall a b. (a -> b) -> a -> b
$ ConnState -> TVar EncryptionLevel
encryptionLevel ConnState
connState
    Bool -> STM ()
checkSTM (EncryptionLevel
l EncryptionLevel -> EncryptionLevel -> Bool
forall a. Ord a => a -> a -> Bool
>= EncryptionLevel
lvl)

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

getCipher :: Connection -> EncryptionLevel -> IO Cipher
getCipher :: Connection -> EncryptionLevel -> IO Cipher
getCipher Connection{Recv
Buffer
Array EncryptionLevel (TVar [ReceivedPacket])
IOArray Bool Coder1RTT
IOArray EncryptionLevel Cipher
IOArray EncryptionLevel Protector
IOArray EncryptionLevel Coder
ThreadId
TVar Bool
TVar Int
TVar TxFlow
TVar Concurrency
TVar MigrationState
TVar CIDDB
IORef Int
IORef (IO ())
IORef (Bool, Int)
IORef RxFlow
IORef UDPSocket
IORef Microseconds
IORef VersionInfo
IORef AuthCIDs
IORef Parameters
IORef StreamTable
IORef Concurrency
IORef Negotiated
IORef CIDDB
IORef RoleInfo
Rate
OutputQLim
MigrationQ
OutputQ
CryptoQ
InputQ
VersionInfo
RecvQ
SizedBuffer
ConnState
Parameters
LDCC
Hooks
Shared
Send
DebugLogger
QLogger
connState :: Connection -> ConnState
connDebugLog :: Connection -> DebugLogger
connQLog :: Connection -> QLogger
connHooks :: Connection -> Hooks
connSend :: Connection -> Send
connRecv :: Connection -> Recv
connRecvQ :: Connection -> RecvQ
udpSocket :: Connection -> IORef UDPSocket
readers :: Connection -> IORef (IO ())
mainThreadId :: Connection -> ThreadId
controlRate :: Connection -> Rate
roleInfo :: Connection -> IORef RoleInfo
quicVersionInfo :: Connection -> IORef VersionInfo
origVersionInfo :: Connection -> VersionInfo
myParameters :: Connection -> Parameters
myCIDDB :: Connection -> IORef CIDDB
peerParameters :: Connection -> IORef Parameters
peerCIDDB :: Connection -> TVar CIDDB
inputQ :: Connection -> InputQ
cryptoQ :: Connection -> CryptoQ
outputQ :: Connection -> OutputQ
outputQLim :: Connection -> OutputQLim
migrationQ :: Connection -> MigrationQ
shared :: Connection -> Shared
delayedAckCount :: Connection -> IORef Int
delayedAckCancel :: Connection -> IORef (IO ())
peerPacketNumber :: Connection -> IORef Int
streamTable :: Connection -> IORef StreamTable
myStreamId :: Connection -> TVar Concurrency
myUniStreamId :: Connection -> TVar Concurrency
peerStreamId :: Connection -> IORef Concurrency
peerUniStreamId :: Connection -> IORef Concurrency
flowTx :: Connection -> TVar TxFlow
flowRx :: Connection -> IORef RxFlow
migrationState :: Connection -> TVar MigrationState
minIdleTimeout :: Connection -> IORef Microseconds
bytesTx :: Connection -> TVar Int
bytesRx :: Connection -> TVar Int
addressValidated :: Connection -> TVar Bool
pendingQ :: Connection -> Array EncryptionLevel (TVar [ReceivedPacket])
ciphers :: Connection -> IOArray EncryptionLevel Cipher
coders :: Connection -> IOArray EncryptionLevel Coder
coders1RTT :: Connection -> IOArray Bool Coder1RTT
protectors :: Connection -> IOArray EncryptionLevel Protector
currentKeyPhase :: Connection -> IORef (Bool, Int)
negotiated :: Connection -> IORef Negotiated
connMyAuthCIDs :: Connection -> IORef AuthCIDs
connPeerAuthCIDs :: Connection -> IORef AuthCIDs
connResources :: Connection -> IORef (IO ())
encodeBuf :: Connection -> Buffer
encryptRes :: Connection -> SizedBuffer
decryptBuf :: Connection -> Buffer
connLDCC :: Connection -> LDCC
connState :: ConnState
connDebugLog :: DebugLogger
connQLog :: QLogger
connHooks :: Hooks
connSend :: Send
connRecv :: Recv
connRecvQ :: RecvQ
udpSocket :: IORef UDPSocket
readers :: IORef (IO ())
mainThreadId :: ThreadId
controlRate :: Rate
roleInfo :: IORef RoleInfo
quicVersionInfo :: IORef VersionInfo
origVersionInfo :: VersionInfo
myParameters :: Parameters
myCIDDB :: IORef CIDDB
peerParameters :: IORef Parameters
peerCIDDB :: TVar CIDDB
inputQ :: InputQ
cryptoQ :: CryptoQ
outputQ :: OutputQ
outputQLim :: OutputQLim
migrationQ :: MigrationQ
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
minIdleTimeout :: IORef Microseconds
bytesTx :: TVar Int
bytesRx :: TVar Int
addressValidated :: TVar Bool
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
connResources :: IORef (IO ())
encodeBuf :: Buffer
encryptRes :: SizedBuffer
decryptBuf :: Buffer
connLDCC :: LDCC
..} EncryptionLevel
lvl = IOArray EncryptionLevel Cipher -> EncryptionLevel -> IO Cipher
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> m e
readArray IOArray EncryptionLevel Cipher
ciphers EncryptionLevel
lvl

setCipher :: Connection -> EncryptionLevel -> Cipher -> IO ()
setCipher :: Connection -> EncryptionLevel -> Cipher -> IO ()
setCipher Connection{Recv
Buffer
Array EncryptionLevel (TVar [ReceivedPacket])
IOArray Bool Coder1RTT
IOArray EncryptionLevel Cipher
IOArray EncryptionLevel Protector
IOArray EncryptionLevel Coder
ThreadId
TVar Bool
TVar Int
TVar TxFlow
TVar Concurrency
TVar MigrationState
TVar CIDDB
IORef Int
IORef (IO ())
IORef (Bool, Int)
IORef RxFlow
IORef UDPSocket
IORef Microseconds
IORef VersionInfo
IORef AuthCIDs
IORef Parameters
IORef StreamTable
IORef Concurrency
IORef Negotiated
IORef CIDDB
IORef RoleInfo
Rate
OutputQLim
MigrationQ
OutputQ
CryptoQ
InputQ
VersionInfo
RecvQ
SizedBuffer
ConnState
Parameters
LDCC
Hooks
Shared
Send
DebugLogger
QLogger
connState :: Connection -> ConnState
connDebugLog :: Connection -> DebugLogger
connQLog :: Connection -> QLogger
connHooks :: Connection -> Hooks
connSend :: Connection -> Send
connRecv :: Connection -> Recv
connRecvQ :: Connection -> RecvQ
udpSocket :: Connection -> IORef UDPSocket
readers :: Connection -> IORef (IO ())
mainThreadId :: Connection -> ThreadId
controlRate :: Connection -> Rate
roleInfo :: Connection -> IORef RoleInfo
quicVersionInfo :: Connection -> IORef VersionInfo
origVersionInfo :: Connection -> VersionInfo
myParameters :: Connection -> Parameters
myCIDDB :: Connection -> IORef CIDDB
peerParameters :: Connection -> IORef Parameters
peerCIDDB :: Connection -> TVar CIDDB
inputQ :: Connection -> InputQ
cryptoQ :: Connection -> CryptoQ
outputQ :: Connection -> OutputQ
outputQLim :: Connection -> OutputQLim
migrationQ :: Connection -> MigrationQ
shared :: Connection -> Shared
delayedAckCount :: Connection -> IORef Int
delayedAckCancel :: Connection -> IORef (IO ())
peerPacketNumber :: Connection -> IORef Int
streamTable :: Connection -> IORef StreamTable
myStreamId :: Connection -> TVar Concurrency
myUniStreamId :: Connection -> TVar Concurrency
peerStreamId :: Connection -> IORef Concurrency
peerUniStreamId :: Connection -> IORef Concurrency
flowTx :: Connection -> TVar TxFlow
flowRx :: Connection -> IORef RxFlow
migrationState :: Connection -> TVar MigrationState
minIdleTimeout :: Connection -> IORef Microseconds
bytesTx :: Connection -> TVar Int
bytesRx :: Connection -> TVar Int
addressValidated :: Connection -> TVar Bool
pendingQ :: Connection -> Array EncryptionLevel (TVar [ReceivedPacket])
ciphers :: Connection -> IOArray EncryptionLevel Cipher
coders :: Connection -> IOArray EncryptionLevel Coder
coders1RTT :: Connection -> IOArray Bool Coder1RTT
protectors :: Connection -> IOArray EncryptionLevel Protector
currentKeyPhase :: Connection -> IORef (Bool, Int)
negotiated :: Connection -> IORef Negotiated
connMyAuthCIDs :: Connection -> IORef AuthCIDs
connPeerAuthCIDs :: Connection -> IORef AuthCIDs
connResources :: Connection -> IORef (IO ())
encodeBuf :: Connection -> Buffer
encryptRes :: Connection -> SizedBuffer
decryptBuf :: Connection -> Buffer
connLDCC :: Connection -> LDCC
connState :: ConnState
connDebugLog :: DebugLogger
connQLog :: QLogger
connHooks :: Hooks
connSend :: Send
connRecv :: Recv
connRecvQ :: RecvQ
udpSocket :: IORef UDPSocket
readers :: IORef (IO ())
mainThreadId :: ThreadId
controlRate :: Rate
roleInfo :: IORef RoleInfo
quicVersionInfo :: IORef VersionInfo
origVersionInfo :: VersionInfo
myParameters :: Parameters
myCIDDB :: IORef CIDDB
peerParameters :: IORef Parameters
peerCIDDB :: TVar CIDDB
inputQ :: InputQ
cryptoQ :: CryptoQ
outputQ :: OutputQ
outputQLim :: OutputQLim
migrationQ :: MigrationQ
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
minIdleTimeout :: IORef Microseconds
bytesTx :: TVar Int
bytesRx :: TVar Int
addressValidated :: TVar Bool
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
connResources :: IORef (IO ())
encodeBuf :: Buffer
encryptRes :: SizedBuffer
decryptBuf :: Buffer
connLDCC :: LDCC
..} EncryptionLevel
lvl Cipher
cipher = IOArray EncryptionLevel Cipher
-> EncryptionLevel -> Cipher -> IO ()
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray IOArray EncryptionLevel Cipher
ciphers EncryptionLevel
lvl Cipher
cipher

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

getTLSMode :: Connection -> IO HandshakeMode13
getTLSMode :: Connection -> IO HandshakeMode13
getTLSMode Connection{Recv
Buffer
Array EncryptionLevel (TVar [ReceivedPacket])
IOArray Bool Coder1RTT
IOArray EncryptionLevel Cipher
IOArray EncryptionLevel Protector
IOArray EncryptionLevel Coder
ThreadId
TVar Bool
TVar Int
TVar TxFlow
TVar Concurrency
TVar MigrationState
TVar CIDDB
IORef Int
IORef (IO ())
IORef (Bool, Int)
IORef RxFlow
IORef UDPSocket
IORef Microseconds
IORef VersionInfo
IORef AuthCIDs
IORef Parameters
IORef StreamTable
IORef Concurrency
IORef Negotiated
IORef CIDDB
IORef RoleInfo
Rate
OutputQLim
MigrationQ
OutputQ
CryptoQ
InputQ
VersionInfo
RecvQ
SizedBuffer
ConnState
Parameters
LDCC
Hooks
Shared
Send
DebugLogger
QLogger
connState :: Connection -> ConnState
connDebugLog :: Connection -> DebugLogger
connQLog :: Connection -> QLogger
connHooks :: Connection -> Hooks
connSend :: Connection -> Send
connRecv :: Connection -> Recv
connRecvQ :: Connection -> RecvQ
udpSocket :: Connection -> IORef UDPSocket
readers :: Connection -> IORef (IO ())
mainThreadId :: Connection -> ThreadId
controlRate :: Connection -> Rate
roleInfo :: Connection -> IORef RoleInfo
quicVersionInfo :: Connection -> IORef VersionInfo
origVersionInfo :: Connection -> VersionInfo
myParameters :: Connection -> Parameters
myCIDDB :: Connection -> IORef CIDDB
peerParameters :: Connection -> IORef Parameters
peerCIDDB :: Connection -> TVar CIDDB
inputQ :: Connection -> InputQ
cryptoQ :: Connection -> CryptoQ
outputQ :: Connection -> OutputQ
outputQLim :: Connection -> OutputQLim
migrationQ :: Connection -> MigrationQ
shared :: Connection -> Shared
delayedAckCount :: Connection -> IORef Int
delayedAckCancel :: Connection -> IORef (IO ())
peerPacketNumber :: Connection -> IORef Int
streamTable :: Connection -> IORef StreamTable
myStreamId :: Connection -> TVar Concurrency
myUniStreamId :: Connection -> TVar Concurrency
peerStreamId :: Connection -> IORef Concurrency
peerUniStreamId :: Connection -> IORef Concurrency
flowTx :: Connection -> TVar TxFlow
flowRx :: Connection -> IORef RxFlow
migrationState :: Connection -> TVar MigrationState
minIdleTimeout :: Connection -> IORef Microseconds
bytesTx :: Connection -> TVar Int
bytesRx :: Connection -> TVar Int
addressValidated :: Connection -> TVar Bool
pendingQ :: Connection -> Array EncryptionLevel (TVar [ReceivedPacket])
ciphers :: Connection -> IOArray EncryptionLevel Cipher
coders :: Connection -> IOArray EncryptionLevel Coder
coders1RTT :: Connection -> IOArray Bool Coder1RTT
protectors :: Connection -> IOArray EncryptionLevel Protector
currentKeyPhase :: Connection -> IORef (Bool, Int)
negotiated :: Connection -> IORef Negotiated
connMyAuthCIDs :: Connection -> IORef AuthCIDs
connPeerAuthCIDs :: Connection -> IORef AuthCIDs
connResources :: Connection -> IORef (IO ())
encodeBuf :: Connection -> Buffer
encryptRes :: Connection -> SizedBuffer
decryptBuf :: Connection -> Buffer
connLDCC :: Connection -> LDCC
connState :: ConnState
connDebugLog :: DebugLogger
connQLog :: QLogger
connHooks :: Hooks
connSend :: Send
connRecv :: Recv
connRecvQ :: RecvQ
udpSocket :: IORef UDPSocket
readers :: IORef (IO ())
mainThreadId :: ThreadId
controlRate :: Rate
roleInfo :: IORef RoleInfo
quicVersionInfo :: IORef VersionInfo
origVersionInfo :: VersionInfo
myParameters :: Parameters
myCIDDB :: IORef CIDDB
peerParameters :: IORef Parameters
peerCIDDB :: TVar CIDDB
inputQ :: InputQ
cryptoQ :: CryptoQ
outputQ :: OutputQ
outputQLim :: OutputQLim
migrationQ :: MigrationQ
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
minIdleTimeout :: IORef Microseconds
bytesTx :: TVar Int
bytesRx :: TVar Int
addressValidated :: TVar Bool
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
connResources :: IORef (IO ())
encodeBuf :: Buffer
encryptRes :: SizedBuffer
decryptBuf :: Buffer
connLDCC :: LDCC
..} = Negotiated -> HandshakeMode13
tlsHandshakeMode (Negotiated -> HandshakeMode13)
-> IO Negotiated -> IO HandshakeMode13
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IORef Negotiated -> IO Negotiated
forall a. IORef a -> IO a
readIORef IORef Negotiated
negotiated

getApplicationProtocol :: Connection -> IO (Maybe NegotiatedProtocol)
getApplicationProtocol :: Connection -> IO (Maybe NegotiatedProtocol)
getApplicationProtocol Connection{Recv
Buffer
Array EncryptionLevel (TVar [ReceivedPacket])
IOArray Bool Coder1RTT
IOArray EncryptionLevel Cipher
IOArray EncryptionLevel Protector
IOArray EncryptionLevel Coder
ThreadId
TVar Bool
TVar Int
TVar TxFlow
TVar Concurrency
TVar MigrationState
TVar CIDDB
IORef Int
IORef (IO ())
IORef (Bool, Int)
IORef RxFlow
IORef UDPSocket
IORef Microseconds
IORef VersionInfo
IORef AuthCIDs
IORef Parameters
IORef StreamTable
IORef Concurrency
IORef Negotiated
IORef CIDDB
IORef RoleInfo
Rate
OutputQLim
MigrationQ
OutputQ
CryptoQ
InputQ
VersionInfo
RecvQ
SizedBuffer
ConnState
Parameters
LDCC
Hooks
Shared
Send
DebugLogger
QLogger
connState :: Connection -> ConnState
connDebugLog :: Connection -> DebugLogger
connQLog :: Connection -> QLogger
connHooks :: Connection -> Hooks
connSend :: Connection -> Send
connRecv :: Connection -> Recv
connRecvQ :: Connection -> RecvQ
udpSocket :: Connection -> IORef UDPSocket
readers :: Connection -> IORef (IO ())
mainThreadId :: Connection -> ThreadId
controlRate :: Connection -> Rate
roleInfo :: Connection -> IORef RoleInfo
quicVersionInfo :: Connection -> IORef VersionInfo
origVersionInfo :: Connection -> VersionInfo
myParameters :: Connection -> Parameters
myCIDDB :: Connection -> IORef CIDDB
peerParameters :: Connection -> IORef Parameters
peerCIDDB :: Connection -> TVar CIDDB
inputQ :: Connection -> InputQ
cryptoQ :: Connection -> CryptoQ
outputQ :: Connection -> OutputQ
outputQLim :: Connection -> OutputQLim
migrationQ :: Connection -> MigrationQ
shared :: Connection -> Shared
delayedAckCount :: Connection -> IORef Int
delayedAckCancel :: Connection -> IORef (IO ())
peerPacketNumber :: Connection -> IORef Int
streamTable :: Connection -> IORef StreamTable
myStreamId :: Connection -> TVar Concurrency
myUniStreamId :: Connection -> TVar Concurrency
peerStreamId :: Connection -> IORef Concurrency
peerUniStreamId :: Connection -> IORef Concurrency
flowTx :: Connection -> TVar TxFlow
flowRx :: Connection -> IORef RxFlow
migrationState :: Connection -> TVar MigrationState
minIdleTimeout :: Connection -> IORef Microseconds
bytesTx :: Connection -> TVar Int
bytesRx :: Connection -> TVar Int
addressValidated :: Connection -> TVar Bool
pendingQ :: Connection -> Array EncryptionLevel (TVar [ReceivedPacket])
ciphers :: Connection -> IOArray EncryptionLevel Cipher
coders :: Connection -> IOArray EncryptionLevel Coder
coders1RTT :: Connection -> IOArray Bool Coder1RTT
protectors :: Connection -> IOArray EncryptionLevel Protector
currentKeyPhase :: Connection -> IORef (Bool, Int)
negotiated :: Connection -> IORef Negotiated
connMyAuthCIDs :: Connection -> IORef AuthCIDs
connPeerAuthCIDs :: Connection -> IORef AuthCIDs
connResources :: Connection -> IORef (IO ())
encodeBuf :: Connection -> Buffer
encryptRes :: Connection -> SizedBuffer
decryptBuf :: Connection -> Buffer
connLDCC :: Connection -> LDCC
connState :: ConnState
connDebugLog :: DebugLogger
connQLog :: QLogger
connHooks :: Hooks
connSend :: Send
connRecv :: Recv
connRecvQ :: RecvQ
udpSocket :: IORef UDPSocket
readers :: IORef (IO ())
mainThreadId :: ThreadId
controlRate :: Rate
roleInfo :: IORef RoleInfo
quicVersionInfo :: IORef VersionInfo
origVersionInfo :: VersionInfo
myParameters :: Parameters
myCIDDB :: IORef CIDDB
peerParameters :: IORef Parameters
peerCIDDB :: TVar CIDDB
inputQ :: InputQ
cryptoQ :: CryptoQ
outputQ :: OutputQ
outputQLim :: OutputQLim
migrationQ :: MigrationQ
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
minIdleTimeout :: IORef Microseconds
bytesTx :: TVar Int
bytesRx :: TVar Int
addressValidated :: TVar Bool
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
connResources :: IORef (IO ())
encodeBuf :: Buffer
encryptRes :: SizedBuffer
decryptBuf :: Buffer
connLDCC :: LDCC
..} = Negotiated -> Maybe NegotiatedProtocol
applicationProtocol (Negotiated -> Maybe NegotiatedProtocol)
-> IO Negotiated -> IO (Maybe NegotiatedProtocol)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IORef Negotiated -> IO Negotiated
forall a. IORef a -> IO a
readIORef IORef Negotiated
negotiated

setNegotiated
    :: Connection
    -> HandshakeMode13
    -> Maybe NegotiatedProtocol
    -> ApplicationSecretInfo
    -> IO ()
setNegotiated :: Connection
-> HandshakeMode13
-> Maybe NegotiatedProtocol
-> ApplicationSecretInfo
-> IO ()
setNegotiated Connection{Recv
Buffer
Array EncryptionLevel (TVar [ReceivedPacket])
IOArray Bool Coder1RTT
IOArray EncryptionLevel Cipher
IOArray EncryptionLevel Protector
IOArray EncryptionLevel Coder
ThreadId
TVar Bool
TVar Int
TVar TxFlow
TVar Concurrency
TVar MigrationState
TVar CIDDB
IORef Int
IORef (IO ())
IORef (Bool, Int)
IORef RxFlow
IORef UDPSocket
IORef Microseconds
IORef VersionInfo
IORef AuthCIDs
IORef Parameters
IORef StreamTable
IORef Concurrency
IORef Negotiated
IORef CIDDB
IORef RoleInfo
Rate
OutputQLim
MigrationQ
OutputQ
CryptoQ
InputQ
VersionInfo
RecvQ
SizedBuffer
ConnState
Parameters
LDCC
Hooks
Shared
Send
DebugLogger
QLogger
connState :: Connection -> ConnState
connDebugLog :: Connection -> DebugLogger
connQLog :: Connection -> QLogger
connHooks :: Connection -> Hooks
connSend :: Connection -> Send
connRecv :: Connection -> Recv
connRecvQ :: Connection -> RecvQ
udpSocket :: Connection -> IORef UDPSocket
readers :: Connection -> IORef (IO ())
mainThreadId :: Connection -> ThreadId
controlRate :: Connection -> Rate
roleInfo :: Connection -> IORef RoleInfo
quicVersionInfo :: Connection -> IORef VersionInfo
origVersionInfo :: Connection -> VersionInfo
myParameters :: Connection -> Parameters
myCIDDB :: Connection -> IORef CIDDB
peerParameters :: Connection -> IORef Parameters
peerCIDDB :: Connection -> TVar CIDDB
inputQ :: Connection -> InputQ
cryptoQ :: Connection -> CryptoQ
outputQ :: Connection -> OutputQ
outputQLim :: Connection -> OutputQLim
migrationQ :: Connection -> MigrationQ
shared :: Connection -> Shared
delayedAckCount :: Connection -> IORef Int
delayedAckCancel :: Connection -> IORef (IO ())
peerPacketNumber :: Connection -> IORef Int
streamTable :: Connection -> IORef StreamTable
myStreamId :: Connection -> TVar Concurrency
myUniStreamId :: Connection -> TVar Concurrency
peerStreamId :: Connection -> IORef Concurrency
peerUniStreamId :: Connection -> IORef Concurrency
flowTx :: Connection -> TVar TxFlow
flowRx :: Connection -> IORef RxFlow
migrationState :: Connection -> TVar MigrationState
minIdleTimeout :: Connection -> IORef Microseconds
bytesTx :: Connection -> TVar Int
bytesRx :: Connection -> TVar Int
addressValidated :: Connection -> TVar Bool
pendingQ :: Connection -> Array EncryptionLevel (TVar [ReceivedPacket])
ciphers :: Connection -> IOArray EncryptionLevel Cipher
coders :: Connection -> IOArray EncryptionLevel Coder
coders1RTT :: Connection -> IOArray Bool Coder1RTT
protectors :: Connection -> IOArray EncryptionLevel Protector
currentKeyPhase :: Connection -> IORef (Bool, Int)
negotiated :: Connection -> IORef Negotiated
connMyAuthCIDs :: Connection -> IORef AuthCIDs
connPeerAuthCIDs :: Connection -> IORef AuthCIDs
connResources :: Connection -> IORef (IO ())
encodeBuf :: Connection -> Buffer
encryptRes :: Connection -> SizedBuffer
decryptBuf :: Connection -> Buffer
connLDCC :: Connection -> LDCC
connState :: ConnState
connDebugLog :: DebugLogger
connQLog :: QLogger
connHooks :: Hooks
connSend :: Send
connRecv :: Recv
connRecvQ :: RecvQ
udpSocket :: IORef UDPSocket
readers :: IORef (IO ())
mainThreadId :: ThreadId
controlRate :: Rate
roleInfo :: IORef RoleInfo
quicVersionInfo :: IORef VersionInfo
origVersionInfo :: VersionInfo
myParameters :: Parameters
myCIDDB :: IORef CIDDB
peerParameters :: IORef Parameters
peerCIDDB :: TVar CIDDB
inputQ :: InputQ
cryptoQ :: CryptoQ
outputQ :: OutputQ
outputQLim :: OutputQLim
migrationQ :: MigrationQ
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
minIdleTimeout :: IORef Microseconds
bytesTx :: TVar Int
bytesRx :: TVar Int
addressValidated :: TVar Bool
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
connResources :: IORef (IO ())
encodeBuf :: Buffer
encryptRes :: SizedBuffer
decryptBuf :: Buffer
connLDCC :: LDCC
..} HandshakeMode13
mode Maybe NegotiatedProtocol
mproto ApplicationSecretInfo
appSecInf =
    IORef Negotiated -> Negotiated -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef
        IORef Negotiated
negotiated
        Negotiated
            { tlsHandshakeMode :: HandshakeMode13
tlsHandshakeMode = HandshakeMode13
mode
            , applicationProtocol :: Maybe NegotiatedProtocol
applicationProtocol = Maybe NegotiatedProtocol
mproto
            , applicationSecretInfo :: ApplicationSecretInfo
applicationSecretInfo = ApplicationSecretInfo
appSecInf
            }

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

dropSecrets :: Connection -> EncryptionLevel -> IO ()
dropSecrets :: Connection -> EncryptionLevel -> IO ()
dropSecrets Connection{Recv
Buffer
Array EncryptionLevel (TVar [ReceivedPacket])
IOArray Bool Coder1RTT
IOArray EncryptionLevel Cipher
IOArray EncryptionLevel Protector
IOArray EncryptionLevel Coder
ThreadId
TVar Bool
TVar Int
TVar TxFlow
TVar Concurrency
TVar MigrationState
TVar CIDDB
IORef Int
IORef (IO ())
IORef (Bool, Int)
IORef RxFlow
IORef UDPSocket
IORef Microseconds
IORef VersionInfo
IORef AuthCIDs
IORef Parameters
IORef StreamTable
IORef Concurrency
IORef Negotiated
IORef CIDDB
IORef RoleInfo
Rate
OutputQLim
MigrationQ
OutputQ
CryptoQ
InputQ
VersionInfo
RecvQ
SizedBuffer
ConnState
Parameters
LDCC
Hooks
Shared
Send
DebugLogger
QLogger
connState :: Connection -> ConnState
connDebugLog :: Connection -> DebugLogger
connQLog :: Connection -> QLogger
connHooks :: Connection -> Hooks
connSend :: Connection -> Send
connRecv :: Connection -> Recv
connRecvQ :: Connection -> RecvQ
udpSocket :: Connection -> IORef UDPSocket
readers :: Connection -> IORef (IO ())
mainThreadId :: Connection -> ThreadId
controlRate :: Connection -> Rate
roleInfo :: Connection -> IORef RoleInfo
quicVersionInfo :: Connection -> IORef VersionInfo
origVersionInfo :: Connection -> VersionInfo
myParameters :: Connection -> Parameters
myCIDDB :: Connection -> IORef CIDDB
peerParameters :: Connection -> IORef Parameters
peerCIDDB :: Connection -> TVar CIDDB
inputQ :: Connection -> InputQ
cryptoQ :: Connection -> CryptoQ
outputQ :: Connection -> OutputQ
outputQLim :: Connection -> OutputQLim
migrationQ :: Connection -> MigrationQ
shared :: Connection -> Shared
delayedAckCount :: Connection -> IORef Int
delayedAckCancel :: Connection -> IORef (IO ())
peerPacketNumber :: Connection -> IORef Int
streamTable :: Connection -> IORef StreamTable
myStreamId :: Connection -> TVar Concurrency
myUniStreamId :: Connection -> TVar Concurrency
peerStreamId :: Connection -> IORef Concurrency
peerUniStreamId :: Connection -> IORef Concurrency
flowTx :: Connection -> TVar TxFlow
flowRx :: Connection -> IORef RxFlow
migrationState :: Connection -> TVar MigrationState
minIdleTimeout :: Connection -> IORef Microseconds
bytesTx :: Connection -> TVar Int
bytesRx :: Connection -> TVar Int
addressValidated :: Connection -> TVar Bool
pendingQ :: Connection -> Array EncryptionLevel (TVar [ReceivedPacket])
ciphers :: Connection -> IOArray EncryptionLevel Cipher
coders :: Connection -> IOArray EncryptionLevel Coder
coders1RTT :: Connection -> IOArray Bool Coder1RTT
protectors :: Connection -> IOArray EncryptionLevel Protector
currentKeyPhase :: Connection -> IORef (Bool, Int)
negotiated :: Connection -> IORef Negotiated
connMyAuthCIDs :: Connection -> IORef AuthCIDs
connPeerAuthCIDs :: Connection -> IORef AuthCIDs
connResources :: Connection -> IORef (IO ())
encodeBuf :: Connection -> Buffer
encryptRes :: Connection -> SizedBuffer
decryptBuf :: Connection -> Buffer
connLDCC :: Connection -> LDCC
connState :: ConnState
connDebugLog :: DebugLogger
connQLog :: QLogger
connHooks :: Hooks
connSend :: Send
connRecv :: Recv
connRecvQ :: RecvQ
udpSocket :: IORef UDPSocket
readers :: IORef (IO ())
mainThreadId :: ThreadId
controlRate :: Rate
roleInfo :: IORef RoleInfo
quicVersionInfo :: IORef VersionInfo
origVersionInfo :: VersionInfo
myParameters :: Parameters
myCIDDB :: IORef CIDDB
peerParameters :: IORef Parameters
peerCIDDB :: TVar CIDDB
inputQ :: InputQ
cryptoQ :: CryptoQ
outputQ :: OutputQ
outputQLim :: OutputQLim
migrationQ :: MigrationQ
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
minIdleTimeout :: IORef Microseconds
bytesTx :: TVar Int
bytesRx :: TVar Int
addressValidated :: TVar Bool
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
connResources :: IORef (IO ())
encodeBuf :: Buffer
encryptRes :: SizedBuffer
decryptBuf :: Buffer
connLDCC :: LDCC
..} EncryptionLevel
lvl = do
    IOArray EncryptionLevel Coder -> EncryptionLevel -> Coder -> IO ()
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray IOArray EncryptionLevel Coder
coders EncryptionLevel
lvl Coder
initialCoder
    IOArray EncryptionLevel Protector
-> EncryptionLevel -> Protector -> IO ()
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray IOArray EncryptionLevel Protector
protectors EncryptionLevel
lvl Protector
initialProtector

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

initializeCoder :: Connection -> EncryptionLevel -> TrafficSecrets a -> IO ()
initializeCoder :: forall a.
Connection -> EncryptionLevel -> TrafficSecrets a -> IO ()
initializeCoder Connection
conn EncryptionLevel
lvl TrafficSecrets a
sec = do
    Version
ver <-
        if EncryptionLevel
lvl EncryptionLevel -> EncryptionLevel -> Bool
forall a. Eq a => a -> a -> Bool
== EncryptionLevel
RTT0Level
            then Version -> IO Version
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Version -> IO Version) -> Version -> IO Version
forall a b. (a -> b) -> a -> b
$ Connection -> Version
getOriginalVersion Connection
conn
            else Connection -> IO Version
getVersion Connection
conn
    Cipher
cipher <- Connection -> EncryptionLevel -> IO Cipher
getCipher Connection
conn EncryptionLevel
lvl
    Bool
avail <- IO Bool
isFusionAvailable
    (Coder
coder, Protector
protector) <-
        if Bool
useFusion Bool -> Bool -> Bool
&& Bool
avail
            then Bool
-> Version -> Cipher -> TrafficSecrets a -> IO (Coder, Protector)
forall a.
Bool
-> Version -> Cipher -> TrafficSecrets a -> IO (Coder, Protector)
genFusionCoder (Connection -> Bool
forall a. Connector a => a -> Bool
isClient Connection
conn) Version
ver Cipher
cipher TrafficSecrets a
sec
            else Bool
-> Version -> Cipher -> TrafficSecrets a -> IO (Coder, Protector)
forall a.
Bool
-> Version -> Cipher -> TrafficSecrets a -> IO (Coder, Protector)
genNiteCoder (Connection -> Bool
forall a. Connector a => a -> Bool
isClient Connection
conn) Version
ver Cipher
cipher TrafficSecrets a
sec
    IOArray EncryptionLevel Coder -> EncryptionLevel -> Coder -> IO ()
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray (Connection -> IOArray EncryptionLevel Coder
coders Connection
conn) EncryptionLevel
lvl Coder
coder
    IOArray EncryptionLevel Protector
-> EncryptionLevel -> Protector -> IO ()
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray (Connection -> IOArray EncryptionLevel Protector
protectors Connection
conn) EncryptionLevel
lvl Protector
protector

initializeCoder1RTT :: Connection -> TrafficSecrets ApplicationSecret -> IO ()
initializeCoder1RTT :: Connection -> TrafficSecrets ApplicationSecret -> IO ()
initializeCoder1RTT Connection
conn TrafficSecrets ApplicationSecret
sec = do
    Version
ver <- Connection -> IO Version
getVersion Connection
conn
    Cipher
cipher <- Connection -> EncryptionLevel -> IO Cipher
getCipher Connection
conn EncryptionLevel
RTT1Level
    Bool
avail <- IO Bool
isFusionAvailable
    (Coder
coder, Protector
protector) <-
        if Bool
useFusion Bool -> Bool -> Bool
&& Bool
avail
            then Bool
-> Version
-> Cipher
-> TrafficSecrets ApplicationSecret
-> IO (Coder, Protector)
forall a.
Bool
-> Version -> Cipher -> TrafficSecrets a -> IO (Coder, Protector)
genFusionCoder (Connection -> Bool
forall a. Connector a => a -> Bool
isClient Connection
conn) Version
ver Cipher
cipher TrafficSecrets ApplicationSecret
sec
            else Bool
-> Version
-> Cipher
-> TrafficSecrets ApplicationSecret
-> IO (Coder, Protector)
forall a.
Bool
-> Version -> Cipher -> TrafficSecrets a -> IO (Coder, Protector)
genNiteCoder (Connection -> Bool
forall a. Connector a => a -> Bool
isClient Connection
conn) Version
ver Cipher
cipher TrafficSecrets ApplicationSecret
sec
    let coder1 :: Coder1RTT
coder1 = Coder -> TrafficSecrets ApplicationSecret -> Coder1RTT
Coder1RTT Coder
coder TrafficSecrets ApplicationSecret
sec
    IOArray Bool Coder1RTT -> Bool -> Coder1RTT -> IO ()
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray (Connection -> IOArray Bool Coder1RTT
coders1RTT Connection
conn) Bool
False Coder1RTT
coder1
    IOArray EncryptionLevel Protector
-> EncryptionLevel -> Protector -> IO ()
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray (Connection -> IOArray EncryptionLevel Protector
protectors Connection
conn) EncryptionLevel
RTT1Level Protector
protector
    Connection -> Bool -> IO ()
updateCoder1RTT Connection
conn Bool
True

updateCoder1RTT :: Connection -> Bool -> IO ()
updateCoder1RTT :: Connection -> Bool -> IO ()
updateCoder1RTT Connection
conn Bool
nextPhase = do
    Version
ver <- Connection -> IO Version
getVersion Connection
conn
    Cipher
cipher <- Connection -> EncryptionLevel -> IO Cipher
getCipher Connection
conn EncryptionLevel
RTT1Level
    Coder1RTT Coder
coder TrafficSecrets ApplicationSecret
secN <- IOArray Bool Coder1RTT -> Bool -> IO Coder1RTT
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> m e
readArray (Connection -> IOArray Bool Coder1RTT
coders1RTT Connection
conn) (Bool -> Bool
not Bool
nextPhase)
    let secN1 :: TrafficSecrets ApplicationSecret
secN1 = Version
-> Cipher
-> TrafficSecrets ApplicationSecret
-> TrafficSecrets ApplicationSecret
updateSecret Version
ver Cipher
cipher TrafficSecrets ApplicationSecret
secN
    Bool
avail <- IO Bool
isFusionAvailable
    Coder
coderN1 <-
        if Bool
useFusion Bool -> Bool -> Bool
&& Bool
avail
            then Bool
-> Version
-> Cipher
-> TrafficSecrets ApplicationSecret
-> Coder
-> IO Coder
forall a.
Bool -> Version -> Cipher -> TrafficSecrets a -> Coder -> IO Coder
genFusionCoder1RTT (Connection -> Bool
forall a. Connector a => a -> Bool
isClient Connection
conn) Version
ver Cipher
cipher TrafficSecrets ApplicationSecret
secN1 Coder
coder
            else Bool
-> Version
-> Cipher
-> TrafficSecrets ApplicationSecret
-> Coder
-> IO Coder
forall a.
Bool -> Version -> Cipher -> TrafficSecrets a -> Coder -> IO Coder
genNiteCoder1RTT (Connection -> Bool
forall a. Connector a => a -> Bool
isClient Connection
conn) Version
ver Cipher
cipher TrafficSecrets ApplicationSecret
secN1 Coder
coder
    let nextCoder :: Coder1RTT
nextCoder = Coder -> TrafficSecrets ApplicationSecret -> Coder1RTT
Coder1RTT Coder
coderN1 TrafficSecrets ApplicationSecret
secN1
    IOArray Bool Coder1RTT -> Bool -> Coder1RTT -> IO ()
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray (Connection -> IOArray Bool Coder1RTT
coders1RTT Connection
conn) Bool
nextPhase Coder1RTT
nextCoder

updateSecret
    :: Version
    -> Cipher
    -> TrafficSecrets ApplicationSecret
    -> TrafficSecrets ApplicationSecret
updateSecret :: Version
-> Cipher
-> TrafficSecrets ApplicationSecret
-> TrafficSecrets ApplicationSecret
updateSecret Version
ver Cipher
cipher (ClientTrafficSecret NegotiatedProtocol
cN, ServerTrafficSecret NegotiatedProtocol
sN) = TrafficSecrets ApplicationSecret
forall {a} {a}. (ClientTrafficSecret a, ServerTrafficSecret a)
secN1
  where
    Secret NegotiatedProtocol
cN1 = Version -> Cipher -> Secret -> Secret
nextSecret Version
ver Cipher
cipher (Secret -> Secret) -> Secret -> Secret
forall a b. (a -> b) -> a -> b
$ NegotiatedProtocol -> Secret
Secret NegotiatedProtocol
cN
    Secret NegotiatedProtocol
sN1 = Version -> Cipher -> Secret -> Secret
nextSecret Version
ver Cipher
cipher (Secret -> Secret) -> Secret -> Secret
forall a b. (a -> b) -> a -> b
$ NegotiatedProtocol -> Secret
Secret NegotiatedProtocol
sN
    secN1 :: (ClientTrafficSecret a, ServerTrafficSecret a)
secN1 = (NegotiatedProtocol -> ClientTrafficSecret a
forall a. NegotiatedProtocol -> ClientTrafficSecret a
ClientTrafficSecret NegotiatedProtocol
cN1, NegotiatedProtocol -> ServerTrafficSecret a
forall a. NegotiatedProtocol -> ServerTrafficSecret a
ServerTrafficSecret NegotiatedProtocol
sN1)

genFusionCoder
    :: Bool -> Version -> Cipher -> TrafficSecrets a -> IO (Coder, Protector)
genFusionCoder :: forall a.
Bool
-> Version -> Cipher -> TrafficSecrets a -> IO (Coder, Protector)
genFusionCoder Bool
cli Version
ver Cipher
cipher (ClientTrafficSecret NegotiatedProtocol
c, ServerTrafficSecret NegotiatedProtocol
s) = do
    FusionContext
fctxt <- IO FusionContext
fusionNewContext
    FusionContext
fctxr <- IO FusionContext
fusionNewContext
    Cipher -> FusionContext -> Key -> IV -> IO ()
fusionSetup Cipher
cipher FusionContext
fctxt Key
txPayloadKey IV
txPayloadIV
    Cipher -> FusionContext -> Key -> IV -> IO ()
fusionSetup Cipher
cipher FusionContext
fctxr Key
rxPayloadKey IV
rxPayloadIV
    Supplement
supp <- Cipher -> Key -> IO Supplement
fusionSetupSupplement Cipher
cipher Key
txHeaderKey
    let coder :: Coder
coder =
            Coder
                { encrypt :: Buffer -> NegotiatedProtocol -> AssDat -> Int -> IO Int
encrypt = FusionContext
-> Supplement
-> Buffer
-> NegotiatedProtocol
-> AssDat
-> Int
-> IO Int
fusionEncrypt FusionContext
fctxt Supplement
supp
                , decrypt :: Buffer -> NegotiatedProtocol -> AssDat -> Int -> IO Int
decrypt = FusionContext
-> Buffer -> NegotiatedProtocol -> AssDat -> Int -> IO Int
fusionDecrypt FusionContext
fctxr
                , supplement :: Maybe Supplement
supplement = Supplement -> Maybe Supplement
forall a. a -> Maybe a
Just Supplement
supp
                }
    let protector :: Protector
protector =
            Protector
                { setSample :: Buffer -> IO ()
setSample = Supplement -> Buffer -> IO ()
fusionSetSample Supplement
supp
                , getMask :: IO Buffer
getMask = Supplement -> IO Buffer
fusionGetMask Supplement
supp
                , unprotect :: Sample -> Mask
unprotect = Sample -> Mask
unp
                }
    (Coder, Protector) -> IO (Coder, Protector)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Coder
coder, Protector
protector)
  where
    txSecret :: Secret
txSecret
        | Bool
cli = NegotiatedProtocol -> Secret
Secret NegotiatedProtocol
c
        | Bool
otherwise = NegotiatedProtocol -> Secret
Secret NegotiatedProtocol
s
    rxSecret :: Secret
rxSecret
        | Bool
cli = NegotiatedProtocol -> Secret
Secret NegotiatedProtocol
s
        | Bool
otherwise = NegotiatedProtocol -> Secret
Secret NegotiatedProtocol
c
    txPayloadKey :: Key
txPayloadKey = Version -> Cipher -> Secret -> Key
aeadKey Version
ver Cipher
cipher Secret
txSecret
    txPayloadIV :: IV
txPayloadIV = Version -> Cipher -> Secret -> IV
initialVector Version
ver Cipher
cipher Secret
txSecret
    txHeaderKey :: Key
txHeaderKey = Version -> Cipher -> Secret -> Key
headerProtectionKey Version
ver Cipher
cipher Secret
txSecret
    rxPayloadKey :: Key
rxPayloadKey = Version -> Cipher -> Secret -> Key
aeadKey Version
ver Cipher
cipher Secret
rxSecret
    rxPayloadIV :: IV
rxPayloadIV = Version -> Cipher -> Secret -> IV
initialVector Version
ver Cipher
cipher Secret
rxSecret
    rxHeaderKey :: Key
rxHeaderKey = Version -> Cipher -> Secret -> Key
headerProtectionKey Version
ver Cipher
cipher Secret
rxSecret
    unp :: Sample -> Mask
unp = Cipher -> Key -> Sample -> Mask
protectionMask Cipher
cipher Key
rxHeaderKey

genNiteCoder
    :: Bool -> Version -> Cipher -> TrafficSecrets a -> IO (Coder, Protector)
genNiteCoder :: forall a.
Bool
-> Version -> Cipher -> TrafficSecrets a -> IO (Coder, Protector)
genNiteCoder Bool
cli Version
ver Cipher
cipher (ClientTrafficSecret NegotiatedProtocol
c, ServerTrafficSecret NegotiatedProtocol
s) = do
    let enc :: Buffer -> NegotiatedProtocol -> AssDat -> Int -> IO Int
enc = Cipher
-> Key
-> IV
-> Buffer
-> NegotiatedProtocol
-> AssDat
-> Int
-> IO Int
makeNiteEncrypt Cipher
cipher Key
txPayloadKey IV
txPayloadIV
        dec :: Buffer -> NegotiatedProtocol -> AssDat -> Int -> IO Int
dec = Cipher
-> Key
-> IV
-> Buffer
-> NegotiatedProtocol
-> AssDat
-> Int
-> IO Int
makeNiteDecrypt Cipher
cipher Key
rxPayloadKey IV
rxPayloadIV
    (Buffer -> IO ()
set, IO Buffer
get) <- Cipher -> Key -> IO (Buffer -> IO (), IO Buffer)
makeNiteProtector Cipher
cipher Key
txHeaderKey
    let coder :: Coder
coder =
            Coder
                { encrypt :: Buffer -> NegotiatedProtocol -> AssDat -> Int -> IO Int
encrypt = Buffer -> NegotiatedProtocol -> AssDat -> Int -> IO Int
enc
                , decrypt :: Buffer -> NegotiatedProtocol -> AssDat -> Int -> IO Int
decrypt = Buffer -> NegotiatedProtocol -> AssDat -> Int -> IO Int
dec
                , supplement :: Maybe Supplement
supplement = Maybe Supplement
forall a. Maybe a
Nothing
                }
    let protector :: Protector
protector =
            Protector
                { setSample :: Buffer -> IO ()
setSample = Buffer -> IO ()
set
                , getMask :: IO Buffer
getMask = IO Buffer
get
                , unprotect :: Sample -> Mask
unprotect = Sample -> Mask
unp
                }
    (Coder, Protector) -> IO (Coder, Protector)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Coder
coder, Protector
protector)
  where
    txSecret :: Secret
txSecret
        | Bool
cli = NegotiatedProtocol -> Secret
Secret NegotiatedProtocol
c
        | Bool
otherwise = NegotiatedProtocol -> Secret
Secret NegotiatedProtocol
s
    rxSecret :: Secret
rxSecret
        | Bool
cli = NegotiatedProtocol -> Secret
Secret NegotiatedProtocol
s
        | Bool
otherwise = NegotiatedProtocol -> Secret
Secret NegotiatedProtocol
c
    txPayloadKey :: Key
txPayloadKey = Version -> Cipher -> Secret -> Key
aeadKey Version
ver Cipher
cipher Secret
txSecret
    txPayloadIV :: IV
txPayloadIV = Version -> Cipher -> Secret -> IV
initialVector Version
ver Cipher
cipher Secret
txSecret
    txHeaderKey :: Key
txHeaderKey = Version -> Cipher -> Secret -> Key
headerProtectionKey Version
ver Cipher
cipher Secret
txSecret
    rxPayloadKey :: Key
rxPayloadKey = Version -> Cipher -> Secret -> Key
aeadKey Version
ver Cipher
cipher Secret
rxSecret
    rxPayloadIV :: IV
rxPayloadIV = Version -> Cipher -> Secret -> IV
initialVector Version
ver Cipher
cipher Secret
rxSecret
    rxHeaderKey :: Key
rxHeaderKey = Version -> Cipher -> Secret -> Key
headerProtectionKey Version
ver Cipher
cipher Secret
rxSecret
    unp :: Sample -> Mask
unp = Cipher -> Key -> Sample -> Mask
protectionMask Cipher
cipher Key
rxHeaderKey

genFusionCoder1RTT
    :: Bool -> Version -> Cipher -> TrafficSecrets a -> Coder -> IO Coder
genFusionCoder1RTT :: forall a.
Bool -> Version -> Cipher -> TrafficSecrets a -> Coder -> IO Coder
genFusionCoder1RTT Bool
cli Version
ver Cipher
cipher (ClientTrafficSecret NegotiatedProtocol
c, ServerTrafficSecret NegotiatedProtocol
s) Coder
oldcoder = do
    FusionContext
fctxt <- IO FusionContext
fusionNewContext
    FusionContext
fctxr <- IO FusionContext
fusionNewContext
    Cipher -> FusionContext -> Key -> IV -> IO ()
fusionSetup Cipher
cipher FusionContext
fctxt Key
txPayloadKey IV
txPayloadIV
    Cipher -> FusionContext -> Key -> IV -> IO ()
fusionSetup Cipher
cipher FusionContext
fctxr Key
rxPayloadKey IV
rxPayloadIV
    let supp :: Supplement
supp = Maybe Supplement -> Supplement
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe Supplement -> Supplement) -> Maybe Supplement -> Supplement
forall a b. (a -> b) -> a -> b
$ Coder -> Maybe Supplement
supplement Coder
oldcoder
    let coder :: Coder
coder =
            Coder
                { encrypt :: Buffer -> NegotiatedProtocol -> AssDat -> Int -> IO Int
encrypt = FusionContext
-> Supplement
-> Buffer
-> NegotiatedProtocol
-> AssDat
-> Int
-> IO Int
fusionEncrypt FusionContext
fctxt Supplement
supp
                , decrypt :: Buffer -> NegotiatedProtocol -> AssDat -> Int -> IO Int
decrypt = FusionContext
-> Buffer -> NegotiatedProtocol -> AssDat -> Int -> IO Int
fusionDecrypt FusionContext
fctxr
                , supplement :: Maybe Supplement
supplement = Supplement -> Maybe Supplement
forall a. a -> Maybe a
Just Supplement
supp
                }
    Coder -> IO Coder
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Coder
coder
  where
    txSecret :: Secret
txSecret
        | Bool
cli = NegotiatedProtocol -> Secret
Secret NegotiatedProtocol
c
        | Bool
otherwise = NegotiatedProtocol -> Secret
Secret NegotiatedProtocol
s
    rxSecret :: Secret
rxSecret
        | Bool
cli = NegotiatedProtocol -> Secret
Secret NegotiatedProtocol
s
        | Bool
otherwise = NegotiatedProtocol -> Secret
Secret NegotiatedProtocol
c
    txPayloadKey :: Key
txPayloadKey = Version -> Cipher -> Secret -> Key
aeadKey Version
ver Cipher
cipher Secret
txSecret
    txPayloadIV :: IV
txPayloadIV = Version -> Cipher -> Secret -> IV
initialVector Version
ver Cipher
cipher Secret
txSecret
    rxPayloadKey :: Key
rxPayloadKey = Version -> Cipher -> Secret -> Key
aeadKey Version
ver Cipher
cipher Secret
rxSecret
    rxPayloadIV :: IV
rxPayloadIV = Version -> Cipher -> Secret -> IV
initialVector Version
ver Cipher
cipher Secret
rxSecret

genNiteCoder1RTT
    :: Bool -> Version -> Cipher -> TrafficSecrets a -> Coder -> IO Coder
genNiteCoder1RTT :: forall a.
Bool -> Version -> Cipher -> TrafficSecrets a -> Coder -> IO Coder
genNiteCoder1RTT Bool
cli Version
ver Cipher
cipher (ClientTrafficSecret NegotiatedProtocol
c, ServerTrafficSecret NegotiatedProtocol
s) Coder
_oldcoder = do
    let enc :: Buffer -> NegotiatedProtocol -> AssDat -> Int -> IO Int
enc = Cipher
-> Key
-> IV
-> Buffer
-> NegotiatedProtocol
-> AssDat
-> Int
-> IO Int
makeNiteEncrypt Cipher
cipher Key
txPayloadKey IV
txPayloadIV
        dec :: Buffer -> NegotiatedProtocol -> AssDat -> Int -> IO Int
dec = Cipher
-> Key
-> IV
-> Buffer
-> NegotiatedProtocol
-> AssDat
-> Int
-> IO Int
makeNiteDecrypt Cipher
cipher Key
rxPayloadKey IV
rxPayloadIV
    let coder :: Coder
coder =
            Coder
                { encrypt :: Buffer -> NegotiatedProtocol -> AssDat -> Int -> IO Int
encrypt = Buffer -> NegotiatedProtocol -> AssDat -> Int -> IO Int
enc
                , decrypt :: Buffer -> NegotiatedProtocol -> AssDat -> Int -> IO Int
decrypt = Buffer -> NegotiatedProtocol -> AssDat -> Int -> IO Int
dec
                , supplement :: Maybe Supplement
supplement = Maybe Supplement
forall a. Maybe a
Nothing
                }
    Coder -> IO Coder
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Coder
coder
  where
    txSecret :: Secret
txSecret
        | Bool
cli = NegotiatedProtocol -> Secret
Secret NegotiatedProtocol
c
        | Bool
otherwise = NegotiatedProtocol -> Secret
Secret NegotiatedProtocol
s
    rxSecret :: Secret
rxSecret
        | Bool
cli = NegotiatedProtocol -> Secret
Secret NegotiatedProtocol
s
        | Bool
otherwise = NegotiatedProtocol -> Secret
Secret NegotiatedProtocol
c
    txPayloadKey :: Key
txPayloadKey = Version -> Cipher -> Secret -> Key
aeadKey Version
ver Cipher
cipher Secret
txSecret
    txPayloadIV :: IV
txPayloadIV = Version -> Cipher -> Secret -> IV
initialVector Version
ver Cipher
cipher Secret
txSecret
    rxPayloadKey :: Key
rxPayloadKey = Version -> Cipher -> Secret -> Key
aeadKey Version
ver Cipher
cipher Secret
rxSecret
    rxPayloadIV :: IV
rxPayloadIV = Version -> Cipher -> Secret -> IV
initialVector Version
ver Cipher
cipher Secret
rxSecret

getCoder :: Connection -> EncryptionLevel -> Bool -> IO Coder
getCoder :: Connection -> EncryptionLevel -> Bool -> IO Coder
getCoder Connection
conn EncryptionLevel
RTT1Level Bool
k = Coder1RTT -> Coder
coder1RTT (Coder1RTT -> Coder) -> IO Coder1RTT -> IO Coder
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IOArray Bool Coder1RTT -> Bool -> IO Coder1RTT
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> m e
readArray (Connection -> IOArray Bool Coder1RTT
coders1RTT Connection
conn) Bool
k
getCoder Connection
conn EncryptionLevel
lvl Bool
_ = IOArray EncryptionLevel Coder -> EncryptionLevel -> IO Coder
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> m e
readArray (Connection -> IOArray EncryptionLevel Coder
coders Connection
conn) EncryptionLevel
lvl

getProtector :: Connection -> EncryptionLevel -> IO Protector
getProtector :: Connection -> EncryptionLevel -> IO Protector
getProtector Connection
conn EncryptionLevel
lvl = IOArray EncryptionLevel Protector
-> EncryptionLevel -> IO Protector
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> m e
readArray (Connection -> IOArray EncryptionLevel Protector
protectors Connection
conn) EncryptionLevel
lvl

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

getCurrentKeyPhase :: Connection -> IO (Bool, PacketNumber)
getCurrentKeyPhase :: Connection -> IO (Bool, Int)
getCurrentKeyPhase Connection{Recv
Buffer
Array EncryptionLevel (TVar [ReceivedPacket])
IOArray Bool Coder1RTT
IOArray EncryptionLevel Cipher
IOArray EncryptionLevel Protector
IOArray EncryptionLevel Coder
ThreadId
TVar Bool
TVar Int
TVar TxFlow
TVar Concurrency
TVar MigrationState
TVar CIDDB
IORef Int
IORef (IO ())
IORef (Bool, Int)
IORef RxFlow
IORef UDPSocket
IORef Microseconds
IORef VersionInfo
IORef AuthCIDs
IORef Parameters
IORef StreamTable
IORef Concurrency
IORef Negotiated
IORef CIDDB
IORef RoleInfo
Rate
OutputQLim
MigrationQ
OutputQ
CryptoQ
InputQ
VersionInfo
RecvQ
SizedBuffer
ConnState
Parameters
LDCC
Hooks
Shared
Send
DebugLogger
QLogger
connState :: Connection -> ConnState
connDebugLog :: Connection -> DebugLogger
connQLog :: Connection -> QLogger
connHooks :: Connection -> Hooks
connSend :: Connection -> Send
connRecv :: Connection -> Recv
connRecvQ :: Connection -> RecvQ
udpSocket :: Connection -> IORef UDPSocket
readers :: Connection -> IORef (IO ())
mainThreadId :: Connection -> ThreadId
controlRate :: Connection -> Rate
roleInfo :: Connection -> IORef RoleInfo
quicVersionInfo :: Connection -> IORef VersionInfo
origVersionInfo :: Connection -> VersionInfo
myParameters :: Connection -> Parameters
myCIDDB :: Connection -> IORef CIDDB
peerParameters :: Connection -> IORef Parameters
peerCIDDB :: Connection -> TVar CIDDB
inputQ :: Connection -> InputQ
cryptoQ :: Connection -> CryptoQ
outputQ :: Connection -> OutputQ
outputQLim :: Connection -> OutputQLim
migrationQ :: Connection -> MigrationQ
shared :: Connection -> Shared
delayedAckCount :: Connection -> IORef Int
delayedAckCancel :: Connection -> IORef (IO ())
peerPacketNumber :: Connection -> IORef Int
streamTable :: Connection -> IORef StreamTable
myStreamId :: Connection -> TVar Concurrency
myUniStreamId :: Connection -> TVar Concurrency
peerStreamId :: Connection -> IORef Concurrency
peerUniStreamId :: Connection -> IORef Concurrency
flowTx :: Connection -> TVar TxFlow
flowRx :: Connection -> IORef RxFlow
migrationState :: Connection -> TVar MigrationState
minIdleTimeout :: Connection -> IORef Microseconds
bytesTx :: Connection -> TVar Int
bytesRx :: Connection -> TVar Int
addressValidated :: Connection -> TVar Bool
pendingQ :: Connection -> Array EncryptionLevel (TVar [ReceivedPacket])
ciphers :: Connection -> IOArray EncryptionLevel Cipher
coders :: Connection -> IOArray EncryptionLevel Coder
coders1RTT :: Connection -> IOArray Bool Coder1RTT
protectors :: Connection -> IOArray EncryptionLevel Protector
currentKeyPhase :: Connection -> IORef (Bool, Int)
negotiated :: Connection -> IORef Negotiated
connMyAuthCIDs :: Connection -> IORef AuthCIDs
connPeerAuthCIDs :: Connection -> IORef AuthCIDs
connResources :: Connection -> IORef (IO ())
encodeBuf :: Connection -> Buffer
encryptRes :: Connection -> SizedBuffer
decryptBuf :: Connection -> Buffer
connLDCC :: Connection -> LDCC
connState :: ConnState
connDebugLog :: DebugLogger
connQLog :: QLogger
connHooks :: Hooks
connSend :: Send
connRecv :: Recv
connRecvQ :: RecvQ
udpSocket :: IORef UDPSocket
readers :: IORef (IO ())
mainThreadId :: ThreadId
controlRate :: Rate
roleInfo :: IORef RoleInfo
quicVersionInfo :: IORef VersionInfo
origVersionInfo :: VersionInfo
myParameters :: Parameters
myCIDDB :: IORef CIDDB
peerParameters :: IORef Parameters
peerCIDDB :: TVar CIDDB
inputQ :: InputQ
cryptoQ :: CryptoQ
outputQ :: OutputQ
outputQLim :: OutputQLim
migrationQ :: MigrationQ
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
minIdleTimeout :: IORef Microseconds
bytesTx :: TVar Int
bytesRx :: TVar Int
addressValidated :: TVar Bool
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
connResources :: IORef (IO ())
encodeBuf :: Buffer
encryptRes :: SizedBuffer
decryptBuf :: Buffer
connLDCC :: LDCC
..} = IORef (Bool, Int) -> IO (Bool, Int)
forall a. IORef a -> IO a
readIORef IORef (Bool, Int)
currentKeyPhase

setCurrentKeyPhase :: Connection -> Bool -> PacketNumber -> IO ()
setCurrentKeyPhase :: Connection -> Bool -> Int -> IO ()
setCurrentKeyPhase Connection{Recv
Buffer
Array EncryptionLevel (TVar [ReceivedPacket])
IOArray Bool Coder1RTT
IOArray EncryptionLevel Cipher
IOArray EncryptionLevel Protector
IOArray EncryptionLevel Coder
ThreadId
TVar Bool
TVar Int
TVar TxFlow
TVar Concurrency
TVar MigrationState
TVar CIDDB
IORef Int
IORef (IO ())
IORef (Bool, Int)
IORef RxFlow
IORef UDPSocket
IORef Microseconds
IORef VersionInfo
IORef AuthCIDs
IORef Parameters
IORef StreamTable
IORef Concurrency
IORef Negotiated
IORef CIDDB
IORef RoleInfo
Rate
OutputQLim
MigrationQ
OutputQ
CryptoQ
InputQ
VersionInfo
RecvQ
SizedBuffer
ConnState
Parameters
LDCC
Hooks
Shared
Send
DebugLogger
QLogger
connState :: Connection -> ConnState
connDebugLog :: Connection -> DebugLogger
connQLog :: Connection -> QLogger
connHooks :: Connection -> Hooks
connSend :: Connection -> Send
connRecv :: Connection -> Recv
connRecvQ :: Connection -> RecvQ
udpSocket :: Connection -> IORef UDPSocket
readers :: Connection -> IORef (IO ())
mainThreadId :: Connection -> ThreadId
controlRate :: Connection -> Rate
roleInfo :: Connection -> IORef RoleInfo
quicVersionInfo :: Connection -> IORef VersionInfo
origVersionInfo :: Connection -> VersionInfo
myParameters :: Connection -> Parameters
myCIDDB :: Connection -> IORef CIDDB
peerParameters :: Connection -> IORef Parameters
peerCIDDB :: Connection -> TVar CIDDB
inputQ :: Connection -> InputQ
cryptoQ :: Connection -> CryptoQ
outputQ :: Connection -> OutputQ
outputQLim :: Connection -> OutputQLim
migrationQ :: Connection -> MigrationQ
shared :: Connection -> Shared
delayedAckCount :: Connection -> IORef Int
delayedAckCancel :: Connection -> IORef (IO ())
peerPacketNumber :: Connection -> IORef Int
streamTable :: Connection -> IORef StreamTable
myStreamId :: Connection -> TVar Concurrency
myUniStreamId :: Connection -> TVar Concurrency
peerStreamId :: Connection -> IORef Concurrency
peerUniStreamId :: Connection -> IORef Concurrency
flowTx :: Connection -> TVar TxFlow
flowRx :: Connection -> IORef RxFlow
migrationState :: Connection -> TVar MigrationState
minIdleTimeout :: Connection -> IORef Microseconds
bytesTx :: Connection -> TVar Int
bytesRx :: Connection -> TVar Int
addressValidated :: Connection -> TVar Bool
pendingQ :: Connection -> Array EncryptionLevel (TVar [ReceivedPacket])
ciphers :: Connection -> IOArray EncryptionLevel Cipher
coders :: Connection -> IOArray EncryptionLevel Coder
coders1RTT :: Connection -> IOArray Bool Coder1RTT
protectors :: Connection -> IOArray EncryptionLevel Protector
currentKeyPhase :: Connection -> IORef (Bool, Int)
negotiated :: Connection -> IORef Negotiated
connMyAuthCIDs :: Connection -> IORef AuthCIDs
connPeerAuthCIDs :: Connection -> IORef AuthCIDs
connResources :: Connection -> IORef (IO ())
encodeBuf :: Connection -> Buffer
encryptRes :: Connection -> SizedBuffer
decryptBuf :: Connection -> Buffer
connLDCC :: Connection -> LDCC
connState :: ConnState
connDebugLog :: DebugLogger
connQLog :: QLogger
connHooks :: Hooks
connSend :: Send
connRecv :: Recv
connRecvQ :: RecvQ
udpSocket :: IORef UDPSocket
readers :: IORef (IO ())
mainThreadId :: ThreadId
controlRate :: Rate
roleInfo :: IORef RoleInfo
quicVersionInfo :: IORef VersionInfo
origVersionInfo :: VersionInfo
myParameters :: Parameters
myCIDDB :: IORef CIDDB
peerParameters :: IORef Parameters
peerCIDDB :: TVar CIDDB
inputQ :: InputQ
cryptoQ :: CryptoQ
outputQ :: OutputQ
outputQLim :: OutputQLim
migrationQ :: MigrationQ
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
minIdleTimeout :: IORef Microseconds
bytesTx :: TVar Int
bytesRx :: TVar Int
addressValidated :: TVar Bool
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
connResources :: IORef (IO ())
encodeBuf :: Buffer
encryptRes :: SizedBuffer
decryptBuf :: Buffer
connLDCC :: LDCC
..} Bool
k Int
pn = IORef (Bool, Int) -> (Bool, Int) -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (Bool, Int)
currentKeyPhase (Bool
k, Int
pn)