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

-- '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 'MuxMode', though the most useful ones are 'ResponderMode' and '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 'requestOutboundConnection' 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 (..)
    -- ** Prune Policy
  , PrunePolicy
  , simplePrunePolicy
    -- * Connection Manager
    -- ** Connection Manager Arguments
  , ConnectionManager (..)
    -- ** API
  , Connected (..)
  , OperationResult (..)
  , resultInState
  , DemotedToColdRemoteTr (..)
  , RequestOutboundConnection
  , IncludeInboundConnection
    -- *** Outbound side
  , requestOutboundConnection
  , promotedToWarmRemote
  , demotedToColdRemote
  , unregisterOutboundConnection
    -- *** Inbound side
  , includeInboundConnection
  , unregisterInboundConnection
  , 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 (..)
  , ConnectionManagerTrace (..)
  , MaybeUnknown (..)
  , Transition' (..)
  , Transition
  , AbstractTransition
  , mkTransition
  , TransitionTrace
  , TransitionTrace' (..)
  , AbstractTransitionTrace
  ) where

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

import           Network.Mux.Types (HasInitiator, HasResponder, MiniProtocolDir,
                     MuxBearer, MuxMode (..))

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
showList :: [AddressType] -> ShowS
$cshowList :: [AddressType] -> ShowS
show :: AddressType -> String
$cshow :: AddressType -> String
showsPrec :: Int -> AddressType -> ShowS
$cshowsPrec :: Int -> 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
/= :: Provenance -> Provenance -> Bool
$c/= :: Provenance -> Provenance -> Bool
== :: Provenance -> Provenance -> Bool
$c== :: 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
min :: Provenance -> Provenance -> Provenance
$cmin :: Provenance -> Provenance -> Provenance
max :: Provenance -> Provenance -> Provenance
$cmax :: Provenance -> Provenance -> Provenance
>= :: Provenance -> Provenance -> Bool
$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
compare :: Provenance -> Provenance -> Ordering
$ccompare :: Provenance -> Provenance -> Ordering
$cp1Ord :: Eq 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
showList :: [Provenance] -> ShowS
$cshowList :: [Provenance] -> ShowS
show :: Provenance -> String
$cshow :: Provenance -> String
showsPrec :: Int -> Provenance -> ShowS
$cshowsPrec :: Int -> 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.
--
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
/= :: DataFlow -> DataFlow -> Bool
$c/= :: DataFlow -> DataFlow -> Bool
== :: DataFlow -> DataFlow -> Bool
$c== :: 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
min :: DataFlow -> DataFlow -> DataFlow
$cmin :: DataFlow -> DataFlow -> DataFlow
max :: DataFlow -> DataFlow -> DataFlow
$cmax :: DataFlow -> DataFlow -> DataFlow
>= :: DataFlow -> DataFlow -> Bool
$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
compare :: DataFlow -> DataFlow -> Ordering
$ccompare :: DataFlow -> DataFlow -> Ordering
$cp1Ord :: Eq 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
showList :: [DataFlow] -> ShowS
$cshowList :: [DataFlow] -> ShowS
show :: DataFlow -> String
$cshow :: DataFlow -> String
showsPrec :: Int -> DataFlow -> ShowS
$cshowsPrec :: Int -> 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
/= :: TimeoutExpired -> TimeoutExpired -> Bool
$c/= :: TimeoutExpired -> TimeoutExpired -> Bool
== :: TimeoutExpired -> TimeoutExpired -> Bool
$c== :: 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
min :: TimeoutExpired -> TimeoutExpired -> TimeoutExpired
$cmin :: TimeoutExpired -> TimeoutExpired -> TimeoutExpired
max :: TimeoutExpired -> TimeoutExpired -> TimeoutExpired
$cmax :: TimeoutExpired -> TimeoutExpired -> TimeoutExpired
>= :: TimeoutExpired -> TimeoutExpired -> Bool
$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
compare :: TimeoutExpired -> TimeoutExpired -> Ordering
$ccompare :: TimeoutExpired -> TimeoutExpired -> Ordering
$cp1Ord :: Eq 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
showList :: [TimeoutExpired] -> ShowS
$cshowList :: [TimeoutExpired] -> ShowS
show :: TimeoutExpired -> String
$cshow :: TimeoutExpired -> String
showsPrec :: Int -> TimeoutExpired -> ShowS
$cshowsPrec :: Int -> 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
/= :: ConnectionType -> ConnectionType -> Bool
$c/= :: ConnectionType -> ConnectionType -> Bool
== :: ConnectionType -> ConnectionType -> Bool
$c== :: 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
min :: ConnectionType -> ConnectionType -> ConnectionType
$cmin :: ConnectionType -> ConnectionType -> ConnectionType
max :: ConnectionType -> ConnectionType -> ConnectionType
$cmax :: ConnectionType -> ConnectionType -> ConnectionType
>= :: ConnectionType -> ConnectionType -> Bool
$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
compare :: ConnectionType -> ConnectionType -> Ordering
$ccompare :: ConnectionType -> ConnectionType -> Ordering
$cp1Ord :: Eq 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
showList :: [ConnectionType] -> ShowS
$cshowList :: [ConnectionType] -> ShowS
show :: ConnectionType -> String
$cshow :: ConnectionType -> String
showsPrec :: Int -> ConnectionType -> ShowS
$cshowsPrec :: Int -> 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.
    --
    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.
    --
    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
showList :: [PromiseWriterException] -> ShowS
$cshowList :: [PromiseWriterException] -> ShowS
show :: PromiseWriterException -> String
$cshow :: PromiseWriterException -> String
showsPrec :: Int -> PromiseWriterException -> ShowS
$cshowsPrec :: Int -> PromiseWriterException -> ShowS
Show, Typeable)

instance Exception PromiseWriterException


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

readPromiseIO :: MonadSTM m => PromiseReader m a -> m a
readPromiseIO :: PromiseReader m a -> m a
readPromiseIO = 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 :: STM m (PromiseReader m a, PromiseWriter m a)
newEmptyPromise = do
    (StrictTMVar m a
v :: StrictTMVar m a) <- STM m (StrictTMVar m a)
forall (m :: * -> *) a. MonadSTM m => STM m (StrictTMVar m a)
newEmptyTMVar
    let reader :: PromiseReader m a
reader = PromiseReader :: forall (m :: * -> *) a. STM m a -> PromiseReader m a
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 m a
writer = PromiseWriter :: forall (m :: * -> *) a.
(a -> STM m ()) -> (a -> STM m ()) -> PromiseWriter m a
PromiseWriter {
                    writePromise :: a -> STM m ()
writePromise = \a
a -> do
                      Bool
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
                      Bool -> STM m () -> STM m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
r
                        (PromiseWriterException -> STM m ()
forall (m :: * -> *) e a.
(MonadSTM m, MonadThrow (STM m), Exception e) =>
e -> STM m a
throwSTM PromiseWriterException
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 (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)
                  }
    (PromiseReader m a, PromiseWriter m a)
-> STM m (PromiseReader m a, PromiseWriter m a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PromiseReader m a
reader, PromiseWriter m a
writer)

newEmptyPromiseIO :: ( MonadSTM m
                     , MonadThrow (STM m) )
                  => m (PromiseReader m a, PromiseWriter m a)
newEmptyPromiseIO :: m (PromiseReader m a, PromiseWriter m a)
newEmptyPromiseIO = STM m (PromiseReader m a, PromiseWriter m a)
-> m (PromiseReader m a, PromiseWriter 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 @'MuxMode'@.
--


-- | Handler action is started with asynchronous exceptions masked; this allows
-- to install exception handlers in an async-safe way.
--
newtype MaskedAction m a = MaskedAction {
    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 (handle, version))
    -> Tracer m handlerTrace
    -> ConnectionId peerAddr
    -> (DiffTime -> socket -> m (MuxBearer m))
    -> MaskedAction m ()


-- | Connection handler action.  It is index by @muxMode :: 'MuxMode'@.
-- There's one 'ConnectionHandlerFn' per provenance, possibly limited by
-- @muxMode@.
--
newtype ConnectionHandler muxMode handlerTrace socket peerAddr handle handleError version m =
    ConnectionHandler {
        -- | Connection handler.
        --
        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
/= :: Inactive -> Inactive -> Bool
$c/= :: Inactive -> Inactive -> Bool
== :: Inactive -> Inactive -> Bool
$c== :: 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
showList :: [Inactive] -> ShowS
$cshowList :: [Inactive] -> ShowS
show :: Inactive -> String
$cshow :: Inactive -> String
showsPrec :: Int -> Inactive -> ShowS
$cshowsPrec :: Int -> 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 stm =  Map peerAddr ConnectionType
                              -> Int
                              -> stm (Set peerAddr)


-- | The simplest 'PrunePolicy', it should only be used for tests.
--
simplePrunePolicy :: ( Applicative stm, Ord peerAddr )
                  => PrunePolicy peerAddr stm
simplePrunePolicy :: PrunePolicy peerAddr stm
simplePrunePolicy Map peerAddr ConnectionType
m Int
n =
    Set peerAddr -> stm (Set peerAddr)
forall (f :: * -> *) a. Applicative f => a -> f a
pure
  (Set peerAddr -> stm (Set peerAddr))
-> (Map peerAddr ConnectionType -> Set peerAddr)
-> Map peerAddr ConnectionType
-> stm (Set peerAddr)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [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 -> stm (Set peerAddr))
-> Map peerAddr ConnectionType -> stm (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
showList :: [OperationResult a] -> ShowS
$cshowList :: forall a. Show a => [OperationResult a] -> ShowS
show :: OperationResult a -> String
$cshow :: forall a. Show a => OperationResult a -> String
showsPrec :: Int -> OperationResult a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> OperationResult a -> ShowS
Show, a -> OperationResult b -> OperationResult a
(a -> b) -> OperationResult a -> OperationResult b
(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
<$ :: a -> OperationResult b -> OperationResult a
$c<$ :: forall a b. a -> OperationResult b -> OperationResult a
fmap :: (a -> b) -> OperationResult a -> OperationResult b
$cfmap :: forall a b. (a -> b) -> OperationResult a -> OperationResult b
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 'unregisterInboundConnection' 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
showList :: [DemotedToColdRemoteTr] -> ShowS
$cshowList :: [DemotedToColdRemoteTr] -> ShowS
show :: DemotedToColdRemoteTr -> String
$cshow :: DemotedToColdRemoteTr -> String
showsPrec :: Int -> DemotedToColdRemoteTr -> ShowS
$cshowsPrec :: Int -> DemotedToColdRemoteTr -> ShowS
Show


-- | Result of 'requestOutboundConnection' 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 'requestOutboundConnection' 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 RequestOutboundConnection 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 :: MuxMode) socket peerAddr handle handleError m where
    OutboundConnectionManager
      :: HasInitiator muxMode ~ True
      => { OutboundConnectionManager
  muxMode socket peerAddr handle handleError m
-> RequestOutboundConnection peerAddr handle handleError m
ocmRequestConnection    :: RequestOutboundConnection peerAddr handle handleError m
         , OutboundConnectionManager
  muxMode socket peerAddr handle handleError m
-> peerAddr -> m (OperationResult AbstractState)
ocmUnregisterConnection :: 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 :: MuxMode) socket peerAddr handle handleError m where
    InboundConnectionManager
      :: HasResponder muxMode ~ True
      => { InboundConnectionManager
  muxMode socket peerAddr handle handleError m
-> IncludeInboundConnection socket peerAddr handle handleError m
icmIncludeConnection    :: IncludeInboundConnection socket peerAddr handle handleError m
         , InboundConnectionManager
  muxMode socket peerAddr handle handleError m
-> peerAddr -> m (OperationResult DemotedToColdRemoteTr)
icmUnregisterConnection :: peerAddr -> m (OperationResult DemotedToColdRemoteTr)
         , InboundConnectionManager
  muxMode socket peerAddr handle handleError m
-> peerAddr -> m (OperationResult AbstractState)
icmPromotedToWarmRemote :: peerAddr -> m (OperationResult AbstractState)
         , InboundConnectionManager
  muxMode socket peerAddr handle handleError m
-> peerAddr -> m (OperationResult AbstractState)
icmDemotedToColdRemote
                                   :: peerAddr -> m (OperationResult AbstractState)
         , 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 :: MuxMode) socket peerAddr handle handleError m =
    ConnectionManager {
        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),

        ConnectionManager muxMode socket peerAddr handle handleError m
-> m (Map peerAddr AbstractState)
readState
          :: m (Map peerAddr AbstractState)
      }

--
-- ConnectionManager API
--

-- | Include outbound connection into 'ConnectionManager'.
--
--   This executes:
--
-- * \(Reserve\) to \(Negotiated^{*}_{Outbound}\) transitions
-- * \(PromotedToWarm^{Duplex}_{Local}\) transition
-- * \(Awake^{Duplex}_{Local}\) transition
requestOutboundConnection
    :: HasInitiator muxMode ~ True
    => ConnectionManager muxMode socket peerAddr handle handleError m
    -> RequestOutboundConnection        peerAddr handle handleError m
requestOutboundConnection :: ConnectionManager muxMode socket peerAddr handle handleError m
-> RequestOutboundConnection peerAddr handle handleError m
requestOutboundConnection =
    OutboundConnectionManager
  muxMode socket peerAddr handle handleError m
-> RequestOutboundConnection peerAddr handle handleError m
forall (muxMode :: MuxMode) socket peerAddr handle handleError
       (m :: * -> *).
OutboundConnectionManager
  muxMode socket peerAddr handle handleError m
-> RequestOutboundConnection peerAddr handle handleError m
ocmRequestConnection (OutboundConnectionManager
   muxMode socket peerAddr handle handleError m
 -> RequestOutboundConnection 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
-> RequestOutboundConnection 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 :: MuxMode) 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 :: 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)
getConnectionManager

-- | Unregister outbound connection.
--
--   This executes:
--
-- * \(DemotedToCold^{*}_{Local}\) transitions
unregisterOutboundConnection
    :: HasInitiator muxMode ~ True
    => ConnectionManager muxMode socket peerAddr handle handleError m
    -> peerAddr
    -> m (OperationResult AbstractState)
    -- ^ reports the from-state.
unregisterOutboundConnection :: ConnectionManager muxMode socket peerAddr handle handleError m
-> peerAddr -> m (OperationResult AbstractState)
unregisterOutboundConnection =
    OutboundConnectionManager
  muxMode socket peerAddr handle handleError m
-> peerAddr -> m (OperationResult AbstractState)
forall (muxMode :: MuxMode) socket peerAddr handle handleError
       (m :: * -> *).
OutboundConnectionManager
  muxMode socket peerAddr handle handleError m
-> peerAddr -> m (OperationResult AbstractState)
ocmUnregisterConnection (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 :: MuxMode) 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 :: 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)
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 :: 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 :: MuxMode) 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 :: MuxMode) 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 :: 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)
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 :: 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 :: MuxMode) 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 :: MuxMode) 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 :: 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)
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 :: 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 :: MuxMode) 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 :: MuxMode) 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 :: 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)
getConnectionManager

-- | Unregister outbound connection. Returns if the operation was successul.
--
-- This executes:
--
-- * \(Commit*{*}\) transition
-- * \(TimeoutExpired\) transition
unregisterInboundConnection
    :: HasResponder muxMode ~ True
    => ConnectionManager muxMode socket peerAddr handle handleError m
    -> peerAddr -> m (OperationResult DemotedToColdRemoteTr)
unregisterInboundConnection :: ConnectionManager muxMode socket peerAddr handle handleError m
-> peerAddr -> m (OperationResult DemotedToColdRemoteTr)
unregisterInboundConnection =
    InboundConnectionManager
  muxMode socket peerAddr handle handleError m
-> peerAddr -> m (OperationResult DemotedToColdRemoteTr)
forall (muxMode :: MuxMode) socket peerAddr handle handleError
       (m :: * -> *).
InboundConnectionManager
  muxMode socket peerAddr handle handleError m
-> peerAddr -> m (OperationResult DemotedToColdRemoteTr)
icmUnregisterConnection (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 :: MuxMode) 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 :: 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)
getConnectionManager

-- | Number of connections tracked by the server.
--
numberOfConnections
    :: HasResponder muxMode ~ True
    => ConnectionManager muxMode socket peerAddr handle handleError m
    -> STM m Int
numberOfConnections :: ConnectionManager muxMode socket peerAddr handle handleError m
-> STM m Int
numberOfConnections =
    InboundConnectionManager
  muxMode socket peerAddr handle handleError m
-> STM m Int
forall (muxMode :: MuxMode) 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 :: MuxMode) 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 :: 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)
getConnectionManager


--
-- Errors
--


-- | Useful for tracing and error messages.
--
data AbstractState
    = 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
/= :: AbstractState -> AbstractState -> Bool
$c/= :: AbstractState -> AbstractState -> Bool
== :: AbstractState -> AbstractState -> Bool
$c== :: 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
min :: AbstractState -> AbstractState -> AbstractState
$cmin :: AbstractState -> AbstractState -> AbstractState
max :: AbstractState -> AbstractState -> AbstractState
$cmax :: AbstractState -> AbstractState -> AbstractState
>= :: AbstractState -> AbstractState -> Bool
$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
compare :: AbstractState -> AbstractState -> Ordering
$ccompare :: AbstractState -> AbstractState -> Ordering
$cp1Ord :: Eq 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
showList :: [AbstractState] -> ShowS
$cshowList :: [AbstractState] -> ShowS
show :: AbstractState -> String
$cshow :: AbstractState -> String
showsPrec :: Int -> AbstractState -> ShowS
$cshowsPrec :: Int -> 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
showList :: [ConnectionManagerCounters] -> ShowS
$cshowList :: [ConnectionManagerCounters] -> ShowS
show :: ConnectionManagerCounters -> String
$cshow :: ConnectionManagerCounters -> String
showsPrec :: Int -> ConnectionManagerCounters -> ShowS
$cshowsPrec :: Int -> ConnectionManagerCounters -> ShowS
Show, ConnectionManagerCounters -> ConnectionManagerCounters -> Bool
(ConnectionManagerCounters -> ConnectionManagerCounters -> Bool)
-> (ConnectionManagerCounters -> ConnectionManagerCounters -> Bool)
-> Eq ConnectionManagerCounters
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ConnectionManagerCounters -> ConnectionManagerCounters -> Bool
$c/= :: ConnectionManagerCounters -> ConnectionManagerCounters -> Bool
== :: ConnectionManagerCounters -> ConnectionManagerCounters -> Bool
$c== :: 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
min :: ConnectionManagerCounters
-> ConnectionManagerCounters -> ConnectionManagerCounters
$cmin :: ConnectionManagerCounters
-> ConnectionManagerCounters -> ConnectionManagerCounters
max :: ConnectionManagerCounters
-> ConnectionManagerCounters -> ConnectionManagerCounters
$cmax :: ConnectionManagerCounters
-> ConnectionManagerCounters -> ConnectionManagerCounters
>= :: ConnectionManagerCounters -> ConnectionManagerCounters -> Bool
$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
compare :: ConnectionManagerCounters -> ConnectionManagerCounters -> Ordering
$ccompare :: ConnectionManagerCounters -> ConnectionManagerCounters -> Ordering
$cp1Ord :: Eq 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
showList :: [ConnectionManagerError peerAddr] -> ShowS
$cshowList :: forall peerAddr.
Show peerAddr =>
[ConnectionManagerError peerAddr] -> ShowS
show :: ConnectionManagerError peerAddr -> String
$cshow :: forall peerAddr.
Show peerAddr =>
ConnectionManagerError peerAddr -> String
showsPrec :: Int -> ConnectionManagerError peerAddr -> ShowS
$cshowsPrec :: forall peerAddr.
Show peerAddr =>
Int -> 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 :: 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 :: SomeException -> Maybe (ConnectionManagerError addr)
connectionManagerErrorFromException SomeException
x = do
    SomeConnectionManagerError ConnectionManagerError addr
a <- SomeException -> Maybe SomeConnectionManagerError
forall e. Exception e => SomeException -> Maybe e
fromException SomeException
x
    ConnectionManagerError addr -> Maybe (ConnectionManagerError addr)
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast ConnectionManagerError addr
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
  = UnregisterInboundConnection  !(Maybe (ConnectionId peerAddr)) !AbstractState
  | RequestOutboundConnection    !(Maybe (ConnectionId peerAddr)) !AbstractState
  | UnregisterOutboundConnection !(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
showList :: [AssertionLocation peerAddr] -> ShowS
$cshowList :: forall peerAddr.
Show peerAddr =>
[AssertionLocation peerAddr] -> ShowS
show :: AssertionLocation peerAddr -> String
$cshow :: forall peerAddr.
Show peerAddr =>
AssertionLocation peerAddr -> String
showsPrec :: Int -> AssertionLocation peerAddr -> ShowS
$cshowsPrec :: forall peerAddr.
Show peerAddr =>
Int -> AssertionLocation peerAddr -> ShowS
Show

-- | 'ConnectionManagerTrace' contains a hole for a trace of single connection
-- which is filled with 'ConnectionHandlerTrace'.
--
data ConnectionManagerTrace peerAddr handlerTrace
  = TrIncludeConnection            Provenance peerAddr
  | TrUnregisterConnection         Provenance peerAddr
  | TrConnect                      (Maybe peerAddr) -- ^ local address
                                   peerAddr         -- ^ remote address
  | TrConnectError                 (Maybe peerAddr) -- ^ local address
                                   peerAddr         -- ^ remote address
                                   SomeException
  | TrTerminatingConnection        Provenance (ConnectionId peerAddr)
  | TrTerminatedConnection         Provenance peerAddr
  | TrConnectionHandler            (ConnectionId peerAddr) handlerTrace
  | TrShutdown
  | TrConnectionExists             Provenance peerAddr    AbstractState
  | TrForbiddenConnection          (ConnectionId peerAddr)
  | TrImpossibleConnection         (ConnectionId peerAddr)
  | TrConnectionFailure            (ConnectionId peerAddr)
  | TrConnectionNotFound           Provenance peerAddr
  | TrForbiddenOperation           peerAddr                AbstractState
  | TrPruneConnections             (Set peerAddr) -- ^ prunning set
                                   Int            -- ^ number connections that must be prunned
                                   (Set peerAddr) -- ^ choice set
  | TrConnectionCleanup            (ConnectionId peerAddr)
  | TrConnectionTimeWait           (ConnectionId peerAddr)
  | TrConnectionTimeWaitDone       (ConnectionId peerAddr)
  | TrConnectionManagerCounters    ConnectionManagerCounters
  | TrState                        (Map peerAddr AbstractState)
  -- ^ traced on SIGUSR1 signal, installed in 'runDataDiffusion'
  | TrUnexpectedlyFalseAssertion   (AssertionLocation peerAddr)
  -- ^ This case is unexpected at call site.
  deriving Int -> ConnectionManagerTrace peerAddr handlerTrace -> ShowS
[ConnectionManagerTrace peerAddr handlerTrace] -> ShowS
ConnectionManagerTrace peerAddr handlerTrace -> String
(Int -> ConnectionManagerTrace peerAddr handlerTrace -> ShowS)
-> (ConnectionManagerTrace peerAddr handlerTrace -> String)
-> ([ConnectionManagerTrace peerAddr handlerTrace] -> ShowS)
-> Show (ConnectionManagerTrace peerAddr handlerTrace)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall peerAddr handlerTrace.
(Show peerAddr, Show handlerTrace) =>
Int -> ConnectionManagerTrace peerAddr handlerTrace -> ShowS
forall peerAddr handlerTrace.
(Show peerAddr, Show handlerTrace) =>
[ConnectionManagerTrace peerAddr handlerTrace] -> ShowS
forall peerAddr handlerTrace.
(Show peerAddr, Show handlerTrace) =>
ConnectionManagerTrace peerAddr handlerTrace -> String
showList :: [ConnectionManagerTrace peerAddr handlerTrace] -> ShowS
$cshowList :: forall peerAddr handlerTrace.
(Show peerAddr, Show handlerTrace) =>
[ConnectionManagerTrace peerAddr handlerTrace] -> ShowS
show :: ConnectionManagerTrace peerAddr handlerTrace -> String
$cshow :: forall peerAddr handlerTrace.
(Show peerAddr, Show handlerTrace) =>
ConnectionManagerTrace peerAddr handlerTrace -> String
showsPrec :: Int -> ConnectionManagerTrace peerAddr handlerTrace -> ShowS
$cshowsPrec :: forall peerAddr handlerTrace.
(Show peerAddr, Show handlerTrace) =>
Int -> ConnectionManagerTrace peerAddr handlerTrace -> 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
showList :: [MaybeUnknown state] -> ShowS
$cshowList :: forall state. Show state => [MaybeUnknown state] -> ShowS
show :: MaybeUnknown state -> String
$cshow :: forall state. Show state => MaybeUnknown state -> String
showsPrec :: Int -> MaybeUnknown state -> ShowS
$cshowsPrec :: forall state. Show state => Int -> MaybeUnknown state -> ShowS
Show, a -> MaybeUnknown b -> MaybeUnknown a
(a -> b) -> MaybeUnknown a -> MaybeUnknown b
(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
<$ :: a -> MaybeUnknown b -> MaybeUnknown a
$c<$ :: forall a b. a -> MaybeUnknown b -> MaybeUnknown a
fmap :: (a -> b) -> MaybeUnknown a -> MaybeUnknown b
$cfmap :: forall a b. (a -> b) -> MaybeUnknown a -> MaybeUnknown b
Functor)


data Transition' state = Transition
    { Transition' state -> state
fromState :: !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
/= :: Transition' state -> Transition' state -> Bool
$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
Eq, a -> Transition' b -> Transition' a
(a -> b) -> Transition' a -> Transition' b
(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
<$ :: a -> Transition' b -> Transition' a
$c<$ :: forall a b. a -> Transition' b -> Transition' a
fmap :: (a -> b) -> Transition' a -> Transition' b
$cfmap :: forall a b. (a -> b) -> Transition' a -> Transition' b
Functor)

instance Show state
      => Show (Transition' state) where
    show :: Transition' state -> String
show Transition { state
fromState :: state
fromState :: forall state. Transition' state -> state
fromState, state
toState :: state
toState :: forall state. Transition' state -> 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 :: state -> state -> Transition state
mkTransition state
from state
to = Transition :: forall state. state -> state -> Transition' state
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
                                  }


data TransitionTrace' peerAddr state = TransitionTrace
    { TransitionTrace' peerAddr state -> peerAddr
ttPeerAddr   :: peerAddr
    , TransitionTrace' peerAddr state -> Transition' state
ttTransition :: Transition' state
    }
  deriving a -> TransitionTrace' peerAddr b -> TransitionTrace' peerAddr a
(a -> b)
-> TransitionTrace' peerAddr a -> TransitionTrace' peerAddr b
(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
<$ :: a -> TransitionTrace' peerAddr b -> TransitionTrace' peerAddr a
$c<$ :: forall peerAddr a b.
a -> TransitionTrace' peerAddr b -> TransitionTrace' peerAddr a
fmap :: (a -> b)
-> TransitionTrace' peerAddr a -> TransitionTrace' peerAddr b
$cfmap :: forall peerAddr a b.
(a -> b)
-> TransitionTrace' peerAddr a -> TransitionTrace' peerAddr b
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