{-# LANGUAGE RecordWildCards #-}

module Network.HTTP2.H2.StreamTable (
    -- * Types
    OddStreamTable (..),
    emptyOddStreamTable,
    EvenStreamTable (..),
    emptyEvenStreamTable,

    -- * Odd
    insertOdd,
    insertOdd',
    deleteOdd,
    lookupOdd,
    getOddConcurrency,
    getOddStreams,
    clearOddStreamTable,
    waitIncOdd,

    -- * Even
    insertEven,
    insertEven',
    deleteEven,
    lookupEven,
    getEvenConcurrency,
    clearEvenStreamTable,
    waitIncEven,
    insertEvenCache,
    deleteEvenCache,
    lookupEvenCache,
    getEvenStreams,
) where

import Control.Concurrent
import Control.Concurrent.STM
import qualified Control.Exception as E
import Data.IntMap.Strict (IntMap)
import qualified Data.IntMap.Strict as IntMap
import Network.Control (LRUCache)
import qualified Network.Control as LRUCache

import Imports
import Network.HTTP2.H2.Types (Stream (..))

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

data OddStreamTable = OddStreamTable
    { OddStreamTable -> Int
oddConc :: Int
    , OddStreamTable -> IntMap Stream
oddTable :: IntMap Stream
    }

emptyOddStreamTable :: OddStreamTable
emptyOddStreamTable :: OddStreamTable
emptyOddStreamTable = Int -> IntMap Stream -> OddStreamTable
OddStreamTable Int
0 IntMap Stream
forall a. IntMap a
IntMap.empty

data EvenStreamTable = EvenStreamTable
    { EvenStreamTable -> Int
evenConc :: Int
    , EvenStreamTable -> IntMap Stream
evenTable :: IntMap Stream
    , -- Cache must contain Stream instead of StreamId because
      -- a Stream is deleted when end-of-stream is received.
      -- After that, cache is looked up.
      -- LRUCache is not used as LRU but as fixed-size map.
      EvenStreamTable -> LRUCache (Method, Method) Stream
evenCache :: LRUCache (Method, ByteString) Stream
    }

emptyEvenStreamTable :: Int -> EvenStreamTable
emptyEvenStreamTable :: Int -> EvenStreamTable
emptyEvenStreamTable Int
lim = Int
-> IntMap Stream
-> LRUCache (Method, Method) Stream
-> EvenStreamTable
EvenStreamTable Int
0 IntMap Stream
forall a. IntMap a
IntMap.empty (LRUCache (Method, Method) Stream -> EvenStreamTable)
-> LRUCache (Method, Method) Stream -> EvenStreamTable
forall a b. (a -> b) -> a -> b
$ Int -> LRUCache (Method, Method) Stream
forall k v. Int -> LRUCache k v
LRUCache.empty Int
lim

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

insertOdd :: TVar OddStreamTable -> IntMap.Key -> Stream -> IO ()
insertOdd :: TVar OddStreamTable -> Int -> Stream -> IO ()
insertOdd TVar OddStreamTable
var Int
k Stream
v = STM () -> IO ()
forall a. STM a -> IO a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ TVar OddStreamTable -> (OddStreamTable -> OddStreamTable) -> STM ()
forall a. TVar a -> (a -> a) -> STM ()
modifyTVar TVar OddStreamTable
var ((OddStreamTable -> OddStreamTable) -> STM ())
-> (OddStreamTable -> OddStreamTable) -> STM ()
forall a b. (a -> b) -> a -> b
$ \OddStreamTable{Int
IntMap Stream
oddConc :: OddStreamTable -> Int
oddTable :: OddStreamTable -> IntMap Stream
oddConc :: Int
oddTable :: IntMap Stream
..} ->
    let oddConc' :: Int
oddConc' = Int
oddConc Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
        oddTable' :: IntMap Stream
oddTable' = Int -> Stream -> IntMap Stream -> IntMap Stream
forall a. Int -> a -> IntMap a -> IntMap a
IntMap.insert Int
k Stream
v IntMap Stream
oddTable
     in Int -> IntMap Stream -> OddStreamTable
OddStreamTable Int
oddConc' IntMap Stream
oddTable'

insertOdd' :: TVar OddStreamTable -> IntMap.Key -> Stream -> IO ()
insertOdd' :: TVar OddStreamTable -> Int -> Stream -> IO ()
insertOdd' TVar OddStreamTable
var Int
k Stream
v = STM () -> IO ()
forall a. STM a -> IO a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ TVar OddStreamTable -> (OddStreamTable -> OddStreamTable) -> STM ()
forall a. TVar a -> (a -> a) -> STM ()
modifyTVar TVar OddStreamTable
var ((OddStreamTable -> OddStreamTable) -> STM ())
-> (OddStreamTable -> OddStreamTable) -> STM ()
forall a b. (a -> b) -> a -> b
$ \OddStreamTable{Int
IntMap Stream
oddConc :: OddStreamTable -> Int
oddTable :: OddStreamTable -> IntMap Stream
oddConc :: Int
oddTable :: IntMap Stream
..} ->
    let oddTable' :: IntMap Stream
oddTable' = Int -> Stream -> IntMap Stream -> IntMap Stream
forall a. Int -> a -> IntMap a -> IntMap a
IntMap.insert Int
k Stream
v IntMap Stream
oddTable
     in Int -> IntMap Stream -> OddStreamTable
OddStreamTable Int
oddConc IntMap Stream
oddTable'

-- | Remove a stream and give its concurrency slot back.
--
-- 'closed' can be called more than once for the same stream -- a RST_STREAM
-- carrying a non-critical error code goes through both 'stream' and
-- 'processState', each of which closes it -- so the count must follow an
-- entry that was really there, not the number of calls.
deleteOdd :: TVar OddStreamTable -> IntMap.Key -> E.SomeException -> IO ()
deleteOdd :: TVar OddStreamTable -> Int -> SomeException -> IO ()
deleteOdd TVar OddStreamTable
var Int
k SomeException
err = do
    Maybe Stream
mv <- STM (Maybe Stream) -> IO (Maybe Stream)
forall a. STM a -> IO a
atomically STM (Maybe Stream)
deleteStream
    case Maybe Stream
mv of
        Maybe Stream
Nothing -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return () -- Stream was already removed
        Just Stream
v -> 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 a. MVar a -> a -> IO Bool
tryPutMVar (Stream -> MVar (Either SomeException InpObj)
streamInput Stream
v) (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
err
  where
    deleteStream :: STM (Maybe Stream)
    deleteStream :: STM (Maybe Stream)
deleteStream = do
        OddStreamTable{Int
IntMap Stream
oddConc :: OddStreamTable -> Int
oddTable :: OddStreamTable -> IntMap Stream
oddConc :: Int
oddTable :: IntMap Stream
..} <- TVar OddStreamTable -> STM OddStreamTable
forall a. TVar a -> STM a
readTVar TVar OddStreamTable
var
        case Int -> IntMap Stream -> Maybe Stream
forall a. Int -> IntMap a -> Maybe a
IntMap.lookup Int
k IntMap Stream
oddTable of
            Maybe Stream
Nothing -> Maybe Stream -> STM (Maybe Stream)
forall a. a -> STM a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Stream
forall a. Maybe a
Nothing
            Just Stream
v -> do
                let oddConc' :: Int
oddConc' = Int
oddConc Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
                    oddTable' :: IntMap Stream
oddTable' = Int -> IntMap Stream -> IntMap Stream
forall a. Int -> IntMap a -> IntMap a
IntMap.delete Int
k IntMap Stream
oddTable
                TVar OddStreamTable -> OddStreamTable -> STM ()
forall a. TVar a -> a -> STM ()
writeTVar TVar OddStreamTable
var (OddStreamTable -> STM ()) -> OddStreamTable -> STM ()
forall a b. (a -> b) -> a -> b
$ Int -> IntMap Stream -> OddStreamTable
OddStreamTable Int
oddConc' IntMap Stream
oddTable'
                Maybe Stream -> STM (Maybe Stream)
forall a. a -> STM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Stream -> STM (Maybe Stream))
-> Maybe Stream -> STM (Maybe Stream)
forall a b. (a -> b) -> a -> b
$ Stream -> Maybe Stream
forall a. a -> Maybe a
Just Stream
v

lookupOdd :: TVar OddStreamTable -> IntMap.Key -> IO (Maybe Stream)
lookupOdd :: TVar OddStreamTable -> Int -> IO (Maybe Stream)
lookupOdd TVar OddStreamTable
var Int
k = Int -> IntMap Stream -> Maybe Stream
forall a. Int -> IntMap a -> Maybe a
IntMap.lookup Int
k (IntMap Stream -> Maybe Stream)
-> (OddStreamTable -> IntMap Stream)
-> OddStreamTable
-> Maybe Stream
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OddStreamTable -> IntMap Stream
oddTable (OddStreamTable -> Maybe Stream)
-> IO OddStreamTable -> IO (Maybe Stream)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TVar OddStreamTable -> IO OddStreamTable
forall a. TVar a -> IO a
readTVarIO TVar OddStreamTable
var

getOddConcurrency :: TVar OddStreamTable -> IO Int
getOddConcurrency :: TVar OddStreamTable -> IO Int
getOddConcurrency TVar OddStreamTable
var = OddStreamTable -> Int
oddConc (OddStreamTable -> Int) -> IO OddStreamTable -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TVar OddStreamTable -> IO OddStreamTable
forall a. TVar a -> IO a
readTVarIO TVar OddStreamTable
var

getOddStreams :: TVar OddStreamTable -> IO (IntMap Stream)
getOddStreams :: TVar OddStreamTable -> IO (IntMap Stream)
getOddStreams TVar OddStreamTable
var = OddStreamTable -> IntMap Stream
oddTable (OddStreamTable -> IntMap Stream)
-> IO OddStreamTable -> IO (IntMap Stream)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TVar OddStreamTable -> IO OddStreamTable
forall a. TVar a -> IO a
readTVarIO TVar OddStreamTable
var

clearOddStreamTable :: TVar OddStreamTable -> IO (IntMap Stream)
clearOddStreamTable :: TVar OddStreamTable -> IO (IntMap Stream)
clearOddStreamTable TVar OddStreamTable
var = STM (IntMap Stream) -> IO (IntMap Stream)
forall a. STM a -> IO a
atomically (STM (IntMap Stream) -> IO (IntMap Stream))
-> STM (IntMap Stream) -> IO (IntMap Stream)
forall a b. (a -> b) -> a -> b
$ do
    OddStreamTable{Int
IntMap Stream
oddConc :: OddStreamTable -> Int
oddTable :: OddStreamTable -> IntMap Stream
oddConc :: Int
oddTable :: IntMap Stream
..} <- TVar OddStreamTable -> STM OddStreamTable
forall a. TVar a -> STM a
readTVar TVar OddStreamTable
var
    TVar OddStreamTable -> OddStreamTable -> STM ()
forall a. TVar a -> a -> STM ()
writeTVar TVar OddStreamTable
var OddStreamTable
emptyOddStreamTable
    IntMap Stream -> STM (IntMap Stream)
forall a. a -> STM a
forall (m :: * -> *) a. Monad m => a -> m a
return IntMap Stream
oddTable

waitIncOdd :: TVar OddStreamTable -> Int -> STM ()
waitIncOdd :: TVar OddStreamTable -> Int -> STM ()
waitIncOdd TVar OddStreamTable
var Int
maxConc = do
    OddStreamTable{Int
IntMap Stream
oddConc :: OddStreamTable -> Int
oddTable :: OddStreamTable -> IntMap Stream
oddConc :: Int
oddTable :: IntMap Stream
..} <- TVar OddStreamTable -> STM OddStreamTable
forall a. TVar a -> STM a
readTVar TVar OddStreamTable
var
    Bool -> STM ()
check (Int
oddConc Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
maxConc)
    let oddConc' :: Int
oddConc' = Int
oddConc Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
    TVar OddStreamTable -> OddStreamTable -> STM ()
forall a. TVar a -> a -> STM ()
writeTVar TVar OddStreamTable
var (OddStreamTable -> STM ()) -> OddStreamTable -> STM ()
forall a b. (a -> b) -> a -> b
$ Int -> IntMap Stream -> OddStreamTable
OddStreamTable Int
oddConc' IntMap Stream
oddTable

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

insertEven :: TVar EvenStreamTable -> IntMap.Key -> Stream -> IO ()
insertEven :: TVar EvenStreamTable -> Int -> Stream -> IO ()
insertEven TVar EvenStreamTable
var Int
k Stream
v = STM () -> IO ()
forall a. STM a -> IO a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ TVar EvenStreamTable
-> (EvenStreamTable -> EvenStreamTable) -> STM ()
forall a. TVar a -> (a -> a) -> STM ()
modifyTVar TVar EvenStreamTable
var ((EvenStreamTable -> EvenStreamTable) -> STM ())
-> (EvenStreamTable -> EvenStreamTable) -> STM ()
forall a b. (a -> b) -> a -> b
$ \EvenStreamTable{Int
IntMap Stream
LRUCache (Method, Method) Stream
evenConc :: EvenStreamTable -> Int
evenTable :: EvenStreamTable -> IntMap Stream
evenCache :: EvenStreamTable -> LRUCache (Method, Method) Stream
evenConc :: Int
evenTable :: IntMap Stream
evenCache :: LRUCache (Method, Method) Stream
..} ->
    let evenConc' :: Int
evenConc' = Int
evenConc Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
        evenTable' :: IntMap Stream
evenTable' = Int -> Stream -> IntMap Stream -> IntMap Stream
forall a. Int -> a -> IntMap a -> IntMap a
IntMap.insert Int
k Stream
v IntMap Stream
evenTable
     in Int
-> IntMap Stream
-> LRUCache (Method, Method) Stream
-> EvenStreamTable
EvenStreamTable Int
evenConc' IntMap Stream
evenTable' LRUCache (Method, Method) Stream
evenCache

insertEven' :: TVar EvenStreamTable -> IntMap.Key -> Stream -> IO ()
insertEven' :: TVar EvenStreamTable -> Int -> Stream -> IO ()
insertEven' TVar EvenStreamTable
var Int
k Stream
v = STM () -> IO ()
forall a. STM a -> IO a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ TVar EvenStreamTable
-> (EvenStreamTable -> EvenStreamTable) -> STM ()
forall a. TVar a -> (a -> a) -> STM ()
modifyTVar TVar EvenStreamTable
var ((EvenStreamTable -> EvenStreamTable) -> STM ())
-> (EvenStreamTable -> EvenStreamTable) -> STM ()
forall a b. (a -> b) -> a -> b
$ \EvenStreamTable{Int
IntMap Stream
LRUCache (Method, Method) Stream
evenConc :: EvenStreamTable -> Int
evenTable :: EvenStreamTable -> IntMap Stream
evenCache :: EvenStreamTable -> LRUCache (Method, Method) Stream
evenConc :: Int
evenTable :: IntMap Stream
evenCache :: LRUCache (Method, Method) Stream
..} ->
    let evenTable' :: IntMap Stream
evenTable' = Int -> Stream -> IntMap Stream -> IntMap Stream
forall a. Int -> a -> IntMap a -> IntMap a
IntMap.insert Int
k Stream
v IntMap Stream
evenTable
     in Int
-> IntMap Stream
-> LRUCache (Method, Method) Stream
-> EvenStreamTable
EvenStreamTable Int
evenConc IntMap Stream
evenTable' LRUCache (Method, Method) Stream
evenCache

-- | Remove a stream and give its concurrency slot back.
-- Idempotent, for the same reason as 'deleteOdd'.
deleteEven :: TVar EvenStreamTable -> IntMap.Key -> E.SomeException -> IO ()
deleteEven :: TVar EvenStreamTable -> Int -> SomeException -> IO ()
deleteEven TVar EvenStreamTable
var Int
k SomeException
err = do
    Maybe Stream
mv <- STM (Maybe Stream) -> IO (Maybe Stream)
forall a. STM a -> IO a
atomically STM (Maybe Stream)
deleteStream
    case Maybe Stream
mv of
        Maybe Stream
Nothing -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return () -- Stream was already removed
        Just Stream
v -> 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 a. MVar a -> a -> IO Bool
tryPutMVar (Stream -> MVar (Either SomeException InpObj)
streamInput Stream
v) (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
err
  where
    deleteStream :: STM (Maybe Stream)
    deleteStream :: STM (Maybe Stream)
deleteStream = do
        EvenStreamTable{Int
IntMap Stream
LRUCache (Method, Method) Stream
evenConc :: EvenStreamTable -> Int
evenTable :: EvenStreamTable -> IntMap Stream
evenCache :: EvenStreamTable -> LRUCache (Method, Method) Stream
evenConc :: Int
evenTable :: IntMap Stream
evenCache :: LRUCache (Method, Method) Stream
..} <- TVar EvenStreamTable -> STM EvenStreamTable
forall a. TVar a -> STM a
readTVar TVar EvenStreamTable
var
        case Int -> IntMap Stream -> Maybe Stream
forall a. Int -> IntMap a -> Maybe a
IntMap.lookup Int
k IntMap Stream
evenTable of
            Maybe Stream
Nothing -> Maybe Stream -> STM (Maybe Stream)
forall a. a -> STM a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Stream
forall a. Maybe a
Nothing
            Just Stream
v -> do
                let evenConc' :: Int
evenConc' = Int
evenConc Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
                    evenTable' :: IntMap Stream
evenTable' = Int -> IntMap Stream -> IntMap Stream
forall a. Int -> IntMap a -> IntMap a
IntMap.delete Int
k IntMap Stream
evenTable
                TVar EvenStreamTable -> EvenStreamTable -> STM ()
forall a. TVar a -> a -> STM ()
writeTVar TVar EvenStreamTable
var (EvenStreamTable -> STM ()) -> EvenStreamTable -> STM ()
forall a b. (a -> b) -> a -> b
$ Int
-> IntMap Stream
-> LRUCache (Method, Method) Stream
-> EvenStreamTable
EvenStreamTable Int
evenConc' IntMap Stream
evenTable' LRUCache (Method, Method) Stream
evenCache
                Maybe Stream -> STM (Maybe Stream)
forall a. a -> STM a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Stream -> STM (Maybe Stream))
-> Maybe Stream -> STM (Maybe Stream)
forall a b. (a -> b) -> a -> b
$ Stream -> Maybe Stream
forall a. a -> Maybe a
Just Stream
v

lookupEven :: TVar EvenStreamTable -> IntMap.Key -> IO (Maybe Stream)
lookupEven :: TVar EvenStreamTable -> Int -> IO (Maybe Stream)
lookupEven TVar EvenStreamTable
var Int
k = Int -> IntMap Stream -> Maybe Stream
forall a. Int -> IntMap a -> Maybe a
IntMap.lookup Int
k (IntMap Stream -> Maybe Stream)
-> (EvenStreamTable -> IntMap Stream)
-> EvenStreamTable
-> Maybe Stream
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EvenStreamTable -> IntMap Stream
evenTable (EvenStreamTable -> Maybe Stream)
-> IO EvenStreamTable -> IO (Maybe Stream)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TVar EvenStreamTable -> IO EvenStreamTable
forall a. TVar a -> IO a
readTVarIO TVar EvenStreamTable
var

getEvenConcurrency :: TVar EvenStreamTable -> IO Int
getEvenConcurrency :: TVar EvenStreamTable -> IO Int
getEvenConcurrency TVar EvenStreamTable
var = EvenStreamTable -> Int
evenConc (EvenStreamTable -> Int) -> IO EvenStreamTable -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TVar EvenStreamTable -> IO EvenStreamTable
forall a. TVar a -> IO a
readTVarIO TVar EvenStreamTable
var

clearEvenStreamTable :: TVar EvenStreamTable -> IO (IntMap Stream)
clearEvenStreamTable :: TVar EvenStreamTable -> IO (IntMap Stream)
clearEvenStreamTable TVar EvenStreamTable
var = STM (IntMap Stream) -> IO (IntMap Stream)
forall a. STM a -> IO a
atomically (STM (IntMap Stream) -> IO (IntMap Stream))
-> STM (IntMap Stream) -> IO (IntMap Stream)
forall a b. (a -> b) -> a -> b
$ do
    EvenStreamTable{Int
IntMap Stream
LRUCache (Method, Method) Stream
evenConc :: EvenStreamTable -> Int
evenTable :: EvenStreamTable -> IntMap Stream
evenCache :: EvenStreamTable -> LRUCache (Method, Method) Stream
evenConc :: Int
evenTable :: IntMap Stream
evenCache :: LRUCache (Method, Method) Stream
..} <- TVar EvenStreamTable -> STM EvenStreamTable
forall a. TVar a -> STM a
readTVar TVar EvenStreamTable
var
    TVar EvenStreamTable -> EvenStreamTable -> STM ()
forall a. TVar a -> a -> STM ()
writeTVar TVar EvenStreamTable
var (EvenStreamTable -> STM ()) -> EvenStreamTable -> STM ()
forall a b. (a -> b) -> a -> b
$ Int -> EvenStreamTable
emptyEvenStreamTable Int
0
    IntMap Stream -> STM (IntMap Stream)
forall a. a -> STM a
forall (m :: * -> *) a. Monad m => a -> m a
return IntMap Stream
evenTable

waitIncEven :: TVar EvenStreamTable -> Int -> STM ()
waitIncEven :: TVar EvenStreamTable -> Int -> STM ()
waitIncEven TVar EvenStreamTable
var Int
maxConc = do
    EvenStreamTable{Int
IntMap Stream
LRUCache (Method, Method) Stream
evenConc :: EvenStreamTable -> Int
evenTable :: EvenStreamTable -> IntMap Stream
evenCache :: EvenStreamTable -> LRUCache (Method, Method) Stream
evenConc :: Int
evenTable :: IntMap Stream
evenCache :: LRUCache (Method, Method) Stream
..} <- TVar EvenStreamTable -> STM EvenStreamTable
forall a. TVar a -> STM a
readTVar TVar EvenStreamTable
var
    Bool -> STM ()
check (Int
evenConc Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
maxConc)
    let evenConc' :: Int
evenConc' = Int
evenConc Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
    TVar EvenStreamTable -> EvenStreamTable -> STM ()
forall a. TVar a -> a -> STM ()
writeTVar TVar EvenStreamTable
var (EvenStreamTable -> STM ()) -> EvenStreamTable -> STM ()
forall a b. (a -> b) -> a -> b
$ Int
-> IntMap Stream
-> LRUCache (Method, Method) Stream
-> EvenStreamTable
EvenStreamTable Int
evenConc' IntMap Stream
evenTable LRUCache (Method, Method) Stream
evenCache

insertEvenCache
    :: TVar EvenStreamTable -> Method -> ByteString -> Stream -> IO ()
insertEvenCache :: TVar EvenStreamTable -> Method -> Method -> Stream -> IO ()
insertEvenCache TVar EvenStreamTable
var Method
method Method
path strm :: Stream
strm@Stream{Int
MVar (Either SomeException InpObj)
TVar Bool
TVar TxFlow
TVar StreamState
IORef (Maybe Method)
IORef (Maybe RxQ)
IORef RxFlow
streamInput :: Stream -> MVar (Either SomeException InpObj)
streamNumber :: Int
streamState :: TVar StreamState
streamInput :: MVar (Either SomeException InpObj)
streamTxFlow :: TVar TxFlow
streamRxFlow :: IORef RxFlow
streamRxQ :: IORef (Maybe RxQ)
streamRequestMethod :: IORef (Maybe Method)
streamDiscardBody :: TVar Bool
streamDiscardBody :: Stream -> TVar Bool
streamRequestMethod :: Stream -> IORef (Maybe Method)
streamRxQ :: Stream -> IORef (Maybe RxQ)
streamRxFlow :: Stream -> IORef RxFlow
streamTxFlow :: Stream -> TVar TxFlow
streamState :: Stream -> TVar StreamState
streamNumber :: Stream -> Int
..} = STM () -> IO ()
forall a. STM a -> IO a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ TVar EvenStreamTable
-> (EvenStreamTable -> EvenStreamTable) -> STM ()
forall a. TVar a -> (a -> a) -> STM ()
modifyTVar TVar EvenStreamTable
var ((EvenStreamTable -> EvenStreamTable) -> STM ())
-> (EvenStreamTable -> EvenStreamTable) -> STM ()
forall a b. (a -> b) -> a -> b
$ \EvenStreamTable{Int
IntMap Stream
LRUCache (Method, Method) Stream
evenConc :: EvenStreamTable -> Int
evenTable :: EvenStreamTable -> IntMap Stream
evenCache :: EvenStreamTable -> LRUCache (Method, Method) Stream
evenConc :: Int
evenTable :: IntMap Stream
evenCache :: LRUCache (Method, Method) Stream
..} ->
    let evenConc' :: Int
evenConc' = Int
evenConc Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
        evenTable' :: IntMap Stream
evenTable' = Int -> Stream -> IntMap Stream -> IntMap Stream
forall a. Int -> a -> IntMap a -> IntMap a
IntMap.insert Int
streamNumber Stream
strm IntMap Stream
evenTable
        evenCache' :: LRUCache (Method, Method) Stream
evenCache' = (Method, Method)
-> Stream
-> LRUCache (Method, Method) Stream
-> LRUCache (Method, Method) Stream
forall k v. Ord k => k -> v -> LRUCache k v -> LRUCache k v
LRUCache.insert (Method
method, Method
path) Stream
strm LRUCache (Method, Method) Stream
evenCache
     in Int
-> IntMap Stream
-> LRUCache (Method, Method) Stream
-> EvenStreamTable
EvenStreamTable Int
evenConc' IntMap Stream
evenTable' LRUCache (Method, Method) Stream
evenCache'

deleteEvenCache :: TVar EvenStreamTable -> Method -> ByteString -> IO ()
deleteEvenCache :: TVar EvenStreamTable -> Method -> Method -> IO ()
deleteEvenCache TVar EvenStreamTable
var Method
m Method
path = STM () -> IO ()
forall a. STM a -> IO a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ TVar EvenStreamTable
-> (EvenStreamTable -> EvenStreamTable) -> STM ()
forall a. TVar a -> (a -> a) -> STM ()
modifyTVar TVar EvenStreamTable
var ((EvenStreamTable -> EvenStreamTable) -> STM ())
-> (EvenStreamTable -> EvenStreamTable) -> STM ()
forall a b. (a -> b) -> a -> b
$ \EvenStreamTable{Int
IntMap Stream
LRUCache (Method, Method) Stream
evenConc :: EvenStreamTable -> Int
evenTable :: EvenStreamTable -> IntMap Stream
evenCache :: EvenStreamTable -> LRUCache (Method, Method) Stream
evenConc :: Int
evenTable :: IntMap Stream
evenCache :: LRUCache (Method, Method) Stream
..} ->
    let evenCache' :: LRUCache (Method, Method) Stream
evenCache' = (Method, Method)
-> LRUCache (Method, Method) Stream
-> LRUCache (Method, Method) Stream
forall k v. Ord k => k -> LRUCache k v -> LRUCache k v
LRUCache.delete (Method
m, Method
path) LRUCache (Method, Method) Stream
evenCache
     in Int
-> IntMap Stream
-> LRUCache (Method, Method) Stream
-> EvenStreamTable
EvenStreamTable Int
evenConc IntMap Stream
evenTable LRUCache (Method, Method) Stream
evenCache'

lookupEvenCache
    :: TVar EvenStreamTable -> Method -> ByteString -> IO (Maybe Stream)
lookupEvenCache :: TVar EvenStreamTable -> Method -> Method -> IO (Maybe Stream)
lookupEvenCache TVar EvenStreamTable
var Method
m Method
path = (Method, Method)
-> LRUCache (Method, Method) Stream -> Maybe Stream
forall k v. Ord k => k -> LRUCache k v -> Maybe v
LRUCache.lookup (Method
m, Method
path) (LRUCache (Method, Method) Stream -> Maybe Stream)
-> (EvenStreamTable -> LRUCache (Method, Method) Stream)
-> EvenStreamTable
-> Maybe Stream
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EvenStreamTable -> LRUCache (Method, Method) Stream
evenCache (EvenStreamTable -> Maybe Stream)
-> IO EvenStreamTable -> IO (Maybe Stream)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TVar EvenStreamTable -> IO EvenStreamTable
forall a. TVar a -> IO a
readTVarIO TVar EvenStreamTable
var

getEvenStreams :: TVar EvenStreamTable -> IO (IntMap Stream)
getEvenStreams :: TVar EvenStreamTable -> IO (IntMap Stream)
getEvenStreams TVar EvenStreamTable
var = EvenStreamTable -> IntMap Stream
evenTable (EvenStreamTable -> IntMap Stream)
-> IO EvenStreamTable -> IO (IntMap Stream)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TVar EvenStreamTable -> IO EvenStreamTable
forall a. TVar a -> IO a
readTVarIO TVar EvenStreamTable
var