{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE NamedFieldPuns #-}
module Network.HTTP2.Server.Stream where
import Control.Concurrent.STM
import Data.IORef
import qualified Data.IntMap.Strict as M
import Imports
import Network.HTTP2
import Network.HTTP2.Priority
import Network.HTTP2.Server.Types
isIdle :: StreamState -> Bool
isIdle Idle = True
isIdle _ = False
isOpen :: StreamState -> Bool
isOpen Open{} = True
isOpen _ = False
isHalfClosedRemote :: StreamState -> Bool
isHalfClosedRemote HalfClosedRemote = True
isHalfClosedRemote (Closed _) = True
isHalfClosedRemote _ = False
isHalfClosedLocal :: StreamState -> Bool
isHalfClosedLocal (HalfClosedLocal _) = True
isHalfClosedLocal (Closed _) = True
isHalfClosedLocal _ = False
isClosed :: StreamState -> Bool
isClosed Closed{} = True
isClosed _ = False
newStream :: StreamId -> WindowSize -> IO Stream
newStream sid win = Stream sid <$> newIORef Idle
<*> newTVarIO win
<*> newIORef defaultPrecedence
{-# INLINE readStreamState #-}
readStreamState :: Stream -> IO StreamState
readStreamState Stream{streamState} = readIORef streamState
newStreamTable :: IO StreamTable
newStreamTable = StreamTable <$> newIORef M.empty
insert :: StreamTable -> M.Key -> Stream -> IO ()
insert (StreamTable ref) k v = atomicModifyIORef' ref $ \m ->
let !m' = M.insert k v m
in (m', ())
remove :: StreamTable -> M.Key -> IO ()
remove (StreamTable ref) k = atomicModifyIORef' ref $ \m ->
let !m' = M.delete k m
in (m', ())
search :: StreamTable -> M.Key -> IO (Maybe Stream)
search (StreamTable ref) k = M.lookup k <$> readIORef ref
updateAllStreamWindow :: (WindowSize -> WindowSize) -> StreamTable -> IO ()
updateAllStreamWindow adst (StreamTable ref) = do
strms <- M.elems <$> readIORef ref
forM_ strms $ \strm -> atomically $ modifyTVar (streamWindow strm) adst