{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}

module Network.HTTP2.H2.Context where

import Data.IORef
import Network.Control
import Network.Socket (SockAddr)
import UnliftIO.Exception
import qualified UnliftIO.Exception as E
import UnliftIO.STM

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

data ServerInfo = ServerInfo
    { ServerInfo -> TQueue (Input Stream)
inputQ :: TQueue (Input Stream)
    }

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 :: IO RoleInfo
newServerInfo :: IO RoleInfo
newServerInfo = ServerInfo -> RoleInfo
RIS (ServerInfo -> RoleInfo)
-> (TQueue (Input Stream) -> ServerInfo)
-> TQueue (Input Stream)
-> RoleInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TQueue (Input Stream) -> ServerInfo
ServerInfo (TQueue (Input Stream) -> RoleInfo)
-> IO (TQueue (Input Stream)) -> IO RoleInfo
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO (TQueue (Input Stream))
forall (m :: * -> *) a. MonadIO m => m (TQueue a)
newTQueueIO

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

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

-- | The context for HTTP/2 connection.
data Context = Context
    { Context -> Role
role :: Role
    , Context -> RoleInfo
roleInfo :: RoleInfo
    , -- Settings
      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)
    -- ^ RFC 9113 says "Other frames (from any stream) MUST NOT
    --   occur between the HEADERS frame and any CONTINUATION
    --   frames that might follow". This field is used to implement
    --   this requirement.
    , Context -> TVar Int
myStreamId :: TVar StreamId
    , Context -> IORef Int
peerStreamId :: IORef StreamId
    , Context -> IORef Int
outputBufferLimit :: IORef Int
    , Context -> TQueue (Output Stream)
outputQ :: TQueue (Output Stream)
    , Context -> TVar Int
outputQStreamID :: TVar StreamId
    , Context -> TQueue Control
controlQ :: TQueue Control
    , Context -> DynamicTable
encodeDynamicTable :: DynamicTable
    , Context -> DynamicTable
decodeDynamicTable :: DynamicTable
    , -- the connection window for sending data
      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
    }

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

newContext
    :: RoleInfo
    -> Config
    -> Int
    -> Int
    -> Settings
    -> IO Context
newContext :: RoleInfo -> Config -> Int -> Int -> Settings -> IO Context
newContext RoleInfo
rinfo Config{Int
Buffer
Manager
SockAddr
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
confWriteBuffer :: Config -> Buffer
confBufferSize :: Config -> Int
confSendAll :: Config -> ByteString -> IO ()
confReadN :: Config -> Int -> IO ByteString
confPositionReadMaker :: Config -> PositionReadMaker
confTimeoutManager :: Config -> Manager
confMySockAddr :: Config -> SockAddr
confPeerSockAddr :: Config -> SockAddr
..} Int
cacheSiz Int
connRxWS Settings
settings =
    -- My: Use this even if ack has not been received yet.
    Role
-> RoleInfo
-> Settings
-> IORef Bool
-> IORef Settings
-> TVar OddStreamTable
-> TVar EvenStreamTable
-> IORef (Maybe Int)
-> TVar Int
-> IORef Int
-> IORef Int
-> TQueue (Output Stream)
-> TVar Int
-> TQueue Control
-> DynamicTable
-> DynamicTable
-> TVar TxFlow
-> IORef RxFlow
-> Rate
-> Rate
-> Rate
-> Rate
-> SockAddr
-> SockAddr
-> Context
Context Role
rl RoleInfo
rinfo Settings
settings
        (IORef Bool
 -> IORef Settings
 -> TVar OddStreamTable
 -> TVar EvenStreamTable
 -> IORef (Maybe Int)
 -> TVar Int
 -> IORef Int
 -> IORef Int
 -> TQueue (Output Stream)
 -> TVar Int
 -> TQueue Control
 -> DynamicTable
 -> DynamicTable
 -> TVar TxFlow
 -> IORef RxFlow
 -> Rate
 -> Rate
 -> Rate
 -> Rate
 -> SockAddr
 -> SockAddr
 -> Context)
-> IO (IORef Bool)
-> IO
     (IORef Settings
      -> TVar OddStreamTable
      -> TVar EvenStreamTable
      -> IORef (Maybe Int)
      -> TVar Int
      -> IORef Int
      -> IORef Int
      -> TQueue (Output Stream)
      -> TVar Int
      -> TQueue Control
      -> DynamicTable
      -> DynamicTable
      -> TVar TxFlow
      -> IORef RxFlow
      -> Rate
      -> Rate
      -> Rate
      -> Rate
      -> SockAddr
      -> SockAddr
      -> Context)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool -> IO (IORef Bool)
forall a. a -> IO (IORef a)
newIORef Bool
False
        -- Peer: The spec defines max concurrency is infinite unless
        -- SETTINGS_MAX_CONCURRENT_STREAMS is exchanged.
        -- But it is vulnerable, so we set the limitations.
        IO
  (IORef Settings
   -> TVar OddStreamTable
   -> TVar EvenStreamTable
   -> IORef (Maybe Int)
   -> TVar Int
   -> IORef Int
   -> IORef Int
   -> TQueue (Output Stream)
   -> TVar Int
   -> TQueue Control
   -> DynamicTable
   -> DynamicTable
   -> TVar TxFlow
   -> IORef RxFlow
   -> Rate
   -> Rate
   -> Rate
   -> Rate
   -> SockAddr
   -> SockAddr
   -> Context)
-> IO (IORef Settings)
-> IO
     (TVar OddStreamTable
      -> TVar EvenStreamTable
      -> IORef (Maybe Int)
      -> TVar Int
      -> IORef Int
      -> IORef Int
      -> TQueue (Output Stream)
      -> TVar Int
      -> TQueue Control
      -> DynamicTable
      -> DynamicTable
      -> TVar TxFlow
      -> IORef RxFlow
      -> Rate
      -> Rate
      -> Rate
      -> Rate
      -> SockAddr
      -> SockAddr
      -> Context)
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Settings -> IO (IORef Settings)
forall a. a -> IO (IORef a)
newIORef Settings
settings
        IO
  (TVar OddStreamTable
   -> TVar EvenStreamTable
   -> IORef (Maybe Int)
   -> TVar Int
   -> IORef Int
   -> IORef Int
   -> TQueue (Output Stream)
   -> TVar Int
   -> TQueue Control
   -> DynamicTable
   -> DynamicTable
   -> TVar TxFlow
   -> IORef RxFlow
   -> Rate
   -> Rate
   -> Rate
   -> Rate
   -> SockAddr
   -> SockAddr
   -> Context)
-> IO (TVar OddStreamTable)
-> IO
     (TVar EvenStreamTable
      -> IORef (Maybe Int)
      -> TVar Int
      -> IORef Int
      -> IORef Int
      -> TQueue (Output Stream)
      -> TVar Int
      -> TQueue Control
      -> DynamicTable
      -> DynamicTable
      -> TVar TxFlow
      -> IORef RxFlow
      -> Rate
      -> Rate
      -> Rate
      -> Rate
      -> SockAddr
      -> SockAddr
      -> Context)
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> OddStreamTable -> IO (TVar OddStreamTable)
forall (m :: * -> *) a. MonadIO m => a -> m (TVar a)
newTVarIO OddStreamTable
emptyOddStreamTable
        IO
  (TVar EvenStreamTable
   -> IORef (Maybe Int)
   -> TVar Int
   -> IORef Int
   -> IORef Int
   -> TQueue (Output Stream)
   -> TVar Int
   -> TQueue Control
   -> DynamicTable
   -> DynamicTable
   -> TVar TxFlow
   -> IORef RxFlow
   -> Rate
   -> Rate
   -> Rate
   -> Rate
   -> SockAddr
   -> SockAddr
   -> Context)
-> IO (TVar EvenStreamTable)
-> IO
     (IORef (Maybe Int)
      -> TVar Int
      -> IORef Int
      -> IORef Int
      -> TQueue (Output Stream)
      -> TVar Int
      -> TQueue Control
      -> DynamicTable
      -> DynamicTable
      -> TVar TxFlow
      -> IORef RxFlow
      -> Rate
      -> Rate
      -> Rate
      -> Rate
      -> SockAddr
      -> SockAddr
      -> Context)
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> EvenStreamTable -> IO (TVar EvenStreamTable)
forall (m :: * -> *) a. MonadIO m => a -> m (TVar a)
newTVarIO (Int -> EvenStreamTable
emptyEvenStreamTable Int
cacheSiz)
        IO
  (IORef (Maybe Int)
   -> TVar Int
   -> IORef Int
   -> IORef Int
   -> TQueue (Output Stream)
   -> TVar Int
   -> TQueue Control
   -> DynamicTable
   -> DynamicTable
   -> TVar TxFlow
   -> IORef RxFlow
   -> Rate
   -> Rate
   -> Rate
   -> Rate
   -> SockAddr
   -> SockAddr
   -> Context)
-> IO (IORef (Maybe Int))
-> IO
     (TVar Int
      -> IORef Int
      -> IORef Int
      -> TQueue (Output Stream)
      -> TVar Int
      -> TQueue Control
      -> DynamicTable
      -> DynamicTable
      -> TVar TxFlow
      -> IORef RxFlow
      -> Rate
      -> Rate
      -> Rate
      -> Rate
      -> SockAddr
      -> SockAddr
      -> Context)
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe Int -> IO (IORef (Maybe Int))
forall a. a -> IO (IORef a)
newIORef Maybe Int
forall a. Maybe a
Nothing
        IO
  (TVar Int
   -> IORef Int
   -> IORef Int
   -> TQueue (Output Stream)
   -> TVar Int
   -> TQueue Control
   -> DynamicTable
   -> DynamicTable
   -> TVar TxFlow
   -> IORef RxFlow
   -> Rate
   -> Rate
   -> Rate
   -> Rate
   -> SockAddr
   -> SockAddr
   -> Context)
-> IO (TVar Int)
-> IO
     (IORef Int
      -> IORef Int
      -> TQueue (Output Stream)
      -> TVar Int
      -> TQueue Control
      -> DynamicTable
      -> DynamicTable
      -> TVar TxFlow
      -> IORef RxFlow
      -> Rate
      -> Rate
      -> Rate
      -> Rate
      -> SockAddr
      -> SockAddr
      -> Context)
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> IO (TVar Int)
forall (m :: * -> *) a. MonadIO m => a -> m (TVar a)
newTVarIO Int
sid0
        IO
  (IORef Int
   -> IORef Int
   -> TQueue (Output Stream)
   -> TVar Int
   -> TQueue Control
   -> DynamicTable
   -> DynamicTable
   -> TVar TxFlow
   -> IORef RxFlow
   -> Rate
   -> Rate
   -> Rate
   -> Rate
   -> SockAddr
   -> SockAddr
   -> Context)
-> IO (IORef Int)
-> IO
     (IORef Int
      -> TQueue (Output Stream)
      -> TVar Int
      -> TQueue Control
      -> DynamicTable
      -> DynamicTable
      -> TVar TxFlow
      -> IORef RxFlow
      -> Rate
      -> Rate
      -> Rate
      -> Rate
      -> SockAddr
      -> SockAddr
      -> Context)
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> IO (IORef Int)
forall a. a -> IO (IORef a)
newIORef Int
0
        IO
  (IORef Int
   -> TQueue (Output Stream)
   -> TVar Int
   -> TQueue Control
   -> DynamicTable
   -> DynamicTable
   -> TVar TxFlow
   -> IORef RxFlow
   -> Rate
   -> Rate
   -> Rate
   -> Rate
   -> SockAddr
   -> SockAddr
   -> Context)
-> IO (IORef Int)
-> IO
     (TQueue (Output Stream)
      -> TVar Int
      -> TQueue Control
      -> DynamicTable
      -> DynamicTable
      -> TVar TxFlow
      -> IORef RxFlow
      -> Rate
      -> Rate
      -> Rate
      -> Rate
      -> SockAddr
      -> SockAddr
      -> Context)
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> IO (IORef Int)
forall a. a -> IO (IORef a)
newIORef Int
buflim
        IO
  (TQueue (Output Stream)
   -> TVar Int
   -> TQueue Control
   -> DynamicTable
   -> DynamicTable
   -> TVar TxFlow
   -> IORef RxFlow
   -> Rate
   -> Rate
   -> Rate
   -> Rate
   -> SockAddr
   -> SockAddr
   -> Context)
-> IO (TQueue (Output Stream))
-> IO
     (TVar Int
      -> TQueue Control
      -> DynamicTable
      -> DynamicTable
      -> TVar TxFlow
      -> IORef RxFlow
      -> Rate
      -> Rate
      -> Rate
      -> Rate
      -> SockAddr
      -> SockAddr
      -> Context)
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> IO (TQueue (Output Stream))
forall (m :: * -> *) a. MonadIO m => m (TQueue a)
newTQueueIO
        IO
  (TVar Int
   -> TQueue Control
   -> DynamicTable
   -> DynamicTable
   -> TVar TxFlow
   -> IORef RxFlow
   -> Rate
   -> Rate
   -> Rate
   -> Rate
   -> SockAddr
   -> SockAddr
   -> Context)
-> IO (TVar Int)
-> IO
     (TQueue Control
      -> DynamicTable
      -> DynamicTable
      -> TVar TxFlow
      -> IORef RxFlow
      -> Rate
      -> Rate
      -> Rate
      -> Rate
      -> SockAddr
      -> SockAddr
      -> Context)
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> IO (TVar Int)
forall (m :: * -> *) a. MonadIO m => a -> m (TVar a)
newTVarIO Int
sid0
        IO
  (TQueue Control
   -> DynamicTable
   -> DynamicTable
   -> TVar TxFlow
   -> IORef RxFlow
   -> Rate
   -> Rate
   -> Rate
   -> Rate
   -> SockAddr
   -> SockAddr
   -> Context)
-> IO (TQueue Control)
-> IO
     (DynamicTable
      -> DynamicTable
      -> TVar TxFlow
      -> IORef RxFlow
      -> Rate
      -> Rate
      -> Rate
      -> Rate
      -> SockAddr
      -> SockAddr
      -> Context)
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> IO (TQueue Control)
forall (m :: * -> *) a. MonadIO m => m (TQueue a)
newTQueueIO
        -- My SETTINGS_HEADER_TABLE_SIZE
        IO
  (DynamicTable
   -> DynamicTable
   -> TVar TxFlow
   -> IORef RxFlow
   -> Rate
   -> Rate
   -> Rate
   -> Rate
   -> SockAddr
   -> SockAddr
   -> Context)
-> IO DynamicTable
-> IO
     (DynamicTable
      -> TVar TxFlow
      -> IORef RxFlow
      -> Rate
      -> Rate
      -> Rate
      -> Rate
      -> SockAddr
      -> SockAddr
      -> Context)
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> IO DynamicTable
newDynamicTableForEncoding Int
defaultDynamicTableSize
        IO
  (DynamicTable
   -> TVar TxFlow
   -> IORef RxFlow
   -> Rate
   -> Rate
   -> Rate
   -> Rate
   -> SockAddr
   -> SockAddr
   -> Context)
-> IO DynamicTable
-> IO
     (TVar TxFlow
      -> IORef RxFlow
      -> Rate
      -> Rate
      -> Rate
      -> Rate
      -> SockAddr
      -> SockAddr
      -> Context)
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> Int -> IO DynamicTable
newDynamicTableForDecoding (Settings -> Int
headerTableSize Settings
settings) Int
4096
        IO
  (TVar TxFlow
   -> IORef RxFlow
   -> Rate
   -> Rate
   -> Rate
   -> Rate
   -> SockAddr
   -> SockAddr
   -> Context)
-> IO (TVar TxFlow)
-> IO
     (IORef RxFlow
      -> Rate -> Rate -> Rate -> Rate -> SockAddr -> SockAddr -> Context)
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> TxFlow -> IO (TVar TxFlow)
forall (m :: * -> *) a. MonadIO m => a -> m (TVar a)
newTVarIO (Int -> TxFlow
newTxFlow Int
defaultWindowSize) -- 64K
        IO
  (IORef RxFlow
   -> Rate -> Rate -> Rate -> Rate -> SockAddr -> SockAddr -> Context)
-> IO (IORef RxFlow)
-> IO
     (Rate -> Rate -> Rate -> Rate -> SockAddr -> SockAddr -> Context)
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RxFlow -> IO (IORef RxFlow)
forall a. a -> IO (IORef a)
newIORef (Int -> RxFlow
newRxFlow Int
connRxWS)
        IO
  (Rate -> Rate -> Rate -> Rate -> SockAddr -> SockAddr -> Context)
-> IO Rate
-> IO (Rate -> Rate -> Rate -> SockAddr -> SockAddr -> Context)
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> IO Rate
newRate
        IO (Rate -> Rate -> Rate -> SockAddr -> SockAddr -> Context)
-> IO Rate -> IO (Rate -> Rate -> SockAddr -> SockAddr -> Context)
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> IO Rate
newRate
        IO (Rate -> Rate -> SockAddr -> SockAddr -> Context)
-> IO Rate -> IO (Rate -> SockAddr -> SockAddr -> Context)
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> IO Rate
newRate
        IO (Rate -> SockAddr -> SockAddr -> Context)
-> IO Rate -> IO (SockAddr -> SockAddr -> Context)
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> IO Rate
newRate
        IO (SockAddr -> SockAddr -> Context)
-> IO SockAddr -> IO (SockAddr -> Context)
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SockAddr -> IO SockAddr
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return SockAddr
confMySockAddr
        IO (SockAddr -> Context) -> IO SockAddr -> IO Context
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SockAddr -> IO SockAddr
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return SockAddr
confPeerSockAddr
  where
    rl :: Role
rl = case RoleInfo
rinfo of
        RIC{} -> Role
Client
        RoleInfo
_ -> Role
Server
    sid0 :: Int
sid0
        | Role
rl 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

makeMySettingsList :: Config -> Int -> WindowSize -> [(SettingsKey, Int)]
makeMySettingsList :: Config -> Int -> Int -> [(SettingsKey, Int)]
makeMySettingsList Config{Int
Buffer
Manager
SockAddr
Int -> IO ByteString
PositionReadMaker
ByteString -> IO ()
confWriteBuffer :: Config -> Buffer
confBufferSize :: Config -> Int
confSendAll :: Config -> ByteString -> IO ()
confReadN :: Config -> Int -> IO ByteString
confPositionReadMaker :: Config -> PositionReadMaker
confTimeoutManager :: Config -> Manager
confMySockAddr :: Config -> SockAddr
confPeerSockAddr :: Config -> SockAddr
confWriteBuffer :: Buffer
confBufferSize :: Int
confSendAll :: ByteString -> IO ()
confReadN :: Int -> IO ByteString
confPositionReadMaker :: PositionReadMaker
confTimeoutManager :: Manager
confMySockAddr :: SockAddr
confPeerSockAddr :: SockAddr
..} Int
maxConc Int
winSiz = [(SettingsKey, Int)]
myInitialAlist
  where
    -- confBufferSize is the size of the write buffer.
    -- But we assume that the size of the read buffer is the same size.
    -- So, the size is announced to via SETTINGS_MAX_FRAME_SIZE.
    len :: Int
len = Int
confBufferSize Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
frameHeaderLength
    payloadLen :: Int
payloadLen = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
defaultPayloadLength Int
len
    myInitialAlist :: [(SettingsKey, Int)]
myInitialAlist =
        [ (SettingsKey
SettingsMaxFrameSize, Int
payloadLen)
        , (SettingsKey
SettingsMaxConcurrentStreams, Int
maxConc)
        , (SettingsKey
SettingsInitialWindowSize, Int
winSiz)
        ]

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

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
SockAddr
Rate
TQueue Control
TQueue (Output Stream)
DynamicTable
Settings
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 Stream)
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
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 Stream)
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
..} = do
    Int
n <- TVar Int -> STM Int
forall a. TVar a -> STM a
readTVar TVar Int
myStreamId
    let n' :: Int
n' = Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2
    TVar Int -> Int -> STM ()
forall a. TVar a -> a -> STM ()
writeTVar TVar Int
myStreamId Int
n'
    Int -> STM Int
forall a. a -> STM a
forall (m :: * -> *) a. Monad m => a -> m a
return Int
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
    StreamState
oldState <- IORef StreamState -> IO StreamState
forall a. IORef a -> IO a
readIORef IORef StreamState
streamState
    case (StreamState
oldState, StreamState
newState) of
        (Open Maybe ClosedCode
_ (Body TQueue (Either SomeException ByteString)
q Maybe Int
_ IORef Int
_ IORef (Maybe TokenHeaderTable)
_), Open Maybe ClosedCode
_ (Body TQueue (Either SomeException ByteString)
q' Maybe Int
_ IORef Int
_ IORef (Maybe TokenHeaderTable)
_))
            | TQueue (Either SomeException ByteString)
q TQueue (Either SomeException ByteString)
-> TQueue (Either SomeException ByteString) -> Bool
forall a. Eq a => a -> a -> Bool
== TQueue (Either SomeException ByteString)
q' ->
                -- The stream stays open with the same body; nothing to do
                () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        (Open Maybe ClosedCode
_ (Body TQueue (Either SomeException ByteString)
q Maybe Int
_ IORef Int
_ IORef (Maybe TokenHeaderTable)
_), StreamState
_) ->
            -- The stream is either closed, or is open with a /new/ body
            -- We need to close the old queue so that any reads from it won't block
            STM () -> IO ()
forall (m :: * -> *) a. MonadIO m => STM a -> m a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ TQueue (Either SomeException ByteString)
-> Either SomeException ByteString -> STM ()
forall a. TQueue a -> a -> STM ()
writeTQueue TQueue (Either SomeException ByteString)
q (Either SomeException ByteString -> STM ())
-> Either SomeException ByteString -> STM ()
forall a b. (a -> b) -> a -> b
$ SomeException -> Either SomeException ByteString
forall a b. a -> Either a b
Left (SomeException -> Either SomeException ByteString)
-> SomeException -> Either SomeException ByteString
forall a b. (a -> b) -> a -> b
$ HTTP2Error -> SomeException
forall e. Exception e => e -> SomeException
toException HTTP2Error
ConnectionIsClosed
        (StreamState, StreamState)
_otherwise ->
            -- The stream wasn't open to start with; nothing to do
            () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    IORef StreamState -> StreamState -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef StreamState
streamState 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
    Maybe ClosedCode
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
    (ClosedCode -> IO ()) -> Maybe ClosedCode -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (Context -> Stream -> ClosedCode -> IO ()
closed Context
ctx Stream
stream) Maybe ClosedCode
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
    Bool
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
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
shouldFinalize (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
        Context -> Stream -> ClosedCode -> IO ()
closed Context
ctx Stream
stream ClosedCode
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) -- anyway
  where
    err :: SomeException
    err :: SomeException
err = HTTP2Error -> SomeException
forall e. Exception e => e -> SomeException
toException (Int -> ClosedCode -> HTTP2Error
closedCodeToError Int
streamNumber ClosedCode
cc)

----------------------------------------------------------------
-- From peer

-- Server
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
    -- My SETTINGS_MAX_CONCURRENT_STREAMS
    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
        Int
conc <- TVar OddStreamTable -> IO Int
getOddConcurrency TVar OddStreamTable
oddStreamTable
        Int -> Settings -> Int -> IO ()
checkMyConcurrency Int
sid Settings
mySettings (Int
conc Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
    Int
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 :: Int
rxws = Settings -> Int
initialWindowSize Settings
mySettings
    Stream
newstrm <- Int -> Int -> Int -> IO Stream
newOddStream Int
sid Int
txws Int
rxws
    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 Bool -> Bool -> Bool
|| FrameType
ftyp FrameType -> FrameType -> Bool
forall a. Eq a => a -> a -> Bool
== FrameType
FramePushPromise) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Context -> Stream -> IO ()
opened Context
ctx Stream
newstrm
    TVar OddStreamTable -> Int -> Stream -> IO ()
insertOdd TVar OddStreamTable
oddStreamTable Int
sid Stream
newstrm
    Stream -> IO Stream
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Stream
newstrm

-- Client
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
    -- My SETTINGS_MAX_CONCURRENT_STREAMS
    Int
conc <- TVar EvenStreamTable -> IO Int
getEvenConcurrency TVar EvenStreamTable
evenStreamTable
    Int -> Settings -> Int -> IO ()
checkMyConcurrency Int
sid Settings
mySettings (Int
conc Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
    Int
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 :: Int
rxws = Settings -> Int
initialWindowSize Settings
mySettings
    Stream
newstrm <- Int -> Int -> Int -> IO Stream
newEvenStream Int
sid Int
txws Int
rxws
    TVar EvenStreamTable -> ByteString -> ByteString -> Stream -> IO ()
insertEvenCache TVar EvenStreamTable
evenStreamTable ByteString
method ByteString
path Stream
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 (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m 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"

----------------------------------------------------------------
-- From me

-- Clinet
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
    -- Peer SETTINGS_MAX_CONCURRENT_STREAMS
    Maybe Int
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 :: Int
rxws = Settings -> Int
initialWindowSize Settings
mySettings
    case Maybe Int
mMaxConc of
        Maybe Int
Nothing -> do
            Int
sid <- STM Int -> IO Int
forall (m :: * -> *) a. MonadIO m => STM a -> m a
atomically (STM Int -> IO Int) -> STM Int -> IO Int
forall a b. (a -> b) -> a -> b
$ Context -> STM Int
getMyNewStreamId Context
ctx
            Int
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
            Stream
newstrm <- Int -> Int -> Int -> IO Stream
newOddStream Int
sid Int
txws Int
rxws
            TVar OddStreamTable -> Int -> Stream -> IO ()
insertOdd TVar OddStreamTable
oddStreamTable Int
sid Stream
newstrm
            (Int, Stream) -> IO (Int, Stream)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
sid, Stream
newstrm)
        Just Int
maxConc -> do
            Int
sid <- STM Int -> IO Int
forall (m :: * -> *) a. MonadIO m => STM a -> m 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
            Int
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
            Stream
newstrm <- Int -> Int -> Int -> IO Stream
newOddStream Int
sid Int
txws Int
rxws
            TVar OddStreamTable -> Int -> Stream -> IO ()
insertOdd' TVar OddStreamTable
oddStreamTable Int
sid Stream
newstrm
            (Int, Stream) -> IO (Int, Stream)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
sid, Stream
newstrm)

-- Server
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
SockAddr
Rate
TQueue Control
TQueue (Output Stream)
DynamicTable
Settings
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 Stream)
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
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 Stream)
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
..} = do
    -- Peer SETTINGS_MAX_CONCURRENT_STREAMS
    Maybe Int
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 :: Int
rxws = Settings -> Int
initialWindowSize Settings
mySettings
    case Maybe Int
mMaxConc of
        Maybe Int
Nothing -> do
            Int
sid <- STM Int -> IO Int
forall (m :: * -> *) a. MonadIO m => STM a -> m a
atomically (STM Int -> IO Int) -> STM Int -> IO Int
forall a b. (a -> b) -> a -> b
$ Context -> STM Int
getMyNewStreamId Context
ctx
            Int
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
            Stream
newstrm <- Int -> Int -> Int -> IO Stream
newEvenStream Int
sid Int
txws Int
rxws
            TVar EvenStreamTable -> Int -> Stream -> IO ()
insertEven TVar EvenStreamTable
evenStreamTable Int
sid Stream
newstrm
            (Int, Stream) -> IO (Int, Stream)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
sid, Stream
newstrm)
        Just Int
maxConc -> do
            Int
sid <- STM Int -> IO Int
forall (m :: * -> *) a. MonadIO m => STM a -> m 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
            Int
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
            Stream
newstrm <- Int -> Int -> Int -> IO Stream
newEvenStream Int
sid Int
txws Int
rxws
            TVar EvenStreamTable -> Int -> Stream -> IO ()
insertEven' TVar EvenStreamTable
evenStreamTable Int
sid Stream
newstrm
            (Int, Stream) -> IO (Int, Stream)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
sid, Stream
newstrm)