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

module Network.HTTP2.H2.Context where

import Control.Exception
import Data.IORef
import Network.Control
import Network.HTTP.Types (Method)
import Network.Socket (SockAddr)
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
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Role -> Role -> Bool
$c/= :: Role -> Role -> Bool
== :: Role -> Role -> Bool
$c== :: Role -> Role -> Bool
Eq, Int -> Role -> ShowS
[Role] -> ShowS
Role -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Role] -> ShowS
$cshowList :: [Role] -> ShowS
show :: Role -> String
$cshow :: Role -> String
showsPrec :: Int -> Role -> ShowS
$cshowsPrec :: Int -> 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 -> ByteString
authority :: ByteString
    }

toServerInfo :: RoleInfo -> ServerInfo
toServerInfo :: RoleInfo -> ServerInfo
toServerInfo (RIS ServerInfo
x) = ServerInfo
x
toServerInfo RoleInfo
_ = forall a. HasCallStack => String -> a
error String
"toServerInfo"

toClientInfo :: RoleInfo -> ClientInfo
toClientInfo :: RoleInfo -> ClientInfo
toClientInfo (RIC ClientInfo
x) = ClientInfo
x
toClientInfo RoleInfo
_ = forall a. HasCallStack => String -> a
error String
"toClientInfo"

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

newClientInfo :: ByteString -> ByteString -> RoleInfo
newClientInfo :: ByteString -> ByteString -> RoleInfo
newClientInfo ByteString
scm ByteString
auth = ClientInfo -> RoleInfo
RIC forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString -> ClientInfo
ClientInfo ByteString
scm ByteString
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 ()
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
confPeerSockAddr :: SockAddr
confMySockAddr :: SockAddr
confTimeoutManager :: Manager
confPositionReadMaker :: PositionReadMaker
confReadN :: Int -> IO ByteString
confSendAll :: ByteString -> IO ()
confBufferSize :: Int
confWriteBuffer :: Buffer
..} 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
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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.
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. a -> IO (IORef a)
newIORef Settings
settings
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) a. MonadIO m => a -> m (TVar a)
newTVarIO OddStreamTable
emptyOddStreamTable
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) a. MonadIO m => a -> m (TVar a)
newTVarIO (Int -> EvenStreamTable
emptyEvenStreamTable Int
cacheSiz)
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. a -> IO (IORef a)
newIORef forall a. Maybe a
Nothing
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) a. MonadIO m => a -> m (TVar a)
newTVarIO Int
sid0
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. a -> IO (IORef a)
newIORef Int
0
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. a -> IO (IORef a)
newIORef Int
buflim
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) a. MonadIO m => m (TQueue a)
newTQueueIO
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) a. MonadIO m => a -> m (TVar a)
newTVarIO Int
sid0
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) a. MonadIO m => m (TQueue a)
newTQueueIO
        -- My SETTINGS_HEADER_TABLE_SIZE
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> IO DynamicTable
newDynamicTableForEncoding Int
defaultDynamicTableSize
        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
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) a. MonadIO m => a -> m (TVar a)
newTVarIO (Int -> TxFlow
newTxFlow Int
defaultWindowSize) -- 64K
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. a -> IO (IORef a)
newIORef (Int -> RxFlow
newRxFlow Int
connRxWS)
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> IO Rate
newRate
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> IO Rate
newRate
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> IO Rate
newRate
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> IO Rate
newRate
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) a. Monad m => a -> m a
return SockAddr
confMySockAddr
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> 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 forall a. Eq a => a -> a -> Bool
== Role
Client = Int
1
        | Bool
otherwise = Int
2
    dlim :: Int
dlim = Int
defaultPayloadLength forall a. Num a => a -> a -> a
+ Int
frameHeaderLength
    buflim :: Int
buflim
        | Int
confBufferSize 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 ()
confPeerSockAddr :: SockAddr
confMySockAddr :: SockAddr
confTimeoutManager :: Manager
confPositionReadMaker :: PositionReadMaker
confReadN :: Int -> IO ByteString
confSendAll :: ByteString -> IO ()
confBufferSize :: Int
confWriteBuffer :: Buffer
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
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 forall a. Num a => a -> a -> a
- Int
frameHeaderLength
    payloadLen :: Int
payloadLen = 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 forall a. Eq a => a -> a -> Bool
== Role
Client

isServer :: Context -> Bool
isServer :: Context -> Bool
isServer Context
ctx = Context -> Role
role Context
ctx 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
peerSockAddr :: SockAddr
mySockAddr :: SockAddr
rstRate :: Rate
emptyFrameRate :: Rate
settingsRate :: Rate
pingRate :: Rate
rxFlow :: IORef RxFlow
txFlow :: TVar TxFlow
decodeDynamicTable :: DynamicTable
encodeDynamicTable :: DynamicTable
controlQ :: TQueue Control
outputQStreamID :: TVar Int
outputQ :: TQueue (Output Stream)
outputBufferLimit :: IORef Int
peerStreamId :: IORef Int
myStreamId :: TVar Int
continued :: IORef (Maybe Int)
evenStreamTable :: TVar EvenStreamTable
oddStreamTable :: TVar OddStreamTable
peerSettings :: IORef Settings
myFirstSettings :: IORef Bool
mySettings :: Settings
roleInfo :: RoleInfo
role :: Role
peerSockAddr :: Context -> SockAddr
mySockAddr :: Context -> SockAddr
rstRate :: Context -> Rate
emptyFrameRate :: Context -> Rate
settingsRate :: Context -> Rate
pingRate :: Context -> Rate
rxFlow :: Context -> IORef RxFlow
txFlow :: Context -> TVar TxFlow
decodeDynamicTable :: Context -> DynamicTable
encodeDynamicTable :: Context -> DynamicTable
controlQ :: Context -> TQueue Control
outputQStreamID :: Context -> TVar Int
outputQ :: Context -> TQueue (Output Stream)
outputBufferLimit :: Context -> IORef Int
peerStreamId :: Context -> IORef Int
myStreamId :: Context -> TVar Int
continued :: Context -> IORef (Maybe Int)
evenStreamTable :: Context -> TVar EvenStreamTable
oddStreamTable :: Context -> TVar OddStreamTable
peerSettings :: Context -> IORef Settings
myFirstSettings :: Context -> IORef Bool
mySettings :: Context -> Settings
roleInfo :: Context -> RoleInfo
role :: Context -> Role
..} = do
    Int
n <- forall a. TVar a -> STM a
readTVar TVar Int
myStreamId
    let n' :: Int
n' = Int
n forall a. Num a => a -> a -> a
+ Int
2
    forall a. TVar a -> a -> STM ()
writeTVar TVar Int
myStreamId Int
n'
    forall (m :: * -> *) a. Monad m => a -> m a
return Int
n

getPeerStreamID :: Context -> IO StreamId
getPeerStreamID :: Context -> IO Int
getPeerStreamID Context
ctx = forall a. IORef a -> IO a
readIORef 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 = 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 :: Stream -> IORef StreamState
streamState :: IORef StreamState
streamState} StreamState
val = forall a. IORef a -> a -> IO ()
writeIORef IORef StreamState
streamState StreamState
val

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 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 :: IORef StreamState
streamState :: Stream -> IORef StreamState
streamState} = do
    Maybe ClosedCode
closingCode <- forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef IORef StreamState
streamState StreamState -> (StreamState, Maybe ClosedCode)
closeHalf
    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, forall a. Maybe a
Nothing)
    closeHalf (Open (Just ClosedCode
cc) OpenState
_) = (ClosedCode -> StreamState
Closed ClosedCode
cc, forall a. a -> Maybe a
Just ClosedCode
cc)
    closeHalf StreamState
_ = (StreamState
HalfClosedRemote, 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 :: IORef StreamState
streamState :: Stream -> IORef StreamState
streamState} ClosedCode
cc = do
    Bool
shouldFinalize <- forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef IORef StreamState
streamState StreamState -> (StreamState, Bool)
closeHalf
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
shouldFinalize 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 (forall a. a -> Maybe a
Just ClosedCode
cc) OpenState
o, Bool
False)
    closeHalf StreamState
_ = (Maybe ClosedCode -> OpenState -> StreamState
Open (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 :: TVar OddStreamTable
oddStreamTable :: Context -> TVar OddStreamTable
oddStreamTable, TVar EvenStreamTable
evenStreamTable :: TVar EvenStreamTable
evenStreamTable :: Context -> TVar EvenStreamTable
evenStreamTable} strm :: Stream
strm@Stream{Int
streamNumber :: Stream -> Int
streamNumber :: 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 = 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 :: TVar OddStreamTable
oddStreamTable :: Context -> TVar OddStreamTable
oddStreamTable, IORef Settings
peerSettings :: IORef Settings
peerSettings :: Context -> IORef Settings
peerSettings, Settings
mySettings :: Settings
mySettings :: Context -> Settings
mySettings} Int
sid FrameType
ftyp = do
    -- My SETTINGS_MAX_CONCURRENT_STREAMS
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (FrameType
ftyp forall a. Eq a => a -> a -> Bool
== FrameType
FrameHeaders) 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 forall a. Num a => a -> a -> a
+ Int
1)
    Int
txws <- Settings -> Int
initialWindowSize forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (FrameType
ftyp forall a. Eq a => a -> a -> Bool
== FrameType
FrameHeaders Bool -> Bool -> Bool
|| FrameType
ftyp forall a. Eq a => a -> a -> Bool
== FrameType
FramePushPromise) 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
    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 :: TVar EvenStreamTable
evenStreamTable :: Context -> TVar EvenStreamTable
evenStreamTable, IORef Settings
peerSettings :: IORef Settings
peerSettings :: Context -> IORef Settings
peerSettings, Settings
mySettings :: Settings
mySettings :: Context -> 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 forall a. Num a => a -> a -> a
+ Int
1)
    Int
txws <- Settings -> Int
initialWindowSize forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
        Just Int
maxConc ->
            forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
conc forall a. Ord a => a -> a -> Bool
> Int
maxConc) forall a b. (a -> b) -> a -> b
$
                forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
E.throwIO 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 :: TVar OddStreamTable
oddStreamTable :: Context -> TVar OddStreamTable
oddStreamTable, Settings
mySettings :: Settings
mySettings :: Context -> Settings
mySettings, IORef Settings
peerSettings :: IORef Settings
peerSettings :: Context -> IORef Settings
peerSettings} = do
    -- Peer SETTINGS_MAX_CONCURRENT_STREAMS
    Maybe Int
mMaxConc <- Settings -> Maybe Int
maxConcurrentStreams forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 <- forall (m :: * -> *) a. MonadIO m => STM a -> m a
atomically forall a b. (a -> b) -> a -> b
$ Context -> STM Int
getMyNewStreamId Context
ctx
            Int
txws <- Settings -> Int
initialWindowSize forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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
            forall (m :: * -> *) a. Monad m => a -> m a
return (Int
sid, Stream
newstrm)
        Just Int
maxConc -> do
            Int
sid <- forall (m :: * -> *) a. MonadIO m => STM a -> m a
atomically 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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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
            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
peerSockAddr :: SockAddr
mySockAddr :: SockAddr
rstRate :: Rate
emptyFrameRate :: Rate
settingsRate :: Rate
pingRate :: Rate
rxFlow :: IORef RxFlow
txFlow :: TVar TxFlow
decodeDynamicTable :: DynamicTable
encodeDynamicTable :: DynamicTable
controlQ :: TQueue Control
outputQStreamID :: TVar Int
outputQ :: TQueue (Output Stream)
outputBufferLimit :: IORef Int
peerStreamId :: IORef Int
myStreamId :: TVar Int
continued :: IORef (Maybe Int)
evenStreamTable :: TVar EvenStreamTable
oddStreamTable :: TVar OddStreamTable
peerSettings :: IORef Settings
myFirstSettings :: IORef Bool
mySettings :: Settings
roleInfo :: RoleInfo
role :: Role
peerSockAddr :: Context -> SockAddr
mySockAddr :: Context -> SockAddr
rstRate :: Context -> Rate
emptyFrameRate :: Context -> Rate
settingsRate :: Context -> Rate
pingRate :: Context -> Rate
rxFlow :: Context -> IORef RxFlow
txFlow :: Context -> TVar TxFlow
decodeDynamicTable :: Context -> DynamicTable
encodeDynamicTable :: Context -> DynamicTable
controlQ :: Context -> TQueue Control
outputQStreamID :: Context -> TVar Int
outputQ :: Context -> TQueue (Output Stream)
outputBufferLimit :: Context -> IORef Int
peerStreamId :: Context -> IORef Int
myStreamId :: Context -> TVar Int
continued :: Context -> IORef (Maybe Int)
evenStreamTable :: Context -> TVar EvenStreamTable
oddStreamTable :: Context -> TVar OddStreamTable
peerSettings :: Context -> IORef Settings
myFirstSettings :: Context -> IORef Bool
mySettings :: Context -> Settings
roleInfo :: Context -> RoleInfo
role :: Context -> Role
..} = do
    -- Peer SETTINGS_MAX_CONCURRENT_STREAMS
    Maybe Int
mMaxConc <- Settings -> Maybe Int
maxConcurrentStreams forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 <- forall (m :: * -> *) a. MonadIO m => STM a -> m a
atomically forall a b. (a -> b) -> a -> b
$ Context -> STM Int
getMyNewStreamId Context
ctx
            Int
txws <- Settings -> Int
initialWindowSize forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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
            forall (m :: * -> *) a. Monad m => a -> m a
return (Int
sid, Stream
newstrm)
        Just Int
maxConc -> do
            Int
sid <- forall (m :: * -> *) a. MonadIO m => STM a -> m a
atomically 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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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
            forall (m :: * -> *) a. Monad m => a -> m a
return (Int
sid, Stream
newstrm)