{-# 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 Control.Exception
import Data.IntMap.Strict (IntMap)
import qualified Data.IntMap.Strict as IntMap
import Network.Control (LRUCache)
import qualified Network.Control as LRUCache
import Network.HTTP.Types (Method)

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.
      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'

deleteOdd :: TVar OddStreamTable -> IntMap.Key -> 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
        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
$ Int -> IntMap Stream -> Maybe Stream
forall a. Int -> IntMap a -> Maybe a
IntMap.lookup Int
k IntMap Stream
oddTable

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

deleteEven :: TVar EvenStreamTable -> IntMap.Key -> 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
        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
$ Int -> IntMap Stream -> Maybe Stream
forall a. Int -> IntMap a -> Maybe a
IntMap.lookup Int
k IntMap Stream
evenTable

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 TxFlow
IORef RxFlow
IORef StreamState
streamInput :: Stream -> MVar (Either SomeException InpObj)
streamNumber :: Int
streamState :: IORef StreamState
streamInput :: MVar (Either SomeException InpObj)
streamTxFlow :: TVar TxFlow
streamRxFlow :: IORef RxFlow
streamNumber :: Stream -> Int
streamState :: Stream -> IORef StreamState
streamTxFlow :: Stream -> TVar TxFlow
streamRxFlow :: Stream -> IORef RxFlow
..} = 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