{-# LANGUAGE BinaryLiterals #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}

module Network.QUIC.Connection.Stream (
    getMyStreamId,
    possibleMyStreams,
    waitMyNewStreamId,
    waitMyNewUniStreamId,
    setTxMaxStreams,
    setTxUniMaxStreams,
    checkRxMaxStreams,
    updatePeerStreamId,
    checkStreamIdRoom,
) where

import Control.Concurrent.STM

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

getMyStreamId :: Connection -> IO Int
getMyStreamId :: Connection -> IO StreamId
getMyStreamId 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
..} = do
    StreamId
next <- Concurrency -> StreamId
currentStream (Concurrency -> StreamId) -> IO Concurrency -> IO StreamId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TVar Concurrency -> IO Concurrency
forall a. TVar a -> IO a
readTVarIO TVar Concurrency
myStreamId
    StreamId -> IO StreamId
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (StreamId -> IO StreamId) -> StreamId -> IO StreamId
forall a b. (a -> b) -> a -> b
$ StreamId
next StreamId -> StreamId -> StreamId
forall a. Num a => a -> a -> a
- StreamId
4

possibleMyStreams :: Connection -> IO Int
possibleMyStreams :: Connection -> IO StreamId
possibleMyStreams 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
    Concurrency{StreamId
StreamIdBase
currentStream :: Concurrency -> StreamId
currentStream :: StreamId
maxStreams :: StreamIdBase
maxStreams :: Concurrency -> StreamIdBase
..} <- TVar Concurrency -> IO Concurrency
forall a. TVar a -> IO a
readTVarIO TVar Concurrency
myStreamId
    let StreamIdBase StreamId
base = StreamIdBase
maxStreams
    StreamId -> IO StreamId
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (StreamId
base StreamId -> StreamId -> StreamId
forall a. Num a => a -> a -> a
- (StreamId
currentStream StreamId -> StreamId -> StreamId
forall a. Bits a => a -> StreamId -> a
!>>. StreamId
2))

waitMyNewStreamId :: Connection -> IO StreamId
waitMyNewStreamId :: Connection -> IO StreamId
waitMyNewStreamId 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
..} = TVar Concurrency -> IO StreamId
get TVar Concurrency
myStreamId

waitMyNewUniStreamId :: Connection -> IO StreamId
waitMyNewUniStreamId :: Connection -> IO StreamId
waitMyNewUniStreamId 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
..} = TVar Concurrency -> IO StreamId
get TVar Concurrency
myUniStreamId

get :: TVar Concurrency -> IO Int
get :: TVar Concurrency -> IO StreamId
get TVar Concurrency
tvar = STM StreamId -> IO StreamId
forall a. STM a -> IO a
atomically (STM StreamId -> IO StreamId) -> STM StreamId -> IO StreamId
forall a b. (a -> b) -> a -> b
$ do
    conc :: Concurrency
conc@Concurrency{StreamId
StreamIdBase
currentStream :: Concurrency -> StreamId
maxStreams :: Concurrency -> StreamIdBase
currentStream :: StreamId
maxStreams :: StreamIdBase
..} <- TVar Concurrency -> STM Concurrency
forall a. TVar a -> STM a
readTVar TVar Concurrency
tvar
    let streamType :: StreamId
streamType = StreamId
currentStream StreamId -> StreamId -> StreamId
forall a. Bits a => a -> a -> a
.&. StreamId
0b11
        StreamIdBase StreamId
base = StreamIdBase
maxStreams
    Bool -> STM ()
check (StreamId
currentStream StreamId -> StreamId -> Bool
forall a. Ord a => a -> a -> Bool
< StreamId
base StreamId -> StreamId -> StreamId
forall a. Num a => a -> a -> a
* StreamId
4 StreamId -> StreamId -> StreamId
forall a. Num a => a -> a -> a
+ StreamId
streamType)
    let currentStream' :: StreamId
currentStream' = StreamId
currentStream StreamId -> StreamId -> StreamId
forall a. Num a => a -> a -> a
+ StreamId
4
    TVar Concurrency -> Concurrency -> STM ()
forall a. TVar a -> a -> STM ()
writeTVar TVar Concurrency
tvar Concurrency
conc{currentStream = currentStream'}
    StreamId -> STM StreamId
forall a. a -> STM a
forall (m :: * -> *) a. Monad m => a -> m a
return StreamId
currentStream

-- From "Peer", but set it to "My".
-- So, using "Tx".
setTxMaxStreams :: Connection -> Int -> IO ()
setTxMaxStreams :: Connection -> StreamId -> IO ()
setTxMaxStreams 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
..} = TVar Concurrency -> StreamId -> IO ()
set TVar Concurrency
myStreamId

setTxUniMaxStreams :: Connection -> Int -> IO ()
setTxUniMaxStreams :: Connection -> StreamId -> IO ()
setTxUniMaxStreams 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
..} = TVar Concurrency -> StreamId -> IO ()
set TVar Concurrency
myUniStreamId

set :: TVar Concurrency -> Int -> IO ()
set :: TVar Concurrency -> StreamId -> IO ()
set TVar Concurrency
tvar StreamId
mx = STM () -> IO ()
forall a. STM a -> IO a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ TVar Concurrency -> (Concurrency -> Concurrency) -> STM ()
forall a. TVar a -> (a -> a) -> STM ()
modifyTVar TVar Concurrency
tvar ((Concurrency -> Concurrency) -> STM ())
-> (Concurrency -> Concurrency) -> STM ()
forall a b. (a -> b) -> a -> b
$ \Concurrency
c -> Concurrency
c{maxStreams = StreamIdBase mx}

updatePeerStreamId :: Connection -> StreamId -> IO ()
updatePeerStreamId :: Connection -> StreamId -> IO ()
updatePeerStreamId Connection
conn StreamId
sid = do
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when
        ( (Connection -> Bool
forall a. Connector a => a -> Bool
isClient Connection
conn Bool -> Bool -> Bool
&& StreamId -> Bool
isServerInitiatedBidirectional StreamId
sid)
            Bool -> Bool -> Bool
|| (Connection -> Bool
forall a. Connector a => a -> Bool
isServer Connection
conn Bool -> Bool -> Bool
&& StreamId -> Bool
isClientInitiatedBidirectional StreamId
sid)
        )
        (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
            IORef Concurrency -> (Concurrency -> Concurrency) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
atomicModifyIORef'' (Connection -> IORef Concurrency
peerStreamId Connection
conn) Concurrency -> Concurrency
checkConc
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when
        ( (Connection -> Bool
forall a. Connector a => a -> Bool
isClient Connection
conn Bool -> Bool -> Bool
&& StreamId -> Bool
isServerInitiatedUnidirectional StreamId
sid)
            Bool -> Bool -> Bool
|| (Connection -> Bool
forall a. Connector a => a -> Bool
isServer Connection
conn Bool -> Bool -> Bool
&& StreamId -> Bool
isClientInitiatedUnidirectional StreamId
sid)
        )
        (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
            IORef Concurrency -> (Concurrency -> Concurrency) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
atomicModifyIORef'' (Connection -> IORef Concurrency
peerUniStreamId Connection
conn) Concurrency -> Concurrency
checkConc
  where
    checkConc :: Concurrency -> Concurrency
checkConc conc :: Concurrency
conc@Concurrency{StreamId
StreamIdBase
currentStream :: Concurrency -> StreamId
maxStreams :: Concurrency -> StreamIdBase
currentStream :: StreamId
maxStreams :: StreamIdBase
..}
        | StreamId
currentStream StreamId -> StreamId -> Bool
forall a. Ord a => a -> a -> Bool
< StreamId
sid = Concurrency
conc{currentStream = sid}
        | Bool
otherwise = Concurrency
conc

checkRxMaxStreams :: Connection -> StreamId -> IO Bool
checkRxMaxStreams :: Connection -> StreamId -> IO Bool
checkRxMaxStreams 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
    Concurrency{StreamId
StreamIdBase
currentStream :: Concurrency -> StreamId
maxStreams :: Concurrency -> StreamIdBase
currentStream :: StreamId
maxStreams :: StreamIdBase
..} <- if Connection -> Bool
forall a. Connector a => a -> Bool
isClient Connection
conn then IO Concurrency
readForClient else IO Concurrency
readForServer
    let StreamIdBase StreamId
base = StreamIdBase
maxStreams
        ok :: Bool
ok = StreamId
sid StreamId -> StreamId -> Bool
forall a. Ord a => a -> a -> Bool
< StreamId
base StreamId -> StreamId -> StreamId
forall a. Num a => a -> a -> a
* StreamId
4 StreamId -> StreamId -> StreamId
forall a. Num a => a -> a -> a
+ StreamId
streamType
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
ok
  where
    streamType :: StreamId
streamType = StreamId
sid StreamId -> StreamId -> StreamId
forall a. Bits a => a -> a -> a
.&. StreamId
0b11
    readForClient :: IO Concurrency
readForClient = case StreamId
streamType of
        StreamId
0 -> TVar Concurrency -> IO Concurrency
forall a. TVar a -> IO a
readTVarIO TVar Concurrency
myStreamId
        StreamId
1 -> IORef Concurrency -> IO Concurrency
forall a. IORef a -> IO a
readIORef IORef Concurrency
peerStreamId
        StreamId
2 -> TVar Concurrency -> IO Concurrency
forall a. TVar a -> IO a
readTVarIO TVar Concurrency
myUniStreamId
        StreamId
3 -> IORef Concurrency -> IO Concurrency
forall a. IORef a -> IO a
readIORef IORef Concurrency
peerUniStreamId
        StreamId
_ -> [Char] -> IO Concurrency
forall a. HasCallStack => [Char] -> a
error [Char]
"never reach"
    readForServer :: IO Concurrency
readForServer = case StreamId
streamType of
        StreamId
0 -> IORef Concurrency -> IO Concurrency
forall a. IORef a -> IO a
readIORef IORef Concurrency
peerStreamId
        StreamId
1 -> TVar Concurrency -> IO Concurrency
forall a. TVar a -> IO a
readTVarIO TVar Concurrency
myStreamId
        StreamId
2 -> IORef Concurrency -> IO Concurrency
forall a. IORef a -> IO a
readIORef IORef Concurrency
peerUniStreamId
        StreamId
3 -> TVar Concurrency -> IO Concurrency
forall a. TVar a -> IO a
readTVarIO TVar Concurrency
myUniStreamId
        StreamId
_ -> [Char] -> IO Concurrency
forall a. HasCallStack => [Char] -> a
error [Char]
"never reach"

checkStreamIdRoom :: Connection -> Direction -> IO (Maybe Int)
checkStreamIdRoom :: Connection -> Direction -> IO (Maybe StreamId)
checkStreamIdRoom Connection
conn Direction
dir = do
    let ref :: IORef Concurrency
ref
            | Direction
dir Direction -> Direction -> Bool
forall a. Eq a => a -> a -> Bool
== Direction
Bidirectional = Connection -> IORef Concurrency
peerStreamId Connection
conn
            | Bool
otherwise = Connection -> IORef Concurrency
peerUniStreamId Connection
conn
    IORef Concurrency
-> (Concurrency -> (Concurrency, Maybe StreamId))
-> IO (Maybe StreamId)
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef' IORef Concurrency
ref Concurrency -> (Concurrency, Maybe StreamId)
checkConc
  where
    checkConc :: Concurrency -> (Concurrency, Maybe StreamId)
checkConc conc :: Concurrency
conc@Concurrency{StreamId
StreamIdBase
currentStream :: Concurrency -> StreamId
maxStreams :: Concurrency -> StreamIdBase
currentStream :: StreamId
maxStreams :: StreamIdBase
..} =
        let StreamIdBase StreamId
base = StreamIdBase
maxStreams
            initialStreams :: StreamId
initialStreams = Parameters -> StreamId
initialMaxStreamsBidi (Parameters -> StreamId) -> Parameters -> StreamId
forall a b. (a -> b) -> a -> b
$ Connection -> Parameters
getMyParameters Connection
conn
            cbase :: StreamId
cbase = StreamId
currentStream StreamId -> StreamId -> StreamId
forall a. Bits a => a -> StreamId -> a
!>>. StreamId
2
         in if StreamId
base StreamId -> StreamId -> StreamId
forall a. Num a => a -> a -> a
- StreamId
cbase StreamId -> StreamId -> Bool
forall a. Ord a => a -> a -> Bool
< (StreamId
initialStreams StreamId -> StreamId -> StreamId
forall a. Bits a => a -> StreamId -> a
!>>. StreamId
3)
                then
                    let base' :: StreamId
base' = StreamId
cbase StreamId -> StreamId -> StreamId
forall a. Num a => a -> a -> a
+ StreamId
initialStreams
                     in (Concurrency
conc{maxStreams = StreamIdBase base'}, StreamId -> Maybe StreamId
forall a. a -> Maybe a
Just StreamId
base')
                else (Concurrency
conc, Maybe StreamId
forall a. Maybe a
Nothing)