module Network.HTTP2.H2.Queue where

import Control.Concurrent.STM

import Network.HTTP2.H2.Types

{-# INLINE enqueueOutput #-}
enqueueOutput :: TQueue Output -> Output -> IO ()
enqueueOutput :: TQueue Output -> Output -> IO ()
enqueueOutput TQueue Output
outQ Output
out = STM () -> IO ()
forall a. STM a -> IO a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ TQueue Output -> Output -> STM ()
forall a. TQueue a -> a -> STM ()
writeTQueue TQueue Output
outQ Output
out

{-# INLINE enqueueOutputSTM #-}
enqueueOutputSTM :: TQueue Output -> Output -> STM ()
enqueueOutputSTM :: TQueue Output -> Output -> STM ()
enqueueOutputSTM TQueue Output
outQ Output
out = TQueue Output -> Output -> STM ()
forall a. TQueue a -> a -> STM ()
writeTQueue TQueue Output
outQ Output
out

newControlQ :: IO ControlQ
newControlQ :: IO ControlQ
newControlQ = TQueue Control -> TVar Int -> ControlQ
ControlQ (TQueue Control -> TVar Int -> ControlQ)
-> IO (TQueue Control) -> IO (TVar Int -> ControlQ)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO (TQueue Control)
forall a. IO (TQueue a)
newTQueueIO IO (TVar Int -> ControlQ) -> IO (TVar Int) -> IO ControlQ
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 a. a -> IO (TVar a)
newTVarIO Int
0

-- | Never blocks: the sender itself enqueues control frames (resets), and
-- would wait for ever on a queue only it empties.
{-# INLINE enqueueControl #-}
enqueueControl :: ControlQ -> Control -> IO ()
enqueueControl :: ControlQ -> Control -> IO ()
enqueueControl (ControlQ TQueue Control
q TVar Int
n) Control
ctl = STM () -> IO ()
forall a. STM a -> IO a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
    TQueue Control -> Control -> STM ()
forall a. TQueue a -> a -> STM ()
writeTQueue TQueue Control
q Control
ctl
    TVar Int -> (Int -> Int) -> STM ()
forall a. TVar a -> (a -> a) -> STM ()
modifyTVar' TVar Int
n (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)

dequeueControlSTM :: ControlQ -> STM Control
dequeueControlSTM :: ControlQ -> STM Control
dequeueControlSTM (ControlQ TQueue Control
q TVar Int
n) = do
    Control
ctl <- TQueue Control -> STM Control
forall a. TQueue a -> STM a
readTQueue TQueue Control
q
    TVar Int -> (Int -> Int) -> STM ()
forall a. TVar a -> (a -> a) -> STM ()
modifyTVar' TVar Int
n (Int -> Int -> Int
forall a. Num a => a -> a -> a
subtract Int
1)
    Control -> STM Control
forall a. a -> STM a
forall (m :: * -> *) a. Monad m => a -> m a
return Control
ctl

isEmptyControlQ :: ControlQ -> STM Bool
isEmptyControlQ :: ControlQ -> STM Bool
isEmptyControlQ (ControlQ TQueue Control
q TVar Int
_) = TQueue Control -> STM Bool
forall a. TQueue a -> STM Bool
isEmptyTQueue TQueue Control
q

-- | Wait until fewer than 'controlQLimit' control frames are waiting for the
-- sender.  The receiver does, before reading each frame.
--
-- Most of the control frames are answers to what the peer sends:
-- RST_STREAM(REFUSED_STREAM) to a stream over our
-- SETTINGS_MAX_CONCURRENT_STREAMS, PING and SETTINGS acks, WINDOW_UPDATE.
-- A peer that does not read them blocks the sender on the socket, and if
-- we read on regardless, they pile up here without bound: a refused stream
-- is a few octets of HEADERS, and not rate-limited, since a peer is meant
-- to be able to retry it.  So we stop reading a peer that does not read
-- us, until the sender has caught up -- or the receive timeout gives up on
-- it.  A peer that reads loses nothing: it could not go on sending without
-- our WINDOW_UPDATEs anyway.
waitControlQ :: ControlQ -> STM ()
waitControlQ :: ControlQ -> STM ()
waitControlQ (ControlQ TQueue Control
_ TVar Int
n) = do
    Int
len <- TVar Int -> STM Int
forall a. TVar a -> STM a
readTVar TVar Int
n
    Bool -> STM ()
check (Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
controlQLimit)

-- | How many control frames may wait for the sender before the receiver
-- stops reading: some 150 KiB of them.
controlQLimit :: Int
controlQLimit :: Int
controlQLimit = Int
1000

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