{-# LANGUAGE NamedFieldPuns #-}

module Network.HTTP2.Arch.Stream where

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

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 (Open (Just ClosedCode
_) OpenState
_) = 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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. a -> IO (IORef a)
newIORef StreamState
Idle
                               forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) a. MonadIO m => a -> m (TVar a)
newTVarIO StreamId
win
                               forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) a. MonadIO m => m (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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. a -> IO (IORef a)
newIORef StreamState
Reserved
                                   forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) a. MonadIO m => a -> m (TVar a)
newTVarIO StreamId
win
                                   forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) a. MonadIO m => m (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} = forall a. IORef a -> IO a
readIORef IORef StreamState
streamState

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

newStreamTable :: IO StreamTable
newStreamTable :: IO StreamTable
newStreamTable = IORef (IntMap Stream) -> StreamTable
StreamTable forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. a -> IO (IORef a)
newIORef 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 = forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef' IORef (IntMap Stream)
ref forall a b. (a -> b) -> a -> b
$ \IntMap Stream
m ->
    let m' :: IntMap Stream
m' = 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 = forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef' IORef (IntMap Stream)
ref forall a b. (a -> b) -> a -> b
$ \IntMap Stream
m ->
    let m' :: IntMap Stream
m' = 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 = forall a. StreamId -> IntMap a -> Maybe a
M.lookup StreamId
k forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 <- forall a. IntMap a -> [a]
M.elems forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. IORef a -> IO a
readIORef IORef (IntMap Stream)
ref
    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Stream]
strms forall a b. (a -> b) -> a -> b
$ \Stream
strm -> 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 (Stream -> TVar StreamId
streamWindow Stream
strm) StreamId -> StreamId
adst

closeAllStreams :: StreamTable -> Maybe SomeException -> IO ()
closeAllStreams :: StreamTable -> Maybe SomeException -> IO ()
closeAllStreams (StreamTable IORef (IntMap Stream)
ref) Maybe SomeException
mErr' = do
    IntMap Stream
strms <- forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef' IORef (IntMap Stream)
ref forall a b. (a -> b) -> a -> b
$ \IntMap Stream
m -> (forall a. IntMap a
M.empty, IntMap Stream
m)
    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ IntMap Stream
strms forall a b. (a -> b) -> a -> b
$ \Stream
strm -> do
      StreamState
st <- Stream -> IO StreamState
readStreamState Stream
strm
      case StreamState
st of
        Open Maybe ClosedCode
_ (Body TQueue (Either SomeException ByteString)
q Maybe StreamId
_ IORef StreamId
_ IORef (Maybe HeaderTable)
_) ->
          forall (m :: * -> *) a. MonadIO m => STM a -> m a
atomically forall a b. (a -> b) -> a -> b
$ forall a. TQueue a -> a -> STM ()
writeTQueue TQueue (Either SomeException ByteString)
q forall a b. (a -> b) -> a -> b
$ forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a b. b -> Either a b
Right forall a. Monoid a => a
mempty) forall a b. a -> Either a b
Left Maybe SomeException
mErr
        StreamState
_otherwise ->
          forall (m :: * -> *) a. Monad m => a -> m a
return ()
  where
    mErr :: Maybe SomeException
    mErr :: Maybe SomeException
mErr = case Maybe SomeException
mErr' of
             Just SomeException
err | Just HTTP2Error
ConnectionIsClosed <- forall e. Exception e => SomeException -> Maybe e
fromException SomeException
err ->
               forall a. Maybe a
Nothing
             Maybe SomeException
_otherwise ->
               Maybe SomeException
mErr'