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

module Network.HTTP2.Arch.Window where

import Data.IORef
import UnliftIO.STM

import Imports
import Network.HTTP2.Arch.Config
import Network.HTTP2.Arch.Context
import Network.HTTP2.Arch.EncodeFrame
import Network.HTTP2.Arch.Queue
import Network.HTTP2.Arch.Stream
import Network.HTTP2.Arch.Types
import Network.HTTP2.Frame

----------------------------------------------------------------
-- Receiving window update

increaseStreamWindowSize :: Stream -> Int -> IO WindowSize
increaseStreamWindowSize :: Stream -> WindowSize -> IO WindowSize
increaseStreamWindowSize Stream{TVar WindowSize
streamWindow :: Stream -> TVar WindowSize
streamWindow :: TVar WindowSize
streamWindow} WindowSize
n = forall (m :: * -> *) a. MonadIO m => STM a -> m a
atomically forall a b. (a -> b) -> a -> b
$ do
    WindowSize
w0 <- forall a. TVar a -> STM a
readTVar TVar WindowSize
streamWindow
    let w1 :: WindowSize
w1 = WindowSize
w0 forall a. Num a => a -> a -> a
+ WindowSize
n
    forall a. TVar a -> a -> STM ()
writeTVar TVar WindowSize
streamWindow WindowSize
w1
    forall (m :: * -> *) a. Monad m => a -> m a
return WindowSize
w1

increaseConnectionWindowSize :: Context -> Int -> IO WindowSize
increaseConnectionWindowSize :: Context -> WindowSize -> IO WindowSize
increaseConnectionWindowSize Context{TVar WindowSize
txConnectionWindow :: Context -> TVar WindowSize
txConnectionWindow :: TVar WindowSize
txConnectionWindow} WindowSize
n = forall (m :: * -> *) a. MonadIO m => STM a -> m a
atomically forall a b. (a -> b) -> a -> b
$ do
    WindowSize
w0 <- forall a. TVar a -> STM a
readTVar TVar WindowSize
txConnectionWindow
    let w1 :: WindowSize
w1 = WindowSize
w0 forall a. Num a => a -> a -> a
+ WindowSize
n
    forall a. TVar a -> a -> STM ()
writeTVar TVar WindowSize
txConnectionWindow WindowSize
w1
    forall (m :: * -> *) a. Monad m => a -> m a
return WindowSize
w1

----------------------------------------------------------------
-- Sending window update

decreaseWindowSize :: Context -> Stream -> WindowSize -> IO ()
decreaseWindowSize :: Context -> Stream -> WindowSize -> IO ()
decreaseWindowSize Context{TVar WindowSize
txConnectionWindow :: TVar WindowSize
txConnectionWindow :: Context -> TVar WindowSize
txConnectionWindow} Stream{TVar WindowSize
streamWindow :: TVar WindowSize
streamWindow :: Stream -> TVar WindowSize
streamWindow} WindowSize
siz = do
    forall (m :: * -> *) a. MonadIO m => STM a -> m a
atomically forall a b. (a -> b) -> a -> b
$ forall a. TVar a -> (a -> a) -> STM ()
modifyTVar' TVar WindowSize
txConnectionWindow (forall a. Num a => a -> a -> a
subtract WindowSize
siz)
    forall (m :: * -> *) a. MonadIO m => STM a -> m a
atomically forall a b. (a -> b) -> a -> b
$ forall a. TVar a -> (a -> a) -> STM ()
modifyTVar' TVar WindowSize
streamWindow (forall a. Num a => a -> a -> a
subtract WindowSize
siz)

informWindowUpdate :: TQueue Control -> StreamId -> IORef Int -> Int -> IO ()
informWindowUpdate :: TQueue Control
-> WindowSize -> IORef WindowSize -> WindowSize -> IO ()
informWindowUpdate TQueue Control
_        WindowSize
_   IORef WindowSize
_      WindowSize
0   = forall (m :: * -> *) a. Monad m => a -> m a
return ()
informWindowUpdate TQueue Control
controlQ WindowSize
sid IORef WindowSize
incref WindowSize
len = do
    -- incref is occupied by the receiver thread
    WindowSize
w0 <- forall a. IORef a -> IO a
readIORef IORef WindowSize
incref
    let w1 :: WindowSize
w1 = WindowSize
w0 forall a. Num a => a -> a -> a
+ WindowSize
len
    if WindowSize
w1 forall a. Ord a => a -> a -> Bool
>= WindowSize
defaultWindowSize then do -- fixme
        let frame :: ByteString
frame = WindowSize -> WindowSize -> ByteString
windowUpdateFrame WindowSize
sid WindowSize
w1
        TQueue Control -> Control -> IO ()
enqueueControl TQueue Control
controlQ forall a b. (a -> b) -> a -> b
$ Maybe SettingsList -> [ByteString] -> Control
CFrames forall a. Maybe a
Nothing [ByteString
frame]
        forall a. IORef a -> a -> IO ()
writeIORef IORef WindowSize
incref WindowSize
0
      else
        forall a. IORef a -> a -> IO ()
writeIORef IORef WindowSize
incref WindowSize
w1

informConnectionWindowUpdate :: Context -> Int -> IO ()
informConnectionWindowUpdate :: Context -> WindowSize -> IO ()
informConnectionWindowUpdate Context{TVar WindowSize
IORef Bool
IORef WindowSize
IORef (Maybe WindowSize)
IORef (Maybe SettingsList)
IORef Settings
TQueue Control
TQueue (Output Stream)
DynamicTable
Rate
StreamTable
RoleInfo
Role
emptyFrameRate :: Context -> Rate
settingsRate :: Context -> Rate
pingRate :: Context -> Rate
rxConnectionInc :: Context -> IORef WindowSize
decodeDynamicTable :: Context -> DynamicTable
encodeDynamicTable :: Context -> DynamicTable
controlQ :: Context -> TQueue Control
outputQStreamID :: Context -> TVar WindowSize
outputQ :: Context -> TQueue (Output Stream)
outputBufferLimit :: Context -> IORef WindowSize
peerStreamId :: Context -> IORef WindowSize
myStreamId :: Context -> IORef WindowSize
continued :: Context -> IORef (Maybe WindowSize)
concurrency :: Context -> IORef WindowSize
streamTable :: Context -> StreamTable
peerSettings :: Context -> IORef Settings
mySettings :: Context -> IORef Settings
myPendingAlist :: Context -> IORef (Maybe SettingsList)
myFirstSettings :: Context -> IORef Bool
roleInfo :: Context -> RoleInfo
role :: Context -> Role
emptyFrameRate :: Rate
settingsRate :: Rate
pingRate :: Rate
rxConnectionInc :: IORef WindowSize
txConnectionWindow :: TVar WindowSize
decodeDynamicTable :: DynamicTable
encodeDynamicTable :: DynamicTable
controlQ :: TQueue Control
outputQStreamID :: TVar WindowSize
outputQ :: TQueue (Output Stream)
outputBufferLimit :: IORef WindowSize
peerStreamId :: IORef WindowSize
myStreamId :: IORef WindowSize
continued :: IORef (Maybe WindowSize)
concurrency :: IORef WindowSize
streamTable :: StreamTable
peerSettings :: IORef Settings
mySettings :: IORef Settings
myPendingAlist :: IORef (Maybe SettingsList)
myFirstSettings :: IORef Bool
roleInfo :: RoleInfo
role :: Role
txConnectionWindow :: Context -> TVar WindowSize
..} =
    TQueue Control
-> WindowSize -> IORef WindowSize -> WindowSize -> IO ()
informWindowUpdate TQueue Control
controlQ WindowSize
0 IORef WindowSize
rxConnectionInc

getStreamWindowSize :: Stream -> IO WindowSize
getStreamWindowSize :: Stream -> IO WindowSize
getStreamWindowSize Stream{TVar WindowSize
streamWindow :: TVar WindowSize
streamWindow :: Stream -> TVar WindowSize
streamWindow} = forall (m :: * -> *) a. MonadIO m => TVar a -> m a
readTVarIO TVar WindowSize
streamWindow

getConnectionWindowSize :: Context -> IO WindowSize
getConnectionWindowSize :: Context -> IO WindowSize
getConnectionWindowSize Context{TVar WindowSize
txConnectionWindow :: TVar WindowSize
txConnectionWindow :: Context -> TVar WindowSize
txConnectionWindow} = forall (m :: * -> *) a. MonadIO m => TVar a -> m a
readTVarIO TVar WindowSize
txConnectionWindow

waitStreamWindowSize :: Stream -> IO ()
waitStreamWindowSize :: Stream -> IO ()
waitStreamWindowSize Stream{TVar WindowSize
streamWindow :: TVar WindowSize
streamWindow :: Stream -> TVar WindowSize
streamWindow} = forall (m :: * -> *) a. MonadIO m => STM a -> m a
atomically forall a b. (a -> b) -> a -> b
$ do
    WindowSize
w <- forall a. TVar a -> STM a
readTVar TVar WindowSize
streamWindow
    Bool -> STM ()
checkSTM (WindowSize
w forall a. Ord a => a -> a -> Bool
> WindowSize
0)

waitConnectionWindowSize :: Context -> STM ()
waitConnectionWindowSize :: Context -> STM ()
waitConnectionWindowSize Context{TVar WindowSize
txConnectionWindow :: TVar WindowSize
txConnectionWindow :: Context -> TVar WindowSize
txConnectionWindow} = do
    WindowSize
w <- forall a. TVar a -> STM a
readTVar TVar WindowSize
txConnectionWindow
    Bool -> STM ()
checkSTM (WindowSize
w forall a. Ord a => a -> a -> Bool
> WindowSize
0)

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

-- max: 2,147,483,647 (2^31-1) is too large.
-- def:        65,535 (2^16-1) it too small.
--          1,048,575 (2^20-1)
properWindowSize :: WindowSize
properWindowSize :: WindowSize
properWindowSize = WindowSize
1048575

updateMySettings :: Config -> Context -> IO [ByteString]
updateMySettings :: Config -> Context -> IO [ByteString]
updateMySettings Config{WindowSize
Buffer
Manager
WindowSize -> IO ByteString
PositionReadMaker
ByteString -> IO ()
confTimeoutManager :: Config -> Manager
confPositionReadMaker :: Config -> PositionReadMaker
confReadN :: Config -> WindowSize -> IO ByteString
confSendAll :: Config -> ByteString -> IO ()
confBufferSize :: Config -> WindowSize
confWriteBuffer :: Config -> Buffer
confTimeoutManager :: Manager
confPositionReadMaker :: PositionReadMaker
confReadN :: WindowSize -> IO ByteString
confSendAll :: ByteString -> IO ()
confBufferSize :: WindowSize
confWriteBuffer :: Buffer
..} Context{IORef Bool
myFirstSettings :: IORef Bool
myFirstSettings :: Context -> IORef Bool
myFirstSettings,IORef (Maybe SettingsList)
myPendingAlist :: IORef (Maybe SettingsList)
myPendingAlist :: Context -> IORef (Maybe SettingsList)
myPendingAlist} = do
    forall a. IORef a -> a -> IO ()
writeIORef IORef Bool
myFirstSettings Bool
True
    forall a. IORef a -> a -> IO ()
writeIORef IORef (Maybe SettingsList)
myPendingAlist forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just SettingsList
myInitialAlist
    forall (m :: * -> *) a. Monad m => a -> m a
return [ByteString]
frames
  where
    len :: WindowSize
len = WindowSize
confBufferSize forall a. Num a => a -> a -> a
- WindowSize
frameHeaderLength
    payloadLen :: WindowSize
payloadLen = forall a. Ord a => a -> a -> a
max WindowSize
defaultPayloadLength WindowSize
len
    myInitialAlist :: SettingsList
myInitialAlist =
        -- 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.
        [(SettingsKey
SettingsMaxFrameSize,WindowSize
payloadLen)
        ,(SettingsKey
SettingsMaxConcurrentStreams,WindowSize
recommendedConcurrency)
        -- Initial window size for streams
        ,(SettingsKey
SettingsInitialWindowSize,WindowSize
properWindowSize)]
    frame1 :: ByteString
frame1 = (FrameFlags -> FrameFlags) -> SettingsList -> ByteString
settingsFrame forall a. a -> a
id SettingsList
myInitialAlist
        -- Initial window update for connection
    frame2 :: ByteString
frame2 = WindowSize -> WindowSize -> ByteString
windowUpdateFrame WindowSize
0 (WindowSize
properWindowSize forall a. Num a => a -> a -> a
- WindowSize
defaultWindowSize)
    frames :: [ByteString]
frames = [ByteString
frame1,ByteString
frame2]

-- Peer SETTINGS_INITIAL_WINDOW_SIZE
-- Adjusting initial window size for streams
updatePeerSettings :: Context -> SettingsList -> IO ()
updatePeerSettings :: Context -> SettingsList -> IO ()
updatePeerSettings Context{IORef Settings
peerSettings :: IORef Settings
peerSettings :: Context -> IORef Settings
peerSettings,StreamTable
streamTable :: StreamTable
streamTable :: Context -> StreamTable
streamTable} SettingsList
peerAlist = do
    WindowSize
oldws <- Settings -> WindowSize
initialWindowSize forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. IORef a -> IO a
readIORef IORef Settings
peerSettings
    forall a. IORef a -> (a -> a) -> IO ()
modifyIORef' IORef Settings
peerSettings forall a b. (a -> b) -> a -> b
$ \Settings
old -> Settings -> SettingsList -> Settings
updateSettings Settings
old SettingsList
peerAlist
    WindowSize
newws <- Settings -> WindowSize
initialWindowSize forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. IORef a -> IO a
readIORef IORef Settings
peerSettings
    let diff :: WindowSize
diff = WindowSize
newws forall a. Num a => a -> a -> a
- WindowSize
oldws
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (WindowSize
diff forall a. Eq a => a -> a -> Bool
/= WindowSize
0) forall a b. (a -> b) -> a -> b
$ (WindowSize -> WindowSize) -> StreamTable -> IO ()
updateAllStreamWindow (forall a. Num a => a -> a -> a
+ WindowSize
diff) StreamTable
streamTable