{-# 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 Control.Concurrent.STM
import Network.TLS.QUIC

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

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

setEncryptionLevel :: Connection -> EncryptionLevel -> IO ()
setEncryptionLevel :: Connection -> EncryptionLevel -> IO ()
setEncryptionLevel Connection{Array EncryptionLevel (TVar [ReceivedPacket])
IOArray Bool Coder1RTT
IOArray EncryptionLevel Cipher
IOArray EncryptionLevel Protector
IOArray EncryptionLevel Coder
ThreadId
TVar Bool
TVar Int
TVar Flow
TVar Concurrency
TVar MigrationState
TVar CIDDB
IORef Int
IORef [Socket]
IORef (IO ())
IORef (Bool, Int)
IORef Microseconds
IORef Version
IORef Flow
IORef StreamTable
IORef AuthCIDs
IORef Parameters
IORef Concurrency
IORef Negotiated
IORef CIDDB
IORef RoleInfo
MigrationQ
OutputQ
CryptoQ
InputQ
RecvQ
ConnState
Parameters
LDCC
Hooks
Shared
DebugLogger
QLogger
connLDCC :: Connection -> LDCC
connResources :: Connection -> IORef (IO ())
handshakeCIDs :: Connection -> IORef AuthCIDs
negotiated :: Connection -> IORef Negotiated
currentKeyPhase :: Connection -> IORef (Bool, Int)
protectors :: Connection -> IOArray EncryptionLevel Protector
coders1RTT :: Connection -> IOArray Bool Coder1RTT
coders :: Connection -> IOArray EncryptionLevel Coder
ciphers :: Connection -> IOArray EncryptionLevel Cipher
pendingQ :: Connection -> Array EncryptionLevel (TVar [ReceivedPacket])
addressValidated :: Connection -> TVar Bool
bytesRx :: Connection -> TVar Int
bytesTx :: Connection -> TVar Int
minIdleTimeout :: Connection -> IORef Microseconds
migrationState :: Connection -> TVar MigrationState
flowRx :: Connection -> IORef Flow
flowTx :: Connection -> TVar Flow
peerStreamId :: Connection -> IORef Concurrency
myUniStreamId :: Connection -> TVar Concurrency
myStreamId :: Connection -> TVar Concurrency
streamTable :: Connection -> IORef StreamTable
peerPacketNumber :: Connection -> IORef Int
delayedAckCancel :: Connection -> IORef (IO ())
delayedAckCount :: Connection -> IORef Int
shared :: Connection -> Shared
migrationQ :: Connection -> MigrationQ
outputQ :: Connection -> OutputQ
cryptoQ :: Connection -> CryptoQ
inputQ :: Connection -> InputQ
peerCIDDB :: Connection -> TVar CIDDB
peerParameters :: Connection -> IORef Parameters
myCIDDB :: Connection -> IORef CIDDB
myParameters :: Connection -> Parameters
quicVersion :: Connection -> IORef Version
roleInfo :: Connection -> IORef RoleInfo
mainThreadId :: Connection -> ThreadId
tmouter :: Connection -> IORef (IO ())
readers :: Connection -> IORef (IO ())
sockets :: Connection -> IORef [Socket]
connRecvQ :: Connection -> RecvQ
connHooks :: Connection -> Hooks
connQLog :: Connection -> QLogger
connDebugLog :: Connection -> DebugLogger
connState :: Connection -> ConnState
connLDCC :: LDCC
connResources :: IORef (IO ())
handshakeCIDs :: IORef AuthCIDs
negotiated :: IORef Negotiated
currentKeyPhase :: IORef (Bool, Int)
protectors :: IOArray EncryptionLevel Protector
coders1RTT :: IOArray Bool Coder1RTT
coders :: IOArray EncryptionLevel Coder
ciphers :: IOArray EncryptionLevel Cipher
pendingQ :: Array EncryptionLevel (TVar [ReceivedPacket])
addressValidated :: TVar Bool
bytesRx :: TVar Int
bytesTx :: TVar Int
minIdleTimeout :: IORef Microseconds
migrationState :: TVar MigrationState
flowRx :: IORef Flow
flowTx :: TVar Flow
peerStreamId :: IORef Concurrency
myUniStreamId :: TVar Concurrency
myStreamId :: TVar Concurrency
streamTable :: IORef StreamTable
peerPacketNumber :: IORef Int
delayedAckCancel :: IORef (IO ())
delayedAckCount :: IORef Int
shared :: Shared
migrationQ :: MigrationQ
outputQ :: OutputQ
cryptoQ :: CryptoQ
inputQ :: InputQ
peerCIDDB :: TVar CIDDB
peerParameters :: IORef Parameters
myCIDDB :: IORef CIDDB
myParameters :: Parameters
quicVersion :: IORef Version
roleInfo :: IORef RoleInfo
mainThreadId :: ThreadId
tmouter :: IORef (IO ())
readers :: IORef (IO ())
sockets :: IORef [Socket]
connRecvQ :: RecvQ
connHooks :: Hooks
connQLog :: QLogger
connDebugLog :: DebugLogger
connState :: ConnState
..} EncryptionLevel
lvl = do
    let q :: RecvQ
q = RecvQ
connRecvQ
    STM () -> IO ()
forall a. STM a -> IO 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 (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 (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 (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 (m :: * -> *) a. Monad m => a -> m a
return ()

putOffCrypto :: Connection -> EncryptionLevel -> ReceivedPacket -> IO ()
putOffCrypto :: Connection -> EncryptionLevel -> ReceivedPacket -> IO ()
putOffCrypto Connection{Array EncryptionLevel (TVar [ReceivedPacket])
IOArray Bool Coder1RTT
IOArray EncryptionLevel Cipher
IOArray EncryptionLevel Protector
IOArray EncryptionLevel Coder
ThreadId
TVar Bool
TVar Int
TVar Flow
TVar Concurrency
TVar MigrationState
TVar CIDDB
IORef Int
IORef [Socket]
IORef (IO ())
IORef (Bool, Int)
IORef Microseconds
IORef Version
IORef Flow
IORef StreamTable
IORef AuthCIDs
IORef Parameters
IORef Concurrency
IORef Negotiated
IORef CIDDB
IORef RoleInfo
MigrationQ
OutputQ
CryptoQ
InputQ
RecvQ
ConnState
Parameters
LDCC
Hooks
Shared
DebugLogger
QLogger
connLDCC :: LDCC
connResources :: IORef (IO ())
handshakeCIDs :: IORef AuthCIDs
negotiated :: IORef Negotiated
currentKeyPhase :: IORef (Bool, Int)
protectors :: IOArray EncryptionLevel Protector
coders1RTT :: IOArray Bool Coder1RTT
coders :: IOArray EncryptionLevel Coder
ciphers :: IOArray EncryptionLevel Cipher
pendingQ :: Array EncryptionLevel (TVar [ReceivedPacket])
addressValidated :: TVar Bool
bytesRx :: TVar Int
bytesTx :: TVar Int
minIdleTimeout :: IORef Microseconds
migrationState :: TVar MigrationState
flowRx :: IORef Flow
flowTx :: TVar Flow
peerStreamId :: IORef Concurrency
myUniStreamId :: TVar Concurrency
myStreamId :: TVar Concurrency
streamTable :: IORef StreamTable
peerPacketNumber :: IORef Int
delayedAckCancel :: IORef (IO ())
delayedAckCount :: IORef Int
shared :: Shared
migrationQ :: MigrationQ
outputQ :: OutputQ
cryptoQ :: CryptoQ
inputQ :: InputQ
peerCIDDB :: TVar CIDDB
peerParameters :: IORef Parameters
myCIDDB :: IORef CIDDB
myParameters :: Parameters
quicVersion :: IORef Version
roleInfo :: IORef RoleInfo
mainThreadId :: ThreadId
tmouter :: IORef (IO ())
readers :: IORef (IO ())
sockets :: IORef [Socket]
connRecvQ :: RecvQ
connHooks :: Hooks
connQLog :: QLogger
connDebugLog :: DebugLogger
connState :: ConnState
connLDCC :: Connection -> LDCC
connResources :: Connection -> IORef (IO ())
handshakeCIDs :: Connection -> IORef AuthCIDs
negotiated :: Connection -> IORef Negotiated
currentKeyPhase :: Connection -> IORef (Bool, Int)
protectors :: Connection -> IOArray EncryptionLevel Protector
coders1RTT :: Connection -> IOArray Bool Coder1RTT
coders :: Connection -> IOArray EncryptionLevel Coder
ciphers :: Connection -> IOArray EncryptionLevel Cipher
pendingQ :: Connection -> Array EncryptionLevel (TVar [ReceivedPacket])
addressValidated :: Connection -> TVar Bool
bytesRx :: Connection -> TVar Int
bytesTx :: Connection -> TVar Int
minIdleTimeout :: Connection -> IORef Microseconds
migrationState :: Connection -> TVar MigrationState
flowRx :: Connection -> IORef Flow
flowTx :: Connection -> TVar Flow
peerStreamId :: Connection -> IORef Concurrency
myUniStreamId :: Connection -> TVar Concurrency
myStreamId :: Connection -> TVar Concurrency
streamTable :: Connection -> IORef StreamTable
peerPacketNumber :: Connection -> IORef Int
delayedAckCancel :: Connection -> IORef (IO ())
delayedAckCount :: Connection -> IORef Int
shared :: Connection -> Shared
migrationQ :: Connection -> MigrationQ
outputQ :: Connection -> OutputQ
cryptoQ :: Connection -> CryptoQ
inputQ :: Connection -> InputQ
peerCIDDB :: Connection -> TVar CIDDB
peerParameters :: Connection -> IORef Parameters
myCIDDB :: Connection -> IORef CIDDB
myParameters :: Connection -> Parameters
quicVersion :: Connection -> IORef Version
roleInfo :: Connection -> IORef RoleInfo
mainThreadId :: Connection -> ThreadId
tmouter :: Connection -> IORef (IO ())
readers :: Connection -> IORef (IO ())
sockets :: Connection -> IORef [Socket]
connRecvQ :: Connection -> RecvQ
connHooks :: Connection -> Hooks
connQLog :: Connection -> QLogger
connDebugLog :: Connection -> DebugLogger
connState :: Connection -> ConnState
..} EncryptionLevel
lvl ReceivedPacket
rpkt =
    STM () -> IO ()
forall a. STM a -> IO 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{Array EncryptionLevel (TVar [ReceivedPacket])
IOArray Bool Coder1RTT
IOArray EncryptionLevel Cipher
IOArray EncryptionLevel Protector
IOArray EncryptionLevel Coder
ThreadId
TVar Bool
TVar Int
TVar Flow
TVar Concurrency
TVar MigrationState
TVar CIDDB
IORef Int
IORef [Socket]
IORef (IO ())
IORef (Bool, Int)
IORef Microseconds
IORef Version
IORef Flow
IORef StreamTable
IORef AuthCIDs
IORef Parameters
IORef Concurrency
IORef Negotiated
IORef CIDDB
IORef RoleInfo
MigrationQ
OutputQ
CryptoQ
InputQ
RecvQ
ConnState
Parameters
LDCC
Hooks
Shared
DebugLogger
QLogger
connLDCC :: LDCC
connResources :: IORef (IO ())
handshakeCIDs :: IORef AuthCIDs
negotiated :: IORef Negotiated
currentKeyPhase :: IORef (Bool, Int)
protectors :: IOArray EncryptionLevel Protector
coders1RTT :: IOArray Bool Coder1RTT
coders :: IOArray EncryptionLevel Coder
ciphers :: IOArray EncryptionLevel Cipher
pendingQ :: Array EncryptionLevel (TVar [ReceivedPacket])
addressValidated :: TVar Bool
bytesRx :: TVar Int
bytesTx :: TVar Int
minIdleTimeout :: IORef Microseconds
migrationState :: TVar MigrationState
flowRx :: IORef Flow
flowTx :: TVar Flow
peerStreamId :: IORef Concurrency
myUniStreamId :: TVar Concurrency
myStreamId :: TVar Concurrency
streamTable :: IORef StreamTable
peerPacketNumber :: IORef Int
delayedAckCancel :: IORef (IO ())
delayedAckCount :: IORef Int
shared :: Shared
migrationQ :: MigrationQ
outputQ :: OutputQ
cryptoQ :: CryptoQ
inputQ :: InputQ
peerCIDDB :: TVar CIDDB
peerParameters :: IORef Parameters
myCIDDB :: IORef CIDDB
myParameters :: Parameters
quicVersion :: IORef Version
roleInfo :: IORef RoleInfo
mainThreadId :: ThreadId
tmouter :: IORef (IO ())
readers :: IORef (IO ())
sockets :: IORef [Socket]
connRecvQ :: RecvQ
connHooks :: Hooks
connQLog :: QLogger
connDebugLog :: DebugLogger
connState :: ConnState
connLDCC :: Connection -> LDCC
connResources :: Connection -> IORef (IO ())
handshakeCIDs :: Connection -> IORef AuthCIDs
negotiated :: Connection -> IORef Negotiated
currentKeyPhase :: Connection -> IORef (Bool, Int)
protectors :: Connection -> IOArray EncryptionLevel Protector
coders1RTT :: Connection -> IOArray Bool Coder1RTT
coders :: Connection -> IOArray EncryptionLevel Coder
ciphers :: Connection -> IOArray EncryptionLevel Cipher
pendingQ :: Connection -> Array EncryptionLevel (TVar [ReceivedPacket])
addressValidated :: Connection -> TVar Bool
bytesRx :: Connection -> TVar Int
bytesTx :: Connection -> TVar Int
minIdleTimeout :: Connection -> IORef Microseconds
migrationState :: Connection -> TVar MigrationState
flowRx :: Connection -> IORef Flow
flowTx :: Connection -> TVar Flow
peerStreamId :: Connection -> IORef Concurrency
myUniStreamId :: Connection -> TVar Concurrency
myStreamId :: Connection -> TVar Concurrency
streamTable :: Connection -> IORef StreamTable
peerPacketNumber :: Connection -> IORef Int
delayedAckCancel :: Connection -> IORef (IO ())
delayedAckCount :: Connection -> IORef Int
shared :: Connection -> Shared
migrationQ :: Connection -> MigrationQ
outputQ :: Connection -> OutputQ
cryptoQ :: Connection -> CryptoQ
inputQ :: Connection -> InputQ
peerCIDDB :: Connection -> TVar CIDDB
peerParameters :: Connection -> IORef Parameters
myCIDDB :: Connection -> IORef CIDDB
myParameters :: Connection -> Parameters
quicVersion :: Connection -> IORef Version
roleInfo :: Connection -> IORef RoleInfo
mainThreadId :: Connection -> ThreadId
tmouter :: Connection -> IORef (IO ())
readers :: Connection -> IORef (IO ())
sockets :: Connection -> IORef [Socket]
connRecvQ :: Connection -> RecvQ
connHooks :: Connection -> Hooks
connQLog :: Connection -> QLogger
connDebugLog :: Connection -> DebugLogger
connState :: Connection -> ConnState
..} EncryptionLevel
lvl = STM () -> IO ()
forall a. STM a -> IO 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 ()
check (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{Array EncryptionLevel (TVar [ReceivedPacket])
IOArray Bool Coder1RTT
IOArray EncryptionLevel Cipher
IOArray EncryptionLevel Protector
IOArray EncryptionLevel Coder
ThreadId
TVar Bool
TVar Int
TVar Flow
TVar Concurrency
TVar MigrationState
TVar CIDDB
IORef Int
IORef [Socket]
IORef (IO ())
IORef (Bool, Int)
IORef Microseconds
IORef Version
IORef Flow
IORef StreamTable
IORef AuthCIDs
IORef Parameters
IORef Concurrency
IORef Negotiated
IORef CIDDB
IORef RoleInfo
MigrationQ
OutputQ
CryptoQ
InputQ
RecvQ
ConnState
Parameters
LDCC
Hooks
Shared
DebugLogger
QLogger
connLDCC :: LDCC
connResources :: IORef (IO ())
handshakeCIDs :: IORef AuthCIDs
negotiated :: IORef Negotiated
currentKeyPhase :: IORef (Bool, Int)
protectors :: IOArray EncryptionLevel Protector
coders1RTT :: IOArray Bool Coder1RTT
coders :: IOArray EncryptionLevel Coder
ciphers :: IOArray EncryptionLevel Cipher
pendingQ :: Array EncryptionLevel (TVar [ReceivedPacket])
addressValidated :: TVar Bool
bytesRx :: TVar Int
bytesTx :: TVar Int
minIdleTimeout :: IORef Microseconds
migrationState :: TVar MigrationState
flowRx :: IORef Flow
flowTx :: TVar Flow
peerStreamId :: IORef Concurrency
myUniStreamId :: TVar Concurrency
myStreamId :: TVar Concurrency
streamTable :: IORef StreamTable
peerPacketNumber :: IORef Int
delayedAckCancel :: IORef (IO ())
delayedAckCount :: IORef Int
shared :: Shared
migrationQ :: MigrationQ
outputQ :: OutputQ
cryptoQ :: CryptoQ
inputQ :: InputQ
peerCIDDB :: TVar CIDDB
peerParameters :: IORef Parameters
myCIDDB :: IORef CIDDB
myParameters :: Parameters
quicVersion :: IORef Version
roleInfo :: IORef RoleInfo
mainThreadId :: ThreadId
tmouter :: IORef (IO ())
readers :: IORef (IO ())
sockets :: IORef [Socket]
connRecvQ :: RecvQ
connHooks :: Hooks
connQLog :: QLogger
connDebugLog :: DebugLogger
connState :: ConnState
connLDCC :: Connection -> LDCC
connResources :: Connection -> IORef (IO ())
handshakeCIDs :: Connection -> IORef AuthCIDs
negotiated :: Connection -> IORef Negotiated
currentKeyPhase :: Connection -> IORef (Bool, Int)
protectors :: Connection -> IOArray EncryptionLevel Protector
coders1RTT :: Connection -> IOArray Bool Coder1RTT
coders :: Connection -> IOArray EncryptionLevel Coder
ciphers :: Connection -> IOArray EncryptionLevel Cipher
pendingQ :: Connection -> Array EncryptionLevel (TVar [ReceivedPacket])
addressValidated :: Connection -> TVar Bool
bytesRx :: Connection -> TVar Int
bytesTx :: Connection -> TVar Int
minIdleTimeout :: Connection -> IORef Microseconds
migrationState :: Connection -> TVar MigrationState
flowRx :: Connection -> IORef Flow
flowTx :: Connection -> TVar Flow
peerStreamId :: Connection -> IORef Concurrency
myUniStreamId :: Connection -> TVar Concurrency
myStreamId :: Connection -> TVar Concurrency
streamTable :: Connection -> IORef StreamTable
peerPacketNumber :: Connection -> IORef Int
delayedAckCancel :: Connection -> IORef (IO ())
delayedAckCount :: Connection -> IORef Int
shared :: Connection -> Shared
migrationQ :: Connection -> MigrationQ
outputQ :: Connection -> OutputQ
cryptoQ :: Connection -> CryptoQ
inputQ :: Connection -> InputQ
peerCIDDB :: Connection -> TVar CIDDB
peerParameters :: Connection -> IORef Parameters
myCIDDB :: Connection -> IORef CIDDB
myParameters :: Connection -> Parameters
quicVersion :: Connection -> IORef Version
roleInfo :: Connection -> IORef RoleInfo
mainThreadId :: Connection -> ThreadId
tmouter :: Connection -> IORef (IO ())
readers :: Connection -> IORef (IO ())
sockets :: Connection -> IORef [Socket]
connRecvQ :: Connection -> RecvQ
connHooks :: Connection -> Hooks
connQLog :: Connection -> QLogger
connDebugLog :: Connection -> DebugLogger
connState :: Connection -> ConnState
..} 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{Array EncryptionLevel (TVar [ReceivedPacket])
IOArray Bool Coder1RTT
IOArray EncryptionLevel Cipher
IOArray EncryptionLevel Protector
IOArray EncryptionLevel Coder
ThreadId
TVar Bool
TVar Int
TVar Flow
TVar Concurrency
TVar MigrationState
TVar CIDDB
IORef Int
IORef [Socket]
IORef (IO ())
IORef (Bool, Int)
IORef Microseconds
IORef Version
IORef Flow
IORef StreamTable
IORef AuthCIDs
IORef Parameters
IORef Concurrency
IORef Negotiated
IORef CIDDB
IORef RoleInfo
MigrationQ
OutputQ
CryptoQ
InputQ
RecvQ
ConnState
Parameters
LDCC
Hooks
Shared
DebugLogger
QLogger
connLDCC :: LDCC
connResources :: IORef (IO ())
handshakeCIDs :: IORef AuthCIDs
negotiated :: IORef Negotiated
currentKeyPhase :: IORef (Bool, Int)
protectors :: IOArray EncryptionLevel Protector
coders1RTT :: IOArray Bool Coder1RTT
coders :: IOArray EncryptionLevel Coder
ciphers :: IOArray EncryptionLevel Cipher
pendingQ :: Array EncryptionLevel (TVar [ReceivedPacket])
addressValidated :: TVar Bool
bytesRx :: TVar Int
bytesTx :: TVar Int
minIdleTimeout :: IORef Microseconds
migrationState :: TVar MigrationState
flowRx :: IORef Flow
flowTx :: TVar Flow
peerStreamId :: IORef Concurrency
myUniStreamId :: TVar Concurrency
myStreamId :: TVar Concurrency
streamTable :: IORef StreamTable
peerPacketNumber :: IORef Int
delayedAckCancel :: IORef (IO ())
delayedAckCount :: IORef Int
shared :: Shared
migrationQ :: MigrationQ
outputQ :: OutputQ
cryptoQ :: CryptoQ
inputQ :: InputQ
peerCIDDB :: TVar CIDDB
peerParameters :: IORef Parameters
myCIDDB :: IORef CIDDB
myParameters :: Parameters
quicVersion :: IORef Version
roleInfo :: IORef RoleInfo
mainThreadId :: ThreadId
tmouter :: IORef (IO ())
readers :: IORef (IO ())
sockets :: IORef [Socket]
connRecvQ :: RecvQ
connHooks :: Hooks
connQLog :: QLogger
connDebugLog :: DebugLogger
connState :: ConnState
connLDCC :: Connection -> LDCC
connResources :: Connection -> IORef (IO ())
handshakeCIDs :: Connection -> IORef AuthCIDs
negotiated :: Connection -> IORef Negotiated
currentKeyPhase :: Connection -> IORef (Bool, Int)
protectors :: Connection -> IOArray EncryptionLevel Protector
coders1RTT :: Connection -> IOArray Bool Coder1RTT
coders :: Connection -> IOArray EncryptionLevel Coder
ciphers :: Connection -> IOArray EncryptionLevel Cipher
pendingQ :: Connection -> Array EncryptionLevel (TVar [ReceivedPacket])
addressValidated :: Connection -> TVar Bool
bytesRx :: Connection -> TVar Int
bytesTx :: Connection -> TVar Int
minIdleTimeout :: Connection -> IORef Microseconds
migrationState :: Connection -> TVar MigrationState
flowRx :: Connection -> IORef Flow
flowTx :: Connection -> TVar Flow
peerStreamId :: Connection -> IORef Concurrency
myUniStreamId :: Connection -> TVar Concurrency
myStreamId :: Connection -> TVar Concurrency
streamTable :: Connection -> IORef StreamTable
peerPacketNumber :: Connection -> IORef Int
delayedAckCancel :: Connection -> IORef (IO ())
delayedAckCount :: Connection -> IORef Int
shared :: Connection -> Shared
migrationQ :: Connection -> MigrationQ
outputQ :: Connection -> OutputQ
cryptoQ :: Connection -> CryptoQ
inputQ :: Connection -> InputQ
peerCIDDB :: Connection -> TVar CIDDB
peerParameters :: Connection -> IORef Parameters
myCIDDB :: Connection -> IORef CIDDB
myParameters :: Connection -> Parameters
quicVersion :: Connection -> IORef Version
roleInfo :: Connection -> IORef RoleInfo
mainThreadId :: Connection -> ThreadId
tmouter :: Connection -> IORef (IO ())
readers :: Connection -> IORef (IO ())
sockets :: Connection -> IORef [Socket]
connRecvQ :: Connection -> RecvQ
connHooks :: Connection -> Hooks
connQLog :: Connection -> QLogger
connDebugLog :: Connection -> DebugLogger
connState :: Connection -> ConnState
..} 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{Array EncryptionLevel (TVar [ReceivedPacket])
IOArray Bool Coder1RTT
IOArray EncryptionLevel Cipher
IOArray EncryptionLevel Protector
IOArray EncryptionLevel Coder
ThreadId
TVar Bool
TVar Int
TVar Flow
TVar Concurrency
TVar MigrationState
TVar CIDDB
IORef Int
IORef [Socket]
IORef (IO ())
IORef (Bool, Int)
IORef Microseconds
IORef Version
IORef Flow
IORef StreamTable
IORef AuthCIDs
IORef Parameters
IORef Concurrency
IORef Negotiated
IORef CIDDB
IORef RoleInfo
MigrationQ
OutputQ
CryptoQ
InputQ
RecvQ
ConnState
Parameters
LDCC
Hooks
Shared
DebugLogger
QLogger
connLDCC :: LDCC
connResources :: IORef (IO ())
handshakeCIDs :: IORef AuthCIDs
negotiated :: IORef Negotiated
currentKeyPhase :: IORef (Bool, Int)
protectors :: IOArray EncryptionLevel Protector
coders1RTT :: IOArray Bool Coder1RTT
coders :: IOArray EncryptionLevel Coder
ciphers :: IOArray EncryptionLevel Cipher
pendingQ :: Array EncryptionLevel (TVar [ReceivedPacket])
addressValidated :: TVar Bool
bytesRx :: TVar Int
bytesTx :: TVar Int
minIdleTimeout :: IORef Microseconds
migrationState :: TVar MigrationState
flowRx :: IORef Flow
flowTx :: TVar Flow
peerStreamId :: IORef Concurrency
myUniStreamId :: TVar Concurrency
myStreamId :: TVar Concurrency
streamTable :: IORef StreamTable
peerPacketNumber :: IORef Int
delayedAckCancel :: IORef (IO ())
delayedAckCount :: IORef Int
shared :: Shared
migrationQ :: MigrationQ
outputQ :: OutputQ
cryptoQ :: CryptoQ
inputQ :: InputQ
peerCIDDB :: TVar CIDDB
peerParameters :: IORef Parameters
myCIDDB :: IORef CIDDB
myParameters :: Parameters
quicVersion :: IORef Version
roleInfo :: IORef RoleInfo
mainThreadId :: ThreadId
tmouter :: IORef (IO ())
readers :: IORef (IO ())
sockets :: IORef [Socket]
connRecvQ :: RecvQ
connHooks :: Hooks
connQLog :: QLogger
connDebugLog :: DebugLogger
connState :: ConnState
connLDCC :: Connection -> LDCC
connResources :: Connection -> IORef (IO ())
handshakeCIDs :: Connection -> IORef AuthCIDs
negotiated :: Connection -> IORef Negotiated
currentKeyPhase :: Connection -> IORef (Bool, Int)
protectors :: Connection -> IOArray EncryptionLevel Protector
coders1RTT :: Connection -> IOArray Bool Coder1RTT
coders :: Connection -> IOArray EncryptionLevel Coder
ciphers :: Connection -> IOArray EncryptionLevel Cipher
pendingQ :: Connection -> Array EncryptionLevel (TVar [ReceivedPacket])
addressValidated :: Connection -> TVar Bool
bytesRx :: Connection -> TVar Int
bytesTx :: Connection -> TVar Int
minIdleTimeout :: Connection -> IORef Microseconds
migrationState :: Connection -> TVar MigrationState
flowRx :: Connection -> IORef Flow
flowTx :: Connection -> TVar Flow
peerStreamId :: Connection -> IORef Concurrency
myUniStreamId :: Connection -> TVar Concurrency
myStreamId :: Connection -> TVar Concurrency
streamTable :: Connection -> IORef StreamTable
peerPacketNumber :: Connection -> IORef Int
delayedAckCancel :: Connection -> IORef (IO ())
delayedAckCount :: Connection -> IORef Int
shared :: Connection -> Shared
migrationQ :: Connection -> MigrationQ
outputQ :: Connection -> OutputQ
cryptoQ :: Connection -> CryptoQ
inputQ :: Connection -> InputQ
peerCIDDB :: Connection -> TVar CIDDB
peerParameters :: Connection -> IORef Parameters
myCIDDB :: Connection -> IORef CIDDB
myParameters :: Connection -> Parameters
quicVersion :: Connection -> IORef Version
roleInfo :: Connection -> IORef RoleInfo
mainThreadId :: Connection -> ThreadId
tmouter :: Connection -> IORef (IO ())
readers :: Connection -> IORef (IO ())
sockets :: Connection -> IORef [Socket]
connRecvQ :: Connection -> RecvQ
connHooks :: Connection -> Hooks
connQLog :: Connection -> QLogger
connDebugLog :: Connection -> DebugLogger
connState :: Connection -> ConnState
..} = 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{Array EncryptionLevel (TVar [ReceivedPacket])
IOArray Bool Coder1RTT
IOArray EncryptionLevel Cipher
IOArray EncryptionLevel Protector
IOArray EncryptionLevel Coder
ThreadId
TVar Bool
TVar Int
TVar Flow
TVar Concurrency
TVar MigrationState
TVar CIDDB
IORef Int
IORef [Socket]
IORef (IO ())
IORef (Bool, Int)
IORef Microseconds
IORef Version
IORef Flow
IORef StreamTable
IORef AuthCIDs
IORef Parameters
IORef Concurrency
IORef Negotiated
IORef CIDDB
IORef RoleInfo
MigrationQ
OutputQ
CryptoQ
InputQ
RecvQ
ConnState
Parameters
LDCC
Hooks
Shared
DebugLogger
QLogger
connLDCC :: LDCC
connResources :: IORef (IO ())
handshakeCIDs :: IORef AuthCIDs
negotiated :: IORef Negotiated
currentKeyPhase :: IORef (Bool, Int)
protectors :: IOArray EncryptionLevel Protector
coders1RTT :: IOArray Bool Coder1RTT
coders :: IOArray EncryptionLevel Coder
ciphers :: IOArray EncryptionLevel Cipher
pendingQ :: Array EncryptionLevel (TVar [ReceivedPacket])
addressValidated :: TVar Bool
bytesRx :: TVar Int
bytesTx :: TVar Int
minIdleTimeout :: IORef Microseconds
migrationState :: TVar MigrationState
flowRx :: IORef Flow
flowTx :: TVar Flow
peerStreamId :: IORef Concurrency
myUniStreamId :: TVar Concurrency
myStreamId :: TVar Concurrency
streamTable :: IORef StreamTable
peerPacketNumber :: IORef Int
delayedAckCancel :: IORef (IO ())
delayedAckCount :: IORef Int
shared :: Shared
migrationQ :: MigrationQ
outputQ :: OutputQ
cryptoQ :: CryptoQ
inputQ :: InputQ
peerCIDDB :: TVar CIDDB
peerParameters :: IORef Parameters
myCIDDB :: IORef CIDDB
myParameters :: Parameters
quicVersion :: IORef Version
roleInfo :: IORef RoleInfo
mainThreadId :: ThreadId
tmouter :: IORef (IO ())
readers :: IORef (IO ())
sockets :: IORef [Socket]
connRecvQ :: RecvQ
connHooks :: Hooks
connQLog :: QLogger
connDebugLog :: DebugLogger
connState :: ConnState
connLDCC :: Connection -> LDCC
connResources :: Connection -> IORef (IO ())
handshakeCIDs :: Connection -> IORef AuthCIDs
negotiated :: Connection -> IORef Negotiated
currentKeyPhase :: Connection -> IORef (Bool, Int)
protectors :: Connection -> IOArray EncryptionLevel Protector
coders1RTT :: Connection -> IOArray Bool Coder1RTT
coders :: Connection -> IOArray EncryptionLevel Coder
ciphers :: Connection -> IOArray EncryptionLevel Cipher
pendingQ :: Connection -> Array EncryptionLevel (TVar [ReceivedPacket])
addressValidated :: Connection -> TVar Bool
bytesRx :: Connection -> TVar Int
bytesTx :: Connection -> TVar Int
minIdleTimeout :: Connection -> IORef Microseconds
migrationState :: Connection -> TVar MigrationState
flowRx :: Connection -> IORef Flow
flowTx :: Connection -> TVar Flow
peerStreamId :: Connection -> IORef Concurrency
myUniStreamId :: Connection -> TVar Concurrency
myStreamId :: Connection -> TVar Concurrency
streamTable :: Connection -> IORef StreamTable
peerPacketNumber :: Connection -> IORef Int
delayedAckCancel :: Connection -> IORef (IO ())
delayedAckCount :: Connection -> IORef Int
shared :: Connection -> Shared
migrationQ :: Connection -> MigrationQ
outputQ :: Connection -> OutputQ
cryptoQ :: Connection -> CryptoQ
inputQ :: Connection -> InputQ
peerCIDDB :: Connection -> TVar CIDDB
peerParameters :: Connection -> IORef Parameters
myCIDDB :: Connection -> IORef CIDDB
myParameters :: Connection -> Parameters
quicVersion :: Connection -> IORef Version
roleInfo :: Connection -> IORef RoleInfo
mainThreadId :: Connection -> ThreadId
tmouter :: Connection -> IORef (IO ())
readers :: Connection -> IORef (IO ())
sockets :: Connection -> IORef [Socket]
connRecvQ :: Connection -> RecvQ
connHooks :: Connection -> Hooks
connQLog :: Connection -> QLogger
connDebugLog :: Connection -> DebugLogger
connState :: Connection -> ConnState
..} = 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{Array EncryptionLevel (TVar [ReceivedPacket])
IOArray Bool Coder1RTT
IOArray EncryptionLevel Cipher
IOArray EncryptionLevel Protector
IOArray EncryptionLevel Coder
ThreadId
TVar Bool
TVar Int
TVar Flow
TVar Concurrency
TVar MigrationState
TVar CIDDB
IORef Int
IORef [Socket]
IORef (IO ())
IORef (Bool, Int)
IORef Microseconds
IORef Version
IORef Flow
IORef StreamTable
IORef AuthCIDs
IORef Parameters
IORef Concurrency
IORef Negotiated
IORef CIDDB
IORef RoleInfo
MigrationQ
OutputQ
CryptoQ
InputQ
RecvQ
ConnState
Parameters
LDCC
Hooks
Shared
DebugLogger
QLogger
connLDCC :: LDCC
connResources :: IORef (IO ())
handshakeCIDs :: IORef AuthCIDs
negotiated :: IORef Negotiated
currentKeyPhase :: IORef (Bool, Int)
protectors :: IOArray EncryptionLevel Protector
coders1RTT :: IOArray Bool Coder1RTT
coders :: IOArray EncryptionLevel Coder
ciphers :: IOArray EncryptionLevel Cipher
pendingQ :: Array EncryptionLevel (TVar [ReceivedPacket])
addressValidated :: TVar Bool
bytesRx :: TVar Int
bytesTx :: TVar Int
minIdleTimeout :: IORef Microseconds
migrationState :: TVar MigrationState
flowRx :: IORef Flow
flowTx :: TVar Flow
peerStreamId :: IORef Concurrency
myUniStreamId :: TVar Concurrency
myStreamId :: TVar Concurrency
streamTable :: IORef StreamTable
peerPacketNumber :: IORef Int
delayedAckCancel :: IORef (IO ())
delayedAckCount :: IORef Int
shared :: Shared
migrationQ :: MigrationQ
outputQ :: OutputQ
cryptoQ :: CryptoQ
inputQ :: InputQ
peerCIDDB :: TVar CIDDB
peerParameters :: IORef Parameters
myCIDDB :: IORef CIDDB
myParameters :: Parameters
quicVersion :: IORef Version
roleInfo :: IORef RoleInfo
mainThreadId :: ThreadId
tmouter :: IORef (IO ())
readers :: IORef (IO ())
sockets :: IORef [Socket]
connRecvQ :: RecvQ
connHooks :: Hooks
connQLog :: QLogger
connDebugLog :: DebugLogger
connState :: ConnState
connLDCC :: Connection -> LDCC
connResources :: Connection -> IORef (IO ())
handshakeCIDs :: Connection -> IORef AuthCIDs
negotiated :: Connection -> IORef Negotiated
currentKeyPhase :: Connection -> IORef (Bool, Int)
protectors :: Connection -> IOArray EncryptionLevel Protector
coders1RTT :: Connection -> IOArray Bool Coder1RTT
coders :: Connection -> IOArray EncryptionLevel Coder
ciphers :: Connection -> IOArray EncryptionLevel Cipher
pendingQ :: Connection -> Array EncryptionLevel (TVar [ReceivedPacket])
addressValidated :: Connection -> TVar Bool
bytesRx :: Connection -> TVar Int
bytesTx :: Connection -> TVar Int
minIdleTimeout :: Connection -> IORef Microseconds
migrationState :: Connection -> TVar MigrationState
flowRx :: Connection -> IORef Flow
flowTx :: Connection -> TVar Flow
peerStreamId :: Connection -> IORef Concurrency
myUniStreamId :: Connection -> TVar Concurrency
myStreamId :: Connection -> TVar Concurrency
streamTable :: Connection -> IORef StreamTable
peerPacketNumber :: Connection -> IORef Int
delayedAckCancel :: Connection -> IORef (IO ())
delayedAckCount :: Connection -> IORef Int
shared :: Connection -> Shared
migrationQ :: Connection -> MigrationQ
outputQ :: Connection -> OutputQ
cryptoQ :: Connection -> CryptoQ
inputQ :: Connection -> InputQ
peerCIDDB :: Connection -> TVar CIDDB
peerParameters :: Connection -> IORef Parameters
myCIDDB :: Connection -> IORef CIDDB
myParameters :: Connection -> Parameters
quicVersion :: Connection -> IORef Version
roleInfo :: Connection -> IORef RoleInfo
mainThreadId :: Connection -> ThreadId
tmouter :: Connection -> IORef (IO ())
readers :: Connection -> IORef (IO ())
sockets :: Connection -> IORef [Socket]
connRecvQ :: Connection -> RecvQ
connHooks :: Connection -> Hooks
connQLog :: Connection -> QLogger
connDebugLog :: Connection -> DebugLogger
connState :: Connection -> ConnState
..} HandshakeMode13
mode Maybe NegotiatedProtocol
mproto ApplicationSecretInfo
appSecInf =
    IORef Negotiated -> Negotiated -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef Negotiated
negotiated Negotiated :: HandshakeMode13
-> Maybe NegotiatedProtocol -> ApplicationSecretInfo -> 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{Array EncryptionLevel (TVar [ReceivedPacket])
IOArray Bool Coder1RTT
IOArray EncryptionLevel Cipher
IOArray EncryptionLevel Protector
IOArray EncryptionLevel Coder
ThreadId
TVar Bool
TVar Int
TVar Flow
TVar Concurrency
TVar MigrationState
TVar CIDDB
IORef Int
IORef [Socket]
IORef (IO ())
IORef (Bool, Int)
IORef Microseconds
IORef Version
IORef Flow
IORef StreamTable
IORef AuthCIDs
IORef Parameters
IORef Concurrency
IORef Negotiated
IORef CIDDB
IORef RoleInfo
MigrationQ
OutputQ
CryptoQ
InputQ
RecvQ
ConnState
Parameters
LDCC
Hooks
Shared
DebugLogger
QLogger
connLDCC :: LDCC
connResources :: IORef (IO ())
handshakeCIDs :: IORef AuthCIDs
negotiated :: IORef Negotiated
currentKeyPhase :: IORef (Bool, Int)
protectors :: IOArray EncryptionLevel Protector
coders1RTT :: IOArray Bool Coder1RTT
coders :: IOArray EncryptionLevel Coder
ciphers :: IOArray EncryptionLevel Cipher
pendingQ :: Array EncryptionLevel (TVar [ReceivedPacket])
addressValidated :: TVar Bool
bytesRx :: TVar Int
bytesTx :: TVar Int
minIdleTimeout :: IORef Microseconds
migrationState :: TVar MigrationState
flowRx :: IORef Flow
flowTx :: TVar Flow
peerStreamId :: IORef Concurrency
myUniStreamId :: TVar Concurrency
myStreamId :: TVar Concurrency
streamTable :: IORef StreamTable
peerPacketNumber :: IORef Int
delayedAckCancel :: IORef (IO ())
delayedAckCount :: IORef Int
shared :: Shared
migrationQ :: MigrationQ
outputQ :: OutputQ
cryptoQ :: CryptoQ
inputQ :: InputQ
peerCIDDB :: TVar CIDDB
peerParameters :: IORef Parameters
myCIDDB :: IORef CIDDB
myParameters :: Parameters
quicVersion :: IORef Version
roleInfo :: IORef RoleInfo
mainThreadId :: ThreadId
tmouter :: IORef (IO ())
readers :: IORef (IO ())
sockets :: IORef [Socket]
connRecvQ :: RecvQ
connHooks :: Hooks
connQLog :: QLogger
connDebugLog :: DebugLogger
connState :: ConnState
connLDCC :: Connection -> LDCC
connResources :: Connection -> IORef (IO ())
handshakeCIDs :: Connection -> IORef AuthCIDs
negotiated :: Connection -> IORef Negotiated
currentKeyPhase :: Connection -> IORef (Bool, Int)
protectors :: Connection -> IOArray EncryptionLevel Protector
coders1RTT :: Connection -> IOArray Bool Coder1RTT
coders :: Connection -> IOArray EncryptionLevel Coder
ciphers :: Connection -> IOArray EncryptionLevel Cipher
pendingQ :: Connection -> Array EncryptionLevel (TVar [ReceivedPacket])
addressValidated :: Connection -> TVar Bool
bytesRx :: Connection -> TVar Int
bytesTx :: Connection -> TVar Int
minIdleTimeout :: Connection -> IORef Microseconds
migrationState :: Connection -> TVar MigrationState
flowRx :: Connection -> IORef Flow
flowTx :: Connection -> TVar Flow
peerStreamId :: Connection -> IORef Concurrency
myUniStreamId :: Connection -> TVar Concurrency
myStreamId :: Connection -> TVar Concurrency
streamTable :: Connection -> IORef StreamTable
peerPacketNumber :: Connection -> IORef Int
delayedAckCancel :: Connection -> IORef (IO ())
delayedAckCount :: Connection -> IORef Int
shared :: Connection -> Shared
migrationQ :: Connection -> MigrationQ
outputQ :: Connection -> OutputQ
cryptoQ :: Connection -> CryptoQ
inputQ :: Connection -> InputQ
peerCIDDB :: Connection -> TVar CIDDB
peerParameters :: Connection -> IORef Parameters
myCIDDB :: Connection -> IORef CIDDB
myParameters :: Connection -> Parameters
quicVersion :: Connection -> IORef Version
roleInfo :: Connection -> IORef RoleInfo
mainThreadId :: Connection -> ThreadId
tmouter :: Connection -> IORef (IO ())
readers :: Connection -> IORef (IO ())
sockets :: Connection -> IORef [Socket]
connRecvQ :: Connection -> RecvQ
connHooks :: Connection -> Hooks
connQLog :: Connection -> QLogger
connDebugLog :: Connection -> DebugLogger
connState :: Connection -> ConnState
..} 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 :: Connection -> EncryptionLevel -> TrafficSecrets a -> IO ()
initializeCoder Connection
conn EncryptionLevel
lvl TrafficSecrets a
sec = do
    Cipher
cipher <- Connection -> EncryptionLevel -> IO Cipher
getCipher Connection
conn EncryptionLevel
lvl
    (Coder
coder, Protector
protector, Supplement
_) <- Bool
-> Cipher -> TrafficSecrets a -> IO (Coder, Protector, Supplement)
forall a.
Bool
-> Cipher -> TrafficSecrets a -> IO (Coder, Protector, Supplement)
genCoder (Connection -> Bool
forall a. Connector a => a -> Bool
isClient Connection
conn) 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
    Cipher
cipher <- Connection -> EncryptionLevel -> IO Cipher
getCipher Connection
conn EncryptionLevel
RTT1Level
    (Coder
coder, Protector
protector, Supplement
supp) <- Bool
-> Cipher
-> TrafficSecrets ApplicationSecret
-> IO (Coder, Protector, Supplement)
forall a.
Bool
-> Cipher -> TrafficSecrets a -> IO (Coder, Protector, Supplement)
genCoder (Connection -> Bool
forall a. Connector a => a -> Bool
isClient Connection
conn) Cipher
cipher TrafficSecrets ApplicationSecret
sec
    let coder1 :: Coder1RTT
coder1 = Coder
-> TrafficSecrets ApplicationSecret -> Supplement -> Coder1RTT
Coder1RTT Coder
coder TrafficSecrets ApplicationSecret
sec Supplement
supp
    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
    Cipher
cipher <- Connection -> EncryptionLevel -> IO Cipher
getCipher Connection
conn EncryptionLevel
RTT1Level
    Coder1RTT Coder
_ TrafficSecrets ApplicationSecret
secN Supplement
supp <- 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 = Cipher
-> TrafficSecrets ApplicationSecret
-> TrafficSecrets ApplicationSecret
updateSecret Cipher
cipher TrafficSecrets ApplicationSecret
secN
    Coder
coderN1 <- Bool
-> Cipher
-> TrafficSecrets ApplicationSecret
-> Supplement
-> IO Coder
forall a.
Bool -> Cipher -> TrafficSecrets a -> Supplement -> IO Coder
genCoder1RTT (Connection -> Bool
forall a. Connector a => a -> Bool
isClient Connection
conn) Cipher
cipher TrafficSecrets ApplicationSecret
secN1 Supplement
supp
    let nextCoder :: Coder1RTT
nextCoder = Coder
-> TrafficSecrets ApplicationSecret -> Supplement -> Coder1RTT
Coder1RTT Coder
coderN1 TrafficSecrets ApplicationSecret
secN1 Supplement
supp
    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 :: Cipher -> TrafficSecrets ApplicationSecret -> TrafficSecrets ApplicationSecret
updateSecret :: Cipher
-> TrafficSecrets ApplicationSecret
-> TrafficSecrets ApplicationSecret
updateSecret Cipher
cipher (ClientTrafficSecret NegotiatedProtocol
cN, ServerTrafficSecret NegotiatedProtocol
sN) = TrafficSecrets ApplicationSecret
forall a a. (ClientTrafficSecret a, ServerTrafficSecret a)
secN1
  where
    Secret NegotiatedProtocol
cN1 = Cipher -> Secret -> Secret
nextSecret Cipher
cipher (Secret -> Secret) -> Secret -> Secret
forall a b. (a -> b) -> a -> b
$ NegotiatedProtocol -> Secret
Secret NegotiatedProtocol
cN
    Secret NegotiatedProtocol
sN1 = Cipher -> Secret -> Secret
nextSecret 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)

genCoder :: Bool -> Cipher -> TrafficSecrets a -> IO (Coder, Protector, Supplement)
genCoder :: Bool
-> Cipher -> TrafficSecrets a -> IO (Coder, Protector, Supplement)
genCoder Bool
cli 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 enc :: Buffer -> Int -> Buffer -> Int -> Int -> Buffer -> IO Int
enc = FusionContext
-> Supplement
-> Buffer
-> Int
-> Buffer
-> Int
-> Int
-> Buffer
-> IO Int
fusionEncrypt FusionContext
fctxt Supplement
supp
        dec :: Buffer -> Int -> Buffer -> Int -> Int -> Buffer -> IO Int
dec = FusionContext
-> Buffer -> Int -> Buffer -> Int -> Int -> Buffer -> IO Int
fusionDecrypt FusionContext
fctxr
        coder :: Coder
coder = (Buffer -> Int -> Buffer -> Int -> Int -> Buffer -> IO Int)
-> (Buffer -> Int -> Buffer -> Int -> Int -> Buffer -> IO Int)
-> Coder
Coder Buffer -> Int -> Buffer -> Int -> Int -> Buffer -> IO Int
enc Buffer -> Int -> Buffer -> Int -> Int -> Buffer -> IO Int
dec
    let set :: Buffer -> IO ()
set = Supplement -> Buffer -> IO ()
fusionSetSample Supplement
supp
        get :: IO Buffer
get = Supplement -> IO Buffer
fusionGetMask Supplement
supp
    let protector :: Protector
protector = (Buffer -> IO ()) -> IO Buffer -> (Sample -> Mask) -> Protector
Protector Buffer -> IO ()
set IO Buffer
get Sample -> Mask
unp
    (Coder, Protector, Supplement) -> IO (Coder, Protector, Supplement)
forall (m :: * -> *) a. Monad m => a -> m a
return (Coder
coder, Protector
protector, Supplement
supp)
  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 = Cipher -> Secret -> Key
aeadKey Cipher
cipher Secret
txSecret
    txPayloadIV :: IV
txPayloadIV  = Cipher -> Secret -> IV
initialVector Cipher
cipher Secret
txSecret
    txHeaderKey :: Key
txHeaderKey  = Cipher -> Secret -> Key
headerProtectionKey Cipher
cipher Secret
txSecret
    rxPayloadKey :: Key
rxPayloadKey = Cipher -> Secret -> Key
aeadKey Cipher
cipher Secret
rxSecret
    rxPayloadIV :: IV
rxPayloadIV  = Cipher -> Secret -> IV
initialVector Cipher
cipher Secret
rxSecret
    rxHeaderKey :: Key
rxHeaderKey  = Cipher -> Secret -> Key
headerProtectionKey Cipher
cipher Secret
rxSecret
    unp :: Sample -> Mask
unp = Cipher -> Key -> Sample -> Mask
protectionMask Cipher
cipher Key
rxHeaderKey

genCoder1RTT :: Bool -> Cipher -> TrafficSecrets a -> Supplement -> IO Coder
genCoder1RTT :: Bool -> Cipher -> TrafficSecrets a -> Supplement -> IO Coder
genCoder1RTT Bool
cli Cipher
cipher (ClientTrafficSecret NegotiatedProtocol
c, ServerTrafficSecret NegotiatedProtocol
s) Supplement
supp = 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 enc :: Buffer -> Int -> Buffer -> Int -> Int -> Buffer -> IO Int
enc = FusionContext
-> Supplement
-> Buffer
-> Int
-> Buffer
-> Int
-> Int
-> Buffer
-> IO Int
fusionEncrypt FusionContext
fctxt Supplement
supp
        dec :: Buffer -> Int -> Buffer -> Int -> Int -> Buffer -> IO Int
dec = FusionContext
-> Buffer -> Int -> Buffer -> Int -> Int -> Buffer -> IO Int
fusionDecrypt FusionContext
fctxr
        coder :: Coder
coder = (Buffer -> Int -> Buffer -> Int -> Int -> Buffer -> IO Int)
-> (Buffer -> Int -> Buffer -> Int -> Int -> Buffer -> IO Int)
-> Coder
Coder Buffer -> Int -> Buffer -> Int -> Int -> Buffer -> IO Int
enc Buffer -> Int -> Buffer -> Int -> Int -> Buffer -> IO Int
dec
    Coder -> IO Coder
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 = Cipher -> Secret -> Key
aeadKey Cipher
cipher Secret
txSecret
    txPayloadIV :: IV
txPayloadIV  = Cipher -> Secret -> IV
initialVector Cipher
cipher Secret
txSecret
    rxPayloadKey :: Key
rxPayloadKey = Cipher -> Secret -> Key
aeadKey Cipher
cipher Secret
rxSecret
    rxPayloadIV :: IV
rxPayloadIV  = Cipher -> Secret -> IV
initialVector 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{Array EncryptionLevel (TVar [ReceivedPacket])
IOArray Bool Coder1RTT
IOArray EncryptionLevel Cipher
IOArray EncryptionLevel Protector
IOArray EncryptionLevel Coder
ThreadId
TVar Bool
TVar Int
TVar Flow
TVar Concurrency
TVar MigrationState
TVar CIDDB
IORef Int
IORef [Socket]
IORef (IO ())
IORef (Bool, Int)
IORef Microseconds
IORef Version
IORef Flow
IORef StreamTable
IORef AuthCIDs
IORef Parameters
IORef Concurrency
IORef Negotiated
IORef CIDDB
IORef RoleInfo
MigrationQ
OutputQ
CryptoQ
InputQ
RecvQ
ConnState
Parameters
LDCC
Hooks
Shared
DebugLogger
QLogger
connLDCC :: LDCC
connResources :: IORef (IO ())
handshakeCIDs :: IORef AuthCIDs
negotiated :: IORef Negotiated
currentKeyPhase :: IORef (Bool, Int)
protectors :: IOArray EncryptionLevel Protector
coders1RTT :: IOArray Bool Coder1RTT
coders :: IOArray EncryptionLevel Coder
ciphers :: IOArray EncryptionLevel Cipher
pendingQ :: Array EncryptionLevel (TVar [ReceivedPacket])
addressValidated :: TVar Bool
bytesRx :: TVar Int
bytesTx :: TVar Int
minIdleTimeout :: IORef Microseconds
migrationState :: TVar MigrationState
flowRx :: IORef Flow
flowTx :: TVar Flow
peerStreamId :: IORef Concurrency
myUniStreamId :: TVar Concurrency
myStreamId :: TVar Concurrency
streamTable :: IORef StreamTable
peerPacketNumber :: IORef Int
delayedAckCancel :: IORef (IO ())
delayedAckCount :: IORef Int
shared :: Shared
migrationQ :: MigrationQ
outputQ :: OutputQ
cryptoQ :: CryptoQ
inputQ :: InputQ
peerCIDDB :: TVar CIDDB
peerParameters :: IORef Parameters
myCIDDB :: IORef CIDDB
myParameters :: Parameters
quicVersion :: IORef Version
roleInfo :: IORef RoleInfo
mainThreadId :: ThreadId
tmouter :: IORef (IO ())
readers :: IORef (IO ())
sockets :: IORef [Socket]
connRecvQ :: RecvQ
connHooks :: Hooks
connQLog :: QLogger
connDebugLog :: DebugLogger
connState :: ConnState
connLDCC :: Connection -> LDCC
connResources :: Connection -> IORef (IO ())
handshakeCIDs :: Connection -> IORef AuthCIDs
negotiated :: Connection -> IORef Negotiated
currentKeyPhase :: Connection -> IORef (Bool, Int)
protectors :: Connection -> IOArray EncryptionLevel Protector
coders1RTT :: Connection -> IOArray Bool Coder1RTT
coders :: Connection -> IOArray EncryptionLevel Coder
ciphers :: Connection -> IOArray EncryptionLevel Cipher
pendingQ :: Connection -> Array EncryptionLevel (TVar [ReceivedPacket])
addressValidated :: Connection -> TVar Bool
bytesRx :: Connection -> TVar Int
bytesTx :: Connection -> TVar Int
minIdleTimeout :: Connection -> IORef Microseconds
migrationState :: Connection -> TVar MigrationState
flowRx :: Connection -> IORef Flow
flowTx :: Connection -> TVar Flow
peerStreamId :: Connection -> IORef Concurrency
myUniStreamId :: Connection -> TVar Concurrency
myStreamId :: Connection -> TVar Concurrency
streamTable :: Connection -> IORef StreamTable
peerPacketNumber :: Connection -> IORef Int
delayedAckCancel :: Connection -> IORef (IO ())
delayedAckCount :: Connection -> IORef Int
shared :: Connection -> Shared
migrationQ :: Connection -> MigrationQ
outputQ :: Connection -> OutputQ
cryptoQ :: Connection -> CryptoQ
inputQ :: Connection -> InputQ
peerCIDDB :: Connection -> TVar CIDDB
peerParameters :: Connection -> IORef Parameters
myCIDDB :: Connection -> IORef CIDDB
myParameters :: Connection -> Parameters
quicVersion :: Connection -> IORef Version
roleInfo :: Connection -> IORef RoleInfo
mainThreadId :: Connection -> ThreadId
tmouter :: Connection -> IORef (IO ())
readers :: Connection -> IORef (IO ())
sockets :: Connection -> IORef [Socket]
connRecvQ :: Connection -> RecvQ
connHooks :: Connection -> Hooks
connQLog :: Connection -> QLogger
connDebugLog :: Connection -> DebugLogger
connState :: Connection -> ConnState
..} = 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{Array EncryptionLevel (TVar [ReceivedPacket])
IOArray Bool Coder1RTT
IOArray EncryptionLevel Cipher
IOArray EncryptionLevel Protector
IOArray EncryptionLevel Coder
ThreadId
TVar Bool
TVar Int
TVar Flow
TVar Concurrency
TVar MigrationState
TVar CIDDB
IORef Int
IORef [Socket]
IORef (IO ())
IORef (Bool, Int)
IORef Microseconds
IORef Version
IORef Flow
IORef StreamTable
IORef AuthCIDs
IORef Parameters
IORef Concurrency
IORef Negotiated
IORef CIDDB
IORef RoleInfo
MigrationQ
OutputQ
CryptoQ
InputQ
RecvQ
ConnState
Parameters
LDCC
Hooks
Shared
DebugLogger
QLogger
connLDCC :: LDCC
connResources :: IORef (IO ())
handshakeCIDs :: IORef AuthCIDs
negotiated :: IORef Negotiated
currentKeyPhase :: IORef (Bool, Int)
protectors :: IOArray EncryptionLevel Protector
coders1RTT :: IOArray Bool Coder1RTT
coders :: IOArray EncryptionLevel Coder
ciphers :: IOArray EncryptionLevel Cipher
pendingQ :: Array EncryptionLevel (TVar [ReceivedPacket])
addressValidated :: TVar Bool
bytesRx :: TVar Int
bytesTx :: TVar Int
minIdleTimeout :: IORef Microseconds
migrationState :: TVar MigrationState
flowRx :: IORef Flow
flowTx :: TVar Flow
peerStreamId :: IORef Concurrency
myUniStreamId :: TVar Concurrency
myStreamId :: TVar Concurrency
streamTable :: IORef StreamTable
peerPacketNumber :: IORef Int
delayedAckCancel :: IORef (IO ())
delayedAckCount :: IORef Int
shared :: Shared
migrationQ :: MigrationQ
outputQ :: OutputQ
cryptoQ :: CryptoQ
inputQ :: InputQ
peerCIDDB :: TVar CIDDB
peerParameters :: IORef Parameters
myCIDDB :: IORef CIDDB
myParameters :: Parameters
quicVersion :: IORef Version
roleInfo :: IORef RoleInfo
mainThreadId :: ThreadId
tmouter :: IORef (IO ())
readers :: IORef (IO ())
sockets :: IORef [Socket]
connRecvQ :: RecvQ
connHooks :: Hooks
connQLog :: QLogger
connDebugLog :: DebugLogger
connState :: ConnState
connLDCC :: Connection -> LDCC
connResources :: Connection -> IORef (IO ())
handshakeCIDs :: Connection -> IORef AuthCIDs
negotiated :: Connection -> IORef Negotiated
currentKeyPhase :: Connection -> IORef (Bool, Int)
protectors :: Connection -> IOArray EncryptionLevel Protector
coders1RTT :: Connection -> IOArray Bool Coder1RTT
coders :: Connection -> IOArray EncryptionLevel Coder
ciphers :: Connection -> IOArray EncryptionLevel Cipher
pendingQ :: Connection -> Array EncryptionLevel (TVar [ReceivedPacket])
addressValidated :: Connection -> TVar Bool
bytesRx :: Connection -> TVar Int
bytesTx :: Connection -> TVar Int
minIdleTimeout :: Connection -> IORef Microseconds
migrationState :: Connection -> TVar MigrationState
flowRx :: Connection -> IORef Flow
flowTx :: Connection -> TVar Flow
peerStreamId :: Connection -> IORef Concurrency
myUniStreamId :: Connection -> TVar Concurrency
myStreamId :: Connection -> TVar Concurrency
streamTable :: Connection -> IORef StreamTable
peerPacketNumber :: Connection -> IORef Int
delayedAckCancel :: Connection -> IORef (IO ())
delayedAckCount :: Connection -> IORef Int
shared :: Connection -> Shared
migrationQ :: Connection -> MigrationQ
outputQ :: Connection -> OutputQ
cryptoQ :: Connection -> CryptoQ
inputQ :: Connection -> InputQ
peerCIDDB :: Connection -> TVar CIDDB
peerParameters :: Connection -> IORef Parameters
myCIDDB :: Connection -> IORef CIDDB
myParameters :: Connection -> Parameters
quicVersion :: Connection -> IORef Version
roleInfo :: Connection -> IORef RoleInfo
mainThreadId :: Connection -> ThreadId
tmouter :: Connection -> IORef (IO ())
readers :: Connection -> IORef (IO ())
sockets :: Connection -> IORef [Socket]
connRecvQ :: Connection -> RecvQ
connHooks :: Connection -> Hooks
connQLog :: Connection -> QLogger
connDebugLog :: Connection -> DebugLogger
connState :: Connection -> ConnState
..} 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)