{-# LANGUAGE DataKinds           #-}
{-# LANGUAGE FlexibleContexts    #-}
{-# LANGUAGE KindSignatures      #-}
{-# LANGUAGE LambdaCase          #-}
{-# LANGUAGE NamedFieldPuns      #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections       #-}

-- Internals of inbound protocol governor.  This module provide 'Event' type,
-- which enumerates external events and stm action which block until these
-- events fire.
--
module Ouroboros.Network.InboundGovernor.Event
  ( Event (..)
  , EventSignal
  , firstMuxToFinish
  , Terminated (..)
  , firstMiniProtocolToFinish
  , firstPeerPromotedToWarm
  , firstPeerPromotedToHot
  , firstPeerDemotedToWarm
  , firstPeerDemotedToCold
  , firstPeerCommitRemote
  , NewConnectionInfo (..)
  ) where

import Control.Applicative (Alternative)
import Control.Concurrent.Class.MonadSTM.Strict
import Control.Monad.Class.MonadThrow hiding (handle)
import Control.Monad.Class.MonadTime.SI

import Data.ByteString.Lazy (ByteString)
import Data.Functor (($>))
import Data.Map.Strict (Map)
import Data.Map.Strict qualified as Map
import Data.Monoid.Synchronisation
import Data.OrdPSQ (OrdPSQ)
import Data.Set qualified as Set

import Network.Mux qualified as Mux
import Network.Mux.Types (MiniProtocolDir (..), MiniProtocolStatus (..))

import Ouroboros.Network.ConnectionHandler
import Ouroboros.Network.ConnectionManager.Types
import Ouroboros.Network.Context
import Ouroboros.Network.InboundGovernor.State
import Ouroboros.Network.Mux


-- | Announcement message for a new connection.
--
data NewConnectionInfo peerAddr handle

    -- | Announce a new connection.  /Inbound protocol governor/ will start
    -- responder protocols using 'StartOnDemand' strategy and monitor remote
    -- transitions: @PromotedToWarm^{Duplex}_{Remote}@ and
    -- @DemotedToCold^{dataFlow}_{Remote}@.
    = NewConnectionInfo
      !Provenance
      !(ConnectionId peerAddr)
      !DataFlow
      !handle

instance Show peerAddr
      => Show (NewConnectionInfo peerAddr handle) where
      show :: NewConnectionInfo peerAddr handle -> String
show (NewConnectionInfo Provenance
provenance ConnectionId peerAddr
connId DataFlow
dataFlow handle
_) =
        [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ String
"NewConnectionInfo "
               , Provenance -> String
forall a. Show a => a -> String
show Provenance
provenance
               , String
" "
               , ConnectionId peerAddr -> String
forall a. Show a => a -> String
show ConnectionId peerAddr
connId
               , String
" "
               , DataFlow -> String
forall a. Show a => a -> String
show DataFlow
dataFlow
               ]

-- | Edge triggered events to which the /inbound protocol governor/ reacts.
--
data Event (muxMode :: Mux.Mode) initiatorCtx peerAddr versionData m a b
    -- | A request to start mini-protocol bundle, either from the server or from
    -- connection manager after a duplex connection was negotiated.
    --
    = NewConnection !(NewConnectionInfo peerAddr
                        (Handle muxMode initiatorCtx (ResponderContext peerAddr) versionData ByteString m a b))

    -- | A multiplexer exited.
    --
    | MuxFinished            !(ConnectionId peerAddr) !(Maybe SomeException)

    -- | A mini-protocol terminated either cleanly or abruptly.
    --
    | MiniProtocolTerminated !(Terminated muxMode initiatorCtx peerAddr m a b)

    -- | Transition from 'RemoteEstablished' to 'RemoteIdle'.
    --
    | WaitIdleRemote         !(ConnectionId peerAddr)

    -- | A remote @warm → hot@ transition.  It is scheduled as soon as all hot
    -- mini-protocols are running.
    --
    | RemotePromotedToHot    !(ConnectionId peerAddr)

    -- | A @hot → warm@ transition.  It is scheduled as soon as any hot
    -- mini-protocol terminates.
    --
    | RemoteDemotedToWarm    !(ConnectionId peerAddr)

    -- | Transition from 'RemoteIdle' to 'RemoteCold'.
    --
    | CommitRemote           !(ConnectionId peerAddr)

    -- | Transition from 'RemoteIdle' or 'RemoteCold' to 'RemoteEstablished'.
    --
    | AwakeRemote            !(ConnectionId peerAddr)

    -- | Update `igsMatureDuplexPeers` and `igsFreshDuplexPeers`.
    --
    | MaturedDuplexPeers   !(Map peerAddr versionData)         -- ^ newly matured duplex peers
                           !(OrdPSQ peerAddr Time versionData) -- ^ queue of fresh duplex peers

    | InactivityTimeout


--
-- STM transactions which detect 'Event's (signals)
--


-- | A signal which returns an 'Event'.  Signals are combined together and
-- passed used to fold the current state map.
--
type EventSignal (muxMode :: Mux.Mode) initiatorCtx peerAddr versionData m a b =
        ConnectionId peerAddr
     -> ConnectionState muxMode initiatorCtx peerAddr versionData m a b
     -> FirstToFinish (STM m) (Event muxMode initiatorCtx peerAddr versionData m a b)

-- | A mux stopped.  If mux exited cleanly no error is attached.
--
firstMuxToFinish :: MonadSTM m
                 => EventSignal muxMode initiatorCtx peerAddr versionData m a b
firstMuxToFinish :: forall (m :: * -> *) (muxMode :: Mode) initiatorCtx peerAddr
       versionData a b.
MonadSTM m =>
EventSignal muxMode initiatorCtx peerAddr versionData m a b
firstMuxToFinish ConnectionId peerAddr
connId ConnectionState { Mux muxMode m
csMux :: Mux muxMode m
csMux :: forall (muxMode :: Mode) initiatorCtx peerAddr versionData
       (m :: * -> *) a b.
ConnectionState muxMode initiatorCtx peerAddr versionData m a b
-> Mux muxMode m
csMux } =
    STM m (Event muxMode initiatorCtx peerAddr versionData m a b)
-> FirstToFinish
     (STM m) (Event muxMode initiatorCtx peerAddr versionData m a b)
forall (m :: * -> *) a. m a -> FirstToFinish m a
FirstToFinish (STM m (Event muxMode initiatorCtx peerAddr versionData m a b)
 -> FirstToFinish
      (STM m) (Event muxMode initiatorCtx peerAddr versionData m a b))
-> STM m (Event muxMode initiatorCtx peerAddr versionData m a b)
-> FirstToFinish
     (STM m) (Event muxMode initiatorCtx peerAddr versionData m a b)
forall a b. (a -> b) -> a -> b
$ ConnectionId peerAddr
-> Maybe SomeException
-> Event muxMode initiatorCtx peerAddr versionData m a b
forall (muxMode :: Mode) initiatorCtx peerAddr versionData
       (m :: * -> *) a b.
ConnectionId peerAddr
-> Maybe SomeException
-> Event muxMode initiatorCtx peerAddr versionData m a b
MuxFinished ConnectionId peerAddr
connId (Maybe SomeException
 -> Event muxMode initiatorCtx peerAddr versionData m a b)
-> STM m (Maybe SomeException)
-> STM m (Event muxMode initiatorCtx peerAddr versionData m a b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Mux muxMode m -> STM m (Maybe SomeException)
forall (m :: * -> *) (mode :: Mode).
MonadSTM m =>
Mux mode m -> STM m (Maybe SomeException)
Mux.stopped Mux muxMode m
csMux


-- | When a mini-protocol terminates we take 'Terminated' out of 'ConnectionState
-- and pass it to the main loop.  This is just enough to decide if we need to
-- restart a mini-protocol and to do the restart.
--
data Terminated muxMode initiatorCtx peerAddr m a b = Terminated {
    forall (muxMode :: Mode) initiatorCtx peerAddr (m :: * -> *) a b.
Terminated muxMode initiatorCtx peerAddr m a b
-> ConnectionId peerAddr
tConnId           :: !(ConnectionId peerAddr),
    forall (muxMode :: Mode) initiatorCtx peerAddr (m :: * -> *) a b.
Terminated muxMode initiatorCtx peerAddr m a b -> Mux muxMode m
tMux              :: !(Mux.Mux muxMode m),
    forall (muxMode :: Mode) initiatorCtx peerAddr (m :: * -> *) a b.
Terminated muxMode initiatorCtx peerAddr m a b
-> MiniProtocolData muxMode initiatorCtx peerAddr m a b
tMiniProtocolData :: !(MiniProtocolData muxMode initiatorCtx peerAddr m a b),
    forall (muxMode :: Mode) initiatorCtx peerAddr (m :: * -> *) a b.
Terminated muxMode initiatorCtx peerAddr m a b -> DataFlow
tDataFlow         :: !DataFlow,
    forall (muxMode :: Mode) initiatorCtx peerAddr (m :: * -> *) a b.
Terminated muxMode initiatorCtx peerAddr m a b
-> Either SomeException b
tResult           :: !(Either SomeException b)
  }


-- | Detect when one of the mini-protocols terminated.
--
-- /triggers:/ 'MiniProtocolTerminated'.
--
firstMiniProtocolToFinish :: Alternative (STM m)
                          => (versionData -> DataFlow)
                          -> EventSignal muxMode initiatorCtx peerAddr versionData m a b
firstMiniProtocolToFinish :: forall (m :: * -> *) versionData (muxMode :: Mode) initiatorCtx
       peerAddr a b.
Alternative (STM m) =>
(versionData -> DataFlow)
-> EventSignal muxMode initiatorCtx peerAddr versionData m a b
firstMiniProtocolToFinish
    versionData -> DataFlow
connDataFlow
    ConnectionId peerAddr
connId
    ConnectionState { Mux muxMode m
csMux :: forall (muxMode :: Mode) initiatorCtx peerAddr versionData
       (m :: * -> *) a b.
ConnectionState muxMode initiatorCtx peerAddr versionData m a b
-> Mux muxMode m
csMux :: Mux muxMode m
csMux,
                      versionData
csVersionData :: versionData
csVersionData :: forall (muxMode :: Mode) initiatorCtx peerAddr versionData
       (m :: * -> *) a b.
ConnectionState muxMode initiatorCtx peerAddr versionData m a b
-> versionData
csVersionData,
                      Map
  MiniProtocolNum
  (MiniProtocolData muxMode initiatorCtx peerAddr m a b)
csMiniProtocolMap :: Map
  MiniProtocolNum
  (MiniProtocolData muxMode initiatorCtx peerAddr m a b)
csMiniProtocolMap :: forall (muxMode :: Mode) initiatorCtx peerAddr versionData
       (m :: * -> *) a b.
ConnectionState muxMode initiatorCtx peerAddr versionData m a b
-> 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 :: forall (muxMode :: Mode) initiatorCtx peerAddr versionData
       (m :: * -> *) a b.
ConnectionState muxMode initiatorCtx peerAddr versionData m a b
-> Map MiniProtocolNum (STM m (Either SomeException b))
csCompletionMap
                    }
    = (MiniProtocolNum
 -> STM m (Either SomeException b)
 -> FirstToFinish
      (STM m) (Event muxMode initiatorCtx peerAddr versionData m a b))
-> Map MiniProtocolNum (STM m (Either SomeException b))
-> FirstToFinish
     (STM m) (Event muxMode initiatorCtx peerAddr versionData m a b)
forall m k a. Monoid m => (k -> a -> m) -> Map k a -> m
Map.foldMapWithKey
        (\MiniProtocolNum
miniProtocolNum STM m (Either SomeException b)
completionAction ->
              (\Either SomeException b
tResult -> Terminated muxMode initiatorCtx peerAddr m a b
-> Event muxMode initiatorCtx peerAddr versionData m a b
forall (muxMode :: Mode) initiatorCtx peerAddr versionData
       (m :: * -> *) a b.
Terminated muxMode initiatorCtx peerAddr m a b
-> Event muxMode initiatorCtx peerAddr versionData m a b
MiniProtocolTerminated (Terminated muxMode initiatorCtx peerAddr m a b
 -> Event muxMode initiatorCtx peerAddr versionData m a b)
-> Terminated muxMode initiatorCtx peerAddr m a b
-> Event muxMode initiatorCtx peerAddr versionData m a b
forall a b. (a -> b) -> a -> b
$ Terminated {
                    tConnId :: ConnectionId peerAddr
tConnId           = ConnectionId peerAddr
connId,
                    tMux :: Mux muxMode m
tMux              = Mux muxMode m
csMux,
                    tMiniProtocolData :: MiniProtocolData muxMode initiatorCtx peerAddr m a b
tMiniProtocolData = Map
  MiniProtocolNum
  (MiniProtocolData muxMode initiatorCtx peerAddr m a b)
csMiniProtocolMap Map
  MiniProtocolNum
  (MiniProtocolData muxMode initiatorCtx peerAddr m a b)
-> MiniProtocolNum
-> MiniProtocolData muxMode initiatorCtx peerAddr m a b
forall k a. Ord k => Map k a -> k -> a
Map.! MiniProtocolNum
miniProtocolNum,
                    tDataFlow :: DataFlow
tDataFlow         = versionData -> DataFlow
connDataFlow versionData
csVersionData,
                    Either SomeException b
tResult :: Either SomeException b
tResult :: Either SomeException b
tResult
                  }
              )
          (Either SomeException b
 -> Event muxMode initiatorCtx peerAddr versionData m a b)
-> FirstToFinish (STM m) (Either SomeException b)
-> FirstToFinish
     (STM m) (Event muxMode initiatorCtx peerAddr versionData m a b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> STM m (Either SomeException b)
-> FirstToFinish (STM m) (Either SomeException b)
forall (m :: * -> *) a. m a -> FirstToFinish m a
FirstToFinish STM m (Either SomeException b)
completionAction
        )
        Map MiniProtocolNum (STM m (Either SomeException b))
csCompletionMap


-- | Detect when one of the peers was promoted to warm, e.g.
-- @PromotedToWarm^{Duplex}_{Remote}@ or
-- @PromotedToWarm^{Unidirectional}_{Remote}@.
--
-- /triggers:/ 'PromotedToWarm'
--
-- Note: The specification only describes @PromotedToWarm^{Duplex}_{Remote}@
-- transition, but here we don't make a distinction on @Duplex@ and
-- @Unidirectional@ connections.
--
firstPeerPromotedToWarm :: forall muxMode initiatorCtx peerAddr versionData m a b.
                           ( Alternative (STM m)
                           , MonadSTM m
                           )
                        => EventSignal muxMode initiatorCtx peerAddr versionData m a b
firstPeerPromotedToWarm :: forall (muxMode :: Mode) initiatorCtx peerAddr versionData
       (m :: * -> *) a b.
(Alternative (STM m), MonadSTM m) =>
EventSignal muxMode initiatorCtx peerAddr versionData m a b
firstPeerPromotedToWarm
    ConnectionId peerAddr
connId
    ConnectionState { Mux muxMode m
csMux :: forall (muxMode :: Mode) initiatorCtx peerAddr versionData
       (m :: * -> *) a b.
ConnectionState muxMode initiatorCtx peerAddr versionData m a b
-> Mux muxMode m
csMux :: Mux muxMode m
csMux, RemoteState m
csRemoteState :: RemoteState m
csRemoteState :: forall (muxMode :: Mode) initiatorCtx peerAddr versionData
       (m :: * -> *) a b.
ConnectionState muxMode initiatorCtx peerAddr versionData m a b
-> RemoteState m
csRemoteState }
    = case RemoteState m
csRemoteState of
        -- the connection is already in 'RemoteEstablished' state.
        RemoteState m
RemoteEstablished -> FirstToFinish
  (STM m) (Event muxMode initiatorCtx peerAddr versionData m a b)
forall a. Monoid a => a
mempty

        -- If the connection is in 'RemoteCold' state we do first to finish
        -- synchronisation to detect incoming traffic on any of the responder
        -- mini-protocols.
        --
        -- This works for both duplex and unidirectional connections (e.g. p2p
        -- \/ non-p2p nodes), for which protocols are started eagerly, unlike
        -- for p2p nodes for which we start all mini-protocols on demand.
        -- Using 'miniProtocolStatusVar' is ok for unidirectional connection,
        -- as we never restart the protocols for them.  They transition to
        -- 'RemoteWarm' as soon the connection is accepted.  This is because
        -- for eagerly started mini-protocols mux puts them in 'StatusRunning'
        -- as soon as mini-protocols are set in place by 'runMiniProtocol'.
        RemoteState m
RemoteCold ->
          ((MiniProtocolNum, MiniProtocolDir)
 -> STM m MiniProtocolStatus
 -> FirstToFinish
      (STM m) (Event muxMode initiatorCtx peerAddr versionData m a b))
-> Map
     (MiniProtocolNum, MiniProtocolDir) (STM m MiniProtocolStatus)
-> FirstToFinish
     (STM m) (Event muxMode initiatorCtx peerAddr versionData m a b)
forall m k a. Monoid m => (k -> a -> m) -> Map k a -> m
Map.foldMapWithKey
            (MiniProtocolNum, MiniProtocolDir)
-> STM m MiniProtocolStatus
-> FirstToFinish
     (STM m) (Event muxMode initiatorCtx peerAddr versionData m a b)
fn
            (Mux muxMode m
-> Map
     (MiniProtocolNum, MiniProtocolDir) (STM m MiniProtocolStatus)
forall (m :: * -> *) (mode :: Mode).
MonadSTM m =>
Mux mode m
-> Map
     (MiniProtocolNum, MiniProtocolDir) (STM m MiniProtocolStatus)
Mux.miniProtocolStateMap Mux muxMode m
csMux)

        -- We skip it here; this case is done in 'firstPeerDemotedToCold'.
        RemoteIdle {} ->
          ((MiniProtocolNum, MiniProtocolDir)
 -> STM m MiniProtocolStatus
 -> FirstToFinish
      (STM m) (Event muxMode initiatorCtx peerAddr versionData m a b))
-> Map
     (MiniProtocolNum, MiniProtocolDir) (STM m MiniProtocolStatus)
-> FirstToFinish
     (STM m) (Event muxMode initiatorCtx peerAddr versionData m a b)
forall m k a. Monoid m => (k -> a -> m) -> Map k a -> m
Map.foldMapWithKey
            (MiniProtocolNum, MiniProtocolDir)
-> STM m MiniProtocolStatus
-> FirstToFinish
     (STM m) (Event muxMode initiatorCtx peerAddr versionData m a b)
fn
            (Mux muxMode m
-> Map
     (MiniProtocolNum, MiniProtocolDir) (STM m MiniProtocolStatus)
forall (m :: * -> *) (mode :: Mode).
MonadSTM m =>
Mux mode m
-> Map
     (MiniProtocolNum, MiniProtocolDir) (STM m MiniProtocolStatus)
Mux.miniProtocolStateMap Mux muxMode m
csMux)
  where
    fn :: (MiniProtocolNum, MiniProtocolDir)
       -> STM m MiniProtocolStatus
       -> FirstToFinish (STM m) (Event muxMode initiatorCtx peerAddr versionData m a b)
    fn :: (MiniProtocolNum, MiniProtocolDir)
-> STM m MiniProtocolStatus
-> FirstToFinish
     (STM m) (Event muxMode initiatorCtx peerAddr versionData m a b)
fn = \(MiniProtocolNum
_miniProtocolNum, MiniProtocolDir
miniProtocolDir) STM m MiniProtocolStatus
miniProtocolStatus ->
      case MiniProtocolDir
miniProtocolDir of
        MiniProtocolDir
InitiatorDir -> FirstToFinish
  (STM m) (Event muxMode initiatorCtx peerAddr versionData m a b)
forall a. Monoid a => a
mempty

        MiniProtocolDir
ResponderDir ->
          STM m (Event muxMode initiatorCtx peerAddr versionData m a b)
-> FirstToFinish
     (STM m) (Event muxMode initiatorCtx peerAddr versionData m a b)
forall (m :: * -> *) a. m a -> FirstToFinish m a
FirstToFinish (STM m (Event muxMode initiatorCtx peerAddr versionData m a b)
 -> FirstToFinish
      (STM m) (Event muxMode initiatorCtx peerAddr versionData m a b))
-> STM m (Event muxMode initiatorCtx peerAddr versionData m a b)
-> FirstToFinish
     (STM m) (Event muxMode initiatorCtx peerAddr versionData m a b)
forall a b. (a -> b) -> a -> b
$
            STM m MiniProtocolStatus
miniProtocolStatus STM m MiniProtocolStatus
-> (MiniProtocolStatus
    -> STM m (Event muxMode initiatorCtx peerAddr versionData m a b))
-> STM m (Event muxMode initiatorCtx peerAddr versionData m a b)
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
>>= \case
              MiniProtocolStatus
StatusIdle          -> STM m (Event muxMode initiatorCtx peerAddr versionData m a b)
forall a. STM m a
forall (m :: * -> *) a. MonadSTM m => STM m a
retry
              MiniProtocolStatus
StatusStartOnDemand -> STM m (Event muxMode initiatorCtx peerAddr versionData m a b)
forall a. STM m a
forall (m :: * -> *) a. MonadSTM m => STM m a
retry
              MiniProtocolStatus
StatusRunning       -> 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 (m :: * -> *) a. Monad m => a -> m a
return (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
$ ConnectionId peerAddr
-> Event muxMode initiatorCtx peerAddr versionData m a b
forall (muxMode :: Mode) initiatorCtx peerAddr versionData
       (m :: * -> *) a b.
ConnectionId peerAddr
-> Event muxMode initiatorCtx peerAddr versionData m a b
AwakeRemote ConnectionId peerAddr
connId


-- | Detect when a first warm peer is promoted to hot (any hot mini-protocols
-- is running).
--
firstPeerPromotedToHot :: forall muxMode initiatorCtx peerAddr versionData m a b.
                          ( Alternative (STM m)
                          , MonadSTM m
                          )
                       => EventSignal muxMode initiatorCtx peerAddr versionData m a b
firstPeerPromotedToHot :: forall (muxMode :: Mode) initiatorCtx peerAddr versionData
       (m :: * -> *) a b.
(Alternative (STM m), MonadSTM m) =>
EventSignal muxMode initiatorCtx peerAddr versionData m a b
firstPeerPromotedToHot
   ConnectionId peerAddr
connId connState :: ConnectionState muxMode initiatorCtx peerAddr versionData m a b
connState@ConnectionState { RemoteState m
csRemoteState :: forall (muxMode :: Mode) initiatorCtx peerAddr versionData
       (m :: * -> *) a b.
ConnectionState muxMode initiatorCtx peerAddr versionData m a b
-> RemoteState m
csRemoteState :: RemoteState m
csRemoteState }
   = case RemoteState m
csRemoteState of
       RemoteState m
RemoteHot     -> FirstToFinish
  (STM m) (Event muxMode initiatorCtx peerAddr versionData m a b)
forall a. Monoid a => a
mempty
       RemoteState m
RemoteWarm    ->
           (() -> Event muxMode initiatorCtx peerAddr versionData m a b)
-> FirstToFinish (STM m) ()
-> FirstToFinish
     (STM m) (Event muxMode initiatorCtx peerAddr versionData m a b)
forall a b.
(a -> b) -> FirstToFinish (STM m) a -> FirstToFinish (STM m) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Event muxMode initiatorCtx peerAddr versionData m a b
-> () -> Event muxMode initiatorCtx peerAddr versionData m a b
forall a b. a -> b -> a
const (Event muxMode initiatorCtx peerAddr versionData m a b
 -> () -> Event muxMode initiatorCtx peerAddr versionData m a b)
-> Event muxMode initiatorCtx peerAddr versionData m a b
-> ()
-> Event muxMode initiatorCtx peerAddr versionData m a b
forall a b. (a -> b) -> a -> b
$ ConnectionId peerAddr
-> Event muxMode initiatorCtx peerAddr versionData m a b
forall (muxMode :: Mode) initiatorCtx peerAddr versionData
       (m :: * -> *) a b.
ConnectionId peerAddr
-> Event muxMode initiatorCtx peerAddr versionData m a b
RemotePromotedToHot ConnectionId peerAddr
connId)
         (FirstToFinish (STM m) ()
 -> FirstToFinish
      (STM m) (Event muxMode initiatorCtx peerAddr versionData m a b))
-> FirstToFinish (STM m) ()
-> FirstToFinish
     (STM m) (Event muxMode initiatorCtx peerAddr versionData m a b)
forall a b. (a -> b) -> a -> b
$ (STM m MiniProtocolStatus -> FirstToFinish (STM m) ())
-> Map
     (MiniProtocolNum, MiniProtocolDir) (STM m MiniProtocolStatus)
-> FirstToFinish (STM m) ()
forall m a.
Monoid m =>
(a -> m) -> Map (MiniProtocolNum, MiniProtocolDir) a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap STM m MiniProtocolStatus -> FirstToFinish (STM m) ()
fn
             (ConnectionState muxMode initiatorCtx peerAddr versionData m a b
-> Map
     (MiniProtocolNum, MiniProtocolDir) (STM m MiniProtocolStatus)
hotMiniProtocolStateMap ConnectionState muxMode initiatorCtx peerAddr versionData m a b
connState)
       RemoteState m
RemoteCold    ->
           (() -> Event muxMode initiatorCtx peerAddr versionData m a b)
-> FirstToFinish (STM m) ()
-> FirstToFinish
     (STM m) (Event muxMode initiatorCtx peerAddr versionData m a b)
forall a b.
(a -> b) -> FirstToFinish (STM m) a -> FirstToFinish (STM m) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Event muxMode initiatorCtx peerAddr versionData m a b
-> () -> Event muxMode initiatorCtx peerAddr versionData m a b
forall a b. a -> b -> a
const (Event muxMode initiatorCtx peerAddr versionData m a b
 -> () -> Event muxMode initiatorCtx peerAddr versionData m a b)
-> Event muxMode initiatorCtx peerAddr versionData m a b
-> ()
-> Event muxMode initiatorCtx peerAddr versionData m a b
forall a b. (a -> b) -> a -> b
$ ConnectionId peerAddr
-> Event muxMode initiatorCtx peerAddr versionData m a b
forall (muxMode :: Mode) initiatorCtx peerAddr versionData
       (m :: * -> *) a b.
ConnectionId peerAddr
-> Event muxMode initiatorCtx peerAddr versionData m a b
RemotePromotedToHot ConnectionId peerAddr
connId)
         (FirstToFinish (STM m) ()
 -> FirstToFinish
      (STM m) (Event muxMode initiatorCtx peerAddr versionData m a b))
-> FirstToFinish (STM m) ()
-> FirstToFinish
     (STM m) (Event muxMode initiatorCtx peerAddr versionData m a b)
forall a b. (a -> b) -> a -> b
$ (STM m MiniProtocolStatus -> FirstToFinish (STM m) ())
-> Map
     (MiniProtocolNum, MiniProtocolDir) (STM m MiniProtocolStatus)
-> FirstToFinish (STM m) ()
forall m a.
Monoid m =>
(a -> m) -> Map (MiniProtocolNum, MiniProtocolDir) a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap STM m MiniProtocolStatus -> FirstToFinish (STM m) ()
fn
             (ConnectionState muxMode initiatorCtx peerAddr versionData m a b
-> Map
     (MiniProtocolNum, MiniProtocolDir) (STM m MiniProtocolStatus)
hotMiniProtocolStateMap ConnectionState muxMode initiatorCtx peerAddr versionData m a b
connState)
       RemoteIdle {} -> FirstToFinish
  (STM m) (Event muxMode initiatorCtx peerAddr versionData m a b)
forall a. Monoid a => a
mempty
  where
    -- only hot mini-protocols;
    hotMiniProtocolStateMap :: ConnectionState muxMode initiatorCtx peerAddr versionData m a b
                            -> Map (MiniProtocolNum, MiniProtocolDir)
                                   (STM m MiniProtocolStatus)
    hotMiniProtocolStateMap :: ConnectionState muxMode initiatorCtx peerAddr versionData m a b
-> Map
     (MiniProtocolNum, MiniProtocolDir) (STM m MiniProtocolStatus)
hotMiniProtocolStateMap ConnectionState { Mux muxMode m
csMux :: forall (muxMode :: Mode) initiatorCtx peerAddr versionData
       (m :: * -> *) a b.
ConnectionState muxMode initiatorCtx peerAddr versionData m a b
-> Mux muxMode m
csMux :: Mux muxMode m
csMux, Map
  MiniProtocolNum
  (MiniProtocolData muxMode initiatorCtx peerAddr m a b)
csMiniProtocolMap :: forall (muxMode :: Mode) initiatorCtx peerAddr versionData
       (m :: * -> *) a b.
ConnectionState muxMode initiatorCtx peerAddr versionData m a b
-> Map
     MiniProtocolNum
     (MiniProtocolData muxMode initiatorCtx peerAddr m a b)
csMiniProtocolMap :: Map
  MiniProtocolNum
  (MiniProtocolData muxMode initiatorCtx peerAddr m a b)
csMiniProtocolMap } =
       Mux muxMode m
-> Map
     (MiniProtocolNum, MiniProtocolDir) (STM m MiniProtocolStatus)
forall (m :: * -> *) (mode :: Mode).
MonadSTM m =>
Mux mode m
-> Map
     (MiniProtocolNum, MiniProtocolDir) (STM m MiniProtocolStatus)
Mux.miniProtocolStateMap Mux muxMode m
csMux
       Map (MiniProtocolNum, MiniProtocolDir) (STM m MiniProtocolStatus)
-> Set (MiniProtocolNum, MiniProtocolDir)
-> Map
     (MiniProtocolNum, MiniProtocolDir) (STM m MiniProtocolStatus)
forall k a. Ord k => Map k a -> Set k -> Map k a
`Map.restrictKeys`
       ( (MiniProtocolNum -> (MiniProtocolNum, MiniProtocolDir))
-> Set MiniProtocolNum -> Set (MiniProtocolNum, MiniProtocolDir)
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map (,MiniProtocolDir
ResponderDir)
       (Set MiniProtocolNum -> Set (MiniProtocolNum, MiniProtocolDir))
-> (Map
      MiniProtocolNum
      (MiniProtocolData muxMode initiatorCtx peerAddr m a b)
    -> Set MiniProtocolNum)
-> Map
     MiniProtocolNum
     (MiniProtocolData muxMode initiatorCtx peerAddr m a b)
-> Set (MiniProtocolNum, MiniProtocolDir)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map
  MiniProtocolNum
  (MiniProtocolData muxMode initiatorCtx peerAddr m a b)
-> Set MiniProtocolNum
forall k a. Map k a -> Set k
Map.keysSet
       (Map
   MiniProtocolNum
   (MiniProtocolData muxMode initiatorCtx peerAddr m a b)
 -> Set MiniProtocolNum)
-> (Map
      MiniProtocolNum
      (MiniProtocolData muxMode initiatorCtx peerAddr m a b)
    -> Map
         MiniProtocolNum
         (MiniProtocolData muxMode initiatorCtx peerAddr m a b))
-> Map
     MiniProtocolNum
     (MiniProtocolData muxMode initiatorCtx peerAddr m a b)
-> Set MiniProtocolNum
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (MiniProtocolData muxMode initiatorCtx peerAddr m a b -> Bool)
-> Map
     MiniProtocolNum
     (MiniProtocolData muxMode initiatorCtx peerAddr m a b)
-> Map
     MiniProtocolNum
     (MiniProtocolData muxMode initiatorCtx peerAddr m a b)
forall a k. (a -> Bool) -> Map k a -> Map k a
Map.filter
           (\MiniProtocolData { ProtocolTemperature
mpdMiniProtocolTemp :: ProtocolTemperature
mpdMiniProtocolTemp :: forall (muxMode :: Mode) initiatorCtx peerAddr (m :: * -> *) a b.
MiniProtocolData muxMode initiatorCtx peerAddr m a b
-> ProtocolTemperature
mpdMiniProtocolTemp } ->
              case ProtocolTemperature
mpdMiniProtocolTemp of
                ProtocolTemperature
Hot -> Bool
True
                ProtocolTemperature
_   -> Bool
False
           )
       (Map
   MiniProtocolNum
   (MiniProtocolData muxMode initiatorCtx peerAddr m a b)
 -> Set (MiniProtocolNum, MiniProtocolDir))
-> Map
     MiniProtocolNum
     (MiniProtocolData muxMode initiatorCtx peerAddr m a b)
-> Set (MiniProtocolNum, MiniProtocolDir)
forall a b. (a -> b) -> a -> b
$ Map
  MiniProtocolNum
  (MiniProtocolData muxMode initiatorCtx peerAddr m a b)
csMiniProtocolMap
       )

    fn :: STM m MiniProtocolStatus
       -> FirstToFinish (STM m) ()
    fn :: STM m MiniProtocolStatus -> FirstToFinish (STM m) ()
fn STM m MiniProtocolStatus
miniProtocolStatus =
      STM m () -> FirstToFinish (STM m) ()
forall (m :: * -> *) a. m a -> FirstToFinish m a
FirstToFinish (STM m () -> FirstToFinish (STM m) ())
-> STM m () -> FirstToFinish (STM m) ()
forall a b. (a -> b) -> a -> b
$
        STM m MiniProtocolStatus
miniProtocolStatus STM m MiniProtocolStatus
-> (MiniProtocolStatus -> 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
>>= \case
          MiniProtocolStatus
StatusIdle          -> STM m ()
forall a. STM m a
forall (m :: * -> *) a. MonadSTM m => STM m a
retry
          MiniProtocolStatus
StatusStartOnDemand -> STM m ()
forall a. STM m a
forall (m :: * -> *) a. MonadSTM m => STM m a
retry
          MiniProtocolStatus
StatusRunning       -> () -> STM m ()
forall a. a -> STM m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()


-- | Detect when all hot mini-protocols terminates, which triggers the
-- `RemoteHot → RemoteWarm` transition.
--
firstPeerDemotedToWarm :: forall muxMode initiatorCtx peerAddr versionData m a b.
                          ( Alternative (STM m)
                          , MonadSTM m
                          )
                       => EventSignal muxMode initiatorCtx peerAddr versionData m a b
firstPeerDemotedToWarm :: forall (muxMode :: Mode) initiatorCtx peerAddr versionData
       (m :: * -> *) a b.
(Alternative (STM m), MonadSTM m) =>
EventSignal muxMode initiatorCtx peerAddr versionData m a b
firstPeerDemotedToWarm
    ConnectionId peerAddr
connId connState :: ConnectionState muxMode initiatorCtx peerAddr versionData m a b
connState@ConnectionState { RemoteState m
csRemoteState :: forall (muxMode :: Mode) initiatorCtx peerAddr versionData
       (m :: * -> *) a b.
ConnectionState muxMode initiatorCtx peerAddr versionData m a b
-> RemoteState m
csRemoteState :: RemoteState m
csRemoteState }
    = case RemoteState m
csRemoteState of
        RemoteState m
RemoteHot ->
           LastToFinishM
  (STM m) (Event muxMode initiatorCtx peerAddr versionData m a b)
-> FirstToFinish
     (STM m) (Event muxMode initiatorCtx peerAddr versionData m a b)
forall (m :: * -> *) a. LastToFinishM m a -> FirstToFinish m a
lastToFirstM (LastToFinishM
   (STM m) (Event muxMode initiatorCtx peerAddr versionData m a b)
 -> FirstToFinish
      (STM m) (Event muxMode initiatorCtx peerAddr versionData m a b))
-> LastToFinishM
     (STM m) (Event muxMode initiatorCtx peerAddr versionData m a b)
-> FirstToFinish
     (STM m) (Event muxMode initiatorCtx peerAddr versionData m a b)
forall a b. (a -> b) -> a -> b
$
              ConnectionId peerAddr
-> Event muxMode initiatorCtx peerAddr versionData m a b
forall (muxMode :: Mode) initiatorCtx peerAddr versionData
       (m :: * -> *) a b.
ConnectionId peerAddr
-> Event muxMode initiatorCtx peerAddr versionData m a b
RemoteDemotedToWarm ConnectionId peerAddr
connId Event muxMode initiatorCtx peerAddr versionData m a b
-> LastToFinishM (STM m) ()
-> LastToFinishM
     (STM m) (Event muxMode initiatorCtx peerAddr versionData m a b)
forall a b. a -> LastToFinishM (STM m) b -> LastToFinishM (STM m) a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (STM m MiniProtocolStatus -> LastToFinishM (STM m) ())
-> Map
     (MiniProtocolNum, MiniProtocolDir) (STM m MiniProtocolStatus)
-> LastToFinishM (STM m) ()
forall m a.
Monoid m =>
(a -> m) -> Map (MiniProtocolNum, MiniProtocolDir) a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap STM m MiniProtocolStatus -> LastToFinishM (STM m) ()
fn (ConnectionState muxMode initiatorCtx peerAddr versionData m a b
-> Map
     (MiniProtocolNum, MiniProtocolDir) (STM m MiniProtocolStatus)
hotMiniProtocolStateMap ConnectionState muxMode initiatorCtx peerAddr versionData m a b
connState)

        RemoteState m
_  -> FirstToFinish
  (STM m) (Event muxMode initiatorCtx peerAddr versionData m a b)
forall a. Monoid a => a
mempty
  where
    -- only hot mini-protocols;
    hotMiniProtocolStateMap :: ConnectionState muxMode initiatorCtx peerAddr versionData m a b
                            -> Map (MiniProtocolNum, MiniProtocolDir)
                                   (STM m MiniProtocolStatus)
    hotMiniProtocolStateMap :: ConnectionState muxMode initiatorCtx peerAddr versionData m a b
-> Map
     (MiniProtocolNum, MiniProtocolDir) (STM m MiniProtocolStatus)
hotMiniProtocolStateMap ConnectionState { Mux muxMode m
csMux :: forall (muxMode :: Mode) initiatorCtx peerAddr versionData
       (m :: * -> *) a b.
ConnectionState muxMode initiatorCtx peerAddr versionData m a b
-> Mux muxMode m
csMux :: Mux muxMode m
csMux, Map
  MiniProtocolNum
  (MiniProtocolData muxMode initiatorCtx peerAddr m a b)
csMiniProtocolMap :: forall (muxMode :: Mode) initiatorCtx peerAddr versionData
       (m :: * -> *) a b.
ConnectionState muxMode initiatorCtx peerAddr versionData m a b
-> Map
     MiniProtocolNum
     (MiniProtocolData muxMode initiatorCtx peerAddr m a b)
csMiniProtocolMap :: Map
  MiniProtocolNum
  (MiniProtocolData muxMode initiatorCtx peerAddr m a b)
csMiniProtocolMap } =
       Mux muxMode m
-> Map
     (MiniProtocolNum, MiniProtocolDir) (STM m MiniProtocolStatus)
forall (m :: * -> *) (mode :: Mode).
MonadSTM m =>
Mux mode m
-> Map
     (MiniProtocolNum, MiniProtocolDir) (STM m MiniProtocolStatus)
Mux.miniProtocolStateMap Mux muxMode m
csMux
       Map (MiniProtocolNum, MiniProtocolDir) (STM m MiniProtocolStatus)
-> Set (MiniProtocolNum, MiniProtocolDir)
-> Map
     (MiniProtocolNum, MiniProtocolDir) (STM m MiniProtocolStatus)
forall k a. Ord k => Map k a -> Set k -> Map k a
`Map.restrictKeys`
       ( (MiniProtocolNum -> (MiniProtocolNum, MiniProtocolDir))
-> Set MiniProtocolNum -> Set (MiniProtocolNum, MiniProtocolDir)
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map (,MiniProtocolDir
ResponderDir)
       (Set MiniProtocolNum -> Set (MiniProtocolNum, MiniProtocolDir))
-> (Map
      MiniProtocolNum
      (MiniProtocolData muxMode initiatorCtx peerAddr m a b)
    -> Set MiniProtocolNum)
-> Map
     MiniProtocolNum
     (MiniProtocolData muxMode initiatorCtx peerAddr m a b)
-> Set (MiniProtocolNum, MiniProtocolDir)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map
  MiniProtocolNum
  (MiniProtocolData muxMode initiatorCtx peerAddr m a b)
-> Set MiniProtocolNum
forall k a. Map k a -> Set k
Map.keysSet
       (Map
   MiniProtocolNum
   (MiniProtocolData muxMode initiatorCtx peerAddr m a b)
 -> Set MiniProtocolNum)
-> (Map
      MiniProtocolNum
      (MiniProtocolData muxMode initiatorCtx peerAddr m a b)
    -> Map
         MiniProtocolNum
         (MiniProtocolData muxMode initiatorCtx peerAddr m a b))
-> Map
     MiniProtocolNum
     (MiniProtocolData muxMode initiatorCtx peerAddr m a b)
-> Set MiniProtocolNum
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (MiniProtocolData muxMode initiatorCtx peerAddr m a b -> Bool)
-> Map
     MiniProtocolNum
     (MiniProtocolData muxMode initiatorCtx peerAddr m a b)
-> Map
     MiniProtocolNum
     (MiniProtocolData muxMode initiatorCtx peerAddr m a b)
forall a k. (a -> Bool) -> Map k a -> Map k a
Map.filter
           (\MiniProtocolData { ProtocolTemperature
mpdMiniProtocolTemp :: forall (muxMode :: Mode) initiatorCtx peerAddr (m :: * -> *) a b.
MiniProtocolData muxMode initiatorCtx peerAddr m a b
-> ProtocolTemperature
mpdMiniProtocolTemp :: ProtocolTemperature
mpdMiniProtocolTemp } ->
                case ProtocolTemperature
mpdMiniProtocolTemp of
                  ProtocolTemperature
Hot -> Bool
True
                  ProtocolTemperature
_   -> Bool
False
           )
       (Map
   MiniProtocolNum
   (MiniProtocolData muxMode initiatorCtx peerAddr m a b)
 -> Set (MiniProtocolNum, MiniProtocolDir))
-> Map
     MiniProtocolNum
     (MiniProtocolData muxMode initiatorCtx peerAddr m a b)
-> Set (MiniProtocolNum, MiniProtocolDir)
forall a b. (a -> b) -> a -> b
$ Map
  MiniProtocolNum
  (MiniProtocolData muxMode initiatorCtx peerAddr m a b)
csMiniProtocolMap
       )

    fn :: STM m MiniProtocolStatus
       -> LastToFinishM (STM m) ()
    fn :: STM m MiniProtocolStatus -> LastToFinishM (STM m) ()
fn STM m MiniProtocolStatus
miniProtocolStatus =
      STM m () -> LastToFinishM (STM m) ()
forall (m :: * -> *) a. m a -> LastToFinishM m a
LastToFinishM (STM m () -> LastToFinishM (STM m) ())
-> STM m () -> LastToFinishM (STM m) ()
forall a b. (a -> b) -> a -> b
$
        STM m MiniProtocolStatus
miniProtocolStatus STM m MiniProtocolStatus
-> (MiniProtocolStatus -> 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
>>= \case
          MiniProtocolStatus
StatusIdle          -> () -> STM m ()
forall a. a -> STM m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
          MiniProtocolStatus
StatusStartOnDemand -> () -> STM m ()
forall a. a -> STM m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
          MiniProtocolStatus
StatusRunning       -> STM m ()
forall a. STM m a
forall (m :: * -> *) a. MonadSTM m => STM m a
retry


-- | Await for first peer demoted to cold, i.e. detect the
-- @DemotedToCold^{Duplex}_{Remote}@.
--
-- /triggers:/ 'DemotedToColdRemote'
--
firstPeerDemotedToCold :: ( Alternative (STM m)
                          , MonadSTM m
                          )
                       => EventSignal muxMode initiatorCtx peerAddr versionData m a b
firstPeerDemotedToCold :: forall (m :: * -> *) (muxMode :: Mode) initiatorCtx peerAddr
       versionData a b.
(Alternative (STM m), MonadSTM m) =>
EventSignal muxMode initiatorCtx peerAddr versionData m a b
firstPeerDemotedToCold
    ConnectionId peerAddr
connId
    ConnectionState {
      Mux muxMode m
csMux :: forall (muxMode :: Mode) initiatorCtx peerAddr versionData
       (m :: * -> *) a b.
ConnectionState muxMode initiatorCtx peerAddr versionData m a b
-> Mux muxMode m
csMux :: Mux muxMode m
csMux,
      RemoteState m
csRemoteState :: forall (muxMode :: Mode) initiatorCtx peerAddr versionData
       (m :: * -> *) a b.
ConnectionState muxMode initiatorCtx peerAddr versionData m a b
-> RemoteState m
csRemoteState :: RemoteState m
csRemoteState
    }
    = case RemoteState m
csRemoteState of
        -- the connection is already in 'RemoteCold' state
        RemoteState m
RemoteCold -> FirstToFinish
  (STM m) (Event muxMode initiatorCtx peerAddr versionData m a b)
forall a. Monoid a => a
mempty

        -- Responders are started using 'StartOnDemand' strategy. We detect
        -- when all of the responders are in 'StatusIdle' or
        -- 'StatusStartOnDemand' and subsequently put the connection in
        -- 'RemoteIdle' state.
        --
        -- In compat mode, when established mini-protocols terminate they will
        -- not be restarted.
        RemoteState m
RemoteEstablished ->
              (() -> Event muxMode initiatorCtx peerAddr versionData m a b)
-> FirstToFinish (STM m) ()
-> FirstToFinish
     (STM m) (Event muxMode initiatorCtx peerAddr versionData m a b)
forall a b.
(a -> b) -> FirstToFinish (STM m) a -> FirstToFinish (STM m) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Event muxMode initiatorCtx peerAddr versionData m a b
-> () -> Event muxMode initiatorCtx peerAddr versionData m a b
forall a b. a -> b -> a
const (Event muxMode initiatorCtx peerAddr versionData m a b
 -> () -> Event muxMode initiatorCtx peerAddr versionData m a b)
-> Event muxMode initiatorCtx peerAddr versionData m a b
-> ()
-> Event muxMode initiatorCtx peerAddr versionData m a b
forall a b. (a -> b) -> a -> b
$ ConnectionId peerAddr
-> Event muxMode initiatorCtx peerAddr versionData m a b
forall (muxMode :: Mode) initiatorCtx peerAddr versionData
       (m :: * -> *) a b.
ConnectionId peerAddr
-> Event muxMode initiatorCtx peerAddr versionData m a b
WaitIdleRemote ConnectionId peerAddr
connId)
            (FirstToFinish (STM m) ()
 -> FirstToFinish
      (STM m) (Event muxMode initiatorCtx peerAddr versionData m a b))
-> (LastToFinishM (STM m) () -> FirstToFinish (STM m) ())
-> LastToFinishM (STM m) ()
-> FirstToFinish
     (STM m) (Event muxMode initiatorCtx peerAddr versionData m a b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LastToFinishM (STM m) () -> FirstToFinish (STM m) ()
forall (m :: * -> *) a. LastToFinishM m a -> FirstToFinish m a
lastToFirstM
            (LastToFinishM (STM m) ()
 -> FirstToFinish
      (STM m) (Event muxMode initiatorCtx peerAddr versionData m a b))
-> LastToFinishM (STM m) ()
-> FirstToFinish
     (STM m) (Event muxMode initiatorCtx peerAddr versionData m a b)
forall a b. (a -> b) -> a -> b
$ ((MiniProtocolNum, MiniProtocolDir)
 -> STM m MiniProtocolStatus -> LastToFinishM (STM m) ())
-> Map
     (MiniProtocolNum, MiniProtocolDir) (STM m MiniProtocolStatus)
-> LastToFinishM (STM m) ()
forall m k a. Monoid m => (k -> a -> m) -> Map k a -> m
Map.foldMapWithKey
                (\(MiniProtocolNum
_, MiniProtocolDir
miniProtocolDir) STM m MiniProtocolStatus
miniProtocolStatus ->
                  case MiniProtocolDir
miniProtocolDir of
                    MiniProtocolDir
InitiatorDir -> LastToFinishM (STM m) ()
forall a. Monoid a => a
mempty

                    MiniProtocolDir
ResponderDir ->
                      STM m () -> LastToFinishM (STM m) ()
forall (m :: * -> *) a. m a -> LastToFinishM m a
LastToFinishM (STM m () -> LastToFinishM (STM m) ())
-> STM m () -> LastToFinishM (STM m) ()
forall a b. (a -> b) -> a -> b
$ do
                        STM m MiniProtocolStatus
miniProtocolStatus STM m MiniProtocolStatus
-> (MiniProtocolStatus -> 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
>>= \case
                          MiniProtocolStatus
StatusIdle          -> () -> STM m ()
forall a. a -> STM m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                          MiniProtocolStatus
StatusStartOnDemand -> () -> STM m ()
forall a. a -> STM m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                          MiniProtocolStatus
StatusRunning       -> STM m ()
forall a. STM m a
forall (m :: * -> *) a. MonadSTM m => STM m a
retry
                )
                (Mux muxMode m
-> Map
     (MiniProtocolNum, MiniProtocolDir) (STM m MiniProtocolStatus)
forall (m :: * -> *) (mode :: Mode).
MonadSTM m =>
Mux mode m
-> Map
     (MiniProtocolNum, MiniProtocolDir) (STM m MiniProtocolStatus)
Mux.miniProtocolStateMap Mux muxMode m
csMux)

        RemoteIdle {} -> FirstToFinish
  (STM m) (Event muxMode initiatorCtx peerAddr versionData m a b)
forall a. Monoid a => a
mempty


-- | First peer for which the 'RemoteIdle' timeout expires.
--
firstPeerCommitRemote :: Alternative (STM m)
                      => EventSignal muxMode initiatorCtx peerAddr versionData m a b
firstPeerCommitRemote :: forall (m :: * -> *) (muxMode :: Mode) initiatorCtx peerAddr
       versionData a b.
Alternative (STM m) =>
EventSignal muxMode initiatorCtx peerAddr versionData m a b
firstPeerCommitRemote
    ConnectionId peerAddr
connId ConnectionState { RemoteState m
csRemoteState :: forall (muxMode :: Mode) initiatorCtx peerAddr versionData
       (m :: * -> *) a b.
ConnectionState muxMode initiatorCtx peerAddr versionData m a b
-> RemoteState m
csRemoteState :: RemoteState m
csRemoteState }
    = case RemoteState m
csRemoteState of
        -- the connection is already in 'RemoteCold' state
        RemoteState m
RemoteCold            -> FirstToFinish
  (STM m) (Event muxMode initiatorCtx peerAddr versionData m a b)
forall a. Monoid a => a
mempty
        RemoteState m
RemoteEstablished     -> FirstToFinish
  (STM m) (Event muxMode initiatorCtx peerAddr versionData m a b)
forall a. Monoid a => a
mempty
        RemoteIdle STM m ()
timeoutSTM -> STM m (Event muxMode initiatorCtx peerAddr versionData m a b)
-> FirstToFinish
     (STM m) (Event muxMode initiatorCtx peerAddr versionData m a b)
forall (m :: * -> *) a. m a -> FirstToFinish m a
FirstToFinish (STM m ()
timeoutSTM STM m ()
-> Event muxMode initiatorCtx peerAddr versionData m a b
-> STM m (Event muxMode initiatorCtx peerAddr versionData m a b)
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> ConnectionId peerAddr
-> Event muxMode initiatorCtx peerAddr versionData m a b
forall (muxMode :: Mode) initiatorCtx peerAddr versionData
       (m :: * -> *) a b.
ConnectionId peerAddr
-> Event muxMode initiatorCtx peerAddr versionData m a b
CommitRemote ConnectionId peerAddr
connId)