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

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 Flow
TVar Concurrency
TVar MigrationState
TVar CIDDB
IORef Int
IORef (IO ())
IORef (Bool, Int)
IORef UDPSocket
IORef Microseconds
IORef VersionInfo
IORef Flow
IORef StreamTable
IORef AuthCIDs
IORef Parameters
IORef Concurrency
IORef Negotiated
IORef CIDDB
IORef RoleInfo
MigrationQ
OutputQ
CryptoQ
InputQ
VersionInfo
RecvQ
SizedBuffer
ConnState
Parameters
LDCC
Hooks
Shared
Send
DebugLogger
QLogger
connLDCC :: Connection -> LDCC
decryptBuf :: Connection -> Buffer
encryptRes :: Connection -> SizedBuffer
encodeBuf :: Connection -> Buffer
connResources :: Connection -> IORef (IO ())
connPeerAuthCIDs :: Connection -> IORef AuthCIDs
connMyAuthCIDs :: 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
origVersionInfo :: Connection -> VersionInfo
quicVersionInfo :: Connection -> IORef VersionInfo
roleInfo :: Connection -> IORef RoleInfo
mainThreadId :: Connection -> ThreadId
readers :: Connection -> IORef (IO ())
udpSocket :: Connection -> IORef UDPSocket
connRecvQ :: Connection -> RecvQ
connRecv :: Connection -> Recv
connSend :: Connection -> Send
connHooks :: Connection -> Hooks
connQLog :: Connection -> QLogger
connDebugLog :: Connection -> DebugLogger
connState :: Connection -> ConnState
connLDCC :: LDCC
decryptBuf :: Buffer
encryptRes :: SizedBuffer
encodeBuf :: Buffer
connResources :: IORef (IO ())
connPeerAuthCIDs :: IORef AuthCIDs
connMyAuthCIDs :: 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
origVersionInfo :: VersionInfo
quicVersionInfo :: IORef VersionInfo
roleInfo :: IORef RoleInfo
mainThreadId :: ThreadId
readers :: IORef (IO ())
udpSocket :: IORef UDPSocket
connRecvQ :: RecvQ
connRecv :: Recv
connSend :: Send
connHooks :: Hooks
connQLog :: QLogger
connDebugLog :: DebugLogger
connState :: ConnState
..} EncryptionLevel
lvl = do
    let q :: RecvQ
q = RecvQ
connRecvQ
    forall (m :: * -> *) a. MonadIO m => STM a -> m a
atomically forall a b. (a -> b) -> a -> b
$ do
        forall a. TVar a -> a -> STM ()
writeTVar (ConnState -> TVar EncryptionLevel
encryptionLevel ConnState
connState) EncryptionLevel
lvl
        case EncryptionLevel
lvl of
          EncryptionLevel
HandshakeLevel -> do
              forall a. TVar a -> STM a
readTVar (Array EncryptionLevel (TVar [ReceivedPacket])
pendingQ forall i e. Ix i => Array i e -> i -> e
! EncryptionLevel
RTT0Level)      forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (RecvQ -> ReceivedPacket -> STM ()
prependRecvQ RecvQ
q)
              forall a. TVar a -> STM a
readTVar (Array EncryptionLevel (TVar [ReceivedPacket])
pendingQ forall i e. Ix i => Array i e -> i -> e
! EncryptionLevel
HandshakeLevel) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (RecvQ -> ReceivedPacket -> STM ()
prependRecvQ RecvQ
q)
          EncryptionLevel
RTT1Level      ->
              forall a. TVar a -> STM a
readTVar (Array EncryptionLevel (TVar [ReceivedPacket])
pendingQ forall i e. Ix i => Array i e -> i -> e
! EncryptionLevel
RTT1Level)      forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (RecvQ -> ReceivedPacket -> STM ()
prependRecvQ RecvQ
q)
          EncryptionLevel
_              -> 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 Flow
TVar Concurrency
TVar MigrationState
TVar CIDDB
IORef Int
IORef (IO ())
IORef (Bool, Int)
IORef UDPSocket
IORef Microseconds
IORef VersionInfo
IORef Flow
IORef StreamTable
IORef AuthCIDs
IORef Parameters
IORef Concurrency
IORef Negotiated
IORef CIDDB
IORef RoleInfo
MigrationQ
OutputQ
CryptoQ
InputQ
VersionInfo
RecvQ
SizedBuffer
ConnState
Parameters
LDCC
Hooks
Shared
Send
DebugLogger
QLogger
connLDCC :: LDCC
decryptBuf :: Buffer
encryptRes :: SizedBuffer
encodeBuf :: Buffer
connResources :: IORef (IO ())
connPeerAuthCIDs :: IORef AuthCIDs
connMyAuthCIDs :: 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
origVersionInfo :: VersionInfo
quicVersionInfo :: IORef VersionInfo
roleInfo :: IORef RoleInfo
mainThreadId :: ThreadId
readers :: IORef (IO ())
udpSocket :: IORef UDPSocket
connRecvQ :: RecvQ
connRecv :: Recv
connSend :: Send
connHooks :: Hooks
connQLog :: QLogger
connDebugLog :: DebugLogger
connState :: ConnState
connLDCC :: Connection -> LDCC
decryptBuf :: Connection -> Buffer
encryptRes :: Connection -> SizedBuffer
encodeBuf :: Connection -> Buffer
connResources :: Connection -> IORef (IO ())
connPeerAuthCIDs :: Connection -> IORef AuthCIDs
connMyAuthCIDs :: 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
origVersionInfo :: Connection -> VersionInfo
quicVersionInfo :: Connection -> IORef VersionInfo
roleInfo :: Connection -> IORef RoleInfo
mainThreadId :: Connection -> ThreadId
readers :: Connection -> IORef (IO ())
udpSocket :: Connection -> IORef UDPSocket
connRecvQ :: Connection -> RecvQ
connRecv :: Connection -> Recv
connSend :: Connection -> Send
connHooks :: Connection -> Hooks
connQLog :: Connection -> QLogger
connDebugLog :: Connection -> DebugLogger
connState :: Connection -> ConnState
..} EncryptionLevel
lvl ReceivedPacket
rpkt =
    forall (m :: * -> *) a. MonadIO m => STM a -> m a
atomically forall a b. (a -> b) -> a -> b
$ forall a. TVar a -> (a -> a) -> STM ()
modifyTVar' (Array EncryptionLevel (TVar [ReceivedPacket])
pendingQ forall i e. Ix i => Array i e -> i -> e
! EncryptionLevel
lvl) (ReceivedPacket
rpkt 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 Flow
TVar Concurrency
TVar MigrationState
TVar CIDDB
IORef Int
IORef (IO ())
IORef (Bool, Int)
IORef UDPSocket
IORef Microseconds
IORef VersionInfo
IORef Flow
IORef StreamTable
IORef AuthCIDs
IORef Parameters
IORef Concurrency
IORef Negotiated
IORef CIDDB
IORef RoleInfo
MigrationQ
OutputQ
CryptoQ
InputQ
VersionInfo
RecvQ
SizedBuffer
ConnState
Parameters
LDCC
Hooks
Shared
Send
DebugLogger
QLogger
connLDCC :: LDCC
decryptBuf :: Buffer
encryptRes :: SizedBuffer
encodeBuf :: Buffer
connResources :: IORef (IO ())
connPeerAuthCIDs :: IORef AuthCIDs
connMyAuthCIDs :: 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
origVersionInfo :: VersionInfo
quicVersionInfo :: IORef VersionInfo
roleInfo :: IORef RoleInfo
mainThreadId :: ThreadId
readers :: IORef (IO ())
udpSocket :: IORef UDPSocket
connRecvQ :: RecvQ
connRecv :: Recv
connSend :: Send
connHooks :: Hooks
connQLog :: QLogger
connDebugLog :: DebugLogger
connState :: ConnState
connLDCC :: Connection -> LDCC
decryptBuf :: Connection -> Buffer
encryptRes :: Connection -> SizedBuffer
encodeBuf :: Connection -> Buffer
connResources :: Connection -> IORef (IO ())
connPeerAuthCIDs :: Connection -> IORef AuthCIDs
connMyAuthCIDs :: 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
origVersionInfo :: Connection -> VersionInfo
quicVersionInfo :: Connection -> IORef VersionInfo
roleInfo :: Connection -> IORef RoleInfo
mainThreadId :: Connection -> ThreadId
readers :: Connection -> IORef (IO ())
udpSocket :: Connection -> IORef UDPSocket
connRecvQ :: Connection -> RecvQ
connRecv :: Connection -> Recv
connSend :: Connection -> Send
connHooks :: Connection -> Hooks
connQLog :: Connection -> QLogger
connDebugLog :: Connection -> DebugLogger
connState :: Connection -> ConnState
..} EncryptionLevel
lvl = forall (m :: * -> *) a. MonadIO m => STM a -> m a
atomically forall a b. (a -> b) -> a -> b
$ do
    EncryptionLevel
l <- forall a. TVar a -> STM a
readTVar forall a b. (a -> b) -> a -> b
$ ConnState -> TVar EncryptionLevel
encryptionLevel ConnState
connState
    Bool -> STM ()
checkSTM (EncryptionLevel
l 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 Flow
TVar Concurrency
TVar MigrationState
TVar CIDDB
IORef Int
IORef (IO ())
IORef (Bool, Int)
IORef UDPSocket
IORef Microseconds
IORef VersionInfo
IORef Flow
IORef StreamTable
IORef AuthCIDs
IORef Parameters
IORef Concurrency
IORef Negotiated
IORef CIDDB
IORef RoleInfo
MigrationQ
OutputQ
CryptoQ
InputQ
VersionInfo
RecvQ
SizedBuffer
ConnState
Parameters
LDCC
Hooks
Shared
Send
DebugLogger
QLogger
connLDCC :: LDCC
decryptBuf :: Buffer
encryptRes :: SizedBuffer
encodeBuf :: Buffer
connResources :: IORef (IO ())
connPeerAuthCIDs :: IORef AuthCIDs
connMyAuthCIDs :: 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
origVersionInfo :: VersionInfo
quicVersionInfo :: IORef VersionInfo
roleInfo :: IORef RoleInfo
mainThreadId :: ThreadId
readers :: IORef (IO ())
udpSocket :: IORef UDPSocket
connRecvQ :: RecvQ
connRecv :: Recv
connSend :: Send
connHooks :: Hooks
connQLog :: QLogger
connDebugLog :: DebugLogger
connState :: ConnState
connLDCC :: Connection -> LDCC
decryptBuf :: Connection -> Buffer
encryptRes :: Connection -> SizedBuffer
encodeBuf :: Connection -> Buffer
connResources :: Connection -> IORef (IO ())
connPeerAuthCIDs :: Connection -> IORef AuthCIDs
connMyAuthCIDs :: 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
origVersionInfo :: Connection -> VersionInfo
quicVersionInfo :: Connection -> IORef VersionInfo
roleInfo :: Connection -> IORef RoleInfo
mainThreadId :: Connection -> ThreadId
readers :: Connection -> IORef (IO ())
udpSocket :: Connection -> IORef UDPSocket
connRecvQ :: Connection -> RecvQ
connRecv :: Connection -> Recv
connSend :: Connection -> Send
connHooks :: Connection -> Hooks
connQLog :: Connection -> QLogger
connDebugLog :: Connection -> DebugLogger
connState :: Connection -> ConnState
..} EncryptionLevel
lvl = 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 Flow
TVar Concurrency
TVar MigrationState
TVar CIDDB
IORef Int
IORef (IO ())
IORef (Bool, Int)
IORef UDPSocket
IORef Microseconds
IORef VersionInfo
IORef Flow
IORef StreamTable
IORef AuthCIDs
IORef Parameters
IORef Concurrency
IORef Negotiated
IORef CIDDB
IORef RoleInfo
MigrationQ
OutputQ
CryptoQ
InputQ
VersionInfo
RecvQ
SizedBuffer
ConnState
Parameters
LDCC
Hooks
Shared
Send
DebugLogger
QLogger
connLDCC :: LDCC
decryptBuf :: Buffer
encryptRes :: SizedBuffer
encodeBuf :: Buffer
connResources :: IORef (IO ())
connPeerAuthCIDs :: IORef AuthCIDs
connMyAuthCIDs :: 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
origVersionInfo :: VersionInfo
quicVersionInfo :: IORef VersionInfo
roleInfo :: IORef RoleInfo
mainThreadId :: ThreadId
readers :: IORef (IO ())
udpSocket :: IORef UDPSocket
connRecvQ :: RecvQ
connRecv :: Recv
connSend :: Send
connHooks :: Hooks
connQLog :: QLogger
connDebugLog :: DebugLogger
connState :: ConnState
connLDCC :: Connection -> LDCC
decryptBuf :: Connection -> Buffer
encryptRes :: Connection -> SizedBuffer
encodeBuf :: Connection -> Buffer
connResources :: Connection -> IORef (IO ())
connPeerAuthCIDs :: Connection -> IORef AuthCIDs
connMyAuthCIDs :: 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
origVersionInfo :: Connection -> VersionInfo
quicVersionInfo :: Connection -> IORef VersionInfo
roleInfo :: Connection -> IORef RoleInfo
mainThreadId :: Connection -> ThreadId
readers :: Connection -> IORef (IO ())
udpSocket :: Connection -> IORef UDPSocket
connRecvQ :: Connection -> RecvQ
connRecv :: Connection -> Recv
connSend :: Connection -> Send
connHooks :: Connection -> Hooks
connQLog :: Connection -> QLogger
connDebugLog :: Connection -> DebugLogger
connState :: Connection -> ConnState
..} EncryptionLevel
lvl Cipher
cipher = 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 Flow
TVar Concurrency
TVar MigrationState
TVar CIDDB
IORef Int
IORef (IO ())
IORef (Bool, Int)
IORef UDPSocket
IORef Microseconds
IORef VersionInfo
IORef Flow
IORef StreamTable
IORef AuthCIDs
IORef Parameters
IORef Concurrency
IORef Negotiated
IORef CIDDB
IORef RoleInfo
MigrationQ
OutputQ
CryptoQ
InputQ
VersionInfo
RecvQ
SizedBuffer
ConnState
Parameters
LDCC
Hooks
Shared
Send
DebugLogger
QLogger
connLDCC :: LDCC
decryptBuf :: Buffer
encryptRes :: SizedBuffer
encodeBuf :: Buffer
connResources :: IORef (IO ())
connPeerAuthCIDs :: IORef AuthCIDs
connMyAuthCIDs :: 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
origVersionInfo :: VersionInfo
quicVersionInfo :: IORef VersionInfo
roleInfo :: IORef RoleInfo
mainThreadId :: ThreadId
readers :: IORef (IO ())
udpSocket :: IORef UDPSocket
connRecvQ :: RecvQ
connRecv :: Recv
connSend :: Send
connHooks :: Hooks
connQLog :: QLogger
connDebugLog :: DebugLogger
connState :: ConnState
connLDCC :: Connection -> LDCC
decryptBuf :: Connection -> Buffer
encryptRes :: Connection -> SizedBuffer
encodeBuf :: Connection -> Buffer
connResources :: Connection -> IORef (IO ())
connPeerAuthCIDs :: Connection -> IORef AuthCIDs
connMyAuthCIDs :: 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
origVersionInfo :: Connection -> VersionInfo
quicVersionInfo :: Connection -> IORef VersionInfo
roleInfo :: Connection -> IORef RoleInfo
mainThreadId :: Connection -> ThreadId
readers :: Connection -> IORef (IO ())
udpSocket :: Connection -> IORef UDPSocket
connRecvQ :: Connection -> RecvQ
connRecv :: Connection -> Recv
connSend :: Connection -> Send
connHooks :: Connection -> Hooks
connQLog :: Connection -> QLogger
connDebugLog :: Connection -> DebugLogger
connState :: Connection -> ConnState
..} = Negotiated -> HandshakeMode13
tlsHandshakeMode forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 Flow
TVar Concurrency
TVar MigrationState
TVar CIDDB
IORef Int
IORef (IO ())
IORef (Bool, Int)
IORef UDPSocket
IORef Microseconds
IORef VersionInfo
IORef Flow
IORef StreamTable
IORef AuthCIDs
IORef Parameters
IORef Concurrency
IORef Negotiated
IORef CIDDB
IORef RoleInfo
MigrationQ
OutputQ
CryptoQ
InputQ
VersionInfo
RecvQ
SizedBuffer
ConnState
Parameters
LDCC
Hooks
Shared
Send
DebugLogger
QLogger
connLDCC :: LDCC
decryptBuf :: Buffer
encryptRes :: SizedBuffer
encodeBuf :: Buffer
connResources :: IORef (IO ())
connPeerAuthCIDs :: IORef AuthCIDs
connMyAuthCIDs :: 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
origVersionInfo :: VersionInfo
quicVersionInfo :: IORef VersionInfo
roleInfo :: IORef RoleInfo
mainThreadId :: ThreadId
readers :: IORef (IO ())
udpSocket :: IORef UDPSocket
connRecvQ :: RecvQ
connRecv :: Recv
connSend :: Send
connHooks :: Hooks
connQLog :: QLogger
connDebugLog :: DebugLogger
connState :: ConnState
connLDCC :: Connection -> LDCC
decryptBuf :: Connection -> Buffer
encryptRes :: Connection -> SizedBuffer
encodeBuf :: Connection -> Buffer
connResources :: Connection -> IORef (IO ())
connPeerAuthCIDs :: Connection -> IORef AuthCIDs
connMyAuthCIDs :: 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
origVersionInfo :: Connection -> VersionInfo
quicVersionInfo :: Connection -> IORef VersionInfo
roleInfo :: Connection -> IORef RoleInfo
mainThreadId :: Connection -> ThreadId
readers :: Connection -> IORef (IO ())
udpSocket :: Connection -> IORef UDPSocket
connRecvQ :: Connection -> RecvQ
connRecv :: Connection -> Recv
connSend :: Connection -> Send
connHooks :: Connection -> Hooks
connQLog :: Connection -> QLogger
connDebugLog :: Connection -> DebugLogger
connState :: Connection -> ConnState
..} = Negotiated -> Maybe NegotiatedProtocol
applicationProtocol forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 Flow
TVar Concurrency
TVar MigrationState
TVar CIDDB
IORef Int
IORef (IO ())
IORef (Bool, Int)
IORef UDPSocket
IORef Microseconds
IORef VersionInfo
IORef Flow
IORef StreamTable
IORef AuthCIDs
IORef Parameters
IORef Concurrency
IORef Negotiated
IORef CIDDB
IORef RoleInfo
MigrationQ
OutputQ
CryptoQ
InputQ
VersionInfo
RecvQ
SizedBuffer
ConnState
Parameters
LDCC
Hooks
Shared
Send
DebugLogger
QLogger
connLDCC :: LDCC
decryptBuf :: Buffer
encryptRes :: SizedBuffer
encodeBuf :: Buffer
connResources :: IORef (IO ())
connPeerAuthCIDs :: IORef AuthCIDs
connMyAuthCIDs :: 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
origVersionInfo :: VersionInfo
quicVersionInfo :: IORef VersionInfo
roleInfo :: IORef RoleInfo
mainThreadId :: ThreadId
readers :: IORef (IO ())
udpSocket :: IORef UDPSocket
connRecvQ :: RecvQ
connRecv :: Recv
connSend :: Send
connHooks :: Hooks
connQLog :: QLogger
connDebugLog :: DebugLogger
connState :: ConnState
connLDCC :: Connection -> LDCC
decryptBuf :: Connection -> Buffer
encryptRes :: Connection -> SizedBuffer
encodeBuf :: Connection -> Buffer
connResources :: Connection -> IORef (IO ())
connPeerAuthCIDs :: Connection -> IORef AuthCIDs
connMyAuthCIDs :: 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
origVersionInfo :: Connection -> VersionInfo
quicVersionInfo :: Connection -> IORef VersionInfo
roleInfo :: Connection -> IORef RoleInfo
mainThreadId :: Connection -> ThreadId
readers :: Connection -> IORef (IO ())
udpSocket :: Connection -> IORef UDPSocket
connRecvQ :: Connection -> RecvQ
connRecv :: Connection -> Recv
connSend :: Connection -> Send
connHooks :: Connection -> Hooks
connQLog :: Connection -> QLogger
connDebugLog :: Connection -> DebugLogger
connState :: Connection -> ConnState
..} HandshakeMode13
mode Maybe NegotiatedProtocol
mproto ApplicationSecretInfo
appSecInf =
    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 Flow
TVar Concurrency
TVar MigrationState
TVar CIDDB
IORef Int
IORef (IO ())
IORef (Bool, Int)
IORef UDPSocket
IORef Microseconds
IORef VersionInfo
IORef Flow
IORef StreamTable
IORef AuthCIDs
IORef Parameters
IORef Concurrency
IORef Negotiated
IORef CIDDB
IORef RoleInfo
MigrationQ
OutputQ
CryptoQ
InputQ
VersionInfo
RecvQ
SizedBuffer
ConnState
Parameters
LDCC
Hooks
Shared
Send
DebugLogger
QLogger
connLDCC :: LDCC
decryptBuf :: Buffer
encryptRes :: SizedBuffer
encodeBuf :: Buffer
connResources :: IORef (IO ())
connPeerAuthCIDs :: IORef AuthCIDs
connMyAuthCIDs :: 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
origVersionInfo :: VersionInfo
quicVersionInfo :: IORef VersionInfo
roleInfo :: IORef RoleInfo
mainThreadId :: ThreadId
readers :: IORef (IO ())
udpSocket :: IORef UDPSocket
connRecvQ :: RecvQ
connRecv :: Recv
connSend :: Send
connHooks :: Hooks
connQLog :: QLogger
connDebugLog :: DebugLogger
connState :: ConnState
connLDCC :: Connection -> LDCC
decryptBuf :: Connection -> Buffer
encryptRes :: Connection -> SizedBuffer
encodeBuf :: Connection -> Buffer
connResources :: Connection -> IORef (IO ())
connPeerAuthCIDs :: Connection -> IORef AuthCIDs
connMyAuthCIDs :: 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
origVersionInfo :: Connection -> VersionInfo
quicVersionInfo :: Connection -> IORef VersionInfo
roleInfo :: Connection -> IORef RoleInfo
mainThreadId :: Connection -> ThreadId
readers :: Connection -> IORef (IO ())
udpSocket :: Connection -> IORef UDPSocket
connRecvQ :: Connection -> RecvQ
connRecv :: Connection -> Recv
connSend :: Connection -> Send
connHooks :: Connection -> Hooks
connQLog :: Connection -> QLogger
connDebugLog :: Connection -> DebugLogger
connState :: Connection -> ConnState
..} EncryptionLevel
lvl = do
    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
    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 forall a. Eq a => a -> a -> Bool
== EncryptionLevel
RTT0Level then
             forall (m :: * -> *) a. Monad m => a -> m a
return 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
            forall a.
Bool
-> Version -> Cipher -> TrafficSecrets a -> IO (Coder, Protector)
genFusionCoder (forall a. Connector a => a -> Bool
isClient Connection
conn) Version
ver Cipher
cipher TrafficSecrets a
sec
          else
            forall a.
Bool
-> Version -> Cipher -> TrafficSecrets a -> IO (Coder, Protector)
genNiteCoder (forall a. Connector a => a -> Bool
isClient Connection
conn) Version
ver Cipher
cipher TrafficSecrets a
sec
    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
    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
            forall a.
Bool
-> Version -> Cipher -> TrafficSecrets a -> IO (Coder, Protector)
genFusionCoder (forall a. Connector a => a -> Bool
isClient Connection
conn) Version
ver Cipher
cipher TrafficSecrets ApplicationSecret
sec
          else
            forall a.
Bool
-> Version -> Cipher -> TrafficSecrets a -> IO (Coder, Protector)
genNiteCoder (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
    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
    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 <- 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
                   forall a.
Bool -> Version -> Cipher -> TrafficSecrets a -> Coder -> IO Coder
genFusionCoder1RTT (forall a. Connector a => a -> Bool
isClient Connection
conn) Version
ver Cipher
cipher TrafficSecrets ApplicationSecret
secN1 Coder
coder
                 else
                   forall a.
Bool -> Version -> Cipher -> TrafficSecrets a -> Coder -> IO Coder
genNiteCoder1RTT (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
    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) = forall {a} {a}. (ClientTrafficSecret a, ServerTrafficSecret a)
secN1
  where
    Secret NegotiatedProtocol
cN1 = Version -> Cipher -> Secret -> Secret
nextSecret Version
ver Cipher
cipher forall a b. (a -> b) -> a -> b
$ NegotiatedProtocol -> Secret
Secret NegotiatedProtocol
cN
    Secret NegotiatedProtocol
sN1 = Version -> Cipher -> Secret -> Secret
nextSecret Version
ver Cipher
cipher forall a b. (a -> b) -> a -> b
$ NegotiatedProtocol -> Secret
Secret NegotiatedProtocol
sN
    secN1 :: (ClientTrafficSecret a, ServerTrafficSecret a)
secN1 = (forall a. NegotiatedProtocol -> ClientTrafficSecret a
ClientTrafficSecret NegotiatedProtocol
cN1, 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 = 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
          }
    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 = 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
          }
    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 = forall a. HasCallStack => Maybe a -> a
fromJust 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 = forall a. a -> Maybe a
Just Supplement
supp
          }
    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 = forall a. Maybe a
Nothing
          }
    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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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
_ = 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 = 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 Flow
TVar Concurrency
TVar MigrationState
TVar CIDDB
IORef Int
IORef (IO ())
IORef (Bool, Int)
IORef UDPSocket
IORef Microseconds
IORef VersionInfo
IORef Flow
IORef StreamTable
IORef AuthCIDs
IORef Parameters
IORef Concurrency
IORef Negotiated
IORef CIDDB
IORef RoleInfo
MigrationQ
OutputQ
CryptoQ
InputQ
VersionInfo
RecvQ
SizedBuffer
ConnState
Parameters
LDCC
Hooks
Shared
Send
DebugLogger
QLogger
connLDCC :: LDCC
decryptBuf :: Buffer
encryptRes :: SizedBuffer
encodeBuf :: Buffer
connResources :: IORef (IO ())
connPeerAuthCIDs :: IORef AuthCIDs
connMyAuthCIDs :: 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
origVersionInfo :: VersionInfo
quicVersionInfo :: IORef VersionInfo
roleInfo :: IORef RoleInfo
mainThreadId :: ThreadId
readers :: IORef (IO ())
udpSocket :: IORef UDPSocket
connRecvQ :: RecvQ
connRecv :: Recv
connSend :: Send
connHooks :: Hooks
connQLog :: QLogger
connDebugLog :: DebugLogger
connState :: ConnState
connLDCC :: Connection -> LDCC
decryptBuf :: Connection -> Buffer
encryptRes :: Connection -> SizedBuffer
encodeBuf :: Connection -> Buffer
connResources :: Connection -> IORef (IO ())
connPeerAuthCIDs :: Connection -> IORef AuthCIDs
connMyAuthCIDs :: 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
origVersionInfo :: Connection -> VersionInfo
quicVersionInfo :: Connection -> IORef VersionInfo
roleInfo :: Connection -> IORef RoleInfo
mainThreadId :: Connection -> ThreadId
readers :: Connection -> IORef (IO ())
udpSocket :: Connection -> IORef UDPSocket
connRecvQ :: Connection -> RecvQ
connRecv :: Connection -> Recv
connSend :: Connection -> Send
connHooks :: Connection -> Hooks
connQLog :: Connection -> QLogger
connDebugLog :: Connection -> DebugLogger
connState :: Connection -> ConnState
..} = 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 Flow
TVar Concurrency
TVar MigrationState
TVar CIDDB
IORef Int
IORef (IO ())
IORef (Bool, Int)
IORef UDPSocket
IORef Microseconds
IORef VersionInfo
IORef Flow
IORef StreamTable
IORef AuthCIDs
IORef Parameters
IORef Concurrency
IORef Negotiated
IORef CIDDB
IORef RoleInfo
MigrationQ
OutputQ
CryptoQ
InputQ
VersionInfo
RecvQ
SizedBuffer
ConnState
Parameters
LDCC
Hooks
Shared
Send
DebugLogger
QLogger
connLDCC :: LDCC
decryptBuf :: Buffer
encryptRes :: SizedBuffer
encodeBuf :: Buffer
connResources :: IORef (IO ())
connPeerAuthCIDs :: IORef AuthCIDs
connMyAuthCIDs :: 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
origVersionInfo :: VersionInfo
quicVersionInfo :: IORef VersionInfo
roleInfo :: IORef RoleInfo
mainThreadId :: ThreadId
readers :: IORef (IO ())
udpSocket :: IORef UDPSocket
connRecvQ :: RecvQ
connRecv :: Recv
connSend :: Send
connHooks :: Hooks
connQLog :: QLogger
connDebugLog :: DebugLogger
connState :: ConnState
connLDCC :: Connection -> LDCC
decryptBuf :: Connection -> Buffer
encryptRes :: Connection -> SizedBuffer
encodeBuf :: Connection -> Buffer
connResources :: Connection -> IORef (IO ())
connPeerAuthCIDs :: Connection -> IORef AuthCIDs
connMyAuthCIDs :: 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
origVersionInfo :: Connection -> VersionInfo
quicVersionInfo :: Connection -> IORef VersionInfo
roleInfo :: Connection -> IORef RoleInfo
mainThreadId :: Connection -> ThreadId
readers :: Connection -> IORef (IO ())
udpSocket :: Connection -> IORef UDPSocket
connRecvQ :: Connection -> RecvQ
connRecv :: Connection -> Recv
connSend :: Connection -> Send
connHooks :: Connection -> Hooks
connQLog :: Connection -> QLogger
connDebugLog :: Connection -> DebugLogger
connState :: Connection -> ConnState
..} Bool
k Int
pn = forall a. IORef a -> a -> IO ()
writeIORef IORef (Bool, Int)
currentKeyPhase (Bool
k, Int
pn)