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

-- 'withInitiatorMode' has @HasInitiator muxMode ~ True@ constraint, which is
-- not redundant at all!  It limits case analysis.
--
-- TODO: this might not by needed by `ghc-8.10`.
{-# OPTIONS_GHC -Wno-redundant-constraints #-}

-- | Connection manager core types.
--
-- Connection manager is responsible for managing uni- and bi-directional
-- connections and threads which are running network applications using
-- 'network-mux'.  In particular it is responsible for:
--
-- * opening new connection / reusing connections (for bidirectional
-- connections) and exposes a method to register inbound connections;
--
-- * run connection handler, i.e. 'ConnectionHandler', which runs handshake
-- negotiation, notifies connection manager on the results and starts the
-- multiplexer;
--
-- * error handling for connection threads;
--
-- * keeping track of handshake negotiation: whether a unidirectional or duplex
--   connection was negotiated;
--
-- * tracking state of each connection;
--
-- * keep inbound connections under limits.
--
-- Connection manager is designed to work for any 'Network.Mux.Mode', though
-- the most useful ones are 'Mux.ResponderMode' and 'Mux.InitiatorResponderMode':
--
-- * 'InitiatorResponderMode' - useful for node-to-node applications, which
--                              needs to create outbound connections as well as
--                              accept inbound ones;
-- * 'ResponderMode'          - useful for server side of node-to-client; it
--                              allows us to share the same server between
--                              node-to-client and node-to-node;
-- * 'InitiatorMode'          - could be used on client side of node-to-client
--                              applications.
--
-- The calls 'acquireOutboundConnection' and 'includeInboundConnection' return
-- once a connection has been negotiated.  The returned 'handle' contains all
-- the information that is needed to start and monitor mini-protocols through
-- the mux interface.
--
-- For inbound connections, the connection manager will pass handle (also after
-- negotiation).
--
-- >
-- > ┌────────────────────────┐
-- > │                        │        ┏━━━━━━━━━━━━━━━━┓
-- > │   ConnectionHandler    │        ┃                ┃
-- > │                        ┝━━━━━━━▶┃     handle     ┃
-- > │  inbound / outbound    │        ┃                ┃
-- > │         ┃              │        ┗━━┳━━━━━━━━━━━━━┛
-- > └─────────╂──────────────┘           ┃
-- >           ┃                          ┃
-- >           ▼                          ┃
-- >    ┏━━━━━━━━━━━━━━━━━┓               ┃
-- >    ┃ Control Channel ┃               ┃
-- >    ┗━━━━━━┳━━━━━━━━━━┛               ┃
-- >           ┃                          ┃
-- >           ┃                          ┃
-- >           ▼                          ┃
-- > ┌────────────────────────┐           ┃
-- > │                        │           ┃
-- > │         Server         │◀━━━━━━━━━━┛
-- > │                        │
-- > └────────────────────────┘
--
-- Termination procedure as well as connection state machine is not described in
-- this haddock, see associated specification.
--
-- The 'handle' is used in `ouroboros-network` package to construct
-- `PeerStateActions` which allow for the outbound governor to
--

module Ouroboros.Network.ConnectionManager.Types
  ( -- * Connection manager core types
    -- ** Connection Types
    AddressType (..)
  , Provenance (..)
  , DataFlow (..)
  , TimeoutExpired (..)
  , ConnectionType (..)
    -- ** Connection Handler
    -- $connectionhandler
  , MaskedAction (..)
  , ConnectionHandlerFn
  , ConnectionHandler (..)
  , Inactive (..)
  , ExceptionInHandler (..)
  , HandleErrorType (..)
  , HandshakeConnectionResult (..)
    -- ** Prune Policy
  , PrunePolicy
  , simplePrunePolicy
    -- * Connection Manager
    -- ** Connection Manager Arguments
  , ConnectionManager (..)
    -- ** API
  , Connected (..)
  , OperationResult (..)
  , resultInState
  , DemotedToColdRemoteTr (..)
  , AcquireOutboundConnection
  , IncludeInboundConnection
    -- *** Outbound side
  , acquireOutboundConnection
  , promotedToWarmRemote
  , demotedToColdRemote
  , releaseOutboundConnection
    -- *** Inbound side
  , includeInboundConnection
  , releaseInboundConnection
  , numberOfConnections
    -- ** Private API
    -- Includes all constructors required to create a 'ConnectionManager'.
  , OutboundConnectionManager (..)
  , InboundConnectionManager (..)
    -- * Exceptions
  , ConnectionManagerError (..)
  , SomeConnectionManagerError (..)
  , AbstractState (..)
    -- * Counters
  , ConnectionManagerCounters (..)
    -- * Mux types
  , WithMuxMode (..)
  , withInitiatorMode
  , withResponderMode
    -- * Promise
    -- $promise
  , newEmptyPromiseIO
  , PromiseReader (..)
  , readPromiseIO
  , PromiseWriter (..)
  , PromiseWriterException (..)
    -- * Tracing
  , AssertionLocation (..)
  , MaybeUnknown (..)
  , Transition' (..)
  , Transition
  , AbstractTransition
  , mkTransition
  , mkAbsTransition
  , TransitionTrace
  , TransitionTrace' (..)
  , AbstractTransitionTrace
  ) where

import Control.Concurrent.Class.MonadSTM.Strict
import Control.Monad (unless)
import Control.Monad.Class.MonadThrow
import Control.Monad.Class.MonadTime.SI (DiffTime)
import Control.Tracer (Tracer)
import Data.Functor (void)
import Data.List (sortOn)
import Data.Map.Strict (Map)
import Data.Map.Strict qualified as Map
import Data.Set (Set)
import Data.Set qualified as Set
import Data.Typeable (Typeable, cast)
import Data.Word (Word32)
import GHC.Stack (CallStack, prettyCallStack)
import System.Random (StdGen)

import Network.Mux.Types (HasInitiator, HasResponder, MiniProtocolDir)
import Network.Mux.Types qualified as Mux

import Ouroboros.Network.ConnectionId (ConnectionId)
import Ouroboros.Network.MuxMode


-- | Connection manager supports `IPv4` and `IPv6` addresses.
--
data AddressType = IPv4Address | IPv6Address
    deriving Int -> AddressType -> ShowS
[AddressType] -> ShowS
AddressType -> String
(Int -> AddressType -> ShowS)
-> (AddressType -> String)
-> ([AddressType] -> ShowS)
-> Show AddressType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AddressType -> ShowS
showsPrec :: Int -> AddressType -> ShowS
$cshow :: AddressType -> String
show :: AddressType -> String
$cshowList :: [AddressType] -> ShowS
showList :: [AddressType] -> ShowS
Show


-- | Each connection is is either initiated locally (outbound) or by a remote
-- peer (inbound).
--
data Provenance =
    -- | An inbound connection: one that was initiated by a remote peer.
    --
    Inbound

    -- | An outbound connection: one that was initiated by us.
    --
  | Outbound
  deriving (Provenance -> Provenance -> Bool
(Provenance -> Provenance -> Bool)
-> (Provenance -> Provenance -> Bool) -> Eq Provenance
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Provenance -> Provenance -> Bool
== :: Provenance -> Provenance -> Bool
$c/= :: Provenance -> Provenance -> Bool
/= :: Provenance -> Provenance -> Bool
Eq, Eq Provenance
Eq Provenance =>
(Provenance -> Provenance -> Ordering)
-> (Provenance -> Provenance -> Bool)
-> (Provenance -> Provenance -> Bool)
-> (Provenance -> Provenance -> Bool)
-> (Provenance -> Provenance -> Bool)
-> (Provenance -> Provenance -> Provenance)
-> (Provenance -> Provenance -> Provenance)
-> Ord Provenance
Provenance -> Provenance -> Bool
Provenance -> Provenance -> Ordering
Provenance -> Provenance -> Provenance
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
$ccompare :: Provenance -> Provenance -> Ordering
compare :: Provenance -> Provenance -> Ordering
$c< :: Provenance -> Provenance -> Bool
< :: Provenance -> Provenance -> Bool
$c<= :: Provenance -> Provenance -> Bool
<= :: Provenance -> Provenance -> Bool
$c> :: Provenance -> Provenance -> Bool
> :: Provenance -> Provenance -> Bool
$c>= :: Provenance -> Provenance -> Bool
>= :: Provenance -> Provenance -> Bool
$cmax :: Provenance -> Provenance -> Provenance
max :: Provenance -> Provenance -> Provenance
$cmin :: Provenance -> Provenance -> Provenance
min :: Provenance -> Provenance -> Provenance
Ord, Int -> Provenance -> ShowS
[Provenance] -> ShowS
Provenance -> String
(Int -> Provenance -> ShowS)
-> (Provenance -> String)
-> ([Provenance] -> ShowS)
-> Show Provenance
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Provenance -> ShowS
showsPrec :: Int -> Provenance -> ShowS
$cshow :: Provenance -> String
show :: Provenance -> String
$cshowList :: [Provenance] -> ShowS
showList :: [Provenance] -> ShowS
Show)


-- | Each connection negotiates if it is uni- or bi-directional.  'DataFlow'
-- is a life time property of a connection, once negotiated it never changes.
--
-- NOTE: This type is isomorphic to `DiffusionMode` for `node-to-node`
-- connections (see `Ouroboros.Network.Diffusion.P2P.ntnDataFlow`), but it isn't
-- for `node-to-client` connections (see
-- `Ouroboros.Network.Diffusion.P2P.ntcDataFlow).
--
data DataFlow
    = Unidirectional
    | Duplex
  deriving (DataFlow -> DataFlow -> Bool
(DataFlow -> DataFlow -> Bool)
-> (DataFlow -> DataFlow -> Bool) -> Eq DataFlow
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DataFlow -> DataFlow -> Bool
== :: DataFlow -> DataFlow -> Bool
$c/= :: DataFlow -> DataFlow -> Bool
/= :: DataFlow -> DataFlow -> Bool
Eq, Eq DataFlow
Eq DataFlow =>
(DataFlow -> DataFlow -> Ordering)
-> (DataFlow -> DataFlow -> Bool)
-> (DataFlow -> DataFlow -> Bool)
-> (DataFlow -> DataFlow -> Bool)
-> (DataFlow -> DataFlow -> Bool)
-> (DataFlow -> DataFlow -> DataFlow)
-> (DataFlow -> DataFlow -> DataFlow)
-> Ord DataFlow
DataFlow -> DataFlow -> Bool
DataFlow -> DataFlow -> Ordering
DataFlow -> DataFlow -> DataFlow
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
$ccompare :: DataFlow -> DataFlow -> Ordering
compare :: DataFlow -> DataFlow -> Ordering
$c< :: DataFlow -> DataFlow -> Bool
< :: DataFlow -> DataFlow -> Bool
$c<= :: DataFlow -> DataFlow -> Bool
<= :: DataFlow -> DataFlow -> Bool
$c> :: DataFlow -> DataFlow -> Bool
> :: DataFlow -> DataFlow -> Bool
$c>= :: DataFlow -> DataFlow -> Bool
>= :: DataFlow -> DataFlow -> Bool
$cmax :: DataFlow -> DataFlow -> DataFlow
max :: DataFlow -> DataFlow -> DataFlow
$cmin :: DataFlow -> DataFlow -> DataFlow
min :: DataFlow -> DataFlow -> DataFlow
Ord, Int -> DataFlow -> ShowS
[DataFlow] -> ShowS
DataFlow -> String
(Int -> DataFlow -> ShowS)
-> (DataFlow -> String) -> ([DataFlow] -> ShowS) -> Show DataFlow
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DataFlow -> ShowS
showsPrec :: Int -> DataFlow -> ShowS
$cshow :: DataFlow -> String
show :: DataFlow -> String
$cshowList :: [DataFlow] -> ShowS
showList :: [DataFlow] -> ShowS
Show)


-- | Boolean like type which indicates if the timeout on 'OutboundStateDuplex'
-- has expired.
data TimeoutExpired = Expired | Ticking
  deriving (TimeoutExpired -> TimeoutExpired -> Bool
(TimeoutExpired -> TimeoutExpired -> Bool)
-> (TimeoutExpired -> TimeoutExpired -> Bool) -> Eq TimeoutExpired
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TimeoutExpired -> TimeoutExpired -> Bool
== :: TimeoutExpired -> TimeoutExpired -> Bool
$c/= :: TimeoutExpired -> TimeoutExpired -> Bool
/= :: TimeoutExpired -> TimeoutExpired -> Bool
Eq, Eq TimeoutExpired
Eq TimeoutExpired =>
(TimeoutExpired -> TimeoutExpired -> Ordering)
-> (TimeoutExpired -> TimeoutExpired -> Bool)
-> (TimeoutExpired -> TimeoutExpired -> Bool)
-> (TimeoutExpired -> TimeoutExpired -> Bool)
-> (TimeoutExpired -> TimeoutExpired -> Bool)
-> (TimeoutExpired -> TimeoutExpired -> TimeoutExpired)
-> (TimeoutExpired -> TimeoutExpired -> TimeoutExpired)
-> Ord TimeoutExpired
TimeoutExpired -> TimeoutExpired -> Bool
TimeoutExpired -> TimeoutExpired -> Ordering
TimeoutExpired -> TimeoutExpired -> TimeoutExpired
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
$ccompare :: TimeoutExpired -> TimeoutExpired -> Ordering
compare :: TimeoutExpired -> TimeoutExpired -> Ordering
$c< :: TimeoutExpired -> TimeoutExpired -> Bool
< :: TimeoutExpired -> TimeoutExpired -> Bool
$c<= :: TimeoutExpired -> TimeoutExpired -> Bool
<= :: TimeoutExpired -> TimeoutExpired -> Bool
$c> :: TimeoutExpired -> TimeoutExpired -> Bool
> :: TimeoutExpired -> TimeoutExpired -> Bool
$c>= :: TimeoutExpired -> TimeoutExpired -> Bool
>= :: TimeoutExpired -> TimeoutExpired -> Bool
$cmax :: TimeoutExpired -> TimeoutExpired -> TimeoutExpired
max :: TimeoutExpired -> TimeoutExpired -> TimeoutExpired
$cmin :: TimeoutExpired -> TimeoutExpired -> TimeoutExpired
min :: TimeoutExpired -> TimeoutExpired -> TimeoutExpired
Ord, Int -> TimeoutExpired -> ShowS
[TimeoutExpired] -> ShowS
TimeoutExpired -> String
(Int -> TimeoutExpired -> ShowS)
-> (TimeoutExpired -> String)
-> ([TimeoutExpired] -> ShowS)
-> Show TimeoutExpired
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TimeoutExpired -> ShowS
showsPrec :: Int -> TimeoutExpired -> ShowS
$cshow :: TimeoutExpired -> String
show :: TimeoutExpired -> String
$cshowList :: [TimeoutExpired] -> ShowS
showList :: [TimeoutExpired] -> ShowS
Show)



-- | Either unnegotiated or negotiated unidirectional or duplex connections.
-- This is not a static property of a connection.  It is used by 'PrunePolicy'.
--
-- Note: the order matters, it can be used by a 'PickPolicy', e.g.
-- 'simplePickPolicy'.
--
data ConnectionType
    -- | An unnegotiated connection.
    --
    = UnnegotiatedConn !Provenance

    -- | An inbound idle connection.
    --
    | InboundIdleConn !DataFlow

    -- | An outbound idle connection.
    --
    | OutboundIdleConn !DataFlow

    -- | A negotiated connection, which is used in only one direction indicated
    -- by 'Provenance'.  The connection could itself negotiated either 'Duplex'
    -- or 'Unidirectional' data flow.
    --
    | NegotiatedConn   !Provenance !DataFlow

    -- | A connection which is running in full duplex mode.
    --
    | DuplexConn
    deriving (ConnectionType -> ConnectionType -> Bool
(ConnectionType -> ConnectionType -> Bool)
-> (ConnectionType -> ConnectionType -> Bool) -> Eq ConnectionType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ConnectionType -> ConnectionType -> Bool
== :: ConnectionType -> ConnectionType -> Bool
$c/= :: ConnectionType -> ConnectionType -> Bool
/= :: ConnectionType -> ConnectionType -> Bool
Eq, Eq ConnectionType
Eq ConnectionType =>
(ConnectionType -> ConnectionType -> Ordering)
-> (ConnectionType -> ConnectionType -> Bool)
-> (ConnectionType -> ConnectionType -> Bool)
-> (ConnectionType -> ConnectionType -> Bool)
-> (ConnectionType -> ConnectionType -> Bool)
-> (ConnectionType -> ConnectionType -> ConnectionType)
-> (ConnectionType -> ConnectionType -> ConnectionType)
-> Ord ConnectionType
ConnectionType -> ConnectionType -> Bool
ConnectionType -> ConnectionType -> Ordering
ConnectionType -> ConnectionType -> ConnectionType
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
$ccompare :: ConnectionType -> ConnectionType -> Ordering
compare :: ConnectionType -> ConnectionType -> Ordering
$c< :: ConnectionType -> ConnectionType -> Bool
< :: ConnectionType -> ConnectionType -> Bool
$c<= :: ConnectionType -> ConnectionType -> Bool
<= :: ConnectionType -> ConnectionType -> Bool
$c> :: ConnectionType -> ConnectionType -> Bool
> :: ConnectionType -> ConnectionType -> Bool
$c>= :: ConnectionType -> ConnectionType -> Bool
>= :: ConnectionType -> ConnectionType -> Bool
$cmax :: ConnectionType -> ConnectionType -> ConnectionType
max :: ConnectionType -> ConnectionType -> ConnectionType
$cmin :: ConnectionType -> ConnectionType -> ConnectionType
min :: ConnectionType -> ConnectionType -> ConnectionType
Ord, Int -> ConnectionType -> ShowS
[ConnectionType] -> ShowS
ConnectionType -> String
(Int -> ConnectionType -> ShowS)
-> (ConnectionType -> String)
-> ([ConnectionType] -> ShowS)
-> Show ConnectionType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ConnectionType -> ShowS
showsPrec :: Int -> ConnectionType -> ShowS
$cshow :: ConnectionType -> String
show :: ConnectionType -> String
$cshowList :: [ConnectionType] -> ShowS
showList :: [ConnectionType] -> ShowS
Show)


-- $promise
--
-- Promise interface, backed by a `StrictTMVar`.
--
-- Making two separate interfaces: 'PromiseWriter' and 'PromiseReader' allows us
-- to make a clear distinction between consumer and producers threads.

data PromiseWriter m a = PromiseWriter {
    -- | 'putPromise', is a non-blocking operation, it throws
    -- 'PromiseWriterException' if it would block.
    --
    forall (m :: * -> *) a. PromiseWriter m a -> a -> STM m ()
writePromise :: a -> STM m (),

    -- | If the promise is empty it fills it, if it is non-empty it replaces
    -- the current value.
    --
    forall (m :: * -> *) a. PromiseWriter m a -> a -> STM m ()
forcePromise :: a -> STM m ()
  }

data PromiseWriterException = PromiseWriterBlocked
  deriving (Int -> PromiseWriterException -> ShowS
[PromiseWriterException] -> ShowS
PromiseWriterException -> String
(Int -> PromiseWriterException -> ShowS)
-> (PromiseWriterException -> String)
-> ([PromiseWriterException] -> ShowS)
-> Show PromiseWriterException
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PromiseWriterException -> ShowS
showsPrec :: Int -> PromiseWriterException -> ShowS
$cshow :: PromiseWriterException -> String
show :: PromiseWriterException -> String
$cshowList :: [PromiseWriterException] -> ShowS
showList :: [PromiseWriterException] -> ShowS
Show, Typeable)

instance Exception PromiseWriterException


newtype PromiseReader m a = PromiseReader {
    -- | A blocking read operation.
    forall (m :: * -> *) a. PromiseReader m a -> STM m a
readPromise :: STM m a
  }

readPromiseIO :: MonadSTM m => PromiseReader m a -> m a
readPromiseIO :: forall (m :: * -> *) a. MonadSTM m => PromiseReader m a -> m a
readPromiseIO = STM m a -> m a
forall a. HasCallStack => STM m a -> m a
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically (STM m a -> m a)
-> (PromiseReader m a -> STM m a) -> PromiseReader m a -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PromiseReader m a -> STM m a
forall (m :: * -> *) a. PromiseReader m a -> STM m a
readPromise

newEmptyPromise :: forall m a.
                   ( MonadSTM m
                   , MonadThrow (STM m) )
                => STM m (PromiseReader m a, PromiseWriter m a)
newEmptyPromise :: forall (m :: * -> *) a.
(MonadSTM m, MonadThrow (STM m)) =>
STM m (PromiseReader m a, PromiseWriter m a)
newEmptyPromise = do
    (v :: StrictTMVar m a) <- STM m (StrictTMVar m a)
forall (m :: * -> *) a. MonadSTM m => STM m (StrictTMVar m a)
newEmptyTMVar
    let reader = PromiseReader { readPromise :: STM m a
readPromise = StrictTMVar m a -> STM m a
forall (m :: * -> *) a. MonadSTM m => StrictTMVar m a -> STM m a
readTMVar StrictTMVar m a
v }
        writer = PromiseWriter {
                    writePromise :: a -> STM m ()
writePromise = \a
a -> do
                      r <- StrictTMVar m a -> a -> STM m Bool
forall (m :: * -> *) a.
MonadSTM m =>
StrictTMVar m a -> a -> STM m Bool
tryPutTMVar StrictTMVar m a
v a
a
                      unless r
                        (throwSTM PromiseWriterBlocked),

                    -- Both 'putTMVar' and 'swapTMVar' are blocking
                    -- operations, but the first blocks if @v@ is non-empty
                    -- and the latter blocks when @b@ is empty.  Combining them
                    -- with 'orElse' is a non-blocking operation.
                    forcePromise :: a -> STM m ()
forcePromise = \a
a -> StrictTMVar m a -> a -> STM m ()
forall (m :: * -> *) a.
MonadSTM m =>
StrictTMVar m a -> a -> STM m ()
putTMVar StrictTMVar m a
v a
a
                        STM m () -> STM m () -> STM m ()
forall a. STM m a -> STM m a -> STM m a
forall (m :: * -> *) a. MonadSTM m => STM m a -> STM m a -> STM m a
`orElse` STM m a -> STM m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (StrictTMVar m a -> a -> STM m a
forall (m :: * -> *) a.
MonadSTM m =>
StrictTMVar m a -> a -> STM m a
swapTMVar StrictTMVar m a
v a
a)
                  }
    pure (reader, writer)

newEmptyPromiseIO :: ( MonadSTM m
                     , MonadThrow (STM m) )
                  => m (PromiseReader m a, PromiseWriter m a)
newEmptyPromiseIO :: forall (m :: * -> *) a.
(MonadSTM m, MonadThrow (STM m)) =>
m (PromiseReader m a, PromiseWriter m a)
newEmptyPromiseIO = STM m (PromiseReader m a, PromiseWriter m a)
-> m (PromiseReader m a, PromiseWriter m a)
forall a. HasCallStack => STM m a -> m a
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically STM m (PromiseReader m a, PromiseWriter m a)
forall (m :: * -> *) a.
(MonadSTM m, MonadThrow (STM m)) =>
STM m (PromiseReader m a, PromiseWriter m a)
newEmptyPromise


--
-- ConnectionHandler
--
-- $connectionhandler
-- 'ConnectionHandler' provides monadic action which runs handshake
-- negotiation and starts the multiplexer.  It's the component which has access
-- to underlying socket.  There's one-to-one correspondence between sockets and
-- threads that run the handler.
--
-- [@'ConnectionHandlerFn'@]:
--   is the type of callback executed for each connection. All arguments are
--   provided by the connection manager.
-- [@'ConnectionHandler'@]:
--   is a newtype wrapper which provides inbound \/ outbound handlers depending
--   on @'Network.Mux.Mode'@.
--


-- | Handler action is started with asynchronous exceptions masked; this allows
-- to install exception handlers in an async-safe way.
--
newtype MaskedAction m a = MaskedAction {
    forall (m :: * -> *) a.
MaskedAction m a -> (forall x. m x -> m x) -> m a
runWithUnmask :: (forall x. m x -> m x) -> m a
  }


-- | MaskedAction which is executed by thread designated for a given connection.
--
-- 'PromiseWriter' allows to notify the 'ConnectionManager' about the result of
-- handshake negotiation.
--
-- Note: 'PromiseWriter' could be replaced with an stm action which is
-- accessing the 'TVar' which holds state of the connection.
--
type ConnectionHandlerFn handlerTrace socket peerAddr handle handleError version m
     = socket
    -> PromiseWriter m (Either handleError (HandshakeConnectionResult handle version))
    -> Tracer m handlerTrace
    -> ConnectionId peerAddr
    -> (DiffTime -> socket -> m (Mux.Bearer m))
    -> MaskedAction m ()

data HandshakeConnectionResult handle version
  -- | Handshake saw a query.
  --
  = HandshakeConnectionQuery

  -- | Handshake resulted in a connection and version.
  --
  | HandshakeConnectionResult handle version

-- | Connection handler action.  It is index by @muxMode :: 'Network.Mux.Mode'@.
-- There's one 'ConnectionHandlerFn' per provenance, possibly limited by
-- @muxMode@.
--
newtype ConnectionHandler muxMode handlerTrace socket peerAddr handle handleError version m =
    ConnectionHandler {
        -- | Connection handler.
        --
        forall (muxMode :: Mode) handlerTrace socket peerAddr handle
       handleError version (m :: * -> *).
ConnectionHandler
  muxMode handlerTrace socket peerAddr handle handleError version m
-> WithMuxTuple
     muxMode
     (ConnectionHandlerFn
        handlerTrace socket peerAddr handle handleError version m)
connectionHandler ::
          WithMuxTuple muxMode
            (ConnectionHandlerFn handlerTrace socket peerAddr handle handleError version m)
      }


-- | Boolean like type
--
data Inactive =
    Active MiniProtocolDir
  | Inactive
  deriving (Inactive -> Inactive -> Bool
(Inactive -> Inactive -> Bool)
-> (Inactive -> Inactive -> Bool) -> Eq Inactive
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Inactive -> Inactive -> Bool
== :: Inactive -> Inactive -> Bool
$c/= :: Inactive -> Inactive -> Bool
/= :: Inactive -> Inactive -> Bool
Eq, Int -> Inactive -> ShowS
[Inactive] -> ShowS
Inactive -> String
(Int -> Inactive -> ShowS)
-> (Inactive -> String) -> ([Inactive] -> ShowS) -> Show Inactive
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Inactive -> ShowS
showsPrec :: Int -> Inactive -> ShowS
$cshow :: Inactive -> String
show :: Inactive -> String
$cshowList :: [Inactive] -> ShowS
showList :: [Inactive] -> ShowS
Show)


-- | Exception which where caught in the connection thread and were re-thrown in
-- the main thread by the 'rethrowPolicy'.
--
data ExceptionInHandler where
    ExceptionInHandler :: forall peerAddr.
                          (Typeable peerAddr, Show peerAddr)
                       => !peerAddr
                       -> !SomeException
                       -> ExceptionInHandler
  deriving Typeable

instance Show ExceptionInHandler where
    show :: ExceptionInHandler -> String
show (ExceptionInHandler peerAddr
peerAddr SomeException
e) = String
"ExceptionInHandler "
                                        String -> ShowS
forall a. [a] -> [a] -> [a]
++ peerAddr -> String
forall a. Show a => a -> String
show peerAddr
peerAddr
                                        String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" "
                                        String -> ShowS
forall a. [a] -> [a] -> [a]
++ SomeException -> String
forall a. Show a => a -> String
show SomeException
e
instance Exception ExceptionInHandler


-- | Data type used to classify 'handleErrors'.
--
data HandleErrorType =
    -- | Handshake negotiation failed.  This is not a protocol error.
    HandshakeFailure

    -- | Handshake protocol error.  This should include timeout errors or any
    -- IO errors.
  | HandshakeProtocolViolation


-- | 'PrunePolicy' allows to pick a select peers from which we will disconnect
-- (we use @TCP@ reset).  The chosen connections will be terminated by the
-- connection manger once it detects that there are too many inbound
-- connections.
--
type PrunePolicy peerAddr = StdGen
                         -> Map peerAddr ConnectionType
                         -> Int
                         -> Set peerAddr


-- | The simplest 'PrunePolicy', it should only be used for tests.
--
simplePrunePolicy :: Ord peerAddr
                  => PrunePolicy peerAddr
simplePrunePolicy :: forall peerAddr. Ord peerAddr => PrunePolicy peerAddr
simplePrunePolicy StdGen
_ Map peerAddr ConnectionType
m Int
n =
    [peerAddr] -> Set peerAddr
forall a. Ord a => [a] -> Set a
Set.fromList
  ([peerAddr] -> Set peerAddr)
-> (Map peerAddr ConnectionType -> [peerAddr])
-> Map peerAddr ConnectionType
-> Set peerAddr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((peerAddr, ConnectionType) -> peerAddr)
-> [(peerAddr, ConnectionType)] -> [peerAddr]
forall a b. (a -> b) -> [a] -> [b]
map (peerAddr, ConnectionType) -> peerAddr
forall a b. (a, b) -> a
fst
  ([(peerAddr, ConnectionType)] -> [peerAddr])
-> (Map peerAddr ConnectionType -> [(peerAddr, ConnectionType)])
-> Map peerAddr ConnectionType
-> [peerAddr]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [(peerAddr, ConnectionType)] -> [(peerAddr, ConnectionType)]
forall a. Int -> [a] -> [a]
take Int
n
  ([(peerAddr, ConnectionType)] -> [(peerAddr, ConnectionType)])
-> (Map peerAddr ConnectionType -> [(peerAddr, ConnectionType)])
-> Map peerAddr ConnectionType
-> [(peerAddr, ConnectionType)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((peerAddr, ConnectionType) -> ConnectionType)
-> [(peerAddr, ConnectionType)] -> [(peerAddr, ConnectionType)]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (peerAddr, ConnectionType) -> ConnectionType
forall a b. (a, b) -> b
snd
  ([(peerAddr, ConnectionType)] -> [(peerAddr, ConnectionType)])
-> (Map peerAddr ConnectionType -> [(peerAddr, ConnectionType)])
-> Map peerAddr ConnectionType
-> [(peerAddr, ConnectionType)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map peerAddr ConnectionType -> [(peerAddr, ConnectionType)]
forall k a. Map k a -> [(k, a)]
Map.toList
  (Map peerAddr ConnectionType -> Set peerAddr)
-> Map peerAddr ConnectionType -> Set peerAddr
forall a b. (a -> b) -> a -> b
$ Map peerAddr ConnectionType
m



-- | Custom either type for result of various methods.
--
data OperationResult a
    = UnsupportedState !AbstractState
    | OperationSuccess !a
    | TerminatedConnection !AbstractState
    deriving (Int -> OperationResult a -> ShowS
[OperationResult a] -> ShowS
OperationResult a -> String
(Int -> OperationResult a -> ShowS)
-> (OperationResult a -> String)
-> ([OperationResult a] -> ShowS)
-> Show (OperationResult a)
forall a. Show a => Int -> OperationResult a -> ShowS
forall a. Show a => [OperationResult a] -> ShowS
forall a. Show a => OperationResult a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> OperationResult a -> ShowS
showsPrec :: Int -> OperationResult a -> ShowS
$cshow :: forall a. Show a => OperationResult a -> String
show :: OperationResult a -> String
$cshowList :: forall a. Show a => [OperationResult a] -> ShowS
showList :: [OperationResult a] -> ShowS
Show, (forall a b. (a -> b) -> OperationResult a -> OperationResult b)
-> (forall a b. a -> OperationResult b -> OperationResult a)
-> Functor OperationResult
forall a b. a -> OperationResult b -> OperationResult a
forall a b. (a -> b) -> OperationResult a -> OperationResult b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> OperationResult a -> OperationResult b
fmap :: forall a b. (a -> b) -> OperationResult a -> OperationResult b
$c<$ :: forall a b. a -> OperationResult b -> OperationResult a
<$ :: forall a b. a -> OperationResult b -> OperationResult a
Functor)


resultInState :: OperationResult AbstractState -> AbstractState
resultInState :: OperationResult AbstractState -> AbstractState
resultInState (UnsupportedState     AbstractState
st) = AbstractState
st
resultInState (OperationSuccess     AbstractState
st) = AbstractState
st
resultInState (TerminatedConnection AbstractState
st) = AbstractState
st


-- | Return value of 'releaseInboundConnection' to inform the caller about
-- the transition.
--
data DemotedToColdRemoteTr =
    -- | @Commit^{dataFlow}@ transition from @'InboundIdleState' dataFlow@.
    --
    CommitTr

    -- | Either @DemotedToCold^{Remote}@ transition from @'DuplexState'@, or
    -- a level triggered @Awake^{Duplex}_{Local}@ transition.  In both cases
    -- the server must keep the responder side of all protocols ready.
  | KeepTr
  deriving Int -> DemotedToColdRemoteTr -> ShowS
[DemotedToColdRemoteTr] -> ShowS
DemotedToColdRemoteTr -> String
(Int -> DemotedToColdRemoteTr -> ShowS)
-> (DemotedToColdRemoteTr -> String)
-> ([DemotedToColdRemoteTr] -> ShowS)
-> Show DemotedToColdRemoteTr
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DemotedToColdRemoteTr -> ShowS
showsPrec :: Int -> DemotedToColdRemoteTr -> ShowS
$cshow :: DemotedToColdRemoteTr -> String
show :: DemotedToColdRemoteTr -> String
$cshowList :: [DemotedToColdRemoteTr] -> ShowS
showList :: [DemotedToColdRemoteTr] -> ShowS
Show


-- | Result of 'acquireOutboundConnection' or 'includeInboundConnection'.
--
data Connected peerAddr handle handleError =
    -- | We are connected and mux is running.
    --
    Connected    !(ConnectionId peerAddr) !DataFlow !handle

    -- | There was an error during handshake negotiation.
    --
    -- /Implementation detail:/ we return @'Maybe' handleError@, rather than
    -- 'handleError'.  In case of an existing inbound connection, the
    -- implementation of 'acquireOutboundConnection' is awaiting on handshake
    -- through the connection state.  The 'TerminatingState' or
    -- 'TerminatedState' are not only used for handshake errors, but also for
    -- normal termination, hence the @'Maybe'@.  We could await on
    -- update from the handshake instead, but this would introduce a race
    -- between inbound \/ outbound threads.
    --
  | Disconnected !(ConnectionId peerAddr) !(Maybe handleError)


type AcquireOutboundConnection peerAddr handle handleError m
    =            peerAddr -> m (Connected peerAddr handle handleError)
type IncludeInboundConnection socket peerAddr handle handleError m
    = Word32
    -- ^ inbound connections hard limit.
    -- NOTE: Check TODO over at includeInboundConnectionImpl
    -- definition.
    -> socket -> peerAddr -> m (Connected peerAddr handle handleError)


-- | Outbound connection manager API.
--
data OutboundConnectionManager (muxMode :: Mux.Mode) socket peerAddr handle handleError m where
    OutboundConnectionManager
      :: HasInitiator muxMode ~ True
      => { forall (muxMode :: Mode) peerAddr handle handleError (m :: * -> *)
       socket.
OutboundConnectionManager
  muxMode socket peerAddr handle handleError m
-> AcquireOutboundConnection peerAddr handle handleError m
ocmAcquireConnection :: AcquireOutboundConnection peerAddr handle handleError m
         , forall (muxMode :: Mode) peerAddr handle handleError (m :: * -> *)
       socket.
OutboundConnectionManager
  muxMode socket peerAddr handle handleError m
-> peerAddr -> m (OperationResult AbstractState)
ocmReleaseConnection :: peerAddr -> m (OperationResult AbstractState)
         }
      -> OutboundConnectionManager muxMode socket peerAddr handle handleError m

-- | Inbound connection manager API.  For a server implementation we also need
-- to know how many connections are now managed by the connection manager.
--
-- This type is an internal detail of 'Ouroboros.Network.ConnectionManager'
--
data InboundConnectionManager (muxMode :: Mux.Mode) socket peerAddr handle handleError m where
    InboundConnectionManager
      :: HasResponder muxMode ~ True
      => { forall (muxMode :: Mode) socket peerAddr handle handleError
       (m :: * -> *).
InboundConnectionManager
  muxMode socket peerAddr handle handleError m
-> IncludeInboundConnection socket peerAddr handle handleError m
icmIncludeConnection    :: IncludeInboundConnection socket peerAddr handle handleError m
         , forall (muxMode :: Mode) socket peerAddr handle handleError
       (m :: * -> *).
InboundConnectionManager
  muxMode socket peerAddr handle handleError m
-> peerAddr -> m (OperationResult DemotedToColdRemoteTr)
icmReleaseConnection    :: peerAddr -> m (OperationResult DemotedToColdRemoteTr)
         , forall (muxMode :: Mode) socket peerAddr handle handleError
       (m :: * -> *).
InboundConnectionManager
  muxMode socket peerAddr handle handleError m
-> peerAddr -> m (OperationResult AbstractState)
icmPromotedToWarmRemote :: peerAddr -> m (OperationResult AbstractState)
         , forall (muxMode :: Mode) socket peerAddr handle handleError
       (m :: * -> *).
InboundConnectionManager
  muxMode socket peerAddr handle handleError m
-> peerAddr -> m (OperationResult AbstractState)
icmDemotedToColdRemote
                                   :: peerAddr -> m (OperationResult AbstractState)
         , forall (muxMode :: Mode) socket peerAddr handle handleError
       (m :: * -> *).
InboundConnectionManager
  muxMode socket peerAddr handle handleError m
-> STM m Int
icmNumberOfConnections  :: STM m Int
         }
      -> InboundConnectionManager muxMode socket peerAddr handle handleError m

-- | 'ConnectionManager'.
--
-- We identify resources (e.g. 'Network.Socket.Socket' or
-- 'System.Win32.Types.HANDLE') by their address.   It is enough for us to use
-- just the remote address rather than connection identifier, since we need one
-- connection towards that peer, even if we are connected through multiple
-- local addresses.  It is safe to share a connection manager with multiple
-- listening sockets.
--
data ConnectionManager (muxMode :: Mux.Mode) socket peerAddr handle handleError m =
    ConnectionManager {
        forall (muxMode :: Mode) socket peerAddr handle handleError
       (m :: * -> *).
ConnectionManager muxMode socket peerAddr handle handleError m
-> WithMuxMode
     muxMode
     (OutboundConnectionManager
        muxMode socket peerAddr handle handleError m)
     (InboundConnectionManager
        muxMode socket peerAddr handle handleError m)
getConnectionManager
          :: WithMuxMode
              muxMode
              (OutboundConnectionManager muxMode socket peerAddr handle handleError m)
              (InboundConnectionManager  muxMode socket peerAddr handle handleError m),

        forall (muxMode :: Mode) socket peerAddr handle handleError
       (m :: * -> *).
ConnectionManager muxMode socket peerAddr handle handleError m
-> STM m (Map peerAddr AbstractState)
readState
          :: STM m (Map peerAddr AbstractState),

        -- | This STM action will block until the given connection is fully
        -- closed/terminated. If the connection manager doesn't have any connection to
        -- that peer it won't block.
        forall (muxMode :: Mode) socket peerAddr handle handleError
       (m :: * -> *).
ConnectionManager muxMode socket peerAddr handle handleError m
-> peerAddr -> STM m ()
waitForOutboundDemotion
          :: peerAddr
          -> STM m ()
      }

--
-- ConnectionManager API
--

-- | Include outbound connection into 'ConnectionManager'.
--
--   This executes:
--
-- * \(Reserve\) to \(Negotiated^{*}_{Outbound}\) transitions
-- * \(PromotedToWarm^{Duplex}_{Local}\) transition
-- * \(Awake^{Duplex}_{Local}\) transition
acquireOutboundConnection
    :: HasInitiator muxMode ~ True
    => ConnectionManager muxMode socket peerAddr handle handleError m
    -> AcquireOutboundConnection        peerAddr handle handleError m
acquireOutboundConnection :: forall (muxMode :: Mode) socket peerAddr handle handleError
       (m :: * -> *).
(HasInitiator muxMode ~ 'True) =>
ConnectionManager muxMode socket peerAddr handle handleError m
-> AcquireOutboundConnection peerAddr handle handleError m
acquireOutboundConnection =
    OutboundConnectionManager
  muxMode socket peerAddr handle handleError m
-> AcquireOutboundConnection peerAddr handle handleError m
forall (muxMode :: Mode) peerAddr handle handleError (m :: * -> *)
       socket.
OutboundConnectionManager
  muxMode socket peerAddr handle handleError m
-> AcquireOutboundConnection peerAddr handle handleError m
ocmAcquireConnection (OutboundConnectionManager
   muxMode socket peerAddr handle handleError m
 -> AcquireOutboundConnection peerAddr handle handleError m)
-> (ConnectionManager muxMode socket peerAddr handle handleError m
    -> OutboundConnectionManager
         muxMode socket peerAddr handle handleError m)
-> ConnectionManager muxMode socket peerAddr handle handleError m
-> AcquireOutboundConnection peerAddr handle handleError m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WithMuxMode
  muxMode
  (OutboundConnectionManager
     muxMode socket peerAddr handle handleError m)
  (InboundConnectionManager
     muxMode socket peerAddr handle handleError m)
-> OutboundConnectionManager
     muxMode socket peerAddr handle handleError m
forall (mode :: Mode) a b.
(HasInitiator mode ~ 'True) =>
WithMuxMode mode a b -> a
withInitiatorMode (WithMuxMode
   muxMode
   (OutboundConnectionManager
      muxMode socket peerAddr handle handleError m)
   (InboundConnectionManager
      muxMode socket peerAddr handle handleError m)
 -> OutboundConnectionManager
      muxMode socket peerAddr handle handleError m)
-> (ConnectionManager muxMode socket peerAddr handle handleError m
    -> WithMuxMode
         muxMode
         (OutboundConnectionManager
            muxMode socket peerAddr handle handleError m)
         (InboundConnectionManager
            muxMode socket peerAddr handle handleError m))
-> ConnectionManager muxMode socket peerAddr handle handleError m
-> OutboundConnectionManager
     muxMode socket peerAddr handle handleError m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConnectionManager muxMode socket peerAddr handle handleError m
-> WithMuxMode
     muxMode
     (OutboundConnectionManager
        muxMode socket peerAddr handle handleError m)
     (InboundConnectionManager
        muxMode socket peerAddr handle handleError m)
forall (muxMode :: Mode) socket peerAddr handle handleError
       (m :: * -> *).
ConnectionManager muxMode socket peerAddr handle handleError m
-> WithMuxMode
     muxMode
     (OutboundConnectionManager
        muxMode socket peerAddr handle handleError m)
     (InboundConnectionManager
        muxMode socket peerAddr handle handleError m)
getConnectionManager

-- | Release outbound connection.
--
--   This executes:
--
-- * \(DemotedToCold^{*}_{Local}\) transitions
releaseOutboundConnection
    :: HasInitiator muxMode ~ True
    => ConnectionManager muxMode socket peerAddr handle handleError m
    -> peerAddr
    -> m (OperationResult AbstractState)
    -- ^ reports the from-state.
releaseOutboundConnection :: forall (muxMode :: Mode) socket peerAddr handle handleError
       (m :: * -> *).
(HasInitiator muxMode ~ 'True) =>
ConnectionManager muxMode socket peerAddr handle handleError m
-> peerAddr -> m (OperationResult AbstractState)
releaseOutboundConnection =
    OutboundConnectionManager
  muxMode socket peerAddr handle handleError m
-> peerAddr -> m (OperationResult AbstractState)
forall (muxMode :: Mode) peerAddr handle handleError (m :: * -> *)
       socket.
OutboundConnectionManager
  muxMode socket peerAddr handle handleError m
-> peerAddr -> m (OperationResult AbstractState)
ocmReleaseConnection (OutboundConnectionManager
   muxMode socket peerAddr handle handleError m
 -> peerAddr -> m (OperationResult AbstractState))
-> (ConnectionManager muxMode socket peerAddr handle handleError m
    -> OutboundConnectionManager
         muxMode socket peerAddr handle handleError m)
-> ConnectionManager muxMode socket peerAddr handle handleError m
-> peerAddr
-> m (OperationResult AbstractState)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WithMuxMode
  muxMode
  (OutboundConnectionManager
     muxMode socket peerAddr handle handleError m)
  (InboundConnectionManager
     muxMode socket peerAddr handle handleError m)
-> OutboundConnectionManager
     muxMode socket peerAddr handle handleError m
forall (mode :: Mode) a b.
(HasInitiator mode ~ 'True) =>
WithMuxMode mode a b -> a
withInitiatorMode (WithMuxMode
   muxMode
   (OutboundConnectionManager
      muxMode socket peerAddr handle handleError m)
   (InboundConnectionManager
      muxMode socket peerAddr handle handleError m)
 -> OutboundConnectionManager
      muxMode socket peerAddr handle handleError m)
-> (ConnectionManager muxMode socket peerAddr handle handleError m
    -> WithMuxMode
         muxMode
         (OutboundConnectionManager
            muxMode socket peerAddr handle handleError m)
         (InboundConnectionManager
            muxMode socket peerAddr handle handleError m))
-> ConnectionManager muxMode socket peerAddr handle handleError m
-> OutboundConnectionManager
     muxMode socket peerAddr handle handleError m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConnectionManager muxMode socket peerAddr handle handleError m
-> WithMuxMode
     muxMode
     (OutboundConnectionManager
        muxMode socket peerAddr handle handleError m)
     (InboundConnectionManager
        muxMode socket peerAddr handle handleError m)
forall (muxMode :: Mode) socket peerAddr handle handleError
       (m :: * -> *).
ConnectionManager muxMode socket peerAddr handle handleError m
-> WithMuxMode
     muxMode
     (OutboundConnectionManager
        muxMode socket peerAddr handle handleError m)
     (InboundConnectionManager
        muxMode socket peerAddr handle handleError m)
getConnectionManager

-- | Notify the 'ConnectionManager' that a remote end promoted us to a
-- /warm peer/.
--
-- This executes either:
--
-- * \(PromotedToWarm^{Duplex}_{Remote}\) transition,
-- * \(Awake^{*}_{Remote}\) transition
--
-- from the specification.
--
promotedToWarmRemote
    :: HasResponder muxMode ~ True
    => ConnectionManager muxMode socket peerAddr handle handleError m
    -> peerAddr -> m (OperationResult AbstractState)
promotedToWarmRemote :: forall (muxMode :: Mode) socket peerAddr handle handleError
       (m :: * -> *).
(HasResponder muxMode ~ 'True) =>
ConnectionManager muxMode socket peerAddr handle handleError m
-> peerAddr -> m (OperationResult AbstractState)
promotedToWarmRemote =
    InboundConnectionManager
  muxMode socket peerAddr handle handleError m
-> peerAddr -> m (OperationResult AbstractState)
forall (muxMode :: Mode) socket peerAddr handle handleError
       (m :: * -> *).
InboundConnectionManager
  muxMode socket peerAddr handle handleError m
-> peerAddr -> m (OperationResult AbstractState)
icmPromotedToWarmRemote (InboundConnectionManager
   muxMode socket peerAddr handle handleError m
 -> peerAddr -> m (OperationResult AbstractState))
-> (ConnectionManager muxMode socket peerAddr handle handleError m
    -> InboundConnectionManager
         muxMode socket peerAddr handle handleError m)
-> ConnectionManager muxMode socket peerAddr handle handleError m
-> peerAddr
-> m (OperationResult AbstractState)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WithMuxMode
  muxMode
  (OutboundConnectionManager
     muxMode socket peerAddr handle handleError m)
  (InboundConnectionManager
     muxMode socket peerAddr handle handleError m)
-> InboundConnectionManager
     muxMode socket peerAddr handle handleError m
forall (mode :: Mode) a b.
(HasResponder mode ~ 'True) =>
WithMuxMode mode a b -> b
withResponderMode (WithMuxMode
   muxMode
   (OutboundConnectionManager
      muxMode socket peerAddr handle handleError m)
   (InboundConnectionManager
      muxMode socket peerAddr handle handleError m)
 -> InboundConnectionManager
      muxMode socket peerAddr handle handleError m)
-> (ConnectionManager muxMode socket peerAddr handle handleError m
    -> WithMuxMode
         muxMode
         (OutboundConnectionManager
            muxMode socket peerAddr handle handleError m)
         (InboundConnectionManager
            muxMode socket peerAddr handle handleError m))
-> ConnectionManager muxMode socket peerAddr handle handleError m
-> InboundConnectionManager
     muxMode socket peerAddr handle handleError m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConnectionManager muxMode socket peerAddr handle handleError m
-> WithMuxMode
     muxMode
     (OutboundConnectionManager
        muxMode socket peerAddr handle handleError m)
     (InboundConnectionManager
        muxMode socket peerAddr handle handleError m)
forall (muxMode :: Mode) socket peerAddr handle handleError
       (m :: * -> *).
ConnectionManager muxMode socket peerAddr handle handleError m
-> WithMuxMode
     muxMode
     (OutboundConnectionManager
        muxMode socket peerAddr handle handleError m)
     (InboundConnectionManager
        muxMode socket peerAddr handle handleError m)
getConnectionManager

-- | Notify the 'ConnectionManager' that a remote end demoted us to a /cold
-- peer/.
--
-- This executes:
--
-- * \(DemotedToCold^{*}_{Remote}\) transition.
--
-- This method is idempotent.
--
demotedToColdRemote
    :: HasResponder muxMode ~ True
    => ConnectionManager muxMode socket peerAddr handle handleError m
    -> peerAddr -> m (OperationResult AbstractState)
demotedToColdRemote :: forall (muxMode :: Mode) socket peerAddr handle handleError
       (m :: * -> *).
(HasResponder muxMode ~ 'True) =>
ConnectionManager muxMode socket peerAddr handle handleError m
-> peerAddr -> m (OperationResult AbstractState)
demotedToColdRemote =
    InboundConnectionManager
  muxMode socket peerAddr handle handleError m
-> peerAddr -> m (OperationResult AbstractState)
forall (muxMode :: Mode) socket peerAddr handle handleError
       (m :: * -> *).
InboundConnectionManager
  muxMode socket peerAddr handle handleError m
-> peerAddr -> m (OperationResult AbstractState)
icmDemotedToColdRemote (InboundConnectionManager
   muxMode socket peerAddr handle handleError m
 -> peerAddr -> m (OperationResult AbstractState))
-> (ConnectionManager muxMode socket peerAddr handle handleError m
    -> InboundConnectionManager
         muxMode socket peerAddr handle handleError m)
-> ConnectionManager muxMode socket peerAddr handle handleError m
-> peerAddr
-> m (OperationResult AbstractState)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WithMuxMode
  muxMode
  (OutboundConnectionManager
     muxMode socket peerAddr handle handleError m)
  (InboundConnectionManager
     muxMode socket peerAddr handle handleError m)
-> InboundConnectionManager
     muxMode socket peerAddr handle handleError m
forall (mode :: Mode) a b.
(HasResponder mode ~ 'True) =>
WithMuxMode mode a b -> b
withResponderMode (WithMuxMode
   muxMode
   (OutboundConnectionManager
      muxMode socket peerAddr handle handleError m)
   (InboundConnectionManager
      muxMode socket peerAddr handle handleError m)
 -> InboundConnectionManager
      muxMode socket peerAddr handle handleError m)
-> (ConnectionManager muxMode socket peerAddr handle handleError m
    -> WithMuxMode
         muxMode
         (OutboundConnectionManager
            muxMode socket peerAddr handle handleError m)
         (InboundConnectionManager
            muxMode socket peerAddr handle handleError m))
-> ConnectionManager muxMode socket peerAddr handle handleError m
-> InboundConnectionManager
     muxMode socket peerAddr handle handleError m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConnectionManager muxMode socket peerAddr handle handleError m
-> WithMuxMode
     muxMode
     (OutboundConnectionManager
        muxMode socket peerAddr handle handleError m)
     (InboundConnectionManager
        muxMode socket peerAddr handle handleError m)
forall (muxMode :: Mode) socket peerAddr handle handleError
       (m :: * -> *).
ConnectionManager muxMode socket peerAddr handle handleError m
-> WithMuxMode
     muxMode
     (OutboundConnectionManager
        muxMode socket peerAddr handle handleError m)
     (InboundConnectionManager
        muxMode socket peerAddr handle handleError m)
getConnectionManager

-- | Include an inbound connection into 'ConnectionManager'.
--   This executes:
--
-- * \(Reserve\) to \(Negotiated^{*}_{Outbound}\) transitions
-- * \(PromotedToWarm^{Duplex}_{Local}\) transition
-- * \(Awake^{Duplex}_{Local}\) transition
includeInboundConnection
    :: HasResponder muxMode ~ True
    => ConnectionManager muxMode socket peerAddr handle handleError m
    -> IncludeInboundConnection  socket peerAddr handle handleError m
includeInboundConnection :: forall (muxMode :: Mode) socket peerAddr handle handleError
       (m :: * -> *).
(HasResponder muxMode ~ 'True) =>
ConnectionManager muxMode socket peerAddr handle handleError m
-> IncludeInboundConnection socket peerAddr handle handleError m
includeInboundConnection =
    InboundConnectionManager
  muxMode socket peerAddr handle handleError m
-> IncludeInboundConnection socket peerAddr handle handleError m
forall (muxMode :: Mode) socket peerAddr handle handleError
       (m :: * -> *).
InboundConnectionManager
  muxMode socket peerAddr handle handleError m
-> IncludeInboundConnection socket peerAddr handle handleError m
icmIncludeConnection (InboundConnectionManager
   muxMode socket peerAddr handle handleError m
 -> IncludeInboundConnection socket peerAddr handle handleError m)
-> (ConnectionManager muxMode socket peerAddr handle handleError m
    -> InboundConnectionManager
         muxMode socket peerAddr handle handleError m)
-> ConnectionManager muxMode socket peerAddr handle handleError m
-> IncludeInboundConnection socket peerAddr handle handleError m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WithMuxMode
  muxMode
  (OutboundConnectionManager
     muxMode socket peerAddr handle handleError m)
  (InboundConnectionManager
     muxMode socket peerAddr handle handleError m)
-> InboundConnectionManager
     muxMode socket peerAddr handle handleError m
forall (mode :: Mode) a b.
(HasResponder mode ~ 'True) =>
WithMuxMode mode a b -> b
withResponderMode (WithMuxMode
   muxMode
   (OutboundConnectionManager
      muxMode socket peerAddr handle handleError m)
   (InboundConnectionManager
      muxMode socket peerAddr handle handleError m)
 -> InboundConnectionManager
      muxMode socket peerAddr handle handleError m)
-> (ConnectionManager muxMode socket peerAddr handle handleError m
    -> WithMuxMode
         muxMode
         (OutboundConnectionManager
            muxMode socket peerAddr handle handleError m)
         (InboundConnectionManager
            muxMode socket peerAddr handle handleError m))
-> ConnectionManager muxMode socket peerAddr handle handleError m
-> InboundConnectionManager
     muxMode socket peerAddr handle handleError m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConnectionManager muxMode socket peerAddr handle handleError m
-> WithMuxMode
     muxMode
     (OutboundConnectionManager
        muxMode socket peerAddr handle handleError m)
     (InboundConnectionManager
        muxMode socket peerAddr handle handleError m)
forall (muxMode :: Mode) socket peerAddr handle handleError
       (m :: * -> *).
ConnectionManager muxMode socket peerAddr handle handleError m
-> WithMuxMode
     muxMode
     (OutboundConnectionManager
        muxMode socket peerAddr handle handleError m)
     (InboundConnectionManager
        muxMode socket peerAddr handle handleError m)
getConnectionManager

-- | Release outbound connection. Returns if the operation was successful.
--
-- This executes:
--
-- * \(Commit*{*}\) transition
-- * \(TimeoutExpired\) transition
releaseInboundConnection
    :: HasResponder muxMode ~ True
    => ConnectionManager muxMode socket peerAddr handle handleError m
    -> peerAddr -> m (OperationResult DemotedToColdRemoteTr)
releaseInboundConnection :: forall (muxMode :: Mode) socket peerAddr handle handleError
       (m :: * -> *).
(HasResponder muxMode ~ 'True) =>
ConnectionManager muxMode socket peerAddr handle handleError m
-> peerAddr -> m (OperationResult DemotedToColdRemoteTr)
releaseInboundConnection =
    InboundConnectionManager
  muxMode socket peerAddr handle handleError m
-> peerAddr -> m (OperationResult DemotedToColdRemoteTr)
forall (muxMode :: Mode) socket peerAddr handle handleError
       (m :: * -> *).
InboundConnectionManager
  muxMode socket peerAddr handle handleError m
-> peerAddr -> m (OperationResult DemotedToColdRemoteTr)
icmReleaseConnection (InboundConnectionManager
   muxMode socket peerAddr handle handleError m
 -> peerAddr -> m (OperationResult DemotedToColdRemoteTr))
-> (ConnectionManager muxMode socket peerAddr handle handleError m
    -> InboundConnectionManager
         muxMode socket peerAddr handle handleError m)
-> ConnectionManager muxMode socket peerAddr handle handleError m
-> peerAddr
-> m (OperationResult DemotedToColdRemoteTr)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WithMuxMode
  muxMode
  (OutboundConnectionManager
     muxMode socket peerAddr handle handleError m)
  (InboundConnectionManager
     muxMode socket peerAddr handle handleError m)
-> InboundConnectionManager
     muxMode socket peerAddr handle handleError m
forall (mode :: Mode) a b.
(HasResponder mode ~ 'True) =>
WithMuxMode mode a b -> b
withResponderMode (WithMuxMode
   muxMode
   (OutboundConnectionManager
      muxMode socket peerAddr handle handleError m)
   (InboundConnectionManager
      muxMode socket peerAddr handle handleError m)
 -> InboundConnectionManager
      muxMode socket peerAddr handle handleError m)
-> (ConnectionManager muxMode socket peerAddr handle handleError m
    -> WithMuxMode
         muxMode
         (OutboundConnectionManager
            muxMode socket peerAddr handle handleError m)
         (InboundConnectionManager
            muxMode socket peerAddr handle handleError m))
-> ConnectionManager muxMode socket peerAddr handle handleError m
-> InboundConnectionManager
     muxMode socket peerAddr handle handleError m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConnectionManager muxMode socket peerAddr handle handleError m
-> WithMuxMode
     muxMode
     (OutboundConnectionManager
        muxMode socket peerAddr handle handleError m)
     (InboundConnectionManager
        muxMode socket peerAddr handle handleError m)
forall (muxMode :: Mode) socket peerAddr handle handleError
       (m :: * -> *).
ConnectionManager muxMode socket peerAddr handle handleError m
-> WithMuxMode
     muxMode
     (OutboundConnectionManager
        muxMode socket peerAddr handle handleError m)
     (InboundConnectionManager
        muxMode socket peerAddr handle handleError m)
getConnectionManager

-- | Number of connections tracked by the server.
--
numberOfConnections
    :: HasResponder muxMode ~ True
    => ConnectionManager muxMode socket peerAddr handle handleError m
    -> STM m Int
numberOfConnections :: forall (muxMode :: Mode) socket peerAddr handle handleError
       (m :: * -> *).
(HasResponder muxMode ~ 'True) =>
ConnectionManager muxMode socket peerAddr handle handleError m
-> STM m Int
numberOfConnections =
    InboundConnectionManager
  muxMode socket peerAddr handle handleError m
-> STM m Int
forall (muxMode :: Mode) socket peerAddr handle handleError
       (m :: * -> *).
InboundConnectionManager
  muxMode socket peerAddr handle handleError m
-> STM m Int
icmNumberOfConnections (InboundConnectionManager
   muxMode socket peerAddr handle handleError m
 -> STM m Int)
-> (ConnectionManager muxMode socket peerAddr handle handleError m
    -> InboundConnectionManager
         muxMode socket peerAddr handle handleError m)
-> ConnectionManager muxMode socket peerAddr handle handleError m
-> STM m Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WithMuxMode
  muxMode
  (OutboundConnectionManager
     muxMode socket peerAddr handle handleError m)
  (InboundConnectionManager
     muxMode socket peerAddr handle handleError m)
-> InboundConnectionManager
     muxMode socket peerAddr handle handleError m
forall (mode :: Mode) a b.
(HasResponder mode ~ 'True) =>
WithMuxMode mode a b -> b
withResponderMode (WithMuxMode
   muxMode
   (OutboundConnectionManager
      muxMode socket peerAddr handle handleError m)
   (InboundConnectionManager
      muxMode socket peerAddr handle handleError m)
 -> InboundConnectionManager
      muxMode socket peerAddr handle handleError m)
-> (ConnectionManager muxMode socket peerAddr handle handleError m
    -> WithMuxMode
         muxMode
         (OutboundConnectionManager
            muxMode socket peerAddr handle handleError m)
         (InboundConnectionManager
            muxMode socket peerAddr handle handleError m))
-> ConnectionManager muxMode socket peerAddr handle handleError m
-> InboundConnectionManager
     muxMode socket peerAddr handle handleError m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConnectionManager muxMode socket peerAddr handle handleError m
-> WithMuxMode
     muxMode
     (OutboundConnectionManager
        muxMode socket peerAddr handle handleError m)
     (InboundConnectionManager
        muxMode socket peerAddr handle handleError m)
forall (muxMode :: Mode) socket peerAddr handle handleError
       (m :: * -> *).
ConnectionManager muxMode socket peerAddr handle handleError m
-> WithMuxMode
     muxMode
     (OutboundConnectionManager
        muxMode socket peerAddr handle handleError m)
     (InboundConnectionManager
        muxMode socket peerAddr handle handleError m)
getConnectionManager


--
-- Errors
--


-- | Useful for tracing and error messages.
--
data AbstractState =
    -- | Unknown connection.  This state indicates the connection manager
    -- removed this connection from its state.
      UnknownConnectionSt
    | ReservedOutboundSt
    | UnnegotiatedSt !Provenance
    | InboundIdleSt  !DataFlow
    | InboundSt      !DataFlow
    | OutboundUniSt
    | OutboundDupSt  !TimeoutExpired
    | OutboundIdleSt !DataFlow
    | DuplexSt
    | WaitRemoteIdleSt
    | TerminatingSt
    | TerminatedSt
    deriving (AbstractState -> AbstractState -> Bool
(AbstractState -> AbstractState -> Bool)
-> (AbstractState -> AbstractState -> Bool) -> Eq AbstractState
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AbstractState -> AbstractState -> Bool
== :: AbstractState -> AbstractState -> Bool
$c/= :: AbstractState -> AbstractState -> Bool
/= :: AbstractState -> AbstractState -> Bool
Eq, Eq AbstractState
Eq AbstractState =>
(AbstractState -> AbstractState -> Ordering)
-> (AbstractState -> AbstractState -> Bool)
-> (AbstractState -> AbstractState -> Bool)
-> (AbstractState -> AbstractState -> Bool)
-> (AbstractState -> AbstractState -> Bool)
-> (AbstractState -> AbstractState -> AbstractState)
-> (AbstractState -> AbstractState -> AbstractState)
-> Ord AbstractState
AbstractState -> AbstractState -> Bool
AbstractState -> AbstractState -> Ordering
AbstractState -> AbstractState -> AbstractState
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
$ccompare :: AbstractState -> AbstractState -> Ordering
compare :: AbstractState -> AbstractState -> Ordering
$c< :: AbstractState -> AbstractState -> Bool
< :: AbstractState -> AbstractState -> Bool
$c<= :: AbstractState -> AbstractState -> Bool
<= :: AbstractState -> AbstractState -> Bool
$c> :: AbstractState -> AbstractState -> Bool
> :: AbstractState -> AbstractState -> Bool
$c>= :: AbstractState -> AbstractState -> Bool
>= :: AbstractState -> AbstractState -> Bool
$cmax :: AbstractState -> AbstractState -> AbstractState
max :: AbstractState -> AbstractState -> AbstractState
$cmin :: AbstractState -> AbstractState -> AbstractState
min :: AbstractState -> AbstractState -> AbstractState
Ord, Int -> AbstractState -> ShowS
[AbstractState] -> ShowS
AbstractState -> String
(Int -> AbstractState -> ShowS)
-> (AbstractState -> String)
-> ([AbstractState] -> ShowS)
-> Show AbstractState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AbstractState -> ShowS
showsPrec :: Int -> AbstractState -> ShowS
$cshow :: AbstractState -> String
show :: AbstractState -> String
$cshowList :: [AbstractState] -> ShowS
showList :: [AbstractState] -> ShowS
Show, Typeable)


-- | Counters for tracing and analysis purposes
--
data ConnectionManagerCounters = ConnectionManagerCounters {
      ConnectionManagerCounters -> Int
fullDuplexConns     :: !Int, -- ^ number of full duplex connections
      ConnectionManagerCounters -> Int
duplexConns         :: !Int, -- ^ number of negotiated duplex connections
                                   --   (including DuplexState connections)
      ConnectionManagerCounters -> Int
unidirectionalConns :: !Int, -- ^ number of negotiated unidirectional connections
      ConnectionManagerCounters -> Int
inboundConns        :: !Int, -- ^ number of inbound connections
      ConnectionManagerCounters -> Int
outboundConns       :: !Int  -- ^ number of outbound connections
    }
  deriving (Int -> ConnectionManagerCounters -> ShowS
[ConnectionManagerCounters] -> ShowS
ConnectionManagerCounters -> String
(Int -> ConnectionManagerCounters -> ShowS)
-> (ConnectionManagerCounters -> String)
-> ([ConnectionManagerCounters] -> ShowS)
-> Show ConnectionManagerCounters
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ConnectionManagerCounters -> ShowS
showsPrec :: Int -> ConnectionManagerCounters -> ShowS
$cshow :: ConnectionManagerCounters -> String
show :: ConnectionManagerCounters -> String
$cshowList :: [ConnectionManagerCounters] -> ShowS
showList :: [ConnectionManagerCounters] -> ShowS
Show, ConnectionManagerCounters -> ConnectionManagerCounters -> Bool
(ConnectionManagerCounters -> ConnectionManagerCounters -> Bool)
-> (ConnectionManagerCounters -> ConnectionManagerCounters -> Bool)
-> Eq ConnectionManagerCounters
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ConnectionManagerCounters -> ConnectionManagerCounters -> Bool
== :: ConnectionManagerCounters -> ConnectionManagerCounters -> Bool
$c/= :: ConnectionManagerCounters -> ConnectionManagerCounters -> Bool
/= :: ConnectionManagerCounters -> ConnectionManagerCounters -> Bool
Eq, Eq ConnectionManagerCounters
Eq ConnectionManagerCounters =>
(ConnectionManagerCounters
 -> ConnectionManagerCounters -> Ordering)
-> (ConnectionManagerCounters -> ConnectionManagerCounters -> Bool)
-> (ConnectionManagerCounters -> ConnectionManagerCounters -> Bool)
-> (ConnectionManagerCounters -> ConnectionManagerCounters -> Bool)
-> (ConnectionManagerCounters -> ConnectionManagerCounters -> Bool)
-> (ConnectionManagerCounters
    -> ConnectionManagerCounters -> ConnectionManagerCounters)
-> (ConnectionManagerCounters
    -> ConnectionManagerCounters -> ConnectionManagerCounters)
-> Ord ConnectionManagerCounters
ConnectionManagerCounters -> ConnectionManagerCounters -> Bool
ConnectionManagerCounters -> ConnectionManagerCounters -> Ordering
ConnectionManagerCounters
-> ConnectionManagerCounters -> ConnectionManagerCounters
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
$ccompare :: ConnectionManagerCounters -> ConnectionManagerCounters -> Ordering
compare :: ConnectionManagerCounters -> ConnectionManagerCounters -> Ordering
$c< :: ConnectionManagerCounters -> ConnectionManagerCounters -> Bool
< :: ConnectionManagerCounters -> ConnectionManagerCounters -> Bool
$c<= :: ConnectionManagerCounters -> ConnectionManagerCounters -> Bool
<= :: ConnectionManagerCounters -> ConnectionManagerCounters -> Bool
$c> :: ConnectionManagerCounters -> ConnectionManagerCounters -> Bool
> :: ConnectionManagerCounters -> ConnectionManagerCounters -> Bool
$c>= :: ConnectionManagerCounters -> ConnectionManagerCounters -> Bool
>= :: ConnectionManagerCounters -> ConnectionManagerCounters -> Bool
$cmax :: ConnectionManagerCounters
-> ConnectionManagerCounters -> ConnectionManagerCounters
max :: ConnectionManagerCounters
-> ConnectionManagerCounters -> ConnectionManagerCounters
$cmin :: ConnectionManagerCounters
-> ConnectionManagerCounters -> ConnectionManagerCounters
min :: ConnectionManagerCounters
-> ConnectionManagerCounters -> ConnectionManagerCounters
Ord)

instance Semigroup ConnectionManagerCounters where
    ConnectionManagerCounters Int
fd1 Int
d1 Int
s1 Int
i1 Int
o1 <> :: ConnectionManagerCounters
-> ConnectionManagerCounters -> ConnectionManagerCounters
<> ConnectionManagerCounters Int
fd2 Int
d2 Int
s2 Int
i2 Int
o2 =
      Int -> Int -> Int -> Int -> Int -> ConnectionManagerCounters
ConnectionManagerCounters (Int
fd1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
fd2) (Int
d1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
d2) (Int
s1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
s2) (Int
i1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
i2) (Int
o1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
o2)

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

-- | Exceptions used by 'ConnectionManager'.
--
data ConnectionManagerError peerAddr
    -- | A connection manager was asked for an outbound connection and there
    -- either exists a connection used in outbound direction or a reservation
    -- for an outbound connection.
    --
    = ConnectionExists      !Provenance !peerAddr    !CallStack

    -- | Connection manager was asked for an outbound connection which turned
    -- out to be unidirectional inbound, and thus it cannot be re-used..
    --
    | ForbiddenConnection   !(ConnectionId peerAddr) !CallStack

    -- | Connections that would be forbidden by the kernel (@TCP@ semantics).
    --
    | ImpossibleConnection  !(ConnectionId peerAddr) !CallStack

    -- | Connection is now terminating.
    --
    | ConnectionTerminating !(ConnectionId peerAddr) !CallStack

    -- | Connection has terminated.
    --
    | ConnectionTerminated  !peerAddr                !CallStack

    -- | Connection manager in impossible state.
    | ImpossibleState       !peerAddr                !CallStack

    -- | A forbidden operation in the given connection state.
    | ForbiddenOperation    !peerAddr !AbstractState !CallStack

    -- | A connection does not exists.  Only thrown when an existing connection
    -- was expected.
    --
    | UnknownPeer           !peerAddr                !CallStack
    deriving (Int -> ConnectionManagerError peerAddr -> ShowS
[ConnectionManagerError peerAddr] -> ShowS
ConnectionManagerError peerAddr -> String
(Int -> ConnectionManagerError peerAddr -> ShowS)
-> (ConnectionManagerError peerAddr -> String)
-> ([ConnectionManagerError peerAddr] -> ShowS)
-> Show (ConnectionManagerError peerAddr)
forall peerAddr.
Show peerAddr =>
Int -> ConnectionManagerError peerAddr -> ShowS
forall peerAddr.
Show peerAddr =>
[ConnectionManagerError peerAddr] -> ShowS
forall peerAddr.
Show peerAddr =>
ConnectionManagerError peerAddr -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall peerAddr.
Show peerAddr =>
Int -> ConnectionManagerError peerAddr -> ShowS
showsPrec :: Int -> ConnectionManagerError peerAddr -> ShowS
$cshow :: forall peerAddr.
Show peerAddr =>
ConnectionManagerError peerAddr -> String
show :: ConnectionManagerError peerAddr -> String
$cshowList :: forall peerAddr.
Show peerAddr =>
[ConnectionManagerError peerAddr] -> ShowS
showList :: [ConnectionManagerError peerAddr] -> ShowS
Show, Typeable)


instance ( Show peerAddr
         , Typeable peerAddr ) => Exception (ConnectionManagerError peerAddr) where

    toException :: ConnectionManagerError peerAddr -> SomeException
toException   = ConnectionManagerError peerAddr -> SomeException
forall addr.
(Typeable addr, Show addr) =>
ConnectionManagerError addr -> SomeException
connectionManagerErrorToException
    fromException :: SomeException -> Maybe (ConnectionManagerError peerAddr)
fromException = SomeException -> Maybe (ConnectionManagerError peerAddr)
forall addr.
(Typeable addr, Show addr) =>
SomeException -> Maybe (ConnectionManagerError addr)
connectionManagerErrorFromException

    displayException :: ConnectionManagerError peerAddr -> String
displayException (ConnectionExists Provenance
provenance peerAddr
peerAddr CallStack
cs) =
      [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ String
"Connection already exists with peer "
             , Provenance -> String
forall a. Show a => a -> String
show Provenance
provenance
             , String
" "
             , peerAddr -> String
forall a. Show a => a -> String
show peerAddr
peerAddr
             , String
"\n"
             , CallStack -> String
prettyCallStack CallStack
cs
             ]
    displayException (ForbiddenConnection ConnectionId peerAddr
connId CallStack
cs) =
      [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ String
"Forbidden to reuse a connection (UnidirectionalDataFlow) with peer "
             , ConnectionId peerAddr -> String
forall a. Show a => a -> String
show ConnectionId peerAddr
connId
             , String
"\n"
             , CallStack -> String
prettyCallStack CallStack
cs
             ]
    displayException (ImpossibleConnection ConnectionId peerAddr
connId CallStack
cs) =
      [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ String
"Impossible connection with peer "
             , ConnectionId peerAddr -> String
forall a. Show a => a -> String
show ConnectionId peerAddr
connId
             , String
"\n"
             , CallStack -> String
prettyCallStack CallStack
cs
             ]
    displayException (ConnectionTerminating ConnectionId peerAddr
connId CallStack
cs) =
      [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ String
"Connection terminating "
             , ConnectionId peerAddr -> String
forall a. Show a => a -> String
show ConnectionId peerAddr
connId
             , String
"\n"
             , CallStack -> String
prettyCallStack CallStack
cs
             ]
    displayException (ConnectionTerminated peerAddr
peerAddr CallStack
cs) =
      [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ String
"Connection terminated "
             , peerAddr -> String
forall a. Show a => a -> String
show peerAddr
peerAddr
             , String
"\n"
             , CallStack -> String
prettyCallStack CallStack
cs
             ]
    displayException (ImpossibleState peerAddr
peerAddr CallStack
cs) =
      [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ String
"Imposible connection state for peer "
             , peerAddr -> String
forall a. Show a => a -> String
show peerAddr
peerAddr
             , String
"\n"
             , CallStack -> String
prettyCallStack CallStack
cs
             ]
    displayException (ForbiddenOperation peerAddr
peerAddr AbstractState
reason CallStack
cs) =
      [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ String
"Forbidden operation "
             , peerAddr -> String
forall a. Show a => a -> String
show peerAddr
peerAddr
             , String
" "
             , AbstractState -> String
forall a. Show a => a -> String
show AbstractState
reason
             , String
"\n"
             , CallStack -> String
prettyCallStack CallStack
cs
             ]
    displayException (UnknownPeer peerAddr
peerAddr CallStack
cs) =
      [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ String
"UnknownPeer "
             , peerAddr -> String
forall a. Show a => a -> String
show peerAddr
peerAddr
             , String
"\n"
             , CallStack -> String
prettyCallStack CallStack
cs
             ]


-- | Existential wrapper for @'ConnectionManagerError' peerAddr@.  It allows to
-- use 'fromException', without being bothered about the address type.
--
data SomeConnectionManagerError =
    forall addr. ( Typeable addr
                 , Show addr
                 )
    => SomeConnectionManagerError !(ConnectionManagerError addr)

instance Show SomeConnectionManagerError where
    show :: SomeConnectionManagerError -> String
show (SomeConnectionManagerError ConnectionManagerError addr
e) = ConnectionManagerError addr -> String
forall a. Show a => a -> String
show ConnectionManagerError addr
e

instance Exception SomeConnectionManagerError where
    displayException :: SomeConnectionManagerError -> String
displayException (SomeConnectionManagerError ConnectionManagerError addr
e) = ConnectionManagerError addr -> String
forall e. Exception e => e -> String
displayException ConnectionManagerError addr
e

connectionManagerErrorToException :: (Typeable addr, Show addr)
                                  => ConnectionManagerError addr
                                  -> SomeException
connectionManagerErrorToException :: forall addr.
(Typeable addr, Show addr) =>
ConnectionManagerError addr -> SomeException
connectionManagerErrorToException = SomeConnectionManagerError -> SomeException
forall e. Exception e => e -> SomeException
toException (SomeConnectionManagerError -> SomeException)
-> (ConnectionManagerError addr -> SomeConnectionManagerError)
-> ConnectionManagerError addr
-> SomeException
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConnectionManagerError addr -> SomeConnectionManagerError
forall addr.
(Typeable addr, Show addr) =>
ConnectionManagerError addr -> SomeConnectionManagerError
SomeConnectionManagerError

connectionManagerErrorFromException :: (Typeable addr, Show addr)
                                    => SomeException
                                    -> Maybe (ConnectionManagerError addr)
connectionManagerErrorFromException :: forall addr.
(Typeable addr, Show addr) =>
SomeException -> Maybe (ConnectionManagerError addr)
connectionManagerErrorFromException SomeException
x = do
    SomeConnectionManagerError a <- SomeException -> Maybe SomeConnectionManagerError
forall e. Exception e => SomeException -> Maybe e
fromException SomeException
x
    cast a

--
-- Tracing
--

-- | 'AssertionLocation' contains constructors that situate the location of the tracing so
-- one can be sure where the assertion came from as well as the all relevant information.
--
data AssertionLocation peerAddr
  = ReleaseInboundConnection  !(Maybe (ConnectionId peerAddr)) !AbstractState
  | AcquireOutboundConnection    !(Maybe (ConnectionId peerAddr)) !AbstractState
  | ReleaseOutboundConnection !(Maybe (ConnectionId peerAddr)) !AbstractState
  | PromotedToWarmRemote         !(Maybe (ConnectionId peerAddr)) !AbstractState
  | DemotedToColdRemote          !(Maybe (ConnectionId peerAddr)) !AbstractState
  deriving Int -> AssertionLocation peerAddr -> ShowS
[AssertionLocation peerAddr] -> ShowS
AssertionLocation peerAddr -> String
(Int -> AssertionLocation peerAddr -> ShowS)
-> (AssertionLocation peerAddr -> String)
-> ([AssertionLocation peerAddr] -> ShowS)
-> Show (AssertionLocation peerAddr)
forall peerAddr.
Show peerAddr =>
Int -> AssertionLocation peerAddr -> ShowS
forall peerAddr.
Show peerAddr =>
[AssertionLocation peerAddr] -> ShowS
forall peerAddr.
Show peerAddr =>
AssertionLocation peerAddr -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall peerAddr.
Show peerAddr =>
Int -> AssertionLocation peerAddr -> ShowS
showsPrec :: Int -> AssertionLocation peerAddr -> ShowS
$cshow :: forall peerAddr.
Show peerAddr =>
AssertionLocation peerAddr -> String
show :: AssertionLocation peerAddr -> String
$cshowList :: forall peerAddr.
Show peerAddr =>
[AssertionLocation peerAddr] -> ShowS
showList :: [AssertionLocation peerAddr] -> ShowS
Show


-- | A custom version of 'Maybe' type, which allows to explicitly represent
-- connections which are not registered by the connection manager.
--
data MaybeUnknown state
    -- | Known connection in 'state'
    = Known !state
    -- | There is a possible race condition between connection finalizer and
    -- either inbound or outbound connection registration.  If that happens we
    -- use 'Race' constructor.
    | Race  !state
    -- | Connection is is not known to the connection manager.
    | Unknown
  deriving (Int -> MaybeUnknown state -> ShowS
[MaybeUnknown state] -> ShowS
MaybeUnknown state -> String
(Int -> MaybeUnknown state -> ShowS)
-> (MaybeUnknown state -> String)
-> ([MaybeUnknown state] -> ShowS)
-> Show (MaybeUnknown state)
forall state. Show state => Int -> MaybeUnknown state -> ShowS
forall state. Show state => [MaybeUnknown state] -> ShowS
forall state. Show state => MaybeUnknown state -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall state. Show state => Int -> MaybeUnknown state -> ShowS
showsPrec :: Int -> MaybeUnknown state -> ShowS
$cshow :: forall state. Show state => MaybeUnknown state -> String
show :: MaybeUnknown state -> String
$cshowList :: forall state. Show state => [MaybeUnknown state] -> ShowS
showList :: [MaybeUnknown state] -> ShowS
Show, (forall a b. (a -> b) -> MaybeUnknown a -> MaybeUnknown b)
-> (forall a b. a -> MaybeUnknown b -> MaybeUnknown a)
-> Functor MaybeUnknown
forall a b. a -> MaybeUnknown b -> MaybeUnknown a
forall a b. (a -> b) -> MaybeUnknown a -> MaybeUnknown b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> MaybeUnknown a -> MaybeUnknown b
fmap :: forall a b. (a -> b) -> MaybeUnknown a -> MaybeUnknown b
$c<$ :: forall a b. a -> MaybeUnknown b -> MaybeUnknown a
<$ :: forall a b. a -> MaybeUnknown b -> MaybeUnknown a
Functor)


data Transition' state = Transition
    { forall state. Transition' state -> state
fromState :: !state
    , forall state. Transition' state -> state
toState   :: !state
    }
  deriving (Transition' state -> Transition' state -> Bool
(Transition' state -> Transition' state -> Bool)
-> (Transition' state -> Transition' state -> Bool)
-> Eq (Transition' state)
forall state.
Eq state =>
Transition' state -> Transition' state -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall state.
Eq state =>
Transition' state -> Transition' state -> Bool
== :: Transition' state -> Transition' state -> Bool
$c/= :: forall state.
Eq state =>
Transition' state -> Transition' state -> Bool
/= :: Transition' state -> Transition' state -> Bool
Eq, (forall a b. (a -> b) -> Transition' a -> Transition' b)
-> (forall a b. a -> Transition' b -> Transition' a)
-> Functor Transition'
forall a b. a -> Transition' b -> Transition' a
forall a b. (a -> b) -> Transition' a -> Transition' b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> Transition' a -> Transition' b
fmap :: forall a b. (a -> b) -> Transition' a -> Transition' b
$c<$ :: forall a b. a -> Transition' b -> Transition' a
<$ :: forall a b. a -> Transition' b -> Transition' a
Functor)

instance Show state
      => Show (Transition' state) where
    show :: Transition' state -> String
show Transition { state
fromState :: forall state. Transition' state -> state
fromState :: state
fromState, state
toState :: forall state. Transition' state -> state
toState :: state
toState } =
      [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ state -> String
forall a. Show a => a -> String
show state
fromState
             , String
" → "
             , state -> String
forall a. Show a => a -> String
show state
toState
             ]

type Transition state   = Transition' (MaybeUnknown state)
type AbstractTransition = Transition' AbstractState

mkTransition :: state -> state -> Transition state
mkTransition :: forall state. state -> state -> Transition state
mkTransition state
from state
to = Transition { fromState :: MaybeUnknown state
fromState = state -> MaybeUnknown state
forall state. state -> MaybeUnknown state
Known state
from
                                  , toState :: MaybeUnknown state
toState   = state -> MaybeUnknown state
forall state. state -> MaybeUnknown state
Known state
to
                                  }

mkAbsTransition :: AbstractState -> AbstractState -> AbstractTransition
mkAbsTransition :: AbstractState -> AbstractState -> AbstractTransition
mkAbsTransition AbstractState
from AbstractState
to = Transition { fromState :: AbstractState
fromState = AbstractState
from
                                     , toState :: AbstractState
toState   = AbstractState
to
                                     }

data TransitionTrace' peerAddr state = TransitionTrace
    { forall peerAddr state. TransitionTrace' peerAddr state -> peerAddr
ttPeerAddr   :: peerAddr
    , forall peerAddr state.
TransitionTrace' peerAddr state -> Transition' state
ttTransition :: Transition' state
    }
  deriving (forall a b.
 (a -> b)
 -> TransitionTrace' peerAddr a -> TransitionTrace' peerAddr b)
-> (forall a b.
    a -> TransitionTrace' peerAddr b -> TransitionTrace' peerAddr a)
-> Functor (TransitionTrace' peerAddr)
forall a b.
a -> TransitionTrace' peerAddr b -> TransitionTrace' peerAddr a
forall a b.
(a -> b)
-> TransitionTrace' peerAddr a -> TransitionTrace' peerAddr b
forall peerAddr a b.
a -> TransitionTrace' peerAddr b -> TransitionTrace' peerAddr a
forall peerAddr a b.
(a -> b)
-> TransitionTrace' peerAddr a -> TransitionTrace' peerAddr b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall peerAddr a b.
(a -> b)
-> TransitionTrace' peerAddr a -> TransitionTrace' peerAddr b
fmap :: forall a b.
(a -> b)
-> TransitionTrace' peerAddr a -> TransitionTrace' peerAddr b
$c<$ :: forall peerAddr a b.
a -> TransitionTrace' peerAddr b -> TransitionTrace' peerAddr a
<$ :: forall a b.
a -> TransitionTrace' peerAddr b -> TransitionTrace' peerAddr a
Functor

instance (Show peerAddr, Show state)
      =>  Show (TransitionTrace' peerAddr state) where
    show :: TransitionTrace' peerAddr state -> String
show (TransitionTrace peerAddr
addr Transition' state
tr) =
      [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ String
"TransitionTrace @("
             , peerAddr -> String
forall a. Show a => a -> String
show peerAddr
addr
             , String
") ("
             , Transition' state -> String
forall a. Show a => a -> String
show Transition' state
tr
             , String
")"
             ]

type TransitionTrace peerAddr state = TransitionTrace' peerAddr (MaybeUnknown state)
type AbstractTransitionTrace peerAddr = TransitionTrace' peerAddr AbstractState