{-# LANGUAGE BangPatterns        #-}
{-# LANGUAGE DataKinds           #-}
{-# LANGUAGE FlexibleContexts    #-}
{-# LANGUAGE GADTs               #-}
{-# LANGUAGE KindSignatures      #-}
{-# LANGUAGE LambdaCase          #-}
{-# LANGUAGE MultiWayIf          #-}
{-# LANGUAGE NamedFieldPuns      #-}
{-# LANGUAGE RankNTypes          #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections       #-}
{-# LANGUAGE TypeApplications    #-}
{-# LANGUAGE TypeOperators       #-}

-- 'runResponder' is using a redundant constraint.
{-# OPTIONS_GHC -Wno-redundant-constraints #-}

-- | Server implementation based on 'ConnectionManager'
--
module Ouroboros.Network.InboundGovernor
  ( InboundGovernorObservableState (..)
  , newObservableStateVar
  , newObservableStateVarIO
  , newObservableStateVarFromSeed
    -- * Run Inbound Protocol Governor
  , inboundGovernor
    -- * Trace
  , InboundGovernorTrace (..)
  , RemoteSt (..)
  , RemoteTransition
  , RemoteTransitionTrace
  , AcceptConnectionsPolicyTrace (..)
    -- * Re-exports
  , Transition' (..)
  , TransitionTrace' (..)
  ) where

import           Control.Exception (SomeAsyncException (..), assert)
import           Control.Monad (foldM, when)
import           Control.Monad.Class.MonadAsync
import qualified Control.Monad.Class.MonadSTM as LazySTM
import           Control.Monad.Class.MonadSTM.Strict
import           Control.Monad.Class.MonadThrow
import           Control.Monad.Class.MonadTime
import           Control.Monad.Class.MonadTimer
import           Control.Tracer (Tracer, traceWith)

import           Data.ByteString.Lazy (ByteString)
import           Data.Cache
import           Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import           Data.Monoid.Synchronisation
import           Data.Void (Void)

import qualified Network.Mux as Mux

import           Ouroboros.Network.Channel (fromChannel)
import           Ouroboros.Network.ConnectionHandler
import           Ouroboros.Network.ConnectionId (ConnectionId (..))
import           Ouroboros.Network.ConnectionManager.Types hiding
                     (TrUnexpectedlyFalseAssertion)
import           Ouroboros.Network.InboundGovernor.ControlChannel
                     (ServerControlChannel)
import qualified Ouroboros.Network.InboundGovernor.ControlChannel as ControlChannel
import           Ouroboros.Network.InboundGovernor.Event
import           Ouroboros.Network.InboundGovernor.State
import           Ouroboros.Network.Mux hiding (ControlMessage)
import           Ouroboros.Network.Server.RateLimiting



-- | Run the server, which consists of the following components:
--
-- * /inbound governor/, it corresponds to p2p-governor on outbound side
-- * /accept loop(s)/, one per given ip address.  We support up to one ipv4
--   address and up to one ipv6 address, i.e. an ipv6 enabled node will run two
--   accept loops on listening on different addresses with shared /inbound governor/.
--
-- The server can be run in either of two 'MuxMode'-es:
--
-- * 'InitiatorResponderMode'
-- * 'ResponderMode'
--
-- The first one is used in data diffusion for /Node-To-Node protocol/, while the
-- other is useful for running a server for the /Node-To-Client protocol/.
--
inboundGovernor :: forall (muxMode :: MuxMode) socket peerAddr versionNumber m a b.
                   ( MonadAsync    m
                   , MonadCatch    m
                   , MonadEvaluate m
                   , MonadThrow    m
                   , MonadThrow    (STM m)
                   , MonadTime     m
                   , MonadTimer    m
                   , MonadMask     m
                   , Ord peerAddr
                   , HasResponder muxMode ~ True
                   )
                => Tracer m (RemoteTransitionTrace peerAddr)
                -> Tracer m (InboundGovernorTrace peerAddr)
                -> ServerControlChannel muxMode peerAddr ByteString m a b
                -> DiffTime -- protocol idle timeout
                -> MuxConnectionManager muxMode socket peerAddr
                                        versionNumber ByteString m a b
                -> StrictTVar m InboundGovernorObservableState
                -> m Void
inboundGovernor :: Tracer m (RemoteTransitionTrace peerAddr)
-> Tracer m (InboundGovernorTrace peerAddr)
-> ServerControlChannel muxMode peerAddr ByteString m a b
-> DiffTime
-> MuxConnectionManager
     muxMode socket peerAddr versionNumber ByteString m a b
-> StrictTVar m InboundGovernorObservableState
-> m Void
inboundGovernor Tracer m (RemoteTransitionTrace peerAddr)
trTracer Tracer m (InboundGovernorTrace peerAddr)
tracer ServerControlChannel muxMode peerAddr ByteString m a b
serverControlChannel DiffTime
inboundIdleTimeout
                MuxConnectionManager
  muxMode socket peerAddr versionNumber ByteString m a b
connectionManager StrictTVar m InboundGovernorObservableState
observableStateVar = do
    -- State needs to be a TVar, otherwise, when catching the exception inside
    -- the loop we do not have access to the most recentversion of the state
    -- and might be truncating transitions.
    StrictTVar m (InboundGovernorState muxMode peerAddr m a b)
st <- STM m (StrictTVar m (InboundGovernorState muxMode peerAddr m a b))
-> m (StrictTVar m (InboundGovernorState muxMode peerAddr m a b))
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically (STM m (StrictTVar m (InboundGovernorState muxMode peerAddr m a b))
 -> m (StrictTVar m (InboundGovernorState muxMode peerAddr m a b)))
-> STM
     m (StrictTVar m (InboundGovernorState muxMode peerAddr m a b))
-> m (StrictTVar m (InboundGovernorState muxMode peerAddr m a b))
forall a b. (a -> b) -> a -> b
$ InboundGovernorState muxMode peerAddr m a b
-> STM
     m (StrictTVar m (InboundGovernorState muxMode peerAddr m a b))
forall (m :: * -> *) a. MonadSTM m => a -> STM m (StrictTVar m a)
newTVar InboundGovernorState muxMode peerAddr m a b
emptyState
    StrictTVar m (InboundGovernorState muxMode peerAddr m a b)
-> m Void
inboundGovernorLoop StrictTVar m (InboundGovernorState muxMode peerAddr m a b)
st
     m Void -> (SomeException -> m Void) -> m Void
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> (e -> m a) -> m a
`catch`
       (\(SomeException
e :: SomeException) -> do
         InboundGovernorState muxMode peerAddr m a b
state <- STM m (InboundGovernorState muxMode peerAddr m a b)
-> m (InboundGovernorState muxMode peerAddr m a b)
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically (STM m (InboundGovernorState muxMode peerAddr m a b)
 -> m (InboundGovernorState muxMode peerAddr m a b))
-> STM m (InboundGovernorState muxMode peerAddr m a b)
-> m (InboundGovernorState muxMode peerAddr m a b)
forall a b. (a -> b) -> a -> b
$ StrictTVar m (InboundGovernorState muxMode peerAddr m a b)
-> STM m (InboundGovernorState muxMode peerAddr m a b)
forall (m :: * -> *) a. MonadSTM m => StrictTVar m a -> STM m a
readTVar StrictTVar m (InboundGovernorState muxMode peerAddr m a b)
st
         Map (ConnectionId peerAddr) ()
_ <- (ConnectionId peerAddr
 -> ConnectionState muxMode peerAddr m a b -> m ())
-> Map
     (ConnectionId peerAddr) (ConnectionState muxMode peerAddr m a b)
-> m (Map (ConnectionId peerAddr) ())
forall (t :: * -> *) k a b.
Applicative t =>
(k -> a -> t b) -> Map k a -> t (Map k b)
Map.traverseWithKey
               (\ConnectionId peerAddr
connId ConnectionState muxMode peerAddr m a b
_ -> do
                 -- Remove the connection from the state so
                 -- mkRemoteTransitionTrace can create the correct state
                 -- transition to Nothing value.
                 let state' :: InboundGovernorState muxMode peerAddr m a b
state' = ConnectionId peerAddr
-> InboundGovernorState muxMode peerAddr m a b
-> InboundGovernorState muxMode peerAddr m a b
forall peerAddr (muxMode :: MuxMode) (m :: * -> *) a b.
Ord peerAddr =>
ConnectionId peerAddr
-> InboundGovernorState muxMode peerAddr m a b
-> InboundGovernorState muxMode peerAddr m a b
unregisterConnection ConnectionId peerAddr
connId InboundGovernorState muxMode peerAddr m a b
state
                 Tracer m (RemoteTransitionTrace peerAddr)
-> RemoteTransitionTrace peerAddr -> m ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer m (RemoteTransitionTrace peerAddr)
trTracer
                           (ConnectionId peerAddr
-> InboundGovernorState muxMode peerAddr m a b
-> InboundGovernorState muxMode peerAddr m a b
-> RemoteTransitionTrace peerAddr
forall peerAddr (muxMode :: MuxMode) (m :: * -> *) a b.
Ord peerAddr =>
ConnectionId peerAddr
-> InboundGovernorState muxMode peerAddr m a b
-> InboundGovernorState muxMode peerAddr m a b
-> RemoteTransitionTrace peerAddr
mkRemoteTransitionTrace ConnectionId peerAddr
connId InboundGovernorState muxMode peerAddr m a b
state InboundGovernorState muxMode peerAddr m a b
state')
               )
               (InboundGovernorState muxMode peerAddr m a b
-> Map
     (ConnectionId peerAddr) (ConnectionState muxMode peerAddr m a b)
forall (muxMode :: MuxMode) peerAddr (m :: * -> *) a b.
InboundGovernorState muxMode peerAddr m a b
-> Map
     (ConnectionId peerAddr) (ConnectionState muxMode peerAddr m a b)
igsConnections InboundGovernorState muxMode peerAddr m a b
state)
         Tracer m (InboundGovernorTrace peerAddr)
-> InboundGovernorTrace peerAddr -> m ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer m (InboundGovernorTrace peerAddr)
tracer (SomeException -> InboundGovernorTrace peerAddr
forall peerAddr. SomeException -> InboundGovernorTrace peerAddr
TrInboundGovernorError SomeException
e)
         SomeException -> m Void
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwIO SomeException
e
       )
  where
    emptyState :: InboundGovernorState muxMode peerAddr m a b
    emptyState :: InboundGovernorState muxMode peerAddr m a b
emptyState = InboundGovernorState :: forall (muxMode :: MuxMode) peerAddr (m :: * -> *) a b.
Map
  (ConnectionId peerAddr) (ConnectionState muxMode peerAddr m a b)
-> StrictTVar m InboundGovernorObservableState
-> Cache InboundGovernorCounters
-> InboundGovernorState muxMode peerAddr m a b
InboundGovernorState {
            igsConnections :: Map
  (ConnectionId peerAddr) (ConnectionState muxMode peerAddr m a b)
igsConnections   = Map
  (ConnectionId peerAddr) (ConnectionState muxMode peerAddr m a b)
forall k a. Map k a
Map.empty,
            igsObservableVar :: StrictTVar m InboundGovernorObservableState
igsObservableVar = StrictTVar m InboundGovernorObservableState
observableStateVar,
            igsCountersCache :: Cache InboundGovernorCounters
igsCountersCache = Cache InboundGovernorCounters
forall a. Monoid a => a
mempty
          }

    -- The inbound protocol governor recursive loop.  The 'igsConnections' is
    -- updated as we recurs.
    --
    inboundGovernorLoop
      :: StrictTVar m (InboundGovernorState muxMode peerAddr m a b)
      -> m Void
    inboundGovernorLoop :: StrictTVar m (InboundGovernorState muxMode peerAddr m a b)
-> m Void
inboundGovernorLoop !StrictTVar m (InboundGovernorState muxMode peerAddr m a b)
st = do
      InboundGovernorState muxMode peerAddr m a b
state <- STM m (InboundGovernorState muxMode peerAddr m a b)
-> m (InboundGovernorState muxMode peerAddr m a b)
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically (STM m (InboundGovernorState muxMode peerAddr m a b)
 -> m (InboundGovernorState muxMode peerAddr m a b))
-> STM m (InboundGovernorState muxMode peerAddr m a b)
-> m (InboundGovernorState muxMode peerAddr m a b)
forall a b. (a -> b) -> a -> b
$ StrictTVar m (InboundGovernorState muxMode peerAddr m a b)
-> STM m (InboundGovernorState muxMode peerAddr m a b)
forall (m :: * -> *) a. MonadSTM m => StrictTVar m a -> STM m a
readTVar StrictTVar m (InboundGovernorState muxMode peerAddr m a b)
st
      (InboundGovernorCounters -> InboundGovernorTrace peerAddr)
-> Tracer m (InboundGovernorTrace peerAddr)
-> Cache InboundGovernorCounters
-> InboundGovernorCounters
-> m ()
forall (m :: * -> *) a b.
(Applicative m, Eq a) =>
(a -> b) -> Tracer m b -> Cache a -> a -> m ()
mapTraceWithCache InboundGovernorCounters -> InboundGovernorTrace peerAddr
forall peerAddr.
InboundGovernorCounters -> InboundGovernorTrace peerAddr
TrInboundGovernorCounters
                        Tracer m (InboundGovernorTrace peerAddr)
tracer
                        (InboundGovernorState muxMode peerAddr m a b
-> Cache InboundGovernorCounters
forall (muxMode :: MuxMode) peerAddr (m :: * -> *) a b.
InboundGovernorState muxMode peerAddr m a b
-> Cache InboundGovernorCounters
igsCountersCache InboundGovernorState muxMode peerAddr m a b
state)
                        (InboundGovernorState muxMode peerAddr m a b
-> InboundGovernorCounters
forall (muxMode :: MuxMode) peerAddr (m :: * -> *) a b.
InboundGovernorState muxMode peerAddr m a b
-> InboundGovernorCounters
inboundGovernorCounters InboundGovernorState muxMode peerAddr m a b
state)
      Tracer m (InboundGovernorTrace peerAddr)
-> InboundGovernorTrace peerAddr -> m ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer m (InboundGovernorTrace peerAddr)
tracer (InboundGovernorTrace peerAddr -> m ())
-> InboundGovernorTrace peerAddr -> m ()
forall a b. (a -> b) -> a -> b
$ Map (ConnectionId peerAddr) RemoteSt
-> InboundGovernorTrace peerAddr
forall peerAddr.
Map (ConnectionId peerAddr) RemoteSt
-> InboundGovernorTrace peerAddr
TrRemoteState (Map (ConnectionId peerAddr) RemoteSt
 -> InboundGovernorTrace peerAddr)
-> Map (ConnectionId peerAddr) RemoteSt
-> InboundGovernorTrace peerAddr
forall a b. (a -> b) -> a -> b
$
            RemoteState m -> RemoteSt
forall (m :: * -> *). RemoteState m -> RemoteSt
mkRemoteSt (RemoteState m -> RemoteSt)
-> (ConnectionState muxMode peerAddr m a b -> RemoteState m)
-> ConnectionState muxMode peerAddr m a b
-> RemoteSt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConnectionState muxMode peerAddr m a b -> RemoteState m
forall (muxMode :: MuxMode) peerAddr (m :: * -> *) a b.
ConnectionState muxMode peerAddr m a b -> RemoteState m
csRemoteState
        (ConnectionState muxMode peerAddr m a b -> RemoteSt)
-> Map
     (ConnectionId peerAddr) (ConnectionState muxMode peerAddr m a b)
-> Map (ConnectionId peerAddr) RemoteSt
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> InboundGovernorState muxMode peerAddr m a b
-> Map
     (ConnectionId peerAddr) (ConnectionState muxMode peerAddr m a b)
forall (muxMode :: MuxMode) peerAddr (m :: * -> *) a b.
InboundGovernorState muxMode peerAddr m a b
-> Map
     (ConnectionId peerAddr) (ConnectionState muxMode peerAddr m a b)
igsConnections InboundGovernorState muxMode peerAddr m a b
state

      Event muxMode peerAddr m a b
event
        <- STM m (Event muxMode peerAddr m a b)
-> m (Event muxMode peerAddr m a b)
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically (STM m (Event muxMode peerAddr m a b)
 -> m (Event muxMode peerAddr m a b))
-> STM m (Event muxMode peerAddr m a b)
-> m (Event muxMode peerAddr m a b)
forall a b. (a -> b) -> a -> b
$ FirstToFinish (STM m) (Event muxMode peerAddr m a b)
-> STM m (Event muxMode peerAddr m a b)
forall (m :: * -> *) a. FirstToFinish m a -> m a
runFirstToFinish (FirstToFinish (STM m) (Event muxMode peerAddr m a b)
 -> STM m (Event muxMode peerAddr m a b))
-> FirstToFinish (STM m) (Event muxMode peerAddr m a b)
-> STM m (Event muxMode peerAddr m a b)
forall a b. (a -> b) -> a -> b
$
               (ConnectionId peerAddr
 -> ConnectionState muxMode peerAddr m a b
 -> FirstToFinish (STM m) (Event muxMode peerAddr m a b))
-> Map
     (ConnectionId peerAddr) (ConnectionState muxMode peerAddr m a b)
-> FirstToFinish (STM m) (Event muxMode peerAddr m a b)
forall m k a. Monoid m => (k -> a -> m) -> Map k a -> m
Map.foldMapWithKey
                 (    ConnectionId peerAddr
-> ConnectionState muxMode peerAddr m a b
-> FirstToFinish (STM m) (Event muxMode peerAddr m a b)
forall (m :: * -> *) (muxMode :: MuxMode) peerAddr a b.
MonadSTM m =>
EventSignal muxMode peerAddr m a b
firstMuxToFinish
                   (ConnectionId peerAddr
 -> ConnectionState muxMode peerAddr m a b
 -> FirstToFinish (STM m) (Event muxMode peerAddr m a b))
-> (ConnectionId peerAddr
    -> ConnectionState muxMode peerAddr m a b
    -> FirstToFinish (STM m) (Event muxMode peerAddr m a b))
-> ConnectionId peerAddr
-> ConnectionState muxMode peerAddr m a b
-> FirstToFinish (STM m) (Event muxMode peerAddr m a b)
forall a. Semigroup a => a -> a -> a
<> ConnectionId peerAddr
-> ConnectionState muxMode peerAddr m a b
-> FirstToFinish (STM m) (Event muxMode peerAddr m a b)
forall (m :: * -> *) (muxMode :: MuxMode) peerAddr a b.
MonadSTM m =>
EventSignal muxMode peerAddr m a b
firstMiniProtocolToFinish
                   (ConnectionId peerAddr
 -> ConnectionState muxMode peerAddr m a b
 -> FirstToFinish (STM m) (Event muxMode peerAddr m a b))
-> (ConnectionId peerAddr
    -> ConnectionState muxMode peerAddr m a b
    -> FirstToFinish (STM m) (Event muxMode peerAddr m a b))
-> ConnectionId peerAddr
-> ConnectionState muxMode peerAddr m a b
-> FirstToFinish (STM m) (Event muxMode peerAddr m a b)
forall a. Semigroup a => a -> a -> a
<> ConnectionId peerAddr
-> ConnectionState muxMode peerAddr m a b
-> FirstToFinish (STM m) (Event muxMode peerAddr m a b)
forall (muxMode :: MuxMode) peerAddr (m :: * -> *) a b.
MonadSTM m =>
EventSignal muxMode peerAddr m a b
firstPeerPromotedToWarm
                   (ConnectionId peerAddr
 -> ConnectionState muxMode peerAddr m a b
 -> FirstToFinish (STM m) (Event muxMode peerAddr m a b))
-> (ConnectionId peerAddr
    -> ConnectionState muxMode peerAddr m a b
    -> FirstToFinish (STM m) (Event muxMode peerAddr m a b))
-> ConnectionId peerAddr
-> ConnectionState muxMode peerAddr m a b
-> FirstToFinish (STM m) (Event muxMode peerAddr m a b)
forall a. Semigroup a => a -> a -> a
<> ConnectionId peerAddr
-> ConnectionState muxMode peerAddr m a b
-> FirstToFinish (STM m) (Event muxMode peerAddr m a b)
forall (muxMode :: MuxMode) peerAddr (m :: * -> *) a b.
MonadSTM m =>
EventSignal muxMode peerAddr m a b
firstPeerPromotedToHot
                   (ConnectionId peerAddr
 -> ConnectionState muxMode peerAddr m a b
 -> FirstToFinish (STM m) (Event muxMode peerAddr m a b))
-> (ConnectionId peerAddr
    -> ConnectionState muxMode peerAddr m a b
    -> FirstToFinish (STM m) (Event muxMode peerAddr m a b))
-> ConnectionId peerAddr
-> ConnectionState muxMode peerAddr m a b
-> FirstToFinish (STM m) (Event muxMode peerAddr m a b)
forall a. Semigroup a => a -> a -> a
<> ConnectionId peerAddr
-> ConnectionState muxMode peerAddr m a b
-> FirstToFinish (STM m) (Event muxMode peerAddr m a b)
forall (muxMode :: MuxMode) peerAddr (m :: * -> *) a b.
MonadSTM m =>
EventSignal muxMode peerAddr m a b
firstPeerDemotedToWarm
                   (ConnectionId peerAddr
 -> ConnectionState muxMode peerAddr m a b
 -> FirstToFinish (STM m) (Event muxMode peerAddr m a b))
-> (ConnectionId peerAddr
    -> ConnectionState muxMode peerAddr m a b
    -> FirstToFinish (STM m) (Event muxMode peerAddr m a b))
-> ConnectionId peerAddr
-> ConnectionState muxMode peerAddr m a b
-> FirstToFinish (STM m) (Event muxMode peerAddr m a b)
forall a. Semigroup a => a -> a -> a
<> ConnectionId peerAddr
-> ConnectionState muxMode peerAddr m a b
-> FirstToFinish (STM m) (Event muxMode peerAddr m a b)
forall (m :: * -> *) (muxMode :: MuxMode) peerAddr a b.
MonadSTM m =>
EventSignal muxMode peerAddr m a b
firstPeerDemotedToCold
                   (ConnectionId peerAddr
 -> ConnectionState muxMode peerAddr m a b
 -> FirstToFinish (STM m) (Event muxMode peerAddr m a b))
-> (ConnectionId peerAddr
    -> ConnectionState muxMode peerAddr m a b
    -> FirstToFinish (STM m) (Event muxMode peerAddr m a b))
-> ConnectionId peerAddr
-> ConnectionState muxMode peerAddr m a b
-> FirstToFinish (STM m) (Event muxMode peerAddr m a b)
forall a. Semigroup a => a -> a -> a
<> ConnectionId peerAddr
-> ConnectionState muxMode peerAddr m a b
-> FirstToFinish (STM m) (Event muxMode peerAddr m a b)
forall (m :: * -> *) (muxMode :: MuxMode) peerAddr a b.
MonadSTM m =>
EventSignal muxMode peerAddr m a b
firstPeerCommitRemote

                   :: EventSignal muxMode peerAddr m a b
                 )
                 (InboundGovernorState muxMode peerAddr m a b
-> Map
     (ConnectionId peerAddr) (ConnectionState muxMode peerAddr m a b)
forall (muxMode :: MuxMode) peerAddr (m :: * -> *) a b.
InboundGovernorState muxMode peerAddr m a b
-> Map
     (ConnectionId peerAddr) (ConnectionState muxMode peerAddr m a b)
igsConnections InboundGovernorState muxMode peerAddr m a b
state)
            FirstToFinish (STM m) (Event muxMode peerAddr m a b)
-> FirstToFinish (STM m) (Event muxMode peerAddr m a b)
-> FirstToFinish (STM m) (Event muxMode peerAddr m a b)
forall a. Semigroup a => a -> a -> a
<> (STM m (Event muxMode peerAddr m a b)
-> FirstToFinish (STM m) (Event muxMode peerAddr m a b)
forall (m :: * -> *) a. m a -> FirstToFinish m a
FirstToFinish (STM m (Event muxMode peerAddr m a b)
 -> FirstToFinish (STM m) (Event muxMode peerAddr m a b))
-> STM m (Event muxMode peerAddr m a b)
-> FirstToFinish (STM m) (Event muxMode peerAddr m a b)
forall a b. (a -> b) -> a -> b
$
                 NewConnection peerAddr (Handle muxMode peerAddr ByteString m a b)
-> Event muxMode peerAddr m a b
forall (muxMode :: MuxMode) peerAddr (m :: * -> *) a b.
NewConnection peerAddr (Handle muxMode peerAddr ByteString m a b)
-> Event muxMode peerAddr m a b
NewConnection (NewConnection peerAddr (Handle muxMode peerAddr ByteString m a b)
 -> Event muxMode peerAddr m a b)
-> STM
     m
     (NewConnection peerAddr (Handle muxMode peerAddr ByteString m a b))
-> STM m (Event muxMode peerAddr m a b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ServerControlChannel muxMode peerAddr ByteString m a b
-> STM
     m
     (NewConnection peerAddr (Handle muxMode peerAddr ByteString m a b))
forall (m :: * -> *) msg. ControlChannel m msg -> STM m msg
ControlChannel.readMessage ServerControlChannel muxMode peerAddr ByteString m a b
serverControlChannel)
      (Maybe (ConnectionId peerAddr)
mbConnId, InboundGovernorState muxMode peerAddr m a b
state') <- case Event muxMode peerAddr m a b
event of
        NewConnection
          -- new connection has been announced by either accept loop or
          -- by connection manager (in which case the connection is in
          -- 'DuplexState').
          (ControlChannel.NewConnection
            Provenance
provenance
            ConnectionId peerAddr
connId
            DataFlow
csDataFlow
            (Handle Mux muxMode m
csMux MuxBundle muxMode ByteString m a b
muxBundle Bundle (StrictTVar m ControlMessage)
_)) -> do

              Tracer m (InboundGovernorTrace peerAddr)
-> InboundGovernorTrace peerAddr -> m ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer m (InboundGovernorTrace peerAddr)
tracer (Provenance
-> ConnectionId peerAddr -> InboundGovernorTrace peerAddr
forall peerAddr.
Provenance
-> ConnectionId peerAddr -> InboundGovernorTrace peerAddr
TrNewConnection Provenance
provenance ConnectionId peerAddr
connId)

              Map
  (ConnectionId peerAddr) (ConnectionState muxMode peerAddr m a b)
igsConnections <- (Maybe (ConnectionState muxMode peerAddr m a b)
 -> m (Maybe (ConnectionState muxMode peerAddr m a b)))
-> ConnectionId peerAddr
-> Map
     (ConnectionId peerAddr) (ConnectionState muxMode peerAddr m a b)
-> m (Map
        (ConnectionId peerAddr) (ConnectionState muxMode peerAddr m a b))
forall (f :: * -> *) k a.
(Functor f, Ord k) =>
(Maybe a -> f (Maybe a)) -> k -> Map k a -> f (Map k a)
Map.alterF
                      (\case
                        -- connection
                        Maybe (ConnectionState muxMode peerAddr m a b)
Nothing -> do
                          let csMPMHot :: [(MiniProtocolNum, MiniProtocolData muxMode m a b)]
csMPMHot =
                                [ ( MiniProtocol muxMode ByteString m a b -> MiniProtocolNum
forall (mode :: MuxMode) bytes (m :: * -> *) a b.
MiniProtocol mode bytes m a b -> MiniProtocolNum
miniProtocolNum MiniProtocol muxMode ByteString m a b
mpH
                                  , MiniProtocol muxMode ByteString m a b
-> ProtocolTemperature -> MiniProtocolData muxMode m a b
forall (muxMode :: MuxMode) (m :: * -> *) a b.
MiniProtocol muxMode ByteString m a b
-> ProtocolTemperature -> MiniProtocolData muxMode m a b
MiniProtocolData MiniProtocol muxMode ByteString m a b
mpH ProtocolTemperature
Hot
                                  )
                                | MiniProtocol muxMode ByteString m a b
mpH <- TokProtocolTemperature 'Hot
-> MuxBundle muxMode ByteString m a b
-> [MiniProtocol muxMode ByteString m a b]
forall (pt :: ProtocolTemperature) a.
TokProtocolTemperature pt -> Bundle a -> a
projectBundle TokProtocolTemperature 'Hot
TokHot MuxBundle muxMode ByteString m a b
muxBundle
                                ]
                              csMPMWarm :: [(MiniProtocolNum, MiniProtocolData muxMode m a b)]
csMPMWarm =
                                [ ( MiniProtocol muxMode ByteString m a b -> MiniProtocolNum
forall (mode :: MuxMode) bytes (m :: * -> *) a b.
MiniProtocol mode bytes m a b -> MiniProtocolNum
miniProtocolNum MiniProtocol muxMode ByteString m a b
mpW
                                  , MiniProtocol muxMode ByteString m a b
-> ProtocolTemperature -> MiniProtocolData muxMode m a b
forall (muxMode :: MuxMode) (m :: * -> *) a b.
MiniProtocol muxMode ByteString m a b
-> ProtocolTemperature -> MiniProtocolData muxMode m a b
MiniProtocolData MiniProtocol muxMode ByteString m a b
mpW ProtocolTemperature
Warm
                                  )
                                | MiniProtocol muxMode ByteString m a b
mpW <- TokProtocolTemperature 'Warm
-> MuxBundle muxMode ByteString m a b
-> [MiniProtocol muxMode ByteString m a b]
forall (pt :: ProtocolTemperature) a.
TokProtocolTemperature pt -> Bundle a -> a
projectBundle TokProtocolTemperature 'Warm
TokWarm MuxBundle muxMode ByteString m a b
muxBundle
                                ]
                              csMPMEstablished :: [(MiniProtocolNum, MiniProtocolData muxMode m a b)]
csMPMEstablished =
                                [ ( MiniProtocol muxMode ByteString m a b -> MiniProtocolNum
forall (mode :: MuxMode) bytes (m :: * -> *) a b.
MiniProtocol mode bytes m a b -> MiniProtocolNum
miniProtocolNum MiniProtocol muxMode ByteString m a b
mpE
                                  , MiniProtocol muxMode ByteString m a b
-> ProtocolTemperature -> MiniProtocolData muxMode m a b
forall (muxMode :: MuxMode) (m :: * -> *) a b.
MiniProtocol muxMode ByteString m a b
-> ProtocolTemperature -> MiniProtocolData muxMode m a b
MiniProtocolData MiniProtocol muxMode ByteString m a b
mpE ProtocolTemperature
Established
                                  )
                                | MiniProtocol muxMode ByteString m a b
mpE <- TokProtocolTemperature 'Established
-> MuxBundle muxMode ByteString m a b
-> [MiniProtocol muxMode ByteString m a b]
forall (pt :: ProtocolTemperature) a.
TokProtocolTemperature pt -> Bundle a -> a
projectBundle TokProtocolTemperature 'Established
TokEstablished MuxBundle muxMode ByteString m a b
muxBundle
                                ]
                              csMiniProtocolMap :: Map MiniProtocolNum (MiniProtocolData muxMode m a b)
csMiniProtocolMap =
                                  [(MiniProtocolNum, MiniProtocolData muxMode m a b)]
-> Map MiniProtocolNum (MiniProtocolData muxMode m a b)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
                                  ([(MiniProtocolNum, MiniProtocolData muxMode m a b)]
csMPMHot [(MiniProtocolNum, MiniProtocolData muxMode m a b)]
-> [(MiniProtocolNum, MiniProtocolData muxMode m a b)]
-> [(MiniProtocolNum, MiniProtocolData muxMode m a b)]
forall a. [a] -> [a] -> [a]
++ [(MiniProtocolNum, MiniProtocolData muxMode m a b)]
csMPMWarm [(MiniProtocolNum, MiniProtocolData muxMode m a b)]
-> [(MiniProtocolNum, MiniProtocolData muxMode m a b)]
-> [(MiniProtocolNum, MiniProtocolData muxMode m a b)]
forall a. [a] -> [a] -> [a]
++ [(MiniProtocolNum, MiniProtocolData muxMode m a b)]
csMPMEstablished)

                          Maybe (Map MiniProtocolNum (STM m (Either SomeException b)))
mCompletionMap
                            <-
                            (Maybe (Map MiniProtocolNum (STM m (Either SomeException b)))
 -> MiniProtocolData muxMode m a b
 -> m (Maybe
         (Map MiniProtocolNum (STM m (Either SomeException b)))))
-> Maybe (Map MiniProtocolNum (STM m (Either SomeException b)))
-> Map MiniProtocolNum (MiniProtocolData muxMode m a b)
-> m (Maybe (Map MiniProtocolNum (STM m (Either SomeException b))))
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM
                              (\Maybe (Map MiniProtocolNum (STM m (Either SomeException b)))
acc MiniProtocolData { MiniProtocol muxMode ByteString m a b
mpdMiniProtocol :: forall (muxMode :: MuxMode) (m :: * -> *) a b.
MiniProtocolData muxMode m a b
-> MiniProtocol muxMode ByteString m a b
mpdMiniProtocol :: MiniProtocol muxMode ByteString m a b
mpdMiniProtocol } -> do
                                 Either SomeException (STM m (Either SomeException b))
result <- Mux muxMode m
-> MiniProtocol muxMode ByteString m a b
-> StartOnDemandOrEagerly
-> m (Either SomeException (STM m (Either SomeException b)))
forall (mode :: MuxMode) (m :: * -> *) a b.
(HasResponder mode ~ 'True, MonadAsync m, MonadCatch m,
 MonadThrow (STM m)) =>
Mux mode m
-> MiniProtocol mode ByteString m a b
-> StartOnDemandOrEagerly
-> m (Either SomeException (STM m (Either SomeException b)))
runResponder
                                             Mux muxMode m
csMux MiniProtocol muxMode ByteString m a b
mpdMiniProtocol
                                             StartOnDemandOrEagerly
Mux.StartOnDemand
                                 case Either SomeException (STM m (Either SomeException b))
result of
                                   -- synchronous exceptions when starting
                                   -- a mini-protocol are non-recoverable; we
                                   -- close the connection and allow the server
                                   -- to continue.
                                   Left SomeException
err -> do
                                     Tracer m (InboundGovernorTrace peerAddr)
-> InboundGovernorTrace peerAddr -> m ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer m (InboundGovernorTrace peerAddr)
tracer (ConnectionId peerAddr
-> MiniProtocolNum
-> SomeException
-> InboundGovernorTrace peerAddr
forall peerAddr.
ConnectionId peerAddr
-> MiniProtocolNum
-> SomeException
-> InboundGovernorTrace peerAddr
TrResponderStartFailure ConnectionId peerAddr
connId (MiniProtocol muxMode ByteString m a b -> MiniProtocolNum
forall (mode :: MuxMode) bytes (m :: * -> *) a b.
MiniProtocol mode bytes m a b -> MiniProtocolNum
miniProtocolNum MiniProtocol muxMode ByteString m a b
mpdMiniProtocol) SomeException
err)
                                     Mux muxMode m -> m ()
forall (m :: * -> *) (mode :: MuxMode).
MonadSTM m =>
Mux mode m -> m ()
Mux.stopMux Mux muxMode m
csMux
                                     Maybe (Map MiniProtocolNum (STM m (Either SomeException b)))
-> m (Maybe (Map MiniProtocolNum (STM m (Either SomeException b))))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Map MiniProtocolNum (STM m (Either SomeException b)))
forall a. Maybe a
Nothing

                                   Right STM m (Either SomeException b)
completion ->  do
                                     let acc' :: Maybe (Map MiniProtocolNum (STM m (Either SomeException b)))
acc' = MiniProtocolNum
-> STM m (Either SomeException b)
-> Map MiniProtocolNum (STM m (Either SomeException b))
-> Map MiniProtocolNum (STM m (Either SomeException b))
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert (MiniProtocol muxMode ByteString m a b -> MiniProtocolNum
forall (mode :: MuxMode) bytes (m :: * -> *) a b.
MiniProtocol mode bytes m a b -> MiniProtocolNum
miniProtocolNum MiniProtocol muxMode ByteString m a b
mpdMiniProtocol)
                                                           STM m (Either SomeException b)
completion
                                            (Map MiniProtocolNum (STM m (Either SomeException b))
 -> Map MiniProtocolNum (STM m (Either SomeException b)))
-> Maybe (Map MiniProtocolNum (STM m (Either SomeException b)))
-> Maybe (Map MiniProtocolNum (STM m (Either SomeException b)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Map MiniProtocolNum (STM m (Either SomeException b)))
acc
                                     -- force under lazy 'Maybe'
                                     case Maybe (Map MiniProtocolNum (STM m (Either SomeException b)))
acc' of
                                       Just !Map MiniProtocolNum (STM m (Either SomeException b))
_ -> Maybe (Map MiniProtocolNum (STM m (Either SomeException b)))
-> m (Maybe (Map MiniProtocolNum (STM m (Either SomeException b))))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Map MiniProtocolNum (STM m (Either SomeException b)))
acc'
                                       Maybe (Map MiniProtocolNum (STM m (Either SomeException b)))
Nothing -> Maybe (Map MiniProtocolNum (STM m (Either SomeException b)))
-> m (Maybe (Map MiniProtocolNum (STM m (Either SomeException b))))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Map MiniProtocolNum (STM m (Either SomeException b)))
acc'
                              )
                              (Map MiniProtocolNum (STM m (Either SomeException b))
-> Maybe (Map MiniProtocolNum (STM m (Either SomeException b)))
forall a. a -> Maybe a
Just Map MiniProtocolNum (STM m (Either SomeException b))
forall k a. Map k a
Map.empty)
                              Map MiniProtocolNum (MiniProtocolData muxMode m a b)
csMiniProtocolMap

                          case Maybe (Map MiniProtocolNum (STM m (Either SomeException b)))
mCompletionMap of
                            -- there was an error when starting one of the
                            -- responders, we let the server continue without this
                            -- connection.
                            Maybe (Map MiniProtocolNum (STM m (Either SomeException b)))
Nothing -> Maybe (ConnectionState muxMode peerAddr m a b)
-> m (Maybe (ConnectionState muxMode peerAddr m a b))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (ConnectionState muxMode peerAddr m a b)
forall a. Maybe a
Nothing

                            Just Map MiniProtocolNum (STM m (Either SomeException b))
csCompletionMap -> do
                              TVar m Bool
v <- DiffTime -> m (TVar m Bool)
forall (m :: * -> *). MonadTimer m => DiffTime -> m (TVar m Bool)
registerDelay DiffTime
inboundIdleTimeout
                              let -- initial state is 'RemoteIdle', if the remote end will not
                                  -- start any responders this will unregister the inbound side.
                                  csRemoteState :: RemoteState m
                                  csRemoteState :: RemoteState m
csRemoteState = STM m () -> RemoteState m
forall (m :: * -> *). STM m () -> RemoteState m
RemoteIdle (TVar m Bool -> STM m Bool
forall (m :: * -> *) a. MonadSTM m => TVar m a -> STM m a
LazySTM.readTVar TVar m Bool
v STM m Bool -> (Bool -> STM m ()) -> STM m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Bool -> STM m ()
forall (m :: * -> *). MonadSTM m => Bool -> STM m ()
check)

                                  connState :: ConnectionState muxMode peerAddr m a b
connState = ConnectionState :: forall (muxMode :: MuxMode) peerAddr (m :: * -> *) a b.
Mux muxMode m
-> DataFlow
-> Map MiniProtocolNum (MiniProtocolData muxMode m a b)
-> Map MiniProtocolNum (STM m (Either SomeException b))
-> RemoteState m
-> ConnectionState muxMode peerAddr m a b
ConnectionState {
                                      Mux muxMode m
csMux :: Mux muxMode m
csMux :: Mux muxMode m
csMux,
                                      DataFlow
csDataFlow :: DataFlow
csDataFlow :: DataFlow
csDataFlow,
                                      Map MiniProtocolNum (MiniProtocolData muxMode m a b)
csMiniProtocolMap :: Map MiniProtocolNum (MiniProtocolData muxMode m a b)
csMiniProtocolMap :: Map MiniProtocolNum (MiniProtocolData muxMode m a b)
csMiniProtocolMap,
                                      Map MiniProtocolNum (STM m (Either SomeException b))
csCompletionMap :: Map MiniProtocolNum (STM m (Either SomeException b))
csCompletionMap :: Map MiniProtocolNum (STM m (Either SomeException b))
csCompletionMap,
                                      RemoteState m
csRemoteState :: RemoteState m
csRemoteState :: RemoteState m
csRemoteState
                                    }

                              Maybe (ConnectionState muxMode peerAddr m a b)
-> m (Maybe (ConnectionState muxMode peerAddr m a b))
forall (m :: * -> *) a. Monad m => a -> m a
return (ConnectionState muxMode peerAddr m a b
-> Maybe (ConnectionState muxMode peerAddr m a b)
forall a. a -> Maybe a
Just ConnectionState muxMode peerAddr m a b
connState)

                        -- inbound governor might be notified about a connection
                        -- which is already tracked.  In such case we preserve its
                        -- state.
                        --
                        -- In particular we preserve an ongoing timeout on
                        -- 'RemoteIdle' state.
                        Just ConnectionState muxMode peerAddr m a b
connState -> Maybe (ConnectionState muxMode peerAddr m a b)
-> m (Maybe (ConnectionState muxMode peerAddr m a b))
forall (m :: * -> *) a. Monad m => a -> m a
return (ConnectionState muxMode peerAddr m a b
-> Maybe (ConnectionState muxMode peerAddr m a b)
forall a. a -> Maybe a
Just ConnectionState muxMode peerAddr m a b
connState)

                      )
                      ConnectionId peerAddr
connId
                      (InboundGovernorState muxMode peerAddr m a b
-> Map
     (ConnectionId peerAddr) (ConnectionState muxMode peerAddr m a b)
forall (muxMode :: MuxMode) peerAddr (m :: * -> *) a b.
InboundGovernorState muxMode peerAddr m a b
-> Map
     (ConnectionId peerAddr) (ConnectionState muxMode peerAddr m a b)
igsConnections InboundGovernorState muxMode peerAddr m a b
state)


              -- update state and continue the recursive loop
              let state' :: InboundGovernorState muxMode peerAddr m a b
state' = InboundGovernorState muxMode peerAddr m a b
state { Map
  (ConnectionId peerAddr) (ConnectionState muxMode peerAddr m a b)
igsConnections :: Map
  (ConnectionId peerAddr) (ConnectionState muxMode peerAddr m a b)
igsConnections :: Map
  (ConnectionId peerAddr) (ConnectionState muxMode peerAddr m a b)
igsConnections }
              (Maybe (ConnectionId peerAddr),
 InboundGovernorState muxMode peerAddr m a b)
-> m (Maybe (ConnectionId peerAddr),
      InboundGovernorState muxMode peerAddr m a b)
forall (m :: * -> *) a. Monad m => a -> m a
return (ConnectionId peerAddr -> Maybe (ConnectionId peerAddr)
forall a. a -> Maybe a
Just ConnectionId peerAddr
connId, InboundGovernorState muxMode peerAddr m a b
state')

        MuxFinished ConnectionId peerAddr
connId Maybe SomeException
merr -> do

          case Maybe SomeException
merr of
            Maybe SomeException
Nothing  -> Tracer m (InboundGovernorTrace peerAddr)
-> InboundGovernorTrace peerAddr -> m ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer m (InboundGovernorTrace peerAddr)
tracer (ConnectionId peerAddr -> InboundGovernorTrace peerAddr
forall peerAddr.
ConnectionId peerAddr -> InboundGovernorTrace peerAddr
TrMuxCleanExit ConnectionId peerAddr
connId)
            Just SomeException
err -> Tracer m (InboundGovernorTrace peerAddr)
-> InboundGovernorTrace peerAddr -> m ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer m (InboundGovernorTrace peerAddr)
tracer (ConnectionId peerAddr
-> SomeException -> InboundGovernorTrace peerAddr
forall peerAddr.
ConnectionId peerAddr
-> SomeException -> InboundGovernorTrace peerAddr
TrMuxErrored ConnectionId peerAddr
connId SomeException
err)

          -- the connection manager does should realise this on itself.
          let state' :: InboundGovernorState muxMode peerAddr m a b
state' = ConnectionId peerAddr
-> InboundGovernorState muxMode peerAddr m a b
-> InboundGovernorState muxMode peerAddr m a b
forall peerAddr (muxMode :: MuxMode) (m :: * -> *) a b.
Ord peerAddr =>
ConnectionId peerAddr
-> InboundGovernorState muxMode peerAddr m a b
-> InboundGovernorState muxMode peerAddr m a b
unregisterConnection ConnectionId peerAddr
connId InboundGovernorState muxMode peerAddr m a b
state
          (Maybe (ConnectionId peerAddr),
 InboundGovernorState muxMode peerAddr m a b)
-> m (Maybe (ConnectionId peerAddr),
      InboundGovernorState muxMode peerAddr m a b)
forall (m :: * -> *) a. Monad m => a -> m a
return (ConnectionId peerAddr -> Maybe (ConnectionId peerAddr)
forall a. a -> Maybe a
Just ConnectionId peerAddr
connId, InboundGovernorState muxMode peerAddr m a b
state')

        MiniProtocolTerminated
          Terminated {
              ConnectionId peerAddr
tConnId :: forall (muxMode :: MuxMode) peerAddr (m :: * -> *) a b.
Terminated muxMode peerAddr m a b -> ConnectionId peerAddr
tConnId :: ConnectionId peerAddr
tConnId,
              Mux muxMode m
tMux :: forall (muxMode :: MuxMode) peerAddr (m :: * -> *) a b.
Terminated muxMode peerAddr m a b -> Mux muxMode m
tMux :: Mux muxMode m
tMux,
              tMiniProtocolData :: forall (muxMode :: MuxMode) peerAddr (m :: * -> *) a b.
Terminated muxMode peerAddr m a b -> MiniProtocolData muxMode m a b
tMiniProtocolData = MiniProtocolData { MiniProtocol muxMode ByteString m a b
mpdMiniProtocol :: MiniProtocol muxMode ByteString m a b
mpdMiniProtocol :: forall (muxMode :: MuxMode) (m :: * -> *) a b.
MiniProtocolData muxMode m a b
-> MiniProtocol muxMode ByteString m a b
mpdMiniProtocol },
              Either SomeException b
tResult :: forall (muxMode :: MuxMode) peerAddr (m :: * -> *) a b.
Terminated muxMode peerAddr m a b -> Either SomeException b
tResult :: Either SomeException b
tResult
            } ->
          let num :: MiniProtocolNum
num = MiniProtocol muxMode ByteString m a b -> MiniProtocolNum
forall (mode :: MuxMode) bytes (m :: * -> *) a b.
MiniProtocol mode bytes m a b -> MiniProtocolNum
miniProtocolNum MiniProtocol muxMode ByteString m a b
mpdMiniProtocol in
          case Either SomeException b
tResult of
            Left SomeException
e -> do
              -- a mini-protocol errored.  In this case mux will shutdown, and
              -- the connection manager will tear down the socket.  We can just
              -- forget the connection from 'InboundGovernorState'.
              Tracer m (InboundGovernorTrace peerAddr)
-> InboundGovernorTrace peerAddr -> m ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer m (InboundGovernorTrace peerAddr)
tracer (InboundGovernorTrace peerAddr -> m ())
-> InboundGovernorTrace peerAddr -> m ()
forall a b. (a -> b) -> a -> b
$
                ConnectionId peerAddr
-> MiniProtocolNum
-> SomeException
-> InboundGovernorTrace peerAddr
forall peerAddr.
ConnectionId peerAddr
-> MiniProtocolNum
-> SomeException
-> InboundGovernorTrace peerAddr
TrResponderErrored ConnectionId peerAddr
tConnId MiniProtocolNum
num SomeException
e

              let state' :: InboundGovernorState muxMode peerAddr m a b
state' = ConnectionId peerAddr
-> InboundGovernorState muxMode peerAddr m a b
-> InboundGovernorState muxMode peerAddr m a b
forall peerAddr (muxMode :: MuxMode) (m :: * -> *) a b.
Ord peerAddr =>
ConnectionId peerAddr
-> InboundGovernorState muxMode peerAddr m a b
-> InboundGovernorState muxMode peerAddr m a b
unregisterConnection ConnectionId peerAddr
tConnId InboundGovernorState muxMode peerAddr m a b
state
              (Maybe (ConnectionId peerAddr),
 InboundGovernorState muxMode peerAddr m a b)
-> m (Maybe (ConnectionId peerAddr),
      InboundGovernorState muxMode peerAddr m a b)
forall (m :: * -> *) a. Monad m => a -> m a
return (ConnectionId peerAddr -> Maybe (ConnectionId peerAddr)
forall a. a -> Maybe a
Just ConnectionId peerAddr
tConnId, InboundGovernorState muxMode peerAddr m a b
state')

            Right b
_ -> do
              Either SomeException (STM m (Either SomeException b))
result
                <- Mux muxMode m
-> MiniProtocol muxMode ByteString m a b
-> StartOnDemandOrEagerly
-> m (Either SomeException (STM m (Either SomeException b)))
forall (mode :: MuxMode) (m :: * -> *) a b.
(HasResponder mode ~ 'True, MonadAsync m, MonadCatch m,
 MonadThrow (STM m)) =>
Mux mode m
-> MiniProtocol mode ByteString m a b
-> StartOnDemandOrEagerly
-> m (Either SomeException (STM m (Either SomeException b)))
runResponder Mux muxMode m
tMux MiniProtocol muxMode ByteString m a b
mpdMiniProtocol StartOnDemandOrEagerly
Mux.StartOnDemand
              case Either SomeException (STM m (Either SomeException b))
result of
                Right STM m (Either SomeException b)
completionAction -> do
                  Tracer m (InboundGovernorTrace peerAddr)
-> InboundGovernorTrace peerAddr -> m ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer m (InboundGovernorTrace peerAddr)
tracer (ConnectionId peerAddr
-> MiniProtocolNum -> InboundGovernorTrace peerAddr
forall peerAddr.
ConnectionId peerAddr
-> MiniProtocolNum -> InboundGovernorTrace peerAddr
TrResponderRestarted ConnectionId peerAddr
tConnId MiniProtocolNum
num)
                  let state' :: InboundGovernorState muxMode peerAddr m a b
state' = ConnectionId peerAddr
-> MiniProtocolNum
-> STM m (Either SomeException b)
-> InboundGovernorState muxMode peerAddr m a b
-> InboundGovernorState muxMode peerAddr m a b
forall peerAddr (m :: * -> *) b (muxMode :: MuxMode) a.
Ord peerAddr =>
ConnectionId peerAddr
-> MiniProtocolNum
-> STM m (Either SomeException b)
-> InboundGovernorState muxMode peerAddr m a b
-> InboundGovernorState muxMode peerAddr m a b
updateMiniProtocol ConnectionId peerAddr
tConnId MiniProtocolNum
num STM m (Either SomeException b)
completionAction
                             (InboundGovernorState muxMode peerAddr m a b
 -> InboundGovernorState muxMode peerAddr m a b)
-> InboundGovernorState muxMode peerAddr m a b
-> InboundGovernorState muxMode peerAddr m a b
forall a b. (a -> b) -> a -> b
$ InboundGovernorState muxMode peerAddr m a b
state
                  (Maybe (ConnectionId peerAddr),
 InboundGovernorState muxMode peerAddr m a b)
-> m (Maybe (ConnectionId peerAddr),
      InboundGovernorState muxMode peerAddr m a b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (ConnectionId peerAddr)
forall a. Maybe a
Nothing, InboundGovernorState muxMode peerAddr m a b
state')

                Left SomeException
err -> do
                  -- there is no way to recover from synchronous exceptions; we
                  -- stop mux which allows to close resources held by
                  -- connection manager.
                  Tracer m (InboundGovernorTrace peerAddr)
-> InboundGovernorTrace peerAddr -> m ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer m (InboundGovernorTrace peerAddr)
tracer (ConnectionId peerAddr
-> MiniProtocolNum
-> SomeException
-> InboundGovernorTrace peerAddr
forall peerAddr.
ConnectionId peerAddr
-> MiniProtocolNum
-> SomeException
-> InboundGovernorTrace peerAddr
TrResponderStartFailure ConnectionId peerAddr
tConnId MiniProtocolNum
num SomeException
err)
                  Mux muxMode m -> m ()
forall (m :: * -> *) (mode :: MuxMode).
MonadSTM m =>
Mux mode m -> m ()
Mux.stopMux Mux muxMode m
tMux

                  let state' :: InboundGovernorState muxMode peerAddr m a b
state' = ConnectionId peerAddr
-> InboundGovernorState muxMode peerAddr m a b
-> InboundGovernorState muxMode peerAddr m a b
forall peerAddr (muxMode :: MuxMode) (m :: * -> *) a b.
Ord peerAddr =>
ConnectionId peerAddr
-> InboundGovernorState muxMode peerAddr m a b
-> InboundGovernorState muxMode peerAddr m a b
unregisterConnection ConnectionId peerAddr
tConnId InboundGovernorState muxMode peerAddr m a b
state

                  (Maybe (ConnectionId peerAddr),
 InboundGovernorState muxMode peerAddr m a b)
-> m (Maybe (ConnectionId peerAddr),
      InboundGovernorState muxMode peerAddr m a b)
forall (m :: * -> *) a. Monad m => a -> m a
return (ConnectionId peerAddr -> Maybe (ConnectionId peerAddr)
forall a. a -> Maybe a
Just ConnectionId peerAddr
tConnId, InboundGovernorState muxMode peerAddr m a b
state')


        WaitIdleRemote ConnectionId peerAddr
connId -> do
          -- @
          --    DemotedToCold^{dataFlow}_{Remote} : InboundState Duplex
          --                                      → InboundIdleState Duplex
          -- @
          OperationResult AbstractState
res <- MuxConnectionManager
  muxMode socket peerAddr versionNumber ByteString m a b
-> peerAddr -> m (OperationResult AbstractState)
forall (muxMode :: MuxMode) socket peerAddr handle handleError
       (m :: * -> *).
(HasResponder muxMode ~ 'True) =>
ConnectionManager muxMode socket peerAddr handle handleError m
-> peerAddr -> m (OperationResult AbstractState)
demotedToColdRemote MuxConnectionManager
  muxMode socket peerAddr versionNumber ByteString m a b
connectionManager
                                     (ConnectionId peerAddr -> peerAddr
forall addr. ConnectionId addr -> addr
remoteAddress ConnectionId peerAddr
connId)
          Tracer m (InboundGovernorTrace peerAddr)
-> InboundGovernorTrace peerAddr -> m ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer m (InboundGovernorTrace peerAddr)
tracer (ConnectionId peerAddr
-> OperationResult AbstractState -> InboundGovernorTrace peerAddr
forall peerAddr.
ConnectionId peerAddr
-> OperationResult AbstractState -> InboundGovernorTrace peerAddr
TrWaitIdleRemote ConnectionId peerAddr
connId OperationResult AbstractState
res)
          case OperationResult AbstractState
res of
            TerminatedConnection {} -> do
              let state' :: InboundGovernorState muxMode peerAddr m a b
state' = ConnectionId peerAddr
-> InboundGovernorState muxMode peerAddr m a b
-> InboundGovernorState muxMode peerAddr m a b
forall peerAddr (muxMode :: MuxMode) (m :: * -> *) a b.
Ord peerAddr =>
ConnectionId peerAddr
-> InboundGovernorState muxMode peerAddr m a b
-> InboundGovernorState muxMode peerAddr m a b
unregisterConnection ConnectionId peerAddr
connId InboundGovernorState muxMode peerAddr m a b
state
              (Maybe (ConnectionId peerAddr),
 InboundGovernorState muxMode peerAddr m a b)
-> m (Maybe (ConnectionId peerAddr),
      InboundGovernorState muxMode peerAddr m a b)
forall (m :: * -> *) a. Monad m => a -> m a
return (ConnectionId peerAddr -> Maybe (ConnectionId peerAddr)
forall a. a -> Maybe a
Just ConnectionId peerAddr
connId, InboundGovernorState muxMode peerAddr m a b
state')
            OperationSuccess {}  -> do
              TVar m Bool
v <- DiffTime -> m (TVar m Bool)
forall (m :: * -> *). MonadTimer m => DiffTime -> m (TVar m Bool)
registerDelay DiffTime
inboundIdleTimeout
              let timeoutSTM :: STM m ()
                  !timeoutSTM :: STM m ()
timeoutSTM = TVar m Bool -> STM m Bool
forall (m :: * -> *) a. MonadSTM m => TVar m a -> STM m a
LazySTM.readTVar TVar m Bool
v STM m Bool -> (Bool -> STM m ()) -> STM m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Bool -> STM m ()
forall (m :: * -> *). MonadSTM m => Bool -> STM m ()
check

              let state' :: InboundGovernorState muxMode peerAddr m a b
state' = ConnectionId peerAddr
-> RemoteState m
-> InboundGovernorState muxMode peerAddr m a b
-> InboundGovernorState muxMode peerAddr m a b
forall peerAddr (m :: * -> *) (muxMode :: MuxMode) a b.
Ord peerAddr =>
ConnectionId peerAddr
-> RemoteState m
-> InboundGovernorState muxMode peerAddr m a b
-> InboundGovernorState muxMode peerAddr m a b
updateRemoteState ConnectionId peerAddr
connId (STM m () -> RemoteState m
forall (m :: * -> *). STM m () -> RemoteState m
RemoteIdle STM m ()
timeoutSTM) InboundGovernorState muxMode peerAddr m a b
state

              (Maybe (ConnectionId peerAddr),
 InboundGovernorState muxMode peerAddr m a b)
-> m (Maybe (ConnectionId peerAddr),
      InboundGovernorState muxMode peerAddr m a b)
forall (m :: * -> *) a. Monad m => a -> m a
return (ConnectionId peerAddr -> Maybe (ConnectionId peerAddr)
forall a. a -> Maybe a
Just ConnectionId peerAddr
connId, InboundGovernorState muxMode peerAddr m a b
state')
            UnsupportedState {} ->
              (Maybe (ConnectionId peerAddr),
 InboundGovernorState muxMode peerAddr m a b)
-> m (Maybe (ConnectionId peerAddr),
      InboundGovernorState muxMode peerAddr m a b)
forall (m :: * -> *) a. Monad m => a -> m a
return (ConnectionId peerAddr -> Maybe (ConnectionId peerAddr)
forall a. a -> Maybe a
Just ConnectionId peerAddr
connId, InboundGovernorState muxMode peerAddr m a b
state)

        -- @
        --    PromotedToWarm^{Duplex}_{Remote}
        -- @
        -- or
        -- @
        --    Awake^{dataFlow}_{Remote}
        -- @
        --
        -- Note: the 'AwakeRemote' is detected as soon as mux detects any
        -- traffic.  This means that we'll observe this transition also if the
        -- first message that arrives is terminating a mini-protocol.
        AwakeRemote ConnectionId peerAddr
connId -> do
          -- notify the connection manager about the transition
          OperationResult AbstractState
res <- MuxConnectionManager
  muxMode socket peerAddr versionNumber ByteString m a b
-> peerAddr -> m (OperationResult AbstractState)
forall (muxMode :: MuxMode) socket peerAddr handle handleError
       (m :: * -> *).
(HasResponder muxMode ~ 'True) =>
ConnectionManager muxMode socket peerAddr handle handleError m
-> peerAddr -> m (OperationResult AbstractState)
promotedToWarmRemote MuxConnectionManager
  muxMode socket peerAddr versionNumber ByteString m a b
connectionManager
                                      (ConnectionId peerAddr -> peerAddr
forall addr. ConnectionId addr -> addr
remoteAddress ConnectionId peerAddr
connId)
          Tracer m (InboundGovernorTrace peerAddr)
-> InboundGovernorTrace peerAddr -> m ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer m (InboundGovernorTrace peerAddr)
tracer (ConnectionId peerAddr
-> OperationResult AbstractState -> InboundGovernorTrace peerAddr
forall peerAddr.
ConnectionId peerAddr
-> OperationResult AbstractState -> InboundGovernorTrace peerAddr
TrPromotedToWarmRemote ConnectionId peerAddr
connId OperationResult AbstractState
res)

          Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (OperationResult AbstractState -> AbstractState
resultInState OperationResult AbstractState
res AbstractState -> AbstractState -> Bool
forall a. Eq a => a -> a -> Bool
== AbstractState
UnknownConnectionSt) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
            Tracer m (InboundGovernorTrace peerAddr)
-> InboundGovernorTrace peerAddr -> m ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer m (InboundGovernorTrace peerAddr)
tracer (IGAssertionLocation peerAddr -> InboundGovernorTrace peerAddr
forall peerAddr.
IGAssertionLocation peerAddr -> InboundGovernorTrace peerAddr
TrUnexpectedlyFalseAssertion
                                (Maybe (ConnectionId peerAddr)
-> AbstractState -> IGAssertionLocation peerAddr
forall peerAddr.
Maybe (ConnectionId peerAddr)
-> AbstractState -> IGAssertionLocation peerAddr
InboundGovernorLoop
                                  (ConnectionId peerAddr -> Maybe (ConnectionId peerAddr)
forall a. a -> Maybe a
Just ConnectionId peerAddr
connId)
                                  AbstractState
UnknownConnectionSt)
                             )
            Any -> Any
_ <- (Any -> Any) -> m (Any -> Any)
forall (m :: * -> *) a. MonadEvaluate m => a -> m a
evaluate (Bool -> Any -> Any
forall a. HasCallStack => Bool -> a -> a
assert Bool
False)
            () -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

          let state' :: InboundGovernorState muxMode peerAddr m a b
state' = ConnectionId peerAddr
-> RemoteState m
-> InboundGovernorState muxMode peerAddr m a b
-> InboundGovernorState muxMode peerAddr m a b
forall peerAddr (m :: * -> *) (muxMode :: MuxMode) a b.
Ord peerAddr =>
ConnectionId peerAddr
-> RemoteState m
-> InboundGovernorState muxMode peerAddr m a b
-> InboundGovernorState muxMode peerAddr m a b
updateRemoteState
                         ConnectionId peerAddr
connId
                         RemoteState m
forall (m :: * -> *). RemoteState m
RemoteWarm
                         InboundGovernorState muxMode peerAddr m a b
state

          (Maybe (ConnectionId peerAddr),
 InboundGovernorState muxMode peerAddr m a b)
-> m (Maybe (ConnectionId peerAddr),
      InboundGovernorState muxMode peerAddr m a b)
forall (m :: * -> *) a. Monad m => a -> m a
return (ConnectionId peerAddr -> Maybe (ConnectionId peerAddr)
forall a. a -> Maybe a
Just ConnectionId peerAddr
connId, InboundGovernorState muxMode peerAddr m a b
state')

        RemotePromotedToHot ConnectionId peerAddr
connId -> do
          Tracer m (InboundGovernorTrace peerAddr)
-> InboundGovernorTrace peerAddr -> m ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer m (InboundGovernorTrace peerAddr)
tracer (ConnectionId peerAddr -> InboundGovernorTrace peerAddr
forall peerAddr.
ConnectionId peerAddr -> InboundGovernorTrace peerAddr
TrPromotedToHotRemote ConnectionId peerAddr
connId)
          let state' :: InboundGovernorState muxMode peerAddr m a b
state' = ConnectionId peerAddr
-> RemoteState m
-> InboundGovernorState muxMode peerAddr m a b
-> InboundGovernorState muxMode peerAddr m a b
forall peerAddr (m :: * -> *) (muxMode :: MuxMode) a b.
Ord peerAddr =>
ConnectionId peerAddr
-> RemoteState m
-> InboundGovernorState muxMode peerAddr m a b
-> InboundGovernorState muxMode peerAddr m a b
updateRemoteState ConnectionId peerAddr
connId RemoteState m
forall (m :: * -> *). RemoteState m
RemoteHot InboundGovernorState muxMode peerAddr m a b
state

          (Maybe (ConnectionId peerAddr),
 InboundGovernorState muxMode peerAddr m a b)
-> m (Maybe (ConnectionId peerAddr),
      InboundGovernorState muxMode peerAddr m a b)
forall (m :: * -> *) a. Monad m => a -> m a
return (ConnectionId peerAddr -> Maybe (ConnectionId peerAddr)
forall a. a -> Maybe a
Just ConnectionId peerAddr
connId, InboundGovernorState muxMode peerAddr m a b
state')

        RemoteDemotedToWarm ConnectionId peerAddr
connId -> do
          Tracer m (InboundGovernorTrace peerAddr)
-> InboundGovernorTrace peerAddr -> m ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer m (InboundGovernorTrace peerAddr)
tracer (ConnectionId peerAddr -> InboundGovernorTrace peerAddr
forall peerAddr.
ConnectionId peerAddr -> InboundGovernorTrace peerAddr
TrDemotedToWarmRemote ConnectionId peerAddr
connId)
          let state' :: InboundGovernorState muxMode peerAddr m a b
state' = ConnectionId peerAddr
-> RemoteState m
-> InboundGovernorState muxMode peerAddr m a b
-> InboundGovernorState muxMode peerAddr m a b
forall peerAddr (m :: * -> *) (muxMode :: MuxMode) a b.
Ord peerAddr =>
ConnectionId peerAddr
-> RemoteState m
-> InboundGovernorState muxMode peerAddr m a b
-> InboundGovernorState muxMode peerAddr m a b
updateRemoteState ConnectionId peerAddr
connId RemoteState m
forall (m :: * -> *). RemoteState m
RemoteWarm InboundGovernorState muxMode peerAddr m a b
state

          (Maybe (ConnectionId peerAddr),
 InboundGovernorState muxMode peerAddr m a b)
-> m (Maybe (ConnectionId peerAddr),
      InboundGovernorState muxMode peerAddr m a b)
forall (m :: * -> *) a. Monad m => a -> m a
return (ConnectionId peerAddr -> Maybe (ConnectionId peerAddr)
forall a. a -> Maybe a
Just ConnectionId peerAddr
connId, InboundGovernorState muxMode peerAddr m a b
state')

        CommitRemote ConnectionId peerAddr
connId -> do
          OperationResult DemotedToColdRemoteTr
res <- MuxConnectionManager
  muxMode socket peerAddr versionNumber ByteString m a b
-> peerAddr -> m (OperationResult DemotedToColdRemoteTr)
forall (muxMode :: MuxMode) socket peerAddr handle handleError
       (m :: * -> *).
(HasResponder muxMode ~ 'True) =>
ConnectionManager muxMode socket peerAddr handle handleError m
-> peerAddr -> m (OperationResult DemotedToColdRemoteTr)
unregisterInboundConnection MuxConnectionManager
  muxMode socket peerAddr versionNumber ByteString m a b
connectionManager
                                             (ConnectionId peerAddr -> peerAddr
forall addr. ConnectionId addr -> addr
remoteAddress ConnectionId peerAddr
connId)
          Tracer m (InboundGovernorTrace peerAddr)
-> InboundGovernorTrace peerAddr -> m ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer m (InboundGovernorTrace peerAddr)
tracer (InboundGovernorTrace peerAddr -> m ())
-> InboundGovernorTrace peerAddr -> m ()
forall a b. (a -> b) -> a -> b
$ ConnectionId peerAddr
-> OperationResult DemotedToColdRemoteTr
-> InboundGovernorTrace peerAddr
forall peerAddr.
ConnectionId peerAddr
-> OperationResult DemotedToColdRemoteTr
-> InboundGovernorTrace peerAddr
TrDemotedToColdRemote ConnectionId peerAddr
connId OperationResult DemotedToColdRemoteTr
res
          case OperationResult DemotedToColdRemoteTr
res of
            UnsupportedState {} -> do
              -- 'inState' can be either:
              -- @'UnknownConnection'@,
              -- @'InReservedOutboundState'@,
              -- @'InUnnegotiatedState',
              -- @'InOutboundState' 'Unidirectional'@,
              -- @'InTerminatingState'@,
              -- @'InTermiantedState'@.
              let state' :: InboundGovernorState muxMode peerAddr m a b
state' = ConnectionId peerAddr
-> InboundGovernorState muxMode peerAddr m a b
-> InboundGovernorState muxMode peerAddr m a b
forall peerAddr (muxMode :: MuxMode) (m :: * -> *) a b.
Ord peerAddr =>
ConnectionId peerAddr
-> InboundGovernorState muxMode peerAddr m a b
-> InboundGovernorState muxMode peerAddr m a b
unregisterConnection ConnectionId peerAddr
connId InboundGovernorState muxMode peerAddr m a b
state
              (Maybe (ConnectionId peerAddr),
 InboundGovernorState muxMode peerAddr m a b)
-> m (Maybe (ConnectionId peerAddr),
      InboundGovernorState muxMode peerAddr m a b)
forall (m :: * -> *) a. Monad m => a -> m a
return (ConnectionId peerAddr -> Maybe (ConnectionId peerAddr)
forall a. a -> Maybe a
Just ConnectionId peerAddr
connId, InboundGovernorState muxMode peerAddr m a b
state')

            TerminatedConnection {} -> do
              -- 'inState' can be either:
              -- @'InTerminatingState'@,
              -- @'InTermiantedState'@.
              let state' :: InboundGovernorState muxMode peerAddr m a b
state' = ConnectionId peerAddr
-> InboundGovernorState muxMode peerAddr m a b
-> InboundGovernorState muxMode peerAddr m a b
forall peerAddr (muxMode :: MuxMode) (m :: * -> *) a b.
Ord peerAddr =>
ConnectionId peerAddr
-> InboundGovernorState muxMode peerAddr m a b
-> InboundGovernorState muxMode peerAddr m a b
unregisterConnection ConnectionId peerAddr
connId InboundGovernorState muxMode peerAddr m a b
state
              (Maybe (ConnectionId peerAddr),
 InboundGovernorState muxMode peerAddr m a b)
-> m (Maybe (ConnectionId peerAddr),
      InboundGovernorState muxMode peerAddr m a b)
forall (m :: * -> *) a. Monad m => a -> m a
return (ConnectionId peerAddr -> Maybe (ConnectionId peerAddr)
forall a. a -> Maybe a
Just ConnectionId peerAddr
connId, InboundGovernorState muxMode peerAddr m a b
state')

            OperationSuccess DemotedToColdRemoteTr
transition ->
              case DemotedToColdRemoteTr
transition of
                -- the following two cases are when the connection was not used
                -- by p2p-governor, the connection will be closed.
                DemotedToColdRemoteTr
CommitTr -> do
                  -- @
                  --    Commit^{dataFlow}_{Remote} : InboundIdleState dataFlow
                  --                               → TerminatingState
                  -- @
                  let state' :: InboundGovernorState muxMode peerAddr m a b
state' = ConnectionId peerAddr
-> InboundGovernorState muxMode peerAddr m a b
-> InboundGovernorState muxMode peerAddr m a b
forall peerAddr (muxMode :: MuxMode) (m :: * -> *) a b.
Ord peerAddr =>
ConnectionId peerAddr
-> InboundGovernorState muxMode peerAddr m a b
-> InboundGovernorState muxMode peerAddr m a b
unregisterConnection ConnectionId peerAddr
connId InboundGovernorState muxMode peerAddr m a b
state
                  (Maybe (ConnectionId peerAddr),
 InboundGovernorState muxMode peerAddr m a b)
-> m (Maybe (ConnectionId peerAddr),
      InboundGovernorState muxMode peerAddr m a b)
forall (m :: * -> *) a. Monad m => a -> m a
return (ConnectionId peerAddr -> Maybe (ConnectionId peerAddr)
forall a. a -> Maybe a
Just ConnectionId peerAddr
connId, InboundGovernorState muxMode peerAddr m a b
state')

                -- the connection is still used by p2p-governor, carry on but put
                -- it in 'RemoteCold' state.  This will ensure we keep ready to
                -- serve the peer.
                -- @
                --    DemotedToCold^{Duplex}_{Remote} : DuplexState
                --                                    → OutboundState Duplex
                -- @
                -- or
                -- @
                --    Awake^{Duplex}^{Local} : InboundIdleState Duplex
                --                           → OutboundState Duplex
                -- @
                --
                -- note: the latter transition is level triggered rather than
                -- edge triggered. The server state is updated once protocol
                -- idleness expires rather than as soon as the connection
                -- manager was requested outbound connection.
                DemotedToColdRemoteTr
KeepTr -> do
                  let state' :: InboundGovernorState muxMode peerAddr m a b
state' = ConnectionId peerAddr
-> RemoteState m
-> InboundGovernorState muxMode peerAddr m a b
-> InboundGovernorState muxMode peerAddr m a b
forall peerAddr (m :: * -> *) (muxMode :: MuxMode) a b.
Ord peerAddr =>
ConnectionId peerAddr
-> RemoteState m
-> InboundGovernorState muxMode peerAddr m a b
-> InboundGovernorState muxMode peerAddr m a b
updateRemoteState ConnectionId peerAddr
connId RemoteState m
forall (m :: * -> *). RemoteState m
RemoteCold InboundGovernorState muxMode peerAddr m a b
state

                  (Maybe (ConnectionId peerAddr),
 InboundGovernorState muxMode peerAddr m a b)
-> m (Maybe (ConnectionId peerAddr),
      InboundGovernorState muxMode peerAddr m a b)
forall (m :: * -> *) a. Monad m => a -> m a
return (ConnectionId peerAddr -> Maybe (ConnectionId peerAddr)
forall a. a -> Maybe a
Just ConnectionId peerAddr
connId, InboundGovernorState muxMode peerAddr m a b
state')

      m () -> m ()
forall (m :: * -> *) a. MonadMask m => m a -> m a
mask_ (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
        STM m () -> m ()
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically (STM m () -> m ()) -> STM m () -> m ()
forall a b. (a -> b) -> a -> b
$ StrictTVar m (InboundGovernorState muxMode peerAddr m a b)
-> InboundGovernorState muxMode peerAddr m a b -> STM m ()
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
StrictTVar m a -> a -> STM m ()
writeTVar StrictTVar m (InboundGovernorState muxMode peerAddr m a b)
st InboundGovernorState muxMode peerAddr m a b
state'
        case Maybe (ConnectionId peerAddr)
mbConnId of
          Just ConnectionId peerAddr
cid -> Tracer m (RemoteTransitionTrace peerAddr)
-> RemoteTransitionTrace peerAddr -> m ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer m (RemoteTransitionTrace peerAddr)
trTracer (ConnectionId peerAddr
-> InboundGovernorState muxMode peerAddr m a b
-> InboundGovernorState muxMode peerAddr m a b
-> RemoteTransitionTrace peerAddr
forall peerAddr (muxMode :: MuxMode) (m :: * -> *) a b.
Ord peerAddr =>
ConnectionId peerAddr
-> InboundGovernorState muxMode peerAddr m a b
-> InboundGovernorState muxMode peerAddr m a b
-> RemoteTransitionTrace peerAddr
mkRemoteTransitionTrace ConnectionId peerAddr
cid InboundGovernorState muxMode peerAddr m a b
state InboundGovernorState muxMode peerAddr m a b
state')
          Maybe (ConnectionId peerAddr)
Nothing  -> () -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

      StrictTVar m (InboundGovernorState muxMode peerAddr m a b)
-> m Void
inboundGovernorLoop StrictTVar m (InboundGovernorState muxMode peerAddr m a b)
st


-- | Run a responder mini-protocol.
--
-- @'HasResponder' mode ~ True@ is used to rule out
-- 'InitiatorProtocolOnly' case.
--
runResponder :: forall (mode :: MuxMode) m a b.
                 ( HasResponder mode ~ True
                 , MonadAsync m
                 , MonadCatch m
                 , MonadThrow (STM m)
                 )
              => Mux.Mux mode m
              -> MiniProtocol mode ByteString m a b
              -> Mux.StartOnDemandOrEagerly
              -> m (Either SomeException (STM m (Either SomeException b)))
runResponder :: Mux mode m
-> MiniProtocol mode ByteString m a b
-> StartOnDemandOrEagerly
-> m (Either SomeException (STM m (Either SomeException b)))
runResponder Mux mode m
mux
             MiniProtocol { MiniProtocolNum
miniProtocolNum :: MiniProtocolNum
miniProtocolNum :: forall (mode :: MuxMode) bytes (m :: * -> *) a b.
MiniProtocol mode bytes m a b -> MiniProtocolNum
miniProtocolNum, RunMiniProtocol mode ByteString m a b
miniProtocolRun :: forall (mode :: MuxMode) bytes (m :: * -> *) a b.
MiniProtocol mode bytes m a b -> RunMiniProtocol mode bytes m a b
miniProtocolRun :: RunMiniProtocol mode ByteString m a b
miniProtocolRun }
             StartOnDemandOrEagerly
startStrategy =
    -- do not catch asynchronous exceptions, which are non recoverable
    (SomeException -> Maybe SomeException)
-> m (STM m (Either SomeException b))
-> m (Either SomeException (STM m (Either SomeException b)))
forall (m :: * -> *) e b a.
(MonadCatch m, Exception e) =>
(e -> Maybe b) -> m a -> m (Either b a)
tryJust (\SomeException
e -> case SomeException -> Maybe SomeAsyncException
forall e. Exception e => SomeException -> Maybe e
fromException SomeException
e of
              Just (SomeAsyncException e
_) -> Maybe SomeException
forall a. Maybe a
Nothing
              Maybe SomeAsyncException
Nothing                     -> SomeException -> Maybe SomeException
forall a. a -> Maybe a
Just SomeException
e) (m (STM m (Either SomeException b))
 -> m (Either SomeException (STM m (Either SomeException b))))
-> m (STM m (Either SomeException b))
-> m (Either SomeException (STM m (Either SomeException b)))
forall a b. (a -> b) -> a -> b
$
      case RunMiniProtocol mode ByteString m a b
miniProtocolRun of
        ResponderProtocolOnly MuxPeer ByteString m b
responder ->
          Mux mode m
-> MiniProtocolNum
-> MiniProtocolDirection mode
-> StartOnDemandOrEagerly
-> (Channel m -> m (b, Maybe ByteString))
-> m (STM m (Either SomeException b))
forall (mode :: MuxMode) (m :: * -> *) a.
(MonadSTM m, MonadThrow m, MonadThrow (STM m)) =>
Mux mode m
-> MiniProtocolNum
-> MiniProtocolDirection mode
-> StartOnDemandOrEagerly
-> (Channel m -> m (a, Maybe ByteString))
-> m (STM m (Either SomeException a))
Mux.runMiniProtocol
            Mux mode m
mux MiniProtocolNum
miniProtocolNum
            MiniProtocolDirection mode
MiniProtocolDirection 'ResponderMode
Mux.ResponderDirectionOnly
            StartOnDemandOrEagerly
startStrategy
            -- TODO: eliminate 'fromChannel'
            (MuxPeer ByteString m b
-> Channel m ByteString -> m (b, Maybe ByteString)
forall (m :: * -> *) bytes a.
(MonadCatch m, MonadAsync m) =>
MuxPeer bytes m a -> Channel m bytes -> m (a, Maybe bytes)
runMuxPeer MuxPeer ByteString m b
responder (Channel m ByteString -> m (b, Maybe ByteString))
-> (Channel m -> Channel m ByteString)
-> Channel m
-> m (b, Maybe ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Channel m -> Channel m ByteString
forall (m :: * -> *). Channel m -> Channel m ByteString
fromChannel)

        InitiatorAndResponderProtocol MuxPeer ByteString m a
_ MuxPeer ByteString m b
responder ->
          Mux mode m
-> MiniProtocolNum
-> MiniProtocolDirection mode
-> StartOnDemandOrEagerly
-> (Channel m -> m (b, Maybe ByteString))
-> m (STM m (Either SomeException b))
forall (mode :: MuxMode) (m :: * -> *) a.
(MonadSTM m, MonadThrow m, MonadThrow (STM m)) =>
Mux mode m
-> MiniProtocolNum
-> MiniProtocolDirection mode
-> StartOnDemandOrEagerly
-> (Channel m -> m (a, Maybe ByteString))
-> m (STM m (Either SomeException a))
Mux.runMiniProtocol
            Mux mode m
mux MiniProtocolNum
miniProtocolNum
            MiniProtocolDirection mode
MiniProtocolDirection 'InitiatorResponderMode
Mux.ResponderDirection
            StartOnDemandOrEagerly
startStrategy
            (MuxPeer ByteString m b
-> Channel m ByteString -> m (b, Maybe ByteString)
forall (m :: * -> *) bytes a.
(MonadCatch m, MonadAsync m) =>
MuxPeer bytes m a -> Channel m bytes -> m (a, Maybe bytes)
runMuxPeer MuxPeer ByteString m b
responder (Channel m ByteString -> m (b, Maybe ByteString))
-> (Channel m -> Channel m ByteString)
-> Channel m
-> m (b, Maybe ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Channel m -> Channel m ByteString
forall (m :: * -> *). Channel m -> Channel m ByteString
fromChannel)


--
-- Trace
--

-- | Remote connection state tracked by inbound protocol governor.
--
data RemoteSt = RemoteWarmSt
              | RemoteHotSt
              | RemoteIdleSt
              | RemoteColdSt
  deriving (RemoteSt -> RemoteSt -> Bool
(RemoteSt -> RemoteSt -> Bool)
-> (RemoteSt -> RemoteSt -> Bool) -> Eq RemoteSt
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RemoteSt -> RemoteSt -> Bool
$c/= :: RemoteSt -> RemoteSt -> Bool
== :: RemoteSt -> RemoteSt -> Bool
$c== :: RemoteSt -> RemoteSt -> Bool
Eq, Int -> RemoteSt -> ShowS
[RemoteSt] -> ShowS
RemoteSt -> String
(Int -> RemoteSt -> ShowS)
-> (RemoteSt -> String) -> ([RemoteSt] -> ShowS) -> Show RemoteSt
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RemoteSt] -> ShowS
$cshowList :: [RemoteSt] -> ShowS
show :: RemoteSt -> String
$cshow :: RemoteSt -> String
showsPrec :: Int -> RemoteSt -> ShowS
$cshowsPrec :: Int -> RemoteSt -> ShowS
Show)


mkRemoteSt :: RemoteState m -> RemoteSt
mkRemoteSt :: RemoteState m -> RemoteSt
mkRemoteSt  RemoteState m
RemoteWarm    = RemoteSt
RemoteWarmSt
mkRemoteSt  RemoteState m
RemoteHot     = RemoteSt
RemoteHotSt
mkRemoteSt (RemoteIdle STM m ()
_) = RemoteSt
RemoteIdleSt
mkRemoteSt  RemoteState m
RemoteCold    = RemoteSt
RemoteColdSt


-- | 'Nothing' represents unitialised state.
--
type RemoteTransition = Transition' (Maybe RemoteSt)

type RemoteTransitionTrace peerAddr = TransitionTrace' peerAddr (Maybe RemoteSt)

mkRemoteTransitionTrace :: Ord peerAddr
                        => ConnectionId peerAddr
                        -> InboundGovernorState muxMode peerAddr m a b
                        -> InboundGovernorState muxMode peerAddr m a b
                        -> RemoteTransitionTrace peerAddr
mkRemoteTransitionTrace :: ConnectionId peerAddr
-> InboundGovernorState muxMode peerAddr m a b
-> InboundGovernorState muxMode peerAddr m a b
-> RemoteTransitionTrace peerAddr
mkRemoteTransitionTrace ConnectionId peerAddr
connId InboundGovernorState muxMode peerAddr m a b
fromState InboundGovernorState muxMode peerAddr m a b
toState =
    peerAddr
-> Transition' (Maybe RemoteSt) -> RemoteTransitionTrace peerAddr
forall peerAddr state.
peerAddr -> Transition' state -> TransitionTrace' peerAddr state
TransitionTrace
      (ConnectionId peerAddr -> peerAddr
forall addr. ConnectionId addr -> addr
remoteAddress ConnectionId peerAddr
connId)
      Transition :: forall state. state -> state -> Transition' state
Transition { fromState :: Maybe RemoteSt
fromState = RemoteState m -> RemoteSt
forall (m :: * -> *). RemoteState m -> RemoteSt
mkRemoteSt
                             (RemoteState m -> RemoteSt)
-> (ConnectionState muxMode peerAddr m a b -> RemoteState m)
-> ConnectionState muxMode peerAddr m a b
-> RemoteSt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConnectionState muxMode peerAddr m a b -> RemoteState m
forall (muxMode :: MuxMode) peerAddr (m :: * -> *) a b.
ConnectionState muxMode peerAddr m a b -> RemoteState m
csRemoteState
                           (ConnectionState muxMode peerAddr m a b -> RemoteSt)
-> Maybe (ConnectionState muxMode peerAddr m a b) -> Maybe RemoteSt
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ConnectionId peerAddr
-> Map
     (ConnectionId peerAddr) (ConnectionState muxMode peerAddr m a b)
-> Maybe (ConnectionState muxMode peerAddr m a b)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup ConnectionId peerAddr
connId (InboundGovernorState muxMode peerAddr m a b
-> Map
     (ConnectionId peerAddr) (ConnectionState muxMode peerAddr m a b)
forall (muxMode :: MuxMode) peerAddr (m :: * -> *) a b.
InboundGovernorState muxMode peerAddr m a b
-> Map
     (ConnectionId peerAddr) (ConnectionState muxMode peerAddr m a b)
igsConnections InboundGovernorState muxMode peerAddr m a b
fromState)
                 , toState :: Maybe RemoteSt
toState   = RemoteState m -> RemoteSt
forall (m :: * -> *). RemoteState m -> RemoteSt
mkRemoteSt
                             (RemoteState m -> RemoteSt)
-> (ConnectionState muxMode peerAddr m a b -> RemoteState m)
-> ConnectionState muxMode peerAddr m a b
-> RemoteSt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConnectionState muxMode peerAddr m a b -> RemoteState m
forall (muxMode :: MuxMode) peerAddr (m :: * -> *) a b.
ConnectionState muxMode peerAddr m a b -> RemoteState m
csRemoteState
                           (ConnectionState muxMode peerAddr m a b -> RemoteSt)
-> Maybe (ConnectionState muxMode peerAddr m a b) -> Maybe RemoteSt
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ConnectionId peerAddr
-> Map
     (ConnectionId peerAddr) (ConnectionState muxMode peerAddr m a b)
-> Maybe (ConnectionState muxMode peerAddr m a b)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup ConnectionId peerAddr
connId (InboundGovernorState muxMode peerAddr m a b
-> Map
     (ConnectionId peerAddr) (ConnectionState muxMode peerAddr m a b)
forall (muxMode :: MuxMode) peerAddr (m :: * -> *) a b.
InboundGovernorState muxMode peerAddr m a b
-> Map
     (ConnectionId peerAddr) (ConnectionState muxMode peerAddr m a b)
igsConnections InboundGovernorState muxMode peerAddr m a b
toState)
                 }


data IGAssertionLocation peerAddr
  = InboundGovernorLoop !(Maybe (ConnectionId peerAddr)) !AbstractState
  deriving Int -> IGAssertionLocation peerAddr -> ShowS
[IGAssertionLocation peerAddr] -> ShowS
IGAssertionLocation peerAddr -> String
(Int -> IGAssertionLocation peerAddr -> ShowS)
-> (IGAssertionLocation peerAddr -> String)
-> ([IGAssertionLocation peerAddr] -> ShowS)
-> Show (IGAssertionLocation peerAddr)
forall peerAddr.
Show peerAddr =>
Int -> IGAssertionLocation peerAddr -> ShowS
forall peerAddr.
Show peerAddr =>
[IGAssertionLocation peerAddr] -> ShowS
forall peerAddr.
Show peerAddr =>
IGAssertionLocation peerAddr -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IGAssertionLocation peerAddr] -> ShowS
$cshowList :: forall peerAddr.
Show peerAddr =>
[IGAssertionLocation peerAddr] -> ShowS
show :: IGAssertionLocation peerAddr -> String
$cshow :: forall peerAddr.
Show peerAddr =>
IGAssertionLocation peerAddr -> String
showsPrec :: Int -> IGAssertionLocation peerAddr -> ShowS
$cshowsPrec :: forall peerAddr.
Show peerAddr =>
Int -> IGAssertionLocation peerAddr -> ShowS
Show

data InboundGovernorTrace peerAddr
    = TrNewConnection                !Provenance !(ConnectionId peerAddr)
    | TrResponderRestarted           !(ConnectionId peerAddr) !MiniProtocolNum
    | TrResponderStartFailure        !(ConnectionId peerAddr) !MiniProtocolNum !SomeException
    | TrResponderErrored             !(ConnectionId peerAddr) !MiniProtocolNum !SomeException
    | TrResponderStarted             !(ConnectionId peerAddr) !MiniProtocolNum
    | TrResponderTerminated          !(ConnectionId peerAddr) !MiniProtocolNum
    | TrPromotedToWarmRemote         !(ConnectionId peerAddr) !(OperationResult AbstractState)
    | TrPromotedToHotRemote          !(ConnectionId peerAddr)
    | TrDemotedToWarmRemote          !(ConnectionId peerAddr)
    | TrDemotedToColdRemote          !(ConnectionId peerAddr) !(OperationResult DemotedToColdRemoteTr)
    -- ^ All mini-protocols terminated.  The boolean is true if this connection
    -- was not used by p2p-governor, and thus the connection will be terminated.
    | TrWaitIdleRemote               !(ConnectionId peerAddr) !(OperationResult AbstractState)
    | TrMuxCleanExit                 !(ConnectionId peerAddr)
    | TrMuxErrored                   !(ConnectionId peerAddr) SomeException
    | TrInboundGovernorCounters      !InboundGovernorCounters
    | TrRemoteState                  !(Map (ConnectionId peerAddr) RemoteSt)
    | TrUnexpectedlyFalseAssertion   !(IGAssertionLocation peerAddr)
    -- ^ This case is unexpected at call site.
    | TrInboundGovernorError  !SomeException
  deriving Int -> InboundGovernorTrace peerAddr -> ShowS
[InboundGovernorTrace peerAddr] -> ShowS
InboundGovernorTrace peerAddr -> String
(Int -> InboundGovernorTrace peerAddr -> ShowS)
-> (InboundGovernorTrace peerAddr -> String)
-> ([InboundGovernorTrace peerAddr] -> ShowS)
-> Show (InboundGovernorTrace peerAddr)
forall peerAddr.
Show peerAddr =>
Int -> InboundGovernorTrace peerAddr -> ShowS
forall peerAddr.
Show peerAddr =>
[InboundGovernorTrace peerAddr] -> ShowS
forall peerAddr.
Show peerAddr =>
InboundGovernorTrace peerAddr -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InboundGovernorTrace peerAddr] -> ShowS
$cshowList :: forall peerAddr.
Show peerAddr =>
[InboundGovernorTrace peerAddr] -> ShowS
show :: InboundGovernorTrace peerAddr -> String
$cshow :: forall peerAddr.
Show peerAddr =>
InboundGovernorTrace peerAddr -> String
showsPrec :: Int -> InboundGovernorTrace peerAddr -> ShowS
$cshowsPrec :: forall peerAddr.
Show peerAddr =>
Int -> InboundGovernorTrace peerAddr -> ShowS
Show