{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
module Network.HTTP2.H2.Context where
import Control.Concurrent.STM
import Control.Exception
import qualified Control.Exception as E
import Data.IORef
import Network.Control
import Network.Socket (SockAddr)
import qualified System.ThreadManager as T
import Imports hiding (insert)
import Network.HPACK
import Network.HTTP2.Frame
import Network.HTTP2.H2.Settings
import Network.HTTP2.H2.Stream
import Network.HTTP2.H2.StreamTable
import Network.HTTP2.H2.Types
data Role = Client | Server deriving (Role -> Role -> Bool
(Role -> Role -> Bool) -> (Role -> Role -> Bool) -> Eq Role
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Role -> Role -> Bool
== :: Role -> Role -> Bool
$c/= :: Role -> Role -> Bool
/= :: Role -> Role -> Bool
Eq, Int -> Role -> ShowS
[Role] -> ShowS
Role -> String
(Int -> Role -> ShowS)
-> (Role -> String) -> ([Role] -> ShowS) -> Show Role
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Role -> ShowS
showsPrec :: Int -> Role -> ShowS
$cshow :: Role -> String
show :: Role -> String
$cshowList :: [Role] -> ShowS
showList :: [Role] -> ShowS
Show)
data RoleInfo = RIS ServerInfo | RIC ClientInfo
type Launch = Context -> Stream -> InpObj -> IO ()
newtype ServerInfo = ServerInfo
{ ServerInfo -> Launch
launch :: Launch
}
data ClientInfo = ClientInfo
{ ClientInfo -> ByteString
scheme :: ByteString
, ClientInfo -> String
authority :: Authority
}
toServerInfo :: RoleInfo -> ServerInfo
toServerInfo :: RoleInfo -> ServerInfo
toServerInfo (RIS ServerInfo
x) = ServerInfo
x
toServerInfo RoleInfo
_ = String -> ServerInfo
forall a. HasCallStack => String -> a
error String
"toServerInfo"
toClientInfo :: RoleInfo -> ClientInfo
toClientInfo :: RoleInfo -> ClientInfo
toClientInfo (RIC ClientInfo
x) = ClientInfo
x
toClientInfo RoleInfo
_ = String -> ClientInfo
forall a. HasCallStack => String -> a
error String
"toClientInfo"
newServerInfo :: Launch -> RoleInfo
newServerInfo :: Launch -> RoleInfo
newServerInfo = ServerInfo -> RoleInfo
RIS (ServerInfo -> RoleInfo)
-> (Launch -> ServerInfo) -> Launch -> RoleInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Launch -> ServerInfo
ServerInfo
newClientInfo :: ByteString -> Authority -> RoleInfo
newClientInfo :: ByteString -> String -> RoleInfo
newClientInfo ByteString
scm String
auth = ClientInfo -> RoleInfo
RIC (ClientInfo -> RoleInfo) -> ClientInfo -> RoleInfo
forall a b. (a -> b) -> a -> b
$ ByteString -> String -> ClientInfo
ClientInfo ByteString
scm String
auth
data Context = Context
{ Context -> Role
role :: Role
, Context -> RoleInfo
roleInfo :: RoleInfo
,
Context -> Settings
mySettings :: Settings
, Context -> IORef Bool
myFirstSettings :: IORef Bool
, Context -> IORef Settings
peerSettings :: IORef Settings
, Context -> TVar OddStreamTable
oddStreamTable :: TVar OddStreamTable
, Context -> TVar EvenStreamTable
evenStreamTable :: TVar EvenStreamTable
, Context -> IORef (Maybe Int)
continued :: IORef (Maybe StreamId)
, Context -> TVar Int
myStreamId :: TVar StreamId
, Context -> IORef Int
peerStreamId :: IORef StreamId
, Context -> IORef Int
outputBufferLimit :: IORef Int
, Context -> TQueue Output
outputQ :: TQueue Output
, Context -> TVar Int
outputQStreamID :: TVar StreamId
, Context -> TQueue Control
controlQ :: TQueue Control
, Context -> DynamicTable
encodeDynamicTable :: DynamicTable
, Context -> DynamicTable
decodeDynamicTable :: DynamicTable
,
Context -> TVar TxFlow
txFlow :: TVar TxFlow
, Context -> IORef RxFlow
rxFlow :: IORef RxFlow
, Context -> Rate
pingRate :: Rate
, Context -> Rate
settingsRate :: Rate
, Context -> Rate
emptyFrameRate :: Rate
, Context -> Rate
rstRate :: Rate
, Context -> SockAddr
mySockAddr :: SockAddr
, Context -> SockAddr
peerSockAddr :: SockAddr
, Context -> ThreadManager
threadManager :: T.ThreadManager
}
newContext
:: RoleInfo
-> Config
-> Int
-> Int
-> Settings
-> T.Manager
-> IO Context
newContext :: RoleInfo
-> Config -> Int -> Int -> Settings -> Manager -> IO Context
newContext RoleInfo
roleInfo Config{Int
Buffer
SockAddr
Manager
Int -> IO ByteString
PositionReadMaker
ByteString -> IO ()
confWriteBuffer :: Buffer
confBufferSize :: Int
confSendAll :: ByteString -> IO ()
confReadN :: Int -> IO ByteString
confPositionReadMaker :: PositionReadMaker
confTimeoutManager :: Manager
confMySockAddr :: SockAddr
confPeerSockAddr :: SockAddr
confPeerSockAddr :: Config -> SockAddr
confMySockAddr :: Config -> SockAddr
confTimeoutManager :: Config -> Manager
confPositionReadMaker :: Config -> PositionReadMaker
confReadN :: Config -> Int -> IO ByteString
confSendAll :: Config -> ByteString -> IO ()
confBufferSize :: Config -> Int
confWriteBuffer :: Config -> Buffer
..} Int
cacheSiz Int
connRxWS Settings
mySettings Manager
timmgr = do
myFirstSettings <- Bool -> IO (IORef Bool)
forall a. a -> IO (IORef a)
newIORef Bool
False
peerSettings <-
newIORef baseSettings{maxConcurrentStreams = Just defaultMaxStreams}
oddStreamTable <- newTVarIO emptyOddStreamTable
evenStreamTable <- newTVarIO (emptyEvenStreamTable cacheSiz)
continued <- newIORef Nothing
myStreamId <- newTVarIO sid0
peerStreamId <- newIORef 0
outputBufferLimit <- newIORef buflim
outputQ <- newTQueueIO
outputQStreamID <- newTVarIO sid0
controlQ <- newTQueueIO
encodeDynamicTable <- newDynamicTableForEncoding defaultDynamicTableSize
decodeDynamicTable <-
newDynamicTableForDecoding (headerTableSize mySettings) 4096
txFlow <- newTVarIO (newTxFlow defaultWindowSize)
rxFlow <- newIORef (newRxFlow connRxWS)
pingRate <- newRate
settingsRate <- newRate
emptyFrameRate <- newRate
rstRate <- newRate
let mySockAddr = SockAddr
confMySockAddr
let peerSockAddr = SockAddr
confPeerSockAddr
threadManager <- T.newThreadManager timmgr
return Context{..}
where
role :: Role
role = case RoleInfo
roleInfo of
RIC{} -> Role
Client
RoleInfo
_ -> Role
Server
sid0 :: Int
sid0
| Role
role Role -> Role -> Bool
forall a. Eq a => a -> a -> Bool
== Role
Client = Int
1
| Bool
otherwise = Int
2
dlim :: Int
dlim = Int
defaultPayloadLength Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
frameHeaderLength
buflim :: Int
buflim
| Int
confBufferSize Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
dlim = Int
dlim
| Bool
otherwise = Int
confBufferSize
isClient :: Context -> Bool
isClient :: Context -> Bool
isClient Context
ctx = Context -> Role
role Context
ctx Role -> Role -> Bool
forall a. Eq a => a -> a -> Bool
== Role
Client
isServer :: Context -> Bool
isServer :: Context -> Bool
isServer Context
ctx = Context -> Role
role Context
ctx Role -> Role -> Bool
forall a. Eq a => a -> a -> Bool
== Role
Server
getMyNewStreamId :: Context -> STM StreamId
getMyNewStreamId :: Context -> STM Int
getMyNewStreamId Context{TVar Int
TVar TxFlow
TVar EvenStreamTable
TVar OddStreamTable
IORef Bool
IORef Int
IORef (Maybe Int)
IORef RxFlow
IORef Settings
DynamicTable
Rate
Settings
TQueue Control
TQueue Output
SockAddr
ThreadManager
RoleInfo
Role
role :: Context -> Role
roleInfo :: Context -> RoleInfo
mySettings :: Context -> Settings
myFirstSettings :: Context -> IORef Bool
peerSettings :: Context -> IORef Settings
oddStreamTable :: Context -> TVar OddStreamTable
evenStreamTable :: Context -> TVar EvenStreamTable
continued :: Context -> IORef (Maybe Int)
myStreamId :: Context -> TVar Int
peerStreamId :: Context -> IORef Int
outputBufferLimit :: Context -> IORef Int
outputQ :: Context -> TQueue Output
outputQStreamID :: Context -> TVar Int
controlQ :: Context -> TQueue Control
encodeDynamicTable :: Context -> DynamicTable
decodeDynamicTable :: Context -> DynamicTable
txFlow :: Context -> TVar TxFlow
rxFlow :: Context -> IORef RxFlow
pingRate :: Context -> Rate
settingsRate :: Context -> Rate
emptyFrameRate :: Context -> Rate
rstRate :: Context -> Rate
mySockAddr :: Context -> SockAddr
peerSockAddr :: Context -> SockAddr
threadManager :: Context -> ThreadManager
role :: Role
roleInfo :: RoleInfo
mySettings :: Settings
myFirstSettings :: IORef Bool
peerSettings :: IORef Settings
oddStreamTable :: TVar OddStreamTable
evenStreamTable :: TVar EvenStreamTable
continued :: IORef (Maybe Int)
myStreamId :: TVar Int
peerStreamId :: IORef Int
outputBufferLimit :: IORef Int
outputQ :: TQueue Output
outputQStreamID :: TVar Int
controlQ :: TQueue Control
encodeDynamicTable :: DynamicTable
decodeDynamicTable :: DynamicTable
txFlow :: TVar TxFlow
rxFlow :: IORef RxFlow
pingRate :: Rate
settingsRate :: Rate
emptyFrameRate :: Rate
rstRate :: Rate
mySockAddr :: SockAddr
peerSockAddr :: SockAddr
threadManager :: ThreadManager
..} = do
n <- TVar Int -> STM Int
forall a. TVar a -> STM a
readTVar TVar Int
myStreamId
let n' = Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2
writeTVar myStreamId n'
return n
getPeerStreamID :: Context -> IO StreamId
getPeerStreamID :: Context -> IO Int
getPeerStreamID Context
ctx = IORef Int -> IO Int
forall a. IORef a -> IO a
readIORef (IORef Int -> IO Int) -> IORef Int -> IO Int
forall a b. (a -> b) -> a -> b
$ Context -> IORef Int
peerStreamId Context
ctx
setPeerStreamID :: Context -> StreamId -> IO ()
setPeerStreamID :: Context -> Int -> IO ()
setPeerStreamID Context
ctx Int
sid = IORef Int -> Int -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (Context -> IORef Int
peerStreamId Context
ctx) Int
sid
{-# INLINE setStreamState #-}
setStreamState :: Context -> Stream -> StreamState -> IO ()
setStreamState :: Context -> Stream -> StreamState -> IO ()
setStreamState Context
_ Stream{IORef StreamState
streamState :: IORef StreamState
streamState :: Stream -> IORef StreamState
streamState} StreamState
newState = do
oldState <- IORef StreamState -> IO StreamState
forall a. IORef a -> IO a
readIORef IORef StreamState
streamState
case (oldState, newState) of
(Open Maybe ClosedCode
_ (Body TQueue (Either SomeException (ByteString, Bool))
q Maybe Int
_ IORef Int
_ IORef (Maybe TokenHeaderTable)
_), Open Maybe ClosedCode
_ (Body TQueue (Either SomeException (ByteString, Bool))
q' Maybe Int
_ IORef Int
_ IORef (Maybe TokenHeaderTable)
_))
| TQueue (Either SomeException (ByteString, Bool))
q TQueue (Either SomeException (ByteString, Bool))
-> TQueue (Either SomeException (ByteString, Bool)) -> Bool
forall a. Eq a => a -> a -> Bool
== TQueue (Either SomeException (ByteString, Bool))
q' ->
() -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
(Open Maybe ClosedCode
_ (Body TQueue (Either SomeException (ByteString, Bool))
q Maybe Int
_ IORef Int
_ IORef (Maybe TokenHeaderTable)
_), StreamState
_) ->
STM () -> IO ()
forall a. STM a -> IO a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ TQueue (Either SomeException (ByteString, Bool))
-> Either SomeException (ByteString, Bool) -> STM ()
forall a. TQueue a -> a -> STM ()
writeTQueue TQueue (Either SomeException (ByteString, Bool))
q (Either SomeException (ByteString, Bool) -> STM ())
-> Either SomeException (ByteString, Bool) -> STM ()
forall a b. (a -> b) -> a -> b
$ SomeException -> Either SomeException (ByteString, Bool)
forall a b. a -> Either a b
Left (SomeException -> Either SomeException (ByteString, Bool))
-> SomeException -> Either SomeException (ByteString, Bool)
forall a b. (a -> b) -> a -> b
$ HTTP2Error -> SomeException
forall e. Exception e => e -> SomeException
toException HTTP2Error
ConnectionIsClosed
(StreamState, StreamState)
_otherwise ->
() -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
writeIORef streamState newState
opened :: Context -> Stream -> IO ()
opened :: Context -> Stream -> IO ()
opened Context
ctx Stream
strm = Context -> Stream -> StreamState -> IO ()
setStreamState Context
ctx Stream
strm (Maybe ClosedCode -> OpenState -> StreamState
Open Maybe ClosedCode
forall a. Maybe a
Nothing OpenState
JustOpened)
halfClosedRemote :: Context -> Stream -> IO ()
halfClosedRemote :: Context -> Stream -> IO ()
halfClosedRemote Context
ctx stream :: Stream
stream@Stream{IORef StreamState
streamState :: Stream -> IORef StreamState
streamState :: IORef StreamState
streamState} = do
closingCode <- IORef StreamState
-> (StreamState -> (StreamState, Maybe ClosedCode))
-> IO (Maybe ClosedCode)
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef IORef StreamState
streamState StreamState -> (StreamState, Maybe ClosedCode)
closeHalf
traverse_ (closed ctx stream) closingCode
where
closeHalf :: StreamState -> (StreamState, Maybe ClosedCode)
closeHalf :: StreamState -> (StreamState, Maybe ClosedCode)
closeHalf x :: StreamState
x@(Closed ClosedCode
_) = (StreamState
x, Maybe ClosedCode
forall a. Maybe a
Nothing)
closeHalf (Open (Just ClosedCode
cc) OpenState
_) = (ClosedCode -> StreamState
Closed ClosedCode
cc, ClosedCode -> Maybe ClosedCode
forall a. a -> Maybe a
Just ClosedCode
cc)
closeHalf StreamState
_ = (StreamState
HalfClosedRemote, Maybe ClosedCode
forall a. Maybe a
Nothing)
halfClosedLocal :: Context -> Stream -> ClosedCode -> IO ()
halfClosedLocal :: Context -> Stream -> ClosedCode -> IO ()
halfClosedLocal Context
ctx stream :: Stream
stream@Stream{IORef StreamState
streamState :: Stream -> IORef StreamState
streamState :: IORef StreamState
streamState} ClosedCode
cc = do
shouldFinalize <- IORef StreamState
-> (StreamState -> (StreamState, Bool)) -> IO Bool
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef IORef StreamState
streamState StreamState -> (StreamState, Bool)
closeHalf
when shouldFinalize $
closed ctx stream cc
where
closeHalf :: StreamState -> (StreamState, Bool)
closeHalf :: StreamState -> (StreamState, Bool)
closeHalf x :: StreamState
x@(Closed ClosedCode
_) = (StreamState
x, Bool
False)
closeHalf StreamState
HalfClosedRemote = (ClosedCode -> StreamState
Closed ClosedCode
cc, Bool
True)
closeHalf (Open Maybe ClosedCode
Nothing OpenState
o) = (Maybe ClosedCode -> OpenState -> StreamState
Open (ClosedCode -> Maybe ClosedCode
forall a. a -> Maybe a
Just ClosedCode
cc) OpenState
o, Bool
False)
closeHalf StreamState
_ = (Maybe ClosedCode -> OpenState -> StreamState
Open (ClosedCode -> Maybe ClosedCode
forall a. a -> Maybe a
Just ClosedCode
cc) OpenState
JustOpened, Bool
False)
closed :: Context -> Stream -> ClosedCode -> IO ()
closed :: Context -> Stream -> ClosedCode -> IO ()
closed ctx :: Context
ctx@Context{TVar OddStreamTable
oddStreamTable :: Context -> TVar OddStreamTable
oddStreamTable :: TVar OddStreamTable
oddStreamTable, TVar EvenStreamTable
evenStreamTable :: Context -> TVar EvenStreamTable
evenStreamTable :: TVar EvenStreamTable
evenStreamTable} strm :: Stream
strm@Stream{Int
streamNumber :: Int
streamNumber :: Stream -> Int
streamNumber} ClosedCode
cc = do
if Int -> Bool
isServerInitiated Int
streamNumber
then TVar EvenStreamTable -> Int -> SomeException -> IO ()
deleteEven TVar EvenStreamTable
evenStreamTable Int
streamNumber SomeException
err
else TVar OddStreamTable -> Int -> SomeException -> IO ()
deleteOdd TVar OddStreamTable
oddStreamTable Int
streamNumber SomeException
err
Context -> Stream -> StreamState -> IO ()
setStreamState Context
ctx Stream
strm (ClosedCode -> StreamState
Closed ClosedCode
cc)
where
err :: SomeException
err :: SomeException
err = HTTP2Error -> SomeException
forall e. Exception e => e -> SomeException
toException (Int -> ClosedCode -> HTTP2Error
closedCodeToError Int
streamNumber ClosedCode
cc)
openOddStreamCheck :: Context -> StreamId -> FrameType -> IO Stream
openOddStreamCheck :: Context -> Int -> FrameType -> IO Stream
openOddStreamCheck ctx :: Context
ctx@Context{TVar OddStreamTable
oddStreamTable :: Context -> TVar OddStreamTable
oddStreamTable :: TVar OddStreamTable
oddStreamTable, IORef Settings
peerSettings :: Context -> IORef Settings
peerSettings :: IORef Settings
peerSettings, Settings
mySettings :: Context -> Settings
mySettings :: Settings
mySettings} Int
sid FrameType
ftyp = do
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (FrameType
ftyp FrameType -> FrameType -> Bool
forall a. Eq a => a -> a -> Bool
== FrameType
FrameHeaders) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
conc <- TVar OddStreamTable -> IO Int
getOddConcurrency TVar OddStreamTable
oddStreamTable
checkMyConcurrency sid mySettings (conc + 1)
txws <- Settings -> Int
initialWindowSize (Settings -> Int) -> IO Settings -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IORef Settings -> IO Settings
forall a. IORef a -> IO a
readIORef IORef Settings
peerSettings
let rxws = Settings -> Int
initialWindowSize Settings
mySettings
newstrm <- newOddStream sid txws rxws
when (ftyp == FrameHeaders || ftyp == FramePushPromise) $ opened ctx newstrm
insertOdd oddStreamTable sid newstrm
return newstrm
openEvenStreamCacheCheck :: Context -> StreamId -> Method -> ByteString -> IO ()
openEvenStreamCacheCheck :: Context -> Int -> ByteString -> ByteString -> IO ()
openEvenStreamCacheCheck Context{TVar EvenStreamTable
evenStreamTable :: Context -> TVar EvenStreamTable
evenStreamTable :: TVar EvenStreamTable
evenStreamTable, IORef Settings
peerSettings :: Context -> IORef Settings
peerSettings :: IORef Settings
peerSettings, Settings
mySettings :: Context -> Settings
mySettings :: Settings
mySettings} Int
sid ByteString
method ByteString
path = do
conc <- TVar EvenStreamTable -> IO Int
getEvenConcurrency TVar EvenStreamTable
evenStreamTable
checkMyConcurrency sid mySettings (conc + 1)
txws <- initialWindowSize <$> readIORef peerSettings
let rxws = Settings -> Int
initialWindowSize Settings
mySettings
newstrm <- newEvenStream sid txws rxws
insertEvenCache evenStreamTable method path newstrm
checkMyConcurrency
:: StreamId -> Settings -> Int -> IO ()
checkMyConcurrency :: Int -> Settings -> Int -> IO ()
checkMyConcurrency Int
sid Settings
settings Int
conc = do
let mMaxConc :: Maybe Int
mMaxConc = Settings -> Maybe Int
maxConcurrentStreams Settings
settings
case Maybe Int
mMaxConc of
Maybe Int
Nothing -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just Int
maxConc ->
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
conc Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
maxConc) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
HTTP2Error -> IO ()
forall e a. (HasCallStack, Exception e) => e -> IO a
E.throwIO (HTTP2Error -> IO ()) -> HTTP2Error -> IO ()
forall a b. (a -> b) -> a -> b
$
ErrorCode -> Int -> ReasonPhrase -> HTTP2Error
StreamErrorIsSent ErrorCode
RefusedStream Int
sid ReasonPhrase
"exceeds max concurrent"
openOddStreamWait :: Context -> IO (StreamId, Stream)
openOddStreamWait :: Context -> IO (Int, Stream)
openOddStreamWait ctx :: Context
ctx@Context{TVar OddStreamTable
oddStreamTable :: Context -> TVar OddStreamTable
oddStreamTable :: TVar OddStreamTable
oddStreamTable, Settings
mySettings :: Context -> Settings
mySettings :: Settings
mySettings, IORef Settings
peerSettings :: Context -> IORef Settings
peerSettings :: IORef Settings
peerSettings} = do
mMaxConc <- Settings -> Maybe Int
maxConcurrentStreams (Settings -> Maybe Int) -> IO Settings -> IO (Maybe Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IORef Settings -> IO Settings
forall a. IORef a -> IO a
readIORef IORef Settings
peerSettings
let rxws = Settings -> Int
initialWindowSize Settings
mySettings
case mMaxConc of
Maybe Int
Nothing -> do
sid <- STM Int -> IO Int
forall a. STM a -> IO a
atomically (STM Int -> IO Int) -> STM Int -> IO Int
forall a b. (a -> b) -> a -> b
$ Context -> STM Int
getMyNewStreamId Context
ctx
txws <- initialWindowSize <$> readIORef peerSettings
newstrm <- newOddStream sid txws rxws
insertOdd oddStreamTable sid newstrm
return (sid, newstrm)
Just Int
maxConc -> do
sid <- STM Int -> IO Int
forall a. STM a -> IO a
atomically (STM Int -> IO Int) -> STM Int -> IO Int
forall a b. (a -> b) -> a -> b
$ do
TVar OddStreamTable -> Int -> STM ()
waitIncOdd TVar OddStreamTable
oddStreamTable Int
maxConc
Context -> STM Int
getMyNewStreamId Context
ctx
txws <- initialWindowSize <$> readIORef peerSettings
newstrm <- newOddStream sid txws rxws
insertOdd' oddStreamTable sid newstrm
return (sid, newstrm)
openEvenStreamWait :: Context -> IO (StreamId, Stream)
openEvenStreamWait :: Context -> IO (Int, Stream)
openEvenStreamWait ctx :: Context
ctx@Context{TVar Int
TVar TxFlow
TVar EvenStreamTable
TVar OddStreamTable
IORef Bool
IORef Int
IORef (Maybe Int)
IORef RxFlow
IORef Settings
DynamicTable
Rate
Settings
TQueue Control
TQueue Output
SockAddr
ThreadManager
RoleInfo
Role
role :: Context -> Role
roleInfo :: Context -> RoleInfo
mySettings :: Context -> Settings
myFirstSettings :: Context -> IORef Bool
peerSettings :: Context -> IORef Settings
oddStreamTable :: Context -> TVar OddStreamTable
evenStreamTable :: Context -> TVar EvenStreamTable
continued :: Context -> IORef (Maybe Int)
myStreamId :: Context -> TVar Int
peerStreamId :: Context -> IORef Int
outputBufferLimit :: Context -> IORef Int
outputQ :: Context -> TQueue Output
outputQStreamID :: Context -> TVar Int
controlQ :: Context -> TQueue Control
encodeDynamicTable :: Context -> DynamicTable
decodeDynamicTable :: Context -> DynamicTable
txFlow :: Context -> TVar TxFlow
rxFlow :: Context -> IORef RxFlow
pingRate :: Context -> Rate
settingsRate :: Context -> Rate
emptyFrameRate :: Context -> Rate
rstRate :: Context -> Rate
mySockAddr :: Context -> SockAddr
peerSockAddr :: Context -> SockAddr
threadManager :: Context -> ThreadManager
role :: Role
roleInfo :: RoleInfo
mySettings :: Settings
myFirstSettings :: IORef Bool
peerSettings :: IORef Settings
oddStreamTable :: TVar OddStreamTable
evenStreamTable :: TVar EvenStreamTable
continued :: IORef (Maybe Int)
myStreamId :: TVar Int
peerStreamId :: IORef Int
outputBufferLimit :: IORef Int
outputQ :: TQueue Output
outputQStreamID :: TVar Int
controlQ :: TQueue Control
encodeDynamicTable :: DynamicTable
decodeDynamicTable :: DynamicTable
txFlow :: TVar TxFlow
rxFlow :: IORef RxFlow
pingRate :: Rate
settingsRate :: Rate
emptyFrameRate :: Rate
rstRate :: Rate
mySockAddr :: SockAddr
peerSockAddr :: SockAddr
threadManager :: ThreadManager
..} = do
mMaxConc <- Settings -> Maybe Int
maxConcurrentStreams (Settings -> Maybe Int) -> IO Settings -> IO (Maybe Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IORef Settings -> IO Settings
forall a. IORef a -> IO a
readIORef IORef Settings
peerSettings
let rxws = Settings -> Int
initialWindowSize Settings
mySettings
case mMaxConc of
Maybe Int
Nothing -> do
sid <- STM Int -> IO Int
forall a. STM a -> IO a
atomically (STM Int -> IO Int) -> STM Int -> IO Int
forall a b. (a -> b) -> a -> b
$ Context -> STM Int
getMyNewStreamId Context
ctx
txws <- initialWindowSize <$> readIORef peerSettings
newstrm <- newEvenStream sid txws rxws
insertEven evenStreamTable sid newstrm
return (sid, newstrm)
Just Int
maxConc -> do
sid <- STM Int -> IO Int
forall a. STM a -> IO a
atomically (STM Int -> IO Int) -> STM Int -> IO Int
forall a b. (a -> b) -> a -> b
$ do
TVar EvenStreamTable -> Int -> STM ()
waitIncEven TVar EvenStreamTable
evenStreamTable Int
maxConc
Context -> STM Int
getMyNewStreamId Context
ctx
txws <- initialWindowSize <$> readIORef peerSettings
newstrm <- newEvenStream sid txws rxws
insertEven' evenStreamTable sid newstrm
return (sid, newstrm)