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

module Network.HTTP2.Arch.Window where

import Data.IORef
import qualified UnliftIO.Exception as E
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

getStreamWindowSize :: Stream -> IO WindowSize
getStreamWindowSize :: Stream -> IO WindowSize
getStreamWindowSize Stream{TVar WindowSize
streamWindow :: Stream -> TVar WindowSize
streamWindow :: 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 :: Context -> TVar WindowSize
txConnectionWindow :: 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)

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

increaseWindowSize :: StreamId -> TVar WindowSize -> WindowSize -> IO ()
increaseWindowSize :: WindowSize -> TVar WindowSize -> WindowSize -> IO ()
increaseWindowSize WindowSize
sid TVar WindowSize
tvar WindowSize
n = do
    WindowSize
w <- 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
tvar
        let w1 :: WindowSize
w1 = WindowSize
w0 forall a. Num a => a -> a -> a
+ WindowSize
n
        forall a. TVar a -> a -> STM ()
writeTVar TVar WindowSize
tvar WindowSize
w1
        forall (m :: * -> *) a. Monad m => a -> m a
return WindowSize
w1
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (WindowSize -> Bool
isWindowOverflow WindowSize
w) forall a b. (a -> b) -> a -> b
$ do
        let msg :: ReasonPhrase
msg = forall a. IsString a => String -> a
fromString (String
"window update for stream " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show WindowSize
sid forall a. [a] -> [a] -> [a]
++ String
" is overflow")
            err :: ErrorCode -> WindowSize -> ReasonPhrase -> HTTP2Error
err = if WindowSize -> Bool
isControl WindowSize
sid then ErrorCode -> WindowSize -> ReasonPhrase -> HTTP2Error
ConnectionErrorIsSent
                                   else ErrorCode -> WindowSize -> ReasonPhrase -> HTTP2Error
StreamErrorIsSent
        forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
E.throwIO forall a b. (a -> b) -> a -> b
$ ErrorCode -> WindowSize -> ReasonPhrase -> HTTP2Error
err ErrorCode
FlowControlError WindowSize
sid ReasonPhrase
msg

increaseStreamWindowSize :: Stream -> WindowSize -> IO ()
increaseStreamWindowSize :: Stream -> WindowSize -> IO ()
increaseStreamWindowSize Stream{WindowSize
streamNumber :: Stream -> WindowSize
streamNumber :: WindowSize
streamNumber,TVar WindowSize
streamWindow :: TVar WindowSize
streamWindow :: Stream -> TVar WindowSize
streamWindow} WindowSize
n =
    WindowSize -> TVar WindowSize -> WindowSize -> IO ()
increaseWindowSize WindowSize
streamNumber TVar WindowSize
streamWindow WindowSize
n

increaseConnectionWindowSize :: Context -> Int -> IO ()
increaseConnectionWindowSize :: Context -> WindowSize -> IO ()
increaseConnectionWindowSize Context{TVar WindowSize
txConnectionWindow :: TVar WindowSize
txConnectionWindow :: Context -> TVar WindowSize
txConnectionWindow} WindowSize
n =
    WindowSize -> TVar WindowSize -> WindowSize -> IO ()
increaseWindowSize WindowSize
0 TVar WindowSize
txConnectionWindow WindowSize
n

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)

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

informWindowUpdate :: Context -> Stream -> IORef Int -> Int -> IO ()
informWindowUpdate :: Context -> Stream -> IORef WindowSize -> WindowSize -> IO ()
informWindowUpdate Context
_        Stream
_   IORef WindowSize
_       WindowSize
0   = forall (m :: * -> *) a. Monad m => a -> m a
return ()
informWindowUpdate Context{TQueue Control
controlQ :: Context -> TQueue Control
controlQ :: TQueue Control
controlQ,IORef WindowSize
rxConnectionInc :: Context -> IORef WindowSize
rxConnectionInc :: IORef WindowSize
rxConnectionInc} Stream{WindowSize
streamNumber :: WindowSize
streamNumber :: Stream -> WindowSize
streamNumber} IORef WindowSize
streamInc WindowSize
len = do
    forall (m :: * -> *) a. Monad m => m (m a) -> m a
join forall a b. (a -> b) -> a -> b
$ forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef IORef WindowSize
rxConnectionInc forall a b. (a -> b) -> a -> b
$ WindowSize -> WindowSize -> (WindowSize, IO ())
modify WindowSize
0
    forall (m :: * -> *) a. Monad m => m (m a) -> m a
join forall a b. (a -> b) -> a -> b
$ forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef IORef WindowSize
streamInc       forall a b. (a -> b) -> a -> b
$ WindowSize -> WindowSize -> (WindowSize, IO ())
modify WindowSize
streamNumber
  where
    modify :: WindowSize -> WindowSize -> (WindowSize, IO ())
modify WindowSize
sid WindowSize
w0
      | WindowSize
w1 forall a. Ord a => a -> a -> Bool
< WindowSize
thresh = (WindowSize
w1, forall (m :: * -> *) a. Monad m => a -> m a
return ())
      | Bool
otherwise   = let frame :: ByteString
frame = WindowSize -> WindowSize -> ByteString
windowUpdateFrame WindowSize
sid WindowSize
w1
                          cframe :: Control
cframe = Maybe SettingsList -> [ByteString] -> Control
CFrames forall a. Maybe a
Nothing [ByteString
frame]
                          action :: IO ()
action = TQueue Control -> Control -> IO ()
enqueueControl TQueue Control
controlQ Control
cframe
                      in (WindowSize
0, IO ()
action)
      where
        thresh :: WindowSize
thresh = WindowSize
defaultWindowSize -- fixme
        w1 :: WindowSize
w1 = WindowSize
w0 forall a. Num a => a -> a -> a
+ WindowSize
len

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

-- 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
SockAddr
WindowSize -> IO ByteString
PositionReadMaker
ByteString -> IO ()
confPeerSockAddr :: Config -> SockAddr
confMySockAddr :: Config -> SockAddr
confTimeoutManager :: Config -> Manager
confPositionReadMaker :: Config -> PositionReadMaker
confReadN :: Config -> WindowSize -> IO ByteString
confSendAll :: Config -> ByteString -> IO ()
confBufferSize :: Config -> WindowSize
confWriteBuffer :: Config -> Buffer
confPeerSockAddr :: SockAddr
confMySockAddr :: SockAddr
confTimeoutManager :: Manager
confPositionReadMaker :: PositionReadMaker
confReadN :: WindowSize -> IO ByteString
confSendAll :: ByteString -> IO ()
confBufferSize :: WindowSize
confWriteBuffer :: Buffer
..} Context{IORef Bool
myFirstSettings :: Context -> IORef Bool
myFirstSettings :: IORef Bool
myFirstSettings,IORef (Maybe SettingsList)
myPendingAlist :: Context -> IORef (Maybe SettingsList)
myPendingAlist :: 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 :: Context -> IORef Settings
peerSettings :: IORef Settings
peerSettings,StreamTable
streamTable :: Context -> StreamTable
streamTable :: 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