{-# LANGUAGE RecordWildCards #-}

module Network.QUIC.Connection.StreamTable (
    createStream,
    findStream,
    addStream,
    delStream,
    initialRxMaxStreamData,
    setupCryptoStreams,
    clearCryptoStream,
    getCryptoStream,
) where

import Network.QUIC.Connection.Misc
import Network.QUIC.Connection.Queue
import Network.QUIC.Connection.Types
import Network.QUIC.Connector
import Network.QUIC.Imports
import Network.QUIC.Parameters
import Network.QUIC.Stream
import Network.QUIC.Types

createStream :: Connection -> StreamId -> IO Stream
createStream :: Connection -> StreamId -> IO Stream
createStream Connection
conn StreamId
sid = do
    Stream
strm <- Connection -> StreamId -> IO Stream
addStream Connection
conn StreamId
sid
    Connection -> Input -> IO ()
putInput Connection
conn (Input -> IO ()) -> Input -> IO ()
forall a b. (a -> b) -> a -> b
$ Stream -> Input
InpStream Stream
strm
    Stream -> IO Stream
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Stream
strm

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

addStream :: Connection -> StreamId -> IO Stream
addStream :: Connection -> StreamId -> IO Stream
addStream conn :: Connection
conn@Connection{Recv
Buffer
Array EncryptionLevel (TVar [ReceivedPacket])
IOArray Bool Coder1RTT
IOArray EncryptionLevel Cipher
IOArray EncryptionLevel Protector
IOArray EncryptionLevel Coder
ThreadId
TVar TxFlow
TVar Concurrency
TVar MigrationState
TVar CIDDB
IORef Bool
IORef StreamId
IORef (IO ())
IORef (Bool, StreamId)
IORef (Map Word64 (Weak ThreadId))
IORef Socket
IORef RxFlow
IORef Microseconds
IORef VersionInfo
IORef AuthCIDs
IORef Parameters
IORef StreamTable
IORef PeerInfo
IORef Concurrency
IORef Negotiated
IORef CIDDB
IORef RoleInfo
Rate
OutputQ
CryptoQ
InputQ
VersionInfo
RecvQ
SizedBuffer
ConnState
Parameters
LDCC
Hooks
Shared
Send
DebugLogger
CID -> StatelessResetToken
QLogger
connLDCC :: Connection -> LDCC
connResources :: Connection -> IORef (IO ())
decryptBuf :: Connection -> Buffer
encryptRes :: Connection -> SizedBuffer
encodeBuf :: Connection -> Buffer
connPeerAuthCIDs :: Connection -> IORef AuthCIDs
connMyAuthCIDs :: Connection -> IORef AuthCIDs
negotiated :: Connection -> IORef Negotiated
currentKeyPhase :: Connection -> IORef (Bool, StreamId)
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])
bytesRx :: Connection -> IORef StreamId
bytesTx :: Connection -> IORef StreamId
minIdleTimeout :: Connection -> IORef Microseconds
sentRetirePriorTo :: Connection -> IORef Bool
migrationState :: Connection -> TVar MigrationState
flowRx :: Connection -> IORef RxFlow
flowTx :: Connection -> TVar TxFlow
peerUniStreamId :: Connection -> IORef Concurrency
peerStreamId :: Connection -> IORef Concurrency
myUniStreamId :: Connection -> TVar Concurrency
myStreamId :: Connection -> TVar Concurrency
streamTable :: Connection -> IORef StreamTable
peerPacketNumber :: Connection -> IORef StreamId
delayedAckCancel :: Connection -> IORef (IO ())
delayedAckCount :: Connection -> IORef StreamId
shared :: Connection -> Shared
outputRate :: Connection -> Rate
outputQ :: Connection -> OutputQ
cryptoQ :: Connection -> CryptoQ
inputQ :: Connection -> InputQ
peerInfo :: Connection -> IORef PeerInfo
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
controlRate :: Connection -> Rate
mainThreadId :: Connection -> ThreadId
readers :: Connection -> IORef (Map Word64 (Weak ThreadId))
genStatelessResetToken :: Connection -> CID -> StatelessResetToken
connSocket :: Connection -> IORef Socket
connRecvQ :: Connection -> RecvQ
connRecv :: Connection -> Recv
connSend :: Connection -> Send
connHooks :: Connection -> Hooks
connQLog :: Connection -> QLogger
connDebugLog :: Connection -> DebugLogger
connState :: Connection -> ConnState
connState :: ConnState
connDebugLog :: DebugLogger
connQLog :: QLogger
connHooks :: Hooks
connSend :: Send
connRecv :: Recv
connRecvQ :: RecvQ
connSocket :: IORef Socket
genStatelessResetToken :: CID -> StatelessResetToken
readers :: IORef (Map Word64 (Weak ThreadId))
mainThreadId :: ThreadId
controlRate :: Rate
roleInfo :: IORef RoleInfo
quicVersionInfo :: IORef VersionInfo
origVersionInfo :: VersionInfo
myParameters :: Parameters
myCIDDB :: IORef CIDDB
peerParameters :: IORef Parameters
peerCIDDB :: TVar CIDDB
peerInfo :: IORef PeerInfo
inputQ :: InputQ
cryptoQ :: CryptoQ
outputQ :: OutputQ
outputRate :: Rate
shared :: Shared
delayedAckCount :: IORef StreamId
delayedAckCancel :: IORef (IO ())
peerPacketNumber :: IORef StreamId
streamTable :: IORef StreamTable
myStreamId :: TVar Concurrency
myUniStreamId :: TVar Concurrency
peerStreamId :: IORef Concurrency
peerUniStreamId :: IORef Concurrency
flowTx :: TVar TxFlow
flowRx :: IORef RxFlow
migrationState :: TVar MigrationState
sentRetirePriorTo :: IORef Bool
minIdleTimeout :: IORef Microseconds
bytesTx :: IORef StreamId
bytesRx :: IORef StreamId
pendingQ :: Array EncryptionLevel (TVar [ReceivedPacket])
ciphers :: IOArray EncryptionLevel Cipher
coders :: IOArray EncryptionLevel Coder
coders1RTT :: IOArray Bool Coder1RTT
protectors :: IOArray EncryptionLevel Protector
currentKeyPhase :: IORef (Bool, StreamId)
negotiated :: IORef Negotiated
connMyAuthCIDs :: IORef AuthCIDs
connPeerAuthCIDs :: IORef AuthCIDs
encodeBuf :: Buffer
encryptRes :: SizedBuffer
decryptBuf :: Buffer
connResources :: IORef (IO ())
connLDCC :: LDCC
..} StreamId
sid = do
    Stream
strm <-
        if Connection -> Bool
forall a. Connector a => a -> Bool
isClient Connection
conn
            then do
                Parameters
serverParams <- Connection -> IO Parameters
getPeerParameters Connection
conn
                let txLim :: StreamId
txLim = StreamId -> Parameters -> StreamId
serverInitial StreamId
sid Parameters
serverParams
                let clientParams :: Parameters
clientParams = Connection -> Parameters
getMyParameters Connection
conn
                    rxLim :: StreamId
rxLim = StreamId -> Parameters -> StreamId
clientInitial StreamId
sid Parameters
clientParams
                Connection -> StreamId -> StreamId -> StreamId -> IO Stream
newStream Connection
conn StreamId
sid StreamId
txLim StreamId
rxLim
            else do
                Parameters
clientParams <- Connection -> IO Parameters
getPeerParameters Connection
conn
                let txLim :: StreamId
txLim = StreamId -> Parameters -> StreamId
clientInitial StreamId
sid Parameters
clientParams
                    serverParams :: Parameters
serverParams = Connection -> Parameters
getMyParameters Connection
conn
                    rxLim :: StreamId
rxLim = StreamId -> Parameters -> StreamId
serverInitial StreamId
sid Parameters
serverParams
                Connection -> StreamId -> StreamId -> StreamId -> IO Stream
newStream Connection
conn StreamId
sid StreamId
txLim StreamId
rxLim
    IORef StreamTable -> (StreamTable -> StreamTable) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
atomicModifyIORef'' IORef StreamTable
streamTable ((StreamTable -> StreamTable) -> IO ())
-> (StreamTable -> StreamTable) -> IO ()
forall a b. (a -> b) -> a -> b
$ StreamId -> Stream -> StreamTable -> StreamTable
insertStream StreamId
sid Stream
strm
    Stream -> IO Stream
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Stream
strm

delStream :: Connection -> Stream -> IO ()
delStream :: Connection -> Stream -> IO ()
delStream Connection{Recv
Buffer
Array EncryptionLevel (TVar [ReceivedPacket])
IOArray Bool Coder1RTT
IOArray EncryptionLevel Cipher
IOArray EncryptionLevel Protector
IOArray EncryptionLevel Coder
ThreadId
TVar TxFlow
TVar Concurrency
TVar MigrationState
TVar CIDDB
IORef Bool
IORef StreamId
IORef (IO ())
IORef (Bool, StreamId)
IORef (Map Word64 (Weak ThreadId))
IORef Socket
IORef RxFlow
IORef Microseconds
IORef VersionInfo
IORef AuthCIDs
IORef Parameters
IORef StreamTable
IORef PeerInfo
IORef Concurrency
IORef Negotiated
IORef CIDDB
IORef RoleInfo
Rate
OutputQ
CryptoQ
InputQ
VersionInfo
RecvQ
SizedBuffer
ConnState
Parameters
LDCC
Hooks
Shared
Send
DebugLogger
CID -> StatelessResetToken
QLogger
connLDCC :: Connection -> LDCC
connResources :: Connection -> IORef (IO ())
decryptBuf :: Connection -> Buffer
encryptRes :: Connection -> SizedBuffer
encodeBuf :: Connection -> Buffer
connPeerAuthCIDs :: Connection -> IORef AuthCIDs
connMyAuthCIDs :: Connection -> IORef AuthCIDs
negotiated :: Connection -> IORef Negotiated
currentKeyPhase :: Connection -> IORef (Bool, StreamId)
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])
bytesRx :: Connection -> IORef StreamId
bytesTx :: Connection -> IORef StreamId
minIdleTimeout :: Connection -> IORef Microseconds
sentRetirePriorTo :: Connection -> IORef Bool
migrationState :: Connection -> TVar MigrationState
flowRx :: Connection -> IORef RxFlow
flowTx :: Connection -> TVar TxFlow
peerUniStreamId :: Connection -> IORef Concurrency
peerStreamId :: Connection -> IORef Concurrency
myUniStreamId :: Connection -> TVar Concurrency
myStreamId :: Connection -> TVar Concurrency
streamTable :: Connection -> IORef StreamTable
peerPacketNumber :: Connection -> IORef StreamId
delayedAckCancel :: Connection -> IORef (IO ())
delayedAckCount :: Connection -> IORef StreamId
shared :: Connection -> Shared
outputRate :: Connection -> Rate
outputQ :: Connection -> OutputQ
cryptoQ :: Connection -> CryptoQ
inputQ :: Connection -> InputQ
peerInfo :: Connection -> IORef PeerInfo
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
controlRate :: Connection -> Rate
mainThreadId :: Connection -> ThreadId
readers :: Connection -> IORef (Map Word64 (Weak ThreadId))
genStatelessResetToken :: Connection -> CID -> StatelessResetToken
connSocket :: Connection -> IORef Socket
connRecvQ :: Connection -> RecvQ
connRecv :: Connection -> Recv
connSend :: Connection -> Send
connHooks :: Connection -> Hooks
connQLog :: Connection -> QLogger
connDebugLog :: Connection -> DebugLogger
connState :: Connection -> ConnState
connState :: ConnState
connDebugLog :: DebugLogger
connQLog :: QLogger
connHooks :: Hooks
connSend :: Send
connRecv :: Recv
connRecvQ :: RecvQ
connSocket :: IORef Socket
genStatelessResetToken :: CID -> StatelessResetToken
readers :: IORef (Map Word64 (Weak ThreadId))
mainThreadId :: ThreadId
controlRate :: Rate
roleInfo :: IORef RoleInfo
quicVersionInfo :: IORef VersionInfo
origVersionInfo :: VersionInfo
myParameters :: Parameters
myCIDDB :: IORef CIDDB
peerParameters :: IORef Parameters
peerCIDDB :: TVar CIDDB
peerInfo :: IORef PeerInfo
inputQ :: InputQ
cryptoQ :: CryptoQ
outputQ :: OutputQ
outputRate :: Rate
shared :: Shared
delayedAckCount :: IORef StreamId
delayedAckCancel :: IORef (IO ())
peerPacketNumber :: IORef StreamId
streamTable :: IORef StreamTable
myStreamId :: TVar Concurrency
myUniStreamId :: TVar Concurrency
peerStreamId :: IORef Concurrency
peerUniStreamId :: IORef Concurrency
flowTx :: TVar TxFlow
flowRx :: IORef RxFlow
migrationState :: TVar MigrationState
sentRetirePriorTo :: IORef Bool
minIdleTimeout :: IORef Microseconds
bytesTx :: IORef StreamId
bytesRx :: IORef StreamId
pendingQ :: Array EncryptionLevel (TVar [ReceivedPacket])
ciphers :: IOArray EncryptionLevel Cipher
coders :: IOArray EncryptionLevel Coder
coders1RTT :: IOArray Bool Coder1RTT
protectors :: IOArray EncryptionLevel Protector
currentKeyPhase :: IORef (Bool, StreamId)
negotiated :: IORef Negotiated
connMyAuthCIDs :: IORef AuthCIDs
connPeerAuthCIDs :: IORef AuthCIDs
encodeBuf :: Buffer
encryptRes :: SizedBuffer
decryptBuf :: Buffer
connResources :: IORef (IO ())
connLDCC :: LDCC
..} Stream
strm =
    IORef StreamTable -> (StreamTable -> StreamTable) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
atomicModifyIORef'' IORef StreamTable
streamTable ((StreamTable -> StreamTable) -> IO ())
-> (StreamTable -> StreamTable) -> IO ()
forall a b. (a -> b) -> a -> b
$ StreamId -> StreamTable -> StreamTable
deleteStream (StreamId -> StreamTable -> StreamTable)
-> StreamId -> StreamTable -> StreamTable
forall a b. (a -> b) -> a -> b
$ Stream -> StreamId
streamId Stream
strm

initialRxMaxStreamData :: Connection -> StreamId -> Int
initialRxMaxStreamData :: Connection -> StreamId -> StreamId
initialRxMaxStreamData Connection
conn StreamId
sid
    | Connection -> Bool
forall a. Connector a => a -> Bool
isClient Connection
conn = StreamId -> Parameters -> StreamId
clientInitial StreamId
sid Parameters
params
    | Bool
otherwise = StreamId -> Parameters -> StreamId
serverInitial StreamId
sid Parameters
params
  where
    params :: Parameters
params = Connection -> Parameters
getMyParameters Connection
conn

clientInitial :: StreamId -> Parameters -> Int
clientInitial :: StreamId -> Parameters -> StreamId
clientInitial StreamId
sid Parameters
params
    | StreamId -> Bool
isClientInitiatedBidirectional StreamId
sid = Parameters -> StreamId
initialMaxStreamDataBidiLocal Parameters
params
    | StreamId -> Bool
isServerInitiatedBidirectional StreamId
sid = Parameters -> StreamId
initialMaxStreamDataBidiRemote Parameters
params
    -- intentionally not using isServerInitiatedUnidirectional
    | Bool
otherwise = Parameters -> StreamId
initialMaxStreamDataUni Parameters
params

serverInitial :: StreamId -> Parameters -> Int
serverInitial :: StreamId -> Parameters -> StreamId
serverInitial StreamId
sid Parameters
params
    | StreamId -> Bool
isServerInitiatedBidirectional StreamId
sid = Parameters -> StreamId
initialMaxStreamDataBidiLocal Parameters
params
    | StreamId -> Bool
isClientInitiatedBidirectional StreamId
sid = Parameters -> StreamId
initialMaxStreamDataBidiRemote Parameters
params
    -- intentionally not using isClientInitiatedUnidirectional
    | Bool
otherwise = Parameters -> StreamId
initialMaxStreamDataUni Parameters
params

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

setupCryptoStreams :: Connection -> IO ()
setupCryptoStreams :: Connection -> IO ()
setupCryptoStreams conn :: Connection
conn@Connection{Recv
Buffer
Array EncryptionLevel (TVar [ReceivedPacket])
IOArray Bool Coder1RTT
IOArray EncryptionLevel Cipher
IOArray EncryptionLevel Protector
IOArray EncryptionLevel Coder
ThreadId
TVar TxFlow
TVar Concurrency
TVar MigrationState
TVar CIDDB
IORef Bool
IORef StreamId
IORef (IO ())
IORef (Bool, StreamId)
IORef (Map Word64 (Weak ThreadId))
IORef Socket
IORef RxFlow
IORef Microseconds
IORef VersionInfo
IORef AuthCIDs
IORef Parameters
IORef StreamTable
IORef PeerInfo
IORef Concurrency
IORef Negotiated
IORef CIDDB
IORef RoleInfo
Rate
OutputQ
CryptoQ
InputQ
VersionInfo
RecvQ
SizedBuffer
ConnState
Parameters
LDCC
Hooks
Shared
Send
DebugLogger
CID -> StatelessResetToken
QLogger
connLDCC :: Connection -> LDCC
connResources :: Connection -> IORef (IO ())
decryptBuf :: Connection -> Buffer
encryptRes :: Connection -> SizedBuffer
encodeBuf :: Connection -> Buffer
connPeerAuthCIDs :: Connection -> IORef AuthCIDs
connMyAuthCIDs :: Connection -> IORef AuthCIDs
negotiated :: Connection -> IORef Negotiated
currentKeyPhase :: Connection -> IORef (Bool, StreamId)
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])
bytesRx :: Connection -> IORef StreamId
bytesTx :: Connection -> IORef StreamId
minIdleTimeout :: Connection -> IORef Microseconds
sentRetirePriorTo :: Connection -> IORef Bool
migrationState :: Connection -> TVar MigrationState
flowRx :: Connection -> IORef RxFlow
flowTx :: Connection -> TVar TxFlow
peerUniStreamId :: Connection -> IORef Concurrency
peerStreamId :: Connection -> IORef Concurrency
myUniStreamId :: Connection -> TVar Concurrency
myStreamId :: Connection -> TVar Concurrency
streamTable :: Connection -> IORef StreamTable
peerPacketNumber :: Connection -> IORef StreamId
delayedAckCancel :: Connection -> IORef (IO ())
delayedAckCount :: Connection -> IORef StreamId
shared :: Connection -> Shared
outputRate :: Connection -> Rate
outputQ :: Connection -> OutputQ
cryptoQ :: Connection -> CryptoQ
inputQ :: Connection -> InputQ
peerInfo :: Connection -> IORef PeerInfo
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
controlRate :: Connection -> Rate
mainThreadId :: Connection -> ThreadId
readers :: Connection -> IORef (Map Word64 (Weak ThreadId))
genStatelessResetToken :: Connection -> CID -> StatelessResetToken
connSocket :: Connection -> IORef Socket
connRecvQ :: Connection -> RecvQ
connRecv :: Connection -> Recv
connSend :: Connection -> Send
connHooks :: Connection -> Hooks
connQLog :: Connection -> QLogger
connDebugLog :: Connection -> DebugLogger
connState :: Connection -> ConnState
connState :: ConnState
connDebugLog :: DebugLogger
connQLog :: QLogger
connHooks :: Hooks
connSend :: Send
connRecv :: Recv
connRecvQ :: RecvQ
connSocket :: IORef Socket
genStatelessResetToken :: CID -> StatelessResetToken
readers :: IORef (Map Word64 (Weak ThreadId))
mainThreadId :: ThreadId
controlRate :: Rate
roleInfo :: IORef RoleInfo
quicVersionInfo :: IORef VersionInfo
origVersionInfo :: VersionInfo
myParameters :: Parameters
myCIDDB :: IORef CIDDB
peerParameters :: IORef Parameters
peerCIDDB :: TVar CIDDB
peerInfo :: IORef PeerInfo
inputQ :: InputQ
cryptoQ :: CryptoQ
outputQ :: OutputQ
outputRate :: Rate
shared :: Shared
delayedAckCount :: IORef StreamId
delayedAckCancel :: IORef (IO ())
peerPacketNumber :: IORef StreamId
streamTable :: IORef StreamTable
myStreamId :: TVar Concurrency
myUniStreamId :: TVar Concurrency
peerStreamId :: IORef Concurrency
peerUniStreamId :: IORef Concurrency
flowTx :: TVar TxFlow
flowRx :: IORef RxFlow
migrationState :: TVar MigrationState
sentRetirePriorTo :: IORef Bool
minIdleTimeout :: IORef Microseconds
bytesTx :: IORef StreamId
bytesRx :: IORef StreamId
pendingQ :: Array EncryptionLevel (TVar [ReceivedPacket])
ciphers :: IOArray EncryptionLevel Cipher
coders :: IOArray EncryptionLevel Coder
coders1RTT :: IOArray Bool Coder1RTT
protectors :: IOArray EncryptionLevel Protector
currentKeyPhase :: IORef (Bool, StreamId)
negotiated :: IORef Negotiated
connMyAuthCIDs :: IORef AuthCIDs
connPeerAuthCIDs :: IORef AuthCIDs
encodeBuf :: Buffer
encryptRes :: SizedBuffer
decryptBuf :: Buffer
connResources :: IORef (IO ())
connLDCC :: LDCC
..} = do
    StreamTable
stbl0 <- IORef StreamTable -> IO StreamTable
forall a. IORef a -> IO a
readIORef IORef StreamTable
streamTable
    StreamTable
stbl <- Connection -> StreamTable -> IO StreamTable
insertCryptoStreams Connection
conn StreamTable
stbl0
    IORef StreamTable -> StreamTable -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef StreamTable
streamTable StreamTable
stbl

clearCryptoStream :: Connection -> EncryptionLevel -> IO ()
clearCryptoStream :: Connection -> EncryptionLevel -> IO ()
clearCryptoStream Connection{Recv
Buffer
Array EncryptionLevel (TVar [ReceivedPacket])
IOArray Bool Coder1RTT
IOArray EncryptionLevel Cipher
IOArray EncryptionLevel Protector
IOArray EncryptionLevel Coder
ThreadId
TVar TxFlow
TVar Concurrency
TVar MigrationState
TVar CIDDB
IORef Bool
IORef StreamId
IORef (IO ())
IORef (Bool, StreamId)
IORef (Map Word64 (Weak ThreadId))
IORef Socket
IORef RxFlow
IORef Microseconds
IORef VersionInfo
IORef AuthCIDs
IORef Parameters
IORef StreamTable
IORef PeerInfo
IORef Concurrency
IORef Negotiated
IORef CIDDB
IORef RoleInfo
Rate
OutputQ
CryptoQ
InputQ
VersionInfo
RecvQ
SizedBuffer
ConnState
Parameters
LDCC
Hooks
Shared
Send
DebugLogger
CID -> StatelessResetToken
QLogger
connLDCC :: Connection -> LDCC
connResources :: Connection -> IORef (IO ())
decryptBuf :: Connection -> Buffer
encryptRes :: Connection -> SizedBuffer
encodeBuf :: Connection -> Buffer
connPeerAuthCIDs :: Connection -> IORef AuthCIDs
connMyAuthCIDs :: Connection -> IORef AuthCIDs
negotiated :: Connection -> IORef Negotiated
currentKeyPhase :: Connection -> IORef (Bool, StreamId)
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])
bytesRx :: Connection -> IORef StreamId
bytesTx :: Connection -> IORef StreamId
minIdleTimeout :: Connection -> IORef Microseconds
sentRetirePriorTo :: Connection -> IORef Bool
migrationState :: Connection -> TVar MigrationState
flowRx :: Connection -> IORef RxFlow
flowTx :: Connection -> TVar TxFlow
peerUniStreamId :: Connection -> IORef Concurrency
peerStreamId :: Connection -> IORef Concurrency
myUniStreamId :: Connection -> TVar Concurrency
myStreamId :: Connection -> TVar Concurrency
streamTable :: Connection -> IORef StreamTable
peerPacketNumber :: Connection -> IORef StreamId
delayedAckCancel :: Connection -> IORef (IO ())
delayedAckCount :: Connection -> IORef StreamId
shared :: Connection -> Shared
outputRate :: Connection -> Rate
outputQ :: Connection -> OutputQ
cryptoQ :: Connection -> CryptoQ
inputQ :: Connection -> InputQ
peerInfo :: Connection -> IORef PeerInfo
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
controlRate :: Connection -> Rate
mainThreadId :: Connection -> ThreadId
readers :: Connection -> IORef (Map Word64 (Weak ThreadId))
genStatelessResetToken :: Connection -> CID -> StatelessResetToken
connSocket :: Connection -> IORef Socket
connRecvQ :: Connection -> RecvQ
connRecv :: Connection -> Recv
connSend :: Connection -> Send
connHooks :: Connection -> Hooks
connQLog :: Connection -> QLogger
connDebugLog :: Connection -> DebugLogger
connState :: Connection -> ConnState
connState :: ConnState
connDebugLog :: DebugLogger
connQLog :: QLogger
connHooks :: Hooks
connSend :: Send
connRecv :: Recv
connRecvQ :: RecvQ
connSocket :: IORef Socket
genStatelessResetToken :: CID -> StatelessResetToken
readers :: IORef (Map Word64 (Weak ThreadId))
mainThreadId :: ThreadId
controlRate :: Rate
roleInfo :: IORef RoleInfo
quicVersionInfo :: IORef VersionInfo
origVersionInfo :: VersionInfo
myParameters :: Parameters
myCIDDB :: IORef CIDDB
peerParameters :: IORef Parameters
peerCIDDB :: TVar CIDDB
peerInfo :: IORef PeerInfo
inputQ :: InputQ
cryptoQ :: CryptoQ
outputQ :: OutputQ
outputRate :: Rate
shared :: Shared
delayedAckCount :: IORef StreamId
delayedAckCancel :: IORef (IO ())
peerPacketNumber :: IORef StreamId
streamTable :: IORef StreamTable
myStreamId :: TVar Concurrency
myUniStreamId :: TVar Concurrency
peerStreamId :: IORef Concurrency
peerUniStreamId :: IORef Concurrency
flowTx :: TVar TxFlow
flowRx :: IORef RxFlow
migrationState :: TVar MigrationState
sentRetirePriorTo :: IORef Bool
minIdleTimeout :: IORef Microseconds
bytesTx :: IORef StreamId
bytesRx :: IORef StreamId
pendingQ :: Array EncryptionLevel (TVar [ReceivedPacket])
ciphers :: IOArray EncryptionLevel Cipher
coders :: IOArray EncryptionLevel Coder
coders1RTT :: IOArray Bool Coder1RTT
protectors :: IOArray EncryptionLevel Protector
currentKeyPhase :: IORef (Bool, StreamId)
negotiated :: IORef Negotiated
connMyAuthCIDs :: IORef AuthCIDs
connPeerAuthCIDs :: IORef AuthCIDs
encodeBuf :: Buffer
encryptRes :: SizedBuffer
decryptBuf :: Buffer
connResources :: IORef (IO ())
connLDCC :: LDCC
..} EncryptionLevel
lvl =
    IORef StreamTable -> (StreamTable -> StreamTable) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
atomicModifyIORef'' IORef StreamTable
streamTable ((StreamTable -> StreamTable) -> IO ())
-> (StreamTable -> StreamTable) -> IO ()
forall a b. (a -> b) -> a -> b
$ EncryptionLevel -> StreamTable -> StreamTable
deleteCryptoStream EncryptionLevel
lvl

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

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