{-# LANGUAGE DataKinds             #-}
{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE GADTs                 #-}
{-# LANGUAGE KindSignatures        #-}
{-# LANGUAGE LambdaCase            #-}
{-# LANGUAGE NamedFieldPuns        #-}
{-# LANGUAGE RankNTypes            #-}
{-# LANGUAGE ScopedTypeVariables   #-}
{-# LANGUAGE TupleSections         #-}
-- Undecidable instances are need for 'Show' instance of 'ConnectionState'.
{-# LANGUAGE QuantifiedConstraints #-}
{-# LANGUAGE UndecidableInstances  #-}

-- | The implementation of connection manager.
--
module Ouroboros.Network.ConnectionManager.Core
  ( ConnectionManagerArguments (..)
  , withConnectionManager
  , defaultTimeWaitTimeout
  , defaultProtocolIdleTimeout
  , defaultResetTimeout
  , ConnectionState (..)
  , abstractState
  ) where

import           Control.Applicative (Alternative)
import qualified Control.Concurrent.Class.MonadSTM as LazySTM
import           Control.Concurrent.Class.MonadSTM.Strict
import           Control.Exception (assert)
import           Control.Monad (forM_, guard, when, (>=>))
import           Control.Monad.Class.MonadAsync
import           Control.Monad.Class.MonadFork (throwTo)
import           Control.Monad.Class.MonadThrow hiding (handle)
import           Control.Monad.Class.MonadTime.SI
import           Control.Monad.Class.MonadTimer.SI
import           Control.Monad.Fix
import           Control.Tracer (Tracer, contramap, traceWith)
import           Data.Foldable (foldMap', traverse_)
import           Data.Function (on)
import           Data.Functor (void)
import           Data.Maybe (maybeToList)
import           Data.Proxy (Proxy (..))
import           Data.Typeable (Typeable)
import           GHC.Stack (CallStack, HasCallStack, callStack)

import           Data.Map (Map)
import qualified Data.Map as Map
import qualified Data.Set as Set

import           Data.Monoid.Synchronisation
import           Data.Wedge
import           Data.Word (Word32)

import           Network.Mux.Trace (MuxTrace, WithMuxBearer (..))
import           Network.Mux.Types (MuxMode)

import           Ouroboros.Network.ConnectionId
import           Ouroboros.Network.ConnectionManager.InformationChannel
                     (InformationChannel)
import qualified Ouroboros.Network.ConnectionManager.InformationChannel as InfoChannel
import           Ouroboros.Network.ConnectionManager.Types
import qualified Ouroboros.Network.ConnectionManager.Types as CM
import           Ouroboros.Network.InboundGovernor.Event
                     (NewConnectionInfo (..))
import           Ouroboros.Network.MuxMode
import           Ouroboros.Network.PeerSelection.PeerSharing (PeerSharing)
import           Ouroboros.Network.Server.RateLimiting
                     (AcceptedConnectionsLimit (..))
import           Ouroboros.Network.Snocket


-- | Arguments for a 'ConnectionManager' which are independent of 'MuxMode'.
--
data ConnectionManagerArguments handlerTrace socket peerAddr handle handleError versionNumber versionData m =
    ConnectionManagerArguments {
        -- | Connection manager tracer.
        --
        forall handlerTrace socket peerAddr handle handleError
       versionNumber versionData (m :: * -> *).
ConnectionManagerArguments
  handlerTrace
  socket
  peerAddr
  handle
  handleError
  versionNumber
  versionData
  m
-> Tracer m (ConnectionManagerTrace peerAddr handlerTrace)
cmTracer              :: Tracer m (ConnectionManagerTrace peerAddr handlerTrace),

        -- | Trace state transitions.
        --
        forall handlerTrace socket peerAddr handle handleError
       versionNumber versionData (m :: * -> *).
ConnectionManagerArguments
  handlerTrace
  socket
  peerAddr
  handle
  handleError
  versionNumber
  versionData
  m
-> Tracer
     m
     (TransitionTrace
        peerAddr
        (ConnectionState peerAddr handle handleError versionNumber m))
cmTrTracer            :: Tracer m (TransitionTrace peerAddr
                                            (ConnectionState peerAddr handle handleError versionNumber m)),

        -- | Mux trace.
        --
        forall handlerTrace socket peerAddr handle handleError
       versionNumber versionData (m :: * -> *).
ConnectionManagerArguments
  handlerTrace
  socket
  peerAddr
  handle
  handleError
  versionNumber
  versionData
  m
-> Tracer m (WithMuxBearer (ConnectionId peerAddr) MuxTrace)
cmMuxTracer           :: Tracer m (WithMuxBearer (ConnectionId peerAddr) MuxTrace),

        -- | @IPv4@ address of the connection manager.  If given, outbound
        -- connections to an @IPv4@ address will bound to it.  To use
        -- bidirectional @TCP@ connections, it must be the same as the server
        -- listening @IPv4@ address.
        --
        forall handlerTrace socket peerAddr handle handleError
       versionNumber versionData (m :: * -> *).
ConnectionManagerArguments
  handlerTrace
  socket
  peerAddr
  handle
  handleError
  versionNumber
  versionData
  m
-> Maybe peerAddr
cmIPv4Address         :: Maybe peerAddr,

        -- | @IPv6@ address of the connection manager.  If given, outbound
        -- connections to an @IPv6@ address will bound to it.  To use
        -- bidirectional @TCP@ connections, it must be the same as the server
        -- listening @IPv6@ address.
        --
        forall handlerTrace socket peerAddr handle handleError
       versionNumber versionData (m :: * -> *).
ConnectionManagerArguments
  handlerTrace
  socket
  peerAddr
  handle
  handleError
  versionNumber
  versionData
  m
-> Maybe peerAddr
cmIPv6Address         :: Maybe peerAddr,

        forall handlerTrace socket peerAddr handle handleError
       versionNumber versionData (m :: * -> *).
ConnectionManagerArguments
  handlerTrace
  socket
  peerAddr
  handle
  handleError
  versionNumber
  versionData
  m
-> peerAddr -> Maybe AddressType
cmAddressType         :: peerAddr -> Maybe AddressType,

        -- | Snocket for the 'socket' type.
        --
        forall handlerTrace socket peerAddr handle handleError
       versionNumber versionData (m :: * -> *).
ConnectionManagerArguments
  handlerTrace
  socket
  peerAddr
  handle
  handleError
  versionNumber
  versionData
  m
-> Snocket m socket peerAddr
cmSnocket             :: Snocket m socket peerAddr,

        -- | Make MuxBearer.
        --
        forall handlerTrace socket peerAddr handle handleError
       versionNumber versionData (m :: * -> *).
ConnectionManagerArguments
  handlerTrace
  socket
  peerAddr
  handle
  handleError
  versionNumber
  versionData
  m
-> MakeBearer m socket
cmMakeBearer          :: MakeBearer m socket,

        -- | Socket configuration.
        --
        forall handlerTrace socket peerAddr handle handleError
       versionNumber versionData (m :: * -> *).
ConnectionManagerArguments
  handlerTrace
  socket
  peerAddr
  handle
  handleError
  versionNumber
  versionData
  m
-> socket -> Maybe peerAddr -> m ()
cmConfigureSocket     :: socket -> Maybe peerAddr -> m (),

        -- | @TCP@ will held connections in @TIME_WAIT@ state for up to two MSL
        -- (maximum segment time).  On Linux this is set to '60' seconds on
        -- other system this might be up to four minutes.
        --
        -- This is configurable, so we can set different value in tests.
        --
        -- When this timeout expires a connection will transition from
        -- 'TerminatingState' to 'TerminatedState'.
        --
        forall handlerTrace socket peerAddr handle handleError
       versionNumber versionData (m :: * -> *).
ConnectionManagerArguments
  handlerTrace
  socket
  peerAddr
  handle
  handleError
  versionNumber
  versionData
  m
-> DiffTime
cmTimeWaitTimeout     :: DiffTime,

        -- | Inactivity timeout before the connection will be reset.  It is the
        -- timeout attached to the 'OutboundIdleState'.
        --
        forall handlerTrace socket peerAddr handle handleError
       versionNumber versionData (m :: * -> *).
ConnectionManagerArguments
  handlerTrace
  socket
  peerAddr
  handle
  handleError
  versionNumber
  versionData
  m
-> DiffTime
cmOutboundIdleTimeout :: DiffTime,

        -- | Given a version number and respective version data, get the
        -- 'DataFlow'.
        --
        forall handlerTrace socket peerAddr handle handleError
       versionNumber versionData (m :: * -> *).
ConnectionManagerArguments
  handlerTrace
  socket
  peerAddr
  handle
  handleError
  versionNumber
  versionData
  m
-> versionNumber -> versionData -> DataFlow
connectionDataFlow    :: versionNumber -> versionData -> DataFlow,

        -- | Prune policy
        --
        forall handlerTrace socket peerAddr handle handleError
       versionNumber versionData (m :: * -> *).
ConnectionManagerArguments
  handlerTrace
  socket
  peerAddr
  handle
  handleError
  versionNumber
  versionData
  m
-> PrunePolicy peerAddr (STM m)
cmPrunePolicy         :: PrunePolicy peerAddr (STM m),
        forall handlerTrace socket peerAddr handle handleError
       versionNumber versionData (m :: * -> *).
ConnectionManagerArguments
  handlerTrace
  socket
  peerAddr
  handle
  handleError
  versionNumber
  versionData
  m
-> AcceptedConnectionsLimit
cmConnectionsLimits   :: AcceptedConnectionsLimit,

        -- | How to extract PeerSharing information from versionData
        forall handlerTrace socket peerAddr handle handleError
       versionNumber versionData (m :: * -> *).
ConnectionManagerArguments
  handlerTrace
  socket
  peerAddr
  handle
  handleError
  versionNumber
  versionData
  m
-> versionData -> PeerSharing
cmGetPeerSharing      :: versionData -> PeerSharing
      }


-- | 'MutableConnState', which supplies a unique identifier.
--
-- TODO: We can get away without id, by tracking connections in
-- `TerminatingState` using a separate priority search queue.
--
data MutableConnState peerAddr handle handleError version m = MutableConnState {
    -- | A unique identifier
    --
    forall peerAddr handle handleError version (m :: * -> *).
MutableConnState peerAddr handle handleError version m -> Int
connStateId  :: !Int

  , -- | Mutable state
    --
    forall peerAddr handle handleError version (m :: * -> *).
MutableConnState peerAddr handle handleError version m
-> StrictTVar
     m (ConnectionState peerAddr handle handleError version m)
connVar      :: !(StrictTVar m (ConnectionState peerAddr handle handleError
                                                    version m))
  }


instance Eq (MutableConnState peerAddr handle handleError version m) where
    == :: MutableConnState peerAddr handle handleError version m
-> MutableConnState peerAddr handle handleError version m -> Bool
(==) =  forall a. Eq a => a -> a -> Bool
(==) forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` forall peerAddr handle handleError version (m :: * -> *).
MutableConnState peerAddr handle handleError version m -> Int
connStateId


-- | A supply of fresh id's.
--
-- We use a fresh ids for 'MutableConnState'.
--
newtype FreshIdSupply m = FreshIdSupply { forall (m :: * -> *). FreshIdSupply m -> STM m Int
getFreshId :: STM m Int }


-- | Create a 'FreshIdSupply' inside an 'STM' monad.
--
newFreshIdSupply :: forall m. MonadSTM m
                 => Proxy m -> STM m (FreshIdSupply m)
newFreshIdSupply :: forall (m :: * -> *).
MonadSTM m =>
Proxy m -> STM m (FreshIdSupply m)
newFreshIdSupply Proxy m
_ = do
    (StrictTVar m Int
v :: StrictTVar m Int) <- forall (m :: * -> *) a. MonadSTM m => a -> STM m (StrictTVar m a)
newTVar Int
0
    let getFreshId :: STM m Int
        getFreshId :: STM m Int
getFreshId = do
          Int
c <- forall (m :: * -> *) a. MonadSTM m => StrictTVar m a -> STM m a
readTVar StrictTVar m Int
v
          forall (m :: * -> *) a.
MonadSTM m =>
StrictTVar m a -> a -> STM m ()
writeTVar StrictTVar m Int
v (forall a. Enum a => a -> a
succ Int
c)
          forall (m :: * -> *) a. Monad m => a -> m a
return Int
c
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ FreshIdSupply { STM m Int
getFreshId :: STM m Int
getFreshId :: STM m Int
getFreshId }


newMutableConnState :: MonadSTM m
                    => FreshIdSupply m
                    -> ConnectionState peerAddr handle handleError
                                       version m
                    -> STM m (MutableConnState peerAddr handle handleError
                                               version m)
newMutableConnState :: forall (m :: * -> *) peerAddr handle handleError version.
MonadSTM m =>
FreshIdSupply m
-> ConnectionState peerAddr handle handleError version m
-> STM m (MutableConnState peerAddr handle handleError version m)
newMutableConnState FreshIdSupply m
freshIdSupply ConnectionState peerAddr handle handleError version m
connState = do
      Int
connStateId <- forall (m :: * -> *). FreshIdSupply m -> STM m Int
getFreshId FreshIdSupply m
freshIdSupply
      StrictTVar
  m (ConnectionState peerAddr handle handleError version m)
connVar <- forall (m :: * -> *) a. MonadSTM m => a -> STM m (StrictTVar m a)
newTVar ConnectionState peerAddr handle handleError version m
connState
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ MutableConnState { Int
connStateId :: Int
connStateId :: Int
connStateId, StrictTVar
  m (ConnectionState peerAddr handle handleError version m)
connVar :: StrictTVar
  m (ConnectionState peerAddr handle handleError version m)
connVar :: StrictTVar
  m (ConnectionState peerAddr handle handleError version m)
connVar }


-- | 'ConnectionManager' state: for each peer we keep a 'ConnectionState' in
-- a mutable variable, which reduces congestion on the 'TMVar' which keeps
-- 'ConnectionManagerState'.
--
-- It is important we can lookup by remote @peerAddr@; this way we can find if
-- the connection manager is already managing a connection towards that
-- @peerAddr@ and reuse the 'ConnectionState'.
--
type ConnectionManagerState peerAddr handle handleError version m
  = Map peerAddr (MutableConnState peerAddr handle handleError version m)

connectionManagerStateToCounters
  :: Map peerAddr (ConnectionState peerAddr handle handleError version m)
  -> ConnectionManagerCounters
connectionManagerStateToCounters :: forall peerAddr handle handleError version (m :: * -> *).
Map
  peerAddr (ConnectionState peerAddr handle handleError version m)
-> ConnectionManagerCounters
connectionManagerStateToCounters =
    forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap' forall peerAddr handle handleError version (m :: * -> *).
ConnectionState peerAddr handle handleError version m
-> ConnectionManagerCounters
connectionStateToCounters

-- | State of a connection.
--
data ConnectionState peerAddr handle handleError version m =
    -- | Each outbound connections starts in this state.
    ReservedOutboundState

    -- | Each inbound connection starts in this state, outbound connection
    -- reach this state once `connect` call returns.
    --
    -- note: the async handle is lazy, because it's passed with 'mfix'.
  | UnnegotiatedState   !Provenance
                        !(ConnectionId peerAddr)
                         (Async m ())

    -- | @OutboundState Unidirectional@ state.
  | OutboundUniState    !(ConnectionId peerAddr) !(Async m ()) !handle

    -- | Either @OutboundState Duplex@ or @OutboundState^\tau Duplex@.
  | OutboundDupState    !(ConnectionId peerAddr) !(Async m ()) !handle !TimeoutExpired

    -- | Before connection is reset it is put in 'OutboundIdleState' for the
    -- duration of 'cmOutboundIdleTimeout'.
    --
  | OutboundIdleState   !(ConnectionId peerAddr) !(Async m ()) !handle !DataFlow
  | InboundIdleState    !(ConnectionId peerAddr) !(Async m ()) !handle !DataFlow
  | InboundState        !(ConnectionId peerAddr) !(Async m ()) !handle !DataFlow
  | DuplexState         !(ConnectionId peerAddr) !(Async m ()) !handle
  | TerminatingState    !(ConnectionId peerAddr) !(Async m ()) !(Maybe handleError)
  | TerminatedState                              !(Maybe handleError)


-- | Return 'True' for states in which the connection was already closed.
--
connectionTerminated :: ConnectionState peerAddr handle handleError version m
                     -> Bool
connectionTerminated :: forall peerAddr handle handleError version (m :: * -> *).
ConnectionState peerAddr handle handleError version m -> Bool
connectionTerminated TerminatingState {} = Bool
True
connectionTerminated TerminatedState  {} = Bool
True
connectionTerminated ConnectionState peerAddr handle handleError version m
_                   = Bool
False


-- | Perform counting from an 'AbstractState'
connectionStateToCounters
    :: ConnectionState peerAddr handle handleError version m
    -> ConnectionManagerCounters
connectionStateToCounters :: forall peerAddr handle handleError version (m :: * -> *).
ConnectionState peerAddr handle handleError version m
-> ConnectionManagerCounters
connectionStateToCounters ConnectionState peerAddr handle handleError version m
state =
    case ConnectionState peerAddr handle handleError version m
state of
      ConnectionState peerAddr handle handleError version m
ReservedOutboundState                 -> forall a. Monoid a => a
mempty

      UnnegotiatedState Provenance
Inbound ConnectionId peerAddr
_ Async m ()
_         -> ConnectionManagerCounters
inboundConn

      UnnegotiatedState Provenance
Outbound ConnectionId peerAddr
_ Async m ()
_        -> ConnectionManagerCounters
outboundConn

      OutboundUniState ConnectionId peerAddr
_ Async m ()
_ handle
_                -> ConnectionManagerCounters
unidirectionalConn
                                            forall a. Semigroup a => a -> a -> a
<> ConnectionManagerCounters
outboundConn

      OutboundDupState  ConnectionId peerAddr
_ Async m ()
_ handle
_ TimeoutExpired
_             -> ConnectionManagerCounters
duplexConn
                                            forall a. Semigroup a => a -> a -> a
<> ConnectionManagerCounters
outboundConn

      OutboundIdleState ConnectionId peerAddr
_ Async m ()
_ handle
_ DataFlow
Unidirectional -> ConnectionManagerCounters
unidirectionalConn
                                             forall a. Semigroup a => a -> a -> a
<> ConnectionManagerCounters
outboundConn

      OutboundIdleState ConnectionId peerAddr
_ Async m ()
_ handle
_ DataFlow
Duplex         -> ConnectionManagerCounters
duplexConn
                                             forall a. Semigroup a => a -> a -> a
<> ConnectionManagerCounters
outboundConn

      InboundIdleState ConnectionId peerAddr
_ Async m ()
_ handle
_ DataFlow
Unidirectional -> ConnectionManagerCounters
unidirectionalConn
                                            forall a. Semigroup a => a -> a -> a
<> ConnectionManagerCounters
inboundConn

      InboundIdleState ConnectionId peerAddr
_ Async m ()
_ handle
_ DataFlow
Duplex         -> ConnectionManagerCounters
duplexConn
                                            forall a. Semigroup a => a -> a -> a
<> ConnectionManagerCounters
inboundConn

      InboundState ConnectionId peerAddr
_ Async m ()
_ handle
_ DataFlow
Unidirectional     -> ConnectionManagerCounters
unidirectionalConn
                                            forall a. Semigroup a => a -> a -> a
<> ConnectionManagerCounters
inboundConn

      InboundState ConnectionId peerAddr
_ Async m ()
_ handle
_ DataFlow
Duplex             -> ConnectionManagerCounters
duplexConn
                                            forall a. Semigroup a => a -> a -> a
<> ConnectionManagerCounters
inboundConn

      DuplexState ConnectionId peerAddr
_ Async m ()
_ handle
_                     -> ConnectionManagerCounters
fullDuplexConn
                                            forall a. Semigroup a => a -> a -> a
<> ConnectionManagerCounters
duplexConn
                                            forall a. Semigroup a => a -> a -> a
<> ConnectionManagerCounters
inboundConn
                                            forall a. Semigroup a => a -> a -> a
<> ConnectionManagerCounters
outboundConn

      TerminatingState ConnectionId peerAddr
_ Async m ()
_ Maybe handleError
_                -> forall a. Monoid a => a
mempty
      TerminatedState Maybe handleError
_                     -> forall a. Monoid a => a
mempty
  where
    fullDuplexConn :: ConnectionManagerCounters
fullDuplexConn     = Int -> Int -> Int -> Int -> Int -> ConnectionManagerCounters
ConnectionManagerCounters Int
1 Int
0 Int
0 Int
0 Int
0
    duplexConn :: ConnectionManagerCounters
duplexConn         = Int -> Int -> Int -> Int -> Int -> ConnectionManagerCounters
ConnectionManagerCounters Int
0 Int
1 Int
0 Int
0 Int
0
    unidirectionalConn :: ConnectionManagerCounters
unidirectionalConn = Int -> Int -> Int -> Int -> Int -> ConnectionManagerCounters
ConnectionManagerCounters Int
0 Int
0 Int
1 Int
0 Int
0
    inboundConn :: ConnectionManagerCounters
inboundConn        = Int -> Int -> Int -> Int -> Int -> ConnectionManagerCounters
ConnectionManagerCounters Int
0 Int
0 Int
0 Int
1 Int
0
    outboundConn :: ConnectionManagerCounters
outboundConn       = Int -> Int -> Int -> Int -> Int -> ConnectionManagerCounters
ConnectionManagerCounters Int
0 Int
0 Int
0 Int
0 Int
1


instance ( Show peerAddr
         , Show handleError
         , MonadAsync m
         )
      => Show (ConnectionState peerAddr handle handleError version m) where
    show :: ConnectionState peerAddr handle handleError version m -> String
show ConnectionState peerAddr handle handleError version m
ReservedOutboundState = String
"ReservedOutboundState"
    show (UnnegotiatedState Provenance
pr ConnectionId peerAddr
connId Async m ()
connThread) =
      forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String
"UnnegotiatedState "
             , forall a. Show a => a -> String
show Provenance
pr
             , String
" "
             , forall a. Show a => a -> String
show ConnectionId peerAddr
connId
             , String
" "
             , forall a. Show a => a -> String
show (forall (m :: * -> *) a. MonadAsync m => Async m a -> ThreadId m
asyncThreadId Async m ()
connThread)
             ]
    show (OutboundUniState ConnectionId peerAddr
connId Async m ()
connThread handle
_handle) =
      forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ String
"OutboundState Unidirectional "
             , forall a. Show a => a -> String
show ConnectionId peerAddr
connId
             , String
" "
             , forall a. Show a => a -> String
show (forall (m :: * -> *) a. MonadAsync m => Async m a -> ThreadId m
asyncThreadId Async m ()
connThread)
             ]
    show (OutboundDupState ConnectionId peerAddr
connId Async m ()
connThread handle
_handle TimeoutExpired
expired) =
      forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ String
"OutboundState "
             , forall a. Show a => a -> String
show ConnectionId peerAddr
connId
             , String
" "
             , forall a. Show a => a -> String
show (forall (m :: * -> *) a. MonadAsync m => Async m a -> ThreadId m
asyncThreadId Async m ()
connThread)
             , String
" "
             , forall a. Show a => a -> String
show TimeoutExpired
expired
             ]
    show (OutboundIdleState ConnectionId peerAddr
connId Async m ()
connThread handle
_handle DataFlow
df) =
      forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ String
"OutboundIdleState "
             , forall a. Show a => a -> String
show ConnectionId peerAddr
connId
             , String
" "
             , forall a. Show a => a -> String
show (forall (m :: * -> *) a. MonadAsync m => Async m a -> ThreadId m
asyncThreadId Async m ()
connThread)
             , String
" "
             , forall a. Show a => a -> String
show DataFlow
df
             ]
    show (InboundIdleState ConnectionId peerAddr
connId Async m ()
connThread handle
_handle DataFlow
df) =
      forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ String
"InboundIdleState "
             , forall a. Show a => a -> String
show ConnectionId peerAddr
connId
             , String
" "
             , forall a. Show a => a -> String
show (forall (m :: * -> *) a. MonadAsync m => Async m a -> ThreadId m
asyncThreadId Async m ()
connThread)
             , String
" "
             , forall a. Show a => a -> String
show DataFlow
df
             ]
    show (InboundState  ConnectionId peerAddr
connId Async m ()
connThread handle
_handle DataFlow
df) =
      forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ String
"InboundState "
             , forall a. Show a => a -> String
show ConnectionId peerAddr
connId
             , String
" "
             , forall a. Show a => a -> String
show (forall (m :: * -> *) a. MonadAsync m => Async m a -> ThreadId m
asyncThreadId Async m ()
connThread)
             , String
" "
             , forall a. Show a => a -> String
show DataFlow
df
             ]
    show (DuplexState   ConnectionId peerAddr
connId Async m ()
connThread handle
_handle) =
      forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ String
"DuplexState "
             , forall a. Show a => a -> String
show ConnectionId peerAddr
connId
             , String
" "
             , forall a. Show a => a -> String
show (forall (m :: * -> *) a. MonadAsync m => Async m a -> ThreadId m
asyncThreadId Async m ()
connThread)
             ]
    show (TerminatingState ConnectionId peerAddr
connId Async m ()
connThread Maybe handleError
handleError) =
      forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([ String
"TerminatingState "
              , forall a. Show a => a -> String
show ConnectionId peerAddr
connId
              , String
" "
              , forall a. Show a => a -> String
show (forall (m :: * -> *) a. MonadAsync m => Async m a -> ThreadId m
asyncThreadId Async m ()
connThread)
              ]
              forall a. [a] -> [a] -> [a]
++ forall a. Maybe a -> [a]
maybeToList ((Char
' ' forall a. a -> [a] -> [a]
:) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe handleError
handleError))
    show (TerminatedState Maybe handleError
handleError) =
      forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([String
"TerminatedState"]
              forall a. [a] -> [a] -> [a]
++ forall a. Maybe a -> [a]
maybeToList ((Char
' ' forall a. a -> [a] -> [a]
:) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe handleError
handleError))


getConnThread :: ConnectionState peerAddr handle handleError version m
              -> Maybe (Async m ())
getConnThread :: forall peerAddr handle handleError version (m :: * -> *).
ConnectionState peerAddr handle handleError version m
-> Maybe (Async m ())
getConnThread ConnectionState peerAddr handle handleError version m
ReservedOutboundState                                     = forall a. Maybe a
Nothing
getConnThread (UnnegotiatedState Provenance
_pr   ConnectionId peerAddr
_connId Async m ()
connThread)              = forall a. a -> Maybe a
Just Async m ()
connThread
getConnThread (OutboundUniState        ConnectionId peerAddr
_connId Async m ()
connThread handle
_handle )     = forall a. a -> Maybe a
Just Async m ()
connThread
getConnThread (OutboundDupState        ConnectionId peerAddr
_connId Async m ()
connThread handle
_handle TimeoutExpired
_te)  = forall a. a -> Maybe a
Just Async m ()
connThread
getConnThread (OutboundIdleState       ConnectionId peerAddr
_connId Async m ()
connThread handle
_handle DataFlow
_df)  = forall a. a -> Maybe a
Just Async m ()
connThread
getConnThread (InboundIdleState        ConnectionId peerAddr
_connId Async m ()
connThread handle
_handle DataFlow
_df)  = forall a. a -> Maybe a
Just Async m ()
connThread
getConnThread (InboundState            ConnectionId peerAddr
_connId Async m ()
connThread handle
_handle DataFlow
_df)  = forall a. a -> Maybe a
Just Async m ()
connThread
getConnThread (DuplexState             ConnectionId peerAddr
_connId Async m ()
connThread handle
_handle)      = forall a. a -> Maybe a
Just Async m ()
connThread
getConnThread (TerminatingState        ConnectionId peerAddr
_connId Async m ()
connThread Maybe handleError
_handleError) = forall a. a -> Maybe a
Just Async m ()
connThread
getConnThread TerminatedState {}                                        = forall a. Maybe a
Nothing

-- | Get 'DataFlow' for a connection.  It returns 'Nowhere' if that connection
-- is either not yet created or in terminating state, 'There' for  unnegotiated
-- connections and 'Here' if the data flow is known.
--
getConnType :: ConnectionState peerAddr handle handleError version m
            -> Maybe ConnectionType
getConnType :: forall peerAddr handle handleError version (m :: * -> *).
ConnectionState peerAddr handle handleError version m
-> Maybe ConnectionType
getConnType ConnectionState peerAddr handle handleError version m
ReservedOutboundState                                    = forall a. Maybe a
Nothing
getConnType (UnnegotiatedState Provenance
pr  ConnectionId peerAddr
_connId Async m ()
_connThread)              = forall a. a -> Maybe a
Just (Provenance -> ConnectionType
UnnegotiatedConn Provenance
pr)
getConnType (OutboundUniState      ConnectionId peerAddr
_connId Async m ()
_connThread handle
_handle)      = forall a. a -> Maybe a
Just (Provenance -> DataFlow -> ConnectionType
NegotiatedConn Provenance
Outbound DataFlow
Unidirectional)
getConnType (OutboundDupState      ConnectionId peerAddr
_connId Async m ()
_connThread handle
_handle TimeoutExpired
_te)  = forall a. a -> Maybe a
Just (Provenance -> DataFlow -> ConnectionType
NegotiatedConn Provenance
Outbound DataFlow
Duplex)
getConnType (OutboundIdleState     ConnectionId peerAddr
_connId Async m ()
_connThread handle
_handle DataFlow
df)   = forall a. a -> Maybe a
Just (DataFlow -> ConnectionType
OutboundIdleConn DataFlow
df)
getConnType (InboundIdleState      ConnectionId peerAddr
_connId Async m ()
_connThread handle
_handle DataFlow
df)   = forall a. a -> Maybe a
Just (DataFlow -> ConnectionType
InboundIdleConn DataFlow
df)
getConnType (InboundState          ConnectionId peerAddr
_connId Async m ()
_connThread handle
_handle DataFlow
df)   = forall a. a -> Maybe a
Just (Provenance -> DataFlow -> ConnectionType
NegotiatedConn Provenance
Inbound DataFlow
df)
getConnType (DuplexState           ConnectionId peerAddr
_connId Async m ()
_connThread handle
_handle)      = forall a. a -> Maybe a
Just ConnectionType
DuplexConn
getConnType (TerminatingState      ConnectionId peerAddr
_connId Async m ()
_connThread Maybe handleError
_handleError) = forall a. Maybe a
Nothing
getConnType TerminatedState {}                                       = forall a. Maybe a
Nothing


-- | Return 'True' if a connection is inbound.  This must agree with
-- 'connectionStateToCounters'.  Both are used for pruning.
--
isInboundConn :: ConnectionState peerAddr handle handleError version m -> Bool
isInboundConn :: forall peerAddr handle handleError version (m :: * -> *).
ConnectionState peerAddr handle handleError version m -> Bool
isInboundConn ConnectionState peerAddr handle handleError version m
ReservedOutboundState                      = Bool
False
isInboundConn (UnnegotiatedState Provenance
pr ConnectionId peerAddr
_connId Async m ()
_connThread) = Provenance
pr forall a. Eq a => a -> a -> Bool
== Provenance
Inbound
isInboundConn OutboundUniState {}                        = Bool
False
isInboundConn OutboundDupState {}                        = Bool
False
isInboundConn OutboundIdleState {}                       = Bool
False
isInboundConn InboundIdleState {}                        = Bool
True
isInboundConn InboundState {}                            = Bool
True
isInboundConn DuplexState {}                             = Bool
True
isInboundConn TerminatingState {}                        = Bool
False
isInboundConn TerminatedState {}                         = Bool
False


abstractState :: MaybeUnknown (ConnectionState muxMode peerAddr m a b) -> AbstractState
abstractState :: forall muxMode peerAddr m a (b :: * -> *).
MaybeUnknown (ConnectionState muxMode peerAddr m a b)
-> AbstractState
abstractState = \case
    MaybeUnknown (ConnectionState muxMode peerAddr m a b)
Unknown  -> AbstractState
UnknownConnectionSt
    Race ConnectionState muxMode peerAddr m a b
s'  -> forall muxMode peerAddr m a (b :: * -> *).
ConnectionState muxMode peerAddr m a b -> AbstractState
go ConnectionState muxMode peerAddr m a b
s'
    Known ConnectionState muxMode peerAddr m a b
s' -> forall muxMode peerAddr m a (b :: * -> *).
ConnectionState muxMode peerAddr m a b -> AbstractState
go ConnectionState muxMode peerAddr m a b
s'
  where
    go :: ConnectionState muxMode peerAddr m a b -> AbstractState
    go :: forall muxMode peerAddr m a (b :: * -> *).
ConnectionState muxMode peerAddr m a b -> AbstractState
go ReservedOutboundState {}       = AbstractState
ReservedOutboundSt
    go (UnnegotiatedState Provenance
pr ConnectionId muxMode
_ Async b ()
_)     = Provenance -> AbstractState
UnnegotiatedSt Provenance
pr
    go (OutboundUniState    ConnectionId muxMode
_ Async b ()
_ peerAddr
_)    = AbstractState
OutboundUniSt
    go (OutboundDupState    ConnectionId muxMode
_ Async b ()
_ peerAddr
_ TimeoutExpired
te) = TimeoutExpired -> AbstractState
OutboundDupSt TimeoutExpired
te
    go (OutboundIdleState ConnectionId muxMode
_ Async b ()
_ peerAddr
_ DataFlow
df)   = DataFlow -> AbstractState
OutboundIdleSt DataFlow
df
    go (InboundIdleState ConnectionId muxMode
_ Async b ()
_ peerAddr
_ DataFlow
df)    = DataFlow -> AbstractState
InboundIdleSt DataFlow
df
    go (InboundState     ConnectionId muxMode
_ Async b ()
_ peerAddr
_ DataFlow
df)    = DataFlow -> AbstractState
InboundSt DataFlow
df
    go DuplexState {}                 = AbstractState
DuplexSt
    go TerminatingState {}            = AbstractState
TerminatingSt
    go TerminatedState {}             = AbstractState
TerminatedSt


-- | The default value for 'cmTimeWaitTimeout'.
--
defaultTimeWaitTimeout :: DiffTime
defaultTimeWaitTimeout :: DiffTime
defaultTimeWaitTimeout = DiffTime
60

-- | Inactivity timeout.  It configures how long to wait since the local side
-- demoted remote peer to /cold/, before closing the connection.
--
defaultProtocolIdleTimeout :: DiffTime
defaultProtocolIdleTimeout :: DiffTime
defaultProtocolIdleTimeout = DiffTime
5

defaultResetTimeout :: DiffTime
defaultResetTimeout :: DiffTime
defaultResetTimeout = DiffTime
5


newtype PruneAction m = PruneAction { forall (m :: * -> *). PruneAction m -> m ()
runPruneAction :: m () }

-- | Instruction used internally in @unregisterOutboundConnectionImpl@, e.g. in
-- the implementation of one of the two  @DemotedToCold^{dataFlow}_{Local}@
-- transitions.
--
data DemoteToColdLocal peerAddr handlerTrace handle handleError version m
    -- | Any @DemotedToCold@ transition which terminates the connection:
    -- @
    --   DemotedToCold^{Duplex}_{Local} : * -> TerminatingState
    -- @
    -- from the spec.
    --
    = DemotedToColdLocal      (ConnectionId peerAddr)
                              (Async m ())
                              (StrictTVar m (ConnectionState
                                              peerAddr handle
                                              handleError version m))
                             !(Transition (ConnectionState
                                            peerAddr handle
                                            handleError version m))

    -- | Any @DemoteToCold@ transition which does not terminate the connection, i.e.
    -- @
    --   DemotedToCold^{Duplex}_{Local} : OutboundState^\tau Duplex
    --                                  → InboundIdleState^\tau
    -- @
    -- or the case where the connection is already in 'TerminatingState' or
    -- 'TerminatedState'.
    --
    | DemoteToColdLocalNoop !(Maybe (Transition (ConnectionState
                                                  peerAddr handle
                                                  handleError version m)))
                            !AbstractState

    -- | Duplex connection was demoted, prune connections.
    --
    | PruneConnections       (PruneAction m)
                             -- ^ prune action

                            !(Either
                               (ConnectionState
                                 peerAddr handle
                                 handleError version m)
                               (Transition (ConnectionState
                                             peerAddr handle
                                             handleError version m))
                             )

                             -- ^ Left case is for when the connection which
                             -- triggered pruning is pruned in this case we do
                             -- not want to trace a new transition.
                             --
                             -- Right case is for when the connection which
                             -- triggered pruning isn't pruned. In this case
                             -- we do want to trace a new transition.


    -- | Demote error.
    | DemoteToColdLocalError  (ConnectionManagerTrace peerAddr handlerTrace)
                             !AbstractState


-- | Entry point for using the connection manager.  This is a classic @with@ style
-- combinator, which cleans resources on exit of the callback (whether cleanly
-- or through an exception).
--
-- Including a connection (either inbound or outbound) is an idempotent
-- operation on connection manager state.  The connection manager will always
-- return the handle that was first to be included in its state.
--
-- Once an inbound connection is passed to the 'ConnectionManager', the manager
-- is responsible for the resource.
--
withConnectionManager
    :: forall (muxMode :: MuxMode) peerAddr socket handlerTrace handle handleError version versionData m a.
       ( Alternative (STM m)
       , MonadLabelledSTM   m
       , MonadTraceSTM      m
       -- 'MonadFork' is only to get access to 'throwTo'
       , MonadFork          m
       , MonadAsync         m
       , MonadDelay         m
       , MonadEvaluate      m
       , MonadFix           m
       , MonadMask          m
       , MonadThrow    (STM m)
       , MonadTimer         m

       , Ord      peerAddr
       , Show     peerAddr
       , Typeable peerAddr
       )
    => ConnectionManagerArguments handlerTrace socket peerAddr handle handleError version versionData m
    -> ConnectionHandler  muxMode handlerTrace socket peerAddr handle handleError (version, versionData) m
    -- ^ Callback which runs in a thread dedicated for a given connection.
    -> (handleError -> HandleErrorType)
    -- ^ classify 'handleError's
    -> InResponderMode muxMode (InformationChannel (NewConnectionInfo peerAddr handle) m)
    -- ^ On outbound duplex connections we need to notify the server about
    -- a new connection.
    -> InResponderMode muxMode (Maybe (InformationChannel (peerAddr, PeerSharing) m))
    -- ^ On inbound duplex connections we need to notify the outbound governor about
    -- a new connection.
    -> (ConnectionManager muxMode socket peerAddr handle handleError m -> m a)
    -- ^ Continuation which receives the 'ConnectionManager'.  It must not leak
    -- outside of scope of this callback.  Once it returns all resources
    -- will be closed.
    -> m a
withConnectionManager :: forall (muxMode :: MuxMode) peerAddr socket handlerTrace handle
       handleError version versionData (m :: * -> *) a.
(Alternative (STM m), MonadLabelledSTM m, MonadTraceSTM m,
 MonadFork m, MonadAsync m, MonadDelay m, MonadEvaluate m,
 MonadFix m, MonadMask m, MonadThrow (STM m), MonadTimer m,
 Ord peerAddr, Show peerAddr, Typeable peerAddr) =>
ConnectionManagerArguments
  handlerTrace
  socket
  peerAddr
  handle
  handleError
  version
  versionData
  m
-> ConnectionHandler
     muxMode
     handlerTrace
     socket
     peerAddr
     handle
     handleError
     (version, versionData)
     m
-> (handleError -> HandleErrorType)
-> InResponderMode
     muxMode (InformationChannel (NewConnectionInfo peerAddr handle) m)
-> InResponderMode
     muxMode (Maybe (InformationChannel (peerAddr, PeerSharing) m))
-> (ConnectionManager muxMode socket peerAddr handle handleError m
    -> m a)
-> m a
withConnectionManager ConnectionManagerArguments {
                          cmTracer :: forall handlerTrace socket peerAddr handle handleError
       versionNumber versionData (m :: * -> *).
ConnectionManagerArguments
  handlerTrace
  socket
  peerAddr
  handle
  handleError
  versionNumber
  versionData
  m
-> Tracer m (ConnectionManagerTrace peerAddr handlerTrace)
cmTracer    = Tracer m (ConnectionManagerTrace peerAddr handlerTrace)
tracer,
                          cmTrTracer :: forall handlerTrace socket peerAddr handle handleError
       versionNumber versionData (m :: * -> *).
ConnectionManagerArguments
  handlerTrace
  socket
  peerAddr
  handle
  handleError
  versionNumber
  versionData
  m
-> Tracer
     m
     (TransitionTrace
        peerAddr
        (ConnectionState peerAddr handle handleError versionNumber m))
cmTrTracer  = Tracer
  m
  (TransitionTrace
     peerAddr (ConnectionState peerAddr handle handleError version m))
trTracer,
                          cmMuxTracer :: forall handlerTrace socket peerAddr handle handleError
       versionNumber versionData (m :: * -> *).
ConnectionManagerArguments
  handlerTrace
  socket
  peerAddr
  handle
  handleError
  versionNumber
  versionData
  m
-> Tracer m (WithMuxBearer (ConnectionId peerAddr) MuxTrace)
cmMuxTracer = Tracer m (WithMuxBearer (ConnectionId peerAddr) MuxTrace)
muxTracer,
                          Maybe peerAddr
cmIPv4Address :: Maybe peerAddr
cmIPv4Address :: forall handlerTrace socket peerAddr handle handleError
       versionNumber versionData (m :: * -> *).
ConnectionManagerArguments
  handlerTrace
  socket
  peerAddr
  handle
  handleError
  versionNumber
  versionData
  m
-> Maybe peerAddr
cmIPv4Address,
                          Maybe peerAddr
cmIPv6Address :: Maybe peerAddr
cmIPv6Address :: forall handlerTrace socket peerAddr handle handleError
       versionNumber versionData (m :: * -> *).
ConnectionManagerArguments
  handlerTrace
  socket
  peerAddr
  handle
  handleError
  versionNumber
  versionData
  m
-> Maybe peerAddr
cmIPv6Address,
                          peerAddr -> Maybe AddressType
cmAddressType :: peerAddr -> Maybe AddressType
cmAddressType :: forall handlerTrace socket peerAddr handle handleError
       versionNumber versionData (m :: * -> *).
ConnectionManagerArguments
  handlerTrace
  socket
  peerAddr
  handle
  handleError
  versionNumber
  versionData
  m
-> peerAddr -> Maybe AddressType
cmAddressType,
                          Snocket m socket peerAddr
cmSnocket :: Snocket m socket peerAddr
cmSnocket :: forall handlerTrace socket peerAddr handle handleError
       versionNumber versionData (m :: * -> *).
ConnectionManagerArguments
  handlerTrace
  socket
  peerAddr
  handle
  handleError
  versionNumber
  versionData
  m
-> Snocket m socket peerAddr
cmSnocket,
                          MakeBearer m socket
cmMakeBearer :: MakeBearer m socket
cmMakeBearer :: forall handlerTrace socket peerAddr handle handleError
       versionNumber versionData (m :: * -> *).
ConnectionManagerArguments
  handlerTrace
  socket
  peerAddr
  handle
  handleError
  versionNumber
  versionData
  m
-> MakeBearer m socket
cmMakeBearer,
                          socket -> Maybe peerAddr -> m ()
cmConfigureSocket :: socket -> Maybe peerAddr -> m ()
cmConfigureSocket :: forall handlerTrace socket peerAddr handle handleError
       versionNumber versionData (m :: * -> *).
ConnectionManagerArguments
  handlerTrace
  socket
  peerAddr
  handle
  handleError
  versionNumber
  versionData
  m
-> socket -> Maybe peerAddr -> m ()
cmConfigureSocket,
                          DiffTime
cmTimeWaitTimeout :: DiffTime
cmTimeWaitTimeout :: forall handlerTrace socket peerAddr handle handleError
       versionNumber versionData (m :: * -> *).
ConnectionManagerArguments
  handlerTrace
  socket
  peerAddr
  handle
  handleError
  versionNumber
  versionData
  m
-> DiffTime
cmTimeWaitTimeout,
                          DiffTime
cmOutboundIdleTimeout :: DiffTime
cmOutboundIdleTimeout :: forall handlerTrace socket peerAddr handle handleError
       versionNumber versionData (m :: * -> *).
ConnectionManagerArguments
  handlerTrace
  socket
  peerAddr
  handle
  handleError
  versionNumber
  versionData
  m
-> DiffTime
cmOutboundIdleTimeout,
                          version -> versionData -> DataFlow
connectionDataFlow :: version -> versionData -> DataFlow
connectionDataFlow :: forall handlerTrace socket peerAddr handle handleError
       versionNumber versionData (m :: * -> *).
ConnectionManagerArguments
  handlerTrace
  socket
  peerAddr
  handle
  handleError
  versionNumber
  versionData
  m
-> versionNumber -> versionData -> DataFlow
connectionDataFlow,
                          PrunePolicy peerAddr (STM m)
cmPrunePolicy :: PrunePolicy peerAddr (STM m)
cmPrunePolicy :: forall handlerTrace socket peerAddr handle handleError
       versionNumber versionData (m :: * -> *).
ConnectionManagerArguments
  handlerTrace
  socket
  peerAddr
  handle
  handleError
  versionNumber
  versionData
  m
-> PrunePolicy peerAddr (STM m)
cmPrunePolicy,
                          AcceptedConnectionsLimit
cmConnectionsLimits :: AcceptedConnectionsLimit
cmConnectionsLimits :: forall handlerTrace socket peerAddr handle handleError
       versionNumber versionData (m :: * -> *).
ConnectionManagerArguments
  handlerTrace
  socket
  peerAddr
  handle
  handleError
  versionNumber
  versionData
  m
-> AcceptedConnectionsLimit
cmConnectionsLimits,
                          versionData -> PeerSharing
cmGetPeerSharing :: versionData -> PeerSharing
cmGetPeerSharing :: forall handlerTrace socket peerAddr handle handleError
       versionNumber versionData (m :: * -> *).
ConnectionManagerArguments
  handlerTrace
  socket
  peerAddr
  handle
  handleError
  versionNumber
  versionData
  m
-> versionData -> PeerSharing
cmGetPeerSharing
                        }
                      ConnectionHandler {
                          WithMuxTuple
  muxMode
  (ConnectionHandlerFn
     handlerTrace
     socket
     peerAddr
     handle
     handleError
     (version, versionData)
     m)
connectionHandler :: forall (muxMode :: MuxMode) 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, versionData)
     m)
connectionHandler
                        }
                      handleError -> HandleErrorType
classifyHandleError
                      InResponderMode
  muxMode (InformationChannel (NewConnectionInfo peerAddr handle) m)
inboundGovernorInfoChannel
                      InResponderMode
  muxMode (Maybe (InformationChannel (peerAddr, PeerSharing) m))
outboundGovernorInfoChannel
                      ConnectionManager muxMode socket peerAddr handle handleError m
-> m a
k = do
    ((FreshIdSupply m
freshIdSupply, StrictTMVar
  m (ConnectionManagerState peerAddr handle handleError version m)
stateVar)
       ::  ( FreshIdSupply m
           , StrictTMVar m (ConnectionManagerState peerAddr handle handleError
                                                   version m)
           ))
      <- forall (m :: * -> *) a.
(MonadSTM m, ?callStack::CallStack) =>
STM m a -> m a
atomically forall a b. (a -> b) -> a -> b
$  do
          StrictTMVar
  m (ConnectionManagerState peerAddr handle handleError version m)
v  <- forall (m :: * -> *) a. MonadSTM m => a -> STM m (StrictTMVar m a)
newTMVar forall k a. Map k a
Map.empty
          forall (m :: * -> *) a.
MonadLabelledSTM m =>
StrictTMVar m a -> String -> STM m ()
labelTMVar StrictTMVar
  m (ConnectionManagerState peerAddr handle handleError version m)
v String
"cm-state"
          forall (m :: * -> *) (proxy :: (* -> *) -> *) a.
MonadTraceSTM m =>
proxy m
-> StrictTMVar m a
-> (Maybe (Maybe a) -> Maybe a -> InspectMonad m TraceValue)
-> STM m ()
traceTMVar (forall {k} (t :: k). Proxy t
Proxy :: Proxy m) StrictTMVar
  m (ConnectionManagerState peerAddr handle handleError version m)
v
                   forall a b. (a -> b) -> a -> b
$ \Maybe
  (Maybe
     (ConnectionManagerState peerAddr handle handleError version m))
old Maybe
  (ConnectionManagerState peerAddr handle handleError version m)
new ->
                     case (Maybe
  (Maybe
     (ConnectionManagerState peerAddr handle handleError version m))
old, Maybe
  (ConnectionManagerState peerAddr handle handleError version m)
new) of
                       (Maybe
  (Maybe
     (ConnectionManagerState peerAddr handle handleError version m))
Nothing, Maybe
  (ConnectionManagerState peerAddr handle handleError version m)
_)             -> forall (f :: * -> *) a. Applicative f => a -> f a
pure TraceValue
DontTrace
                       -- taken
                       (Just (Just ConnectionManagerState peerAddr handle handleError version m
_), Maybe
  (ConnectionManagerState peerAddr handle handleError version m)
Nothing) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> TraceValue
TraceString String
"cm-state: taken")
                       -- released
                       (Just Maybe
  (ConnectionManagerState peerAddr handle handleError version m)
Nothing,  Just ConnectionManagerState peerAddr handle handleError version m
_)  -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> TraceValue
TraceString String
"cm-state: released")
                       (Maybe
  (Maybe
     (ConnectionManagerState peerAddr handle handleError version m))
_, Maybe
  (ConnectionManagerState peerAddr handle handleError version m)
_)                   -> forall (f :: * -> *) a. Applicative f => a -> f a
pure TraceValue
DontTrace

          FreshIdSupply m
freshIdSupply <- forall (m :: * -> *).
MonadSTM m =>
Proxy m -> STM m (FreshIdSupply m)
newFreshIdSupply (forall {k} (t :: k). Proxy t
Proxy :: Proxy m)
          forall (m :: * -> *) a. Monad m => a -> m a
return (FreshIdSupply m
freshIdSupply, StrictTMVar
  m (ConnectionManagerState peerAddr handle handleError version m)
v)

    let readState
          :: m (Map peerAddr AbstractState)
        readState :: m (Map peerAddr AbstractState)
readState =
          forall (m :: * -> *) a.
(MonadSTM m, ?callStack::CallStack) =>
STM m a -> m a
atomically forall a b. (a -> b) -> a -> b
$ do
              ConnectionManagerState peerAddr handle handleError version m
state <- forall (m :: * -> *) a. MonadSTM m => StrictTMVar m a -> STM m a
readTMVar StrictTMVar
  m (ConnectionManagerState peerAddr handle handleError version m)
stateVar
              forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ( forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall muxMode peerAddr m a (b :: * -> *).
MaybeUnknown (ConnectionState muxMode peerAddr m a b)
-> AbstractState
abstractState forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall state. state -> MaybeUnknown state
Known)
                       forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. MonadSTM m => StrictTVar m a -> STM m a
readTVar
                       forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall peerAddr handle handleError version (m :: * -> *).
MutableConnState peerAddr handle handleError version m
-> StrictTVar
     m (ConnectionState peerAddr handle handleError version m)
connVar
                       )
                       ConnectionManagerState peerAddr handle handleError version m
state

        connectionManager :: ConnectionManager muxMode socket peerAddr
                                               handle handleError m
        connectionManager :: ConnectionManager muxMode socket peerAddr handle handleError m
connectionManager =
          case WithMuxTuple
  muxMode
  (ConnectionHandlerFn
     handlerTrace
     socket
     peerAddr
     handle
     handleError
     (version, versionData)
     m)
connectionHandler of
            WithInitiatorMode ConnectionHandlerFn
  handlerTrace
  socket
  peerAddr
  handle
  handleError
  (version, versionData)
  m
outboundHandler ->
              ConnectionManager {
                getConnectionManager :: WithMuxMode
  'InitiatorMode
  (OutboundConnectionManager
     'InitiatorMode socket peerAddr handle handleError m)
  (InboundConnectionManager
     'InitiatorMode socket peerAddr handle handleError m)
getConnectionManager =
                  forall a b. a -> WithMuxMode 'InitiatorMode a b
WithInitiatorMode
                    OutboundConnectionManager {
                        ocmRequestConnection :: RequestOutboundConnection peerAddr handle handleError m
ocmRequestConnection =
                          (?callStack::CallStack) =>
FreshIdSupply m
-> StrictTMVar
     m (ConnectionManagerState peerAddr handle handleError version m)
-> ConnectionHandlerFn
     handlerTrace
     socket
     peerAddr
     handle
     handleError
     (version, versionData)
     m
-> RequestOutboundConnection peerAddr handle handleError m
requestOutboundConnectionImpl FreshIdSupply m
freshIdSupply StrictTMVar
  m (ConnectionManagerState peerAddr handle handleError version m)
stateVar
                                                        ConnectionHandlerFn
  handlerTrace
  socket
  peerAddr
  handle
  handleError
  (version, versionData)
  m
outboundHandler,
                        ocmUnregisterConnection :: peerAddr -> m (OperationResult AbstractState)
ocmUnregisterConnection =
                          StrictTMVar
  m (ConnectionManagerState peerAddr handle handleError version m)
-> peerAddr -> m (OperationResult AbstractState)
unregisterOutboundConnectionImpl StrictTMVar
  m (ConnectionManagerState peerAddr handle handleError version m)
stateVar
                      },
                m (Map peerAddr AbstractState)
readState :: m (Map peerAddr AbstractState)
readState :: m (Map peerAddr AbstractState)
readState
              }

            WithResponderMode ConnectionHandlerFn
  handlerTrace
  socket
  peerAddr
  handle
  handleError
  (version, versionData)
  m
inboundHandler ->
              ConnectionManager {
                getConnectionManager :: WithMuxMode
  'ResponderMode
  (OutboundConnectionManager
     'ResponderMode socket peerAddr handle handleError m)
  (InboundConnectionManager
     'ResponderMode socket peerAddr handle handleError m)
getConnectionManager =
                  forall b a. b -> WithMuxMode 'ResponderMode a b
WithResponderMode
                    InboundConnectionManager {
                        icmIncludeConnection :: IncludeInboundConnection socket peerAddr handle handleError m
icmIncludeConnection =
                          (?callStack::CallStack) =>
FreshIdSupply m
-> StrictTMVar
     m (ConnectionManagerState peerAddr handle handleError version m)
-> ConnectionHandlerFn
     handlerTrace
     socket
     peerAddr
     handle
     handleError
     (version, versionData)
     m
-> IncludeInboundConnection socket peerAddr handle handleError m
includeInboundConnectionImpl FreshIdSupply m
freshIdSupply StrictTMVar
  m (ConnectionManagerState peerAddr handle handleError version m)
stateVar
                                                       ConnectionHandlerFn
  handlerTrace
  socket
  peerAddr
  handle
  handleError
  (version, versionData)
  m
inboundHandler,
                        icmUnregisterConnection :: peerAddr -> m (OperationResult DemotedToColdRemoteTr)
icmUnregisterConnection =
                          StrictTMVar
  m (ConnectionManagerState peerAddr handle handleError version m)
-> peerAddr -> m (OperationResult DemotedToColdRemoteTr)
unregisterInboundConnectionImpl StrictTMVar
  m (ConnectionManagerState peerAddr handle handleError version m)
stateVar,
                        icmPromotedToWarmRemote :: peerAddr -> m (OperationResult AbstractState)
icmPromotedToWarmRemote =
                          StrictTMVar
  m (ConnectionManagerState peerAddr handle handleError version m)
-> peerAddr -> m (OperationResult AbstractState)
promotedToWarmRemoteImpl StrictTMVar
  m (ConnectionManagerState peerAddr handle handleError version m)
stateVar,
                        icmDemotedToColdRemote :: peerAddr -> m (OperationResult AbstractState)
icmDemotedToColdRemote =
                          StrictTMVar
  m (ConnectionManagerState peerAddr handle handleError version m)
-> peerAddr -> m (OperationResult AbstractState)
demotedToColdRemoteImpl StrictTMVar
  m (ConnectionManagerState peerAddr handle handleError version m)
stateVar,
                        icmNumberOfConnections :: STM m Int
icmNumberOfConnections =
                          forall (m :: * -> *) a. MonadSTM m => StrictTMVar m a -> STM m a
readTMVar StrictTMVar
  m (ConnectionManagerState peerAddr handle handleError version m)
stateVar forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ConnectionManagerState peerAddr handle handleError version m
-> STM m Int
countIncomingConnections
                      },
                m (Map peerAddr AbstractState)
readState :: m (Map peerAddr AbstractState)
readState :: m (Map peerAddr AbstractState)
readState
              }

            WithInitiatorResponderMode ConnectionHandlerFn
  handlerTrace
  socket
  peerAddr
  handle
  handleError
  (version, versionData)
  m
outboundHandler ConnectionHandlerFn
  handlerTrace
  socket
  peerAddr
  handle
  handleError
  (version, versionData)
  m
inboundHandler ->
              ConnectionManager {
                getConnectionManager :: WithMuxMode
  'InitiatorResponderMode
  (OutboundConnectionManager
     'InitiatorResponderMode socket peerAddr handle handleError m)
  (InboundConnectionManager
     'InitiatorResponderMode socket peerAddr handle handleError m)
getConnectionManager =
                  forall a b. a -> b -> WithMuxMode 'InitiatorResponderMode a b
WithInitiatorResponderMode
                    OutboundConnectionManager {
                        ocmRequestConnection :: RequestOutboundConnection peerAddr handle handleError m
ocmRequestConnection =
                          (?callStack::CallStack) =>
FreshIdSupply m
-> StrictTMVar
     m (ConnectionManagerState peerAddr handle handleError version m)
-> ConnectionHandlerFn
     handlerTrace
     socket
     peerAddr
     handle
     handleError
     (version, versionData)
     m
-> RequestOutboundConnection peerAddr handle handleError m
requestOutboundConnectionImpl FreshIdSupply m
freshIdSupply StrictTMVar
  m (ConnectionManagerState peerAddr handle handleError version m)
stateVar
                                                        ConnectionHandlerFn
  handlerTrace
  socket
  peerAddr
  handle
  handleError
  (version, versionData)
  m
outboundHandler,
                        ocmUnregisterConnection :: peerAddr -> m (OperationResult AbstractState)
ocmUnregisterConnection =
                          StrictTMVar
  m (ConnectionManagerState peerAddr handle handleError version m)
-> peerAddr -> m (OperationResult AbstractState)
unregisterOutboundConnectionImpl StrictTMVar
  m (ConnectionManagerState peerAddr handle handleError version m)
stateVar
                      }
                    InboundConnectionManager {
                        icmIncludeConnection :: IncludeInboundConnection socket peerAddr handle handleError m
icmIncludeConnection =
                          (?callStack::CallStack) =>
FreshIdSupply m
-> StrictTMVar
     m (ConnectionManagerState peerAddr handle handleError version m)
-> ConnectionHandlerFn
     handlerTrace
     socket
     peerAddr
     handle
     handleError
     (version, versionData)
     m
-> IncludeInboundConnection socket peerAddr handle handleError m
includeInboundConnectionImpl FreshIdSupply m
freshIdSupply StrictTMVar
  m (ConnectionManagerState peerAddr handle handleError version m)
stateVar
                                                       ConnectionHandlerFn
  handlerTrace
  socket
  peerAddr
  handle
  handleError
  (version, versionData)
  m
inboundHandler,
                        icmUnregisterConnection :: peerAddr -> m (OperationResult DemotedToColdRemoteTr)
icmUnregisterConnection =
                          StrictTMVar
  m (ConnectionManagerState peerAddr handle handleError version m)
-> peerAddr -> m (OperationResult DemotedToColdRemoteTr)
unregisterInboundConnectionImpl StrictTMVar
  m (ConnectionManagerState peerAddr handle handleError version m)
stateVar,
                        icmPromotedToWarmRemote :: peerAddr -> m (OperationResult AbstractState)
icmPromotedToWarmRemote =
                          StrictTMVar
  m (ConnectionManagerState peerAddr handle handleError version m)
-> peerAddr -> m (OperationResult AbstractState)
promotedToWarmRemoteImpl StrictTMVar
  m (ConnectionManagerState peerAddr handle handleError version m)
stateVar,
                        icmDemotedToColdRemote :: peerAddr -> m (OperationResult AbstractState)
icmDemotedToColdRemote =
                          StrictTMVar
  m (ConnectionManagerState peerAddr handle handleError version m)
-> peerAddr -> m (OperationResult AbstractState)
demotedToColdRemoteImpl StrictTMVar
  m (ConnectionManagerState peerAddr handle handleError version m)
stateVar,
                        icmNumberOfConnections :: STM m Int
icmNumberOfConnections =
                          forall (m :: * -> *) a. MonadSTM m => StrictTMVar m a -> STM m a
readTMVar StrictTMVar
  m (ConnectionManagerState peerAddr handle handleError version m)
stateVar forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ConnectionManagerState peerAddr handle handleError version m
-> STM m Int
countIncomingConnections
                      },
                m (Map peerAddr AbstractState)
readState :: m (Map peerAddr AbstractState)
readState :: m (Map peerAddr AbstractState)
readState
              }

    ConnectionManager muxMode socket peerAddr handle handleError m
-> m a
k ConnectionManager muxMode socket peerAddr handle handleError m
connectionManager
      -- Since this exception handler is blocking it might receive exceptions
      -- during its execution, which we want to avoid, so we wrap it around
      -- uninterruptibleMask_.
      forall (m :: * -> *) a b. MonadThrow m => m a -> m b -> m a
`finally` forall (m :: * -> *) a. MonadMask m => m a -> m a
uninterruptibleMask_ (do
        forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer m (ConnectionManagerTrace peerAddr handlerTrace)
tracer forall peerAddr handlerTrace.
ConnectionManagerTrace peerAddr handlerTrace
TrShutdown

        ConnectionManagerState peerAddr handle handleError version m
state <- forall (m :: * -> *) a.
(MonadSTM m, ?callStack::CallStack) =>
STM m a -> m a
atomically forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadSTM m => StrictTMVar m a -> STM m a
readTMVar StrictTMVar
  m (ConnectionManagerState peerAddr handle handleError version m)
stateVar
        -- Spawning one thread for each connection cleanup avoids spending time
        -- waiting for locks and cleanup logic that could delay closing the
        -- connections and making us not respecting certain timeouts.
        [Async m ()]
asyncs <- forall k a. Map k a -> [a]
Map.elems
          forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) k a b.
Applicative f =>
(k -> a -> f (Maybe b)) -> Map k a -> f (Map k b)
Map.traverseMaybeWithKey
          (\peerAddr
peerAddr MutableConnState { StrictTVar
  m (ConnectionState peerAddr handle handleError version m)
connVar :: StrictTVar
  m (ConnectionState peerAddr handle handleError version m)
connVar :: forall peerAddr handle handleError version (m :: * -> *).
MutableConnState peerAddr handle handleError version m
-> StrictTVar
     m (ConnectionState peerAddr handle handleError version m)
connVar } -> do
            -- cleanup handler for that thread will close socket associated
            -- with the thread.  We put each connection in 'TerminatedState' to
            -- try that none of the connection threads will enter
            -- 'TerminatingState' (and thus delay shutdown for 'tcp_WAIT_TIME'
            -- seconds) when receiving the 'AsyncCancelled' exception. However,
            -- we can have a race between the finally handler and the `cleanup`
            -- callback. If the finally block loses the race, the received
            -- 'AsyncCancelled' should interrupt the 'threadDelay'.
            --
            (ConnectionState peerAddr handle handleError version m
connState, TransitionTrace
  peerAddr (ConnectionState peerAddr handle handleError version m)
trT, TransitionTrace
  peerAddr (ConnectionState peerAddr handle handleError version m)
trU , Bool
shouldTraceTerminated, Bool
shouldTraceUnknown)
              <- forall (m :: * -> *) a.
(MonadSTM m, ?callStack::CallStack) =>
STM m a -> m a
atomically forall a b. (a -> b) -> a -> b
$ do
                  ConnectionState peerAddr handle handleError version m
connState <- forall (m :: * -> *) a. MonadSTM m => StrictTVar m a -> STM m a
readTVar StrictTVar
  m (ConnectionState peerAddr handle handleError version m)
connVar
                  let connState' :: ConnectionState peerAddr handle handleError version m
connState'            = forall peerAddr handle handleError version (m :: * -> *).
Maybe handleError
-> ConnectionState peerAddr handle handleError version m
TerminatedState forall a. Maybe a
Nothing
                      trT :: TransitionTrace
  peerAddr (ConnectionState peerAddr handle handleError version m)
trT                   =
                        forall peerAddr state.
peerAddr -> Transition' state -> TransitionTrace' peerAddr state
TransitionTrace peerAddr
peerAddr (forall state. state -> state -> Transition state
mkTransition ConnectionState peerAddr handle handleError version m
connState forall {peerAddr} {handle} {handleError} {version} {m :: * -> *}.
ConnectionState peerAddr handle handleError version m
connState')
                      absConnState :: AbstractState
absConnState          = forall muxMode peerAddr m a (b :: * -> *).
MaybeUnknown (ConnectionState muxMode peerAddr m a b)
-> AbstractState
abstractState (forall state. state -> MaybeUnknown state
Known ConnectionState peerAddr handle handleError version m
connState)
                      shouldTraceTerminated :: Bool
shouldTraceTerminated = AbstractState
absConnState forall a. Eq a => a -> a -> Bool
/= AbstractState
TerminatedSt
                      shouldTraceUnknown :: Bool
shouldTraceUnknown    = AbstractState
absConnState forall a. Eq a => a -> a -> Bool
== AbstractState
ReservedOutboundSt
                      trU :: TransitionTrace
  peerAddr (ConnectionState peerAddr handle handleError version m)
trU = forall peerAddr state.
peerAddr -> Transition' state -> TransitionTrace' peerAddr state
TransitionTrace
                              peerAddr
peerAddr
                              (Transition { fromState :: MaybeUnknown
  (ConnectionState peerAddr handle handleError version m)
fromState = forall state. state -> MaybeUnknown state
Known forall {peerAddr} {handle} {handleError} {version} {m :: * -> *}.
ConnectionState peerAddr handle handleError version m
connState'
                                          , toState :: MaybeUnknown
  (ConnectionState peerAddr handle handleError version m)
toState   = forall state. MaybeUnknown state
Unknown
                                          })

                  forall (m :: * -> *) a.
MonadSTM m =>
StrictTVar m a -> a -> STM m ()
writeTVar StrictTVar
  m (ConnectionState peerAddr handle handleError version m)
connVar forall {peerAddr} {handle} {handleError} {version} {m :: * -> *}.
ConnectionState peerAddr handle handleError version m
connState'
                  forall (m :: * -> *) a. Monad m => a -> m a
return (ConnectionState peerAddr handle handleError version m
connState, TransitionTrace
  peerAddr (ConnectionState peerAddr handle handleError version m)
trT, TransitionTrace
  peerAddr (ConnectionState peerAddr handle handleError version m)
trU
                         , Bool
shouldTraceTerminated, Bool
shouldTraceUnknown)

            forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
shouldTraceTerminated forall a b. (a -> b) -> a -> b
$ do
              forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer
  m
  (TransitionTrace
     peerAddr (ConnectionState peerAddr handle handleError version m))
trTracer TransitionTrace
  peerAddr (ConnectionState peerAddr handle handleError version m)
trT

              -- If an Async exception is received after a connection gets set
              -- to ReservedOutboundSt, BUT after a connect call is made and,
              -- therefore still does not have a connection handler thread, we
              -- should trace the unknown transition as well.
              forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
shouldTraceUnknown forall a b. (a -> b) -> a -> b
$
                forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer
  m
  (TransitionTrace
     peerAddr (ConnectionState peerAddr handle handleError version m))
trTracer TransitionTrace
  peerAddr (ConnectionState peerAddr handle handleError version m)
trU

            -- using 'throwTo' here, since we want to block only until connection
            -- handler thread receives an exception so as to not take up extra
            -- time and making us go above timeout schedules.
            forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse
              (\Async m ()
thread -> do
                forall (m :: * -> *) e.
(MonadFork m, Exception e) =>
ThreadId m -> e -> m ()
throwTo (forall (m :: * -> *) a. MonadAsync m => Async m a -> ThreadId m
asyncThreadId Async m ()
thread) AsyncCancelled
AsyncCancelled
                forall (f :: * -> *) a. Applicative f => a -> f a
pure Async m ()
thread
              )
              (forall peerAddr handle handleError version (m :: * -> *).
ConnectionState peerAddr handle handleError version m
-> Maybe (Async m ())
getConnThread ConnectionState peerAddr handle handleError version m
connState)
          ) ConnectionManagerState peerAddr handle handleError version m
state

        forall (m :: * -> *) a.
(MonadSTM m, ?callStack::CallStack) =>
STM m a -> m a
atomically forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. LastToFinishM m a -> m a
runLastToFinishM
                   forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (forall (m :: * -> *) a. m a -> LastToFinishM m a
LastToFinishM forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Functor f => f a -> f ()
void forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a.
MonadAsync m =>
Async m a -> STM m (Either SomeException a)
waitCatchSTM) [Async m ()]
asyncs
      )
  where
    traceCounters :: StrictTMVar m (ConnectionManagerState peerAddr handle handleError version m) -> m ()
    traceCounters :: StrictTMVar
  m (ConnectionManagerState peerAddr handle handleError version m)
-> m ()
traceCounters StrictTMVar
  m (ConnectionManagerState peerAddr handle handleError version m)
stateVar = do
      Map
  peerAddr (ConnectionState peerAddr handle handleError version m)
mState <- forall (m :: * -> *) a.
(MonadSTM m, ?callStack::CallStack) =>
STM m a -> m a
atomically forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadSTM m => StrictTMVar m a -> STM m a
readTMVar StrictTMVar
  m (ConnectionManagerState peerAddr handle handleError version m)
stateVar forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall (m :: * -> *) a. MonadSTM m => StrictTVar m a -> STM m a
readTVar forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall peerAddr handle handleError version (m :: * -> *).
MutableConnState peerAddr handle handleError version m
-> StrictTVar
     m (ConnectionState peerAddr handle handleError version m)
connVar)
      forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer m (ConnectionManagerTrace peerAddr handlerTrace)
tracer (forall peerAddr handlerTrace.
ConnectionManagerCounters
-> ConnectionManagerTrace peerAddr handlerTrace
TrConnectionManagerCounters (forall peerAddr handle handleError version (m :: * -> *).
Map
  peerAddr (ConnectionState peerAddr handle handleError version m)
-> ConnectionManagerCounters
connectionManagerStateToCounters Map
  peerAddr (ConnectionState peerAddr handle handleError version m)
mState))

    countIncomingConnections
        :: ConnectionManagerState peerAddr handle handleError version m
        -> STM m Int
    countIncomingConnections :: ConnectionManagerState peerAddr handle handleError version m
-> STM m Int
countIncomingConnections ConnectionManagerState peerAddr handle handleError version m
st =
          ConnectionManagerCounters -> Int
inboundConns
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall peerAddr handle handleError version (m :: * -> *).
Map
  peerAddr (ConnectionState peerAddr handle handleError version m)
-> ConnectionManagerCounters
connectionManagerStateToCounters
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall (m :: * -> *) a. MonadSTM m => StrictTVar m a -> STM m a
readTVar forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall peerAddr handle handleError version (m :: * -> *).
MutableConnState peerAddr handle handleError version m
-> StrictTVar
     m (ConnectionState peerAddr handle handleError version m)
connVar) ConnectionManagerState peerAddr handle handleError version m
st


    -- Fork connection thread.
    --
    -- TODO: We could probably elegantly eliminate 'PromiseWriter', now that we use
    -- MonadFix.
    forkConnectionHandler
      :: StrictTMVar m (ConnectionManagerState peerAddr handle handleError version m)
      -> MutableConnState peerAddr handle handleError version m
      -> socket
      -> ConnectionId peerAddr
      -> PromiseWriter m (Either handleError (HandshakeConnectionResult handle (version, versionData)))
      -> ConnectionHandlerFn handlerTrace socket peerAddr handle handleError (version, versionData) m
      -> m (Async m ())
    forkConnectionHandler :: StrictTMVar
  m (ConnectionManagerState peerAddr handle handleError version m)
-> MutableConnState peerAddr handle handleError version m
-> socket
-> ConnectionId peerAddr
-> PromiseWriter
     m
     (Either
        handleError
        (HandshakeConnectionResult handle (version, versionData)))
-> ConnectionHandlerFn
     handlerTrace
     socket
     peerAddr
     handle
     handleError
     (version, versionData)
     m
-> m (Async m ())
forkConnectionHandler StrictTMVar
  m (ConnectionManagerState peerAddr handle handleError version m)
stateVar
                          mutableConnState :: MutableConnState peerAddr handle handleError version m
mutableConnState@MutableConnState { StrictTVar
  m (ConnectionState peerAddr handle handleError version m)
connVar :: StrictTVar
  m (ConnectionState peerAddr handle handleError version m)
connVar :: forall peerAddr handle handleError version (m :: * -> *).
MutableConnState peerAddr handle handleError version m
-> StrictTVar
     m (ConnectionState peerAddr handle handleError version m)
connVar }
                          socket
socket
                          connId :: ConnectionId peerAddr
connId@ConnectionId { remoteAddress :: forall addr. ConnectionId addr -> addr
remoteAddress = peerAddr
peerAddr }
                          PromiseWriter
  m
  (Either
     handleError
     (HandshakeConnectionResult handle (version, versionData)))
writer
                          ConnectionHandlerFn
  handlerTrace
  socket
  peerAddr
  handle
  handleError
  (version, versionData)
  m
handler =
        forall (m :: * -> *) b.
MonadMask m =>
((forall a. m a -> m a) -> m b) -> m b
mask forall a b. (a -> b) -> a -> b
$ \forall a. m a -> m a
unmask -> forall (m :: * -> *) a. MonadAsync m => m a -> m (Async m a)
async forall a b. (a -> b) -> a -> b
$ do
          forall (m :: * -> *) a.
MaskedAction m a -> (forall x. m x -> m x) -> m a
runWithUnmask
            (ConnectionHandlerFn
  handlerTrace
  socket
  peerAddr
  handle
  handleError
  (version, versionData)
  m
handler socket
socket PromiseWriter
  m
  (Either
     handleError
     (HandshakeConnectionResult handle (version, versionData)))
writer
                     (forall peerAddr handlerTrace.
ConnectionId peerAddr
-> handlerTrace -> ConnectionManagerTrace peerAddr handlerTrace
TrConnectionHandler ConnectionId peerAddr
connId forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
`contramap` Tracer m (ConnectionManagerTrace peerAddr handlerTrace)
tracer)
                     ConnectionId peerAddr
connId
                     (\DiffTime
bearerTimeout ->
                       forall (m :: * -> *) fd.
MakeBearer m fd
-> DiffTime -> Tracer m MuxTrace -> fd -> m (MuxBearer m)
getBearer MakeBearer m socket
cmMakeBearer
                         DiffTime
bearerTimeout
                         (forall peerid a. peerid -> a -> WithMuxBearer peerid a
WithMuxBearer ConnectionId peerAddr
connId forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
`contramap` Tracer m (WithMuxBearer (ConnectionId peerAddr) MuxTrace)
muxTracer)))
            forall a. m a -> m a
unmask
          forall (m :: * -> *) a b. MonadThrow m => m a -> m b -> m a
`finally` m ()
cleanup
      where
        cleanup :: m ()
        cleanup :: m ()
cleanup =
          -- We must ensure that we update 'connVar',
          -- `requestOutboundConnection` might be blocked on it awaiting for:
          -- - handshake negotiation; or
          -- - `Terminate: TerminatingState → TerminatedState` transition.
          -- That's why we use 'uninterruptibleMask'. Note that this cleanup
          -- function after all is interruptible, because we unmask async
          -- exceptions around 'threadDelay', but even if an async exception
          -- hits there we will update `connVar`.
          forall (m :: * -> *) b.
MonadMask m =>
((forall a. m a -> m a) -> m b) -> m b
uninterruptibleMask forall a b. (a -> b) -> a -> b
$ \forall a. m a -> m a
unmask -> do
            forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer m (ConnectionManagerTrace peerAddr handlerTrace)
tracer (forall peerAddr handlerTrace.
ConnectionId peerAddr
-> ConnectionManagerTrace peerAddr handlerTrace
TrConnectionCleanup ConnectionId peerAddr
connId)
            Either
  ()
  (Transition'
     (MaybeUnknown
        (ConnectionState peerAddr handle handleError version m)))
eTransition <- forall (m :: * -> *) a b.
(MonadEvaluate m, MonadMask m, MonadSTM m) =>
StrictTMVar m a -> (a -> m (a, b)) -> m b
modifyTMVar StrictTMVar
  m (ConnectionManagerState peerAddr handle handleError version m)
stateVar forall a b. (a -> b) -> a -> b
$ \ConnectionManagerState peerAddr handle handleError version m
state -> do
              Either
  (Maybe
     (TransitionTrace
        peerAddr (ConnectionState peerAddr handle handleError version m)))
  (Transition'
     (MaybeUnknown
        (ConnectionState peerAddr handle handleError version m)))
eTransition <- forall (m :: * -> *) a.
(MonadSTM m, ?callStack::CallStack) =>
STM m a -> m a
atomically forall a b. (a -> b) -> a -> b
$ do
                ConnectionState peerAddr handle handleError version m
connState <- forall (m :: * -> *) a. MonadSTM m => StrictTVar m a -> STM m a
readTVar StrictTVar
  m (ConnectionState peerAddr handle handleError version m)
connVar
                let connState' :: ConnectionState peerAddr handle handleError version m
connState' = forall peerAddr handle handleError version (m :: * -> *).
Maybe handleError
-> ConnectionState peerAddr handle handleError version m
TerminatedState forall a. Maybe a
Nothing
                    transition :: Transition'
  (MaybeUnknown
     (ConnectionState peerAddr handle handleError version m))
transition = forall state. state -> state -> Transition state
mkTransition ConnectionState peerAddr handle handleError version m
connState forall {peerAddr} {handle} {handleError} {version} {m :: * -> *}.
ConnectionState peerAddr handle handleError version m
connState'
                    transitionTrace :: TransitionTrace
  peerAddr (ConnectionState peerAddr handle handleError version m)
transitionTrace = forall peerAddr state.
peerAddr -> Transition' state -> TransitionTrace' peerAddr state
TransitionTrace peerAddr
peerAddr Transition'
  (MaybeUnknown
     (ConnectionState peerAddr handle handleError version m))
transition
                case ConnectionState peerAddr handle handleError version m
connState of
                  ConnectionState peerAddr handle handleError version m
ReservedOutboundState -> do
                    forall (m :: * -> *) a.
MonadSTM m =>
StrictTVar m a -> a -> STM m ()
writeTVar StrictTVar
  m (ConnectionState peerAddr handle handleError version m)
connVar forall {peerAddr} {handle} {handleError} {version} {m :: * -> *}.
ConnectionState peerAddr handle handleError version m
connState'
                    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left (forall a. a -> Maybe a
Just TransitionTrace
  peerAddr (ConnectionState peerAddr handle handleError version m)
transitionTrace)
                  UnnegotiatedState {} -> do
                    forall (m :: * -> *) a.
MonadSTM m =>
StrictTVar m a -> a -> STM m ()
writeTVar StrictTVar
  m (ConnectionState peerAddr handle handleError version m)
connVar forall {peerAddr} {handle} {handleError} {version} {m :: * -> *}.
ConnectionState peerAddr handle handleError version m
connState'
                    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left (forall a. a -> Maybe a
Just TransitionTrace
  peerAddr (ConnectionState peerAddr handle handleError version m)
transitionTrace)
                  OutboundUniState {} -> do
                    forall (m :: * -> *) a.
MonadSTM m =>
StrictTVar m a -> a -> STM m ()
writeTVar StrictTVar
  m (ConnectionState peerAddr handle handleError version m)
connVar forall {peerAddr} {handle} {handleError} {version} {m :: * -> *}.
ConnectionState peerAddr handle handleError version m
connState'
                    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left (forall a. a -> Maybe a
Just TransitionTrace
  peerAddr (ConnectionState peerAddr handle handleError version m)
transitionTrace)
                  OutboundDupState {} -> do
                    forall (m :: * -> *) a.
MonadSTM m =>
StrictTVar m a -> a -> STM m ()
writeTVar StrictTVar
  m (ConnectionState peerAddr handle handleError version m)
connVar forall {peerAddr} {handle} {handleError} {version} {m :: * -> *}.
ConnectionState peerAddr handle handleError version m
connState'
                    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left (forall a. a -> Maybe a
Just TransitionTrace
  peerAddr (ConnectionState peerAddr handle handleError version m)
transitionTrace)
                  OutboundIdleState {} -> do
                    forall (m :: * -> *) a.
MonadSTM m =>
StrictTVar m a -> a -> STM m ()
writeTVar StrictTVar
  m (ConnectionState peerAddr handle handleError version m)
connVar forall {peerAddr} {handle} {handleError} {version} {m :: * -> *}.
ConnectionState peerAddr handle handleError version m
connState'
                    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left (forall a. a -> Maybe a
Just TransitionTrace
  peerAddr (ConnectionState peerAddr handle handleError version m)
transitionTrace)
                  InboundIdleState {} -> do
                    forall (m :: * -> *) a.
MonadSTM m =>
StrictTVar m a -> a -> STM m ()
writeTVar StrictTVar
  m (ConnectionState peerAddr handle handleError version m)
connVar forall {peerAddr} {handle} {handleError} {version} {m :: * -> *}.
ConnectionState peerAddr handle handleError version m
connState'
                    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left (forall a. a -> Maybe a
Just TransitionTrace
  peerAddr (ConnectionState peerAddr handle handleError version m)
transitionTrace)
                  InboundState {} -> do
                    forall (m :: * -> *) a.
MonadSTM m =>
StrictTVar m a -> a -> STM m ()
writeTVar StrictTVar
  m (ConnectionState peerAddr handle handleError version m)
connVar forall {peerAddr} {handle} {handleError} {version} {m :: * -> *}.
ConnectionState peerAddr handle handleError version m
connState'
                    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left (forall a. a -> Maybe a
Just TransitionTrace
  peerAddr (ConnectionState peerAddr handle handleError version m)
transitionTrace)
                  DuplexState {} -> do
                    forall (m :: * -> *) a.
MonadSTM m =>
StrictTVar m a -> a -> STM m ()
writeTVar StrictTVar
  m (ConnectionState peerAddr handle handleError version m)
connVar forall {peerAddr} {handle} {handleError} {version} {m :: * -> *}.
ConnectionState peerAddr handle handleError version m
connState'
                    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left (forall a. a -> Maybe a
Just TransitionTrace
  peerAddr (ConnectionState peerAddr handle handleError version m)
transitionTrace)
                  TerminatingState {} -> do
                    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right Transition'
  (MaybeUnknown
     (ConnectionState peerAddr handle handleError version m))
transition
                  TerminatedState {} ->
                    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left forall a. Maybe a
Nothing

              case Either
  (Maybe
     (TransitionTrace
        peerAddr (ConnectionState peerAddr handle handleError version m)))
  (Transition'
     (MaybeUnknown
        (ConnectionState peerAddr handle handleError version m)))
eTransition of
                Left Maybe
  (TransitionTrace
     peerAddr (ConnectionState peerAddr handle handleError version m))
mbTransition -> do
                  forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer
  m
  (TransitionTrace
     peerAddr (ConnectionState peerAddr handle handleError version m))
trTracer) Maybe
  (TransitionTrace
     peerAddr (ConnectionState peerAddr handle handleError version m))
mbTransition
                  forall (m :: * -> *) fd addr. Snocket m fd addr -> fd -> m ()
close Snocket m socket peerAddr
cmSnocket socket
socket
                  forall (m :: * -> *) a. Monad m => a -> m a
return ( forall k a. Ord k => k -> Map k a -> Map k a
Map.delete peerAddr
peerAddr ConnectionManagerState peerAddr handle handleError version m
state
                         , forall a b. a -> Either a b
Left ()
                         )
                Right Transition'
  (MaybeUnknown
     (ConnectionState peerAddr handle handleError version m))
transition -> do
                  forall (m :: * -> *) fd addr. Snocket m fd addr -> fd -> m ()
close Snocket m socket peerAddr
cmSnocket socket
socket
                  forall (m :: * -> *) a. Monad m => a -> m a
return ( ConnectionManagerState peerAddr handle handleError version m
state
                         , forall a b. b -> Either a b
Right Transition'
  (MaybeUnknown
     (ConnectionState peerAddr handle handleError version m))
transition
                         )

            case Either
  ()
  (Transition'
     (MaybeUnknown
        (ConnectionState peerAddr handle handleError version m)))
eTransition of
              Left () -> do
                forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer
  m
  (TransitionTrace
     peerAddr (ConnectionState peerAddr handle handleError version m))
trTracer
                          (forall peerAddr state.
peerAddr -> Transition' state -> TransitionTrace' peerAddr state
TransitionTrace
                            peerAddr
peerAddr
                            Transition
                               { fromState :: MaybeUnknown
  (ConnectionState peerAddr handle handleError version m)
fromState = forall state. state -> MaybeUnknown state
Known (forall peerAddr handle handleError version (m :: * -> *).
Maybe handleError
-> ConnectionState peerAddr handle handleError version m
TerminatedState forall a. Maybe a
Nothing)
                               , toState :: MaybeUnknown
  (ConnectionState peerAddr handle handleError version m)
toState   = forall state. MaybeUnknown state
Unknown
                               })
                StrictTMVar
  m (ConnectionManagerState peerAddr handle handleError version m)
-> m ()
traceCounters StrictTMVar
  m (ConnectionManagerState peerAddr handle handleError version m)
stateVar
              Right Transition'
  (MaybeUnknown
     (ConnectionState peerAddr handle handleError version m))
transition ->
                do forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer m (ConnectionManagerTrace peerAddr handlerTrace)
tracer (forall peerAddr handlerTrace.
ConnectionId peerAddr
-> ConnectionManagerTrace peerAddr handlerTrace
TrConnectionTimeWait ConnectionId peerAddr
connId)
                   forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (DiffTime
cmTimeWaitTimeout forall a. Ord a => a -> a -> Bool
> DiffTime
0) forall a b. (a -> b) -> a -> b
$
                     let -- make sure we wait at least 'cmTimeWaitTimeout', we
                         -- ignore all 'AsyncCancelled' exceptions.
                         forceThreadDelay :: DiffTime -> m ()
forceThreadDelay DiffTime
delay | DiffTime
delay forall a. Ord a => a -> a -> Bool
<= DiffTime
0 = forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
                         forceThreadDelay DiffTime
delay = do
                           Time
t <- forall (m :: * -> *). MonadMonotonicTime m => m Time
getMonotonicTime
                           forall a. m a -> m a
unmask (forall (m :: * -> *). MonadDelay m => DiffTime -> m ()
threadDelay DiffTime
delay)
                             forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> (e -> m a) -> m a
`catch` \SomeException
e ->
                                case forall e. Exception e => SomeException -> Maybe e
fromException SomeException
e
                                of Just AsyncCancelled
AsyncCancelled -> do
                                     Time
t' <- forall (m :: * -> *). MonadMonotonicTime m => m Time
getMonotonicTime
                                     DiffTime -> m ()
forceThreadDelay (DiffTime
delay forall a. Num a => a -> a -> a
- Time
t' Time -> Time -> DiffTime
`diffTime` Time
t)
                                   Maybe AsyncCancelled
_ -> forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwIO SomeException
e
                     in DiffTime -> m ()
forceThreadDelay DiffTime
cmTimeWaitTimeout
                forall (m :: * -> *) a b. MonadThrow m => m a -> m b -> m a
`finally` do
                  -- We must ensure that we update 'connVar',
                  -- `requestOutboundConnection` might be blocked on it awaiting for:
                  -- - handshake negotiation; or
                  -- - `Terminate: TerminatingState → TerminatedState` transition.
                  forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer m (ConnectionManagerTrace peerAddr handlerTrace)
tracer (forall peerAddr handlerTrace.
ConnectionId peerAddr
-> ConnectionManagerTrace peerAddr handlerTrace
TrConnectionTimeWaitDone ConnectionId peerAddr
connId)

                  [Transition'
   (MaybeUnknown
      (ConnectionState peerAddr handle handleError version m))]
trs <- forall (m :: * -> *) a.
(MonadSTM m, ?callStack::CallStack) =>
STM m a -> m a
atomically forall a b. (a -> b) -> a -> b
$ do
                    ConnectionState peerAddr handle handleError version m
connState <- forall (m :: * -> *) a. MonadSTM m => StrictTVar m a -> STM m a
readTVar StrictTVar
  m (ConnectionState peerAddr handle handleError version m)
connVar
                    let transition' :: Transition'
  (MaybeUnknown
     (ConnectionState peerAddr handle handleError version m))
transition' = Transition'
  (MaybeUnknown
     (ConnectionState peerAddr handle handleError version m))
transition { fromState :: MaybeUnknown
  (ConnectionState peerAddr handle handleError version m)
fromState = forall state. state -> MaybeUnknown state
Known ConnectionState peerAddr handle handleError version m
connState }
                        shouldTrace :: Bool
shouldTrace = forall muxMode peerAddr m a (b :: * -> *).
MaybeUnknown (ConnectionState muxMode peerAddr m a b)
-> AbstractState
abstractState (forall state. state -> MaybeUnknown state
Known ConnectionState peerAddr handle handleError version m
connState)
                                   forall a. Eq a => a -> a -> Bool
/= AbstractState
TerminatedSt
                    forall (m :: * -> *) a.
MonadSTM m =>
StrictTVar m a -> a -> STM m ()
writeTVar StrictTVar
  m (ConnectionState peerAddr handle handleError version m)
connVar (forall peerAddr handle handleError version (m :: * -> *).
Maybe handleError
-> ConnectionState peerAddr handle handleError version m
TerminatedState forall a. Maybe a
Nothing)
                    --  We have to be careful when deleting it from
                    --  'ConnectionManagerState'.
                    Bool
updated <-
                      forall (m :: * -> *) a b.
MonadSTM m =>
StrictTMVar m a -> (a -> (a, b)) -> STM m b
modifyTMVarPure
                        StrictTMVar
  m (ConnectionManagerState peerAddr handle handleError version m)
stateVar
                        ( \ConnectionManagerState peerAddr handle handleError version m
state ->
                          case forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup peerAddr
peerAddr ConnectionManagerState peerAddr handle handleError version m
state of
                            Maybe (MutableConnState peerAddr handle handleError version m)
Nothing -> (ConnectionManagerState peerAddr handle handleError version m
state, Bool
False)
                            Just MutableConnState peerAddr handle handleError version m
v  ->
                              if MutableConnState peerAddr handle handleError version m
mutableConnState forall a. Eq a => a -> a -> Bool
== MutableConnState peerAddr handle handleError version m
v
                                then (forall k a. Ord k => k -> Map k a -> Map k a
Map.delete peerAddr
peerAddr ConnectionManagerState peerAddr handle handleError version m
state , Bool
True)
                                else (ConnectionManagerState peerAddr handle handleError version m
state                     , Bool
False)
                        )

                    if Bool
updated
                       then do
                      -- Key was present in the dictionary (stateVar) and
                      -- removed so we trace the removal.
                        let trs :: [Transition'
   (MaybeUnknown
      (ConnectionState peerAddr handle handleError version m))]
trs = [ Transition
                                     { fromState :: MaybeUnknown
  (ConnectionState peerAddr handle handleError version m)
fromState = forall state. state -> MaybeUnknown state
Known (forall peerAddr handle handleError version (m :: * -> *).
Maybe handleError
-> ConnectionState peerAddr handle handleError version m
TerminatedState forall a. Maybe a
Nothing)
                                     , toState :: MaybeUnknown
  (ConnectionState peerAddr handle handleError version m)
toState   = forall state. MaybeUnknown state
Unknown
                                     }
                                  ]
                        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
                          if Bool
shouldTrace
                             then Transition'
  (MaybeUnknown
     (ConnectionState peerAddr handle handleError version m))
transition' forall a. a -> [a] -> [a]
: forall {peerAddr} {handle} {handleError} {version} {m :: * -> *}.
[Transition'
   (MaybeUnknown
      (ConnectionState peerAddr handle handleError version m))]
trs
                             else forall {peerAddr} {handle} {handleError} {version} {m :: * -> *}.
[Transition'
   (MaybeUnknown
      (ConnectionState peerAddr handle handleError version m))]
trs
                      -- Key was not present in the dictionary (stateVar),
                      -- so we do not trace anything as it was already traced upon
                      -- deletion.
                      --
                      -- OR
                      --
                      -- Key was overwritten in the dictionary (stateVar),
                      -- so we do not trace anything as it was already traced upon
                      -- overwriting.
                       else forall (m :: * -> *) a. Monad m => a -> m a
return [ ]

                  forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer
  m
  (TransitionTrace
     peerAddr (ConnectionState peerAddr handle handleError version m))
trTracer forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall peerAddr state.
peerAddr -> Transition' state -> TransitionTrace' peerAddr state
TransitionTrace peerAddr
peerAddr) [Transition'
   (MaybeUnknown
      (ConnectionState peerAddr handle handleError version m))]
trs
                  StrictTMVar
  m (ConnectionManagerState peerAddr handle handleError version m)
-> m ()
traceCounters StrictTMVar
  m (ConnectionManagerState peerAddr handle handleError version m)
stateVar

    -- Pruning is done in two stages:
    -- * an STM transaction which selects which connections to prune, and sets
    --   their state to 'TerminatedState';
    -- * an io action which logs and cancels all the connection handler
    --   threads.
    mkPruneAction :: peerAddr
                  -> Int
                  -- ^ number of connections to prune
                  -> ConnectionManagerState peerAddr handle handleError version m
                  -> ConnectionState peerAddr handle handleError version  m
                  -- ^ next connection state, if it will not be pruned.
                  -> StrictTVar m (ConnectionState peerAddr handle handleError version m)
                  -> Async m ()
                  -> STM m (Bool, PruneAction m)
                  -- ^ return if the connection was choose to be pruned and the
                  -- 'PruneAction'
    mkPruneAction :: peerAddr
-> Int
-> ConnectionManagerState peerAddr handle handleError version m
-> ConnectionState peerAddr handle handleError version m
-> StrictTVar
     m (ConnectionState peerAddr handle handleError version m)
-> Async m ()
-> STM m (Bool, PruneAction m)
mkPruneAction peerAddr
peerAddr Int
numberToPrune ConnectionManagerState peerAddr handle handleError version m
state ConnectionState peerAddr handle handleError version m
connState' StrictTVar
  m (ConnectionState peerAddr handle handleError version m)
connVar Async m ()
connThread = do
      (Map
  peerAddr
  (ConnectionType, Async m (),
   StrictTVar
     m (ConnectionState peerAddr handle handleError version m))
choiceMap' :: Map peerAddr ( ConnectionType
                                  , Async m ()
                                  , StrictTVar m
                                      (ConnectionState
                                        peerAddr
                                        handle handleError
                                        version m)
                                  ))
        <- forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (f :: * -> *) k a b.
Applicative f =>
(k -> a -> f (Maybe b)) -> Map k a -> f (Map k b)
Map.traverseMaybeWithKey ConnectionManagerState peerAddr handle handleError version m
state forall a b. (a -> b) -> a -> b
$ \peerAddr
_peerAddr MutableConnState { connVar :: forall peerAddr handle handleError version (m :: * -> *).
MutableConnState peerAddr handle handleError version m
-> StrictTVar
     m (ConnectionState peerAddr handle handleError version m)
connVar = StrictTVar
  m (ConnectionState peerAddr handle handleError version m)
connVar' } ->
             (\ConnectionState peerAddr handle handleError version m
cs -> do
                 -- this expression returns @Maybe (connType, connThread)@;
                 -- 'traverseMaybeWithKey' collects all 'Just' cases.
                 forall (f :: * -> *). Alternative f => Bool -> f ()
guard (forall peerAddr handle handleError version (m :: * -> *).
ConnectionState peerAddr handle handleError version m -> Bool
isInboundConn ConnectionState peerAddr handle handleError version m
cs)
                 (,,StrictTVar
  m (ConnectionState peerAddr handle handleError version m)
connVar') forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall peerAddr handle handleError version (m :: * -> *).
ConnectionState peerAddr handle handleError version m
-> Maybe ConnectionType
getConnType ConnectionState peerAddr handle handleError version m
cs
                              forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall peerAddr handle handleError version (m :: * -> *).
ConnectionState peerAddr handle handleError version m
-> Maybe (Async m ())
getConnThread ConnectionState peerAddr handle handleError version m
cs)
         forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a. MonadSTM m => StrictTVar m a -> STM m a
readTVar StrictTVar
  m (ConnectionState peerAddr handle handleError version m)
connVar'
      let choiceMap :: Map
  peerAddr
  (ConnectionType, Async m (),
   StrictTVar
     m (ConnectionState peerAddr handle handleError version m))
choiceMap =
            case forall peerAddr handle handleError version (m :: * -> *).
ConnectionState peerAddr handle handleError version m
-> Maybe ConnectionType
getConnType ConnectionState peerAddr handle handleError version m
connState' of
              Maybe ConnectionType
Nothing -> forall a. (?callStack::CallStack) => Bool -> a -> a
assert Bool
False Map
  peerAddr
  (ConnectionType, Async m (),
   StrictTVar
     m (ConnectionState peerAddr handle handleError version m))
choiceMap'
              Just ConnectionType
a  -> forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert peerAddr
peerAddr (ConnectionType
a, Async m ()
connThread, StrictTVar
  m (ConnectionState peerAddr handle handleError version m)
connVar)
                                    Map
  peerAddr
  (ConnectionType, Async m (),
   StrictTVar
     m (ConnectionState peerAddr handle handleError version m))
choiceMap'

      Set peerAddr
pruneSet <-
        PrunePolicy peerAddr (STM m)
cmPrunePolicy
          ((\(ConnectionType
a,Async m ()
_,StrictTVar
  m (ConnectionState peerAddr handle handleError version m)
_) -> ConnectionType
a) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map
  peerAddr
  (ConnectionType, Async m (),
   StrictTVar
     m (ConnectionState peerAddr handle handleError version m))
choiceMap)
          Int
numberToPrune

      let pruneMap :: Map
  peerAddr
  (ConnectionType, Async m (),
   StrictTVar
     m (ConnectionState peerAddr handle handleError version m))
pruneMap = Map
  peerAddr
  (ConnectionType, Async m (),
   StrictTVar
     m (ConnectionState peerAddr handle handleError version m))
choiceMap forall k a. Ord k => Map k a -> Set k -> Map k a
`Map.restrictKeys` Set peerAddr
pruneSet
      forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Map
  peerAddr
  (ConnectionType, Async m (),
   StrictTVar
     m (ConnectionState peerAddr handle handleError version m))
pruneMap forall a b. (a -> b) -> a -> b
$ \(ConnectionType
_, Async m ()
_, StrictTVar
  m (ConnectionState peerAddr handle handleError version m)
connVar') ->
        forall (m :: * -> *) a.
MonadSTM m =>
StrictTVar m a -> a -> STM m ()
writeTVar StrictTVar
  m (ConnectionState peerAddr handle handleError version m)
connVar' (forall peerAddr handle handleError version (m :: * -> *).
Maybe handleError
-> ConnectionState peerAddr handle handleError version m
TerminatedState forall a. Maybe a
Nothing)

      forall (m :: * -> *) a. Monad m => a -> m a
return ( peerAddr
peerAddr forall a. Ord a => a -> Set a -> Bool
`Set.member` Set peerAddr
pruneSet
             , forall (m :: * -> *). m () -> PruneAction m
PruneAction forall a b. (a -> b) -> a -> b
$ do
                 forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer m (ConnectionManagerTrace peerAddr handlerTrace)
tracer (forall peerAddr handlerTrace.
Set peerAddr
-> Int
-> Set peerAddr
-> ConnectionManagerTrace peerAddr handlerTrace
TrPruneConnections (forall k a. Map k a -> Set k
Map.keysSet Map
  peerAddr
  (ConnectionType, Async m (),
   StrictTVar
     m (ConnectionState peerAddr handle handleError version m))
pruneMap)
                                                      Int
numberToPrune
                                                      (forall k a. Map k a -> Set k
Map.keysSet Map
  peerAddr
  (ConnectionType, Async m (),
   StrictTVar
     m (ConnectionState peerAddr handle handleError version m))
choiceMap))
                 -- we don't block until the thread terminates, delivering the
                 -- async exception is enough (although in this case, there's no
                 -- difference, since we put the connection in 'TerminatedState'
                 -- which avoids the 'cmTimeWaitTimeout').
                 forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Map
  peerAddr
  (ConnectionType, Async m (),
   StrictTVar
     m (ConnectionState peerAddr handle handleError version m))
pruneMap forall a b. (a -> b) -> a -> b
$ \(ConnectionType
_, Async m ()
connThread', StrictTVar
  m (ConnectionState peerAddr handle handleError version m)
_) ->
                                   forall (m :: * -> *) e.
(MonadFork m, Exception e) =>
ThreadId m -> e -> m ()
throwTo (forall (m :: * -> *) a. MonadAsync m => Async m a -> ThreadId m
asyncThreadId Async m ()
connThread')
                                           AsyncCancelled
AsyncCancelled
             )

    includeInboundConnectionImpl
        :: HasCallStack
        => FreshIdSupply m
        -> StrictTMVar m (ConnectionManagerState peerAddr handle handleError version m)
        -> ConnectionHandlerFn handlerTrace socket peerAddr handle handleError (version, versionData) m
        -> Word32
        -- ^ inbound connections hard limit
        -- TODO: This is needed because the accept loop can not guarantee that
        -- includeInboundConnection can run safely without going above the
        -- hard limit.  We have to check if we are not above the hard limit
        -- after locking the connection manager state `TMVar` and  then decide
        -- whether we can include the connection or not.
        -> socket
        -- ^ resource to include in the state
        -> peerAddr
        -- ^ remote address used as an identifier of the resource
        -> m (Connected peerAddr handle handleError)
    includeInboundConnectionImpl :: (?callStack::CallStack) =>
FreshIdSupply m
-> StrictTMVar
     m (ConnectionManagerState peerAddr handle handleError version m)
-> ConnectionHandlerFn
     handlerTrace
     socket
     peerAddr
     handle
     handleError
     (version, versionData)
     m
-> IncludeInboundConnection socket peerAddr handle handleError m
includeInboundConnectionImpl FreshIdSupply m
freshIdSupply
                                 StrictTMVar
  m (ConnectionManagerState peerAddr handle handleError version m)
stateVar
                                 ConnectionHandlerFn
  handlerTrace
  socket
  peerAddr
  handle
  handleError
  (version, versionData)
  m
handler
                                 Word32
hardLimit
                                 socket
socket
                                 peerAddr
peerAddr = do
        (Maybe
  (MutableConnState peerAddr handle handleError version m,
   Async m (),
   PromiseReader
     m
     (Either
        handleError
        (HandshakeConnectionResult handle (version, versionData))))
r, ConnectionId peerAddr
connId) <- forall (m :: * -> *) a b.
(MonadEvaluate m, MonadMask m, MonadSTM m) =>
StrictTMVar m a -> (a -> m (a, b)) -> m b
modifyTMVar StrictTMVar
  m (ConnectionManagerState peerAddr handle handleError version m)
stateVar forall a b. (a -> b) -> a -> b
$ \ConnectionManagerState peerAddr handle handleError version m
state -> do
          peerAddr
localAddress <- forall (m :: * -> *) fd addr. Snocket m fd addr -> fd -> m addr
getLocalAddr Snocket m socket peerAddr
cmSnocket socket
socket
          Int
numberOfCons <- forall (m :: * -> *) a.
(MonadSTM m, ?callStack::CallStack) =>
STM m a -> m a
atomically forall a b. (a -> b) -> a -> b
$ ConnectionManagerState peerAddr handle handleError version m
-> STM m Int
countIncomingConnections ConnectionManagerState peerAddr handle handleError version m
state

          let connId :: ConnectionId peerAddr
connId = ConnectionId { peerAddr
localAddress :: peerAddr
localAddress :: peerAddr
localAddress, remoteAddress :: peerAddr
remoteAddress = peerAddr
peerAddr }

              -- Check if after accepting this connection we get above the
              -- hard limit
              canAccept :: Bool
canAccept = Int
numberOfCons forall a. Num a => a -> a -> a
+ Int
1 forall a. Ord a => a -> a -> Bool
<= forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
hardLimit

          if Bool
canAccept
          then do
            let provenance :: Provenance
provenance = Provenance
Inbound
            forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer m (ConnectionManagerTrace peerAddr handlerTrace)
tracer (forall peerAddr handlerTrace.
Provenance
-> peerAddr -> ConnectionManagerTrace peerAddr handlerTrace
TrIncludeConnection Provenance
provenance peerAddr
peerAddr)
            (PromiseReader
  m
  (Either
     handleError
     (HandshakeConnectionResult handle (version, versionData)))
reader, PromiseWriter
  m
  (Either
     handleError
     (HandshakeConnectionResult handle (version, versionData)))
writer) <- forall (m :: * -> *) a.
(MonadSTM m, MonadThrow (STM m)) =>
m (PromiseReader m a, PromiseWriter m a)
newEmptyPromiseIO
            (Async m ()
connThread, MutableConnState peerAddr handle handleError version m
connVar, Maybe (ConnectionState peerAddr handle handleError version m)
connState0, ConnectionState peerAddr handle handleError version m
connState) <-
              forall (m :: * -> *) a. MonadFix m => (a -> m a) -> m a
mfix forall a b. (a -> b) -> a -> b
$ \ ~(Async m ()
connThread, MutableConnState peerAddr handle handleError version m
_mutableConnVar, Maybe (ConnectionState peerAddr handle handleError version m)
_connState0, ConnectionState peerAddr handle handleError version m
_connState) -> do
                -- Either
                -- @
                --   Accepted    : ● → UnnegotiatedState Inbound
                --   Overwritten : ● → UnnegotiatedState Inbound
                --   SelfConn    : UnnegotiatedState Outbound
                --               → UnnegotiatedState Inbound
                -- @
                --
                -- This is subtle part, which needs to handle a near simultaneous
                -- open.  We cannot rely on 'ReservedOutboundState' state as
                -- a lock.  It may happen that the `requestOutboundConnection`
                -- will put 'ReservedOutboundState', but before it will call `connect`
                -- the `accept` call will return.  We overwrite the state and
                -- replace the connection state 'TVar' with a fresh one.  Nothing
                -- is blocked on the replaced 'TVar'.
                --
                -- The `SelfConn` transition can happen when the node tries to
                -- connect to itself (and inbound & outbound addresses are the
                -- same).
                let connState' :: ConnectionState peerAddr handle handleError version m
connState' = forall peerAddr handle handleError version (m :: * -> *).
Provenance
-> ConnectionId peerAddr
-> Async m ()
-> ConnectionState peerAddr handle handleError version m
UnnegotiatedState Provenance
provenance ConnectionId peerAddr
connId Async m ()
connThread
                (MutableConnState peerAddr handle handleError version m
mutableConnVar', Maybe (ConnectionState peerAddr handle handleError version m)
connState0') <-
                  forall (m :: * -> *) a.
(MonadSTM m, ?callStack::CallStack) =>
STM m a -> m a
atomically forall a b. (a -> b) -> a -> b
$ do
                    let v0 :: Maybe (MutableConnState peerAddr handle handleError version m)
v0 = forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup peerAddr
peerAddr ConnectionManagerState peerAddr handle handleError version m
state
                    Maybe (ConnectionState peerAddr handle handleError version m)
connState0' <- forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall (m :: * -> *) a. MonadSTM m => StrictTVar m a -> STM m a
readTVar forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall peerAddr handle handleError version (m :: * -> *).
MutableConnState peerAddr handle handleError version m
-> StrictTVar
     m (ConnectionState peerAddr handle handleError version m)
connVar) Maybe (MutableConnState peerAddr handle handleError version m)
v0
                    case Maybe (MutableConnState peerAddr handle handleError version m)
v0 of
                      Maybe (MutableConnState peerAddr handle handleError version m)
Nothing -> do
                        -- 'Accepted'
                        MutableConnState peerAddr handle handleError version m
v <- forall (m :: * -> *) peerAddr handle handleError version.
MonadSTM m =>
FreshIdSupply m
-> ConnectionState peerAddr handle handleError version m
-> STM m (MutableConnState peerAddr handle handleError version m)
newMutableConnState FreshIdSupply m
freshIdSupply ConnectionState peerAddr handle handleError version m
connState'
                        forall (m :: * -> *) a.
MonadLabelledSTM m =>
StrictTVar m a -> String -> STM m ()
labelTVar (forall peerAddr handle handleError version (m :: * -> *).
MutableConnState peerAddr handle handleError version m
-> StrictTVar
     m (ConnectionState peerAddr handle handleError version m)
connVar MutableConnState peerAddr handle handleError version m
v) (String
"conn-state-" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show ConnectionId peerAddr
connId)
                        forall (m :: * -> *) a. Monad m => a -> m a
return (MutableConnState peerAddr handle handleError version m
v, Maybe (ConnectionState peerAddr handle handleError version m)
connState0')
                      Just MutableConnState peerAddr handle handleError version m
v -> do
                        -- 'Overwritten' or 'SelfConn'.
                        forall (m :: * -> *) a.
MonadSTM m =>
StrictTVar m a -> a -> STM m ()
writeTVar (forall peerAddr handle handleError version (m :: * -> *).
MutableConnState peerAddr handle handleError version m
-> StrictTVar
     m (ConnectionState peerAddr handle handleError version m)
connVar MutableConnState peerAddr handle handleError version m
v) ConnectionState peerAddr handle handleError version m
connState'
                        forall (m :: * -> *) a. Monad m => a -> m a
return (MutableConnState peerAddr handle handleError version m
v, Maybe (ConnectionState peerAddr handle handleError version m)
connState0')
                Async m ()
connThread' <-
                  StrictTMVar
  m (ConnectionManagerState peerAddr handle handleError version m)
-> MutableConnState peerAddr handle handleError version m
-> socket
-> ConnectionId peerAddr
-> PromiseWriter
     m
     (Either
        handleError
        (HandshakeConnectionResult handle (version, versionData)))
-> ConnectionHandlerFn
     handlerTrace
     socket
     peerAddr
     handle
     handleError
     (version, versionData)
     m
-> m (Async m ())
forkConnectionHandler
                     StrictTMVar
  m (ConnectionManagerState peerAddr handle handleError version m)
stateVar MutableConnState peerAddr handle handleError version m
mutableConnVar' socket
socket ConnectionId peerAddr
connId PromiseWriter
  m
  (Either
     handleError
     (HandshakeConnectionResult handle (version, versionData)))
writer ConnectionHandlerFn
  handlerTrace
  socket
  peerAddr
  handle
  handleError
  (version, versionData)
  m
handler
                forall (m :: * -> *) a. Monad m => a -> m a
return (Async m ()
connThread', MutableConnState peerAddr handle handleError version m
mutableConnVar', Maybe (ConnectionState peerAddr handle handleError version m)
connState0', ConnectionState peerAddr handle handleError version m
connState')

            forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer
  m
  (TransitionTrace
     peerAddr (ConnectionState peerAddr handle handleError version m))
trTracer (forall peerAddr state.
peerAddr -> Transition' state -> TransitionTrace' peerAddr state
TransitionTrace peerAddr
peerAddr
                                 Transition { fromState :: MaybeUnknown
  (ConnectionState peerAddr handle handleError version m)
fromState = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall state. MaybeUnknown state
Unknown forall state. state -> MaybeUnknown state
Known Maybe (ConnectionState peerAddr handle handleError version m)
connState0
                                            , toState :: MaybeUnknown
  (ConnectionState peerAddr handle handleError version m)
toState   = forall state. state -> MaybeUnknown state
Known ConnectionState peerAddr handle handleError version m
connState
                                            })
            forall (m :: * -> *) a. Monad m => a -> m a
return ( forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert peerAddr
peerAddr MutableConnState peerAddr handle handleError version m
connVar ConnectionManagerState peerAddr handle handleError version m
state
                   , (forall a. a -> Maybe a
Just (MutableConnState peerAddr handle handleError version m
connVar, Async m ()
connThread, PromiseReader
  m
  (Either
     handleError
     (HandshakeConnectionResult handle (version, versionData)))
reader), ConnectionId peerAddr
connId)
                   )
          else
            forall (m :: * -> *) a. Monad m => a -> m a
return ( ConnectionManagerState peerAddr handle handleError version m
state
                   , (forall a. Maybe a
Nothing, ConnectionId peerAddr
connId)
                   )

        case Maybe
  (MutableConnState peerAddr handle handleError version m,
   Async m (),
   PromiseReader
     m
     (Either
        handleError
        (HandshakeConnectionResult handle (version, versionData))))
r of
          Maybe
  (MutableConnState peerAddr handle handleError version m,
   Async m (),
   PromiseReader
     m
     (Either
        handleError
        (HandshakeConnectionResult handle (version, versionData))))
Nothing ->
            forall (m :: * -> *) a. Monad m => a -> m a
return (forall peerAddr handle handleError.
ConnectionId peerAddr
-> Maybe handleError -> Connected peerAddr handle handleError
Disconnected ConnectionId peerAddr
connId forall a. Maybe a
Nothing)

          Just (mutableConnState :: MutableConnState peerAddr handle handleError version m
mutableConnState@MutableConnState { StrictTVar
  m (ConnectionState peerAddr handle handleError version m)
connVar :: StrictTVar
  m (ConnectionState peerAddr handle handleError version m)
connVar :: forall peerAddr handle handleError version (m :: * -> *).
MutableConnState peerAddr handle handleError version m
-> StrictTVar
     m (ConnectionState peerAddr handle handleError version m)
connVar }
               , Async m ()
connThread, PromiseReader
  m
  (Either
     handleError
     (HandshakeConnectionResult handle (version, versionData)))
reader) -> do
            StrictTMVar
  m (ConnectionManagerState peerAddr handle handleError version m)
-> m ()
traceCounters StrictTMVar
  m (ConnectionManagerState peerAddr handle handleError version m)
stateVar

            Either
  handleError
  (HandshakeConnectionResult handle (version, versionData))
res <- forall (m :: * -> *) a.
(MonadSTM m, ?callStack::CallStack) =>
STM m a -> m a
atomically forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. PromiseReader m a -> STM m a
readPromise PromiseReader
  m
  (Either
     handleError
     (HandshakeConnectionResult handle (version, versionData)))
reader
            case Either
  handleError
  (HandshakeConnectionResult handle (version, versionData))
res of
              Left handleError
handleError -> do
                ConnectionId peerAddr
-> StrictTVar
     m (ConnectionState peerAddr handle handleError version m)
-> Async m ()
-> peerAddr
-> StrictTMVar
     m (ConnectionManagerState peerAddr handle handleError version m)
-> MutableConnState peerAddr handle handleError version m
-> Maybe handleError
-> m (Connected peerAddr handle handleError)
terminateInboundWithErrorOrQuery ConnectionId peerAddr
connId StrictTVar
  m (ConnectionState peerAddr handle handleError version m)
connVar Async m ()
connThread peerAddr
peerAddr StrictTMVar
  m (ConnectionManagerState peerAddr handle handleError version m)
stateVar MutableConnState peerAddr handle handleError version m
mutableConnState forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just handleError
handleError

              Right HandshakeConnectionResult handle (version, versionData)
HandshakeConnectionQuery -> do
                ConnectionId peerAddr
-> StrictTVar
     m (ConnectionState peerAddr handle handleError version m)
-> Async m ()
-> peerAddr
-> StrictTMVar
     m (ConnectionManagerState peerAddr handle handleError version m)
-> MutableConnState peerAddr handle handleError version m
-> Maybe handleError
-> m (Connected peerAddr handle handleError)
terminateInboundWithErrorOrQuery ConnectionId peerAddr
connId StrictTVar
  m (ConnectionState peerAddr handle handleError version m)
connVar Async m ()
connThread peerAddr
peerAddr StrictTMVar
  m (ConnectionManagerState peerAddr handle handleError version m)
stateVar MutableConnState peerAddr handle handleError version m
mutableConnState forall a. Maybe a
Nothing

              Right (HandshakeConnectionResult handle
handle (version
version, versionData
versionData)) -> do
                let dataFlow :: DataFlow
dataFlow = version -> versionData -> DataFlow
connectionDataFlow version
version versionData
versionData
                (Bool
connected, Maybe
  (Transition'
     (MaybeUnknown
        (ConnectionState peerAddr handle handleError version m)))
mbTransition, Provenance
provenance) <- forall (m :: * -> *) a.
(MonadSTM m, ?callStack::CallStack) =>
STM m a -> m a
atomically forall a b. (a -> b) -> a -> b
$ do
                  ConnectionState peerAddr handle handleError version m
connState <- forall (m :: * -> *) a. MonadSTM m => StrictTVar m a -> STM m a
readTVar StrictTVar
  m (ConnectionState peerAddr handle handleError version m)
connVar
                  case ConnectionState peerAddr handle handleError version m
connState of
                    -- Inbound connections cannot be found in this state at this
                    -- stage.
                    ConnectionState peerAddr handle handleError version m
ReservedOutboundState ->
                      forall (m :: * -> *) e a.
(MonadSTM m, MonadThrow (STM m), Exception e) =>
e -> STM m a
throwSTM (forall a. (?callStack::CallStack) => (CallStack -> a) -> a
withCallStack (forall peerAddr.
peerAddr -> CallStack -> ConnectionManagerError peerAddr
ImpossibleState peerAddr
peerAddr))

                    --
                    -- The common case.
                    --
                    -- Note: we don't set an explicit timeout here.  The
                    -- server will set a timeout and call
                    -- 'unregisterInboundConnection' when it expires.
                    --
                    UnnegotiatedState {} -> do
                      let connState' :: ConnectionState peerAddr handle handleError version m
connState' = forall peerAddr handle handleError version (m :: * -> *).
ConnectionId peerAddr
-> Async m ()
-> handle
-> DataFlow
-> ConnectionState peerAddr handle handleError version m
InboundIdleState
                                         ConnectionId peerAddr
connId Async m ()
connThread handle
handle DataFlow
dataFlow
                      forall (m :: * -> *) a.
MonadSTM m =>
StrictTVar m a -> a -> STM m ()
writeTVar StrictTVar
  m (ConnectionState peerAddr handle handleError version m)
connVar ConnectionState peerAddr handle handleError version m
connState'
                      forall (m :: * -> *) a. Monad m => a -> m a
return ( Bool
True
                             , forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall state. state -> state -> Transition state
mkTransition ConnectionState peerAddr handle handleError version m
connState ConnectionState peerAddr handle handleError version m
connState'
                             , Provenance
Inbound
                             )

                    -- Self connection: the inbound side lost the race to update
                    -- the state after negotiating the connection.
                    OutboundUniState {} -> forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
True, forall a. Maybe a
Nothing, Provenance
Outbound)
                    OutboundDupState {} -> forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
True, forall a. Maybe a
Nothing, Provenance
Outbound)

                    OutboundIdleState ConnectionId peerAddr
_ Async m ()
_ handle
_ DataFlow
dataFlow' -> do
                      let connState' :: ConnectionState peerAddr handle handleError version m
connState' = forall peerAddr handle handleError version (m :: * -> *).
ConnectionId peerAddr
-> Async m ()
-> handle
-> DataFlow
-> ConnectionState peerAddr handle handleError version m
InboundIdleState
                                         ConnectionId peerAddr
connId Async m ()
connThread handle
handle
                                         DataFlow
dataFlow'
                      forall (m :: * -> *) a.
MonadSTM m =>
StrictTVar m a -> a -> STM m ()
writeTVar StrictTVar
  m (ConnectionState peerAddr handle handleError version m)
connVar ConnectionState peerAddr handle handleError version m
connState'
                      forall (m :: * -> *) a. Monad m => a -> m a
return ( Bool
True
                             , forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall state. state -> state -> Transition state
mkTransition ConnectionState peerAddr handle handleError version m
connState ConnectionState peerAddr handle handleError version m
connState'
                             , Provenance
Outbound
                             )

                    InboundIdleState {} ->
                      forall (m :: * -> *) e a.
(MonadSTM m, MonadThrow (STM m), Exception e) =>
e -> STM m a
throwSTM (forall a. (?callStack::CallStack) => (CallStack -> a) -> a
withCallStack (forall peerAddr.
peerAddr -> CallStack -> ConnectionManagerError peerAddr
ImpossibleState peerAddr
peerAddr))

                    -- At this stage the inbound connection cannot be in
                    -- 'InboundState', it would mean that there was another thread
                    -- that included that connection, but this would violate @TCP@
                    -- constraints.
                    InboundState {} ->
                      forall (m :: * -> *) e a.
(MonadSTM m, MonadThrow (STM m), Exception e) =>
e -> STM m a
throwSTM (forall a. (?callStack::CallStack) => (CallStack -> a) -> a
withCallStack (forall peerAddr.
peerAddr -> CallStack -> ConnectionManagerError peerAddr
ImpossibleState peerAddr
peerAddr))

                    DuplexState {} ->
                      forall (m :: * -> *) e a.
(MonadSTM m, MonadThrow (STM m), Exception e) =>
e -> STM m a
throwSTM (forall a. (?callStack::CallStack) => (CallStack -> a) -> a
withCallStack (forall peerAddr.
peerAddr -> CallStack -> ConnectionManagerError peerAddr
ImpossibleState peerAddr
peerAddr))

                    TerminatingState {} -> forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
False, forall a. Maybe a
Nothing, Provenance
Inbound)

                    TerminatedState {} -> forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
False, forall a. Maybe a
Nothing, Provenance
Inbound)

                forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer
  m
  (TransitionTrace
     peerAddr (ConnectionState peerAddr handle handleError version m))
trTracer forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall peerAddr state.
peerAddr -> Transition' state -> TransitionTrace' peerAddr state
TransitionTrace peerAddr
peerAddr) Maybe
  (Transition'
     (MaybeUnknown
        (ConnectionState peerAddr handle handleError version m)))
mbTransition
                StrictTMVar
  m (ConnectionManagerState peerAddr handle handleError version m)
-> m ()
traceCounters StrictTMVar
  m (ConnectionManagerState peerAddr handle handleError version m)
stateVar

                -- Note that we don't set a timeout thread here which would
                -- perform:
                -- @
                --   Commit^{dataFlow}
                --     : InboundIdleState dataFlow
                --     → TerminatingState
                -- @
                -- This is not needed!  When we return from this call, the inbound
                -- protocol governor will monitor the connection.  Once it becomes
                -- idle, it will call 'unregisterInboundConnection' which will
                -- perform the aforementioned @Commit@ transition.

                if Bool
connected
                  then do
                    case InResponderMode
  muxMode (InformationChannel (NewConnectionInfo peerAddr handle) m)
inboundGovernorInfoChannel of
                      InResponderMode InformationChannel (NewConnectionInfo peerAddr handle) m
infoChannel ->
                        forall (m :: * -> *) a.
(MonadSTM m, ?callStack::CallStack) =>
STM m a -> m a
atomically forall a b. (a -> b) -> a -> b
$ forall a (m :: * -> *). InformationChannel a m -> a -> STM m ()
InfoChannel.writeMessage
                                       InformationChannel (NewConnectionInfo peerAddr handle) m
infoChannel
                                       (forall peerAddr handle.
Provenance
-> ConnectionId peerAddr
-> DataFlow
-> handle
-> NewConnectionInfo peerAddr handle
NewConnectionInfo Provenance
provenance ConnectionId peerAddr
connId DataFlow
dataFlow handle
handle)
                      InResponderMode
  muxMode (InformationChannel (NewConnectionInfo peerAddr handle) m)
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ()

                    let -- True iff the connection can be used by the outbound
                        -- governor.
                        notifyOutboundGov :: Bool
notifyOutboundGov =
                          case Provenance
provenance of
                            Provenance
Inbound  -> DataFlow
Duplex forall a. Eq a => a -> a -> Bool
== DataFlow
dataFlow
                            Provenance
Outbound -> Bool
False
                            -- The connection started as inbound but its
                            -- provenance was changed to outbound; this is only
                            -- possible if we are connecting to ourselves.  In
                            -- this case we don't need to notify the outbound
                            -- governor.
                    case InResponderMode
  muxMode (Maybe (InformationChannel (peerAddr, PeerSharing) m))
outboundGovernorInfoChannel of
                      InResponderMode (Just InformationChannel (peerAddr, PeerSharing) m
infoChannel) | Bool
notifyOutboundGov
                                                         ->
                        forall (m :: * -> *) a.
(MonadSTM m, ?callStack::CallStack) =>
STM m a -> m a
atomically forall a b. (a -> b) -> a -> b
$ forall a (m :: * -> *). InformationChannel a m -> a -> STM m ()
InfoChannel.writeMessage
                                       InformationChannel (peerAddr, PeerSharing) m
infoChannel
                                       (peerAddr
peerAddr, versionData -> PeerSharing
cmGetPeerSharing versionData
versionData)

                      InResponderMode
  muxMode (Maybe (InformationChannel (peerAddr, PeerSharing) m))
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ()

                    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall peerAddr handle handleError.
ConnectionId peerAddr
-> DataFlow -> handle -> Connected peerAddr handle handleError
Connected ConnectionId peerAddr
connId DataFlow
dataFlow handle
handle

                  -- the connection is in `TerminatingState` or
                  -- `TerminatedState`.
                  else
                    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall peerAddr handle handleError.
ConnectionId peerAddr
-> Maybe handleError -> Connected peerAddr handle handleError
Disconnected ConnectionId peerAddr
connId forall a. Maybe a
Nothing

    terminateInboundWithErrorOrQuery :: ConnectionId peerAddr
-> StrictTVar
     m (ConnectionState peerAddr handle handleError version m)
-> Async m ()
-> peerAddr
-> StrictTMVar
     m (ConnectionManagerState peerAddr handle handleError version m)
-> MutableConnState peerAddr handle handleError version m
-> Maybe handleError
-> m (Connected peerAddr handle handleError)
terminateInboundWithErrorOrQuery ConnectionId peerAddr
connId StrictTVar
  m (ConnectionState peerAddr handle handleError version m)
connVar Async m ()
connThread peerAddr
peerAddr StrictTMVar
  m (ConnectionManagerState peerAddr handle handleError version m)
stateVar MutableConnState peerAddr handle handleError version m
mutableConnState Maybe handleError
handleErrorM = do
        [Transition'
   (MaybeUnknown
      (ConnectionState peerAddr handle handleError version m))]
transitions <- forall (m :: * -> *) a.
(MonadSTM m, ?callStack::CallStack) =>
STM m a -> m a
atomically forall a b. (a -> b) -> a -> b
$ do
          ConnectionState peerAddr handle handleError version m
connState <- forall (m :: * -> *) a. MonadSTM m => StrictTVar m a -> STM m a
readTVar StrictTVar
  m (ConnectionState peerAddr handle handleError version m)
connVar

          let connState' :: ConnectionState peerAddr handle handleError version m
connState' =
                case handleError -> HandleErrorType
classifyHandleError forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe handleError
handleErrorM of
                  Just HandleErrorType
HandshakeFailure ->
                    forall peerAddr handle handleError version (m :: * -> *).
ConnectionId peerAddr
-> Async m ()
-> Maybe handleError
-> ConnectionState peerAddr handle handleError version m
TerminatingState ConnectionId peerAddr
connId Async m ()
connThread
                                    Maybe handleError
handleErrorM
                  Just HandleErrorType
HandshakeProtocolViolation ->
                    forall peerAddr handle handleError version (m :: * -> *).
Maybe handleError
-> ConnectionState peerAddr handle handleError version m
TerminatedState Maybe handleError
handleErrorM
                  -- On inbound query, connection is terminating.
                  Maybe HandleErrorType
Nothing ->
                    forall peerAddr handle handleError version (m :: * -> *).
ConnectionId peerAddr
-> Async m ()
-> Maybe handleError
-> ConnectionState peerAddr handle handleError version m
TerminatingState ConnectionId peerAddr
connId Async m ()
connThread
                                    Maybe handleError
handleErrorM
              transition :: Transition'
  (MaybeUnknown
     (ConnectionState peerAddr handle handleError version m))
transition = forall state. state -> state -> Transition state
mkTransition ConnectionState peerAddr handle handleError version m
connState ConnectionState peerAddr handle handleError version m
connState'
              absConnState :: AbstractState
absConnState = forall muxMode peerAddr m a (b :: * -> *).
MaybeUnknown (ConnectionState muxMode peerAddr m a b)
-> AbstractState
abstractState (forall state. state -> MaybeUnknown state
Known ConnectionState peerAddr handle handleError version m
connState)
              shouldTrace :: Bool
shouldTrace = AbstractState
absConnState forall a. Eq a => a -> a -> Bool
/= AbstractState
TerminatedSt

          Bool
updated <-
            forall (m :: * -> *) a b.
MonadSTM m =>
StrictTMVar m a -> (a -> STM m (a, b)) -> STM m b
modifyTMVarSTM
              StrictTMVar
  m (ConnectionManagerState peerAddr handle handleError version m)
stateVar
              ( \ConnectionManagerState peerAddr handle handleError version m
state ->
                case forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup peerAddr
peerAddr ConnectionManagerState peerAddr handle handleError version m
state of
                  Maybe (MutableConnState peerAddr handle handleError version m)
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return (ConnectionManagerState peerAddr handle handleError version m
state, Bool
False)
                  Just MutableConnState peerAddr handle handleError version m
mutableConnState'  ->
                    if MutableConnState peerAddr handle handleError version m
mutableConnState' forall a. Eq a => a -> a -> Bool
== MutableConnState peerAddr handle handleError version m
mutableConnState
                      then do
                        -- 'handleError' might be either a handshake
                        -- negotiation a protocol failure (an IO
                        -- exception, a timeout or codec failure).  In
                        -- the first case we should not reset the
                        -- connection as this is not a protocol error.
                        --
                        -- If we are deleting the connState from the
                        -- state then connState' can be TerminatingSt in
                        -- which case we are going to transition
                        -- TerminatingSt -> TerminatedSt. Otherwise,
                        -- Connection Manager cleanup will take care of
                        -- tracing accordingly.
                        forall (m :: * -> *) a.
MonadSTM m =>
StrictTVar m a -> a -> STM m ()
writeTVar StrictTVar
  m (ConnectionState peerAddr handle handleError version m)
connVar ConnectionState peerAddr handle handleError version m
connState'

                        forall (m :: * -> *) a. Monad m => a -> m a
return (forall k a. Ord k => k -> Map k a -> Map k a
Map.delete peerAddr
peerAddr ConnectionManagerState peerAddr handle handleError version m
state , Bool
True)
                      else forall (m :: * -> *) a. Monad m => a -> m a
return (ConnectionManagerState peerAddr handle handleError version m
state                  , Bool
False)
              )

          if Bool
updated
             then
            -- Key was present in the dictionary (stateVar) and
            -- removed so we trace the removal.
              forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
                if Bool
shouldTrace
                   then [ Transition'
  (MaybeUnknown
     (ConnectionState peerAddr handle handleError version m))
transition
                        , Transition
                           { fromState :: MaybeUnknown
  (ConnectionState peerAddr handle handleError version m)
fromState = forall state. state -> MaybeUnknown state
Known (forall peerAddr handle handleError version (m :: * -> *).
Maybe handleError
-> ConnectionState peerAddr handle handleError version m
TerminatedState forall a. Maybe a
Nothing)
                           , toState :: MaybeUnknown
  (ConnectionState peerAddr handle handleError version m)
toState   = forall state. MaybeUnknown state
Unknown
                           }
                        ]
                   else [ Transition
                           { fromState :: MaybeUnknown
  (ConnectionState peerAddr handle handleError version m)
fromState = forall state. state -> MaybeUnknown state
Known (forall peerAddr handle handleError version (m :: * -> *).
Maybe handleError
-> ConnectionState peerAddr handle handleError version m
TerminatedState forall a. Maybe a
Nothing)
                           , toState :: MaybeUnknown
  (ConnectionState peerAddr handle handleError version m)
toState   = forall state. MaybeUnknown state
Unknown
                           }
                        ]
            -- Key was not present in the dictionary (stateVar),
            -- so we do not trace anything as it was already traced upon
            -- deletion.
            --
            -- OR
            --
            -- Key was overwritten in the dictionary (stateVar),
            -- so we do not trace anything as it was already traced upon
            -- overwriting.
             else forall (m :: * -> *) a. Monad m => a -> m a
return [ ]

        forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer
  m
  (TransitionTrace
     peerAddr (ConnectionState peerAddr handle handleError version m))
trTracer forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall peerAddr state.
peerAddr -> Transition' state -> TransitionTrace' peerAddr state
TransitionTrace peerAddr
peerAddr) [Transition'
   (MaybeUnknown
      (ConnectionState peerAddr handle handleError version m))]
transitions
        StrictTMVar
  m (ConnectionManagerState peerAddr handle handleError version m)
-> m ()
traceCounters StrictTMVar
  m (ConnectionManagerState peerAddr handle handleError version m)
stateVar

        forall (m :: * -> *) a. Monad m => a -> m a
return (forall peerAddr handle handleError.
ConnectionId peerAddr
-> Maybe handleError -> Connected peerAddr handle handleError
Disconnected ConnectionId peerAddr
connId Maybe handleError
handleErrorM)

    -- We need 'mask' in order to guarantee that the traces are logged if an
    -- async exception lands between the successful STM action and the logging
    -- action.
    unregisterInboundConnectionImpl
        :: StrictTMVar m (ConnectionManagerState peerAddr handle handleError version m)
        -> peerAddr
        -> m (OperationResult DemotedToColdRemoteTr)
    unregisterInboundConnectionImpl :: StrictTMVar
  m (ConnectionManagerState peerAddr handle handleError version m)
-> peerAddr -> m (OperationResult DemotedToColdRemoteTr)
unregisterInboundConnectionImpl StrictTMVar
  m (ConnectionManagerState peerAddr handle handleError version m)
stateVar peerAddr
peerAddr = forall (m :: * -> *) a. MonadMask m => m a -> m a
mask_ forall a b. (a -> b) -> a -> b
$ do
      forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer m (ConnectionManagerTrace peerAddr handlerTrace)
tracer (forall peerAddr handlerTrace.
Provenance
-> peerAddr -> ConnectionManagerTrace peerAddr handlerTrace
TrUnregisterConnection Provenance
Inbound peerAddr
peerAddr)
      (Maybe (Async m ())
mbThread, Maybe
  (Transition'
     (MaybeUnknown
        (ConnectionState peerAddr handle handleError version m)))
mbTransition, OperationResult DemotedToColdRemoteTr
result, Maybe (ConnectionManagerTrace peerAddr handlerTrace)
mbAssertion) <- forall (m :: * -> *) a.
(MonadSTM m, ?callStack::CallStack) =>
STM m a -> m a
atomically forall a b. (a -> b) -> a -> b
$ do
        ConnectionManagerState peerAddr handle handleError version m
state <- forall (m :: * -> *) a. MonadSTM m => StrictTMVar m a -> STM m a
readTMVar StrictTMVar
  m (ConnectionManagerState peerAddr handle handleError version m)
stateVar
        case forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup peerAddr
peerAddr ConnectionManagerState peerAddr handle handleError version m
state of
          Maybe (MutableConnState peerAddr handle handleError version m)
Nothing -> do
            -- Note: this can happen if the inbound connection manager is
            -- notified late about the connection which has already terminated
            -- at this point.
            forall (f :: * -> *) a. Applicative f => a -> f a
pure ( forall a. Maybe a
Nothing
                 , forall a. Maybe a
Nothing
                 , forall a. a -> OperationResult a
OperationSuccess DemotedToColdRemoteTr
CommitTr
                 , forall a. Maybe a
Nothing
                 )
          Just MutableConnState { StrictTVar
  m (ConnectionState peerAddr handle handleError version m)
connVar :: StrictTVar
  m (ConnectionState peerAddr handle handleError version m)
connVar :: forall peerAddr handle handleError version (m :: * -> *).
MutableConnState peerAddr handle handleError version m
-> StrictTVar
     m (ConnectionState peerAddr handle handleError version m)
connVar } -> do
            ConnectionState peerAddr handle handleError version m
connState <- forall (m :: * -> *) a. MonadSTM m => StrictTVar m a -> STM m a
readTVar StrictTVar
  m (ConnectionState peerAddr handle handleError version m)
connVar
            let st :: AbstractState
st = forall muxMode peerAddr m a (b :: * -> *).
MaybeUnknown (ConnectionState muxMode peerAddr m a b)
-> AbstractState
abstractState (forall state. state -> MaybeUnknown state
Known ConnectionState peerAddr handle handleError version m
connState)
            case ConnectionState peerAddr handle handleError version m
connState of
              -- In any of the following two states unregistering is not
              -- supported.  'includeInboundConnection' is a synchronous
              -- operation which returns only once the connection is
              -- negotiated.
              ConnectionState peerAddr handle handleError version m
ReservedOutboundState ->
                forall (m :: * -> *) a. Monad m => a -> m a
return ( forall a. Maybe a
Nothing
                       , forall a. Maybe a
Nothing
                       , forall a. AbstractState -> OperationResult a
UnsupportedState AbstractState
st
                       , forall a. Maybe a
Nothing
                       )
              UnnegotiatedState Provenance
_ ConnectionId peerAddr
_ Async m ()
_ ->
                forall (m :: * -> *) a. Monad m => a -> m a
return ( forall a. Maybe a
Nothing
                       , forall a. Maybe a
Nothing
                       , forall a. AbstractState -> OperationResult a
UnsupportedState AbstractState
st
                       , forall a. Maybe a
Nothing
                       )

              -- @
              --   TimeoutExpired : OutboundState^\tau Duplex
              --                  → OutboundState      Duplex
              -- @
              OutboundDupState ConnectionId peerAddr
connId Async m ()
connThread handle
handle TimeoutExpired
Ticking -> do
                let connState' :: ConnectionState peerAddr handle handleError version m
connState' = forall peerAddr handle handleError version (m :: * -> *).
ConnectionId peerAddr
-> Async m ()
-> handle
-> TimeoutExpired
-> ConnectionState peerAddr handle handleError version m
OutboundDupState ConnectionId peerAddr
connId Async m ()
connThread handle
handle TimeoutExpired
Expired
                forall (m :: * -> *) a.
MonadSTM m =>
StrictTVar m a -> a -> STM m ()
writeTVar StrictTVar
  m (ConnectionState peerAddr handle handleError version m)
connVar ConnectionState peerAddr handle handleError version m
connState'
                forall (m :: * -> *) a. Monad m => a -> m a
return ( forall a. Maybe a
Nothing
                       , forall a. a -> Maybe a
Just (forall state. state -> state -> Transition state
mkTransition ConnectionState peerAddr handle handleError version m
connState ConnectionState peerAddr handle handleError version m
connState')
                       , forall a. a -> OperationResult a
OperationSuccess DemotedToColdRemoteTr
KeepTr
                       , forall a. Maybe a
Nothing
                       )
              OutboundDupState ConnectionId peerAddr
connId Async m ()
_connThread handle
_handle TimeoutExpired
Expired ->
                forall a. (?callStack::CallStack) => Bool -> a -> a
assert Bool
False forall a b. (a -> b) -> a -> b
$
                forall (m :: * -> *) a. Monad m => a -> m a
return ( forall a. Maybe a
Nothing
                       , forall a. Maybe a
Nothing
                       , forall a. a -> OperationResult a
OperationSuccess DemotedToColdRemoteTr
KeepTr
                       , forall a. a -> Maybe a
Just (forall peerAddr handlerTrace.
AssertionLocation peerAddr
-> ConnectionManagerTrace peerAddr handlerTrace
CM.TrUnexpectedlyFalseAssertion
                                 (forall peerAddr.
Maybe (ConnectionId peerAddr)
-> AbstractState -> AssertionLocation peerAddr
UnregisterInboundConnection (forall a. a -> Maybe a
Just ConnectionId peerAddr
connId)
                                                              AbstractState
st)
                                 )
                       )

              OutboundUniState ConnectionId peerAddr
_connId Async m ()
_connThread handle
_handle ->
                forall (m :: * -> *) a. Monad m => a -> m a
return ( forall a. Maybe a
Nothing
                       , forall a. Maybe a
Nothing
                       , forall a. AbstractState -> OperationResult a
UnsupportedState AbstractState
st
                       , forall a. Maybe a
Nothing
                       )

              -- unexpected state, this state is reachable only from outbound
              -- states
              OutboundIdleState ConnectionId peerAddr
connId Async m ()
_connThread handle
_handle DataFlow
_dataFlow ->
                forall (m :: * -> *) a. Monad m => a -> m a
return ( forall a. Maybe a
Nothing
                       , forall a. Maybe a
Nothing
                       , forall a. a -> OperationResult a
OperationSuccess DemotedToColdRemoteTr
CommitTr
                       , forall a. a -> Maybe a
Just (forall peerAddr handlerTrace.
AssertionLocation peerAddr
-> ConnectionManagerTrace peerAddr handlerTrace
CM.TrUnexpectedlyFalseAssertion
                                 (forall peerAddr.
Maybe (ConnectionId peerAddr)
-> AbstractState -> AssertionLocation peerAddr
UnregisterInboundConnection (forall a. a -> Maybe a
Just ConnectionId peerAddr
connId)
                                                              AbstractState
st)
                                 )
                       )

              -- @
              --   Commit^{dataFlow} : InboundIdleState dataFlow
              --                     → TerminatingState
              -- @
              --
              -- Note: the 'TrDemotedToColdRemote' is logged by the server.
              InboundIdleState ConnectionId peerAddr
connId Async m ()
connThread handle
_handle DataFlow
_dataFlow -> do
                let connState' :: ConnectionState peerAddr handle handleError version m
connState' = forall peerAddr handle handleError version (m :: * -> *).
ConnectionId peerAddr
-> Async m ()
-> Maybe handleError
-> ConnectionState peerAddr handle handleError version m
TerminatingState ConnectionId peerAddr
connId Async m ()
connThread forall a. Maybe a
Nothing
                forall (m :: * -> *) a.
MonadSTM m =>
StrictTVar m a -> a -> STM m ()
writeTVar StrictTVar
  m (ConnectionState peerAddr handle handleError version m)
connVar ConnectionState peerAddr handle handleError version m
connState'
                forall (m :: * -> *) a. Monad m => a -> m a
return ( forall a. a -> Maybe a
Just Async m ()
connThread
                       , forall a. a -> Maybe a
Just (forall state. state -> state -> Transition state
mkTransition ConnectionState peerAddr handle handleError version m
connState ConnectionState peerAddr handle handleError version m
connState')
                       , forall a. a -> OperationResult a
OperationSuccess DemotedToColdRemoteTr
CommitTr
                       , forall a. Maybe a
Nothing
                       )

              -- the inbound protocol governor was supposed to call
              -- 'demotedToColdRemote' first.
              InboundState ConnectionId peerAddr
connId Async m ()
connThread handle
_handle DataFlow
_dataFlow -> do
                let connState' :: ConnectionState peerAddr handle handleError version m
connState' = forall peerAddr handle handleError version (m :: * -> *).
ConnectionId peerAddr
-> Async m ()
-> Maybe handleError
-> ConnectionState peerAddr handle handleError version m
TerminatingState ConnectionId peerAddr
connId Async m ()
connThread forall a. Maybe a
Nothing
                forall (m :: * -> *) a.
MonadSTM m =>
StrictTVar m a -> a -> STM m ()
writeTVar StrictTVar
  m (ConnectionState peerAddr handle handleError version m)
connVar ConnectionState peerAddr handle handleError version m
connState'
                forall (m :: * -> *) a. Monad m => a -> m a
return ( forall a. a -> Maybe a
Just Async m ()
connThread
                       , forall a. a -> Maybe a
Just (forall state. state -> state -> Transition state
mkTransition ConnectionState peerAddr handle handleError version m
connState ConnectionState peerAddr handle handleError version m
connState')
                       , forall a. AbstractState -> OperationResult a
UnsupportedState AbstractState
st
                       , forall a. a -> Maybe a
Just (forall peerAddr handlerTrace.
AssertionLocation peerAddr
-> ConnectionManagerTrace peerAddr handlerTrace
CM.TrUnexpectedlyFalseAssertion
                                 (forall peerAddr.
Maybe (ConnectionId peerAddr)
-> AbstractState -> AssertionLocation peerAddr
UnregisterInboundConnection (forall a. a -> Maybe a
Just ConnectionId peerAddr
connId)
                                                              AbstractState
st)
                                 )
                       )

              -- the inbound connection governor ought to call
              -- 'demotedToColdRemote' first.
              DuplexState ConnectionId peerAddr
connId Async m ()
connThread handle
handle -> do
                let connState' :: ConnectionState peerAddr handle handleError version m
connState' = forall peerAddr handle handleError version (m :: * -> *).
ConnectionId peerAddr
-> Async m ()
-> handle
-> TimeoutExpired
-> ConnectionState peerAddr handle handleError version m
OutboundDupState ConnectionId peerAddr
connId Async m ()
connThread handle
handle TimeoutExpired
Ticking
                forall (m :: * -> *) a.
MonadSTM m =>
StrictTVar m a -> a -> STM m ()
writeTVar StrictTVar
  m (ConnectionState peerAddr handle handleError version m)
connVar ConnectionState peerAddr handle handleError version m
connState'
                forall (m :: * -> *) a. Monad m => a -> m a
return ( forall a. Maybe a
Nothing
                       , forall a. a -> Maybe a
Just (forall state. state -> state -> Transition state
mkTransition ConnectionState peerAddr handle handleError version m
connState ConnectionState peerAddr handle handleError version m
connState')
                       , forall a. AbstractState -> OperationResult a
UnsupportedState AbstractState
st
                       , forall a. a -> Maybe a
Just (forall peerAddr handlerTrace.
AssertionLocation peerAddr
-> ConnectionManagerTrace peerAddr handlerTrace
CM.TrUnexpectedlyFalseAssertion
                                 (forall peerAddr.
Maybe (ConnectionId peerAddr)
-> AbstractState -> AssertionLocation peerAddr
UnregisterInboundConnection (forall a. a -> Maybe a
Just ConnectionId peerAddr
connId)
                                                              AbstractState
st)
                                 )
                       )

              -- If 'unregisterOutboundConnection' is called just before
              -- 'unregisterInboundConnection', the latter one might observe
              -- 'TerminatingState'.
              TerminatingState ConnectionId peerAddr
_connId Async m ()
_connThread Maybe handleError
_handleError ->
                forall (m :: * -> *) a. Monad m => a -> m a
return ( forall a. Maybe a
Nothing
                       , forall a. Maybe a
Nothing
                       , forall a. a -> OperationResult a
OperationSuccess DemotedToColdRemoteTr
CommitTr
                       , forall a. Maybe a
Nothing
                       )
              -- However, 'TerminatedState' should not be observable by
              -- 'unregisterInboundConnection', unless 'cmTimeWaitTimeout' is
              -- close to 'serverProtocolIdleTimeout'.
              TerminatedState Maybe handleError
_handleError ->
                forall (m :: * -> *) a. Monad m => a -> m a
return ( forall a. Maybe a
Nothing
                       , forall a. Maybe a
Nothing
                       , forall a. AbstractState -> OperationResult a
UnsupportedState AbstractState
TerminatedSt
                       , forall a. Maybe a
Nothing
                       )

      forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer
  m
  (TransitionTrace
     peerAddr (ConnectionState peerAddr handle handleError version m))
trTracer forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall peerAddr state.
peerAddr -> Transition' state -> TransitionTrace' peerAddr state
TransitionTrace peerAddr
peerAddr) Maybe
  (Transition'
     (MaybeUnknown
        (ConnectionState peerAddr handle handleError version m)))
mbTransition
      StrictTMVar
  m (ConnectionManagerState peerAddr handle handleError version m)
-> m ()
traceCounters StrictTMVar
  m (ConnectionManagerState peerAddr handle handleError version m)
stateVar

      -- 'throwTo' avoids blocking until 'cmTimeWaitTimeout' expires.
      forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (m :: * -> *) e.
(MonadFork m, Exception e) =>
ThreadId m -> e -> m ()
throwTo AsyncCancelled
AsyncCancelled forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. MonadAsync m => Async m a -> ThreadId m
asyncThreadId)
                Maybe (Async m ())
mbThread

      forall (m :: * -> *) a.
Applicative m =>
Maybe a -> (a -> m ()) -> m ()
whenJust Maybe (ConnectionManagerTrace peerAddr handlerTrace)
mbAssertion forall a b. (a -> b) -> a -> b
$ \ConnectionManagerTrace peerAddr handlerTrace
tr -> do
        forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer m (ConnectionManagerTrace peerAddr handlerTrace)
tracer ConnectionManagerTrace peerAddr handlerTrace
tr
        Any -> Any
_ <- forall (m :: * -> *) a. MonadEvaluate m => a -> m a
evaluate (forall a. (?callStack::CallStack) => Bool -> a -> a
assert Bool
False)
        forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

      forall (m :: * -> *) a. Monad m => a -> m a
return OperationResult DemotedToColdRemoteTr
result

    requestOutboundConnectionImpl
        :: HasCallStack
        => FreshIdSupply m
        -> StrictTMVar m (ConnectionManagerState peerAddr handle handleError version m)
        -> ConnectionHandlerFn handlerTrace socket peerAddr handle handleError (version, versionData) m
        -> peerAddr
        -> m (Connected peerAddr handle handleError)
    requestOutboundConnectionImpl :: (?callStack::CallStack) =>
FreshIdSupply m
-> StrictTMVar
     m (ConnectionManagerState peerAddr handle handleError version m)
-> ConnectionHandlerFn
     handlerTrace
     socket
     peerAddr
     handle
     handleError
     (version, versionData)
     m
-> RequestOutboundConnection peerAddr handle handleError m
requestOutboundConnectionImpl FreshIdSupply m
freshIdSupply StrictTMVar
  m (ConnectionManagerState peerAddr handle handleError version m)
stateVar ConnectionHandlerFn
  handlerTrace
  socket
  peerAddr
  handle
  handleError
  (version, versionData)
  m
handler peerAddr
peerAddr = do
        let provenance :: Provenance
provenance = Provenance
Outbound
        forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer m (ConnectionManagerTrace peerAddr handlerTrace)
tracer (forall peerAddr handlerTrace.
Provenance
-> peerAddr -> ConnectionManagerTrace peerAddr handlerTrace
TrIncludeConnection Provenance
provenance peerAddr
peerAddr)
        (Maybe
  (Either
     (TransitionTrace
        peerAddr (ConnectionState peerAddr handle handleError version m))
     (ConnectionManagerTrace peerAddr handlerTrace))
trace, mutableConnState :: MutableConnState peerAddr handle handleError version m
mutableConnState@MutableConnState { StrictTVar
  m (ConnectionState peerAddr handle handleError version m)
connVar :: StrictTVar
  m (ConnectionState peerAddr handle handleError version m)
connVar :: forall peerAddr handle handleError version (m :: * -> *).
MutableConnState peerAddr handle handleError version m
-> StrictTVar
     m (ConnectionState peerAddr handle handleError version m)
connVar }
              , Either
  (ConnectionManagerError peerAddr)
  (Wedge
     (Connected peerAddr handle handleError) (ConnectionId peerAddr))
eHandleWedge) <- forall (m :: * -> *) a.
(MonadSTM m, ?callStack::CallStack) =>
STM m a -> m a
atomically forall a b. (a -> b) -> a -> b
$ do
          ConnectionManagerState peerAddr handle handleError version m
state <- forall (m :: * -> *) a. MonadSTM m => StrictTMVar m a -> STM m a
readTMVar StrictTMVar
  m (ConnectionManagerState peerAddr handle handleError version m)
stateVar
          case forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup peerAddr
peerAddr ConnectionManagerState peerAddr handle handleError version m
state of
            Just mutableConnState :: MutableConnState peerAddr handle handleError version m
mutableConnState@MutableConnState { StrictTVar
  m (ConnectionState peerAddr handle handleError version m)
connVar :: StrictTVar
  m (ConnectionState peerAddr handle handleError version m)
connVar :: forall peerAddr handle handleError version (m :: * -> *).
MutableConnState peerAddr handle handleError version m
-> StrictTVar
     m (ConnectionState peerAddr handle handleError version m)
connVar } -> do
              ConnectionState peerAddr handle handleError version m
connState <- forall (m :: * -> *) a. MonadSTM m => StrictTVar m a -> STM m a
readTVar StrictTVar
  m (ConnectionState peerAddr handle handleError version m)
connVar
              let st :: AbstractState
st = forall muxMode peerAddr m a (b :: * -> *).
MaybeUnknown (ConnectionState muxMode peerAddr m a b)
-> AbstractState
abstractState (forall state. state -> MaybeUnknown state
Known ConnectionState peerAddr handle handleError version m
connState)
              case ConnectionState peerAddr handle handleError version m
connState of
                ConnectionState peerAddr handle handleError version m
ReservedOutboundState ->
                  forall (m :: * -> *) a. Monad m => a -> m a
return ( forall a. a -> Maybe a
Just (forall a b. b -> Either a b
Right (forall peerAddr handlerTrace.
Provenance
-> peerAddr
-> AbstractState
-> ConnectionManagerTrace peerAddr handlerTrace
TrConnectionExists Provenance
provenance peerAddr
peerAddr AbstractState
st))
                         , MutableConnState peerAddr handle handleError version m
mutableConnState
                         , forall a b. a -> Either a b
Left (forall a. (?callStack::CallStack) => (CallStack -> a) -> a
withCallStack
                                  (forall peerAddr.
Provenance
-> peerAddr -> CallStack -> ConnectionManagerError peerAddr
ConnectionExists Provenance
provenance peerAddr
peerAddr))
                         )

                UnnegotiatedState Provenance
Outbound ConnectionId peerAddr
_connId Async m ()
_connThread -> do
                  forall (m :: * -> *) a. Monad m => a -> m a
return ( forall a. a -> Maybe a
Just (forall a b. b -> Either a b
Right (forall peerAddr handlerTrace.
Provenance
-> peerAddr
-> AbstractState
-> ConnectionManagerTrace peerAddr handlerTrace
TrConnectionExists Provenance
provenance peerAddr
peerAddr AbstractState
st))
                         , MutableConnState peerAddr handle handleError version m
mutableConnState
                         , forall a b. a -> Either a b
Left (forall a. (?callStack::CallStack) => (CallStack -> a) -> a
withCallStack
                                  (forall peerAddr.
Provenance
-> peerAddr -> CallStack -> ConnectionManagerError peerAddr
ConnectionExists Provenance
provenance peerAddr
peerAddr))
                         )

                UnnegotiatedState Provenance
Inbound ConnectionId peerAddr
connId Async m ()
_connThread ->
                  -- we must not block inside @modifyTVar stateVar@, we
                  -- return 'There' to indicate that we need to block on
                  -- the connection state.
                  forall (m :: * -> *) a. Monad m => a -> m a
return ( forall a. Maybe a
Nothing
                         , MutableConnState peerAddr handle handleError version m
mutableConnState
                         , forall a b. b -> Either a b
Right (forall a b. b -> Wedge a b
There ConnectionId peerAddr
connId)
                         )

                OutboundUniState {} -> do
                  forall (m :: * -> *) a. Monad m => a -> m a
return ( forall a. a -> Maybe a
Just (forall a b. b -> Either a b
Right (forall peerAddr handlerTrace.
Provenance
-> peerAddr
-> AbstractState
-> ConnectionManagerTrace peerAddr handlerTrace
TrConnectionExists Provenance
provenance peerAddr
peerAddr AbstractState
st))
                         , MutableConnState peerAddr handle handleError version m
mutableConnState
                         , forall a b. a -> Either a b
Left (forall a. (?callStack::CallStack) => (CallStack -> a) -> a
withCallStack
                                  (forall peerAddr.
Provenance
-> peerAddr -> CallStack -> ConnectionManagerError peerAddr
ConnectionExists Provenance
provenance peerAddr
peerAddr))
                         )

                OutboundDupState {} -> do
                  forall (m :: * -> *) a. Monad m => a -> m a
return ( forall a. a -> Maybe a
Just (forall a b. b -> Either a b
Right (forall peerAddr handlerTrace.
Provenance
-> peerAddr
-> AbstractState
-> ConnectionManagerTrace peerAddr handlerTrace
TrConnectionExists Provenance
provenance peerAddr
peerAddr AbstractState
st))
                         , MutableConnState peerAddr handle handleError version m
mutableConnState
                         , forall a b. a -> Either a b
Left (forall a. (?callStack::CallStack) => (CallStack -> a) -> a
withCallStack
                                  (forall peerAddr.
Provenance
-> peerAddr -> CallStack -> ConnectionManagerError peerAddr
ConnectionExists Provenance
provenance peerAddr
peerAddr))
                         )

                OutboundIdleState ConnectionId peerAddr
_connId Async m ()
_connThread handle
_handle DataFlow
_dataFlow ->
                  let tr :: AbstractState
tr = forall muxMode peerAddr m a (b :: * -> *).
MaybeUnknown (ConnectionState muxMode peerAddr m a b)
-> AbstractState
abstractState (forall state. state -> MaybeUnknown state
Known ConnectionState peerAddr handle handleError version m
connState) in
                  forall (m :: * -> *) a. Monad m => a -> m a
return ( forall a. a -> Maybe a
Just (forall a b. b -> Either a b
Right (forall peerAddr handlerTrace.
peerAddr
-> AbstractState -> ConnectionManagerTrace peerAddr handlerTrace
TrForbiddenOperation peerAddr
peerAddr AbstractState
tr))
                         , MutableConnState peerAddr handle handleError version m
mutableConnState
                         , forall a b. a -> Either a b
Left (forall a. (?callStack::CallStack) => (CallStack -> a) -> a
withCallStack (forall peerAddr.
peerAddr
-> AbstractState -> CallStack -> ConnectionManagerError peerAddr
ForbiddenOperation peerAddr
peerAddr AbstractState
tr))
                         )

                InboundIdleState ConnectionId peerAddr
connId Async m ()
_connThread handle
_handle DataFlow
Unidirectional -> do
                  forall (m :: * -> *) a. Monad m => a -> m a
return ( forall a. a -> Maybe a
Just (forall a b. b -> Either a b
Right (forall peerAddr handlerTrace.
ConnectionId peerAddr
-> ConnectionManagerTrace peerAddr handlerTrace
TrForbiddenConnection ConnectionId peerAddr
connId))
                         , MutableConnState peerAddr handle handleError version m
mutableConnState
                         , forall a b. a -> Either a b
Left (forall a. (?callStack::CallStack) => (CallStack -> a) -> a
withCallStack
                                  (forall peerAddr.
ConnectionId peerAddr
-> CallStack -> ConnectionManagerError peerAddr
ForbiddenConnection ConnectionId peerAddr
connId))
                         )

                InboundIdleState ConnectionId peerAddr
connId Async m ()
connThread handle
handle dataFlow :: DataFlow
dataFlow@DataFlow
Duplex -> do
                  -- @
                  --   Awake^{Duplex}_{Local} : InboundIdleState Duplex
                  --                          → OutboundState^\tau Duplex
                  -- @
                  let connState' :: ConnectionState peerAddr handle handleError version m
connState' = forall peerAddr handle handleError version (m :: * -> *).
ConnectionId peerAddr
-> Async m ()
-> handle
-> TimeoutExpired
-> ConnectionState peerAddr handle handleError version m
OutboundDupState ConnectionId peerAddr
connId Async m ()
connThread handle
handle TimeoutExpired
Ticking
                  forall (m :: * -> *) a.
MonadSTM m =>
StrictTVar m a -> a -> STM m ()
writeTVar StrictTVar
  m (ConnectionState peerAddr handle handleError version m)
connVar ConnectionState peerAddr handle handleError version m
connState'
                  forall (m :: * -> *) a. Monad m => a -> m a
return ( forall a. a -> Maybe a
Just (forall a b. a -> Either a b
Left (forall peerAddr state.
peerAddr -> Transition' state -> TransitionTrace' peerAddr state
TransitionTrace
                                         peerAddr
peerAddr
                                         (forall state. state -> state -> Transition state
mkTransition ConnectionState peerAddr handle handleError version m
connState ConnectionState peerAddr handle handleError version m
connState')))
                         , MutableConnState peerAddr handle handleError version m
mutableConnState
                         , forall a b. b -> Either a b
Right (forall a b. a -> Wedge a b
Here (forall peerAddr handle handleError.
ConnectionId peerAddr
-> DataFlow -> handle -> Connected peerAddr handle handleError
Connected ConnectionId peerAddr
connId DataFlow
dataFlow handle
handle))
                         )

                InboundState ConnectionId peerAddr
connId Async m ()
_connThread handle
_handle DataFlow
Unidirectional -> do
                  -- the remote side negotiated unidirectional connection, we
                  -- cannot re-use it.
                  forall (m :: * -> *) a. Monad m => a -> m a
return ( forall a. a -> Maybe a
Just (forall a b. b -> Either a b
Right (forall peerAddr handlerTrace.
ConnectionId peerAddr
-> ConnectionManagerTrace peerAddr handlerTrace
TrForbiddenConnection ConnectionId peerAddr
connId))
                         , MutableConnState peerAddr handle handleError version m
mutableConnState
                         , forall a b. a -> Either a b
Left (forall a. (?callStack::CallStack) => (CallStack -> a) -> a
withCallStack
                                  (forall peerAddr.
ConnectionId peerAddr
-> CallStack -> ConnectionManagerError peerAddr
ForbiddenConnection ConnectionId peerAddr
connId))
                         )

                InboundState ConnectionId peerAddr
connId Async m ()
connThread handle
handle dataFlow :: DataFlow
dataFlow@DataFlow
Duplex -> do
                  -- @
                  --   PromotedToWarm^{Duplex}_{Local} : InboundState Duplex
                  --                                   → DuplexState
                  -- @
                  let connState' :: ConnectionState peerAddr handle handleError version m
connState' = forall peerAddr handle handleError version (m :: * -> *).
ConnectionId peerAddr
-> Async m ()
-> handle
-> ConnectionState peerAddr handle handleError version m
DuplexState ConnectionId peerAddr
connId Async m ()
connThread handle
handle
                  forall (m :: * -> *) a.
MonadSTM m =>
StrictTVar m a -> a -> STM m ()
writeTVar StrictTVar
  m (ConnectionState peerAddr handle handleError version m)
connVar ConnectionState peerAddr handle handleError version m
connState'
                  forall (m :: * -> *) a. Monad m => a -> m a
return ( forall a. a -> Maybe a
Just (forall a b. a -> Either a b
Left (forall peerAddr state.
peerAddr -> Transition' state -> TransitionTrace' peerAddr state
TransitionTrace
                                        peerAddr
peerAddr
                                        (forall state. state -> state -> Transition state
mkTransition ConnectionState peerAddr handle handleError version m
connState ConnectionState peerAddr handle handleError version m
connState')))
                         , MutableConnState peerAddr handle handleError version m
mutableConnState
                         , forall a b. b -> Either a b
Right (forall a b. a -> Wedge a b
Here (forall peerAddr handle handleError.
ConnectionId peerAddr
-> DataFlow -> handle -> Connected peerAddr handle handleError
Connected ConnectionId peerAddr
connId DataFlow
dataFlow handle
handle))
                         )

                DuplexState ConnectionId peerAddr
_connId Async m ()
_connThread  handle
_handle ->
                  forall (m :: * -> *) a. Monad m => a -> m a
return ( forall a. a -> Maybe a
Just (forall a b. b -> Either a b
Right (forall peerAddr handlerTrace.
Provenance
-> peerAddr
-> AbstractState
-> ConnectionManagerTrace peerAddr handlerTrace
TrConnectionExists Provenance
provenance peerAddr
peerAddr AbstractState
st))
                         , MutableConnState peerAddr handle handleError version m
mutableConnState
                         , forall a b. a -> Either a b
Left (forall a. (?callStack::CallStack) => (CallStack -> a) -> a
withCallStack
                                  (forall peerAddr.
Provenance
-> peerAddr -> CallStack -> ConnectionManagerError peerAddr
ConnectionExists Provenance
provenance peerAddr
peerAddr))
                         )

                TerminatingState ConnectionId peerAddr
_connId Async m ()
_connThread Maybe handleError
_handleError ->
                  -- await for 'TerminatedState' or for removal of the
                  -- connection from the state.
                  forall (m :: * -> *) a. MonadSTM m => STM m a
retry

                TerminatedState Maybe handleError
_handleError -> do
                  -- the connection terminated; we can not reset 'connVar' and
                  -- start afresh. We should wait for the removal of the
                  -- connection from the state.
                  forall (m :: * -> *) a. MonadSTM m => STM m a
retry

            Maybe (MutableConnState peerAddr handle handleError version m)
Nothing -> do
              let connState' :: ConnectionState peerAddr handle handleError version m
connState' = forall {peerAddr} {handle} {handleError} {version} {m :: * -> *}.
ConnectionState peerAddr handle handleError version m
ReservedOutboundState
              (MutableConnState peerAddr handle handleError version m
mutableConnState :: MutableConnState peerAddr handle handleError
                                                    version m)
                <- forall (m :: * -> *) peerAddr handle handleError version.
MonadSTM m =>
FreshIdSupply m
-> ConnectionState peerAddr handle handleError version m
-> STM m (MutableConnState peerAddr handle handleError version m)
newMutableConnState FreshIdSupply m
freshIdSupply forall {peerAddr} {handle} {handleError} {version} {m :: * -> *}.
ConnectionState peerAddr handle handleError version m
connState'
              -- TODO: label `connVar` using 'ConnectionId'
              forall (m :: * -> *) a.
MonadLabelledSTM m =>
StrictTVar m a -> String -> STM m ()
labelTVar (forall peerAddr handle handleError version (m :: * -> *).
MutableConnState peerAddr handle handleError version m
-> StrictTVar
     m (ConnectionState peerAddr handle handleError version m)
connVar MutableConnState peerAddr handle handleError version m
mutableConnState) (String
"conn-state-" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show peerAddr
peerAddr)

              -- record the @connVar@ in 'ConnectionManagerState' we can use
              -- 'swapTMVar' as we did not use 'takeTMVar' at the beginning of
              -- this transaction.  Since we already 'readTMVar', it will not
              -- block.
              (Maybe (ConnectionState peerAddr handle handleError version m)
mbConnState
                 :: Maybe (ConnectionState peerAddr handle handleError version m))
                   <- forall (m :: * -> *) a.
MonadSTM m =>
StrictTMVar m a -> a -> STM m a
swapTMVar StrictTMVar
  m (ConnectionManagerState peerAddr handle handleError version m)
stateVar
                        (forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert peerAddr
peerAddr MutableConnState peerAddr handle handleError version m
mutableConnState ConnectionManagerState peerAddr handle handleError version m
state)
                        forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall (m :: * -> *) a. MonadSTM m => StrictTVar m a -> STM m a
readTVar forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall peerAddr handle handleError version (m :: * -> *).
MutableConnState peerAddr handle handleError version m
-> StrictTVar
     m (ConnectionState peerAddr handle handleError version m)
connVar) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup peerAddr
peerAddr
              forall (m :: * -> *) a. Monad m => a -> m a
return ( forall a. a -> Maybe a
Just (forall a b. a -> Either a b
Left (forall peerAddr state.
peerAddr -> Transition' state -> TransitionTrace' peerAddr state
TransitionTrace
                                    peerAddr
peerAddr
                                    Transition {
                                        fromState :: MaybeUnknown
  (ConnectionState peerAddr handle handleError version m)
fromState = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall state. MaybeUnknown state
Unknown forall state. state -> MaybeUnknown state
Known Maybe (ConnectionState peerAddr handle handleError version m)
mbConnState,
                                        toState :: MaybeUnknown
  (ConnectionState peerAddr handle handleError version m)
toState   = forall state. state -> MaybeUnknown state
Known forall {peerAddr} {handle} {handleError} {version} {m :: * -> *}.
ConnectionState peerAddr handle handleError version m
connState'
                                      }))
                     , MutableConnState peerAddr handle handleError version m
mutableConnState
                     , forall a b. b -> Either a b
Right forall a b. Wedge a b
Nowhere
                     )

        forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer
  m
  (TransitionTrace
     peerAddr (ConnectionState peerAddr handle handleError version m))
trTracer) (forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer m (ConnectionManagerTrace peerAddr handlerTrace)
tracer)) Maybe
  (Either
     (TransitionTrace
        peerAddr (ConnectionState peerAddr handle handleError version m))
     (ConnectionManagerTrace peerAddr handlerTrace))
trace
        StrictTMVar
  m (ConnectionManagerState peerAddr handle handleError version m)
-> m ()
traceCounters StrictTMVar
  m (ConnectionManagerState peerAddr handle handleError version m)
stateVar
        case Either
  (ConnectionManagerError peerAddr)
  (Wedge
     (Connected peerAddr handle handleError) (ConnectionId peerAddr))
eHandleWedge of
          Left ConnectionManagerError peerAddr
e ->
            forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwIO ConnectionManagerError peerAddr
e

          -- connection manager does not have a connection with @peerAddr@.
          Right Wedge
  (Connected peerAddr handle handleError) (ConnectionId peerAddr)
Nowhere -> do
            (PromiseReader
  m
  (Either
     handleError
     (HandshakeConnectionResult handle (version, versionData)))
reader, PromiseWriter
  m
  (Either
     handleError
     (HandshakeConnectionResult handle (version, versionData)))
writer) <- forall (m :: * -> *) a.
(MonadSTM m, MonadThrow (STM m)) =>
m (PromiseReader m a, PromiseWriter m a)
newEmptyPromiseIO

            (ConnectionId peerAddr
connId, Async m ()
connThread) <-
              -- This section of code passes the control over socket from
              -- `bracketOnError` which is responsible for:
              --
              --    * creating socket
              --    * connecting to remote host
              --    * obtaining local address of the connection
              --
              -- to the connection handler and its resource cleanup.
              -- Both the 'bracketOnError''s resource handler and the
              -- connection handler cleanup function are responsible for:
              --
              --  * closing the socket
              --  * freeing the slot in connection manager state map
              --
              forall (m :: * -> *) b.
MonadMask m =>
((forall a. m a -> m a) -> m b) -> m b
mask forall a b. (a -> b) -> a -> b
$ \forall a. m a -> m a
unmask -> do

                --
                -- connect
                --

                (socket
socket, ConnectionId peerAddr
connId) <-
                  forall a. m a -> m a
unmask forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a b c.
MonadCatch m =>
m a -> (a -> m b) -> (a -> m c) -> m c
bracketOnError
                    (forall (m :: * -> *) fd addr. Snocket m fd addr -> addr -> m fd
openToConnect Snocket m socket peerAddr
cmSnocket peerAddr
peerAddr)
                    (\socket
socket -> forall (m :: * -> *) a. MonadMask m => m a -> m a
uninterruptibleMask_ forall a b. (a -> b) -> a -> b
$ do
                      forall (m :: * -> *) fd addr. Snocket m fd addr -> fd -> m ()
close Snocket m socket peerAddr
cmSnocket socket
socket
                      [Transition'
   (MaybeUnknown
      (ConnectionState peerAddr handle handleError version m))]
trs <- forall (m :: * -> *) a.
(MonadSTM m, ?callStack::CallStack) =>
STM m a -> m a
atomically forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a b.
MonadSTM m =>
StrictTMVar m a -> (a -> STM m (a, b)) -> STM m b
modifyTMVarSTM StrictTMVar
  m (ConnectionManagerState peerAddr handle handleError version m)
stateVar forall a b. (a -> b) -> a -> b
$ \ConnectionManagerState peerAddr handle handleError version m
state -> do
                        case forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup peerAddr
peerAddr ConnectionManagerState peerAddr handle handleError version m
state of
                          -- Lookup failed, which means connection was already
                          -- removed.  So we just update the connVar and trace
                          -- accordingly.
                          Maybe (MutableConnState peerAddr handle handleError version m)
Nothing -> do
                            ConnectionState peerAddr handle handleError version m
connState <- forall (m :: * -> *) a. MonadSTM m => StrictTVar m a -> STM m a
readTVar StrictTVar
  m (ConnectionState peerAddr handle handleError version m)
connVar
                            let connState' :: ConnectionState peerAddr handle handleError version m
connState' = forall peerAddr handle handleError version (m :: * -> *).
Maybe handleError
-> ConnectionState peerAddr handle handleError version m
TerminatedState forall a. Maybe a
Nothing
                            forall (m :: * -> *) a.
MonadSTM m =>
StrictTVar m a -> a -> STM m ()
writeTVar StrictTVar
  m (ConnectionState peerAddr handle handleError version m)
connVar forall {peerAddr} {handle} {handleError} {version} {m :: * -> *}.
ConnectionState peerAddr handle handleError version m
connState'
                            forall (m :: * -> *) a. Monad m => a -> m a
return
                              ( ConnectionManagerState peerAddr handle handleError version m
state
                              , [ forall state. state -> state -> Transition state
mkTransition ConnectionState peerAddr handle handleError version m
connState forall {peerAddr} {handle} {handleError} {version} {m :: * -> *}.
ConnectionState peerAddr handle handleError version m
connState'
                                , forall state. state -> state -> Transition' state
Transition (forall state. state -> MaybeUnknown state
Known forall {peerAddr} {handle} {handleError} {version} {m :: * -> *}.
ConnectionState peerAddr handle handleError version m
connState') forall state. MaybeUnknown state
Unknown
                                ]
                              )

                          -- Current connVar.
                          Just MutableConnState peerAddr handle handleError version m
mutableConnState' -> do
                            ConnectionState peerAddr handle handleError version m
connState <- forall (m :: * -> *) a. MonadSTM m => StrictTVar m a -> STM m a
readTVar StrictTVar
  m (ConnectionState peerAddr handle handleError version m)
connVar
                            case ConnectionState peerAddr handle handleError version m
connState of
                              -- Update the state only if the connection was in
                              -- 'ReservedOutboundState'.  This covers the case
                              -- when we connect to ourselves, in which case: we
                              -- first set the connection state to
                              -- `ReservedOutboundState`, then race connect
                              -- & accept calls.  If the connection was
                              -- accepted it, it will use the same
                              -- 'MutableConnState', and if the inbound side is
                              -- using the connection the state will be
                              -- different than `ReservedOutboundState`.
                              ConnectionState peerAddr handle handleError version m
ReservedOutboundState | MutableConnState peerAddr handle handleError version m
mutableConnState' forall a. Eq a => a -> a -> Bool
== MutableConnState peerAddr handle handleError version m
mutableConnState -> do
                                let state' :: ConnectionManagerState peerAddr handle handleError version m
state' = forall k a. Ord k => k -> Map k a -> Map k a
Map.delete peerAddr
peerAddr ConnectionManagerState peerAddr handle handleError version m
state
                                    connState' :: ConnectionState peerAddr handle handleError version m
connState' = forall peerAddr handle handleError version (m :: * -> *).
Maybe handleError
-> ConnectionState peerAddr handle handleError version m
TerminatedState forall a. Maybe a
Nothing
                                forall (m :: * -> *) a.
MonadSTM m =>
StrictTVar m a -> a -> STM m ()
writeTVar StrictTVar
  m (ConnectionState peerAddr handle handleError version m)
connVar forall {peerAddr} {handle} {handleError} {version} {m :: * -> *}.
ConnectionState peerAddr handle handleError version m
connState'
                                forall (m :: * -> *) a. Monad m => a -> m a
return
                                  ( ConnectionManagerState peerAddr handle handleError version m
state'
                                  , [ forall state. state -> state -> Transition state
mkTransition ConnectionState peerAddr handle handleError version m
connState forall {peerAddr} {handle} {handleError} {version} {m :: * -> *}.
ConnectionState peerAddr handle handleError version m
connState'
                                    , forall state. state -> state -> Transition' state
Transition (forall state. state -> MaybeUnknown state
Known forall {peerAddr} {handle} {handleError} {version} {m :: * -> *}.
ConnectionState peerAddr handle handleError version m
connState')
                                                 forall state. MaybeUnknown state
Unknown
                                    ]
                                  )

                                -- self connection: the connection might have
                                -- been accepted, in such case do not modify its
                                -- state.
                              ConnectionState peerAddr handle handleError version m
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return (ConnectionManagerState peerAddr handle handleError version m
state, [])

                      forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer
  m
  (TransitionTrace
     peerAddr (ConnectionState peerAddr handle handleError version m))
trTracer forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall peerAddr state.
peerAddr -> Transition' state -> TransitionTrace' peerAddr state
TransitionTrace peerAddr
peerAddr) [Transition'
   (MaybeUnknown
      (ConnectionState peerAddr handle handleError version m))]
trs
                      StrictTMVar
  m (ConnectionManagerState peerAddr handle handleError version m)
-> m ()
traceCounters StrictTMVar
  m (ConnectionManagerState peerAddr handle handleError version m)
stateVar
                    )
                    forall a b. (a -> b) -> a -> b
$ \socket
socket -> do
                      forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer m (ConnectionManagerTrace peerAddr handlerTrace)
tracer (forall peerAddr handlerTrace.
Provenance
-> peerAddr -> ConnectionManagerTrace peerAddr handlerTrace
TrConnectionNotFound Provenance
provenance peerAddr
peerAddr)
                      let addr :: Maybe peerAddr
addr = case peerAddr -> Maybe AddressType
cmAddressType peerAddr
peerAddr of
                                   Maybe AddressType
Nothing          -> forall a. Maybe a
Nothing
                                   Just AddressType
IPv4Address -> Maybe peerAddr
cmIPv4Address
                                   Just AddressType
IPv6Address -> Maybe peerAddr
cmIPv6Address
                      socket -> Maybe peerAddr -> m ()
cmConfigureSocket socket
socket Maybe peerAddr
addr
                      case peerAddr -> Maybe AddressType
cmAddressType peerAddr
peerAddr of
                        Maybe AddressType
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
                        Just AddressType
IPv4Address ->
                             forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (forall (m :: * -> *) fd addr.
Snocket m fd addr -> fd -> addr -> m ()
bind Snocket m socket peerAddr
cmSnocket socket
socket)
                                       Maybe peerAddr
cmIPv4Address
                        Just AddressType
IPv6Address ->
                             forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (forall (m :: * -> *) fd addr.
Snocket m fd addr -> fd -> addr -> m ()
bind Snocket m socket peerAddr
cmSnocket socket
socket)
                                       Maybe peerAddr
cmIPv6Address

                      forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer m (ConnectionManagerTrace peerAddr handlerTrace)
tracer (forall peerAddr handlerTrace.
Maybe peerAddr
-> peerAddr -> ConnectionManagerTrace peerAddr handlerTrace
TrConnect Maybe peerAddr
addr peerAddr
peerAddr)
                      forall (m :: * -> *) fd addr.
Snocket m fd addr -> fd -> addr -> m ()
connect Snocket m socket peerAddr
cmSnocket socket
socket peerAddr
peerAddr
                        forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> (e -> m a) -> m a
`catch` \SomeException
e -> do
                          forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer m (ConnectionManagerTrace peerAddr handlerTrace)
tracer (forall peerAddr handlerTrace.
Maybe peerAddr
-> peerAddr
-> SomeException
-> ConnectionManagerTrace peerAddr handlerTrace
TrConnectError Maybe peerAddr
addr peerAddr
peerAddr SomeException
e)
                          -- the handler attached by `bracketOnError` will
                          -- reset the state
                          forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwIO SomeException
e
                      peerAddr
localAddress <- forall (m :: * -> *) fd addr. Snocket m fd addr -> fd -> m addr
getLocalAddr Snocket m socket peerAddr
cmSnocket socket
socket
                      let connId :: ConnectionId peerAddr
connId = ConnectionId { peerAddr
localAddress :: peerAddr
localAddress :: peerAddr
localAddress
                                                , remoteAddress :: peerAddr
remoteAddress = peerAddr
peerAddr
                                                }
                      forall (m :: * -> *) a. Monad m => a -> m a
return (socket
socket, ConnectionId peerAddr
connId)

                --
                -- fork connection handler; it will unmask exceptions
                --

                Async m ()
connThread <-
                  StrictTMVar
  m (ConnectionManagerState peerAddr handle handleError version m)
-> MutableConnState peerAddr handle handleError version m
-> socket
-> ConnectionId peerAddr
-> PromiseWriter
     m
     (Either
        handleError
        (HandshakeConnectionResult handle (version, versionData)))
-> ConnectionHandlerFn
     handlerTrace
     socket
     peerAddr
     handle
     handleError
     (version, versionData)
     m
-> m (Async m ())
forkConnectionHandler
                    StrictTMVar
  m (ConnectionManagerState peerAddr handle handleError version m)
stateVar MutableConnState peerAddr handle handleError version m
mutableConnState socket
socket ConnectionId peerAddr
connId PromiseWriter
  m
  (Either
     handleError
     (HandshakeConnectionResult handle (version, versionData)))
writer ConnectionHandlerFn
  handlerTrace
  socket
  peerAddr
  handle
  handleError
  (version, versionData)
  m
handler
                forall (m :: * -> *) a. Monad m => a -> m a
return (ConnectionId peerAddr
connId, Async m ()
connThread)

            (Maybe
  (Transition'
     (MaybeUnknown
        (ConnectionState peerAddr handle handleError version m)))
trans, Maybe (ConnectionManagerTrace peerAddr handlerTrace)
mbAssertion) <- forall (m :: * -> *) a.
(MonadSTM m, ?callStack::CallStack) =>
STM m a -> m a
atomically forall a b. (a -> b) -> a -> b
$ do
              ConnectionState peerAddr handle handleError version m
connState <- forall (m :: * -> *) a. MonadSTM m => StrictTVar m a -> STM m a
readTVar StrictTVar
  m (ConnectionState peerAddr handle handleError version m)
connVar

              -- @
              --  Connected : ReservedOutboundState
              --            → UnnegotiatedState Outbound
              -- @
              case ConnectionState peerAddr handle handleError version m
connState of
                ConnectionState peerAddr handle handleError version m
ReservedOutboundState -> do
                  let connState' :: ConnectionState peerAddr handle handleError version m
connState' = forall peerAddr handle handleError version (m :: * -> *).
Provenance
-> ConnectionId peerAddr
-> Async m ()
-> ConnectionState peerAddr handle handleError version m
UnnegotiatedState Provenance
provenance ConnectionId peerAddr
connId Async m ()
connThread
                  forall (m :: * -> *) a.
MonadSTM m =>
StrictTVar m a -> a -> STM m ()
writeTVar StrictTVar
  m (ConnectionState peerAddr handle handleError version m)
connVar ConnectionState peerAddr handle handleError version m
connState'
                  forall (m :: * -> *) a. Monad m => a -> m a
return ( forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall state. state -> state -> Transition state
mkTransition ConnectionState peerAddr handle handleError version m
connState ConnectionState peerAddr handle handleError version m
connState'
                         , forall a. Maybe a
Nothing
                         )

                -- @
                --  SelfConn⁻¹ : UnnegotiatedState Inbound
                --             → UnnegotiatedState Outbound
                -- @
                --
                UnnegotiatedState Provenance
Inbound ConnectionId peerAddr
_connId Async m ()
_connThread -> do
                  let connState' :: ConnectionState peerAddr handle handleError version m
connState' = forall peerAddr handle handleError version (m :: * -> *).
Provenance
-> ConnectionId peerAddr
-> Async m ()
-> ConnectionState peerAddr handle handleError version m
UnnegotiatedState Provenance
Outbound ConnectionId peerAddr
connId Async m ()
connThread
                  forall (m :: * -> *) a.
MonadSTM m =>
StrictTVar m a -> a -> STM m ()
writeTVar StrictTVar
  m (ConnectionState peerAddr handle handleError version m)
connVar ConnectionState peerAddr handle handleError version m
connState'
                  forall (m :: * -> *) a. Monad m => a -> m a
return ( forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall state. state -> state -> Transition state
mkTransition ConnectionState peerAddr handle handleError version m
connState ConnectionState peerAddr handle handleError version m
connState'
                         , forall a. Maybe a
Nothing
                         )


                TerminatingState {} ->
                  forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. Maybe a
Nothing, forall a. Maybe a
Nothing)
                TerminatedState {} ->
                  forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. Maybe a
Nothing, forall a. Maybe a
Nothing)
                ConnectionState peerAddr handle handleError version m
_ ->
                  forall (m :: * -> *) a. Monad m => a -> m a
return ( forall a. Maybe a
Nothing
                         , forall a. a -> Maybe a
Just (forall peerAddr handlerTrace.
AssertionLocation peerAddr
-> ConnectionManagerTrace peerAddr handlerTrace
CM.TrUnexpectedlyFalseAssertion
                                   (forall peerAddr.
Maybe (ConnectionId peerAddr)
-> AbstractState -> AssertionLocation peerAddr
RequestOutboundConnection
                                     (forall a. a -> Maybe a
Just ConnectionId peerAddr
connId)
                                     (forall muxMode peerAddr m a (b :: * -> *).
MaybeUnknown (ConnectionState muxMode peerAddr m a b)
-> AbstractState
abstractState (forall state. state -> MaybeUnknown state
Known ConnectionState peerAddr handle handleError version m
connState))
                                   )
                                )
                         )

            forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer
  m
  (TransitionTrace
     peerAddr (ConnectionState peerAddr handle handleError version m))
trTracer forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall peerAddr state.
peerAddr -> Transition' state -> TransitionTrace' peerAddr state
TransitionTrace peerAddr
peerAddr) Maybe
  (Transition'
     (MaybeUnknown
        (ConnectionState peerAddr handle handleError version m)))
trans
            forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer m (ConnectionManagerTrace peerAddr handlerTrace)
tracer forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall (m :: * -> *) a. MonadEvaluate m => a -> m a
evaluate forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (?callStack::CallStack) => Bool -> a -> a
assert Bool
True)
                      Maybe (ConnectionManagerTrace peerAddr handlerTrace)
mbAssertion
            StrictTMVar
  m (ConnectionManagerState peerAddr handle handleError version m)
-> m ()
traceCounters StrictTMVar
  m (ConnectionManagerState peerAddr handle handleError version m)
stateVar

            Either
  handleError
  (HandshakeConnectionResult handle (version, versionData))
res <- forall (m :: * -> *) a.
(MonadSTM m, ?callStack::CallStack) =>
STM m a -> m a
atomically (forall (m :: * -> *) a. PromiseReader m a -> STM m a
readPromise PromiseReader
  m
  (Either
     handleError
     (HandshakeConnectionResult handle (version, versionData)))
reader)
            case Either
  handleError
  (HandshakeConnectionResult handle (version, versionData))
res of
              Left handleError
handleError -> do
                ConnectionId peerAddr
-> StrictTVar
     m (ConnectionState peerAddr handle handleError version m)
-> Async m ()
-> peerAddr
-> StrictTMVar
     m (ConnectionManagerState peerAddr handle handleError version m)
-> MutableConnState peerAddr handle handleError version m
-> Maybe handleError
-> m (Connected peerAddr handle handleError)
terminateOutboundWithErrorOrQuery ConnectionId peerAddr
connId StrictTVar
  m (ConnectionState peerAddr handle handleError version m)
connVar Async m ()
connThread peerAddr
peerAddr StrictTMVar
  m (ConnectionManagerState peerAddr handle handleError version m)
stateVar MutableConnState peerAddr handle handleError version m
mutableConnState forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just handleError
handleError

              Right HandshakeConnectionResult handle (version, versionData)
HandshakeConnectionQuery -> do
                ConnectionId peerAddr
-> StrictTVar
     m (ConnectionState peerAddr handle handleError version m)
-> Async m ()
-> peerAddr
-> StrictTMVar
     m (ConnectionManagerState peerAddr handle handleError version m)
-> MutableConnState peerAddr handle handleError version m
-> Maybe handleError
-> m (Connected peerAddr handle handleError)
terminateOutboundWithErrorOrQuery ConnectionId peerAddr
connId StrictTVar
  m (ConnectionState peerAddr handle handleError version m)
connVar Async m ()
connThread peerAddr
peerAddr StrictTMVar
  m (ConnectionManagerState peerAddr handle handleError version m)
stateVar MutableConnState peerAddr handle handleError version m
mutableConnState forall a. Maybe a
Nothing

              Right (HandshakeConnectionResult handle
handle (version
version, versionData
versionData)) -> do
                let dataFlow :: DataFlow
dataFlow = version -> versionData -> DataFlow
connectionDataFlow version
version versionData
versionData
                -- We can safely overwrite the state: after successful
                -- `connect` it's not possible to have a race condition
                -- with any other inbound thread.  We are also guaranteed
                -- to have exclusive access as an outbound thread.
                Maybe
  (Transition'
     (MaybeUnknown
        (ConnectionState peerAddr handle handleError version m)))
mbTransition <- forall (m :: * -> *) a.
(MonadSTM m, ?callStack::CallStack) =>
STM m a -> m a
atomically forall a b. (a -> b) -> a -> b
$ do
                  ConnectionState peerAddr handle handleError version m
connState <- forall (m :: * -> *) a. MonadSTM m => StrictTVar m a -> STM m a
readTVar  StrictTVar
  m (ConnectionState peerAddr handle handleError version m)
connVar
                  case ConnectionState peerAddr handle handleError version m
connState of
                    UnnegotiatedState Provenance
provenance' ConnectionId peerAddr
_ Async m ()
_ ->
                      case DataFlow
dataFlow of
                        DataFlow
Unidirectional -> do
                          -- @
                          --  Negotiated^{Unidirectional}_{Outbound}
                          --    : UnnegotiatedState Outbound
                          --    → OutboundUniState Outbound
                          -- @
                          let connState' :: ConnectionState peerAddr handle handleError version m
connState' = forall peerAddr handle handleError version (m :: * -> *).
ConnectionId peerAddr
-> Async m ()
-> handle
-> ConnectionState peerAddr handle handleError version m
OutboundUniState ConnectionId peerAddr
connId Async m ()
connThread handle
handle
                          forall (m :: * -> *) a.
MonadSTM m =>
StrictTVar m a -> a -> STM m ()
writeTVar StrictTVar
  m (ConnectionState peerAddr handle handleError version m)
connVar ConnectionState peerAddr handle handleError version m
connState'
                          forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall state. state -> state -> Transition state
mkTransition ConnectionState peerAddr handle handleError version m
connState ConnectionState peerAddr handle handleError version m
connState')
                        DataFlow
Duplex -> do
                          -- @
                          --  Negotiated^{Duplex}_{Outbound}
                          --    : UnnegotiatedState Outbound
                          --    → OutboundDupState^\tau Outbound
                          -- @
                          let connState' :: ConnectionState peerAddr handle handleError version m
connState' = forall peerAddr handle handleError version (m :: * -> *).
ConnectionId peerAddr
-> Async m ()
-> handle
-> TimeoutExpired
-> ConnectionState peerAddr handle handleError version m
OutboundDupState ConnectionId peerAddr
connId Async m ()
connThread handle
handle TimeoutExpired
Ticking
                              notifyInboundGov :: Bool
notifyInboundGov =
                                case Provenance
provenance' of
                                  Provenance
Inbound  -> Bool
False
                                  -- ^ This is a connection to oneself; We don't
                                  -- need to notify the inbound governor, as
                                  -- it's already done by
                                  -- `includeInboundConnectionImpl`
                                  Provenance
Outbound -> Bool
True
                          forall (m :: * -> *) a.
MonadSTM m =>
StrictTVar m a -> a -> STM m ()
writeTVar StrictTVar
  m (ConnectionState peerAddr handle handleError version m)
connVar ConnectionState peerAddr handle handleError version m
connState'
                          case InResponderMode
  muxMode (InformationChannel (NewConnectionInfo peerAddr handle) m)
inboundGovernorInfoChannel of
                            InResponderMode InformationChannel (NewConnectionInfo peerAddr handle) m
infoChannel | Bool
notifyInboundGov ->
                              forall a (m :: * -> *). InformationChannel a m -> a -> STM m ()
InfoChannel.writeMessage
                                InformationChannel (NewConnectionInfo peerAddr handle) m
infoChannel
                                (forall peerAddr handle.
Provenance
-> ConnectionId peerAddr
-> DataFlow
-> handle
-> NewConnectionInfo peerAddr handle
NewConnectionInfo Provenance
provenance' ConnectionId peerAddr
connId DataFlow
dataFlow handle
handle)
                            InResponderMode
  muxMode (InformationChannel (NewConnectionInfo peerAddr handle) m)
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
                          forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall state. state -> state -> Transition state
mkTransition ConnectionState peerAddr handle handleError version m
connState ConnectionState peerAddr handle handleError version m
connState')

                    -- @
                    --   SelfConn'^{-1}
                    --     : InboundIdleState Unidirectional
                    --     → OutboundUniState
                    -- @
                    InboundIdleState ConnectionId peerAddr
connId' Async m ()
connThread' handle
handle' DataFlow
Unidirectional -> do
                      let connState' :: ConnectionState peerAddr handle handleError version m
connState' = forall peerAddr handle handleError version (m :: * -> *).
ConnectionId peerAddr
-> Async m ()
-> handle
-> ConnectionState peerAddr handle handleError version m
OutboundUniState ConnectionId peerAddr
connId' Async m ()
connThread' handle
handle'
                      forall (m :: * -> *) a.
MonadSTM m =>
StrictTVar m a -> a -> STM m ()
writeTVar StrictTVar
  m (ConnectionState peerAddr handle handleError version m)
connVar ConnectionState peerAddr handle handleError version m
connState'
                      forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall state. state -> state -> Transition state
mkTransition ConnectionState peerAddr handle handleError version m
connState ConnectionState peerAddr handle handleError version m
connState')

                    -- @
                    --   SelfConn'^{-1}
                    --     : InboundIdleState Duplex
                    --     → OutboundDupState
                    -- @
                    InboundIdleState ConnectionId peerAddr
connId' Async m ()
connThread' handle
handle' DataFlow
Duplex -> do
                      let connState' :: ConnectionState peerAddr handle handleError version m
connState' = forall peerAddr handle handleError version (m :: * -> *).
ConnectionId peerAddr
-> Async m ()
-> handle
-> TimeoutExpired
-> ConnectionState peerAddr handle handleError version m
OutboundDupState ConnectionId peerAddr
connId' Async m ()
connThread' handle
handle' TimeoutExpired
Ticking
                      forall (m :: * -> *) a.
MonadSTM m =>
StrictTVar m a -> a -> STM m ()
writeTVar StrictTVar
  m (ConnectionState peerAddr handle handleError version m)
connVar ConnectionState peerAddr handle handleError version m
connState'
                      forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall state. state -> state -> Transition state
mkTransition ConnectionState peerAddr handle handleError version m
connState ConnectionState peerAddr handle handleError version m
connState')

                    TerminatedState Maybe handleError
_ ->
                      forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
                    ConnectionState peerAddr handle handleError version m
_ ->
                      let st :: AbstractState
st = forall muxMode peerAddr m a (b :: * -> *).
MaybeUnknown (ConnectionState muxMode peerAddr m a b)
-> AbstractState
abstractState (forall state. state -> MaybeUnknown state
Known ConnectionState peerAddr handle handleError version m
connState) in
                      forall (m :: * -> *) e a.
(MonadSTM m, MonadThrow (STM m), Exception e) =>
e -> STM m a
throwSTM (forall a. (?callStack::CallStack) => (CallStack -> a) -> a
withCallStack (forall peerAddr.
peerAddr
-> AbstractState -> CallStack -> ConnectionManagerError peerAddr
ForbiddenOperation peerAddr
peerAddr AbstractState
st))
                forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer
  m
  (TransitionTrace
     peerAddr (ConnectionState peerAddr handle handleError version m))
trTracer forall b c a. (b -> c) -> (a -> b) -> a -> c
.  forall peerAddr state.
peerAddr -> Transition' state -> TransitionTrace' peerAddr state
TransitionTrace peerAddr
peerAddr)
                          Maybe
  (Transition'
     (MaybeUnknown
        (ConnectionState peerAddr handle handleError version m)))
mbTransition
                StrictTMVar
  m (ConnectionManagerState peerAddr handle handleError version m)
-> m ()
traceCounters StrictTMVar
  m (ConnectionManagerState peerAddr handle handleError version m)
stateVar
                forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ case Maybe
  (Transition'
     (MaybeUnknown
        (ConnectionState peerAddr handle handleError version m)))
mbTransition of
                  Just Transition'
  (MaybeUnknown
     (ConnectionState peerAddr handle handleError version m))
_  -> forall peerAddr handle handleError.
ConnectionId peerAddr
-> DataFlow -> handle -> Connected peerAddr handle handleError
Connected    ConnectionId peerAddr
connId DataFlow
dataFlow handle
handle
                  Maybe
  (Transition'
     (MaybeUnknown
        (ConnectionState peerAddr handle handleError version m)))
Nothing -> forall peerAddr handle handleError.
ConnectionId peerAddr
-> Maybe handleError -> Connected peerAddr handle handleError
Disconnected ConnectionId peerAddr
connId forall a. Maybe a
Nothing

          Right (There ConnectionId peerAddr
connId) -> do
            -- We can only enter the 'There' case if there is an inbound
            -- connection, and we are about to reuse it, but we need to wait
            -- for handshake.
            (Either
  (TransitionTrace
     peerAddr (ConnectionState peerAddr handle handleError version m))
  (ConnectionManagerTrace peerAddr handlerTrace)
etr, Connected peerAddr handle handleError
connected) <- forall (m :: * -> *) a.
(MonadSTM m, ?callStack::CallStack) =>
STM m a -> m a
atomically forall a b. (a -> b) -> a -> b
$ do
              ConnectionState peerAddr handle handleError version m
connState <- forall (m :: * -> *) a. MonadSTM m => StrictTVar m a -> STM m a
readTVar StrictTVar
  m (ConnectionState peerAddr handle handleError version m)
connVar
              case ConnectionState peerAddr handle handleError version m
connState of
                ReservedOutboundState {} ->
                  forall (m :: * -> *) e a.
(MonadSTM m, MonadThrow (STM m), Exception e) =>
e -> STM m a
throwSTM
                    (forall a. (?callStack::CallStack) => (CallStack -> a) -> a
withCallStack (forall peerAddr.
peerAddr -> CallStack -> ConnectionManagerError peerAddr
ImpossibleState (forall addr. ConnectionId addr -> addr
remoteAddress ConnectionId peerAddr
connId)))
                UnnegotiatedState Provenance
Outbound ConnectionId peerAddr
_ Async m ()
_ ->
                  forall (m :: * -> *) e a.
(MonadSTM m, MonadThrow (STM m), Exception e) =>
e -> STM m a
throwSTM
                    (forall a. (?callStack::CallStack) => (CallStack -> a) -> a
withCallStack (forall peerAddr.
Provenance
-> peerAddr -> CallStack -> ConnectionManagerError peerAddr
ConnectionExists Provenance
provenance ConnectionId peerAddr
connId))

                UnnegotiatedState Provenance
Inbound ConnectionId peerAddr
_ Async m ()
_ ->
                  -- await for connection negotiation
                  forall (m :: * -> *) a. MonadSTM m => STM m a
retry

                OutboundUniState {} ->
                  forall (m :: * -> *) e a.
(MonadSTM m, MonadThrow (STM m), Exception e) =>
e -> STM m a
throwSTM (forall a. (?callStack::CallStack) => (CallStack -> a) -> a
withCallStack (forall peerAddr.
Provenance
-> peerAddr -> CallStack -> ConnectionManagerError peerAddr
ConnectionExists Provenance
provenance ConnectionId peerAddr
connId))

                OutboundDupState {} ->
                  forall (m :: * -> *) e a.
(MonadSTM m, MonadThrow (STM m), Exception e) =>
e -> STM m a
throwSTM (forall a. (?callStack::CallStack) => (CallStack -> a) -> a
withCallStack (forall peerAddr.
Provenance
-> peerAddr -> CallStack -> ConnectionManagerError peerAddr
ConnectionExists Provenance
provenance ConnectionId peerAddr
connId))

                OutboundIdleState ConnectionId peerAddr
_connId Async m ()
_connThread handle
_handle DataFlow
_dataFlow ->
                  let tr :: AbstractState
tr = forall muxMode peerAddr m a (b :: * -> *).
MaybeUnknown (ConnectionState muxMode peerAddr m a b)
-> AbstractState
abstractState (forall state. state -> MaybeUnknown state
Known ConnectionState peerAddr handle handleError version m
connState) in
                  forall (m :: * -> *) e a.
(MonadSTM m, MonadThrow (STM m), Exception e) =>
e -> STM m a
throwSTM (forall a. (?callStack::CallStack) => (CallStack -> a) -> a
withCallStack (forall peerAddr.
peerAddr
-> AbstractState -> CallStack -> ConnectionManagerError peerAddr
ForbiddenOperation peerAddr
peerAddr AbstractState
tr))

                InboundIdleState ConnectionId peerAddr
_connId Async m ()
connThread handle
handle dataFlow :: DataFlow
dataFlow@DataFlow
Duplex -> do
                  -- @
                  --   Awake^{Duplex}_{Local} : InboundIdleState Duplex
                  --                          → OutboundState^\tau Duplex
                  -- @
                  -- This transition can happen if there are concurrent
                  -- `includeInboundConnection` and `requestOutboundConnection`
                  -- calls.
                  let connState' :: ConnectionState peerAddr handle handleError version m
connState' = forall peerAddr handle handleError version (m :: * -> *).
ConnectionId peerAddr
-> Async m ()
-> handle
-> TimeoutExpired
-> ConnectionState peerAddr handle handleError version m
OutboundDupState ConnectionId peerAddr
connId Async m ()
connThread handle
handle TimeoutExpired
Ticking
                  forall (m :: * -> *) a.
MonadSTM m =>
StrictTVar m a -> a -> STM m ()
writeTVar StrictTVar
  m (ConnectionState peerAddr handle handleError version m)
connVar ConnectionState peerAddr handle handleError version m
connState'
                  forall (m :: * -> *) a. Monad m => a -> m a
return ( forall a b. a -> Either a b
Left (forall peerAddr state.
peerAddr -> Transition' state -> TransitionTrace' peerAddr state
TransitionTrace
                                  peerAddr
peerAddr
                                  (forall state. state -> state -> Transition state
mkTransition ConnectionState peerAddr handle handleError version m
connState ConnectionState peerAddr handle handleError version m
connState'))
                         ,