{-# LANGUAGE NamedFieldPuns #-}

module Network.HTTP2.Arch.Stream where

import Control.Concurrent
import Control.Concurrent.STM
import Data.IORef
import qualified Data.IntMap.Strict as M

import Imports
import Network.HTTP2.Arch.Types
import Network.HTTP2.Frame

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

isIdle :: StreamState -> Bool
isIdle :: StreamState -> Bool
isIdle StreamState
Idle = Bool
True
isIdle StreamState
_    = Bool
False

isOpen :: StreamState -> Bool
isOpen :: StreamState -> Bool
isOpen Open{} = Bool
True
isOpen StreamState
_      = Bool
False

isHalfClosedRemote :: StreamState -> Bool
isHalfClosedRemote :: StreamState -> Bool
isHalfClosedRemote StreamState
HalfClosedRemote = Bool
True
isHalfClosedRemote (Closed ClosedCode
_)       = Bool
True
isHalfClosedRemote StreamState
_                = Bool
False

isHalfClosedLocal :: StreamState -> Bool
isHalfClosedLocal :: StreamState -> Bool
isHalfClosedLocal (HalfClosedLocal ClosedCode
_) = Bool
True
isHalfClosedLocal (Closed ClosedCode
_)       = Bool
True
isHalfClosedLocal StreamState
_                = Bool
False

isClosed :: StreamState -> Bool
isClosed :: StreamState -> Bool
isClosed Closed{} = Bool
True
isClosed StreamState
_        = Bool
False

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

newStream :: StreamId -> WindowSize -> IO Stream
newStream :: StreamId -> StreamId -> IO Stream
newStream StreamId
sid StreamId
win = StreamId
-> IORef StreamState -> TVar StreamId -> MVar InpObj -> Stream
Stream StreamId
sid (IORef StreamState -> TVar StreamId -> MVar InpObj -> Stream)
-> IO (IORef StreamState)
-> IO (TVar StreamId -> MVar InpObj -> Stream)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StreamState -> IO (IORef StreamState)
forall a. a -> IO (IORef a)
newIORef StreamState
Idle
                               IO (TVar StreamId -> MVar InpObj -> Stream)
-> IO (TVar StreamId) -> IO (MVar InpObj -> Stream)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StreamId -> IO (TVar StreamId)
forall a. a -> IO (TVar a)
newTVarIO StreamId
win
                               IO (MVar InpObj -> Stream) -> IO (MVar InpObj) -> IO Stream
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> IO (MVar InpObj)
forall a. IO (MVar a)
newEmptyMVar

newPushStream :: StreamId -> WindowSize -> IO Stream
newPushStream :: StreamId -> StreamId -> IO Stream
newPushStream StreamId
sid StreamId
win = StreamId
-> IORef StreamState -> TVar StreamId -> MVar InpObj -> Stream
Stream StreamId
sid (IORef StreamState -> TVar StreamId -> MVar InpObj -> Stream)
-> IO (IORef StreamState)
-> IO (TVar StreamId -> MVar InpObj -> Stream)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StreamState -> IO (IORef StreamState)
forall a. a -> IO (IORef a)
newIORef StreamState
Reserved
                                   IO (TVar StreamId -> MVar InpObj -> Stream)
-> IO (TVar StreamId) -> IO (MVar InpObj -> Stream)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StreamId -> IO (TVar StreamId)
forall a. a -> IO (TVar a)
newTVarIO StreamId
win
                                   IO (MVar InpObj -> Stream) -> IO (MVar InpObj) -> IO Stream
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> IO (MVar InpObj)
forall a. IO (MVar a)
newEmptyMVar

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

{-# INLINE readStreamState #-}
readStreamState :: Stream -> IO StreamState
readStreamState :: Stream -> IO StreamState
readStreamState Stream{IORef StreamState
streamState :: Stream -> IORef StreamState
streamState :: IORef StreamState
streamState} = IORef StreamState -> IO StreamState
forall a. IORef a -> IO a
readIORef IORef StreamState
streamState

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

newStreamTable :: IO StreamTable
newStreamTable :: IO StreamTable
newStreamTable = IORef (IntMap Stream) -> StreamTable
StreamTable (IORef (IntMap Stream) -> StreamTable)
-> IO (IORef (IntMap Stream)) -> IO StreamTable
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IntMap Stream -> IO (IORef (IntMap Stream))
forall a. a -> IO (IORef a)
newIORef IntMap Stream
forall a. IntMap a
M.empty

insert :: StreamTable -> M.Key -> Stream -> IO ()
insert :: StreamTable -> StreamId -> Stream -> IO ()
insert (StreamTable IORef (IntMap Stream)
ref) StreamId
k Stream
v = IORef (IntMap Stream)
-> (IntMap Stream -> (IntMap Stream, ())) -> IO ()
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef' IORef (IntMap Stream)
ref ((IntMap Stream -> (IntMap Stream, ())) -> IO ())
-> (IntMap Stream -> (IntMap Stream, ())) -> IO ()
forall a b. (a -> b) -> a -> b
$ \IntMap Stream
m ->
    let m' :: IntMap Stream
m' = StreamId -> Stream -> IntMap Stream -> IntMap Stream
forall a. StreamId -> a -> IntMap a -> IntMap a
M.insert StreamId
k Stream
v IntMap Stream
m
    in (IntMap Stream
m', ())

remove :: StreamTable -> M.Key -> IO ()
remove :: StreamTable -> StreamId -> IO ()
remove (StreamTable IORef (IntMap Stream)
ref) StreamId
k = IORef (IntMap Stream)
-> (IntMap Stream -> (IntMap Stream, ())) -> IO ()
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef' IORef (IntMap Stream)
ref ((IntMap Stream -> (IntMap Stream, ())) -> IO ())
-> (IntMap Stream -> (IntMap Stream, ())) -> IO ()
forall a b. (a -> b) -> a -> b
$ \IntMap Stream
m ->
    let m' :: IntMap Stream
m' = StreamId -> IntMap Stream -> IntMap Stream
forall a. StreamId -> IntMap a -> IntMap a
M.delete StreamId
k IntMap Stream
m
    in (IntMap Stream
m', ())

search :: StreamTable -> M.Key -> IO (Maybe Stream)
search :: StreamTable -> StreamId -> IO (Maybe Stream)
search (StreamTable IORef (IntMap Stream)
ref) StreamId
k = StreamId -> IntMap Stream -> Maybe Stream
forall a. StreamId -> IntMap a -> Maybe a
M.lookup StreamId
k (IntMap Stream -> Maybe Stream)
-> IO (IntMap Stream) -> IO (Maybe Stream)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IORef (IntMap Stream) -> IO (IntMap Stream)
forall a. IORef a -> IO a
readIORef IORef (IntMap Stream)
ref

updateAllStreamWindow :: (WindowSize -> WindowSize) -> StreamTable -> IO ()
updateAllStreamWindow :: (StreamId -> StreamId) -> StreamTable -> IO ()
updateAllStreamWindow StreamId -> StreamId
adst (StreamTable IORef (IntMap Stream)
ref) = do
    [Stream]
strms <- IntMap Stream -> [Stream]
forall a. IntMap a -> [a]
M.elems (IntMap Stream -> [Stream]) -> IO (IntMap Stream) -> IO [Stream]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IORef (IntMap Stream) -> IO (IntMap Stream)
forall a. IORef a -> IO a
readIORef IORef (IntMap Stream)
ref
    [Stream] -> (Stream -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Stream]
strms ((Stream -> IO ()) -> IO ()) -> (Stream -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Stream
strm -> STM () -> IO ()
forall a. STM a -> IO a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ TVar StreamId -> (StreamId -> StreamId) -> STM ()
forall a. TVar a -> (a -> a) -> STM ()
modifyTVar (Stream -> TVar StreamId
streamWindow Stream
strm) StreamId -> StreamId
adst