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

-- 'runResponder' is using a redundant constraint.
{-# OPTIONS_GHC -Wno-redundant-constraints #-}
{-# OPTIONS_GHC -Wno-deferred-out-of-scope-variables #-}

-- | Server implementation based on 'ConnectionManager'
--
-- This module should be imported qualified.
--
module Ouroboros.Network.InboundGovernor
  ( -- * Run Inbound Protocol Governor
    PublicState (..)
  , Arguments (..)
  , with
    -- * Trace
  , Trace (..)
  , Debug (..)
  , RemoteSt (..)
  , RemoteTransition
  , RemoteTransitionTrace
  , AcceptConnectionsPolicyTrace (..)
    -- * Re-exports
  , Transition' (..)
  , TransitionTrace' (..)
    -- * API's exported for testing purposes
  , maturedPeers
  ) where

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

import Data.Bifunctor (first)
import Data.ByteString.Lazy (ByteString)
import Data.Cache
import Data.Map.Strict (Map)
import Data.Map.Strict qualified as Map
import Data.Monoid.Synchronisation
import Data.OrdPSQ (OrdPSQ)
import Data.OrdPSQ qualified as OrdPSQ
import Data.Set (Set)
import Data.Set qualified as Set
import Data.Void (Void)

import Network.Mux qualified as Mux

import Ouroboros.Network.ConnectionHandler
import Ouroboros.Network.ConnectionManager.InformationChannel
           (InboundGovernorInfoChannel)
import Ouroboros.Network.ConnectionManager.InformationChannel qualified as InfoChannel
import Ouroboros.Network.ConnectionManager.Types
import Ouroboros.Network.Context
import Ouroboros.Network.InboundGovernor.Event
import Ouroboros.Network.InboundGovernor.State
import Ouroboros.Network.Mux
import Ouroboros.Network.Server.RateLimiting


-- | Period of time after which a peer transitions from a fresh to a mature one,
-- see `matureDuplexPeers` and `freshDuplexPeers`.
--
inboundMaturePeerDelay :: DiffTime
inboundMaturePeerDelay :: DiffTime
inboundMaturePeerDelay = DiffTime
15 DiffTime -> DiffTime -> DiffTime
forall a. Num a => a -> a -> a
* DiffTime
60


-- | Every ~30s we wake up the inbound governor.  This is to give a chance to
-- mark some of the inbound connections as mature.
--
inactionTimeout :: DiffTime
inactionTimeout :: DiffTime
inactionTimeout = DiffTime
31.415927


data Arguments muxMode socket initiatorCtx peerAddr versionNumber versionData m a b = Arguments {
      forall (muxMode :: MuxMode) socket initiatorCtx peerAddr
       versionNumber versionData (m :: * -> *) a b.
Arguments
  muxMode
  socket
  initiatorCtx
  peerAddr
  versionNumber
  versionData
  m
  a
  b
-> Tracer m (RemoteTransitionTrace peerAddr)
transitionTracer   :: Tracer m (RemoteTransitionTrace peerAddr),
      -- ^ transition tracer
      forall (muxMode :: MuxMode) socket initiatorCtx peerAddr
       versionNumber versionData (m :: * -> *) a b.
Arguments
  muxMode
  socket
  initiatorCtx
  peerAddr
  versionNumber
  versionData
  m
  a
  b
-> Tracer m (Trace peerAddr)
tracer             :: Tracer m (Trace peerAddr),
      -- ^ main inbound governor tracer
      forall (muxMode :: MuxMode) socket initiatorCtx peerAddr
       versionNumber versionData (m :: * -> *) a b.
Arguments
  muxMode
  socket
  initiatorCtx
  peerAddr
  versionNumber
  versionData
  m
  a
  b
-> Tracer m (Debug peerAddr versionData)
debugTracer        :: Tracer m (Debug peerAddr versionData),
      -- ^ debug inbound governor tracer
      forall (muxMode :: MuxMode) socket initiatorCtx peerAddr
       versionNumber versionData (m :: * -> *) a b.
Arguments
  muxMode
  socket
  initiatorCtx
  peerAddr
  versionNumber
  versionData
  m
  a
  b
-> versionData -> DataFlow
connectionDataFlow :: versionData -> DataFlow,
      -- ^ connection data flow
      forall (muxMode :: MuxMode) socket initiatorCtx peerAddr
       versionNumber versionData (m :: * -> *) a b.
Arguments
  muxMode
  socket
  initiatorCtx
  peerAddr
  versionNumber
  versionData
  m
  a
  b
-> InboundGovernorInfoChannel
     muxMode initiatorCtx peerAddr versionData ByteString m a b
infoChannel        :: InboundGovernorInfoChannel muxMode initiatorCtx peerAddr versionData ByteString m a b,
      -- ^ 'InformationChannel' which passes 'NewConnectionInfo' for outbound
      -- connections from connection manager to the inbound governor.
      forall (muxMode :: MuxMode) socket initiatorCtx peerAddr
       versionNumber versionData (m :: * -> *) a b.
Arguments
  muxMode
  socket
  initiatorCtx
  peerAddr
  versionNumber
  versionData
  m
  a
  b
-> Maybe DiffTime
idleTimeout        :: Maybe DiffTime,
      -- ^ protocol idle timeout.  The remote site must restart a mini-protocol
      -- within given timeframe (Nothing indicates no timeout).
      forall (muxMode :: MuxMode) socket initiatorCtx peerAddr
       versionNumber versionData (m :: * -> *) a b.
Arguments
  muxMode
  socket
  initiatorCtx
  peerAddr
  versionNumber
  versionData
  m
  a
  b
-> MuxConnectionManager
     muxMode
     socket
     initiatorCtx
     (ResponderContext peerAddr)
     peerAddr
     versionData
     versionNumber
     ByteString
     m
     a
     b
connectionManager  :: MuxConnectionManager muxMode socket initiatorCtx
                                                    (ResponderContext peerAddr) peerAddr
                                                    versionData versionNumber
                                                    ByteString m a b
      -- ^ connection manager
    }


-- | 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/.
--
with :: forall (muxMode :: MuxMode) socket initiatorCtx peerAddr versionData versionNumber m a b x.
        ( Alternative (STM m)
        , MonadAsync       m
        , MonadCatch       m
        , MonadEvaluate    m
        , MonadLabelledSTM m
        , MonadThrow       m
        , MonadThrow  (STM m)
        , MonadTime        m
        , MonadTimer       m
        , MonadMask        m
        , Ord peerAddr
        , HasResponder muxMode ~ True
        )
     => Arguments muxMode socket initiatorCtx peerAddr versionNumber versionData m a b
     -> (Async m Void -> m (PublicState peerAddr versionData) -> m x)
     -> m x
with :: forall (muxMode :: MuxMode) socket initiatorCtx peerAddr
       versionData versionNumber (m :: * -> *) a b x.
(Alternative (STM m), MonadAsync m, MonadCatch m, MonadEvaluate m,
 MonadLabelledSTM m, MonadThrow m, MonadThrow (STM m), MonadTime m,
 MonadTimer m, MonadMask m, Ord peerAddr,
 HasResponder muxMode ~ 'True) =>
Arguments
  muxMode
  socket
  initiatorCtx
  peerAddr
  versionNumber
  versionData
  m
  a
  b
-> (Async m Void -> m (PublicState peerAddr versionData) -> m x)
-> m x
with
    Arguments {
      transitionTracer :: forall (muxMode :: MuxMode) socket initiatorCtx peerAddr
       versionNumber versionData (m :: * -> *) a b.
Arguments
  muxMode
  socket
  initiatorCtx
  peerAddr
  versionNumber
  versionData
  m
  a
  b
-> Tracer m (RemoteTransitionTrace peerAddr)
transitionTracer   = Tracer m (RemoteTransitionTrace peerAddr)
trTracer,
      tracer :: forall (muxMode :: MuxMode) socket initiatorCtx peerAddr
       versionNumber versionData (m :: * -> *) a b.
Arguments
  muxMode
  socket
  initiatorCtx
  peerAddr
  versionNumber
  versionData
  m
  a
  b
-> Tracer m (Trace peerAddr)
tracer             = Tracer m (Trace peerAddr)
tracer,
      debugTracer :: forall (muxMode :: MuxMode) socket initiatorCtx peerAddr
       versionNumber versionData (m :: * -> *) a b.
Arguments
  muxMode
  socket
  initiatorCtx
  peerAddr
  versionNumber
  versionData
  m
  a
  b
-> Tracer m (Debug peerAddr versionData)
debugTracer        = Tracer m (Debug peerAddr versionData)
debugTracer,
      connectionDataFlow :: forall (muxMode :: MuxMode) socket initiatorCtx peerAddr
       versionNumber versionData (m :: * -> *) a b.
Arguments
  muxMode
  socket
  initiatorCtx
  peerAddr
  versionNumber
  versionData
  m
  a
  b
-> versionData -> DataFlow
connectionDataFlow = versionData -> DataFlow
connectionDataFlow,
      infoChannel :: forall (muxMode :: MuxMode) socket initiatorCtx peerAddr
       versionNumber versionData (m :: * -> *) a b.
Arguments
  muxMode
  socket
  initiatorCtx
  peerAddr
  versionNumber
  versionData
  m
  a
  b
-> InboundGovernorInfoChannel
     muxMode initiatorCtx peerAddr versionData ByteString m a b
infoChannel        = InboundGovernorInfoChannel
  muxMode initiatorCtx peerAddr versionData ByteString m a b
infoChannel,
      idleTimeout :: forall (muxMode :: MuxMode) socket initiatorCtx peerAddr
       versionNumber versionData (m :: * -> *) a b.
Arguments
  muxMode
  socket
  initiatorCtx
  peerAddr
  versionNumber
  versionData
  m
  a
  b
-> Maybe DiffTime
idleTimeout        = Maybe DiffTime
idleTimeout,
      connectionManager :: forall (muxMode :: MuxMode) socket initiatorCtx peerAddr
       versionNumber versionData (m :: * -> *) a b.
Arguments
  muxMode
  socket
  initiatorCtx
  peerAddr
  versionNumber
  versionData
  m
  a
  b
-> MuxConnectionManager
     muxMode
     socket
     initiatorCtx
     (ResponderContext peerAddr)
     peerAddr
     versionData
     versionNumber
     ByteString
     m
     a
     b
connectionManager  = MuxConnectionManager
  muxMode
  socket
  initiatorCtx
  (ResponderContext peerAddr)
  peerAddr
  versionData
  versionNumber
  ByteString
  m
  a
  b
connectionManager
    }
    Async m Void -> m (PublicState peerAddr versionData) -> m x
k
    = do
    var <- PublicState peerAddr versionData
-> m (StrictTVar m (PublicState peerAddr versionData))
forall (m :: * -> *) a. MonadSTM m => a -> m (StrictTVar m a)
newTVarIO (State muxMode initiatorCtx peerAddr versionData m a b
-> PublicState peerAddr versionData
forall (muxMode :: MuxMode) initatorCtx versionData peerAddr
       (m :: * -> *) a b.
State muxMode initatorCtx peerAddr versionData m a b
-> PublicState peerAddr versionData
mkPublicState State muxMode initiatorCtx peerAddr versionData m a b
emptyState)
    withAsync (inboundGovernorLoop var emptyState
                `catch`
               handleError var) $
      \Async m Void
thread ->
        Async m Void -> m (PublicState peerAddr versionData) -> m x
k Async m Void
thread (StrictTVar m (PublicState peerAddr versionData)
-> m (PublicState peerAddr versionData)
forall (m :: * -> *) a. MonadSTM m => StrictTVar m a -> m a
readTVarIO StrictTVar m (PublicState peerAddr versionData)
var)
  where
    emptyState :: State muxMode initiatorCtx peerAddr versionData m a b
    emptyState :: State muxMode initiatorCtx peerAddr versionData m a b
emptyState = State {
        connections :: Map
  (ConnectionId peerAddr)
  (ConnectionState muxMode initiatorCtx peerAddr versionData m a b)
connections       = Map
  (ConnectionId peerAddr)
  (ConnectionState muxMode initiatorCtx peerAddr versionData m a b)
forall k a. Map k a
Map.empty,
        matureDuplexPeers :: Map peerAddr versionData
matureDuplexPeers = Map peerAddr versionData
forall k a. Map k a
Map.empty,
        freshDuplexPeers :: OrdPSQ peerAddr Time versionData
freshDuplexPeers  = OrdPSQ peerAddr Time versionData
forall k p v. OrdPSQ k p v
OrdPSQ.empty,
        countersCache :: Cache Counters
countersCache     = Cache Counters
forall a. Monoid a => a
mempty
      }

    -- trace final transition, mostly for testing purposes
    handleError
      :: StrictTVar m (PublicState peerAddr versionData)
      -> SomeException
      -> m Void
    handleError :: StrictTVar m (PublicState peerAddr versionData)
-> SomeException -> m Void
handleError StrictTVar m (PublicState peerAddr versionData)
var SomeException
e = do
      PublicState { remoteStateMap } <- StrictTVar m (PublicState peerAddr versionData)
-> m (PublicState peerAddr versionData)
forall (m :: * -> *) a. MonadSTM m => StrictTVar m a -> m a
readTVarIO StrictTVar m (PublicState peerAddr versionData)
var
      _ <- Map.traverseWithKey
             (\ConnectionId peerAddr
connId RemoteSt
remoteSt ->
               Tracer m (RemoteTransitionTrace peerAddr)
-> RemoteTransitionTrace peerAddr -> m ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer m (RemoteTransitionTrace peerAddr)
trTracer (RemoteTransitionTrace peerAddr -> m ())
-> RemoteTransitionTrace peerAddr -> m ()
forall a b. (a -> b) -> a -> b
$
                 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 { fromState :: Maybe RemoteSt
fromState = RemoteSt -> Maybe RemoteSt
forall a. a -> Maybe a
Just RemoteSt
remoteSt,
                              toState :: Maybe RemoteSt
toState   = Maybe RemoteSt
forall a. Maybe a
Nothing }
             )
             remoteStateMap
      throwIO e

    -- The inbound protocol governor recursive loop.  The 'connections' is
    -- updated as we recurse.
    --
    inboundGovernorLoop
      :: StrictTVar m (PublicState peerAddr versionData)
      -> State muxMode initiatorCtx peerAddr versionData m a b
      -> m Void
    inboundGovernorLoop :: StrictTVar m (PublicState peerAddr versionData)
-> State muxMode initiatorCtx peerAddr versionData m a b -> m Void
inboundGovernorLoop StrictTVar m (PublicState peerAddr versionData)
var !State muxMode initiatorCtx peerAddr versionData m a b
state = do
      time <- m Time
forall (m :: * -> *). MonadMonotonicTime m => m Time
getMonotonicTime
      inactivityVar <- registerDelay inactionTimeout

      event
        <- atomically $ runFirstToFinish $
               FirstToFinish  (
                 -- mark connections as mature
                 case maturedPeers time (freshDuplexPeers state) of
                   (Map peerAddr versionData
as, OrdPSQ peerAddr Time versionData
_)     | Map peerAddr versionData -> Bool
forall k a. Map k a -> Bool
Map.null Map peerAddr versionData
as
                               -> STM m (Event muxMode initiatorCtx peerAddr versionData m a b)
forall a. STM m a
forall (m :: * -> *) a. MonadSTM m => STM m a
retry
                   (Map peerAddr versionData
as, OrdPSQ peerAddr Time versionData
fresh) -> Event muxMode initiatorCtx peerAddr versionData m a b
-> STM m (Event muxMode initiatorCtx peerAddr versionData m a b)
forall a. a -> STM m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Event muxMode initiatorCtx peerAddr versionData m a b
 -> STM m (Event muxMode initiatorCtx peerAddr versionData m a b))
-> Event muxMode initiatorCtx peerAddr versionData m a b
-> STM m (Event muxMode initiatorCtx peerAddr versionData m a b)
forall a b. (a -> b) -> a -> b
$ Map peerAddr versionData
-> OrdPSQ peerAddr Time versionData
-> Event muxMode initiatorCtx peerAddr versionData m a b
forall (muxMode :: MuxMode) initiatorCtx peerAddr versionData
       (m :: * -> *) a b.
Map peerAddr versionData
-> OrdPSQ peerAddr Time versionData
-> Event muxMode initiatorCtx peerAddr versionData m a b
MaturedDuplexPeers Map peerAddr versionData
as OrdPSQ peerAddr Time versionData
fresh
               )
            <> Map.foldMapWithKey
                 (    firstMuxToFinish
                   <> firstMiniProtocolToFinish connectionDataFlow
                   <> firstPeerPromotedToWarm
                   <> firstPeerPromotedToHot
                   <> firstPeerDemotedToWarm
                   <> firstPeerDemotedToCold
                   <> firstPeerCommitRemote

                   :: EventSignal muxMode initiatorCtx peerAddr versionData m a b
                 )
                 (connections state)
            <> FirstToFinish (
                 NewConnection <$> InfoChannel.readMessage infoChannel
               )
            <> FirstToFinish (
                  -- spin the inbound governor loop; it will re-run with new
                  -- time, which allows to make some peers mature.
                  LazySTM.readTVar inactivityVar >>= check >> pure InactivityTimeout
               )
      (mbConnId, state') <- case event of
        NewConnection
          -- new connection has been announced by either accept loop or
          -- by connection manager (in which case the connection is in
          -- 'DuplexState').
          (NewConnectionInfo
            Provenance
provenance
            ConnectionId peerAddr
connId
            DataFlow
dataFlow
            Handle {
              hMux :: forall (muxMode :: MuxMode) initiatorCtx responderCtx versionData
       bytes (m :: * -> *) a b.
Handle muxMode initiatorCtx responderCtx versionData bytes m a b
-> Mux muxMode m
hMux         = Mux muxMode m
csMux,
              hMuxBundle :: forall (muxMode :: MuxMode) initiatorCtx responderCtx versionData
       bytes (m :: * -> *) a b.
Handle muxMode initiatorCtx responderCtx versionData bytes m a b
-> OuroborosBundle muxMode initiatorCtx responderCtx bytes m a b
hMuxBundle   = OuroborosBundle
  muxMode initiatorCtx (ResponderContext peerAddr) ByteString m a b
muxBundle,
              hVersionData :: forall (muxMode :: MuxMode) initiatorCtx responderCtx versionData
       bytes (m :: * -> *) a b.
Handle muxMode initiatorCtx responderCtx versionData bytes m a b
-> versionData
hVersionData = versionData
csVersionData
            }) -> do

              Tracer m (Trace peerAddr) -> Trace peerAddr -> m ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer m (Trace peerAddr)
tracer (Provenance -> ConnectionId peerAddr -> Trace peerAddr
forall peerAddr.
Provenance -> ConnectionId peerAddr -> Trace peerAddr
TrNewConnection Provenance
provenance ConnectionId peerAddr
connId)
              let responderContext :: ResponderContext peerAddr
responderContext = ResponderContext { rcConnectionId :: ConnectionId peerAddr
rcConnectionId = ConnectionId peerAddr
connId }

              connections <- (Maybe
   (ConnectionState muxMode initiatorCtx peerAddr versionData m a b)
 -> m (Maybe
         (ConnectionState muxMode initiatorCtx peerAddr versionData m a b)))
-> ConnectionId peerAddr
-> Map
     (ConnectionId peerAddr)
     (ConnectionState muxMode initiatorCtx peerAddr versionData m a b)
-> m (Map
        (ConnectionId peerAddr)
        (ConnectionState muxMode initiatorCtx peerAddr versionData 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 initiatorCtx peerAddr versionData m a b)
Nothing -> do
                    let csMPMHot :: [(MiniProtocolNum,
  MiniProtocolData muxMode initiatorCtx peerAddr m a b)]
csMPMHot =
                          [ ( MiniProtocol
  muxMode initiatorCtx (ResponderContext peerAddr) ByteString m a b
-> MiniProtocolNum
forall (mode :: MuxMode) initiatorCtx responderCtx bytes
       (m :: * -> *) a b.
MiniProtocol mode initiatorCtx responderCtx bytes m a b
-> MiniProtocolNum
miniProtocolNum MiniProtocol
  muxMode initiatorCtx (ResponderContext peerAddr) ByteString m a b
mpH
                            , MiniProtocol
  muxMode initiatorCtx (ResponderContext peerAddr) ByteString m a b
-> ResponderContext peerAddr
-> ProtocolTemperature
-> MiniProtocolData muxMode initiatorCtx peerAddr m a b
forall (muxMode :: MuxMode) initiatorCtx peerAddr (m :: * -> *) a
       b.
MiniProtocol
  muxMode initiatorCtx (ResponderContext peerAddr) ByteString m a b
-> ResponderContext peerAddr
-> ProtocolTemperature
-> MiniProtocolData muxMode initiatorCtx peerAddr m a b
MiniProtocolData MiniProtocol
  muxMode initiatorCtx (ResponderContext peerAddr) ByteString m a b
mpH ResponderContext peerAddr
responderContext ProtocolTemperature
Hot
                            )
                          | MiniProtocol
  muxMode initiatorCtx (ResponderContext peerAddr) ByteString m a b
mpH <- SingProtocolTemperature 'Hot
-> OuroborosBundle
     muxMode initiatorCtx (ResponderContext peerAddr) ByteString m a b
-> [MiniProtocol
      muxMode initiatorCtx (ResponderContext peerAddr) ByteString m a b]
forall (pt :: ProtocolTemperature) a.
SingProtocolTemperature pt -> TemperatureBundle a -> a
projectBundle SingProtocolTemperature 'Hot
SingHot OuroborosBundle
  muxMode initiatorCtx (ResponderContext peerAddr) ByteString m a b
muxBundle
                          ]
                        csMPMWarm :: [(MiniProtocolNum,
  MiniProtocolData muxMode initiatorCtx peerAddr m a b)]
csMPMWarm =
                          [ ( MiniProtocol
  muxMode initiatorCtx (ResponderContext peerAddr) ByteString m a b
-> MiniProtocolNum
forall (mode :: MuxMode) initiatorCtx responderCtx bytes
       (m :: * -> *) a b.
MiniProtocol mode initiatorCtx responderCtx bytes m a b
-> MiniProtocolNum
miniProtocolNum MiniProtocol
  muxMode initiatorCtx (ResponderContext peerAddr) ByteString m a b
mpW
                            , MiniProtocol
  muxMode initiatorCtx (ResponderContext peerAddr) ByteString m a b
-> ResponderContext peerAddr
-> ProtocolTemperature
-> MiniProtocolData muxMode initiatorCtx peerAddr m a b
forall (muxMode :: MuxMode) initiatorCtx peerAddr (m :: * -> *) a
       b.
MiniProtocol
  muxMode initiatorCtx (ResponderContext peerAddr) ByteString m a b
-> ResponderContext peerAddr
-> ProtocolTemperature
-> MiniProtocolData muxMode initiatorCtx peerAddr m a b
MiniProtocolData MiniProtocol
  muxMode initiatorCtx (ResponderContext peerAddr) ByteString m a b
mpW ResponderContext peerAddr
responderContext ProtocolTemperature
Warm
                            )
                          | MiniProtocol
  muxMode initiatorCtx (ResponderContext peerAddr) ByteString m a b
mpW <- SingProtocolTemperature 'Warm
-> OuroborosBundle
     muxMode initiatorCtx (ResponderContext peerAddr) ByteString m a b
-> [MiniProtocol
      muxMode initiatorCtx (ResponderContext peerAddr) ByteString m a b]
forall (pt :: ProtocolTemperature) a.
SingProtocolTemperature pt -> TemperatureBundle a -> a
projectBundle SingProtocolTemperature 'Warm
SingWarm OuroborosBundle
  muxMode initiatorCtx (ResponderContext peerAddr) ByteString m a b
muxBundle
                          ]
                        csMPMEstablished :: [(MiniProtocolNum,
  MiniProtocolData muxMode initiatorCtx peerAddr m a b)]
csMPMEstablished =
                          [ ( MiniProtocol
  muxMode initiatorCtx (ResponderContext peerAddr) ByteString m a b
-> MiniProtocolNum
forall (mode :: MuxMode) initiatorCtx responderCtx bytes
       (m :: * -> *) a b.
MiniProtocol mode initiatorCtx responderCtx bytes m a b
-> MiniProtocolNum
miniProtocolNum MiniProtocol
  muxMode initiatorCtx (ResponderContext peerAddr) ByteString m a b
mpE
                            , MiniProtocol
  muxMode initiatorCtx (ResponderContext peerAddr) ByteString m a b
-> ResponderContext peerAddr
-> ProtocolTemperature
-> MiniProtocolData muxMode initiatorCtx peerAddr m a b
forall (muxMode :: MuxMode) initiatorCtx peerAddr (m :: * -> *) a
       b.
MiniProtocol
  muxMode initiatorCtx (ResponderContext peerAddr) ByteString m a b
-> ResponderContext peerAddr
-> ProtocolTemperature
-> MiniProtocolData muxMode initiatorCtx peerAddr m a b
MiniProtocolData MiniProtocol
  muxMode initiatorCtx (ResponderContext peerAddr) ByteString m a b
mpE ResponderContext peerAddr
responderContext ProtocolTemperature
Established
                            )
                          | MiniProtocol
  muxMode initiatorCtx (ResponderContext peerAddr) ByteString m a b
mpE <- SingProtocolTemperature 'Established
-> OuroborosBundle
     muxMode initiatorCtx (ResponderContext peerAddr) ByteString m a b
-> [MiniProtocol
      muxMode initiatorCtx (ResponderContext peerAddr) ByteString m a b]
forall (pt :: ProtocolTemperature) a.
SingProtocolTemperature pt -> TemperatureBundle a -> a
projectBundle SingProtocolTemperature 'Established
SingEstablished OuroborosBundle
  muxMode initiatorCtx (ResponderContext peerAddr) ByteString m a b
muxBundle
                          ]
                        csMiniProtocolMap :: Map
  MiniProtocolNum
  (MiniProtocolData muxMode initiatorCtx peerAddr m a b)
csMiniProtocolMap =
                            [(MiniProtocolNum,
  MiniProtocolData muxMode initiatorCtx peerAddr m a b)]
-> Map
     MiniProtocolNum
     (MiniProtocolData muxMode initiatorCtx peerAddr m a b)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
                            ([(MiniProtocolNum,
  MiniProtocolData muxMode initiatorCtx peerAddr m a b)]
csMPMHot [(MiniProtocolNum,
  MiniProtocolData muxMode initiatorCtx peerAddr m a b)]
-> [(MiniProtocolNum,
     MiniProtocolData muxMode initiatorCtx peerAddr m a b)]
-> [(MiniProtocolNum,
     MiniProtocolData muxMode initiatorCtx peerAddr m a b)]
forall a. [a] -> [a] -> [a]
++ [(MiniProtocolNum,
  MiniProtocolData muxMode initiatorCtx peerAddr m a b)]
csMPMWarm [(MiniProtocolNum,
  MiniProtocolData muxMode initiatorCtx peerAddr m a b)]
-> [(MiniProtocolNum,
     MiniProtocolData muxMode initiatorCtx peerAddr m a b)]
-> [(MiniProtocolNum,
     MiniProtocolData muxMode initiatorCtx peerAddr m a b)]
forall a. [a] -> [a] -> [a]
++ [(MiniProtocolNum,
  MiniProtocolData muxMode initiatorCtx peerAddr m a b)]
csMPMEstablished)

                    mCompletionMap
                      <-
                      (Maybe (Map MiniProtocolNum (STM m (Either SomeException b)))
 -> MiniProtocolData muxMode initiatorCtx peerAddr m a b
 -> m (Maybe
         (Map MiniProtocolNum (STM m (Either SomeException b)))))
-> Maybe (Map MiniProtocolNum (STM m (Either SomeException b)))
-> Map
     MiniProtocolNum
     (MiniProtocolData muxMode initiatorCtx peerAddr 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 mpd :: MiniProtocolData muxMode initiatorCtx peerAddr m a b
mpd@MiniProtocolData { MiniProtocol
  muxMode initiatorCtx (ResponderContext peerAddr) ByteString m a b
mpdMiniProtocol :: MiniProtocol
  muxMode initiatorCtx (ResponderContext peerAddr) ByteString m a b
mpdMiniProtocol :: forall (muxMode :: MuxMode) initiatorCtx peerAddr (m :: * -> *) a
       b.
MiniProtocolData muxMode initiatorCtx peerAddr m a b
-> MiniProtocol
     muxMode initiatorCtx (ResponderContext peerAddr) ByteString m a b
mpdMiniProtocol } ->
                          Mux muxMode m
-> MiniProtocolData muxMode initiatorCtx peerAddr m a b
-> StartOnDemandOrEagerly
-> m (Either SomeException (STM m (Either SomeException b)))
forall (mode :: MuxMode) initiatorCtx peerAddr (m :: * -> *) a b.
(Alternative (STM m), HasResponder mode ~ 'True, MonadAsync m,
 MonadLabelledSTM m, MonadCatch m, MonadMask m,
 MonadThrow (STM m)) =>
Mux mode m
-> MiniProtocolData mode initiatorCtx peerAddr m a b
-> StartOnDemandOrEagerly
-> m (Either SomeException (STM m (Either SomeException b)))
runResponder Mux muxMode m
csMux MiniProtocolData muxMode initiatorCtx peerAddr m a b
mpd StartOnDemandOrEagerly
Mux.StartOnDemand m (Either SomeException (STM m (Either SomeException b)))
-> (Either SomeException (STM m (Either SomeException b))
    -> m (Maybe
            (Map MiniProtocolNum (STM m (Either SomeException b)))))
-> m (Maybe (Map MiniProtocolNum (STM m (Either SomeException b))))
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
                            -- 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 (Trace peerAddr) -> Trace peerAddr -> m ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer m (Trace peerAddr)
tracer (ConnectionId peerAddr
-> MiniProtocolNum -> SomeException -> Trace peerAddr
forall peerAddr.
ConnectionId peerAddr
-> MiniProtocolNum -> SomeException -> Trace peerAddr
TrResponderStartFailure ConnectionId peerAddr
connId (MiniProtocol
  muxMode initiatorCtx (ResponderContext peerAddr) ByteString m a b
-> MiniProtocolNum
forall (mode :: MuxMode) initiatorCtx responderCtx bytes
       (m :: * -> *) a b.
MiniProtocol mode initiatorCtx responderCtx bytes m a b
-> MiniProtocolNum
miniProtocolNum MiniProtocol
  muxMode initiatorCtx (ResponderContext peerAddr) 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 a. a -> m a
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 initiatorCtx (ResponderContext peerAddr) ByteString m a b
-> MiniProtocolNum
forall (mode :: MuxMode) initiatorCtx responderCtx bytes
       (m :: * -> *) a b.
MiniProtocol mode initiatorCtx responderCtx bytes m a b
-> MiniProtocolNum
miniProtocolNum MiniProtocol
  muxMode initiatorCtx (ResponderContext peerAddr) 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 a. a -> m a
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 a. a -> m a
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 initiatorCtx peerAddr m a b)
csMiniProtocolMap

                    case 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 initiatorCtx peerAddr versionData m a b)
-> m (Maybe
        (ConnectionState muxMode initiatorCtx peerAddr versionData m a b))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe
  (ConnectionState muxMode initiatorCtx peerAddr versionData m a b)
forall a. Maybe a
Nothing

                      Just Map MiniProtocolNum (STM m (Either SomeException b))
csCompletionMap -> do
                        mv <- (DiffTime -> m (TVar m Bool))
-> Maybe DiffTime -> m (Maybe (TVar m Bool))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Maybe a -> f (Maybe b)
traverse DiffTime -> m (TVar m Bool)
forall (m :: * -> *). MonadTimer m => DiffTime -> m (TVar m Bool)
registerDelay Maybe DiffTime
idleTimeout
                        let -- initial state is 'RemoteIdle', if the remote end will not
                            -- start any responders this will unregister the inbound side.
                            csRemoteState :: RemoteState m
                            csRemoteState = STM m () -> RemoteState m
forall (m :: * -> *). STM m () -> RemoteState m
RemoteIdle (case Maybe (TVar m Bool)
mv of
                                                          Maybe (TVar m Bool)
Nothing -> STM m ()
forall a. STM m a
forall (m :: * -> *) a. MonadSTM m => STM m a
retry
                                                          Just TVar m Bool
v  -> TVar m Bool -> STM m Bool
forall a. TVar m a -> STM m a
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 a b. STM m a -> (a -> STM m b) -> STM m b
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 {
                                Mux muxMode m
csMux :: Mux muxMode m
csMux :: Mux muxMode m
csMux,
                                versionData
csVersionData :: versionData
csVersionData :: versionData
csVersionData,
                                Map
  MiniProtocolNum
  (MiniProtocolData muxMode initiatorCtx peerAddr m a b)
csMiniProtocolMap :: Map
  MiniProtocolNum
  (MiniProtocolData muxMode initiatorCtx peerAddr m a b)
csMiniProtocolMap :: Map
  MiniProtocolNum
  (MiniProtocolData muxMode initiatorCtx peerAddr 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
                              }

                        return (Just 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 initiatorCtx peerAddr versionData m a b
connState -> Maybe
  (ConnectionState muxMode initiatorCtx peerAddr versionData m a b)
-> m (Maybe
        (ConnectionState muxMode initiatorCtx peerAddr versionData m a b))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (ConnectionState muxMode initiatorCtx peerAddr versionData m a b
-> Maybe
     (ConnectionState muxMode initiatorCtx peerAddr versionData m a b)
forall a. a -> Maybe a
Just ConnectionState muxMode initiatorCtx peerAddr versionData m a b
connState)

                )
                ConnectionId peerAddr
connId
                (State muxMode initiatorCtx peerAddr versionData m a b
-> Map
     (ConnectionId peerAddr)
     (ConnectionState muxMode initiatorCtx peerAddr versionData m a b)
forall (muxMode :: MuxMode) initiatorCtx peerAddr versionData
       (m :: * -> *) a b.
State muxMode initiatorCtx peerAddr versionData m a b
-> Map
     (ConnectionId peerAddr)
     (ConnectionState muxMode initiatorCtx peerAddr versionData m a b)
connections State muxMode initiatorCtx peerAddr versionData m a b
state)

              time' <- getMonotonicTime
              -- update state and continue the recursive loop
              let state' = State muxMode initiatorCtx peerAddr versionData m a b
state {
                      connections,
                      freshDuplexPeers =
                        case dataFlow of
                          DataFlow
Unidirectional -> State muxMode initiatorCtx peerAddr versionData m a b
-> OrdPSQ peerAddr Time versionData
forall (muxMode :: MuxMode) initiatorCtx peerAddr versionData
       (m :: * -> *) a b.
State muxMode initiatorCtx peerAddr versionData m a b
-> OrdPSQ peerAddr Time versionData
freshDuplexPeers State muxMode initiatorCtx peerAddr versionData m a b
state
                          DataFlow
Duplex         -> peerAddr
-> Time
-> versionData
-> OrdPSQ peerAddr Time versionData
-> OrdPSQ peerAddr Time versionData
forall k p v.
(Ord k, Ord p) =>
k -> p -> v -> OrdPSQ k p v -> OrdPSQ k p v
OrdPSQ.insert (ConnectionId peerAddr -> peerAddr
forall addr. ConnectionId addr -> addr
remoteAddress ConnectionId peerAddr
connId) Time
time' versionData
csVersionData
                                                          (State muxMode initiatorCtx peerAddr versionData m a b
-> OrdPSQ peerAddr Time versionData
forall (muxMode :: MuxMode) initiatorCtx peerAddr versionData
       (m :: * -> *) a b.
State muxMode initiatorCtx peerAddr versionData m a b
-> OrdPSQ peerAddr Time versionData
freshDuplexPeers State muxMode initiatorCtx peerAddr versionData m a b
state)
                    }
              return (Just connId, state')

        MuxFinished ConnectionId peerAddr
connId Maybe SomeException
merr -> do

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

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

        MiniProtocolTerminated
          Terminated {
              ConnectionId peerAddr
tConnId :: ConnectionId peerAddr
tConnId :: forall (muxMode :: MuxMode) initiatorCtx peerAddr (m :: * -> *) a
       b.
Terminated muxMode initiatorCtx peerAddr m a b
-> ConnectionId peerAddr
tConnId,
              Mux muxMode m
tMux :: Mux muxMode m
tMux :: forall (muxMode :: MuxMode) initiatorCtx peerAddr (m :: * -> *) a
       b.
Terminated muxMode initiatorCtx peerAddr m a b -> Mux muxMode m
tMux,
              tMiniProtocolData :: forall (muxMode :: MuxMode) initiatorCtx peerAddr (m :: * -> *) a
       b.
Terminated muxMode initiatorCtx peerAddr m a b
-> MiniProtocolData muxMode initiatorCtx peerAddr m a b
tMiniProtocolData = mpd :: MiniProtocolData muxMode initiatorCtx peerAddr m a b
mpd@MiniProtocolData { mpdMiniProtocol :: forall (muxMode :: MuxMode) initiatorCtx peerAddr (m :: * -> *) a
       b.
MiniProtocolData muxMode initiatorCtx peerAddr m a b
-> MiniProtocol
     muxMode initiatorCtx (ResponderContext peerAddr) ByteString m a b
mpdMiniProtocol = MiniProtocol
  muxMode initiatorCtx (ResponderContext peerAddr) ByteString m a b
miniProtocol },
              Either SomeException b
tResult :: Either SomeException b
tResult :: forall (muxMode :: MuxMode) initiatorCtx peerAddr (m :: * -> *) a
       b.
Terminated muxMode initiatorCtx peerAddr m a b
-> Either SomeException b
tResult
            } ->
          let num :: MiniProtocolNum
num = MiniProtocol
  muxMode initiatorCtx (ResponderContext peerAddr) ByteString m a b
-> MiniProtocolNum
forall (mode :: MuxMode) initiatorCtx responderCtx bytes
       (m :: * -> *) a b.
MiniProtocol mode initiatorCtx responderCtx bytes m a b
-> MiniProtocolNum
miniProtocolNum MiniProtocol
  muxMode initiatorCtx (ResponderContext peerAddr) ByteString m a b
miniProtocol 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 'State'.
              Tracer m (Trace peerAddr) -> Trace peerAddr -> m ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer m (Trace peerAddr)
tracer (Trace peerAddr -> m ()) -> Trace peerAddr -> m ()
forall a b. (a -> b) -> a -> b
$
                ConnectionId peerAddr
-> MiniProtocolNum -> SomeException -> Trace peerAddr
forall peerAddr.
ConnectionId peerAddr
-> MiniProtocolNum -> SomeException -> Trace peerAddr
TrResponderErrored ConnectionId peerAddr
tConnId MiniProtocolNum
num SomeException
e

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

            Right b
_ ->
              Mux muxMode m
-> MiniProtocolData muxMode initiatorCtx peerAddr m a b
-> StartOnDemandOrEagerly
-> m (Either SomeException (STM m (Either SomeException b)))
forall (mode :: MuxMode) initiatorCtx peerAddr (m :: * -> *) a b.
(Alternative (STM m), HasResponder mode ~ 'True, MonadAsync m,
 MonadLabelledSTM m, MonadCatch m, MonadMask m,
 MonadThrow (STM m)) =>
Mux mode m
-> MiniProtocolData mode initiatorCtx peerAddr m a b
-> StartOnDemandOrEagerly
-> m (Either SomeException (STM m (Either SomeException b)))
runResponder Mux muxMode m
tMux MiniProtocolData muxMode initiatorCtx peerAddr m a b
mpd StartOnDemandOrEagerly
Mux.StartOnDemand m (Either SomeException (STM m (Either SomeException b)))
-> (Either SomeException (STM m (Either SomeException b))
    -> m (Maybe (ConnectionId peerAddr),
          State muxMode initiatorCtx peerAddr versionData m a b))
-> m (Maybe (ConnectionId peerAddr),
      State muxMode initiatorCtx peerAddr versionData m a b)
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
                Right STM m (Either SomeException b)
completionAction -> do
                  Tracer m (Trace peerAddr) -> Trace peerAddr -> m ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer m (Trace peerAddr)
tracer (ConnectionId peerAddr -> MiniProtocolNum -> Trace peerAddr
forall peerAddr.
ConnectionId peerAddr -> MiniProtocolNum -> Trace peerAddr
TrResponderRestarted ConnectionId peerAddr
tConnId MiniProtocolNum
num)
                  let state' :: State muxMode initiatorCtx peerAddr versionData m a b
state' = ConnectionId peerAddr
-> MiniProtocolNum
-> STM m (Either SomeException b)
-> State muxMode initiatorCtx peerAddr versionData m a b
-> State muxMode initiatorCtx peerAddr versionData m a b
forall peerAddr (m :: * -> *) b (muxMode :: MuxMode) initiatorCtx
       versionData a.
Ord peerAddr =>
ConnectionId peerAddr
-> MiniProtocolNum
-> STM m (Either SomeException b)
-> State muxMode initiatorCtx peerAddr versionData m a b
-> State muxMode initiatorCtx peerAddr versionData m a b
updateMiniProtocol ConnectionId peerAddr
tConnId MiniProtocolNum
num STM m (Either SomeException b)
completionAction State muxMode initiatorCtx peerAddr versionData m a b
state
                  (Maybe (ConnectionId peerAddr),
 State muxMode initiatorCtx peerAddr versionData m a b)
-> m (Maybe (ConnectionId peerAddr),
      State muxMode initiatorCtx peerAddr versionData m a b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (ConnectionId peerAddr)
forall a. Maybe a
Nothing, State muxMode initiatorCtx peerAddr versionData 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 (Trace peerAddr) -> Trace peerAddr -> m ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer m (Trace peerAddr)
tracer (ConnectionId peerAddr
-> MiniProtocolNum -> SomeException -> Trace peerAddr
forall peerAddr.
ConnectionId peerAddr
-> MiniProtocolNum -> SomeException -> Trace 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' :: State muxMode initiatorCtx peerAddr versionData m a b
state' = ConnectionId peerAddr
-> State muxMode initiatorCtx peerAddr versionData m a b
-> State muxMode initiatorCtx peerAddr versionData m a b
forall peerAddr (muxMode :: MuxMode) initiatorCtx versionData
       (m :: * -> *) a b.
Ord peerAddr =>
ConnectionId peerAddr
-> State muxMode initiatorCtx peerAddr versionData m a b
-> State muxMode initiatorCtx peerAddr versionData m a b
unregisterConnection ConnectionId peerAddr
tConnId State muxMode initiatorCtx peerAddr versionData m a b
state

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


        WaitIdleRemote ConnectionId peerAddr
connId -> do
          -- @
          --    DemotedToCold^{dataFlow}_{Remote} : InboundState Duplex
          --                                      → InboundIdleState Duplex
          -- @
          res <- MuxConnectionManager
  muxMode
  socket
  initiatorCtx
  (ResponderContext peerAddr)
  peerAddr
  versionData
  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
  initiatorCtx
  (ResponderContext peerAddr)
  peerAddr
  versionData
  versionNumber
  ByteString
  m
  a
  b
connectionManager
                                     (ConnectionId peerAddr -> peerAddr
forall addr. ConnectionId addr -> addr
remoteAddress ConnectionId peerAddr
connId)
          traceWith tracer (TrWaitIdleRemote connId res)
          case res of
            TerminatedConnection {} -> do
              let state' :: State muxMode initiatorCtx peerAddr versionData m a b
state' = ConnectionId peerAddr
-> State muxMode initiatorCtx peerAddr versionData m a b
-> State muxMode initiatorCtx peerAddr versionData m a b
forall peerAddr (muxMode :: MuxMode) initiatorCtx versionData
       (m :: * -> *) a b.
Ord peerAddr =>
ConnectionId peerAddr
-> State muxMode initiatorCtx peerAddr versionData m a b
-> State muxMode initiatorCtx peerAddr versionData m a b
unregisterConnection ConnectionId peerAddr
connId State muxMode initiatorCtx peerAddr versionData m a b
state
              (Maybe (ConnectionId peerAddr),
 State muxMode initiatorCtx peerAddr versionData m a b)
-> m (Maybe (ConnectionId peerAddr),
      State muxMode initiatorCtx peerAddr versionData m a b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (ConnectionId peerAddr -> Maybe (ConnectionId peerAddr)
forall a. a -> Maybe a
Just ConnectionId peerAddr
connId, State muxMode initiatorCtx peerAddr versionData m a b
state')
            OperationSuccess {}  -> do
              mv <- (DiffTime -> m (TVar m Bool))
-> Maybe DiffTime -> m (Maybe (TVar m Bool))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Maybe a -> f (Maybe b)
traverse DiffTime -> m (TVar m Bool)
forall (m :: * -> *). MonadTimer m => DiffTime -> m (TVar m Bool)
registerDelay Maybe DiffTime
idleTimeout
              let timeoutSTM :: STM m ()
                  !timeoutSTM = case Maybe (TVar m Bool)
mv of
                    Maybe (TVar m Bool)
Nothing -> STM m ()
forall a. STM m a
forall (m :: * -> *) a. MonadSTM m => STM m a
retry
                    Just TVar m Bool
v  -> TVar m Bool -> STM m Bool
forall a. TVar m a -> STM m a
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 a b. STM m a -> (a -> STM m b) -> STM m b
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' = ConnectionId peerAddr
-> RemoteState m
-> State muxMode initiatorCtx peerAddr versionData m a b
-> State muxMode initiatorCtx peerAddr versionData m a b
forall peerAddr (m :: * -> *) (muxMode :: MuxMode) initiatorCtx
       versionData a b.
Ord peerAddr =>
ConnectionId peerAddr
-> RemoteState m
-> State muxMode initiatorCtx peerAddr versionData m a b
-> State muxMode initiatorCtx peerAddr versionData m a b
updateRemoteState ConnectionId peerAddr
connId (STM m () -> RemoteState m
forall (m :: * -> *). STM m () -> RemoteState m
RemoteIdle STM m ()
timeoutSTM) State muxMode initiatorCtx peerAddr versionData m a b
state

              return (Just connId, state')
            -- It could happen that the connection got deleted by connection
            -- manager due to some async exception so we need to unregister it
            -- from the inbound governor state.
            UnsupportedState AbstractState
UnknownConnectionSt -> do
              let state' :: State muxMode initiatorCtx peerAddr versionData m a b
state' = ConnectionId peerAddr
-> State muxMode initiatorCtx peerAddr versionData m a b
-> State muxMode initiatorCtx peerAddr versionData m a b
forall peerAddr (muxMode :: MuxMode) initiatorCtx versionData
       (m :: * -> *) a b.
Ord peerAddr =>
ConnectionId peerAddr
-> State muxMode initiatorCtx peerAddr versionData m a b
-> State muxMode initiatorCtx peerAddr versionData m a b
unregisterConnection ConnectionId peerAddr
connId State muxMode initiatorCtx peerAddr versionData m a b
state
              (Maybe (ConnectionId peerAddr),
 State muxMode initiatorCtx peerAddr versionData m a b)
-> m (Maybe (ConnectionId peerAddr),
      State muxMode initiatorCtx peerAddr versionData m a b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (ConnectionId peerAddr -> Maybe (ConnectionId peerAddr)
forall a. a -> Maybe a
Just ConnectionId peerAddr
connId, State muxMode initiatorCtx peerAddr versionData m a b
state')
            UnsupportedState {} -> do
              (Maybe (ConnectionId peerAddr),
 State muxMode initiatorCtx peerAddr versionData m a b)
-> m (Maybe (ConnectionId peerAddr),
      State muxMode initiatorCtx peerAddr versionData m a b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (ConnectionId peerAddr -> Maybe (ConnectionId peerAddr)
forall a. a -> Maybe a
Just ConnectionId peerAddr
connId, State muxMode initiatorCtx peerAddr versionData 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
          res <- MuxConnectionManager
  muxMode
  socket
  initiatorCtx
  (ResponderContext peerAddr)
  peerAddr
  versionData
  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
  initiatorCtx
  (ResponderContext peerAddr)
  peerAddr
  versionData
  versionNumber
  ByteString
  m
  a
  b
connectionManager
                                      (ConnectionId peerAddr -> peerAddr
forall addr. ConnectionId addr -> addr
remoteAddress ConnectionId peerAddr
connId)
          traceWith tracer (TrPromotedToWarmRemote connId res)

          when (resultInState res == UnknownConnectionSt) $ do
            traceWith tracer (TrUnexpectedlyFalseAssertion
                                (InboundGovernorLoop
                                  (Just connId)
                                  UnknownConnectionSt)
                             )
            evaluate (assert False ())

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

          return (Just connId, state')

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

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

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

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

        CommitRemote ConnectionId peerAddr
connId -> do
          res <- MuxConnectionManager
  muxMode
  socket
  initiatorCtx
  (ResponderContext peerAddr)
  peerAddr
  versionData
  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
  initiatorCtx
  (ResponderContext peerAddr)
  peerAddr
  versionData
  versionNumber
  ByteString
  m
  a
  b
connectionManager
                                             (ConnectionId peerAddr -> peerAddr
forall addr. ConnectionId addr -> addr
remoteAddress ConnectionId peerAddr
connId)
          traceWith tracer $ TrDemotedToColdRemote connId res
          case res of
            UnsupportedState {} -> do
              -- 'inState' can be either:
              -- @'UnknownConnection'@,
              -- @'InReservedOutboundState'@,
              -- @'InUnnegotiatedState',
              -- @'InOutboundState' 'Unidirectional'@,
              -- @'InTerminatingState'@,
              -- @'InTermiantedState'@.
              let state' :: State muxMode initiatorCtx peerAddr versionData m a b
state' = ConnectionId peerAddr
-> State muxMode initiatorCtx peerAddr versionData m a b
-> State muxMode initiatorCtx peerAddr versionData m a b
forall peerAddr (muxMode :: MuxMode) initiatorCtx versionData
       (m :: * -> *) a b.
Ord peerAddr =>
ConnectionId peerAddr
-> State muxMode initiatorCtx peerAddr versionData m a b
-> State muxMode initiatorCtx peerAddr versionData m a b
unregisterConnection ConnectionId peerAddr
connId State muxMode initiatorCtx peerAddr versionData m a b
state
              (Maybe (ConnectionId peerAddr),
 State muxMode initiatorCtx peerAddr versionData m a b)
-> m (Maybe (ConnectionId peerAddr),
      State muxMode initiatorCtx peerAddr versionData m a b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (ConnectionId peerAddr -> Maybe (ConnectionId peerAddr)
forall a. a -> Maybe a
Just ConnectionId peerAddr
connId, State muxMode initiatorCtx peerAddr versionData m a b
state')

            TerminatedConnection {} -> do
              -- 'inState' can be either:
              -- @'InTerminatingState'@,
              -- @'InTermiantedState'@.
              let state' :: State muxMode initiatorCtx peerAddr versionData m a b
state' = ConnectionId peerAddr
-> State muxMode initiatorCtx peerAddr versionData m a b
-> State muxMode initiatorCtx peerAddr versionData m a b
forall peerAddr (muxMode :: MuxMode) initiatorCtx versionData
       (m :: * -> *) a b.
Ord peerAddr =>
ConnectionId peerAddr
-> State muxMode initiatorCtx peerAddr versionData m a b
-> State muxMode initiatorCtx peerAddr versionData m a b
unregisterConnection ConnectionId peerAddr
connId State muxMode initiatorCtx peerAddr versionData m a b
state
              (Maybe (ConnectionId peerAddr),
 State muxMode initiatorCtx peerAddr versionData m a b)
-> m (Maybe (ConnectionId peerAddr),
      State muxMode initiatorCtx peerAddr versionData m a b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (ConnectionId peerAddr -> Maybe (ConnectionId peerAddr)
forall a. a -> Maybe a
Just ConnectionId peerAddr
connId, State muxMode initiatorCtx peerAddr versionData 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' :: State muxMode initiatorCtx peerAddr versionData m a b
state' = ConnectionId peerAddr
-> State muxMode initiatorCtx peerAddr versionData m a b
-> State muxMode initiatorCtx peerAddr versionData m a b
forall peerAddr (muxMode :: MuxMode) initiatorCtx versionData
       (m :: * -> *) a b.
Ord peerAddr =>
ConnectionId peerAddr
-> State muxMode initiatorCtx peerAddr versionData m a b
-> State muxMode initiatorCtx peerAddr versionData m a b
unregisterConnection ConnectionId peerAddr
connId State muxMode initiatorCtx peerAddr versionData m a b
state
                  (Maybe (ConnectionId peerAddr),
 State muxMode initiatorCtx peerAddr versionData m a b)
-> m (Maybe (ConnectionId peerAddr),
      State muxMode initiatorCtx peerAddr versionData m a b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (ConnectionId peerAddr -> Maybe (ConnectionId peerAddr)
forall a. a -> Maybe a
Just ConnectionId peerAddr
connId, State muxMode initiatorCtx peerAddr versionData 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' :: State muxMode initiatorCtx peerAddr versionData m a b
state' = ConnectionId peerAddr
-> RemoteState m
-> State muxMode initiatorCtx peerAddr versionData m a b
-> State muxMode initiatorCtx peerAddr versionData m a b
forall peerAddr (m :: * -> *) (muxMode :: MuxMode) initiatorCtx
       versionData a b.
Ord peerAddr =>
ConnectionId peerAddr
-> RemoteState m
-> State muxMode initiatorCtx peerAddr versionData m a b
-> State muxMode initiatorCtx peerAddr versionData m a b
updateRemoteState ConnectionId peerAddr
connId RemoteState m
forall (m :: * -> *). RemoteState m
RemoteCold State muxMode initiatorCtx peerAddr versionData m a b
state

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

        MaturedDuplexPeers Map peerAddr versionData
newMatureDuplexPeers OrdPSQ peerAddr Time versionData
freshDuplexPeers -> do
          Tracer m (Trace peerAddr) -> Trace peerAddr -> m ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer m (Trace peerAddr)
tracer (Trace peerAddr -> m ()) -> Trace peerAddr -> m ()
forall a b. (a -> b) -> a -> b
$ Set peerAddr -> Set peerAddr -> Trace peerAddr
forall peerAddr. Set peerAddr -> Set peerAddr -> Trace peerAddr
TrMaturedConnections (Map peerAddr versionData -> Set peerAddr
forall k a. Map k a -> Set k
Map.keysSet Map peerAddr versionData
newMatureDuplexPeers)
                                                  ([peerAddr] -> Set peerAddr
forall a. Ord a => [a] -> Set a
Set.fromList ([peerAddr] -> Set peerAddr) -> [peerAddr] -> Set peerAddr
forall a b. (a -> b) -> a -> b
$ OrdPSQ peerAddr Time versionData -> [peerAddr]
forall k p v. OrdPSQ k p v -> [k]
OrdPSQ.keys OrdPSQ peerAddr Time versionData
freshDuplexPeers)
          (Maybe (ConnectionId peerAddr),
 State muxMode initiatorCtx peerAddr versionData m a b)
-> m (Maybe (ConnectionId peerAddr),
      State muxMode initiatorCtx peerAddr versionData m a b)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (ConnectionId peerAddr)
forall a. Maybe a
Nothing, State muxMode initiatorCtx peerAddr versionData m a b
state { matureDuplexPeers = newMatureDuplexPeers
                                                  <> matureDuplexPeers state,
                                 freshDuplexPeers })

        Event muxMode initiatorCtx peerAddr versionData m a b
InactivityTimeout -> do
          Tracer m (Trace peerAddr) -> Trace peerAddr -> m ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer m (Trace peerAddr)
tracer (Trace peerAddr -> m ()) -> Trace peerAddr -> m ()
forall a b. (a -> b) -> a -> b
$ [(peerAddr, Time)] -> Trace peerAddr
forall peerAddr. [(peerAddr, Time)] -> Trace peerAddr
TrInactive ((\(peerAddr
a,Time
b,versionData
_) -> (peerAddr
a,Time
b)) ((peerAddr, Time, versionData) -> (peerAddr, Time))
-> [(peerAddr, Time, versionData)] -> [(peerAddr, Time)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> OrdPSQ peerAddr Time versionData -> [(peerAddr, Time, versionData)]
forall k p v. OrdPSQ k p v -> [(k, p, v)]
OrdPSQ.toList (State muxMode initiatorCtx peerAddr versionData m a b
-> OrdPSQ peerAddr Time versionData
forall (muxMode :: MuxMode) initiatorCtx peerAddr versionData
       (m :: * -> *) a b.
State muxMode initiatorCtx peerAddr versionData m a b
-> OrdPSQ peerAddr Time versionData
freshDuplexPeers State muxMode initiatorCtx peerAddr versionData m a b
state))
          (Maybe (ConnectionId peerAddr),
 State muxMode initiatorCtx peerAddr versionData m a b)
-> m (Maybe (ConnectionId peerAddr),
      State muxMode initiatorCtx peerAddr versionData m a b)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (ConnectionId peerAddr)
forall a. Maybe a
Nothing, State muxMode initiatorCtx peerAddr versionData m a b
state)

      mask_ $ do
        atomically $ writeTVar var (mkPublicState state')
        traceWith debugTracer (Debug state')
        case 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
-> State muxMode initiatorCtx peerAddr versionData m a b
-> State muxMode initiatorCtx peerAddr versionData m a b
-> RemoteTransitionTrace peerAddr
forall peerAddr (muxMode :: MuxMode) initiatorCtx versionData
       (m :: * -> *) a b.
Ord peerAddr =>
ConnectionId peerAddr
-> State muxMode initiatorCtx peerAddr versionData m a b
-> State muxMode initiatorCtx peerAddr versionData m a b
-> RemoteTransitionTrace peerAddr
mkRemoteTransitionTrace ConnectionId peerAddr
cid State muxMode initiatorCtx peerAddr versionData m a b
state State muxMode initiatorCtx peerAddr versionData m a b
state')
          Maybe (ConnectionId peerAddr)
Nothing  -> () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

      mapTraceWithCache TrInboundGovernorCounters
                        tracer
                        (countersCache state')
                        (counters state')
      traceWith tracer $ TrRemoteState $
            mkRemoteSt . csRemoteState
        <$> connections state'

      -- Update Inbound Governor Counters cache values
      let newCounters       = State muxMode initiatorCtx peerAddr versionData m a b -> Counters
forall (muxMode :: MuxMode) initiatorCtx peerAddr versionData
       (m :: * -> *) a b.
State muxMode initiatorCtx peerAddr versionData m a b -> Counters
counters State muxMode initiatorCtx peerAddr versionData m a b
state'
          Cache oldCounters = countersCache state'
          state'' | Counters
newCounters Counters -> Counters -> Bool
forall a. Eq a => a -> a -> Bool
/= Counters
oldCounters = State muxMode initiatorCtx peerAddr versionData m a b
state' { countersCache = Cache newCounters }
                  | Bool
otherwise                 = State muxMode initiatorCtx peerAddr versionData m a b
state'

      inboundGovernorLoop var state''


-- | Run a responder mini-protocol.
--
-- @'HasResponder' mode ~ True@ is used to rule out
-- 'InitiatorProtocolOnly' case.
--
runResponder :: forall (mode :: MuxMode) initiatorCtx peerAddr m a b.
                 ( Alternative (STM m)
                 , HasResponder mode ~ True
                 , MonadAsync       m
                 , MonadLabelledSTM m
                 , MonadCatch       m
                 , MonadMask        m
                 , MonadThrow  (STM m)
                 )
              => Mux.Mux mode m
              -> MiniProtocolData mode initiatorCtx peerAddr m a b
              -> Mux.StartOnDemandOrEagerly
              -> m (Either SomeException (STM m (Either SomeException b)))
runResponder :: forall (mode :: MuxMode) initiatorCtx peerAddr (m :: * -> *) a b.
(Alternative (STM m), HasResponder mode ~ 'True, MonadAsync m,
 MonadLabelledSTM m, MonadCatch m, MonadMask m,
 MonadThrow (STM m)) =>
Mux mode m
-> MiniProtocolData mode initiatorCtx peerAddr m a b
-> StartOnDemandOrEagerly
-> m (Either SomeException (STM m (Either SomeException b)))
runResponder Mux mode m
mux
             MiniProtocolData {
               mpdMiniProtocol :: forall (muxMode :: MuxMode) initiatorCtx peerAddr (m :: * -> *) a
       b.
MiniProtocolData muxMode initiatorCtx peerAddr m a b
-> MiniProtocol
     muxMode initiatorCtx (ResponderContext peerAddr) ByteString m a b
mpdMiniProtocol     = MiniProtocol
  mode initiatorCtx (ResponderContext peerAddr) ByteString m a b
miniProtocol,
               mpdResponderContext :: forall (muxMode :: MuxMode) initiatorCtx peerAddr (m :: * -> *) a
       b.
MiniProtocolData muxMode initiatorCtx peerAddr m a b
-> ResponderContext peerAddr
mpdResponderContext = ResponderContext peerAddr
responderContext
             }
             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 e b a.
Exception e =>
(e -> Maybe b) -> m a -> m (Either b a)
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 MiniProtocol
  mode initiatorCtx (ResponderContext peerAddr) ByteString m a b
-> RunMiniProtocol
     mode initiatorCtx (ResponderContext peerAddr) ByteString m a b
forall (mode :: MuxMode) initiatorCtx responderCtx bytes
       (m :: * -> *) a b.
MiniProtocol mode initiatorCtx responderCtx bytes m a b
-> RunMiniProtocol mode initiatorCtx responderCtx bytes m a b
miniProtocolRun MiniProtocol
  mode initiatorCtx (ResponderContext peerAddr) ByteString m a b
miniProtocol of
        ResponderProtocolOnly MiniProtocolCb (ResponderContext peerAddr) ByteString m b
responder ->
          Mux mode m
-> MiniProtocolNum
-> MiniProtocolDirection mode
-> StartOnDemandOrEagerly
-> (ByteChannel m -> m (b, Maybe ByteString))
-> m (STM m (Either SomeException b))
forall (mode :: MuxMode) (m :: * -> *) a.
(Alternative (STM m), MonadSTM m, MonadThrow m,
 MonadThrow (STM m)) =>
Mux mode m
-> MiniProtocolNum
-> MiniProtocolDirection mode
-> StartOnDemandOrEagerly
-> (ByteChannel m -> m (a, Maybe ByteString))
-> m (STM m (Either SomeException a))
Mux.runMiniProtocol
            Mux mode m
mux (MiniProtocol
  mode initiatorCtx (ResponderContext peerAddr) ByteString m a b
-> MiniProtocolNum
forall (mode :: MuxMode) initiatorCtx responderCtx bytes
       (m :: * -> *) a b.
MiniProtocol mode initiatorCtx responderCtx bytes m a b
-> MiniProtocolNum
miniProtocolNum MiniProtocol
  mode initiatorCtx (ResponderContext peerAddr) ByteString m a b
miniProtocol)
            MiniProtocolDirection mode
MiniProtocolDirection 'ResponderMode
Mux.ResponderDirectionOnly
            StartOnDemandOrEagerly
startStrategy
            (MiniProtocolCb (ResponderContext peerAddr) ByteString m b
-> ResponderContext peerAddr
-> ByteChannel m
-> m (b, Maybe ByteString)
forall (m :: * -> *) ctx a.
(MonadAsync m, MonadThrow m) =>
MiniProtocolCb ctx ByteString m a
-> ctx -> ByteChannel m -> m (a, Maybe ByteString)
runMiniProtocolCb MiniProtocolCb (ResponderContext peerAddr) ByteString m b
responder ResponderContext peerAddr
responderContext)

        InitiatorAndResponderProtocol MiniProtocolCb initiatorCtx ByteString m a
_ MiniProtocolCb (ResponderContext peerAddr) ByteString m b
responder ->
          Mux mode m
-> MiniProtocolNum
-> MiniProtocolDirection mode
-> StartOnDemandOrEagerly
-> (ByteChannel m -> m (b, Maybe ByteString))
-> m (STM m (Either SomeException b))
forall (mode :: MuxMode) (m :: * -> *) a.
(Alternative (STM m), MonadSTM m, MonadThrow m,
 MonadThrow (STM m)) =>
Mux mode m
-> MiniProtocolNum
-> MiniProtocolDirection mode
-> StartOnDemandOrEagerly
-> (ByteChannel m -> m (a, Maybe ByteString))
-> m (STM m (Either SomeException a))
Mux.runMiniProtocol
            Mux mode m
mux (MiniProtocol
  mode initiatorCtx (ResponderContext peerAddr) ByteString m a b
-> MiniProtocolNum
forall (mode :: MuxMode) initiatorCtx responderCtx bytes
       (m :: * -> *) a b.
MiniProtocol mode initiatorCtx responderCtx bytes m a b
-> MiniProtocolNum
miniProtocolNum MiniProtocol
  mode initiatorCtx (ResponderContext peerAddr) ByteString m a b
miniProtocol)
            MiniProtocolDirection mode
MiniProtocolDirection 'InitiatorResponderMode
Mux.ResponderDirection
            StartOnDemandOrEagerly
startStrategy
            (MiniProtocolCb (ResponderContext peerAddr) ByteString m b
-> ResponderContext peerAddr
-> ByteChannel m
-> m (b, Maybe ByteString)
forall (m :: * -> *) ctx a.
(MonadAsync m, MonadThrow m) =>
MiniProtocolCb ctx ByteString m a
-> ctx -> ByteChannel m -> m (a, Maybe ByteString)
runMiniProtocolCb MiniProtocolCb (ResponderContext peerAddr) ByteString m b
responder ResponderContext peerAddr
responderContext)


maturedPeers :: Ord peerAddr
             => Time
             -> OrdPSQ peerAddr Time versionData
             -> (Map peerAddr versionData, OrdPSQ peerAddr Time versionData)
maturedPeers :: forall peerAddr versionData.
Ord peerAddr =>
Time
-> OrdPSQ peerAddr Time versionData
-> (Map peerAddr versionData, OrdPSQ peerAddr Time versionData)
maturedPeers Time
time OrdPSQ peerAddr Time versionData
freshPeers =
      ([(peerAddr, Time, versionData)] -> Map peerAddr versionData)
-> ([(peerAddr, Time, versionData)],
    OrdPSQ peerAddr Time versionData)
-> (Map peerAddr versionData, OrdPSQ peerAddr Time versionData)
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ([(peerAddr, versionData)] -> Map peerAddr versionData
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(peerAddr, versionData)] -> Map peerAddr versionData)
-> ([(peerAddr, Time, versionData)] -> [(peerAddr, versionData)])
-> [(peerAddr, Time, versionData)]
-> Map peerAddr versionData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((peerAddr, Time, versionData) -> (peerAddr, versionData))
-> [(peerAddr, Time, versionData)] -> [(peerAddr, versionData)]
forall a b. (a -> b) -> [a] -> [b]
map (\(peerAddr
addr, Time
_p, versionData
v) -> (peerAddr
addr, versionData
v)))
    (([(peerAddr, Time, versionData)],
  OrdPSQ peerAddr Time versionData)
 -> (Map peerAddr versionData, OrdPSQ peerAddr Time versionData))
-> ([(peerAddr, Time, versionData)],
    OrdPSQ peerAddr Time versionData)
-> (Map peerAddr versionData, OrdPSQ peerAddr Time versionData)
forall a b. (a -> b) -> a -> b
$ Time
-> OrdPSQ peerAddr Time versionData
-> ([(peerAddr, Time, versionData)],
    OrdPSQ peerAddr Time versionData)
forall k p v.
(Ord k, Ord p) =>
p -> OrdPSQ k p v -> ([(k, p, v)], OrdPSQ k p v)
OrdPSQ.atMostView ((-DiffTime
inboundMaturePeerDelay) DiffTime -> Time -> Time
`addTime` Time
time)
                           OrdPSQ peerAddr Time versionData
freshPeers

--
-- Trace
--


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

type RemoteTransitionTrace peerAddr = TransitionTrace' peerAddr (Maybe RemoteSt)

mkRemoteTransitionTrace :: Ord peerAddr
                        => ConnectionId peerAddr
                        -> State muxMode initiatorCtx peerAddr versionData m a b
                        -> State muxMode initiatorCtx peerAddr versionData m a b
                        -> RemoteTransitionTrace peerAddr
mkRemoteTransitionTrace :: forall peerAddr (muxMode :: MuxMode) initiatorCtx versionData
       (m :: * -> *) a b.
Ord peerAddr =>
ConnectionId peerAddr
-> State muxMode initiatorCtx peerAddr versionData m a b
-> State muxMode initiatorCtx peerAddr versionData m a b
-> RemoteTransitionTrace peerAddr
mkRemoteTransitionTrace ConnectionId peerAddr
connId State muxMode initiatorCtx peerAddr versionData m a b
fromState State muxMode initiatorCtx peerAddr versionData m a b
toState =
    peerAddr
-> Transition' (Maybe RemoteSt)
-> TransitionTrace' peerAddr (Maybe RemoteSt)
forall peerAddr state.
peerAddr -> Transition' state -> TransitionTrace' peerAddr state
TransitionTrace
      (ConnectionId peerAddr -> peerAddr
forall addr. ConnectionId addr -> addr
remoteAddress ConnectionId peerAddr
connId)
      Transition { fromState :: Maybe RemoteSt
fromState = RemoteState m -> RemoteSt
forall (m :: * -> *). RemoteState m -> RemoteSt
mkRemoteSt
                             (RemoteState m -> RemoteSt)
-> (ConnectionState muxMode initiatorCtx peerAddr versionData m a b
    -> RemoteState m)
-> ConnectionState muxMode initiatorCtx peerAddr versionData m a b
-> RemoteSt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConnectionState muxMode initiatorCtx peerAddr versionData m a b
-> RemoteState m
forall (muxMode :: MuxMode) initiatorCtx peerAddr versionData
       (m :: * -> *) a b.
ConnectionState muxMode initiatorCtx peerAddr versionData m a b
-> RemoteState m
csRemoteState
                           (ConnectionState muxMode initiatorCtx peerAddr versionData m a b
 -> RemoteSt)
-> Maybe
     (ConnectionState muxMode initiatorCtx peerAddr versionData m a b)
-> Maybe RemoteSt
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ConnectionId peerAddr
-> Map
     (ConnectionId peerAddr)
     (ConnectionState muxMode initiatorCtx peerAddr versionData m a b)
-> Maybe
     (ConnectionState muxMode initiatorCtx peerAddr versionData m a b)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup ConnectionId peerAddr
connId (State muxMode initiatorCtx peerAddr versionData m a b
-> Map
     (ConnectionId peerAddr)
     (ConnectionState muxMode initiatorCtx peerAddr versionData m a b)
forall (muxMode :: MuxMode) initiatorCtx peerAddr versionData
       (m :: * -> *) a b.
State muxMode initiatorCtx peerAddr versionData m a b
-> Map
     (ConnectionId peerAddr)
     (ConnectionState muxMode initiatorCtx peerAddr versionData m a b)
connections State muxMode initiatorCtx peerAddr versionData m a b
fromState)
                 , toState :: Maybe RemoteSt
toState   = RemoteState m -> RemoteSt
forall (m :: * -> *). RemoteState m -> RemoteSt
mkRemoteSt
                             (RemoteState m -> RemoteSt)
-> (ConnectionState muxMode initiatorCtx peerAddr versionData m a b
    -> RemoteState m)
-> ConnectionState muxMode initiatorCtx peerAddr versionData m a b
-> RemoteSt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConnectionState muxMode initiatorCtx peerAddr versionData m a b
-> RemoteState m
forall (muxMode :: MuxMode) initiatorCtx peerAddr versionData
       (m :: * -> *) a b.
ConnectionState muxMode initiatorCtx peerAddr versionData m a b
-> RemoteState m
csRemoteState
                           (ConnectionState muxMode initiatorCtx peerAddr versionData m a b
 -> RemoteSt)
-> Maybe
     (ConnectionState muxMode initiatorCtx peerAddr versionData m a b)
-> Maybe RemoteSt
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ConnectionId peerAddr
-> Map
     (ConnectionId peerAddr)
     (ConnectionState muxMode initiatorCtx peerAddr versionData m a b)
-> Maybe
     (ConnectionState muxMode initiatorCtx peerAddr versionData m a b)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup ConnectionId peerAddr
connId (State muxMode initiatorCtx peerAddr versionData m a b
-> Map
     (ConnectionId peerAddr)
     (ConnectionState muxMode initiatorCtx peerAddr versionData m a b)
forall (muxMode :: MuxMode) initiatorCtx peerAddr versionData
       (m :: * -> *) a b.
State muxMode initiatorCtx peerAddr versionData m a b
-> Map
     (ConnectionId peerAddr)
     (ConnectionState muxMode initiatorCtx peerAddr versionData m a b)
connections State muxMode initiatorCtx peerAddr versionData 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
$cshowsPrec :: forall peerAddr.
Show peerAddr =>
Int -> IGAssertionLocation peerAddr -> ShowS
showsPrec :: Int -> IGAssertionLocation peerAddr -> ShowS
$cshow :: forall peerAddr.
Show peerAddr =>
IGAssertionLocation peerAddr -> String
show :: IGAssertionLocation peerAddr -> String
$cshowList :: forall peerAddr.
Show peerAddr =>
[IGAssertionLocation peerAddr] -> ShowS
showList :: [IGAssertionLocation peerAddr] -> ShowS
Show

data Trace 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      !Counters
    | TrRemoteState                  !(Map (ConnectionId peerAddr) RemoteSt)
    | TrUnexpectedlyFalseAssertion   !(IGAssertionLocation peerAddr)
    -- ^ This case is unexpected at call site.
    | TrInboundGovernorError         !SomeException
    | TrMaturedConnections           !(Set peerAddr) !(Set peerAddr)
    | TrInactive                     ![(peerAddr, Time)]
  deriving Int -> Trace peerAddr -> ShowS
[Trace peerAddr] -> ShowS
Trace peerAddr -> String
(Int -> Trace peerAddr -> ShowS)
-> (Trace peerAddr -> String)
-> ([Trace peerAddr] -> ShowS)
-> Show (Trace peerAddr)
forall peerAddr. Show peerAddr => Int -> Trace peerAddr -> ShowS
forall peerAddr. Show peerAddr => [Trace peerAddr] -> ShowS
forall peerAddr. Show peerAddr => Trace peerAddr -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall peerAddr. Show peerAddr => Int -> Trace peerAddr -> ShowS
showsPrec :: Int -> Trace peerAddr -> ShowS
$cshow :: forall peerAddr. Show peerAddr => Trace peerAddr -> String
show :: Trace peerAddr -> String
$cshowList :: forall peerAddr. Show peerAddr => [Trace peerAddr] -> ShowS
showList :: [Trace peerAddr] -> ShowS
Show


data Debug peerAddr versionData = forall muxMode initiatorCtx m a b.
    Debug (State muxMode initiatorCtx peerAddr versionData m a b)