-- | Hierarchical resource management for the Switch (docs/08-switch.md §Resource Limits).
--
-- Implements a scope tree (System → Peer → Connection → Stream) with
-- STM-based reserve/release that atomically walks leaf→root to enforce
-- per-scope limits. If any scope exceeds its limit, the entire
-- transaction rolls back.
module Network.LibP2P.Switch.ResourceManager
  ( -- * Direction
    Direction (..)
    -- * Resource tracking
  , ResourceUsage (..)
  , emptyUsage
    -- * Limits configuration
  , ResourceLimits (..)
  , noLimits
  , DefaultLimits (..)
  , defaultSystemLimits
  , defaultPeerLimits
    -- * Scope hierarchy
  , ResourceScope (..)
  , ScopeName (..)
  , ResourceError (..)
    -- * Resource manager
  , ResourceManager (..)
  , newResourceManager
    -- * Scope management
  , getOrCreatePeerScope
    -- * Reserve / release
  , reserveConnection
  , releaseConnection
  , reserveStream
  , releaseStream
    -- * Bracket patterns
  , withConnection
  , withStream
  ) where

import Control.Concurrent.STM (STM, TVar, newTVar, readTVar, writeTVar)
import Control.Exception (bracket_)
import Control.Concurrent.STM (atomically)
import qualified Data.Map.Strict as Map
import Network.LibP2P.Crypto.PeerId (PeerId)

-- | Direction of a connection relative to this node.
-- Defined here to avoid circular dependency with Switch.Types.
data Direction
  = Inbound   -- ^ Remote peer initiated the connection
  | Outbound  -- ^ Local node initiated the connection
  deriving (Int -> Direction -> ShowS
[Direction] -> ShowS
Direction -> String
(Int -> Direction -> ShowS)
-> (Direction -> String)
-> ([Direction] -> ShowS)
-> Show Direction
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Direction -> ShowS
showsPrec :: Int -> Direction -> ShowS
$cshow :: Direction -> String
show :: Direction -> String
$cshowList :: [Direction] -> ShowS
showList :: [Direction] -> ShowS
Show, Direction -> Direction -> Bool
(Direction -> Direction -> Bool)
-> (Direction -> Direction -> Bool) -> Eq Direction
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Direction -> Direction -> Bool
== :: Direction -> Direction -> Bool
$c/= :: Direction -> Direction -> Bool
/= :: Direction -> Direction -> Bool
Eq)

-- | Tracked resource usage at a single scope.
data ResourceUsage = ResourceUsage
  { ResourceUsage -> Int
ruConnsInbound   :: !Int
  , ResourceUsage -> Int
ruConnsOutbound  :: !Int
  , ResourceUsage -> Int
ruStreamsInbound  :: !Int
  , ResourceUsage -> Int
ruStreamsOutbound :: !Int
  , ResourceUsage -> Int
ruMemory         :: !Int
  } deriving (Int -> ResourceUsage -> ShowS
[ResourceUsage] -> ShowS
ResourceUsage -> String
(Int -> ResourceUsage -> ShowS)
-> (ResourceUsage -> String)
-> ([ResourceUsage] -> ShowS)
-> Show ResourceUsage
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ResourceUsage -> ShowS
showsPrec :: Int -> ResourceUsage -> ShowS
$cshow :: ResourceUsage -> String
show :: ResourceUsage -> String
$cshowList :: [ResourceUsage] -> ShowS
showList :: [ResourceUsage] -> ShowS
Show, ResourceUsage -> ResourceUsage -> Bool
(ResourceUsage -> ResourceUsage -> Bool)
-> (ResourceUsage -> ResourceUsage -> Bool) -> Eq ResourceUsage
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ResourceUsage -> ResourceUsage -> Bool
== :: ResourceUsage -> ResourceUsage -> Bool
$c/= :: ResourceUsage -> ResourceUsage -> Bool
/= :: ResourceUsage -> ResourceUsage -> Bool
Eq)

-- | Zero usage.
emptyUsage :: ResourceUsage
emptyUsage :: ResourceUsage
emptyUsage = Int -> Int -> Int -> Int -> Int -> ResourceUsage
ResourceUsage Int
0 Int
0 Int
0 Int
0 Int
0

-- | Configurable limits per scope. Nothing = unlimited.
data ResourceLimits = ResourceLimits
  { ResourceLimits -> Maybe Int
rlMaxConnsInbound   :: !(Maybe Int)
  , ResourceLimits -> Maybe Int
rlMaxConnsOutbound  :: !(Maybe Int)
  , ResourceLimits -> Maybe Int
rlMaxConnsTotal     :: !(Maybe Int)
  , ResourceLimits -> Maybe Int
rlMaxStreamsInbound  :: !(Maybe Int)
  , ResourceLimits -> Maybe Int
rlMaxStreamsOutbound :: !(Maybe Int)
  , ResourceLimits -> Maybe Int
rlMaxStreamsTotal    :: !(Maybe Int)
  , ResourceLimits -> Maybe Int
rlMaxMemory         :: !(Maybe Int)
  } deriving (Int -> ResourceLimits -> ShowS
[ResourceLimits] -> ShowS
ResourceLimits -> String
(Int -> ResourceLimits -> ShowS)
-> (ResourceLimits -> String)
-> ([ResourceLimits] -> ShowS)
-> Show ResourceLimits
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ResourceLimits -> ShowS
showsPrec :: Int -> ResourceLimits -> ShowS
$cshow :: ResourceLimits -> String
show :: ResourceLimits -> String
$cshowList :: [ResourceLimits] -> ShowS
showList :: [ResourceLimits] -> ShowS
Show, ResourceLimits -> ResourceLimits -> Bool
(ResourceLimits -> ResourceLimits -> Bool)
-> (ResourceLimits -> ResourceLimits -> Bool) -> Eq ResourceLimits
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ResourceLimits -> ResourceLimits -> Bool
== :: ResourceLimits -> ResourceLimits -> Bool
$c/= :: ResourceLimits -> ResourceLimits -> Bool
/= :: ResourceLimits -> ResourceLimits -> Bool
Eq)

-- | No limits (all Nothing).
noLimits :: ResourceLimits
noLimits :: ResourceLimits
noLimits = Maybe Int
-> Maybe Int
-> Maybe Int
-> Maybe Int
-> Maybe Int
-> Maybe Int
-> Maybe Int
-> ResourceLimits
ResourceLimits Maybe Int
forall a. Maybe a
Nothing Maybe Int
forall a. Maybe a
Nothing Maybe Int
forall a. Maybe a
Nothing Maybe Int
forall a. Maybe a
Nothing Maybe Int
forall a. Maybe a
Nothing Maybe Int
forall a. Maybe a
Nothing Maybe Int
forall a. Maybe a
Nothing

-- | A node in the scope hierarchy.
data ResourceScope = ResourceScope
  { ResourceScope -> ScopeName
rsName   :: !ScopeName
  , ResourceScope -> TVar ResourceUsage
rsUsage  :: !(TVar ResourceUsage)
  , ResourceScope -> ResourceLimits
rsLimits :: !ResourceLimits
  , ResourceScope -> Maybe ResourceScope
rsParent :: !(Maybe ResourceScope)
  }

-- | Scope name for debugging and identification.
data ScopeName
  = SystemScope
  | PeerScope !PeerId
  | ConnectionScope
  | StreamScope
  deriving (Int -> ScopeName -> ShowS
[ScopeName] -> ShowS
ScopeName -> String
(Int -> ScopeName -> ShowS)
-> (ScopeName -> String)
-> ([ScopeName] -> ShowS)
-> Show ScopeName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ScopeName -> ShowS
showsPrec :: Int -> ScopeName -> ShowS
$cshow :: ScopeName -> String
show :: ScopeName -> String
$cshowList :: [ScopeName] -> ShowS
showList :: [ScopeName] -> ShowS
Show, ScopeName -> ScopeName -> Bool
(ScopeName -> ScopeName -> Bool)
-> (ScopeName -> ScopeName -> Bool) -> Eq ScopeName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ScopeName -> ScopeName -> Bool
== :: ScopeName -> ScopeName -> Bool
$c/= :: ScopeName -> ScopeName -> Bool
/= :: ScopeName -> ScopeName -> Bool
Eq)

-- | Resource limit violation error.
data ResourceError
  = ResourceLimitExceeded !ScopeName !String
  deriving (Int -> ResourceError -> ShowS
[ResourceError] -> ShowS
ResourceError -> String
(Int -> ResourceError -> ShowS)
-> (ResourceError -> String)
-> ([ResourceError] -> ShowS)
-> Show ResourceError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ResourceError -> ShowS
showsPrec :: Int -> ResourceError -> ShowS
$cshow :: ResourceError -> String
show :: ResourceError -> String
$cshowList :: [ResourceError] -> ShowS
showList :: [ResourceError] -> ShowS
Show, ResourceError -> ResourceError -> Bool
(ResourceError -> ResourceError -> Bool)
-> (ResourceError -> ResourceError -> Bool) -> Eq ResourceError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ResourceError -> ResourceError -> Bool
== :: ResourceError -> ResourceError -> Bool
$c/= :: ResourceError -> ResourceError -> Bool
/= :: ResourceError -> ResourceError -> Bool
Eq)

-- | Default limits for auto-created scopes.
data DefaultLimits = DefaultLimits
  { DefaultLimits -> ResourceLimits
dlSystemLimits :: !ResourceLimits
  , DefaultLimits -> ResourceLimits
dlPeerLimits   :: !ResourceLimits
  } deriving (Int -> DefaultLimits -> ShowS
[DefaultLimits] -> ShowS
DefaultLimits -> String
(Int -> DefaultLimits -> ShowS)
-> (DefaultLimits -> String)
-> ([DefaultLimits] -> ShowS)
-> Show DefaultLimits
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DefaultLimits -> ShowS
showsPrec :: Int -> DefaultLimits -> ShowS
$cshow :: DefaultLimits -> String
show :: DefaultLimits -> String
$cshowList :: [DefaultLimits] -> ShowS
showList :: [DefaultLimits] -> ShowS
Show, DefaultLimits -> DefaultLimits -> Bool
(DefaultLimits -> DefaultLimits -> Bool)
-> (DefaultLimits -> DefaultLimits -> Bool) -> Eq DefaultLimits
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DefaultLimits -> DefaultLimits -> Bool
== :: DefaultLimits -> DefaultLimits -> Bool
$c/= :: DefaultLimits -> DefaultLimits -> Bool
/= :: DefaultLimits -> DefaultLimits -> Bool
Eq)

-- | Sensible default system limits.
defaultSystemLimits :: ResourceLimits
defaultSystemLimits :: ResourceLimits
defaultSystemLimits = ResourceLimits
  { rlMaxConnsInbound :: Maybe Int
rlMaxConnsInbound   = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
256
  , rlMaxConnsOutbound :: Maybe Int
rlMaxConnsOutbound  = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
256
  , rlMaxConnsTotal :: Maybe Int
rlMaxConnsTotal     = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
512
  , rlMaxStreamsInbound :: Maybe Int
rlMaxStreamsInbound  = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
4096
  , rlMaxStreamsOutbound :: Maybe Int
rlMaxStreamsOutbound = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
4096
  , rlMaxStreamsTotal :: Maybe Int
rlMaxStreamsTotal    = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
8192
  , rlMaxMemory :: Maybe Int
rlMaxMemory         = Int -> Maybe Int
forall a. a -> Maybe a
Just (Int
256 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
1024 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
1024)  -- 256 MiB
  }

-- | Sensible default per-peer limits.
defaultPeerLimits :: ResourceLimits
defaultPeerLimits :: ResourceLimits
defaultPeerLimits = ResourceLimits
  { rlMaxConnsInbound :: Maybe Int
rlMaxConnsInbound   = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
4
  , rlMaxConnsOutbound :: Maybe Int
rlMaxConnsOutbound  = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
4
  , rlMaxConnsTotal :: Maybe Int
rlMaxConnsTotal     = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
8
  , rlMaxStreamsInbound :: Maybe Int
rlMaxStreamsInbound  = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
256
  , rlMaxStreamsOutbound :: Maybe Int
rlMaxStreamsOutbound = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
256
  , rlMaxStreamsTotal :: Maybe Int
rlMaxStreamsTotal    = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
512
  , rlMaxMemory :: Maybe Int
rlMaxMemory         = Int -> Maybe Int
forall a. a -> Maybe a
Just (Int
16 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
1024 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
1024)  -- 16 MiB
  }

-- | Top-level resource manager.
data ResourceManager = ResourceManager
  { ResourceManager -> ResourceScope
rmSystemScope :: !ResourceScope
  , ResourceManager -> DefaultLimits
rmDefaults    :: !DefaultLimits
  , ResourceManager -> TVar (Map PeerId ResourceScope)
rmPeerScopes  :: !(TVar (Map.Map PeerId ResourceScope))
  }

-- | Create a new resource manager with the given default limits.
newResourceManager :: DefaultLimits -> IO ResourceManager
newResourceManager :: DefaultLimits -> IO ResourceManager
newResourceManager DefaultLimits
defaults = do
  usageVar <- STM (TVar ResourceUsage) -> IO (TVar ResourceUsage)
forall a. STM a -> IO a
atomically (STM (TVar ResourceUsage) -> IO (TVar ResourceUsage))
-> STM (TVar ResourceUsage) -> IO (TVar ResourceUsage)
forall a b. (a -> b) -> a -> b
$ ResourceUsage -> STM (TVar ResourceUsage)
forall a. a -> STM (TVar a)
newTVar ResourceUsage
emptyUsage
  peersVar <- atomically $ newTVar Map.empty
  let systemScope = ResourceScope
        { rsName :: ScopeName
rsName   = ScopeName
SystemScope
        , rsUsage :: TVar ResourceUsage
rsUsage  = TVar ResourceUsage
usageVar
        , rsLimits :: ResourceLimits
rsLimits = DefaultLimits -> ResourceLimits
dlSystemLimits DefaultLimits
defaults
        , rsParent :: Maybe ResourceScope
rsParent = Maybe ResourceScope
forall a. Maybe a
Nothing
        }
  pure ResourceManager
    { rmSystemScope = systemScope
    , rmDefaults    = defaults
    , rmPeerScopes  = peersVar
    }

-- | Get or create a peer scope under the system scope.
getOrCreatePeerScope :: ResourceManager -> PeerId -> STM ResourceScope
getOrCreatePeerScope :: ResourceManager -> PeerId -> STM ResourceScope
getOrCreatePeerScope ResourceManager
rm PeerId
pid = do
  peers <- TVar (Map PeerId ResourceScope) -> STM (Map PeerId ResourceScope)
forall a. TVar a -> STM a
readTVar (ResourceManager -> TVar (Map PeerId ResourceScope)
rmPeerScopes ResourceManager
rm)
  case Map.lookup pid peers of
    Just ResourceScope
scope -> ResourceScope -> STM ResourceScope
forall a. a -> STM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ResourceScope
scope
    Maybe ResourceScope
Nothing -> do
      usageVar <- ResourceUsage -> STM (TVar ResourceUsage)
forall a. a -> STM (TVar a)
newTVar ResourceUsage
emptyUsage
      let scope = ResourceScope
            { rsName :: ScopeName
rsName   = PeerId -> ScopeName
PeerScope PeerId
pid
            , rsUsage :: TVar ResourceUsage
rsUsage  = TVar ResourceUsage
usageVar
            , rsLimits :: ResourceLimits
rsLimits = DefaultLimits -> ResourceLimits
dlPeerLimits (ResourceManager -> DefaultLimits
rmDefaults ResourceManager
rm)
            , rsParent :: Maybe ResourceScope
rsParent = ResourceScope -> Maybe ResourceScope
forall a. a -> Maybe a
Just (ResourceManager -> ResourceScope
rmSystemScope ResourceManager
rm)
            }
      writeTVar (rmPeerScopes rm) (Map.insert pid scope peers)
      pure scope

-- | Reserve a connection in the hierarchy (peer scope → system scope).
-- Returns Left on limit violation (STM auto-rolls back all increments).
reserveConnection :: ResourceManager -> PeerId -> Direction -> STM (Either ResourceError ())
reserveConnection :: ResourceManager
-> PeerId -> Direction -> STM (Either ResourceError ())
reserveConnection ResourceManager
rm PeerId
pid Direction
dir = do
  peerScope <- ResourceManager -> PeerId -> STM ResourceScope
getOrCreatePeerScope ResourceManager
rm PeerId
pid
  reserveConnInScope peerScope dir

-- | Release a connection in the hierarchy (peer scope → system scope).
releaseConnection :: ResourceManager -> PeerId -> Direction -> STM ()
releaseConnection :: ResourceManager -> PeerId -> Direction -> STM ()
releaseConnection ResourceManager
rm PeerId
pid Direction
dir = do
  peers <- TVar (Map PeerId ResourceScope) -> STM (Map PeerId ResourceScope)
forall a. TVar a -> STM a
readTVar (ResourceManager -> TVar (Map PeerId ResourceScope)
rmPeerScopes ResourceManager
rm)
  case Map.lookup pid peers of
    Maybe ResourceScope
Nothing -> () -> STM ()
forall a. a -> STM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    Just ResourceScope
peerScope -> ResourceScope -> Direction -> STM ()
releaseConnInScope ResourceScope
peerScope Direction
dir

-- | Reserve a stream in the given scope (walks up to parent).
reserveStream :: ResourceScope -> Direction -> STM (Either ResourceError ())
reserveStream :: ResourceScope -> Direction -> STM (Either ResourceError ())
reserveStream ResourceScope
scope Direction
dir = ResourceScope -> Direction -> STM (Either ResourceError ())
reserveStreamInScope ResourceScope
scope Direction
dir

-- | Release a stream in the given scope (walks up to parent).
releaseStream :: ResourceScope -> Direction -> STM ()
releaseStream :: ResourceScope -> Direction -> STM ()
releaseStream ResourceScope
scope Direction
dir = ResourceScope -> Direction -> STM ()
releaseStreamInScope ResourceScope
scope Direction
dir

-- | Bracket: reserve connection, run action, release on exit (even on exception).
withConnection :: ResourceManager -> PeerId -> Direction -> IO a -> IO a
withConnection :: forall a. ResourceManager -> PeerId -> Direction -> IO a -> IO a
withConnection ResourceManager
rm PeerId
pid Direction
dir IO a
action =
  IO () -> IO () -> IO a -> IO a
forall a b c. IO a -> IO b -> IO c -> IO c
bracket_
    (STM (Either ResourceError ()) -> IO (Either ResourceError ())
forall a. STM a -> IO a
atomically (ResourceManager
-> PeerId -> Direction -> STM (Either ResourceError ())
reserveConnection ResourceManager
rm PeerId
pid Direction
dir) IO (Either ResourceError ())
-> (Either ResourceError () -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (ResourceError -> IO ())
-> (() -> IO ()) -> Either ResourceError () -> IO ()
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> IO ()
forall a. String -> IO a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> IO ())
-> (ResourceError -> String) -> ResourceError -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ResourceError -> String
forall a. Show a => a -> String
show) () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure)
    (STM () -> IO ()
forall a. STM a -> IO a
atomically (ResourceManager -> PeerId -> Direction -> STM ()
releaseConnection ResourceManager
rm PeerId
pid Direction
dir))
    IO a
action

-- | Bracket: reserve stream, run action, release on exit (even on exception).
withStream :: ResourceScope -> Direction -> IO a -> IO a
withStream :: forall a. ResourceScope -> Direction -> IO a -> IO a
withStream ResourceScope
scope Direction
dir IO a
action =
  IO () -> IO () -> IO a -> IO a
forall a b c. IO a -> IO b -> IO c -> IO c
bracket_
    (STM (Either ResourceError ()) -> IO (Either ResourceError ())
forall a. STM a -> IO a
atomically (ResourceScope -> Direction -> STM (Either ResourceError ())
reserveStream ResourceScope
scope Direction
dir) IO (Either ResourceError ())
-> (Either ResourceError () -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (ResourceError -> IO ())
-> (() -> IO ()) -> Either ResourceError () -> IO ()
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> IO ()
forall a. String -> IO a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> IO ())
-> (ResourceError -> String) -> ResourceError -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ResourceError -> String
forall a. Show a => a -> String
show) () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure)
    (STM () -> IO ()
forall a. STM a -> IO a
atomically (ResourceScope -> Direction -> STM ()
releaseStream ResourceScope
scope Direction
dir))
    IO a
action

-- Internal: two-phase reserve for connections.
-- Phase 1: Walk leaf→root, compute new usages and check limits.
-- Phase 2: If all checks pass, commit all writes atomically.
-- This prevents phantom usage when a parent scope blocks.
reserveConnInScope :: ResourceScope -> Direction -> STM (Either ResourceError ())
reserveConnInScope :: ResourceScope -> Direction -> STM (Either ResourceError ())
reserveConnInScope ResourceScope
scope Direction
dir = do
  proposed <- ResourceScope
-> Direction
-> STM (Either ResourceError [(ResourceScope, ResourceUsage)])
collectConnUpdates ResourceScope
scope Direction
dir
  case proposed of
    Left ResourceError
err -> Either ResourceError () -> STM (Either ResourceError ())
forall a. a -> STM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ResourceError -> Either ResourceError ()
forall a b. a -> Either a b
Left ResourceError
err)
    Right [(ResourceScope, ResourceUsage)]
updates -> do
      ((ResourceScope, ResourceUsage) -> STM ())
-> [(ResourceScope, ResourceUsage)] -> STM ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\(ResourceScope
s, ResourceUsage
u) -> TVar ResourceUsage -> ResourceUsage -> STM ()
forall a. TVar a -> a -> STM ()
writeTVar (ResourceScope -> TVar ResourceUsage
rsUsage ResourceScope
s) ResourceUsage
u) [(ResourceScope, ResourceUsage)]
updates
      Either ResourceError () -> STM (Either ResourceError ())
forall a. a -> STM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (() -> Either ResourceError ()
forall a b. b -> Either a b
Right ())

-- Collect proposed (scope, newUsage) pairs from leaf to root.
-- Returns Left if any scope exceeds its limit.
collectConnUpdates :: ResourceScope -> Direction -> STM (Either ResourceError [(ResourceScope, ResourceUsage)])
collectConnUpdates :: ResourceScope
-> Direction
-> STM (Either ResourceError [(ResourceScope, ResourceUsage)])
collectConnUpdates ResourceScope
scope Direction
dir = do
  usage <- TVar ResourceUsage -> STM ResourceUsage
forall a. TVar a -> STM a
readTVar (ResourceScope -> TVar ResourceUsage
rsUsage ResourceScope
scope)
  let (newUsage, checkField, dirName) = case dir of
        Direction
Inbound  -> (ResourceUsage
usage { ruConnsInbound = ruConnsInbound usage + 1 },
                     ResourceUsage -> Int
ruConnsInbound, String
"inbound connections")
        Direction
Outbound -> (ResourceUsage
usage { ruConnsOutbound = ruConnsOutbound usage + 1 },
                     ResourceUsage -> Int
ruConnsOutbound, String
"outbound connections")
      totalConns = ResourceUsage -> Int
ruConnsInbound ResourceUsage
newUsage Int -> Int -> Int
forall a. Num a => a -> a -> a
+ ResourceUsage -> Int
ruConnsOutbound ResourceUsage
newUsage
      limits = ResourceScope -> ResourceLimits
rsLimits ResourceScope
scope
  case connDirLimit dir limits of
    Just Int
lim | ResourceUsage -> Int
checkField ResourceUsage
newUsage Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
lim ->
      Either ResourceError [(ResourceScope, ResourceUsage)]
-> STM (Either ResourceError [(ResourceScope, ResourceUsage)])
forall a. a -> STM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ResourceError
-> Either ResourceError [(ResourceScope, ResourceUsage)]
forall a b. a -> Either a b
Left (ScopeName -> String -> ResourceError
ResourceLimitExceeded (ResourceScope -> ScopeName
rsName ResourceScope
scope) String
dirName))
    Maybe Int
_ ->
      case ResourceLimits -> Maybe Int
rlMaxConnsTotal ResourceLimits
limits of
        Just Int
lim | Int
totalConns Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
lim ->
          Either ResourceError [(ResourceScope, ResourceUsage)]
-> STM (Either ResourceError [(ResourceScope, ResourceUsage)])
forall a. a -> STM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ResourceError
-> Either ResourceError [(ResourceScope, ResourceUsage)]
forall a b. a -> Either a b
Left (ScopeName -> String -> ResourceError
ResourceLimitExceeded (ResourceScope -> ScopeName
rsName ResourceScope
scope) String
"total connections"))
        Maybe Int
_ -> case ResourceScope -> Maybe ResourceScope
rsParent ResourceScope
scope of
          Maybe ResourceScope
Nothing -> Either ResourceError [(ResourceScope, ResourceUsage)]
-> STM (Either ResourceError [(ResourceScope, ResourceUsage)])
forall a. a -> STM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([(ResourceScope, ResourceUsage)]
-> Either ResourceError [(ResourceScope, ResourceUsage)]
forall a b. b -> Either a b
Right [(ResourceScope
scope, ResourceUsage
newUsage)])
          Just ResourceScope
parent -> do
            parentResult <- ResourceScope
-> Direction
-> STM (Either ResourceError [(ResourceScope, ResourceUsage)])
collectConnUpdates ResourceScope
parent Direction
dir
            case parentResult of
              Left ResourceError
err -> Either ResourceError [(ResourceScope, ResourceUsage)]
-> STM (Either ResourceError [(ResourceScope, ResourceUsage)])
forall a. a -> STM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ResourceError
-> Either ResourceError [(ResourceScope, ResourceUsage)]
forall a b. a -> Either a b
Left ResourceError
err)
              Right [(ResourceScope, ResourceUsage)]
parentUpdates -> Either ResourceError [(ResourceScope, ResourceUsage)]
-> STM (Either ResourceError [(ResourceScope, ResourceUsage)])
forall a. a -> STM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([(ResourceScope, ResourceUsage)]
-> Either ResourceError [(ResourceScope, ResourceUsage)]
forall a b. b -> Either a b
Right ((ResourceScope
scope, ResourceUsage
newUsage) (ResourceScope, ResourceUsage)
-> [(ResourceScope, ResourceUsage)]
-> [(ResourceScope, ResourceUsage)]
forall a. a -> [a] -> [a]
: [(ResourceScope, ResourceUsage)]
parentUpdates))
  where
    connDirLimit :: Direction -> ResourceLimits -> Maybe Int
connDirLimit Direction
Inbound  = ResourceLimits -> Maybe Int
rlMaxConnsInbound
    connDirLimit Direction
Outbound = ResourceLimits -> Maybe Int
rlMaxConnsOutbound

-- Internal: release a connection at this scope and walk up to parent.
releaseConnInScope :: ResourceScope -> Direction -> STM ()
releaseConnInScope :: ResourceScope -> Direction -> STM ()
releaseConnInScope ResourceScope
scope Direction
dir = do
  usage <- TVar ResourceUsage -> STM ResourceUsage
forall a. TVar a -> STM a
readTVar (ResourceScope -> TVar ResourceUsage
rsUsage ResourceScope
scope)
  let newUsage = case Direction
dir of
        Direction
Inbound  -> ResourceUsage
usage { ruConnsInbound = max 0 (ruConnsInbound usage - 1) }
        Direction
Outbound -> ResourceUsage
usage { ruConnsOutbound = max 0 (ruConnsOutbound usage - 1) }
  writeTVar (rsUsage scope) newUsage
  case rsParent scope of
    Maybe ResourceScope
Nothing -> () -> STM ()
forall a. a -> STM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    Just ResourceScope
parent -> ResourceScope -> Direction -> STM ()
releaseConnInScope ResourceScope
parent Direction
dir

-- Internal: two-phase reserve for streams (same pattern as connections).
reserveStreamInScope :: ResourceScope -> Direction -> STM (Either ResourceError ())
reserveStreamInScope :: ResourceScope -> Direction -> STM (Either ResourceError ())
reserveStreamInScope ResourceScope
scope Direction
dir = do
  proposed <- ResourceScope
-> Direction
-> STM (Either ResourceError [(ResourceScope, ResourceUsage)])
collectStreamUpdates ResourceScope
scope Direction
dir
  case proposed of
    Left ResourceError
err -> Either ResourceError () -> STM (Either ResourceError ())
forall a. a -> STM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ResourceError -> Either ResourceError ()
forall a b. a -> Either a b
Left ResourceError
err)
    Right [(ResourceScope, ResourceUsage)]
updates -> do
      ((ResourceScope, ResourceUsage) -> STM ())
-> [(ResourceScope, ResourceUsage)] -> STM ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\(ResourceScope
s, ResourceUsage
u) -> TVar ResourceUsage -> ResourceUsage -> STM ()
forall a. TVar a -> a -> STM ()
writeTVar (ResourceScope -> TVar ResourceUsage
rsUsage ResourceScope
s) ResourceUsage
u) [(ResourceScope, ResourceUsage)]
updates
      Either ResourceError () -> STM (Either ResourceError ())
forall a. a -> STM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (() -> Either ResourceError ()
forall a b. b -> Either a b
Right ())

-- Collect proposed stream updates from leaf to root.
collectStreamUpdates :: ResourceScope -> Direction -> STM (Either ResourceError [(ResourceScope, ResourceUsage)])
collectStreamUpdates :: ResourceScope
-> Direction
-> STM (Either ResourceError [(ResourceScope, ResourceUsage)])
collectStreamUpdates ResourceScope
scope Direction
dir = do
  usage <- TVar ResourceUsage -> STM ResourceUsage
forall a. TVar a -> STM a
readTVar (ResourceScope -> TVar ResourceUsage
rsUsage ResourceScope
scope)
  let (newUsage, checkField, dirName) = case dir of
        Direction
Inbound  -> (ResourceUsage
usage { ruStreamsInbound = ruStreamsInbound usage + 1 },
                     ResourceUsage -> Int
ruStreamsInbound, String
"inbound streams")
        Direction
Outbound -> (ResourceUsage
usage { ruStreamsOutbound = ruStreamsOutbound usage + 1 },
                     ResourceUsage -> Int
ruStreamsOutbound, String
"outbound streams")
      totalStreams = ResourceUsage -> Int
ruStreamsInbound ResourceUsage
newUsage Int -> Int -> Int
forall a. Num a => a -> a -> a
+ ResourceUsage -> Int
ruStreamsOutbound ResourceUsage
newUsage
      limits = ResourceScope -> ResourceLimits
rsLimits ResourceScope
scope
  case streamDirLimit dir limits of
    Just Int
lim | ResourceUsage -> Int
checkField ResourceUsage
newUsage Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
lim ->
      Either ResourceError [(ResourceScope, ResourceUsage)]
-> STM (Either ResourceError [(ResourceScope, ResourceUsage)])
forall a. a -> STM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ResourceError
-> Either ResourceError [(ResourceScope, ResourceUsage)]
forall a b. a -> Either a b
Left (ScopeName -> String -> ResourceError
ResourceLimitExceeded (ResourceScope -> ScopeName
rsName ResourceScope
scope) String
dirName))
    Maybe Int
_ ->
      case ResourceLimits -> Maybe Int
rlMaxStreamsTotal ResourceLimits
limits of
        Just Int
lim | Int
totalStreams Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
lim ->
          Either ResourceError [(ResourceScope, ResourceUsage)]
-> STM (Either ResourceError [(ResourceScope, ResourceUsage)])
forall a. a -> STM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ResourceError
-> Either ResourceError [(ResourceScope, ResourceUsage)]
forall a b. a -> Either a b
Left (ScopeName -> String -> ResourceError
ResourceLimitExceeded (ResourceScope -> ScopeName
rsName ResourceScope
scope) String
"total streams"))
        Maybe Int
_ -> case ResourceScope -> Maybe ResourceScope
rsParent ResourceScope
scope of
          Maybe ResourceScope
Nothing -> Either ResourceError [(ResourceScope, ResourceUsage)]
-> STM (Either ResourceError [(ResourceScope, ResourceUsage)])
forall a. a -> STM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([(ResourceScope, ResourceUsage)]
-> Either ResourceError [(ResourceScope, ResourceUsage)]
forall a b. b -> Either a b
Right [(ResourceScope
scope, ResourceUsage
newUsage)])
          Just ResourceScope
parent -> do
            parentResult <- ResourceScope
-> Direction
-> STM (Either ResourceError [(ResourceScope, ResourceUsage)])
collectStreamUpdates ResourceScope
parent Direction
dir
            case parentResult of
              Left ResourceError
err -> Either ResourceError [(ResourceScope, ResourceUsage)]
-> STM (Either ResourceError [(ResourceScope, ResourceUsage)])
forall a. a -> STM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ResourceError
-> Either ResourceError [(ResourceScope, ResourceUsage)]
forall a b. a -> Either a b
Left ResourceError
err)
              Right [(ResourceScope, ResourceUsage)]
parentUpdates -> Either ResourceError [(ResourceScope, ResourceUsage)]
-> STM (Either ResourceError [(ResourceScope, ResourceUsage)])
forall a. a -> STM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([(ResourceScope, ResourceUsage)]
-> Either ResourceError [(ResourceScope, ResourceUsage)]
forall a b. b -> Either a b
Right ((ResourceScope
scope, ResourceUsage
newUsage) (ResourceScope, ResourceUsage)
-> [(ResourceScope, ResourceUsage)]
-> [(ResourceScope, ResourceUsage)]
forall a. a -> [a] -> [a]
: [(ResourceScope, ResourceUsage)]
parentUpdates))
  where
    streamDirLimit :: Direction -> ResourceLimits -> Maybe Int
streamDirLimit Direction
Inbound  = ResourceLimits -> Maybe Int
rlMaxStreamsInbound
    streamDirLimit Direction
Outbound = ResourceLimits -> Maybe Int
rlMaxStreamsOutbound

-- Internal: release a stream at this scope and walk up to parent.
releaseStreamInScope :: ResourceScope -> Direction -> STM ()
releaseStreamInScope :: ResourceScope -> Direction -> STM ()
releaseStreamInScope ResourceScope
scope Direction
dir = do
  usage <- TVar ResourceUsage -> STM ResourceUsage
forall a. TVar a -> STM a
readTVar (ResourceScope -> TVar ResourceUsage
rsUsage ResourceScope
scope)
  let newUsage = case Direction
dir of
        Direction
Inbound  -> ResourceUsage
usage { ruStreamsInbound = max 0 (ruStreamsInbound usage - 1) }
        Direction
Outbound -> ResourceUsage
usage { ruStreamsOutbound = max 0 (ruStreamsOutbound usage - 1) }
  writeTVar (rsUsage scope) newUsage
  case rsParent scope of
    Maybe ResourceScope
Nothing -> () -> STM ()
forall a. a -> STM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    Just ResourceScope
parent -> ResourceScope -> Direction -> STM ()
releaseStreamInScope ResourceScope
parent Direction
dir