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

module Network.HTTP2.H2.Stream where

import Control.Monad
import Data.IORef
import Data.Maybe (fromMaybe)
import Network.Control
import UnliftIO.Concurrent
import UnliftIO.Exception
import UnliftIO.STM

import Network.HTTP2.Frame
import Network.HTTP2.H2.StreamTable
import Network.HTTP2.H2.Types

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

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

isReserved :: StreamState -> Bool
isReserved :: StreamState -> Bool
isReserved StreamState
Reserved = Bool
True
isReserved StreamState
_ = Bool
False

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

newOddStream :: StreamId -> WindowSize -> WindowSize -> IO Stream
newOddStream :: StreamId -> StreamId -> StreamId -> IO Stream
newOddStream StreamId
sid StreamId
txwin StreamId
rxwin =
    StreamId
-> IORef StreamState
-> MVar (Either SomeException InpObj)
-> TVar TxFlow
-> IORef RxFlow
-> Stream
Stream StreamId
sid
        (IORef StreamState
 -> MVar (Either SomeException InpObj)
 -> TVar TxFlow
 -> IORef RxFlow
 -> Stream)
-> IO (IORef StreamState)
-> IO
     (MVar (Either SomeException InpObj)
      -> TVar TxFlow -> IORef RxFlow -> 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
  (MVar (Either SomeException InpObj)
   -> TVar TxFlow -> IORef RxFlow -> Stream)
-> IO (MVar (Either SomeException InpObj))
-> IO (TVar TxFlow -> IORef RxFlow -> Stream)
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> IO (MVar (Either SomeException InpObj))
forall (m :: * -> *) a. MonadIO m => m (MVar a)
newEmptyMVar
        IO (TVar TxFlow -> IORef RxFlow -> Stream)
-> IO (TVar TxFlow) -> IO (IORef RxFlow -> Stream)
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> TxFlow -> IO (TVar TxFlow)
forall (m :: * -> *) a. MonadIO m => a -> m (TVar a)
newTVarIO (StreamId -> TxFlow
newTxFlow StreamId
txwin)
        IO (IORef RxFlow -> Stream) -> IO (IORef RxFlow) -> IO Stream
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RxFlow -> IO (IORef RxFlow)
forall a. a -> IO (IORef a)
newIORef (StreamId -> RxFlow
newRxFlow StreamId
rxwin)

newEvenStream :: StreamId -> WindowSize -> WindowSize -> IO Stream
newEvenStream :: StreamId -> StreamId -> StreamId -> IO Stream
newEvenStream StreamId
sid StreamId
txwin StreamId
rxwin =
    StreamId
-> IORef StreamState
-> MVar (Either SomeException InpObj)
-> TVar TxFlow
-> IORef RxFlow
-> Stream
Stream StreamId
sid
        (IORef StreamState
 -> MVar (Either SomeException InpObj)
 -> TVar TxFlow
 -> IORef RxFlow
 -> Stream)
-> IO (IORef StreamState)
-> IO
     (MVar (Either SomeException InpObj)
      -> TVar TxFlow -> IORef RxFlow -> 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
  (MVar (Either SomeException InpObj)
   -> TVar TxFlow -> IORef RxFlow -> Stream)
-> IO (MVar (Either SomeException InpObj))
-> IO (TVar TxFlow -> IORef RxFlow -> Stream)
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> IO (MVar (Either SomeException InpObj))
forall (m :: * -> *) a. MonadIO m => m (MVar a)
newEmptyMVar
        IO (TVar TxFlow -> IORef RxFlow -> Stream)
-> IO (TVar TxFlow) -> IO (IORef RxFlow -> Stream)
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> TxFlow -> IO (TVar TxFlow)
forall (m :: * -> *) a. MonadIO m => a -> m (TVar a)
newTVarIO (StreamId -> TxFlow
newTxFlow StreamId
txwin)
        IO (IORef RxFlow -> Stream) -> IO (IORef RxFlow) -> IO Stream
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RxFlow -> IO (IORef RxFlow)
forall a. a -> IO (IORef a)
newIORef (StreamId -> RxFlow
newRxFlow StreamId
rxwin)

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

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

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

closeAllStreams
    :: TVar OddStreamTable -> TVar EvenStreamTable -> Maybe SomeException -> IO ()
closeAllStreams :: TVar OddStreamTable
-> TVar EvenStreamTable -> Maybe SomeException -> IO ()
closeAllStreams TVar OddStreamTable
ovar TVar EvenStreamTable
evar Maybe SomeException
mErr' = do
    IntMap Stream
ostrms <- TVar OddStreamTable -> IO (IntMap Stream)
clearOddStreamTable TVar OddStreamTable
ovar
    (Stream -> IO ()) -> IntMap Stream -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Stream -> IO ()
finalize IntMap Stream
ostrms
    IntMap Stream
estrms <- TVar EvenStreamTable -> IO (IntMap Stream)
clearEvenStreamTable TVar EvenStreamTable
evar
    (Stream -> IO ()) -> IntMap Stream -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Stream -> IO ()
finalize IntMap Stream
estrms
  where
    finalize :: Stream -> IO ()
finalize Stream
strm = do
        StreamState
st <- Stream -> IO StreamState
readStreamState Stream
strm
        IO Bool -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO Bool -> IO ())
-> (Either SomeException InpObj -> IO Bool)
-> Either SomeException InpObj
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MVar (Either SomeException InpObj)
-> Either SomeException InpObj -> IO Bool
forall (m :: * -> *) a. MonadIO m => MVar a -> a -> m Bool
tryPutMVar (Stream -> MVar (Either SomeException InpObj)
streamInput Stream
strm) (Either SomeException InpObj -> IO ())
-> Either SomeException InpObj -> IO ()
forall a b. (a -> b) -> a -> b
$
            SomeException -> Either SomeException InpObj
forall a b. a -> Either a b
Left (SomeException -> Either SomeException InpObj)
-> SomeException -> Either SomeException InpObj
forall a b. (a -> b) -> a -> b
$
                SomeException -> Maybe SomeException -> SomeException
forall a. a -> Maybe a -> a
fromMaybe (HTTP2Error -> SomeException
forall e. Exception e => e -> SomeException
toException HTTP2Error
ConnectionIsClosed) (Maybe SomeException -> SomeException)
-> Maybe SomeException -> SomeException
forall a b. (a -> b) -> a -> b
$
                    Maybe SomeException
mErr
        case StreamState
st of
            Open Maybe ClosedCode
_ (Body TQueue (Either SomeException ByteString)
q Maybe StreamId
_ IORef StreamId
_ IORef (Maybe TokenHeaderTable)
_) ->
                STM () -> IO ()
forall (m :: * -> *) a. MonadIO m => STM a -> m a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ TQueue (Either SomeException ByteString)
-> Either SomeException ByteString -> STM ()
forall a. TQueue a -> a -> STM ()
writeTQueue TQueue (Either SomeException ByteString)
q (Either SomeException ByteString -> STM ())
-> Either SomeException ByteString -> STM ()
forall a b. (a -> b) -> a -> b
$ Either SomeException ByteString
-> (SomeException -> Either SomeException ByteString)
-> Maybe SomeException
-> Either SomeException ByteString
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (ByteString -> Either SomeException ByteString
forall a b. b -> Either a b
Right ByteString
forall a. Monoid a => a
mempty) SomeException -> Either SomeException ByteString
forall a b. a -> Either a b
Left Maybe SomeException
mErr
            StreamState
_otherwise ->
                () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    mErr :: Maybe SomeException
    mErr :: Maybe SomeException
mErr = case Maybe SomeException
mErr' of
        Just SomeException
err
            | Just HTTP2Error
ConnectionIsClosed <- SomeException -> Maybe HTTP2Error
forall e. Exception e => SomeException -> Maybe e
fromException SomeException
err ->
                Maybe SomeException
forall a. Maybe a
Nothing
        Maybe SomeException
_otherwise ->
            Maybe SomeException
mErr'