{-# LANGUAGE KindSignatures      #-}
{-# LANGUAGE LambdaCase          #-}
{-# LANGUAGE NamedFieldPuns      #-}
{-# LANGUAGE PatternSynonyms     #-}
{-# LANGUAGE RankNTypes          #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE ViewPatterns        #-}

-- Inbound protocol governor state.
--
module Ouroboros.Network.InboundGovernor.State
  ( InboundGovernorObservableState (..)
  , newObservableStateVar
  , newObservableStateVarIO
  , newObservableStateVarFromSeed
    -- * Internals
  , InboundGovernorState (..)
  , ConnectionState (..)
  , InboundGovernorCounters (..)
  , inboundGovernorCounters
  , unregisterConnection
  , updateMiniProtocol
  , RemoteState (.., RemoteEstablished)
  , updateRemoteState
  , mapRemoteState
  , MiniProtocolData (..)
  ) where

import           Control.Exception (assert)
import           Control.Monad.Class.MonadSTM.Strict
import           Control.Monad.Class.MonadThrow hiding (handle)

import           Data.ByteString.Lazy (ByteString)
import           Data.Cache (Cache)
import           Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import           System.Random (StdGen)
import qualified System.Random as Rnd

import qualified Network.Mux as Mux

import           Ouroboros.Network.ConnectionId (ConnectionId (..))
import           Ouroboros.Network.ConnectionManager.Types
import           Ouroboros.Network.Mux hiding (ControlMessage)


-- | Currently only 'StdGen', but in the future this will be extended to
-- a record which contains some useful statistics about peers to support more
-- advances prune strategies (see. 'PruneStrategy').
--
newtype InboundGovernorObservableState = InboundGovernorObservableState {
      InboundGovernorObservableState -> StdGen
igosPrng :: StdGen
    }

-- | Create new observable state 'StrictTVar'.
--
newObservableStateVar
    :: MonadLabelledSTM m
    => StdGen
    -> m (StrictTVar m InboundGovernorObservableState)
newObservableStateVar :: StdGen -> m (StrictTVar m InboundGovernorObservableState)
newObservableStateVar StdGen
prng = do
    StrictTVar m InboundGovernorObservableState
v <- InboundGovernorObservableState
-> m (StrictTVar m InboundGovernorObservableState)
forall (m :: * -> *) a. MonadSTM m => a -> m (StrictTVar m a)
newTVarIO (StdGen -> InboundGovernorObservableState
InboundGovernorObservableState StdGen
prng)
    StrictTVar m InboundGovernorObservableState -> String -> m ()
forall (m :: * -> *) a.
MonadLabelledSTM m =>
StrictTVar m a -> String -> m ()
labelTVarIO StrictTVar m InboundGovernorObservableState
v String
"observable-state-var"
    StrictTVar m InboundGovernorObservableState
-> m (StrictTVar m InboundGovernorObservableState)
forall (m :: * -> *) a. Monad m => a -> m a
return StrictTVar m InboundGovernorObservableState
v


-- | Using the global 'StdGen'.
--
newObservableStateVarIO
    :: IO (StrictTVar IO InboundGovernorObservableState)
newObservableStateVarIO :: IO (StrictTVar IO InboundGovernorObservableState)
newObservableStateVarIO = do
    StdGen
g <- IO StdGen
forall (m :: * -> *). MonadIO m => m StdGen
Rnd.getStdGen
    let (StdGen
g', StdGen
igsPrng) = StdGen -> (StdGen, StdGen)
forall g. RandomGen g => g -> (g, g)
Rnd.split StdGen
g
    StdGen -> IO ()
forall (m :: * -> *). MonadIO m => StdGen -> m ()
Rnd.setStdGen StdGen
g'
    StdGen -> IO (StrictTVar IO InboundGovernorObservableState)
forall (m :: * -> *).
MonadLabelledSTM m =>
StdGen -> m (StrictTVar m InboundGovernorObservableState)
newObservableStateVar StdGen
igsPrng


-- | Useful for testing, it is using 'Rnd.mkStdGen'.
--
newObservableStateVarFromSeed
    :: MonadLabelledSTM m
    => Int
    -> m (StrictTVar m InboundGovernorObservableState)
newObservableStateVarFromSeed :: Int -> m (StrictTVar m InboundGovernorObservableState)
newObservableStateVarFromSeed = StdGen -> m (StrictTVar m InboundGovernorObservableState)
forall (m :: * -> *).
MonadLabelledSTM m =>
StdGen -> m (StrictTVar m InboundGovernorObservableState)
newObservableStateVar (StdGen -> m (StrictTVar m InboundGovernorObservableState))
-> (Int -> StdGen)
-> Int
-> m (StrictTVar m InboundGovernorObservableState)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> StdGen
Rnd.mkStdGen


-- | 'InboundGovernorState', which consist of pure part, and a mutable part.
-- The mutable part can be observable from outside.  Future version could
-- contain additional statistics on the peers.
--
data InboundGovernorState muxMode peerAddr m a b =
    InboundGovernorState {
        -- | Map of connections state.  Modifying 'igsConnections' outside of
        -- 'inboundGovernorLoop' is not safe.
        --
        InboundGovernorState muxMode peerAddr m a b
-> Map
     (ConnectionId peerAddr) (ConnectionState muxMode peerAddr m a b)
igsConnections   :: !(Map (ConnectionId peerAddr)
                                  (ConnectionState muxMode peerAddr m a b)),

        -- | PRNG available to 'PrunePolicy'.
        --
        InboundGovernorState muxMode peerAddr m a b
-> StrictTVar m InboundGovernorObservableState
igsObservableVar :: !(StrictTVar m InboundGovernorObservableState),

        -- | 'InboundGovernorCounters' counters cache. Allows to only trace
        -- values when necessary.
        InboundGovernorState muxMode peerAddr m a b
-> Cache InboundGovernorCounters
igsCountersCache :: !(Cache InboundGovernorCounters)
      }

-- | Counters for tracing and analysis purposes
--
data InboundGovernorCounters = InboundGovernorCounters {
      InboundGovernorCounters -> Int
coldPeersRemote :: !Int,
      -- ^ the number of remote peers which are in 'RemoteCold' state
      InboundGovernorCounters -> Int
idlePeersRemote :: !Int,
      -- ^ the number of remote peers which are in 'RemoteIdle' state
      InboundGovernorCounters -> Int
warmPeersRemote :: !Int,
      -- ^ the number of remote peers which are in 'RemoteWarm' state (a close
      -- approximation of peers that have the node as a warm peer)
      InboundGovernorCounters -> Int
hotPeersRemote  :: !Int
      -- ^ the number of remote peers which are in 'RemoteHot' state (a close
      -- approximation of peers that have the node as a hot peer)
    }
  deriving (InboundGovernorCounters -> InboundGovernorCounters -> Bool
(InboundGovernorCounters -> InboundGovernorCounters -> Bool)
-> (InboundGovernorCounters -> InboundGovernorCounters -> Bool)
-> Eq InboundGovernorCounters
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InboundGovernorCounters -> InboundGovernorCounters -> Bool
$c/= :: InboundGovernorCounters -> InboundGovernorCounters -> Bool
== :: InboundGovernorCounters -> InboundGovernorCounters -> Bool
$c== :: InboundGovernorCounters -> InboundGovernorCounters -> Bool
Eq, Eq InboundGovernorCounters
Eq InboundGovernorCounters
-> (InboundGovernorCounters -> InboundGovernorCounters -> Ordering)
-> (InboundGovernorCounters -> InboundGovernorCounters -> Bool)
-> (InboundGovernorCounters -> InboundGovernorCounters -> Bool)
-> (InboundGovernorCounters -> InboundGovernorCounters -> Bool)
-> (InboundGovernorCounters -> InboundGovernorCounters -> Bool)
-> (InboundGovernorCounters
    -> InboundGovernorCounters -> InboundGovernorCounters)
-> (InboundGovernorCounters
    -> InboundGovernorCounters -> InboundGovernorCounters)
-> Ord InboundGovernorCounters
InboundGovernorCounters -> InboundGovernorCounters -> Bool
InboundGovernorCounters -> InboundGovernorCounters -> Ordering
InboundGovernorCounters
-> InboundGovernorCounters -> InboundGovernorCounters
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: InboundGovernorCounters
-> InboundGovernorCounters -> InboundGovernorCounters
$cmin :: InboundGovernorCounters
-> InboundGovernorCounters -> InboundGovernorCounters
max :: InboundGovernorCounters
-> InboundGovernorCounters -> InboundGovernorCounters
$cmax :: InboundGovernorCounters
-> InboundGovernorCounters -> InboundGovernorCounters
>= :: InboundGovernorCounters -> InboundGovernorCounters -> Bool
$c>= :: InboundGovernorCounters -> InboundGovernorCounters -> Bool
> :: InboundGovernorCounters -> InboundGovernorCounters -> Bool
$c> :: InboundGovernorCounters -> InboundGovernorCounters -> Bool
<= :: InboundGovernorCounters -> InboundGovernorCounters -> Bool
$c<= :: InboundGovernorCounters -> InboundGovernorCounters -> Bool
< :: InboundGovernorCounters -> InboundGovernorCounters -> Bool
$c< :: InboundGovernorCounters -> InboundGovernorCounters -> Bool
compare :: InboundGovernorCounters -> InboundGovernorCounters -> Ordering
$ccompare :: InboundGovernorCounters -> InboundGovernorCounters -> Ordering
$cp1Ord :: Eq InboundGovernorCounters
Ord, Int -> InboundGovernorCounters -> ShowS
[InboundGovernorCounters] -> ShowS
InboundGovernorCounters -> String
(Int -> InboundGovernorCounters -> ShowS)
-> (InboundGovernorCounters -> String)
-> ([InboundGovernorCounters] -> ShowS)
-> Show InboundGovernorCounters
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InboundGovernorCounters] -> ShowS
$cshowList :: [InboundGovernorCounters] -> ShowS
show :: InboundGovernorCounters -> String
$cshow :: InboundGovernorCounters -> String
showsPrec :: Int -> InboundGovernorCounters -> ShowS
$cshowsPrec :: Int -> InboundGovernorCounters -> ShowS
Show)

instance Semigroup InboundGovernorCounters where
    InboundGovernorCounters Int
c Int
i Int
w Int
h <> :: InboundGovernorCounters
-> InboundGovernorCounters -> InboundGovernorCounters
<> InboundGovernorCounters Int
c' Int
i' Int
w' Int
h' =
      Int -> Int -> Int -> Int -> InboundGovernorCounters
InboundGovernorCounters (Int
c Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
c') (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
i') (Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
w') (Int
h Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
h')

instance Monoid InboundGovernorCounters where
    mempty :: InboundGovernorCounters
mempty = Int -> Int -> Int -> Int -> InboundGovernorCounters
InboundGovernorCounters Int
0 Int
0 Int
0 Int
0


inboundGovernorCounters :: InboundGovernorState muxMode peerAddr m a b
                        -> InboundGovernorCounters
inboundGovernorCounters :: InboundGovernorState muxMode peerAddr m a b
-> InboundGovernorCounters
inboundGovernorCounters InboundGovernorState { Map
  (ConnectionId peerAddr) (ConnectionState muxMode peerAddr m a b)
igsConnections :: Map
  (ConnectionId peerAddr) (ConnectionState muxMode peerAddr m a b)
igsConnections :: forall (muxMode :: MuxMode) peerAddr (m :: * -> *) a b.
InboundGovernorState muxMode peerAddr m a b
-> Map
     (ConnectionId peerAddr) (ConnectionState muxMode peerAddr m a b)
igsConnections } =
    (ConnectionState muxMode peerAddr m a b -> InboundGovernorCounters)
-> Map
     (ConnectionId peerAddr) (ConnectionState muxMode peerAddr m a b)
-> InboundGovernorCounters
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (\ConnectionState { RemoteState m
csRemoteState :: forall (muxMode :: MuxMode) peerAddr (m :: * -> *) a b.
ConnectionState muxMode peerAddr m a b -> RemoteState m
csRemoteState :: RemoteState m
csRemoteState } ->
              case RemoteState m
csRemoteState of
                RemoteState m
RemoteCold    -> Int -> Int -> Int -> Int -> InboundGovernorCounters
InboundGovernorCounters Int
1 Int
0 Int
0 Int
0
                RemoteIdle {} -> Int -> Int -> Int -> Int -> InboundGovernorCounters
InboundGovernorCounters Int
0 Int
1 Int
0 Int
0
                RemoteState m
RemoteWarm    -> Int -> Int -> Int -> Int -> InboundGovernorCounters
InboundGovernorCounters Int
0 Int
0 Int
1 Int
0
                RemoteState m
RemoteHot     -> Int -> Int -> Int -> Int -> InboundGovernorCounters
InboundGovernorCounters Int
0 Int
0 Int
0 Int
1
            )
            Map
  (ConnectionId peerAddr) (ConnectionState muxMode peerAddr m a b)
igsConnections


data MiniProtocolData muxMode m a b = MiniProtocolData {
    -- | Static 'MiniProtocol' description.
    --
    MiniProtocolData muxMode m a b
-> MiniProtocol muxMode ByteString m a b
mpdMiniProtocol     :: !(MiniProtocol muxMode ByteString m a b),

    -- | Static mini-protocol temperature.
    --
    MiniProtocolData muxMode m a b -> ProtocolTemperature
mpdMiniProtocolTemp :: !ProtocolTemperature
  }


-- | Per connection state tracked by /inbound protocol governor/.
--
data ConnectionState muxMode peerAddr m a b = ConnectionState {
      -- | Mux interface.
      --
      ConnectionState muxMode peerAddr m a b -> Mux muxMode m
csMux             :: !(Mux.Mux muxMode m),

      -- | Connection data flow.
      --
      ConnectionState muxMode peerAddr m a b -> DataFlow
csDataFlow        :: !DataFlow,

      -- | All supported mini-protocols and respective
      -- 'ProtocolTemperature'
      --
      ConnectionState muxMode peerAddr m a b
-> Map MiniProtocolNum (MiniProtocolData muxMode m a b)
csMiniProtocolMap :: !(Map MiniProtocolNum
                                 (MiniProtocolData muxMode m a b)),

      -- | Map of all running mini-protocol completion STM actions.
      --
      ConnectionState muxMode peerAddr m a b
-> Map MiniProtocolNum (STM m (Either SomeException b))
csCompletionMap   :: !(Map MiniProtocolNum
                                 (STM m (Either SomeException b))),

      -- | State of the connection.
      --
      ConnectionState muxMode peerAddr m a b -> RemoteState m
csRemoteState     :: !(RemoteState m)

    }


--
-- State management functions
--


-- | Remove connection from 'InboundGovernorState'.
--
unregisterConnection :: Ord peerAddr
                     => ConnectionId peerAddr
                     -> InboundGovernorState muxMode peerAddr m a b
                     -> InboundGovernorState muxMode peerAddr m a b
unregisterConnection :: ConnectionId peerAddr
-> InboundGovernorState muxMode peerAddr m a b
-> InboundGovernorState muxMode peerAddr m a b
unregisterConnection ConnectionId peerAddr
connId InboundGovernorState muxMode peerAddr m a b
state =
    InboundGovernorState muxMode peerAddr m a b
state { igsConnections :: Map
  (ConnectionId peerAddr) (ConnectionState muxMode peerAddr m a b)
igsConnections =
              Bool
-> Map
     (ConnectionId peerAddr) (ConnectionState muxMode peerAddr m a b)
-> Map
     (ConnectionId peerAddr) (ConnectionState muxMode peerAddr m a b)
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (ConnectionId peerAddr
connId ConnectionId peerAddr
-> Map
     (ConnectionId peerAddr) (ConnectionState muxMode peerAddr m a b)
-> Bool
forall k a. Ord k => k -> Map k a -> Bool
`Map.member` InboundGovernorState muxMode peerAddr m a b
-> Map
     (ConnectionId peerAddr) (ConnectionState muxMode peerAddr m a b)
forall (muxMode :: MuxMode) peerAddr (m :: * -> *) a b.
InboundGovernorState muxMode peerAddr m a b
-> Map
     (ConnectionId peerAddr) (ConnectionState muxMode peerAddr m a b)
igsConnections InboundGovernorState muxMode peerAddr m a b
state) (Map
   (ConnectionId peerAddr) (ConnectionState muxMode peerAddr m a b)
 -> Map
      (ConnectionId peerAddr) (ConnectionState muxMode peerAddr m a b))
-> Map
     (ConnectionId peerAddr) (ConnectionState muxMode peerAddr m a b)
-> Map
     (ConnectionId peerAddr) (ConnectionState muxMode peerAddr m a b)
forall a b. (a -> b) -> a -> b
$
              ConnectionId peerAddr
-> Map
     (ConnectionId peerAddr) (ConnectionState muxMode peerAddr m a b)
-> Map
     (ConnectionId peerAddr) (ConnectionState muxMode peerAddr m a b)
forall k a. Ord k => k -> Map k a -> Map k a
Map.delete ConnectionId peerAddr
connId (InboundGovernorState muxMode peerAddr m a b
-> Map
     (ConnectionId peerAddr) (ConnectionState muxMode peerAddr m a b)
forall (muxMode :: MuxMode) peerAddr (m :: * -> *) a b.
InboundGovernorState muxMode peerAddr m a b
-> Map
     (ConnectionId peerAddr) (ConnectionState muxMode peerAddr m a b)
igsConnections InboundGovernorState muxMode peerAddr m a b
state)
          }


-- | Update a mini-protocol in 'ConnectionState'.  Once a mini-protocol was
-- restarted we put the new completion action into 'csCompletionMap'.
--
updateMiniProtocol :: Ord peerAddr
                   => ConnectionId peerAddr
                   -> MiniProtocolNum
                   -> STM m (Either SomeException b)
                   -> InboundGovernorState muxMode peerAddr m a b
                   -> InboundGovernorState muxMode peerAddr m a b
updateMiniProtocol :: ConnectionId peerAddr
-> MiniProtocolNum
-> STM m (Either SomeException b)
-> InboundGovernorState muxMode peerAddr m a b
-> InboundGovernorState muxMode peerAddr m a b
updateMiniProtocol ConnectionId peerAddr
connId MiniProtocolNum
miniProtocolNum STM m (Either SomeException b)
completionAction InboundGovernorState muxMode peerAddr m a b
state =
    InboundGovernorState muxMode peerAddr m a b
state { igsConnections :: Map
  (ConnectionId peerAddr) (ConnectionState muxMode peerAddr m a b)
igsConnections =
              (ConnectionState muxMode peerAddr m a b
 -> ConnectionState muxMode peerAddr m a b)
-> ConnectionId peerAddr
-> Map
     (ConnectionId peerAddr) (ConnectionState muxMode peerAddr m a b)
-> Map
     (ConnectionId peerAddr) (ConnectionState muxMode peerAddr m a b)
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
Map.adjust (\connState :: ConnectionState muxMode peerAddr m a b
connState@ConnectionState { Map MiniProtocolNum (STM m (Either SomeException b))
csCompletionMap :: Map MiniProtocolNum (STM m (Either SomeException b))
csCompletionMap :: forall (muxMode :: MuxMode) peerAddr (m :: * -> *) a b.
ConnectionState muxMode peerAddr m a b
-> Map MiniProtocolNum (STM m (Either SomeException b))
csCompletionMap } ->
                           ConnectionState muxMode peerAddr m a b
connState {
                             csCompletionMap :: Map MiniProtocolNum (STM m (Either SomeException b))
csCompletionMap =
                               Bool
-> Map MiniProtocolNum (STM m (Either SomeException b))
-> Map MiniProtocolNum (STM m (Either SomeException b))
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (MiniProtocolNum
miniProtocolNum MiniProtocolNum
-> Map MiniProtocolNum (STM m (Either SomeException b)) -> Bool
forall k a. Ord k => k -> Map k a -> Bool
`Map.member` Map MiniProtocolNum (STM m (Either SomeException b))
csCompletionMap) (Map MiniProtocolNum (STM m (Either SomeException b))
 -> Map MiniProtocolNum (STM m (Either SomeException b)))
-> Map MiniProtocolNum (STM m (Either SomeException b))
-> Map MiniProtocolNum (STM m (Either SomeException b))
forall a b. (a -> b) -> a -> b
$
                               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 MiniProtocolNum
miniProtocolNum
                                          STM m (Either SomeException b)
completionAction
                                          Map MiniProtocolNum (STM m (Either SomeException b))
csCompletionMap
                            }
                         )
                         ConnectionId peerAddr
connId
                         (InboundGovernorState muxMode peerAddr m a b
-> Map
     (ConnectionId peerAddr) (ConnectionState muxMode peerAddr m a b)
forall (muxMode :: MuxMode) peerAddr (m :: * -> *) a b.
InboundGovernorState muxMode peerAddr m a b
-> Map
     (ConnectionId peerAddr) (ConnectionState muxMode peerAddr m a b)
igsConnections InboundGovernorState muxMode peerAddr m a b
state)
          }


-- | Each inbound connection is either in 'RemoteIdle', 'RemoteCold' or
-- 'RemoteEstablished' state.  We only need to support
-- @PromotedToWarm^{Duplex}_{Remote}@,
-- @DemotedToCold^{Duplex}_{Remote}@ and
-- @DemotedToCold^{Unidirectional}_{Remote}@ transitions.
--
data RemoteState m
    -- | After @PromotedToWarm^{dataFlow}_{Remote}@ a connection is in
    -- 'RemoteWarm' state.
    --
    = RemoteWarm

    -- | In this state all established and hot mini-protocols are running and
    -- none of the warm mini-protocols is running.
    --
    | RemoteHot

    -- | After @DemotedToCold^{dataFlow}_{Remote}@ is detected.  This state
    -- corresponds to 'InboundIdleState'. In this state we are checking
    -- if the responder protocols are idle during protocol idle timeout
    -- (represented by an 'STM' action)
    --
    -- 'RemoteIdle' is the initial state of an accepted a connection.
    --
    | RemoteIdle !(STM m ())

    -- | The 'RemoteCold' state for 'Duplex' connections allows us to have
    -- responders started using the on-demand strategy.  This assures that once
    -- the remote peer start using the connection the local side will be ready
    -- to serve it.
    --
    -- For a 'Duplex' connection: a 'RemoteIdle' connection transitions to
    -- 'RemoteCold' state after all responders being idle for
    -- @protocolIdleTimeout@. This triggers 'unregisterInboundConnection'.
    --
    -- For a 'Unidreictional' connection: after all responders terminated.
    --
    | RemoteCold


remoteEstablished :: RemoteState m -> Maybe (RemoteState m)
remoteEstablished :: RemoteState m -> Maybe (RemoteState m)
remoteEstablished a :: RemoteState m
a@RemoteState m
RemoteWarm = RemoteState m -> Maybe (RemoteState m)
forall a. a -> Maybe a
Just RemoteState m
a
remoteEstablished a :: RemoteState m
a@RemoteState m
RemoteHot  = RemoteState m -> Maybe (RemoteState m)
forall a. a -> Maybe a
Just RemoteState m
a
remoteEstablished RemoteState m
_            = Maybe (RemoteState m)
forall a. Maybe a
Nothing

pattern RemoteEstablished :: RemoteState m
pattern $mRemoteEstablished :: forall r (m :: * -> *).
RemoteState m -> (Void# -> r) -> (Void# -> r) -> r
RemoteEstablished <- (remoteEstablished -> Just _)

{-# COMPLETE RemoteEstablished, RemoteIdle, RemoteCold #-}


-- | Set 'csRemoteState' for a given connection.
--
updateRemoteState :: Ord peerAddr
                  => ConnectionId peerAddr
                  -> RemoteState m
                  -> InboundGovernorState muxMode peerAddr m a b
                  -> InboundGovernorState muxMode peerAddr m a b
updateRemoteState :: ConnectionId peerAddr
-> RemoteState m
-> InboundGovernorState muxMode peerAddr m a b
-> InboundGovernorState muxMode peerAddr m a b
updateRemoteState ConnectionId peerAddr
connId RemoteState m
csRemoteState InboundGovernorState muxMode peerAddr m a b
state =
    InboundGovernorState muxMode peerAddr m a b
state {
      igsConnections :: Map
  (ConnectionId peerAddr) (ConnectionState muxMode peerAddr m a b)
igsConnections =
        (ConnectionState muxMode peerAddr m a b
 -> ConnectionState muxMode peerAddr m a b)
-> ConnectionId peerAddr
-> Map
     (ConnectionId peerAddr) (ConnectionState muxMode peerAddr m a b)
-> Map
     (ConnectionId peerAddr) (ConnectionState muxMode peerAddr m a b)
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
Map.adjust
          (\ConnectionState muxMode peerAddr m a b
connState -> ConnectionState muxMode peerAddr m a b
connState { RemoteState m
csRemoteState :: RemoteState m
csRemoteState :: RemoteState m
csRemoteState })
          ConnectionId peerAddr
connId
          (InboundGovernorState muxMode peerAddr m a b
-> Map
     (ConnectionId peerAddr) (ConnectionState muxMode peerAddr m a b)
forall (muxMode :: MuxMode) peerAddr (m :: * -> *) a b.
InboundGovernorState muxMode peerAddr m a b
-> Map
     (ConnectionId peerAddr) (ConnectionState muxMode peerAddr m a b)
igsConnections InboundGovernorState muxMode peerAddr m a b
state)
    }

mapRemoteState :: Ord peerAddr
               => ConnectionId peerAddr
               -> (RemoteState m -> RemoteState m)
               -> InboundGovernorState muxMode peerAddr m a b
               -> InboundGovernorState muxMode peerAddr m a b
mapRemoteState :: ConnectionId peerAddr
-> (RemoteState m -> RemoteState m)
-> InboundGovernorState muxMode peerAddr m a b
-> InboundGovernorState muxMode peerAddr m a b
mapRemoteState ConnectionId peerAddr
connId RemoteState m -> RemoteState m
fn InboundGovernorState muxMode peerAddr m a b
state =
    InboundGovernorState muxMode peerAddr m a b
state {
      igsConnections :: Map
  (ConnectionId peerAddr) (ConnectionState muxMode peerAddr m a b)
igsConnections =
        (ConnectionState muxMode peerAddr m a b
 -> ConnectionState muxMode peerAddr m a b)
-> ConnectionId peerAddr
-> Map
     (ConnectionId peerAddr) (ConnectionState muxMode peerAddr m a b)
-> Map
     (ConnectionId peerAddr) (ConnectionState muxMode peerAddr m a b)
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
Map.adjust
          (\connState :: ConnectionState muxMode peerAddr m a b
connState@ConnectionState { RemoteState m
csRemoteState :: RemoteState m
csRemoteState :: forall (muxMode :: MuxMode) peerAddr (m :: * -> *) a b.
ConnectionState muxMode peerAddr m a b -> RemoteState m
csRemoteState } ->
            ConnectionState muxMode peerAddr m a b
connState { csRemoteState :: RemoteState m
csRemoteState = RemoteState m -> RemoteState m
fn RemoteState m
csRemoteState })
          ConnectionId peerAddr
connId
          (InboundGovernorState muxMode peerAddr m a b
-> Map
     (ConnectionId peerAddr) (ConnectionState muxMode peerAddr m a b)
forall (muxMode :: MuxMode) peerAddr (m :: * -> *) a b.
InboundGovernorState muxMode peerAddr m a b
-> Map
     (ConnectionId peerAddr) (ConnectionState muxMode peerAddr m a b)
igsConnections InboundGovernorState muxMode peerAddr m a b
state)
    }