{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE QuantifiedConstraints #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE UndecidableInstances #-}
module Ouroboros.Network.ConnectionManager.Core
( Arguments (..)
, Trace (..)
, with
, defaultTimeWaitTimeout
, defaultProtocolIdleTimeout
, defaultResetTimeout
, ConnectionState (..)
, abstractState
) where
import Control.Applicative (Alternative)
import Control.Concurrent.Class.MonadSTM qualified 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 System.Random (StdGen, split)
import Data.Map (Map)
import Data.Map qualified as Map
import Data.Set qualified as Set
import Data.Monoid.Synchronisation
import Data.Set (Set)
import Data.Wedge
import Data.Word (Word32)
import Network.Mux.Trace qualified as Mx
import Network.Mux.Types qualified as Mx
import Ouroboros.Network.ConnectionId
import Ouroboros.Network.ConnectionManager.InformationChannel
(InformationChannel)
import Ouroboros.Network.ConnectionManager.InformationChannel qualified as InfoChannel
import Ouroboros.Network.ConnectionManager.Types
import Ouroboros.Network.InboundGovernor.Event (NewConnectionInfo (..))
import Ouroboros.Network.MuxMode
import Ouroboros.Network.Server.RateLimiting (AcceptedConnectionsLimit (..))
import Ouroboros.Network.Snocket
import Ouroboros.Network.Testing.Utils (WithName (..))
data Arguments handlerTrace socket peerAddr handle handleError versionNumber versionData m =
Arguments {
forall handlerTrace socket peerAddr handle handleError
versionNumber versionData (m :: * -> *).
Arguments
handlerTrace
socket
peerAddr
handle
handleError
versionNumber
versionData
m
-> Tracer m (Trace peerAddr handlerTrace)
tracer :: Tracer m (Trace peerAddr handlerTrace),
forall handlerTrace socket peerAddr handle handleError
versionNumber versionData (m :: * -> *).
Arguments
handlerTrace
socket
peerAddr
handle
handleError
versionNumber
versionData
m
-> Tracer
m
(TransitionTrace
peerAddr
(ConnectionState peerAddr handle handleError versionNumber m))
trTracer :: Tracer m (TransitionTrace peerAddr
(ConnectionState peerAddr handle handleError versionNumber m)),
forall handlerTrace socket peerAddr handle handleError
versionNumber versionData (m :: * -> *).
Arguments
handlerTrace
socket
peerAddr
handle
handleError
versionNumber
versionData
m
-> Tracer m (WithBearer (ConnectionId peerAddr) Trace)
muxTracer :: Tracer m (Mx.WithBearer (ConnectionId peerAddr) Mx.Trace),
forall handlerTrace socket peerAddr handle handleError
versionNumber versionData (m :: * -> *).
Arguments
handlerTrace
socket
peerAddr
handle
handleError
versionNumber
versionData
m
-> Maybe peerAddr
ipv4Address :: Maybe peerAddr,
forall handlerTrace socket peerAddr handle handleError
versionNumber versionData (m :: * -> *).
Arguments
handlerTrace
socket
peerAddr
handle
handleError
versionNumber
versionData
m
-> Maybe peerAddr
ipv6Address :: Maybe peerAddr,
forall handlerTrace socket peerAddr handle handleError
versionNumber versionData (m :: * -> *).
Arguments
handlerTrace
socket
peerAddr
handle
handleError
versionNumber
versionData
m
-> peerAddr -> Maybe AddressType
addressType :: peerAddr -> Maybe AddressType,
forall handlerTrace socket peerAddr handle handleError
versionNumber versionData (m :: * -> *).
Arguments
handlerTrace
socket
peerAddr
handle
handleError
versionNumber
versionData
m
-> Snocket m socket peerAddr
snocket :: Snocket m socket peerAddr,
forall handlerTrace socket peerAddr handle handleError
versionNumber versionData (m :: * -> *).
Arguments
handlerTrace
socket
peerAddr
handle
handleError
versionNumber
versionData
m
-> MakeBearer m socket
makeBearer :: MakeBearer m socket,
forall handlerTrace socket peerAddr handle handleError
versionNumber versionData (m :: * -> *).
Arguments
handlerTrace
socket
peerAddr
handle
handleError
versionNumber
versionData
m
-> socket -> Maybe peerAddr -> m ()
configureSocket :: socket -> Maybe peerAddr -> m (),
forall handlerTrace socket peerAddr handle handleError
versionNumber versionData (m :: * -> *).
Arguments
handlerTrace
socket
peerAddr
handle
handleError
versionNumber
versionData
m
-> DiffTime
timeWaitTimeout :: DiffTime,
forall handlerTrace socket peerAddr handle handleError
versionNumber versionData (m :: * -> *).
Arguments
handlerTrace
socket
peerAddr
handle
handleError
versionNumber
versionData
m
-> DiffTime
outboundIdleTimeout :: DiffTime,
forall handlerTrace socket peerAddr handle handleError
versionNumber versionData (m :: * -> *).
Arguments
handlerTrace
socket
peerAddr
handle
handleError
versionNumber
versionData
m
-> versionData -> DataFlow
connectionDataFlow :: versionData -> DataFlow,
forall handlerTrace socket peerAddr handle handleError
versionNumber versionData (m :: * -> *).
Arguments
handlerTrace
socket
peerAddr
handle
handleError
versionNumber
versionData
m
-> PrunePolicy peerAddr
prunePolicy :: PrunePolicy peerAddr,
forall handlerTrace socket peerAddr handle handleError
versionNumber versionData (m :: * -> *).
Arguments
handlerTrace
socket
peerAddr
handle
handleError
versionNumber
versionData
m
-> StdGen
stdGen :: StdGen,
forall handlerTrace socket peerAddr handle handleError
versionNumber versionData (m :: * -> *).
Arguments
handlerTrace
socket
peerAddr
handle
handleError
versionNumber
versionData
m
-> AcceptedConnectionsLimit
connectionsLimits :: AcceptedConnectionsLimit
}
data MutableConnState peerAddr handle handleError version m = MutableConnState {
forall peerAddr handle handleError version (m :: * -> *).
MutableConnState peerAddr handle handleError version m -> Int
connStateId :: !Int
,
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
(==) = Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
(==) (Int -> Int -> Bool)
-> (MutableConnState peerAddr handle handleError version m -> Int)
-> MutableConnState peerAddr handle handleError version m
-> MutableConnState peerAddr handle handleError version m
-> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` MutableConnState peerAddr handle handleError version m -> Int
forall peerAddr handle handleError version (m :: * -> *).
MutableConnState peerAddr handle handleError version m -> Int
connStateId
newtype FreshIdSupply m = FreshIdSupply { forall (m :: * -> *). FreshIdSupply m -> STM m Int
getFreshId :: STM m Int }
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
(v :: StrictTVar m Int) <- Int -> STM m (StrictTVar m Int)
forall (m :: * -> *) a. MonadSTM m => a -> STM m (StrictTVar m a)
newTVar Int
0
let getFreshId :: STM m Int
getFreshId = do
c <- StrictTVar m Int -> STM m Int
forall (m :: * -> *) a. MonadSTM m => StrictTVar m a -> STM m a
readTVar StrictTVar m Int
v
writeTVar v (succ c)
return c
return $ FreshIdSupply { getFreshId }
newMutableConnState :: forall peerAddr handle handleError version m.
( MonadTraceSTM m
, Typeable peerAddr
)
=> peerAddr
-> FreshIdSupply m
-> ConnectionState peerAddr handle handleError
version m
-> STM m (MutableConnState peerAddr handle handleError
version m)
newMutableConnState :: forall peerAddr handle handleError version (m :: * -> *).
(MonadTraceSTM m, Typeable peerAddr) =>
peerAddr
-> FreshIdSupply m
-> ConnectionState peerAddr handle handleError version m
-> STM m (MutableConnState peerAddr handle handleError version m)
newMutableConnState peerAddr
peerAddr FreshIdSupply m
freshIdSupply ConnectionState peerAddr handle handleError version m
connState = do
connStateId <- FreshIdSupply m -> STM m Int
forall (m :: * -> *). FreshIdSupply m -> STM m Int
getFreshId FreshIdSupply m
freshIdSupply
connVar <- newTVar connState
traceTVar
(Proxy @m) connVar
(\Maybe (ConnectionState peerAddr handle handleError version m)
mbPrev ConnectionState peerAddr handle handleError version m
curr ->
let currAbs :: AbstractState
currAbs = MaybeUnknown
(ConnectionState peerAddr handle handleError version m)
-> AbstractState
forall muxMode peerAddr m a (b :: * -> *).
MaybeUnknown (ConnectionState muxMode peerAddr m a b)
-> AbstractState
abstractState (ConnectionState peerAddr handle handleError version m
-> MaybeUnknown
(ConnectionState peerAddr handle handleError version m)
forall state. state -> MaybeUnknown state
Known ConnectionState peerAddr handle handleError version m
curr)
in case Maybe (ConnectionState peerAddr handle handleError version m)
mbPrev of
Just ConnectionState peerAddr handle handleError version m
prev |
let prevAbs :: AbstractState
prevAbs = MaybeUnknown
(ConnectionState peerAddr handle handleError version m)
-> AbstractState
forall muxMode peerAddr m a (b :: * -> *).
MaybeUnknown (ConnectionState muxMode peerAddr m a b)
-> AbstractState
abstractState (ConnectionState peerAddr handle handleError version m
-> MaybeUnknown
(ConnectionState peerAddr handle handleError version m)
forall state. state -> MaybeUnknown state
Known ConnectionState peerAddr handle handleError version m
prev)
, AbstractState
prevAbs AbstractState -> AbstractState -> Bool
forall a. Eq a => a -> a -> Bool
/= AbstractState
currAbs -> TraceValue -> InspectMonad m TraceValue
forall a. a -> InspectMonad m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
(TraceValue -> InspectMonad m TraceValue)
-> TraceValue -> InspectMonad m TraceValue
forall a b. (a -> b) -> a -> b
$ WithName Int (TransitionTrace' peerAddr AbstractState)
-> TraceValue
forall tr. Typeable tr => tr -> TraceValue
TraceDynamic
(WithName Int (TransitionTrace' peerAddr AbstractState)
-> TraceValue)
-> WithName Int (TransitionTrace' peerAddr AbstractState)
-> TraceValue
forall a b. (a -> b) -> a -> b
$ Int
-> TransitionTrace' peerAddr AbstractState
-> WithName Int (TransitionTrace' peerAddr AbstractState)
forall name event. name -> event -> WithName name event
WithName Int
connStateId
(TransitionTrace' peerAddr AbstractState
-> WithName Int (TransitionTrace' peerAddr AbstractState))
-> TransitionTrace' peerAddr AbstractState
-> WithName Int (TransitionTrace' peerAddr AbstractState)
forall a b. (a -> b) -> a -> b
$ peerAddr
-> Transition' AbstractState
-> TransitionTrace' peerAddr AbstractState
forall peerAddr state.
peerAddr -> Transition' state -> TransitionTrace' peerAddr state
TransitionTrace peerAddr
peerAddr
(Transition' AbstractState
-> TransitionTrace' peerAddr AbstractState)
-> Transition' AbstractState
-> TransitionTrace' peerAddr AbstractState
forall a b. (a -> b) -> a -> b
$ AbstractState -> AbstractState -> Transition' AbstractState
mkAbsTransition AbstractState
prevAbs
AbstractState
currAbs
Maybe (ConnectionState peerAddr handle handleError version m)
Nothing -> TraceValue -> InspectMonad m TraceValue
forall a. a -> InspectMonad m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
(TraceValue -> InspectMonad m TraceValue)
-> TraceValue -> InspectMonad m TraceValue
forall a b. (a -> b) -> a -> b
$ WithName Int (TransitionTrace' peerAddr AbstractState)
-> TraceValue
forall tr. Typeable tr => tr -> TraceValue
TraceDynamic
(WithName Int (TransitionTrace' peerAddr AbstractState)
-> TraceValue)
-> WithName Int (TransitionTrace' peerAddr AbstractState)
-> TraceValue
forall a b. (a -> b) -> a -> b
$ Int
-> TransitionTrace' peerAddr AbstractState
-> WithName Int (TransitionTrace' peerAddr AbstractState)
forall name event. name -> event -> WithName name event
WithName Int
connStateId
(TransitionTrace' peerAddr AbstractState
-> WithName Int (TransitionTrace' peerAddr AbstractState))
-> TransitionTrace' peerAddr AbstractState
-> WithName Int (TransitionTrace' peerAddr AbstractState)
forall a b. (a -> b) -> a -> b
$ peerAddr
-> Transition' AbstractState
-> TransitionTrace' peerAddr AbstractState
forall peerAddr state.
peerAddr -> Transition' state -> TransitionTrace' peerAddr state
TransitionTrace peerAddr
peerAddr
(Transition' AbstractState
-> TransitionTrace' peerAddr AbstractState)
-> Transition' AbstractState
-> TransitionTrace' peerAddr AbstractState
forall a b. (a -> b) -> a -> b
$ AbstractState -> AbstractState -> Transition' AbstractState
mkAbsTransition AbstractState
TerminatedSt
AbstractState
currAbs
Maybe (ConnectionState peerAddr handle handleError version m)
_ -> TraceValue -> InspectMonad m TraceValue
forall a. a -> InspectMonad m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TraceValue
DontTrace
)
return $ MutableConnState { connStateId, connVar }
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 =
(ConnectionState peerAddr handle handleError version m
-> ConnectionManagerCounters)
-> Map
peerAddr (ConnectionState peerAddr handle handleError version m)
-> ConnectionManagerCounters
forall m a. Monoid m => (a -> m) -> Map peerAddr a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap' ConnectionState peerAddr handle handleError version m
-> ConnectionManagerCounters
forall peerAddr handle handleError version (m :: * -> *).
ConnectionState peerAddr handle handleError version m
-> ConnectionManagerCounters
connectionStateToCounters
data ConnectionState peerAddr handle handleError version m =
ReservedOutboundState
| UnnegotiatedState !Provenance
!(ConnectionId peerAddr)
(Async m ())
| OutboundUniState !(ConnectionId peerAddr) !(Async m ()) !handle
| OutboundDupState !(ConnectionId peerAddr) !(Async m ()) !handle !TimeoutExpired
| 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)
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
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 -> ConnectionManagerCounters
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
ConnectionManagerCounters
-> ConnectionManagerCounters -> ConnectionManagerCounters
forall a. Semigroup a => a -> a -> a
<> ConnectionManagerCounters
outboundConn
OutboundDupState ConnectionId peerAddr
_ Async m ()
_ handle
_ TimeoutExpired
_ -> ConnectionManagerCounters
duplexConn
ConnectionManagerCounters
-> ConnectionManagerCounters -> ConnectionManagerCounters
forall a. Semigroup a => a -> a -> a
<> ConnectionManagerCounters
outboundConn
OutboundIdleState ConnectionId peerAddr
_ Async m ()
_ handle
_ DataFlow
Unidirectional -> ConnectionManagerCounters
unidirectionalConn
ConnectionManagerCounters
-> ConnectionManagerCounters -> ConnectionManagerCounters
forall a. Semigroup a => a -> a -> a
<> ConnectionManagerCounters
outboundConn
OutboundIdleState ConnectionId peerAddr
_ Async m ()
_ handle
_ DataFlow
Duplex -> ConnectionManagerCounters
duplexConn
ConnectionManagerCounters
-> ConnectionManagerCounters -> ConnectionManagerCounters
forall a. Semigroup a => a -> a -> a
<> ConnectionManagerCounters
outboundConn
InboundIdleState ConnectionId peerAddr
_ Async m ()
_ handle
_ DataFlow
Unidirectional -> ConnectionManagerCounters
unidirectionalConn
ConnectionManagerCounters
-> ConnectionManagerCounters -> ConnectionManagerCounters
forall a. Semigroup a => a -> a -> a
<> ConnectionManagerCounters
inboundConn
InboundIdleState ConnectionId peerAddr
_ Async m ()
_ handle
_ DataFlow
Duplex -> ConnectionManagerCounters
duplexConn
ConnectionManagerCounters
-> ConnectionManagerCounters -> ConnectionManagerCounters
forall a. Semigroup a => a -> a -> a
<> ConnectionManagerCounters
inboundConn
InboundState ConnectionId peerAddr
_ Async m ()
_ handle
_ DataFlow
Unidirectional -> ConnectionManagerCounters
unidirectionalConn
ConnectionManagerCounters
-> ConnectionManagerCounters -> ConnectionManagerCounters
forall a. Semigroup a => a -> a -> a
<> ConnectionManagerCounters
inboundConn
InboundState ConnectionId peerAddr
_ Async m ()
_ handle
_ DataFlow
Duplex -> ConnectionManagerCounters
duplexConn
ConnectionManagerCounters
-> ConnectionManagerCounters -> ConnectionManagerCounters
forall a. Semigroup a => a -> a -> a
<> ConnectionManagerCounters
inboundConn
DuplexState ConnectionId peerAddr
_ Async m ()
_ handle
_ -> ConnectionManagerCounters
fullDuplexConn
ConnectionManagerCounters
-> ConnectionManagerCounters -> ConnectionManagerCounters
forall a. Semigroup a => a -> a -> a
<> ConnectionManagerCounters
duplexConn
ConnectionManagerCounters
-> ConnectionManagerCounters -> ConnectionManagerCounters
forall a. Semigroup a => a -> a -> a
<> ConnectionManagerCounters
inboundConn
ConnectionManagerCounters
-> ConnectionManagerCounters -> ConnectionManagerCounters
forall a. Semigroup a => a -> a -> a
<> ConnectionManagerCounters
outboundConn
TerminatingState ConnectionId peerAddr
_ Async m ()
_ Maybe handleError
_ -> ConnectionManagerCounters
forall a. Monoid a => a
mempty
TerminatedState Maybe handleError
_ -> ConnectionManagerCounters
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) =
[String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String
"UnnegotiatedState "
, Provenance -> String
forall a. Show a => a -> String
show Provenance
pr
, String
" "
, ConnectionId peerAddr -> String
forall a. Show a => a -> String
show ConnectionId peerAddr
connId
, String
" "
, ThreadId m -> String
forall a. Show a => a -> String
show (Async m () -> ThreadId m
forall a. Async m a -> ThreadId m
forall (m :: * -> *) a. MonadAsync m => Async m a -> ThreadId m
asyncThreadId Async m ()
connThread)
]
show (OutboundUniState ConnectionId peerAddr
connId Async m ()
connThread handle
_handle) =
[String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ String
"OutboundState Unidirectional "
, ConnectionId peerAddr -> String
forall a. Show a => a -> String
show ConnectionId peerAddr
connId
, String
" "
, ThreadId m -> String
forall a. Show a => a -> String
show (Async m () -> ThreadId m
forall a. Async m a -> ThreadId m
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) =
[String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ String
"OutboundState "
, ConnectionId peerAddr -> String
forall a. Show a => a -> String
show ConnectionId peerAddr
connId
, String
" "
, ThreadId m -> String
forall a. Show a => a -> String
show (Async m () -> ThreadId m
forall a. Async m a -> ThreadId m
forall (m :: * -> *) a. MonadAsync m => Async m a -> ThreadId m
asyncThreadId Async m ()
connThread)
, String
" "
, TimeoutExpired -> String
forall a. Show a => a -> String
show TimeoutExpired
expired
]
show (OutboundIdleState ConnectionId peerAddr
connId Async m ()
connThread handle
_handle DataFlow
df) =
[String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ String
"OutboundIdleState "
, ConnectionId peerAddr -> String
forall a. Show a => a -> String
show ConnectionId peerAddr
connId
, String
" "
, ThreadId m -> String
forall a. Show a => a -> String
show (Async m () -> ThreadId m
forall a. Async m a -> ThreadId m
forall (m :: * -> *) a. MonadAsync m => Async m a -> ThreadId m
asyncThreadId Async m ()
connThread)
, String
" "
, DataFlow -> String
forall a. Show a => a -> String
show DataFlow
df
]
show (InboundIdleState ConnectionId peerAddr
connId Async m ()
connThread handle
_handle DataFlow
df) =
[String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ String
"InboundIdleState "
, ConnectionId peerAddr -> String
forall a. Show a => a -> String
show ConnectionId peerAddr
connId
, String
" "
, ThreadId m -> String
forall a. Show a => a -> String
show (Async m () -> ThreadId m
forall a. Async m a -> ThreadId m
forall (m :: * -> *) a. MonadAsync m => Async m a -> ThreadId m
asyncThreadId Async m ()
connThread)
, String
" "
, DataFlow -> String
forall a. Show a => a -> String
show DataFlow
df
]
show (InboundState ConnectionId peerAddr
connId Async m ()
connThread handle
_handle DataFlow
df) =
[String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ String
"InboundState "
, ConnectionId peerAddr -> String
forall a. Show a => a -> String
show ConnectionId peerAddr
connId
, String
" "
, ThreadId m -> String
forall a. Show a => a -> String
show (Async m () -> ThreadId m
forall a. Async m a -> ThreadId m
forall (m :: * -> *) a. MonadAsync m => Async m a -> ThreadId m
asyncThreadId Async m ()
connThread)
, String
" "
, DataFlow -> String
forall a. Show a => a -> String
show DataFlow
df
]
show (DuplexState ConnectionId peerAddr
connId Async m ()
connThread handle
_handle) =
[String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ String
"DuplexState "
, ConnectionId peerAddr -> String
forall a. Show a => a -> String
show ConnectionId peerAddr
connId
, String
" "
, ThreadId m -> String
forall a. Show a => a -> String
show (Async m () -> ThreadId m
forall a. Async m a -> ThreadId m
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) =
[String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([ String
"TerminatingState "
, ConnectionId peerAddr -> String
forall a. Show a => a -> String
show ConnectionId peerAddr
connId
, String
" "
, ThreadId m -> String
forall a. Show a => a -> String
show (Async m () -> ThreadId m
forall a. Async m a -> ThreadId m
forall (m :: * -> *) a. MonadAsync m => Async m a -> ThreadId m
asyncThreadId Async m ()
connThread)
]
[String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ Maybe String -> [String]
forall a. Maybe a -> [a]
maybeToList ((Char
' ' Char -> ShowS
forall a. a -> [a] -> [a]
:) ShowS -> (handleError -> String) -> handleError -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. handleError -> String
forall a. Show a => a -> String
show (handleError -> String) -> Maybe handleError -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe handleError
handleError))
show (TerminatedState Maybe handleError
handleError) =
[String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([String
"TerminatedState"]
[String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ Maybe String -> [String]
forall a. Maybe a -> [a]
maybeToList ((Char
' ' Char -> ShowS
forall a. a -> [a] -> [a]
:) ShowS -> (handleError -> String) -> handleError -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. handleError -> String
forall a. Show a => a -> String
show (handleError -> String) -> Maybe handleError -> Maybe String
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 = Maybe (Async m ())
forall a. Maybe a
Nothing
getConnThread (UnnegotiatedState Provenance
_pr ConnectionId peerAddr
_connId Async m ()
connThread) = Async m () -> Maybe (Async m ())
forall a. a -> Maybe a
Just Async m ()
connThread
getConnThread (OutboundUniState ConnectionId peerAddr
_connId Async m ()
connThread handle
_handle ) = Async m () -> Maybe (Async m ())
forall a. a -> Maybe a
Just Async m ()
connThread
getConnThread (OutboundDupState ConnectionId peerAddr
_connId Async m ()
connThread handle
_handle TimeoutExpired
_te) = Async m () -> Maybe (Async m ())
forall a. a -> Maybe a
Just Async m ()
connThread
getConnThread (OutboundIdleState ConnectionId peerAddr
_connId Async m ()
connThread handle
_handle DataFlow
_df) = Async m () -> Maybe (Async m ())
forall a. a -> Maybe a
Just Async m ()
connThread
getConnThread (InboundIdleState ConnectionId peerAddr
_connId Async m ()
connThread handle
_handle DataFlow
_df) = Async m () -> Maybe (Async m ())
forall a. a -> Maybe a
Just Async m ()
connThread
getConnThread (InboundState ConnectionId peerAddr
_connId Async m ()
connThread handle
_handle DataFlow
_df) = Async m () -> Maybe (Async m ())
forall a. a -> Maybe a
Just Async m ()
connThread
getConnThread (DuplexState ConnectionId peerAddr
_connId Async m ()
connThread handle
_handle) = Async m () -> Maybe (Async m ())
forall a. a -> Maybe a
Just Async m ()
connThread
getConnThread (TerminatingState ConnectionId peerAddr
_connId Async m ()
connThread Maybe handleError
_handleError) = Async m () -> Maybe (Async m ())
forall a. a -> Maybe a
Just Async m ()
connThread
getConnThread TerminatedState {} = Maybe (Async m ())
forall a. Maybe a
Nothing
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 = Maybe ConnectionType
forall a. Maybe a
Nothing
getConnType (UnnegotiatedState Provenance
pr ConnectionId peerAddr
_connId Async m ()
_connThread) = ConnectionType -> Maybe ConnectionType
forall a. a -> Maybe a
Just (Provenance -> ConnectionType
UnnegotiatedConn Provenance
pr)
getConnType (OutboundUniState ConnectionId peerAddr
_connId Async m ()
_connThread handle
_handle) = ConnectionType -> Maybe ConnectionType
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) = ConnectionType -> Maybe ConnectionType
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) = ConnectionType -> Maybe ConnectionType
forall a. a -> Maybe a
Just (DataFlow -> ConnectionType
OutboundIdleConn DataFlow
df)
getConnType (InboundIdleState ConnectionId peerAddr
_connId Async m ()
_connThread handle
_handle DataFlow
df) = ConnectionType -> Maybe ConnectionType
forall a. a -> Maybe a
Just (DataFlow -> ConnectionType
InboundIdleConn DataFlow
df)
getConnType (InboundState ConnectionId peerAddr
_connId Async m ()
_connThread handle
_handle DataFlow
df) = ConnectionType -> Maybe ConnectionType
forall a. a -> Maybe a
Just (Provenance -> DataFlow -> ConnectionType
NegotiatedConn Provenance
Inbound DataFlow
df)
getConnType (DuplexState ConnectionId peerAddr
_connId Async m ()
_connThread handle
_handle) = ConnectionType -> Maybe ConnectionType
forall a. a -> Maybe a
Just ConnectionType
DuplexConn
getConnType (TerminatingState ConnectionId peerAddr
_connId Async m ()
_connThread Maybe handleError
_handleError) = Maybe ConnectionType
forall a. Maybe a
Nothing
getConnType TerminatedState {} = Maybe ConnectionType
forall a. Maybe a
Nothing
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 Provenance -> Provenance -> Bool
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' -> ConnectionState muxMode peerAddr m a b -> AbstractState
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' -> ConnectionState muxMode peerAddr m a b -> AbstractState
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
defaultTimeWaitTimeout :: DiffTime
defaultTimeWaitTimeout :: DiffTime
defaultTimeWaitTimeout = DiffTime
60
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 () }
data DemoteToColdLocal peerAddr handlerTrace handle handleError version m
= DemotedToColdLocal (ConnectionId peerAddr)
(Async m ())
(StrictTVar m (ConnectionState
peerAddr handle
handleError version m))
!(Transition (ConnectionState
peerAddr handle
handleError version m))
| DemoteToColdLocalNoop !(Maybe (Transition (ConnectionState
peerAddr handle
handleError version m)))
!AbstractState
| PruneConnections (PruneAction m)
!(Either
(ConnectionState
peerAddr handle
handleError version m)
(Transition (ConnectionState
peerAddr handle
handleError version m))
)
| DemoteToColdLocalError (Trace peerAddr handlerTrace)
!AbstractState
with
:: forall (muxMode :: Mx.Mode) 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
)
=> Arguments 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)
-> (ConnectionManager muxMode socket peerAddr handle handleError m -> m a)
-> m a
with :: forall (muxMode :: Mode) 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) =>
Arguments
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)
-> (ConnectionManager muxMode socket peerAddr handle handleError m
-> m a)
-> m a
with args :: Arguments
handlerTrace
socket
peerAddr
handle
handleError
version
versionData
m
args@Arguments {
tracer :: forall handlerTrace socket peerAddr handle handleError
versionNumber versionData (m :: * -> *).
Arguments
handlerTrace
socket
peerAddr
handle
handleError
versionNumber
versionData
m
-> Tracer m (Trace peerAddr handlerTrace)
tracer = Tracer m (Trace peerAddr handlerTrace)
tracer,
trTracer :: forall handlerTrace socket peerAddr handle handleError
versionNumber versionData (m :: * -> *).
Arguments
handlerTrace
socket
peerAddr
handle
handleError
versionNumber
versionData
m
-> Tracer
m
(TransitionTrace
peerAddr
(ConnectionState peerAddr handle handleError versionNumber m))
trTracer = Tracer
m
(TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m))
trTracer,
muxTracer :: forall handlerTrace socket peerAddr handle handleError
versionNumber versionData (m :: * -> *).
Arguments
handlerTrace
socket
peerAddr
handle
handleError
versionNumber
versionData
m
-> Tracer m (WithBearer (ConnectionId peerAddr) Trace)
muxTracer = Tracer m (WithBearer (ConnectionId peerAddr) Trace)
muxTracer,
Maybe peerAddr
ipv4Address :: forall handlerTrace socket peerAddr handle handleError
versionNumber versionData (m :: * -> *).
Arguments
handlerTrace
socket
peerAddr
handle
handleError
versionNumber
versionData
m
-> Maybe peerAddr
ipv4Address :: Maybe peerAddr
ipv4Address,
Maybe peerAddr
ipv6Address :: forall handlerTrace socket peerAddr handle handleError
versionNumber versionData (m :: * -> *).
Arguments
handlerTrace
socket
peerAddr
handle
handleError
versionNumber
versionData
m
-> Maybe peerAddr
ipv6Address :: Maybe peerAddr
ipv6Address,
peerAddr -> Maybe AddressType
addressType :: forall handlerTrace socket peerAddr handle handleError
versionNumber versionData (m :: * -> *).
Arguments
handlerTrace
socket
peerAddr
handle
handleError
versionNumber
versionData
m
-> peerAddr -> Maybe AddressType
addressType :: peerAddr -> Maybe AddressType
addressType,
Snocket m socket peerAddr
snocket :: forall handlerTrace socket peerAddr handle handleError
versionNumber versionData (m :: * -> *).
Arguments
handlerTrace
socket
peerAddr
handle
handleError
versionNumber
versionData
m
-> Snocket m socket peerAddr
snocket :: Snocket m socket peerAddr
snocket,
MakeBearer m socket
makeBearer :: forall handlerTrace socket peerAddr handle handleError
versionNumber versionData (m :: * -> *).
Arguments
handlerTrace
socket
peerAddr
handle
handleError
versionNumber
versionData
m
-> MakeBearer m socket
makeBearer :: MakeBearer m socket
makeBearer,
socket -> Maybe peerAddr -> m ()
configureSocket :: forall handlerTrace socket peerAddr handle handleError
versionNumber versionData (m :: * -> *).
Arguments
handlerTrace
socket
peerAddr
handle
handleError
versionNumber
versionData
m
-> socket -> Maybe peerAddr -> m ()
configureSocket :: socket -> Maybe peerAddr -> m ()
configureSocket,
DiffTime
timeWaitTimeout :: forall handlerTrace socket peerAddr handle handleError
versionNumber versionData (m :: * -> *).
Arguments
handlerTrace
socket
peerAddr
handle
handleError
versionNumber
versionData
m
-> DiffTime
timeWaitTimeout :: DiffTime
timeWaitTimeout,
DiffTime
outboundIdleTimeout :: forall handlerTrace socket peerAddr handle handleError
versionNumber versionData (m :: * -> *).
Arguments
handlerTrace
socket
peerAddr
handle
handleError
versionNumber
versionData
m
-> DiffTime
outboundIdleTimeout :: DiffTime
outboundIdleTimeout,
versionData -> DataFlow
connectionDataFlow :: forall handlerTrace socket peerAddr handle handleError
versionNumber versionData (m :: * -> *).
Arguments
handlerTrace
socket
peerAddr
handle
handleError
versionNumber
versionData
m
-> versionData -> DataFlow
connectionDataFlow :: versionData -> DataFlow
connectionDataFlow,
PrunePolicy peerAddr
prunePolicy :: forall handlerTrace socket peerAddr handle handleError
versionNumber versionData (m :: * -> *).
Arguments
handlerTrace
socket
peerAddr
handle
handleError
versionNumber
versionData
m
-> PrunePolicy peerAddr
prunePolicy :: PrunePolicy peerAddr
prunePolicy,
AcceptedConnectionsLimit
connectionsLimits :: forall handlerTrace socket peerAddr handle handleError
versionNumber versionData (m :: * -> *).
Arguments
handlerTrace
socket
peerAddr
handle
handleError
versionNumber
versionData
m
-> AcceptedConnectionsLimit
connectionsLimits :: AcceptedConnectionsLimit
connectionsLimits
}
ConnectionHandler {
WithMuxTuple
muxMode
(ConnectionHandlerFn
handlerTrace
socket
peerAddr
handle
handleError
(version, versionData)
m)
connectionHandler :: WithMuxTuple
muxMode
(ConnectionHandlerFn
handlerTrace
socket
peerAddr
handle
handleError
(version, versionData)
m)
connectionHandler :: forall (muxMode :: Mode) handlerTrace socket peerAddr handle
handleError version (m :: * -> *).
ConnectionHandler
muxMode handlerTrace socket peerAddr handle handleError version m
-> WithMuxTuple
muxMode
(ConnectionHandlerFn
handlerTrace socket peerAddr handle handleError version m)
connectionHandler
}
handleError -> HandleErrorType
classifyHandleError
InResponderMode
muxMode (InformationChannel (NewConnectionInfo peerAddr handle) m)
inboundGovernorInfoChannel
ConnectionManager muxMode socket peerAddr handle handleError m
-> m a
k = do
((freshIdSupply, stateVar, stdGenVar)
:: ( FreshIdSupply m
, StrictTMVar m (ConnectionManagerState peerAddr handle handleError
version m)
, StrictTVar m StdGen
))
<- STM
m
(FreshIdSupply m,
StrictTMVar
m (ConnectionManagerState peerAddr handle handleError version m),
StrictTVar m StdGen)
-> m (FreshIdSupply m,
StrictTMVar
m (ConnectionManagerState peerAddr handle handleError version m),
StrictTVar m StdGen)
forall a. (?callStack::CallStack) => STM m a -> m a
forall (m :: * -> *) a.
(MonadSTM m, ?callStack::CallStack) =>
STM m a -> m a
atomically (STM
m
(FreshIdSupply m,
StrictTMVar
m (ConnectionManagerState peerAddr handle handleError version m),
StrictTVar m StdGen)
-> m (FreshIdSupply m,
StrictTMVar
m (ConnectionManagerState peerAddr handle handleError version m),
StrictTVar m StdGen))
-> STM
m
(FreshIdSupply m,
StrictTMVar
m (ConnectionManagerState peerAddr handle handleError version m),
StrictTVar m StdGen)
-> m (FreshIdSupply m,
StrictTMVar
m (ConnectionManagerState peerAddr handle handleError version m),
StrictTVar m StdGen)
forall a b. (a -> b) -> a -> b
$ do
v <- ConnectionManagerState peerAddr handle handleError version m
-> STM
m
(StrictTMVar
m (ConnectionManagerState peerAddr handle handleError version m))
forall (m :: * -> *) a. MonadSTM m => a -> STM m (StrictTMVar m a)
newTMVar ConnectionManagerState peerAddr handle handleError version m
forall k a. Map k a
Map.empty
labelTMVar v "cm-state"
traceTMVar (Proxy :: Proxy m) v
$ \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)
_) -> TraceValue -> InspectMonad m TraceValue
forall a. a -> InspectMonad m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TraceValue
DontTrace
(Just (Just ConnectionManagerState peerAddr handle handleError version m
_), Maybe
(ConnectionManagerState peerAddr handle handleError version m)
Nothing) -> TraceValue -> InspectMonad m TraceValue
forall a. a -> InspectMonad m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> TraceValue
TraceString String
"cm-state: taken")
(Just Maybe
(ConnectionManagerState peerAddr handle handleError version m)
Nothing, Just ConnectionManagerState peerAddr handle handleError version m
_) -> TraceValue -> InspectMonad m TraceValue
forall a. a -> InspectMonad m a
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)
_) -> TraceValue -> InspectMonad m TraceValue
forall a. a -> InspectMonad m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TraceValue
DontTrace
freshIdSupply <- newFreshIdSupply (Proxy :: Proxy m)
stdGenVar <- newTVar (stdGen args)
return (freshIdSupply, v, stdGenVar)
let readState
:: STM m (Map peerAddr AbstractState)
readState = do
state <- StrictTMVar
m (ConnectionManagerState peerAddr handle handleError version m)
-> STM
m (ConnectionManagerState peerAddr handle handleError version m)
forall (m :: * -> *) a. MonadSTM m => StrictTMVar m a -> STM m a
readTMVar StrictTMVar
m (ConnectionManagerState peerAddr handle handleError version m)
stateVar
traverse ( fmap (abstractState . Known)
. readTVar
. connVar
)
state
waitForOutboundDemotion
:: peerAddr
-> STM m ()
waitForOutboundDemotion peerAddr
addr = do
state <- STM m (Map peerAddr AbstractState)
readState
case Map.lookup addr state of
Maybe AbstractState
Nothing -> () -> STM m ()
forall a. a -> STM m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just AbstractState
UnknownConnectionSt -> () -> STM m ()
forall a. a -> STM m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just InboundIdleSt {} -> () -> STM m ()
forall a. a -> STM m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just InboundSt {} -> () -> STM m ()
forall a. a -> STM m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just AbstractState
WaitRemoteIdleSt -> () -> STM m ()
forall a. a -> STM m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just AbstractState
TerminatedSt -> () -> STM m ()
forall a. a -> STM m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just (UnnegotiatedSt Provenance
Inbound) -> () -> STM m ()
forall a. a -> STM m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just (UnnegotiatedSt Provenance
Outbound) -> STM m ()
forall a. STM m a
forall (m :: * -> *) a. MonadSTM m => STM m a
retry
Just AbstractState
ReservedOutboundSt -> STM m ()
forall a. STM m a
forall (m :: * -> *) a. MonadSTM m => STM m a
retry
Just AbstractState
OutboundUniSt -> STM m ()
forall a. STM m a
forall (m :: * -> *) a. MonadSTM m => STM m a
retry
Just OutboundIdleSt {} -> STM m ()
forall a. STM m a
forall (m :: * -> *) a. MonadSTM m => STM m a
retry
Just OutboundDupSt {} -> STM m ()
forall a. STM m a
forall (m :: * -> *) a. MonadSTM m => STM m a
retry
Just AbstractState
DuplexSt -> STM m ()
forall a. STM m a
forall (m :: * -> *) a. MonadSTM m => STM m a
retry
Just AbstractState
TerminatingSt -> STM m ()
forall a. STM m a
forall (m :: * -> *) a. MonadSTM m => STM m a
retry
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 =
OutboundConnectionManager
'InitiatorMode socket peerAddr handle handleError m
-> WithMuxMode
'InitiatorMode
(OutboundConnectionManager
'InitiatorMode socket peerAddr handle handleError m)
(InboundConnectionManager
'InitiatorMode socket peerAddr handle handleError m)
forall a b. a -> WithMuxMode 'InitiatorMode a b
WithInitiatorMode
OutboundConnectionManager {
ocmAcquireConnection :: AcquireOutboundConnection peerAddr handle handleError m
ocmAcquireConnection =
(?callStack::CallStack) =>
FreshIdSupply m
-> StrictTMVar
m (ConnectionManagerState peerAddr handle handleError version m)
-> ConnectionHandlerFn
handlerTrace
socket
peerAddr
handle
handleError
(version, versionData)
m
-> AcquireOutboundConnection peerAddr handle handleError m
FreshIdSupply m
-> StrictTMVar
m (ConnectionManagerState peerAddr handle handleError version m)
-> ConnectionHandlerFn
handlerTrace
socket
peerAddr
handle
handleError
(version, versionData)
m
-> AcquireOutboundConnection peerAddr handle handleError m
acquireOutboundConnectionImpl FreshIdSupply m
freshIdSupply StrictTMVar
m (ConnectionManagerState peerAddr handle handleError version m)
stateVar
ConnectionHandlerFn
handlerTrace
socket
peerAddr
handle
handleError
(version, versionData)
m
outboundHandler,
ocmReleaseConnection :: peerAddr -> m (OperationResult AbstractState)
ocmReleaseConnection =
StrictTMVar
m (ConnectionManagerState peerAddr handle handleError version m)
-> StrictTVar m StdGen
-> peerAddr
-> m (OperationResult AbstractState)
releaseOutboundConnectionImpl StrictTMVar
m (ConnectionManagerState peerAddr handle handleError version m)
stateVar StrictTVar m StdGen
stdGenVar
},
STM m (Map peerAddr AbstractState)
readState :: STM m (Map peerAddr AbstractState)
readState :: STM m (Map peerAddr AbstractState)
readState,
peerAddr -> STM m ()
waitForOutboundDemotion :: peerAddr -> STM m ()
waitForOutboundDemotion :: peerAddr -> STM m ()
waitForOutboundDemotion
}
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 =
InboundConnectionManager
'ResponderMode socket peerAddr handle handleError m
-> WithMuxMode
'ResponderMode
(OutboundConnectionManager
'ResponderMode socket peerAddr handle handleError m)
(InboundConnectionManager
'ResponderMode socket peerAddr handle handleError m)
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
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,
icmReleaseConnection :: peerAddr -> m (OperationResult DemotedToColdRemoteTr)
icmReleaseConnection =
StrictTMVar
m (ConnectionManagerState peerAddr handle handleError version m)
-> peerAddr -> m (OperationResult DemotedToColdRemoteTr)
releaseInboundConnectionImpl StrictTMVar
m (ConnectionManagerState peerAddr handle handleError version m)
stateVar,
icmPromotedToWarmRemote :: peerAddr -> m (OperationResult AbstractState)
icmPromotedToWarmRemote =
StrictTMVar
m (ConnectionManagerState peerAddr handle handleError version m)
-> StrictTVar m StdGen
-> peerAddr
-> m (OperationResult AbstractState)
promotedToWarmRemoteImpl StrictTMVar
m (ConnectionManagerState peerAddr handle handleError version m)
stateVar StrictTVar m StdGen
stdGenVar,
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 =
StrictTMVar
m (ConnectionManagerState peerAddr handle handleError version m)
-> STM
m (ConnectionManagerState peerAddr handle handleError version m)
forall (m :: * -> *) a. MonadSTM m => StrictTMVar m a -> STM m a
readTMVar StrictTMVar
m (ConnectionManagerState peerAddr handle handleError version m)
stateVar STM
m (ConnectionManagerState peerAddr handle handleError version m)
-> (ConnectionManagerState peerAddr handle handleError version m
-> STM m Int)
-> STM m Int
forall a b. STM m a -> (a -> STM m b) -> STM m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ConnectionManagerState peerAddr handle handleError version m
-> STM m Int
countIncomingConnections
},
STM m (Map peerAddr AbstractState)
readState :: STM m (Map peerAddr AbstractState)
readState :: STM m (Map peerAddr AbstractState)
readState,
peerAddr -> STM m ()
waitForOutboundDemotion :: peerAddr -> STM m ()
waitForOutboundDemotion :: peerAddr -> STM m ()
waitForOutboundDemotion
}
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 =
OutboundConnectionManager
'InitiatorResponderMode socket peerAddr handle handleError m
-> InboundConnectionManager
'InitiatorResponderMode socket peerAddr handle handleError m
-> WithMuxMode
'InitiatorResponderMode
(OutboundConnectionManager
'InitiatorResponderMode socket peerAddr handle handleError m)
(InboundConnectionManager
'InitiatorResponderMode socket peerAddr handle handleError m)
forall a b. a -> b -> WithMuxMode 'InitiatorResponderMode a b
WithInitiatorResponderMode
OutboundConnectionManager {
ocmAcquireConnection :: AcquireOutboundConnection peerAddr handle handleError m
ocmAcquireConnection =
(?callStack::CallStack) =>
FreshIdSupply m
-> StrictTMVar
m (ConnectionManagerState peerAddr handle handleError version m)
-> ConnectionHandlerFn
handlerTrace
socket
peerAddr
handle
handleError
(version, versionData)
m
-> AcquireOutboundConnection peerAddr handle handleError m
FreshIdSupply m
-> StrictTMVar
m (ConnectionManagerState peerAddr handle handleError version m)
-> ConnectionHandlerFn
handlerTrace
socket
peerAddr
handle
handleError
(version, versionData)
m
-> AcquireOutboundConnection peerAddr handle handleError m
acquireOutboundConnectionImpl FreshIdSupply m
freshIdSupply StrictTMVar
m (ConnectionManagerState peerAddr handle handleError version m)
stateVar
ConnectionHandlerFn
handlerTrace
socket
peerAddr
handle
handleError
(version, versionData)
m
outboundHandler,
ocmReleaseConnection :: peerAddr -> m (OperationResult AbstractState)
ocmReleaseConnection =
StrictTMVar
m (ConnectionManagerState peerAddr handle handleError version m)
-> StrictTVar m StdGen
-> peerAddr
-> m (OperationResult AbstractState)
releaseOutboundConnectionImpl StrictTMVar
m (ConnectionManagerState peerAddr handle handleError version m)
stateVar StrictTVar m StdGen
stdGenVar
}
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
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,
icmReleaseConnection :: peerAddr -> m (OperationResult DemotedToColdRemoteTr)
icmReleaseConnection =
StrictTMVar
m (ConnectionManagerState peerAddr handle handleError version m)
-> peerAddr -> m (OperationResult DemotedToColdRemoteTr)
releaseInboundConnectionImpl StrictTMVar
m (ConnectionManagerState peerAddr handle handleError version m)
stateVar,
icmPromotedToWarmRemote :: peerAddr -> m (OperationResult AbstractState)
icmPromotedToWarmRemote =
StrictTMVar
m (ConnectionManagerState peerAddr handle handleError version m)
-> StrictTVar m StdGen
-> peerAddr
-> m (OperationResult AbstractState)
promotedToWarmRemoteImpl StrictTMVar
m (ConnectionManagerState peerAddr handle handleError version m)
stateVar StrictTVar m StdGen
stdGenVar,
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 =
StrictTMVar
m (ConnectionManagerState peerAddr handle handleError version m)
-> STM
m (ConnectionManagerState peerAddr handle handleError version m)
forall (m :: * -> *) a. MonadSTM m => StrictTMVar m a -> STM m a
readTMVar StrictTMVar
m (ConnectionManagerState peerAddr handle handleError version m)
stateVar STM
m (ConnectionManagerState peerAddr handle handleError version m)
-> (ConnectionManagerState peerAddr handle handleError version m
-> STM m Int)
-> STM m Int
forall a b. STM m a -> (a -> STM m b) -> STM m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ConnectionManagerState peerAddr handle handleError version m
-> STM m Int
countIncomingConnections
},
STM m (Map peerAddr AbstractState)
readState :: STM m (Map peerAddr AbstractState)
readState :: STM m (Map peerAddr AbstractState)
readState,
peerAddr -> STM m ()
waitForOutboundDemotion :: peerAddr -> STM m ()
waitForOutboundDemotion :: peerAddr -> STM m ()
waitForOutboundDemotion
}
k connectionManager
`finally` uninterruptibleMask_ (do
traceWith tracer TrShutdown
state <- atomically $ readTMVar stateVar
asyncs <- Map.elems
<$> Map.traverseMaybeWithKey
(\peerAddr
peerAddr MutableConnState { 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 :: StrictTVar
m (ConnectionState peerAddr handle handleError version m)
connVar } -> do
(connState, trT, trU , shouldTraceTerminated, shouldTraceUnknown)
<- STM
m
(ConnectionState peerAddr handle handleError version m,
TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m),
TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m),
Bool, Bool)
-> m (ConnectionState peerAddr handle handleError version m,
TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m),
TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m),
Bool, Bool)
forall a. (?callStack::CallStack) => STM m a -> m a
forall (m :: * -> *) a.
(MonadSTM m, ?callStack::CallStack) =>
STM m a -> m a
atomically (STM
m
(ConnectionState peerAddr handle handleError version m,
TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m),
TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m),
Bool, Bool)
-> m (ConnectionState peerAddr handle handleError version m,
TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m),
TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m),
Bool, Bool))
-> STM
m
(ConnectionState peerAddr handle handleError version m,
TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m),
TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m),
Bool, Bool)
-> m (ConnectionState peerAddr handle handleError version m,
TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m),
TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m),
Bool, Bool)
forall a b. (a -> b) -> a -> b
$ do
connState <- StrictTVar
m (ConnectionState peerAddr handle handleError version m)
-> STM m (ConnectionState peerAddr handle handleError version m)
forall (m :: * -> *) a. MonadSTM m => StrictTVar m a -> STM m a
readTVar StrictTVar
m (ConnectionState peerAddr handle handleError version m)
connVar
let connState' = Maybe handleError
-> ConnectionState peerAddr handle handleError version m
forall peerAddr handle handleError version (m :: * -> *).
Maybe handleError
-> ConnectionState peerAddr handle handleError version m
TerminatedState Maybe handleError
forall a. Maybe a
Nothing
trT =
peerAddr
-> Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))
-> TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m)
forall peerAddr state.
peerAddr -> Transition' state -> TransitionTrace' peerAddr state
TransitionTrace peerAddr
peerAddr (ConnectionState peerAddr handle handleError version m
-> ConnectionState peerAddr handle handleError version m
-> Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))
forall state. state -> state -> Transition state
mkTransition ConnectionState peerAddr handle handleError version m
connState ConnectionState peerAddr handle handleError version m
forall {peerAddr} {handle} {handleError} {version} {m :: * -> *}.
ConnectionState peerAddr handle handleError version m
connState')
absConnState = MaybeUnknown
(ConnectionState peerAddr handle handleError version m)
-> AbstractState
forall muxMode peerAddr m a (b :: * -> *).
MaybeUnknown (ConnectionState muxMode peerAddr m a b)
-> AbstractState
abstractState (ConnectionState peerAddr handle handleError version m
-> MaybeUnknown
(ConnectionState peerAddr handle handleError version m)
forall state. state -> MaybeUnknown state
Known ConnectionState peerAddr handle handleError version m
connState)
shouldTraceTerminated = AbstractState
absConnState AbstractState -> AbstractState -> Bool
forall a. Eq a => a -> a -> Bool
/= AbstractState
TerminatedSt
shouldTraceUnknown = AbstractState
absConnState AbstractState -> AbstractState -> Bool
forall a. Eq a => a -> a -> Bool
== AbstractState
ReservedOutboundSt
trU = peerAddr
-> Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))
-> TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m)
forall peerAddr state.
peerAddr -> Transition' state -> TransitionTrace' peerAddr state
TransitionTrace
peerAddr
peerAddr
(Transition { fromState :: MaybeUnknown
(ConnectionState peerAddr handle handleError version m)
fromState = ConnectionState peerAddr handle handleError version m
-> MaybeUnknown
(ConnectionState peerAddr handle handleError version m)
forall state. state -> MaybeUnknown state
Known ConnectionState peerAddr handle handleError version m
forall {peerAddr} {handle} {handleError} {version} {m :: * -> *}.
ConnectionState peerAddr handle handleError version m
connState'
, toState :: MaybeUnknown
(ConnectionState peerAddr handle handleError version m)
toState = MaybeUnknown
(ConnectionState peerAddr handle handleError version m)
forall state. MaybeUnknown state
Unknown
})
writeTVar connVar connState'
return (connState, trT, trU
, shouldTraceTerminated, shouldTraceUnknown)
when shouldTraceTerminated $ do
traceWith trTracer trT
when shouldTraceUnknown $
traceWith trTracer trU
traverse
(\Async m ()
thread -> do
ThreadId m -> AsyncCancelled -> m ()
forall e. Exception e => ThreadId m -> e -> m ()
forall (m :: * -> *) e.
(MonadFork m, Exception e) =>
ThreadId m -> e -> m ()
throwTo (Async m () -> ThreadId m
forall a. Async m a -> ThreadId m
forall (m :: * -> *) a. MonadAsync m => Async m a -> ThreadId m
asyncThreadId Async m ()
thread) AsyncCancelled
AsyncCancelled
Async m () -> m (Async m ())
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Async m ()
thread
)
(getConnThread connState)
) state
atomically $ runLastToFinishM
$ foldMap (LastToFinishM . void <$> waitCatchSTM) 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
mState <- STM
m
(Map
peerAddr (ConnectionState peerAddr handle handleError version m))
-> m (Map
peerAddr (ConnectionState peerAddr handle handleError version m))
forall a. (?callStack::CallStack) => STM m a -> m a
forall (m :: * -> *) a.
(MonadSTM m, ?callStack::CallStack) =>
STM m a -> m a
atomically (STM
m
(Map
peerAddr (ConnectionState peerAddr handle handleError version m))
-> m (Map
peerAddr (ConnectionState peerAddr handle handleError version m)))
-> STM
m
(Map
peerAddr (ConnectionState peerAddr handle handleError version m))
-> m (Map
peerAddr (ConnectionState peerAddr handle handleError version m))
forall a b. (a -> b) -> a -> b
$ StrictTMVar
m (ConnectionManagerState peerAddr handle handleError version m)
-> STM
m (ConnectionManagerState peerAddr handle handleError version m)
forall (m :: * -> *) a. MonadSTM m => StrictTMVar m a -> STM m a
readTMVar StrictTMVar
m (ConnectionManagerState peerAddr handle handleError version m)
stateVar STM
m (ConnectionManagerState peerAddr handle handleError version m)
-> (ConnectionManagerState peerAddr handle handleError version m
-> STM
m
(Map
peerAddr (ConnectionState peerAddr handle handleError version m)))
-> STM
m
(Map
peerAddr (ConnectionState peerAddr handle handleError version m))
forall a b. STM m a -> (a -> STM m b) -> STM m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (MutableConnState peerAddr handle handleError version m
-> STM m (ConnectionState peerAddr handle handleError version m))
-> ConnectionManagerState peerAddr handle handleError version m
-> STM
m
(Map
peerAddr (ConnectionState peerAddr handle handleError version m))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Map peerAddr a -> f (Map peerAddr b)
traverse (StrictTVar
m (ConnectionState peerAddr handle handleError version m)
-> STM m (ConnectionState peerAddr handle handleError version m)
forall (m :: * -> *) a. MonadSTM m => StrictTVar m a -> STM m a
readTVar (StrictTVar
m (ConnectionState peerAddr handle handleError version m)
-> STM m (ConnectionState peerAddr handle handleError version m))
-> (MutableConnState peerAddr handle handleError version m
-> StrictTVar
m (ConnectionState peerAddr handle handleError version m))
-> MutableConnState peerAddr handle handleError version m
-> STM m (ConnectionState peerAddr handle handleError version m)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MutableConnState peerAddr handle handleError version m
-> StrictTVar
m (ConnectionState peerAddr handle handleError version m)
forall peerAddr handle handleError version (m :: * -> *).
MutableConnState peerAddr handle handleError version m
-> StrictTVar
m (ConnectionState peerAddr handle handleError version m)
connVar)
traceWith tracer (TrConnectionManagerCounters (connectionManagerStateToCounters 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
(ConnectionManagerCounters -> Int)
-> (Map
peerAddr (ConnectionState peerAddr handle handleError version m)
-> ConnectionManagerCounters)
-> Map
peerAddr (ConnectionState peerAddr handle handleError version m)
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map
peerAddr (ConnectionState peerAddr handle handleError version m)
-> ConnectionManagerCounters
forall peerAddr handle handleError version (m :: * -> *).
Map
peerAddr (ConnectionState peerAddr handle handleError version m)
-> ConnectionManagerCounters
connectionManagerStateToCounters
(Map
peerAddr (ConnectionState peerAddr handle handleError version m)
-> Int)
-> STM
m
(Map
peerAddr (ConnectionState peerAddr handle handleError version m))
-> STM m Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (MutableConnState peerAddr handle handleError version m
-> STM m (ConnectionState peerAddr handle handleError version m))
-> ConnectionManagerState peerAddr handle handleError version m
-> STM
m
(Map
peerAddr (ConnectionState peerAddr handle handleError version m))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Map peerAddr a -> f (Map peerAddr b)
traverse (StrictTVar
m (ConnectionState peerAddr handle handleError version m)
-> STM m (ConnectionState peerAddr handle handleError version m)
forall (m :: * -> *) a. MonadSTM m => StrictTVar m a -> STM m a
readTVar (StrictTVar
m (ConnectionState peerAddr handle handleError version m)
-> STM m (ConnectionState peerAddr handle handleError version m))
-> (MutableConnState peerAddr handle handleError version m
-> StrictTVar
m (ConnectionState peerAddr handle handleError version m))
-> MutableConnState peerAddr handle handleError version m
-> STM m (ConnectionState peerAddr handle handleError version m)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MutableConnState peerAddr handle handleError version m
-> StrictTVar
m (ConnectionState peerAddr handle handleError version m)
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
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 :: 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 }
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 a. m a -> m a) -> m (Async m ())) -> m (Async m ())
forall b. ((forall a. m a -> m a) -> m b) -> m b
forall (m :: * -> *) b.
MonadMask m =>
((forall a. m a -> m a) -> m b) -> m b
mask (((forall a. m a -> m a) -> m (Async m ())) -> m (Async m ()))
-> ((forall a. m a -> m a) -> m (Async m ())) -> m (Async m ())
forall a b. (a -> b) -> a -> b
$ \forall a. m a -> m a
unmask -> m () -> m (Async m ())
forall a. m a -> m (Async m a)
forall (m :: * -> *) a. MonadAsync m => m a -> m (Async m a)
async (m () -> m (Async m ())) -> m () -> m (Async m ())
forall a b. (a -> b) -> a -> b
$ do
MaskedAction m () -> (forall a. m a -> m a) -> m ()
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
(ConnectionId peerAddr
-> handlerTrace -> Trace peerAddr handlerTrace
forall peerAddr handlerTrace.
ConnectionId peerAddr
-> handlerTrace -> Trace peerAddr handlerTrace
TrConnectionHandler ConnectionId peerAddr
connId (handlerTrace -> Trace peerAddr handlerTrace)
-> Tracer m (Trace peerAddr handlerTrace) -> Tracer m handlerTrace
forall a' a. (a' -> a) -> Tracer m a -> Tracer m a'
forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
`contramap` Tracer m (Trace peerAddr handlerTrace)
tracer)
ConnectionId peerAddr
connId
(\DiffTime
bearerTimeout ->
MakeBearer m socket
-> DiffTime -> Tracer m Trace -> socket -> m (Bearer m)
forall (m :: * -> *) fd.
MakeBearer m fd -> DiffTime -> Tracer m Trace -> fd -> m (Bearer m)
getBearer MakeBearer m socket
makeBearer
DiffTime
bearerTimeout
(ConnectionId peerAddr
-> Trace -> WithBearer (ConnectionId peerAddr) Trace
forall peerid a. peerid -> a -> WithBearer peerid a
Mx.WithBearer ConnectionId peerAddr
connId (Trace -> WithBearer (ConnectionId peerAddr) Trace)
-> Tracer m (WithBearer (ConnectionId peerAddr) Trace)
-> Tracer m Trace
forall a' a. (a' -> a) -> Tracer m a -> Tracer m a'
forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
`contramap` Tracer m (WithBearer (ConnectionId peerAddr) Trace)
muxTracer)))
m x -> m x
forall a. m a -> m a
unmask
m () -> m () -> m ()
forall a b. m a -> m b -> m a
forall (m :: * -> *) a b. MonadThrow m => m a -> m b -> m a
`finally` m ()
cleanup
where
cleanup :: m ()
cleanup :: m ()
cleanup =
((forall a. m a -> m a) -> m ()) -> m ()
forall b. ((forall a. m a -> m a) -> m b) -> m b
forall (m :: * -> *) b.
MonadMask m =>
((forall a. m a -> m a) -> m b) -> m b
uninterruptibleMask (((forall a. m a -> m a) -> m ()) -> m ())
-> ((forall a. m a -> m a) -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \forall a. m a -> m a
unmask -> do
Tracer m (Trace peerAddr handlerTrace)
-> Trace peerAddr handlerTrace -> m ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer m (Trace peerAddr handlerTrace)
tracer (ConnectionId peerAddr -> Trace peerAddr handlerTrace
forall peerAddr handlerTrace.
ConnectionId peerAddr -> Trace peerAddr handlerTrace
TrConnectionCleanup ConnectionId peerAddr
connId)
eTransition <- StrictTMVar
m (ConnectionManagerState peerAddr handle handleError version m)
-> (ConnectionManagerState peerAddr handle handleError version m
-> m (ConnectionManagerState peerAddr handle handleError version m,
Either
()
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m)))))
-> m (Either
()
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))))
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 ((ConnectionManagerState peerAddr handle handleError version m
-> m (ConnectionManagerState peerAddr handle handleError version m,
Either
()
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m)))))
-> m (Either
()
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m)))))
-> (ConnectionManagerState peerAddr handle handleError version m
-> m (ConnectionManagerState peerAddr handle handleError version m,
Either
()
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m)))))
-> m (Either
()
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))))
forall a b. (a -> b) -> a -> b
$ \ConnectionManagerState peerAddr handle handleError version m
state -> do
eTransition <- STM
m
(Either
(Maybe
(TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m)))
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))))
-> m (Either
(Maybe
(TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m)))
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))))
forall a. (?callStack::CallStack) => STM m a -> m a
forall (m :: * -> *) a.
(MonadSTM m, ?callStack::CallStack) =>
STM m a -> m a
atomically (STM
m
(Either
(Maybe
(TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m)))
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))))
-> m (Either
(Maybe
(TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m)))
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m)))))
-> STM
m
(Either
(Maybe
(TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m)))
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))))
-> m (Either
(Maybe
(TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m)))
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))))
forall a b. (a -> b) -> a -> b
$ do
connState <- StrictTVar
m (ConnectionState peerAddr handle handleError version m)
-> STM m (ConnectionState peerAddr handle handleError version m)
forall (m :: * -> *) a. MonadSTM m => StrictTVar m a -> STM m a
readTVar StrictTVar
m (ConnectionState peerAddr handle handleError version m)
connVar
let connState' = Maybe handleError
-> ConnectionState peerAddr handle handleError version m
forall peerAddr handle handleError version (m :: * -> *).
Maybe handleError
-> ConnectionState peerAddr handle handleError version m
TerminatedState Maybe handleError
forall a. Maybe a
Nothing
transition = ConnectionState peerAddr handle handleError version m
-> ConnectionState peerAddr handle handleError version m
-> Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))
forall state. state -> state -> Transition state
mkTransition ConnectionState peerAddr handle handleError version m
connState ConnectionState peerAddr handle handleError version m
forall {peerAddr} {handle} {handleError} {version} {m :: * -> *}.
ConnectionState peerAddr handle handleError version m
connState'
transitionTrace = peerAddr
-> Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))
-> TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m)
forall peerAddr state.
peerAddr -> Transition' state -> TransitionTrace' peerAddr state
TransitionTrace peerAddr
peerAddr Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))
transition
case connState of
ConnectionState peerAddr handle handleError version m
ReservedOutboundState -> do
StrictTVar
m (ConnectionState peerAddr handle handleError version m)
-> ConnectionState peerAddr handle handleError version m
-> STM m ()
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
forall {peerAddr} {handle} {handleError} {version} {m :: * -> *}.
ConnectionState peerAddr handle handleError version m
connState'
Either
(Maybe
(TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m)))
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m)))
-> STM
m
(Either
(Maybe
(TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m)))
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))))
forall a. a -> STM m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either
(Maybe
(TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m)))
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m)))
-> STM
m
(Either
(Maybe
(TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m)))
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m)))))
-> Either
(Maybe
(TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m)))
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m)))
-> STM
m
(Either
(Maybe
(TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m)))
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))))
forall a b. (a -> b) -> a -> b
$ Maybe
(TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m))
-> Either
(Maybe
(TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m)))
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m)))
forall a b. a -> Either a b
Left (TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m)
-> Maybe
(TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m))
forall a. a -> Maybe a
Just TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m)
transitionTrace)
UnnegotiatedState {} -> do
StrictTVar
m (ConnectionState peerAddr handle handleError version m)
-> ConnectionState peerAddr handle handleError version m
-> STM m ()
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
forall {peerAddr} {handle} {handleError} {version} {m :: * -> *}.
ConnectionState peerAddr handle handleError version m
connState'
Either
(Maybe
(TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m)))
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m)))
-> STM
m
(Either
(Maybe
(TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m)))
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))))
forall a. a -> STM m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either
(Maybe
(TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m)))
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m)))
-> STM
m
(Either
(Maybe
(TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m)))
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m)))))
-> Either
(Maybe
(TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m)))
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m)))
-> STM
m
(Either
(Maybe
(TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m)))
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))))
forall a b. (a -> b) -> a -> b
$ Maybe
(TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m))
-> Either
(Maybe
(TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m)))
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m)))
forall a b. a -> Either a b
Left (TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m)
-> Maybe
(TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m))
forall a. a -> Maybe a
Just TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m)
transitionTrace)
OutboundUniState {} -> do
StrictTVar
m (ConnectionState peerAddr handle handleError version m)
-> ConnectionState peerAddr handle handleError version m
-> STM m ()
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
forall {peerAddr} {handle} {handleError} {version} {m :: * -> *}.
ConnectionState peerAddr handle handleError version m
connState'
Either
(Maybe
(TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m)))
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m)))
-> STM
m
(Either
(Maybe
(TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m)))
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))))
forall a. a -> STM m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either
(Maybe
(TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m)))
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m)))
-> STM
m
(Either
(Maybe
(TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m)))
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m)))))
-> Either
(Maybe
(TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m)))
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m)))
-> STM
m
(Either
(Maybe
(TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m)))
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))))
forall a b. (a -> b) -> a -> b
$ Maybe
(TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m))
-> Either
(Maybe
(TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m)))
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m)))
forall a b. a -> Either a b
Left (TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m)
-> Maybe
(TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m))
forall a. a -> Maybe a
Just TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m)
transitionTrace)
OutboundDupState {} -> do
StrictTVar
m (ConnectionState peerAddr handle handleError version m)
-> ConnectionState peerAddr handle handleError version m
-> STM m ()
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
forall {peerAddr} {handle} {handleError} {version} {m :: * -> *}.
ConnectionState peerAddr handle handleError version m
connState'
Either
(Maybe
(TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m)))
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m)))
-> STM
m
(Either
(Maybe
(TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m)))
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))))
forall a. a -> STM m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either
(Maybe
(TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m)))
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m)))
-> STM
m
(Either
(Maybe
(TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m)))
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m)))))
-> Either
(Maybe
(TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m)))
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m)))
-> STM
m
(Either
(Maybe
(TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m)))
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))))
forall a b. (a -> b) -> a -> b
$ Maybe
(TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m))
-> Either
(Maybe
(TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m)))
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m)))
forall a b. a -> Either a b
Left (TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m)
-> Maybe
(TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m))
forall a. a -> Maybe a
Just TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m)
transitionTrace)
OutboundIdleState {} -> do
StrictTVar
m (ConnectionState peerAddr handle handleError version m)
-> ConnectionState peerAddr handle handleError version m
-> STM m ()
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
forall {peerAddr} {handle} {handleError} {version} {m :: * -> *}.
ConnectionState peerAddr handle handleError version m
connState'
Either
(Maybe
(TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m)))
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m)))
-> STM
m
(Either
(Maybe
(TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m)))
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))))
forall a. a -> STM m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either
(Maybe
(TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m)))
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m)))
-> STM
m
(Either
(Maybe
(TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m)))
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m)))))
-> Either
(Maybe
(TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m)))
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m)))
-> STM
m
(Either
(Maybe
(TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m)))
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))))
forall a b. (a -> b) -> a -> b
$ Maybe
(TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m))
-> Either
(Maybe
(TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m)))
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m)))
forall a b. a -> Either a b
Left (TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m)
-> Maybe
(TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m))
forall a. a -> Maybe a
Just TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m)
transitionTrace)
InboundIdleState {} -> do
StrictTVar
m (ConnectionState peerAddr handle handleError version m)
-> ConnectionState peerAddr handle handleError version m
-> STM m ()
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
forall {peerAddr} {handle} {handleError} {version} {m :: * -> *}.
ConnectionState peerAddr handle handleError version m
connState'
Either
(Maybe
(TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m)))
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m)))
-> STM
m
(Either
(Maybe
(TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m)))
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))))
forall a. a -> STM m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either
(Maybe
(TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m)))
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m)))
-> STM
m
(Either
(Maybe
(TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m)))
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m)))))
-> Either
(Maybe
(TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m)))
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m)))
-> STM
m
(Either
(Maybe
(TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m)))
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))))
forall a b. (a -> b) -> a -> b
$ Maybe
(TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m))
-> Either
(Maybe
(TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m)))
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m)))
forall a b. a -> Either a b
Left (TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m)
-> Maybe
(TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m))
forall a. a -> Maybe a
Just TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m)
transitionTrace)
InboundState {} -> do
StrictTVar
m (ConnectionState peerAddr handle handleError version m)
-> ConnectionState peerAddr handle handleError version m
-> STM m ()
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
forall {peerAddr} {handle} {handleError} {version} {m :: * -> *}.
ConnectionState peerAddr handle handleError version m
connState'
Either
(Maybe
(TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m)))
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m)))
-> STM
m
(Either
(Maybe
(TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m)))
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))))
forall a. a -> STM m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either
(Maybe
(TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m)))
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m)))
-> STM
m
(Either
(Maybe
(TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m)))
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m)))))
-> Either
(Maybe
(TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m)))
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m)))
-> STM
m
(Either
(Maybe
(TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m)))
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))))
forall a b. (a -> b) -> a -> b
$ Maybe
(TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m))
-> Either
(Maybe
(TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m)))
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m)))
forall a b. a -> Either a b
Left (TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m)
-> Maybe
(TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m))
forall a. a -> Maybe a
Just TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m)
transitionTrace)
DuplexState {} -> do
StrictTVar
m (ConnectionState peerAddr handle handleError version m)
-> ConnectionState peerAddr handle handleError version m
-> STM m ()
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
forall {peerAddr} {handle} {handleError} {version} {m :: * -> *}.
ConnectionState peerAddr handle handleError version m
connState'
Either
(Maybe
(TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m)))
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m)))
-> STM
m
(Either
(Maybe
(TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m)))
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))))
forall a. a -> STM m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either
(Maybe
(TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m)))
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m)))
-> STM
m
(Either
(Maybe
(TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m)))
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m)))))
-> Either
(Maybe
(TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m)))
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m)))
-> STM
m
(Either
(Maybe
(TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m)))
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))))
forall a b. (a -> b) -> a -> b
$ Maybe
(TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m))
-> Either
(Maybe
(TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m)))
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m)))
forall a b. a -> Either a b
Left (TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m)
-> Maybe
(TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m))
forall a. a -> Maybe a
Just TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m)
transitionTrace)
TerminatingState {} -> do
Either
(Maybe
(TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m)))
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m)))
-> STM
m
(Either
(Maybe
(TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m)))
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))))
forall a. a -> STM m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either
(Maybe
(TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m)))
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m)))
-> STM
m
(Either
(Maybe
(TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m)))
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m)))))
-> Either
(Maybe
(TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m)))
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m)))
-> STM
m
(Either
(Maybe
(TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m)))
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))))
forall a b. (a -> b) -> a -> b
$ Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))
-> Either
(Maybe
(TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m)))
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m)))
forall a b. b -> Either a b
Right Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))
transition
TerminatedState {} ->
Either
(Maybe
(TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m)))
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m)))
-> STM
m
(Either
(Maybe
(TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m)))
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))))
forall a. a -> STM m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either
(Maybe
(TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m)))
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m)))
-> STM
m
(Either
(Maybe
(TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m)))
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m)))))
-> Either
(Maybe
(TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m)))
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m)))
-> STM
m
(Either
(Maybe
(TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m)))
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))))
forall a b. (a -> b) -> a -> b
$ Maybe
(TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m))
-> Either
(Maybe
(TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m)))
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m)))
forall a b. a -> Either a b
Left Maybe
(TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m))
forall a. Maybe a
Nothing
case eTransition of
Left Maybe
(TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m))
mbTransition -> do
(TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m)
-> m ())
-> Maybe
(TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m))
-> m ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (Tracer
m
(TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m))
-> TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m)
-> m ()
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
Snocket m socket peerAddr -> socket -> m ()
forall (m :: * -> *) fd addr. Snocket m fd addr -> fd -> m ()
close Snocket m socket peerAddr
snocket socket
socket
(ConnectionManagerState peerAddr handle handleError version m,
Either
()
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))))
-> m (ConnectionManagerState peerAddr handle handleError version m,
Either
()
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ( ConnectionManagerState peerAddr handle handleError version m
state
, ()
-> Either
()
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m)))
forall a b. a -> Either a b
Left ()
)
Right Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))
transition -> do
Snocket m socket peerAddr -> socket -> m ()
forall (m :: * -> *) fd addr. Snocket m fd addr -> fd -> m ()
close Snocket m socket peerAddr
snocket socket
socket
(ConnectionManagerState peerAddr handle handleError version m,
Either
()
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))))
-> m (ConnectionManagerState peerAddr handle handleError version m,
Either
()
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ( ConnectionManagerState peerAddr handle handleError version m
state
, Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))
-> Either
()
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m)))
forall a b. b -> Either a b
Right Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))
transition
)
case eTransition of
Left () -> do
let transition :: TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m)
transition =
peerAddr
-> Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))
-> TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m)
forall peerAddr state.
peerAddr -> Transition' state -> TransitionTrace' peerAddr state
TransitionTrace
peerAddr
peerAddr
Transition
{ fromState :: MaybeUnknown
(ConnectionState peerAddr handle handleError version m)
fromState = ConnectionState peerAddr handle handleError version m
-> MaybeUnknown
(ConnectionState peerAddr handle handleError version m)
forall state. state -> MaybeUnknown state
Known (Maybe handleError
-> ConnectionState peerAddr handle handleError version m
forall peerAddr handle handleError version (m :: * -> *).
Maybe handleError
-> ConnectionState peerAddr handle handleError version m
TerminatedState Maybe handleError
forall a. Maybe a
Nothing)
, toState :: MaybeUnknown
(ConnectionState peerAddr handle handleError version m)
toState = MaybeUnknown
(ConnectionState peerAddr handle handleError version m)
forall state. MaybeUnknown state
Unknown
}
mbTransition <- StrictTMVar
m (ConnectionManagerState peerAddr handle handleError version m)
-> (ConnectionManagerState peerAddr handle handleError version m
-> m (ConnectionManagerState peerAddr handle handleError version m,
Maybe
(TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m))))
-> m (Maybe
(TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m)))
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 ((ConnectionManagerState peerAddr handle handleError version m
-> m (ConnectionManagerState peerAddr handle handleError version m,
Maybe
(TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m))))
-> m (Maybe
(TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m))))
-> (ConnectionManagerState peerAddr handle handleError version m
-> m (ConnectionManagerState peerAddr handle handleError version m,
Maybe
(TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m))))
-> m (Maybe
(TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m)))
forall a b. (a -> b) -> a -> b
$ \ConnectionManagerState peerAddr handle handleError version m
state ->
case peerAddr
-> ConnectionManagerState peerAddr handle handleError version m
-> Maybe (MutableConnState peerAddr handle handleError version m)
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,
Maybe
(TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m)))
-> m (ConnectionManagerState peerAddr handle handleError version m,
Maybe
(TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m)))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ConnectionManagerState peerAddr handle handleError version m
state, Maybe
(TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m))
forall a. Maybe a
Nothing)
Just MutableConnState peerAddr handle handleError version m
v ->
if MutableConnState peerAddr handle handleError version m
mutableConnState MutableConnState peerAddr handle handleError version m
-> MutableConnState peerAddr handle handleError version m -> Bool
forall a. Eq a => a -> a -> Bool
== MutableConnState peerAddr handle handleError version m
v
then (ConnectionManagerState peerAddr handle handleError version m,
Maybe
(TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m)))
-> m (ConnectionManagerState peerAddr handle handleError version m,
Maybe
(TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m)))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (peerAddr
-> ConnectionManagerState peerAddr handle handleError version m
-> ConnectionManagerState peerAddr handle handleError version m
forall k a. Ord k => k -> Map k a -> Map k a
Map.delete peerAddr
peerAddr ConnectionManagerState peerAddr handle handleError version m
state , TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m)
-> Maybe
(TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m))
forall a. a -> Maybe a
Just TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m)
transition)
else (ConnectionManagerState peerAddr handle handleError version m,
Maybe
(TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m)))
-> m (ConnectionManagerState peerAddr handle handleError version m,
Maybe
(TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m)))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ConnectionManagerState peerAddr handle handleError version m
state , Maybe
(TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m))
forall a. Maybe a
Nothing)
traverse_ (traceWith trTracer) mbTransition
traceCounters stateVar
Right Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))
transition ->
do Tracer m (Trace peerAddr handlerTrace)
-> Trace peerAddr handlerTrace -> m ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer m (Trace peerAddr handlerTrace)
tracer (ConnectionId peerAddr -> Trace peerAddr handlerTrace
forall peerAddr handlerTrace.
ConnectionId peerAddr -> Trace peerAddr handlerTrace
TrConnectionTimeWait ConnectionId peerAddr
connId)
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (DiffTime
timeWaitTimeout DiffTime -> DiffTime -> Bool
forall a. Ord a => a -> a -> Bool
> DiffTime
0) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
let
forceThreadDelay :: DiffTime -> m ()
forceThreadDelay DiffTime
delay | DiffTime
delay DiffTime -> DiffTime -> Bool
forall a. Ord a => a -> a -> Bool
<= DiffTime
0 = () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
forceThreadDelay DiffTime
delay = do
t <- m Time
forall (m :: * -> *). MonadMonotonicTime m => m Time
getMonotonicTime
unmask (threadDelay delay)
`catch` \SomeException
e ->
case SomeException -> Maybe AsyncCancelled
forall e. Exception e => SomeException -> Maybe e
fromException SomeException
e
of Just AsyncCancelled
AsyncCancelled -> do
t' <- m Time
forall (m :: * -> *). MonadMonotonicTime m => m Time
getMonotonicTime
forceThreadDelay (delay - t' `diffTime` t)
Maybe AsyncCancelled
_ -> SomeException -> m ()
forall e a. Exception e => e -> m a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwIO SomeException
e
in DiffTime -> m ()
forceThreadDelay DiffTime
timeWaitTimeout
m () -> m () -> m ()
forall a b. m a -> m b -> m a
forall (m :: * -> *) a b. MonadThrow m => m a -> m b -> m a
`finally` do
Tracer m (Trace peerAddr handlerTrace)
-> Trace peerAddr handlerTrace -> m ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer m (Trace peerAddr handlerTrace)
tracer (ConnectionId peerAddr -> Trace peerAddr handlerTrace
forall peerAddr handlerTrace.
ConnectionId peerAddr -> Trace peerAddr handlerTrace
TrConnectionTimeWaitDone ConnectionId peerAddr
connId)
trs <- STM
m
[Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))]
-> m [Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))]
forall a. (?callStack::CallStack) => STM m a -> m a
forall (m :: * -> *) a.
(MonadSTM m, ?callStack::CallStack) =>
STM m a -> m a
atomically (STM
m
[Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))]
-> m [Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))])
-> STM
m
[Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))]
-> m [Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))]
forall a b. (a -> b) -> a -> b
$ do
connState <- StrictTVar
m (ConnectionState peerAddr handle handleError version m)
-> STM m (ConnectionState peerAddr handle handleError version m)
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 { fromState = Known connState }
shouldTrace = MaybeUnknown
(ConnectionState peerAddr handle handleError version m)
-> AbstractState
forall muxMode peerAddr m a (b :: * -> *).
MaybeUnknown (ConnectionState muxMode peerAddr m a b)
-> AbstractState
abstractState (ConnectionState peerAddr handle handleError version m
-> MaybeUnknown
(ConnectionState peerAddr handle handleError version m)
forall state. state -> MaybeUnknown state
Known ConnectionState peerAddr handle handleError version m
connState)
AbstractState -> AbstractState -> Bool
forall a. Eq a => a -> a -> Bool
/= AbstractState
TerminatedSt
writeTVar connVar (TerminatedState Nothing)
updated <-
modifyTMVarPure
stateVar
( \ConnectionManagerState peerAddr handle handleError version m
state ->
case peerAddr
-> ConnectionManagerState peerAddr handle handleError version m
-> Maybe (MutableConnState peerAddr handle handleError version m)
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 MutableConnState peerAddr handle handleError version m
-> MutableConnState peerAddr handle handleError version m -> Bool
forall a. Eq a => a -> a -> Bool
== MutableConnState peerAddr handle handleError version m
v
then (peerAddr
-> ConnectionManagerState peerAddr handle handleError version m
-> ConnectionManagerState peerAddr handle handleError version m
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 updated
then do
let trs = [ Transition
{ fromState :: MaybeUnknown
(ConnectionState peerAddr handle handleError version m)
fromState = ConnectionState peerAddr handle handleError version m
-> MaybeUnknown
(ConnectionState peerAddr handle handleError version m)
forall state. state -> MaybeUnknown state
Known (Maybe handleError
-> ConnectionState peerAddr handle handleError version m
forall peerAddr handle handleError version (m :: * -> *).
Maybe handleError
-> ConnectionState peerAddr handle handleError version m
TerminatedState Maybe handleError
forall a. Maybe a
Nothing)
, toState :: MaybeUnknown
(ConnectionState peerAddr handle handleError version m)
toState = MaybeUnknown
(ConnectionState peerAddr handle handleError version m)
forall state. MaybeUnknown state
Unknown
}
]
return $
if shouldTrace
then transition' : trs
else trs
else return [ ]
traverse_ (traceWith trTracer . TransitionTrace peerAddr) trs
traceCounters stateVar
mkPruneAction :: peerAddr
-> Int
-> ConnectionManagerState peerAddr handle handleError version m
-> ConnectionState peerAddr handle handleError version m
-> StrictTVar m (ConnectionState peerAddr handle handleError version m)
-> StrictTVar m StdGen
-> Async m ()
-> STM m (Bool, PruneAction m)
mkPruneAction :: peerAddr
-> Int
-> ConnectionManagerState peerAddr handle handleError version m
-> ConnectionState peerAddr handle handleError version m
-> StrictTVar
m (ConnectionState peerAddr handle handleError version m)
-> StrictTVar m StdGen
-> 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 StrictTVar m StdGen
stdGenVar Async m ()
connThread = do
(choiceMap' :: Map peerAddr ( ConnectionType
, Async m ()
, StrictTVar m
(ConnectionState
peerAddr
handle handleError
version m)
))
<- ((peerAddr
-> MutableConnState peerAddr handle handleError version m
-> STM
m
(Maybe
(ConnectionType, Async m (),
StrictTVar
m (ConnectionState peerAddr handle handleError version m))))
-> ConnectionManagerState peerAddr handle handleError version m
-> STM
m
(Map
peerAddr
(ConnectionType, Async m (),
StrictTVar
m (ConnectionState peerAddr handle handleError version m))))
-> ConnectionManagerState peerAddr handle handleError version m
-> (peerAddr
-> MutableConnState peerAddr handle handleError version m
-> STM
m
(Maybe
(ConnectionType, Async m (),
StrictTVar
m (ConnectionState peerAddr handle handleError version m))))
-> STM
m
(Map
peerAddr
(ConnectionType, Async m (),
StrictTVar
m (ConnectionState peerAddr handle handleError version m)))
forall a b c. (a -> b -> c) -> b -> a -> c
flip (peerAddr
-> MutableConnState peerAddr handle handleError version m
-> STM
m
(Maybe
(ConnectionType, Async m (),
StrictTVar
m (ConnectionState peerAddr handle handleError version m))))
-> ConnectionManagerState peerAddr handle handleError version m
-> STM
m
(Map
peerAddr
(ConnectionType, Async m (),
StrictTVar
m (ConnectionState peerAddr handle handleError version m)))
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 ((peerAddr
-> MutableConnState peerAddr handle handleError version m
-> STM
m
(Maybe
(ConnectionType, Async m (),
StrictTVar
m (ConnectionState peerAddr handle handleError version m))))
-> STM
m
(Map
peerAddr
(ConnectionType, Async m (),
StrictTVar
m (ConnectionState peerAddr handle handleError version m))))
-> (peerAddr
-> MutableConnState peerAddr handle handleError version m
-> STM
m
(Maybe
(ConnectionType, Async m (),
StrictTVar
m (ConnectionState peerAddr handle handleError version m))))
-> STM
m
(Map
peerAddr
(ConnectionType, Async m (),
StrictTVar
m (ConnectionState peerAddr handle handleError version m)))
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
Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (ConnectionState peerAddr handle handleError version m -> Bool
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') (ConnectionType
-> Async m ()
-> (ConnectionType, Async m (),
StrictTVar
m (ConnectionState peerAddr handle handleError version m)))
-> Maybe ConnectionType
-> Maybe
(Async m ()
-> (ConnectionType, Async m (),
StrictTVar
m (ConnectionState peerAddr handle handleError version m)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ConnectionState peerAddr handle handleError version m
-> Maybe ConnectionType
forall peerAddr handle handleError version (m :: * -> *).
ConnectionState peerAddr handle handleError version m
-> Maybe ConnectionType
getConnType ConnectionState peerAddr handle handleError version m
cs
Maybe
(Async m ()
-> (ConnectionType, Async m (),
StrictTVar
m (ConnectionState peerAddr handle handleError version m)))
-> Maybe (Async m ())
-> Maybe
(ConnectionType, Async m (),
StrictTVar
m (ConnectionState peerAddr handle handleError version m))
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ConnectionState peerAddr handle handleError version m
-> Maybe (Async m ())
forall peerAddr handle handleError version (m :: * -> *).
ConnectionState peerAddr handle handleError version m
-> Maybe (Async m ())
getConnThread ConnectionState peerAddr handle handleError version m
cs)
(ConnectionState peerAddr handle handleError version m
-> Maybe
(ConnectionType, Async m (),
StrictTVar
m (ConnectionState peerAddr handle handleError version m)))
-> STM m (ConnectionState peerAddr handle handleError version m)
-> STM
m
(Maybe
(ConnectionType, Async m (),
StrictTVar
m (ConnectionState peerAddr handle handleError version m)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StrictTVar
m (ConnectionState peerAddr handle handleError version m)
-> STM m (ConnectionState peerAddr handle handleError version m)
forall (m :: * -> *) a. MonadSTM m => StrictTVar m a -> STM m a
readTVar StrictTVar
m (ConnectionState peerAddr handle handleError version m)
connVar'
let choiceMap =
case ConnectionState peerAddr handle handleError version m
-> Maybe ConnectionType
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 -> Bool
-> Map
peerAddr
(ConnectionType, Async m (),
StrictTVar
m (ConnectionState peerAddr handle handleError version m))
-> Map
peerAddr
(ConnectionType, Async m (),
StrictTVar
m (ConnectionState peerAddr handle handleError version m))
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 -> peerAddr
-> (ConnectionType, Async m (),
StrictTVar
m (ConnectionState peerAddr handle handleError version m))
-> Map
peerAddr
(ConnectionType, Async m (),
StrictTVar
m (ConnectionState peerAddr handle handleError version m))
-> Map
peerAddr
(ConnectionType, Async m (),
StrictTVar
m (ConnectionState peerAddr handle handleError version m))
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'
stdGen <- stateTVar stdGenVar split
let pruneSet = PrunePolicy peerAddr
prunePolicy
StdGen
stdGen
((\(ConnectionType
a,Async m ()
_,StrictTVar
m (ConnectionState peerAddr handle handleError version m)
_) -> ConnectionType
a) ((ConnectionType, Async m (),
StrictTVar
m (ConnectionState peerAddr handle handleError version m))
-> ConnectionType)
-> Map
peerAddr
(ConnectionType, Async m (),
StrictTVar
m (ConnectionState peerAddr handle handleError version m))
-> Map peerAddr ConnectionType
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))
choiceMap Map
peerAddr
(ConnectionType, Async m (),
StrictTVar
m (ConnectionState peerAddr handle handleError version m))
-> Set peerAddr
-> Map
peerAddr
(ConnectionType, Async m (),
StrictTVar
m (ConnectionState peerAddr handle handleError version m))
forall k a. Ord k => Map k a -> Set k -> Map k a
`Map.restrictKeys` Set peerAddr
pruneSet
forM_ pruneMap $ \(ConnectionType
_, Async m ()
_, StrictTVar
m (ConnectionState peerAddr handle handleError version m)
connVar') ->
StrictTVar
m (ConnectionState peerAddr handle handleError version m)
-> ConnectionState peerAddr handle handleError version m
-> STM m ()
forall (m :: * -> *) a.
MonadSTM m =>
StrictTVar m a -> a -> STM m ()
writeTVar StrictTVar
m (ConnectionState peerAddr handle handleError version m)
connVar' (Maybe handleError
-> ConnectionState peerAddr handle handleError version m
forall peerAddr handle handleError version (m :: * -> *).
Maybe handleError
-> ConnectionState peerAddr handle handleError version m
TerminatedState Maybe handleError
forall a. Maybe a
Nothing)
return ( peerAddr `Set.member` pruneSet
, PruneAction $ do
traceWith tracer (TrPruneConnections (Map.keysSet pruneMap)
numberToPrune
(Map.keysSet choiceMap))
forM_ pruneMap $ \(ConnectionType
_, Async m ()
connThread', StrictTVar
m (ConnectionState peerAddr handle handleError version m)
_) ->
ThreadId m -> AsyncCancelled -> m ()
forall e. Exception e => ThreadId m -> e -> m ()
forall (m :: * -> *) e.
(MonadFork m, Exception e) =>
ThreadId m -> e -> m ()
throwTo (Async m () -> ThreadId m
forall a. Async m a -> ThreadId m
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
-> socket
-> peerAddr
-> 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
(r, connId) <- StrictTMVar
m (ConnectionManagerState peerAddr handle handleError version m)
-> (ConnectionManagerState peerAddr handle handleError version m
-> m (ConnectionManagerState peerAddr handle handleError version m,
(Maybe
(MutableConnState peerAddr handle handleError version m,
Async m (),
PromiseReader
m
(Either
handleError
(HandshakeConnectionResult handle (version, versionData)))),
ConnectionId peerAddr)))
-> m (Maybe
(MutableConnState peerAddr handle handleError version m,
Async m (),
PromiseReader
m
(Either
handleError
(HandshakeConnectionResult handle (version, versionData)))),
ConnectionId peerAddr)
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 ((ConnectionManagerState peerAddr handle handleError version m
-> m (ConnectionManagerState peerAddr handle handleError version m,
(Maybe
(MutableConnState peerAddr handle handleError version m,
Async m (),
PromiseReader
m
(Either
handleError
(HandshakeConnectionResult handle (version, versionData)))),
ConnectionId peerAddr)))
-> m (Maybe
(MutableConnState peerAddr handle handleError version m,
Async m (),
PromiseReader
m
(Either
handleError
(HandshakeConnectionResult handle (version, versionData)))),
ConnectionId peerAddr))
-> (ConnectionManagerState peerAddr handle handleError version m
-> m (ConnectionManagerState peerAddr handle handleError version m,
(Maybe
(MutableConnState peerAddr handle handleError version m,
Async m (),
PromiseReader
m
(Either
handleError
(HandshakeConnectionResult handle (version, versionData)))),
ConnectionId peerAddr)))
-> m (Maybe
(MutableConnState peerAddr handle handleError version m,
Async m (),
PromiseReader
m
(Either
handleError
(HandshakeConnectionResult handle (version, versionData)))),
ConnectionId peerAddr)
forall a b. (a -> b) -> a -> b
$ \ConnectionManagerState peerAddr handle handleError version m
state -> do
localAddress <- Snocket m socket peerAddr -> socket -> m peerAddr
forall (m :: * -> *) fd addr. Snocket m fd addr -> fd -> m addr
getLocalAddr Snocket m socket peerAddr
snocket socket
socket
numberOfCons <- atomically $ countIncomingConnections state
let connId = ConnectionId { peerAddr
localAddress :: peerAddr
localAddress :: peerAddr
localAddress, remoteAddress :: peerAddr
remoteAddress = peerAddr
peerAddr }
canAccept = Int
numberOfCons Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
hardLimit
if canAccept
then do
let provenance = Provenance
Inbound
traceWith tracer (TrIncludeConnection provenance peerAddr)
(reader, writer) <- newEmptyPromiseIO
(connThread, connVar, connState0, connState) <-
mfix $ \ ~(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
let connState' :: ConnectionState peerAddr handle handleError version m
connState' = Provenance
-> ConnectionId peerAddr
-> Async m ()
-> ConnectionState peerAddr handle handleError version m
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
(mutableConnVar', connState0') <-
STM
m
(MutableConnState peerAddr handle handleError version m,
Maybe (ConnectionState peerAddr handle handleError version m))
-> m (MutableConnState peerAddr handle handleError version m,
Maybe (ConnectionState peerAddr handle handleError version m))
forall a. (?callStack::CallStack) => STM m a -> m a
forall (m :: * -> *) a.
(MonadSTM m, ?callStack::CallStack) =>
STM m a -> m a
atomically (STM
m
(MutableConnState peerAddr handle handleError version m,
Maybe (ConnectionState peerAddr handle handleError version m))
-> m (MutableConnState peerAddr handle handleError version m,
Maybe (ConnectionState peerAddr handle handleError version m)))
-> STM
m
(MutableConnState peerAddr handle handleError version m,
Maybe (ConnectionState peerAddr handle handleError version m))
-> m (MutableConnState peerAddr handle handleError version m,
Maybe (ConnectionState peerAddr handle handleError version m))
forall a b. (a -> b) -> a -> b
$ do
let v0 :: Maybe (MutableConnState peerAddr handle handleError version m)
v0 = peerAddr
-> ConnectionManagerState peerAddr handle handleError version m
-> Maybe (MutableConnState peerAddr handle handleError version m)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup peerAddr
peerAddr ConnectionManagerState peerAddr handle handleError version m
state
case Maybe (MutableConnState peerAddr handle handleError version m)
v0 of
Maybe (MutableConnState peerAddr handle handleError version m)
Nothing -> do
v <- peerAddr
-> FreshIdSupply m
-> ConnectionState peerAddr handle handleError version m
-> STM m (MutableConnState peerAddr handle handleError version m)
forall peerAddr handle handleError version (m :: * -> *).
(MonadTraceSTM m, Typeable peerAddr) =>
peerAddr
-> FreshIdSupply m
-> ConnectionState peerAddr handle handleError version m
-> STM m (MutableConnState peerAddr handle handleError version m)
newMutableConnState peerAddr
peerAddr FreshIdSupply m
freshIdSupply ConnectionState peerAddr handle handleError version m
connState'
labelTVar (connVar v) ("conn-state-" ++ show connId)
return (v, Nothing)
Just MutableConnState peerAddr handle handleError version m
v -> do
connState0' <- StrictTVar
m (ConnectionState peerAddr handle handleError version m)
-> STM m (ConnectionState peerAddr handle handleError version m)
forall (m :: * -> *) a. MonadSTM m => StrictTVar m a -> STM m a
readTVar (MutableConnState peerAddr handle handleError version m
-> StrictTVar
m (ConnectionState peerAddr handle handleError version m)
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)
!v' <- case connState0' of
ReservedOutboundState {} -> StrictTVar
m (ConnectionState peerAddr handle handleError version m)
-> ConnectionState peerAddr handle handleError version m
-> STM m ()
forall (m :: * -> *) a.
MonadSTM m =>
StrictTVar m a -> a -> STM m ()
writeTVar (MutableConnState peerAddr handle handleError version m
-> StrictTVar
m (ConnectionState peerAddr handle handleError version m)
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'
STM m ()
-> MutableConnState peerAddr handle handleError version m
-> STM m (MutableConnState peerAddr handle handleError version m)
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> MutableConnState peerAddr handle handleError version m
v
UnnegotiatedState {} -> StrictTVar
m (ConnectionState peerAddr handle handleError version m)
-> ConnectionState peerAddr handle handleError version m
-> STM m ()
forall (m :: * -> *) a.
MonadSTM m =>
StrictTVar m a -> a -> STM m ()
writeTVar (MutableConnState peerAddr handle handleError version m
-> StrictTVar
m (ConnectionState peerAddr handle handleError version m)
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'
STM m ()
-> MutableConnState peerAddr handle handleError version m
-> STM m (MutableConnState peerAddr handle handleError version m)
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> MutableConnState peerAddr handle handleError version m
v
OutboundUniState {} -> StrictTVar
m (ConnectionState peerAddr handle handleError version m)
-> ConnectionState peerAddr handle handleError version m
-> STM m ()
forall (m :: * -> *) a.
MonadSTM m =>
StrictTVar m a -> a -> STM m ()
writeTVar (MutableConnState peerAddr handle handleError version m
-> StrictTVar
m (ConnectionState peerAddr handle handleError version m)
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'
STM m ()
-> MutableConnState peerAddr handle handleError version m
-> STM m (MutableConnState peerAddr handle handleError version m)
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Bool
-> MutableConnState peerAddr handle handleError version m
-> MutableConnState peerAddr handle handleError version m
forall a. (?callStack::CallStack) => Bool -> a -> a
assert Bool
False MutableConnState peerAddr handle handleError version m
v
OutboundDupState {} -> StrictTVar
m (ConnectionState peerAddr handle handleError version m)
-> ConnectionState peerAddr handle handleError version m
-> STM m ()
forall (m :: * -> *) a.
MonadSTM m =>
StrictTVar m a -> a -> STM m ()
writeTVar (MutableConnState peerAddr handle handleError version m
-> StrictTVar
m (ConnectionState peerAddr handle handleError version m)
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'
STM m ()
-> MutableConnState peerAddr handle handleError version m
-> STM m (MutableConnState peerAddr handle handleError version m)
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Bool
-> MutableConnState peerAddr handle handleError version m
-> MutableConnState peerAddr handle handleError version m
forall a. (?callStack::CallStack) => Bool -> a -> a
assert Bool
False MutableConnState peerAddr handle handleError version m
v
OutboundIdleState {} -> StrictTVar
m (ConnectionState peerAddr handle handleError version m)
-> ConnectionState peerAddr handle handleError version m
-> STM m ()
forall (m :: * -> *) a.
MonadSTM m =>
StrictTVar m a -> a -> STM m ()
writeTVar (MutableConnState peerAddr handle handleError version m
-> StrictTVar
m (ConnectionState peerAddr handle handleError version m)
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'
STM m ()
-> MutableConnState peerAddr handle handleError version m
-> STM m (MutableConnState peerAddr handle handleError version m)
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Bool
-> MutableConnState peerAddr handle handleError version m
-> MutableConnState peerAddr handle handleError version m
forall a. (?callStack::CallStack) => Bool -> a -> a
assert Bool
False MutableConnState peerAddr handle handleError version m
v
DuplexState {} -> StrictTVar
m (ConnectionState peerAddr handle handleError version m)
-> ConnectionState peerAddr handle handleError version m
-> STM m ()
forall (m :: * -> *) a.
MonadSTM m =>
StrictTVar m a -> a -> STM m ()
writeTVar (MutableConnState peerAddr handle handleError version m
-> StrictTVar
m (ConnectionState peerAddr handle handleError version m)
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'
STM m ()
-> MutableConnState peerAddr handle handleError version m
-> STM m (MutableConnState peerAddr handle handleError version m)
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Bool
-> MutableConnState peerAddr handle handleError version m
-> MutableConnState peerAddr handle handleError version m
forall a. (?callStack::CallStack) => Bool -> a -> a
assert Bool
False MutableConnState peerAddr handle handleError version m
v
InboundIdleState {} -> StrictTVar
m (ConnectionState peerAddr handle handleError version m)
-> ConnectionState peerAddr handle handleError version m
-> STM m ()
forall (m :: * -> *) a.
MonadSTM m =>
StrictTVar m a -> a -> STM m ()
writeTVar (MutableConnState peerAddr handle handleError version m
-> StrictTVar
m (ConnectionState peerAddr handle handleError version m)
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'
STM m ()
-> MutableConnState peerAddr handle handleError version m
-> STM m (MutableConnState peerAddr handle handleError version m)
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Bool
-> MutableConnState peerAddr handle handleError version m
-> MutableConnState peerAddr handle handleError version m
forall a. (?callStack::CallStack) => Bool -> a -> a
assert Bool
False MutableConnState peerAddr handle handleError version m
v
InboundState {} -> StrictTVar
m (ConnectionState peerAddr handle handleError version m)
-> ConnectionState peerAddr handle handleError version m
-> STM m ()
forall (m :: * -> *) a.
MonadSTM m =>
StrictTVar m a -> a -> STM m ()
writeTVar (MutableConnState peerAddr handle handleError version m
-> StrictTVar
m (ConnectionState peerAddr handle handleError version m)
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'
STM m ()
-> MutableConnState peerAddr handle handleError version m
-> STM m (MutableConnState peerAddr handle handleError version m)
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Bool
-> MutableConnState peerAddr handle handleError version m
-> MutableConnState peerAddr handle handleError version m
forall a. (?callStack::CallStack) => Bool -> a -> a
assert Bool
False MutableConnState peerAddr handle handleError version m
v
TerminatingState {} -> peerAddr
-> FreshIdSupply m
-> ConnectionState peerAddr handle handleError version m
-> STM m (MutableConnState peerAddr handle handleError version m)
forall peerAddr handle handleError version (m :: * -> *).
(MonadTraceSTM m, Typeable peerAddr) =>
peerAddr
-> FreshIdSupply m
-> ConnectionState peerAddr handle handleError version m
-> STM m (MutableConnState peerAddr handle handleError version m)
newMutableConnState peerAddr
peerAddr FreshIdSupply m
freshIdSupply ConnectionState peerAddr handle handleError version m
connState'
TerminatedState {} -> peerAddr
-> FreshIdSupply m
-> ConnectionState peerAddr handle handleError version m
-> STM m (MutableConnState peerAddr handle handleError version m)
forall peerAddr handle handleError version (m :: * -> *).
(MonadTraceSTM m, Typeable peerAddr) =>
peerAddr
-> FreshIdSupply m
-> ConnectionState peerAddr handle handleError version m
-> STM m (MutableConnState peerAddr handle handleError version m)
newMutableConnState peerAddr
peerAddr FreshIdSupply m
freshIdSupply ConnectionState peerAddr handle handleError version m
connState'
labelTVar (connVar v') ("conn-state-" ++ show connId)
return (v', Just connState0')
connThread' <-
forkConnectionHandler
stateVar mutableConnVar' socket connId writer handler
return (connThread', mutableConnVar', connState0', connState')
traceWith trTracer (TransitionTrace peerAddr
Transition { fromState = maybe Unknown Known connState0
, toState = Known connState
})
return ( Map.insert peerAddr connVar state
, (Just (connVar, connThread, reader), connId)
)
else
return ( state
, (Nothing, connId)
)
case r of
Maybe
(MutableConnState peerAddr handle handleError version m,
Async m (),
PromiseReader
m
(Either
handleError
(HandshakeConnectionResult handle (version, versionData))))
Nothing ->
Connected peerAddr handle handleError
-> m (Connected peerAddr handle handleError)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (ConnectionId peerAddr
-> Maybe handleError -> Connected peerAddr handle handleError
forall peerAddr handle handleError.
ConnectionId peerAddr
-> Maybe handleError -> Connected peerAddr handle handleError
Disconnected ConnectionId peerAddr
connId Maybe handleError
forall a. Maybe a
Nothing)
Just (mutableConnState :: MutableConnState peerAddr handle handleError version m
mutableConnState@MutableConnState { 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 :: 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
res <- STM
m
(Either
handleError
(HandshakeConnectionResult handle (version, versionData)))
-> m (Either
handleError
(HandshakeConnectionResult handle (version, versionData)))
forall a. (?callStack::CallStack) => STM m a -> m a
forall (m :: * -> *) a.
(MonadSTM m, ?callStack::CallStack) =>
STM m a -> m a
atomically (STM
m
(Either
handleError
(HandshakeConnectionResult handle (version, versionData)))
-> m (Either
handleError
(HandshakeConnectionResult handle (version, versionData))))
-> STM
m
(Either
handleError
(HandshakeConnectionResult handle (version, versionData)))
-> m (Either
handleError
(HandshakeConnectionResult handle (version, versionData)))
forall a b. (a -> b) -> a -> b
$ PromiseReader
m
(Either
handleError
(HandshakeConnectionResult handle (version, versionData)))
-> STM
m
(Either
handleError
(HandshakeConnectionResult handle (version, versionData)))
forall (m :: * -> *) a. PromiseReader m a -> STM m a
readPromise PromiseReader
m
(Either
handleError
(HandshakeConnectionResult handle (version, versionData)))
reader
case 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 (Maybe handleError -> m (Connected peerAddr handle handleError))
-> Maybe handleError -> m (Connected peerAddr handle handleError)
forall a b. (a -> b) -> a -> b
$ handleError -> Maybe handleError
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 Maybe handleError
forall a. Maybe a
Nothing
Right (HandshakeConnectionResult handle
handle (version
_version, versionData
versionData)) -> do
let dataFlow :: DataFlow
dataFlow = versionData -> DataFlow
connectionDataFlow versionData
versionData
(connected, mbTransition, provenance) <- STM
m
(Bool,
Maybe
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))),
Provenance)
-> m (Bool,
Maybe
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))),
Provenance)
forall a. (?callStack::CallStack) => STM m a -> m a
forall (m :: * -> *) a.
(MonadSTM m, ?callStack::CallStack) =>
STM m a -> m a
atomically (STM
m
(Bool,
Maybe
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))),
Provenance)
-> m (Bool,
Maybe
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))),
Provenance))
-> STM
m
(Bool,
Maybe
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))),
Provenance)
-> m (Bool,
Maybe
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))),
Provenance)
forall a b. (a -> b) -> a -> b
$ do
connState <- StrictTVar
m (ConnectionState peerAddr handle handleError version m)
-> STM m (ConnectionState peerAddr handle handleError version m)
forall (m :: * -> *) a. MonadSTM m => StrictTVar m a -> STM m a
readTVar StrictTVar
m (ConnectionState peerAddr handle handleError version m)
connVar
case connState of
ConnectionState peerAddr handle handleError version m
ReservedOutboundState ->
ConnectionManagerError peerAddr
-> STM
m
(Bool,
Maybe
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))),
Provenance)
forall (m :: * -> *) e a.
(MonadSTM m, MonadThrow (STM m), Exception e) =>
e -> STM m a
throwSTM ((CallStack -> ConnectionManagerError peerAddr)
-> ConnectionManagerError peerAddr
forall a. (?callStack::CallStack) => (CallStack -> a) -> a
withCallStack (peerAddr -> CallStack -> ConnectionManagerError peerAddr
forall peerAddr.
peerAddr -> CallStack -> ConnectionManagerError peerAddr
ImpossibleState peerAddr
peerAddr))
UnnegotiatedState {} -> do
let connState' :: ConnectionState peerAddr handle handleError version m
connState' = ConnectionId peerAddr
-> Async m ()
-> handle
-> DataFlow
-> ConnectionState peerAddr handle handleError version m
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
StrictTVar
m (ConnectionState peerAddr handle handleError version m)
-> ConnectionState peerAddr handle handleError version m
-> STM m ()
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'
(Bool,
Maybe
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))),
Provenance)
-> STM
m
(Bool,
Maybe
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))),
Provenance)
forall a. a -> STM m a
forall (m :: * -> *) a. Monad m => a -> m a
return ( Bool
True
, Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))
-> Maybe
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m)))
forall a. a -> Maybe a
Just (Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))
-> Maybe
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))))
-> Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))
-> Maybe
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m)))
forall a b. (a -> b) -> a -> b
$ ConnectionState peerAddr handle handleError version m
-> ConnectionState peerAddr handle handleError version m
-> Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))
forall state. state -> state -> Transition state
mkTransition ConnectionState peerAddr handle handleError version m
connState ConnectionState peerAddr handle handleError version m
connState'
, Provenance
Inbound
)
OutboundUniState {} -> (Bool,
Maybe
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))),
Provenance)
-> STM
m
(Bool,
Maybe
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))),
Provenance)
forall a. a -> STM m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
True, Maybe
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m)))
forall a. Maybe a
Nothing, Provenance
Outbound)
OutboundDupState {} -> (Bool,
Maybe
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))),
Provenance)
-> STM
m
(Bool,
Maybe
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))),
Provenance)
forall a. a -> STM m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
True, Maybe
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m)))
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' = ConnectionId peerAddr
-> Async m ()
-> handle
-> DataFlow
-> ConnectionState peerAddr handle handleError version m
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'
StrictTVar
m (ConnectionState peerAddr handle handleError version m)
-> ConnectionState peerAddr handle handleError version m
-> STM m ()
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'
(Bool,
Maybe
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))),
Provenance)
-> STM
m
(Bool,
Maybe
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))),
Provenance)
forall a. a -> STM m a
forall (m :: * -> *) a. Monad m => a -> m a
return ( Bool
True
, Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))
-> Maybe
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m)))
forall a. a -> Maybe a
Just (Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))
-> Maybe
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))))
-> Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))
-> Maybe
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m)))
forall a b. (a -> b) -> a -> b
$ ConnectionState peerAddr handle handleError version m
-> ConnectionState peerAddr handle handleError version m
-> Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))
forall state. state -> state -> Transition state
mkTransition ConnectionState peerAddr handle handleError version m
connState ConnectionState peerAddr handle handleError version m
connState'
, Provenance
Outbound
)
InboundIdleState {} ->
ConnectionManagerError peerAddr
-> STM
m
(Bool,
Maybe
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))),
Provenance)
forall (m :: * -> *) e a.
(MonadSTM m, MonadThrow (STM m), Exception e) =>
e -> STM m a
throwSTM ((CallStack -> ConnectionManagerError peerAddr)
-> ConnectionManagerError peerAddr
forall a. (?callStack::CallStack) => (CallStack -> a) -> a
withCallStack (peerAddr -> CallStack -> ConnectionManagerError peerAddr
forall peerAddr.
peerAddr -> CallStack -> ConnectionManagerError peerAddr
ImpossibleState peerAddr
peerAddr))
InboundState {} ->
ConnectionManagerError peerAddr
-> STM
m
(Bool,
Maybe
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))),
Provenance)
forall (m :: * -> *) e a.
(MonadSTM m, MonadThrow (STM m), Exception e) =>
e -> STM m a
throwSTM ((CallStack -> ConnectionManagerError peerAddr)
-> ConnectionManagerError peerAddr
forall a. (?callStack::CallStack) => (CallStack -> a) -> a
withCallStack (peerAddr -> CallStack -> ConnectionManagerError peerAddr
forall peerAddr.
peerAddr -> CallStack -> ConnectionManagerError peerAddr
ImpossibleState peerAddr
peerAddr))
DuplexState {} ->
ConnectionManagerError peerAddr
-> STM
m
(Bool,
Maybe
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))),
Provenance)
forall (m :: * -> *) e a.
(MonadSTM m, MonadThrow (STM m), Exception e) =>
e -> STM m a
throwSTM ((CallStack -> ConnectionManagerError peerAddr)
-> ConnectionManagerError peerAddr
forall a. (?callStack::CallStack) => (CallStack -> a) -> a
withCallStack (peerAddr -> CallStack -> ConnectionManagerError peerAddr
forall peerAddr.
peerAddr -> CallStack -> ConnectionManagerError peerAddr
ImpossibleState peerAddr
peerAddr))
TerminatingState {} -> (Bool,
Maybe
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))),
Provenance)
-> STM
m
(Bool,
Maybe
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))),
Provenance)
forall a. a -> STM m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
False, Maybe
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m)))
forall a. Maybe a
Nothing, Provenance
Inbound)
TerminatedState {} -> (Bool,
Maybe
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))),
Provenance)
-> STM
m
(Bool,
Maybe
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))),
Provenance)
forall a. a -> STM m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
False, Maybe
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m)))
forall a. Maybe a
Nothing, Provenance
Inbound)
traverse_ (traceWith trTracer . TransitionTrace peerAddr) mbTransition
traceCounters stateVar
if connected
then do
case inboundGovernorInfoChannel of
InResponderMode InformationChannel (NewConnectionInfo peerAddr handle) m
infoChannel ->
STM m () -> m ()
forall a. (?callStack::CallStack) => STM m a -> m a
forall (m :: * -> *) a.
(MonadSTM m, ?callStack::CallStack) =>
STM m a -> m a
atomically (STM m () -> m ()) -> STM m () -> m ()
forall a b. (a -> b) -> a -> b
$ InformationChannel (NewConnectionInfo peerAddr handle) m
-> NewConnectionInfo peerAddr handle -> STM m ()
forall a (m :: * -> *). InformationChannel a m -> a -> STM m ()
InfoChannel.writeMessage
InformationChannel (NewConnectionInfo peerAddr handle) m
infoChannel
(Provenance
-> ConnectionId peerAddr
-> DataFlow
-> handle
-> NewConnectionInfo peerAddr handle
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)
_ -> () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
return $ Connected connId dataFlow handle
else
return $ Disconnected connId 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
transitions <- STM
m
[Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))]
-> m [Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))]
forall a. (?callStack::CallStack) => STM m a -> m a
forall (m :: * -> *) a.
(MonadSTM m, ?callStack::CallStack) =>
STM m a -> m a
atomically (STM
m
[Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))]
-> m [Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))])
-> STM
m
[Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))]
-> m [Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))]
forall a b. (a -> b) -> a -> b
$ do
connState <- StrictTVar
m (ConnectionState peerAddr handle handleError version m)
-> STM m (ConnectionState peerAddr handle handleError version m)
forall (m :: * -> *) a. MonadSTM m => StrictTVar m a -> STM m a
readTVar StrictTVar
m (ConnectionState peerAddr handle handleError version m)
connVar
let connState' =
case handleError -> HandleErrorType
classifyHandleError (handleError -> HandleErrorType)
-> Maybe handleError -> Maybe HandleErrorType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe handleError
handleErrorM of
Just HandleErrorType
HandshakeFailure ->
ConnectionId peerAddr
-> Async m ()
-> Maybe handleError
-> ConnectionState peerAddr handle handleError version m
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 ->
Maybe handleError
-> ConnectionState peerAddr handle handleError version m
forall peerAddr handle handleError version (m :: * -> *).
Maybe handleError
-> ConnectionState peerAddr handle handleError version m
TerminatedState Maybe handleError
handleErrorM
Maybe HandleErrorType
Nothing ->
ConnectionId peerAddr
-> Async m ()
-> Maybe handleError
-> ConnectionState peerAddr handle handleError version m
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 = ConnectionState peerAddr handle handleError version m
-> ConnectionState peerAddr handle handleError version m
-> Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))
forall state. state -> state -> Transition state
mkTransition ConnectionState peerAddr handle handleError version m
connState ConnectionState peerAddr handle handleError version m
connState'
absConnState = MaybeUnknown
(ConnectionState peerAddr handle handleError version m)
-> AbstractState
forall muxMode peerAddr m a (b :: * -> *).
MaybeUnknown (ConnectionState muxMode peerAddr m a b)
-> AbstractState
abstractState (ConnectionState peerAddr handle handleError version m
-> MaybeUnknown
(ConnectionState peerAddr handle handleError version m)
forall state. state -> MaybeUnknown state
Known ConnectionState peerAddr handle handleError version m
connState)
shouldTrace = AbstractState
absConnState AbstractState -> AbstractState -> Bool
forall a. Eq a => a -> a -> Bool
/= AbstractState
TerminatedSt
updated <-
modifyTMVarSTM
stateVar
( \ConnectionManagerState peerAddr handle handleError version m
state ->
case peerAddr
-> ConnectionManagerState peerAddr handle handleError version m
-> Maybe (MutableConnState peerAddr handle handleError version m)
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,
Bool)
-> STM
m
(ConnectionManagerState peerAddr handle handleError version m,
Bool)
forall a. a -> STM m a
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' MutableConnState peerAddr handle handleError version m
-> MutableConnState peerAddr handle handleError version m -> Bool
forall a. Eq a => a -> a -> Bool
== MutableConnState peerAddr handle handleError version m
mutableConnState
then do
StrictTVar
m (ConnectionState peerAddr handle handleError version m)
-> ConnectionState peerAddr handle handleError version m
-> STM m ()
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'
(ConnectionManagerState peerAddr handle handleError version m,
Bool)
-> STM
m
(ConnectionManagerState peerAddr handle handleError version m,
Bool)
forall a. a -> STM m a
forall (m :: * -> *) a. Monad m => a -> m a
return (peerAddr
-> ConnectionManagerState peerAddr handle handleError version m
-> ConnectionManagerState peerAddr handle handleError version m
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,
Bool)
-> STM
m
(ConnectionManagerState peerAddr handle handleError version m,
Bool)
forall a. a -> STM m a
forall (m :: * -> *) a. Monad m => a -> m a
return (ConnectionManagerState peerAddr handle handleError version m
state , Bool
False)
)
if updated
then
return $
if shouldTrace
then [ transition
, Transition
{ fromState = Known (TerminatedState Nothing)
, toState = Unknown
}
]
else [ Transition
{ fromState = Known (TerminatedState Nothing)
, toState = Unknown
}
]
else return [ ]
traverse_ (traceWith trTracer . TransitionTrace peerAddr) transitions
traceCounters stateVar
return (Disconnected connId handleErrorM)
releaseInboundConnectionImpl
:: StrictTMVar m (ConnectionManagerState peerAddr handle handleError version m)
-> peerAddr
-> m (OperationResult DemotedToColdRemoteTr)
releaseInboundConnectionImpl :: StrictTMVar
m (ConnectionManagerState peerAddr handle handleError version m)
-> peerAddr -> m (OperationResult DemotedToColdRemoteTr)
releaseInboundConnectionImpl StrictTMVar
m (ConnectionManagerState peerAddr handle handleError version m)
stateVar peerAddr
peerAddr = m (OperationResult DemotedToColdRemoteTr)
-> m (OperationResult DemotedToColdRemoteTr)
forall a. m a -> m a
forall (m :: * -> *) a. MonadMask m => m a -> m a
mask_ (m (OperationResult DemotedToColdRemoteTr)
-> m (OperationResult DemotedToColdRemoteTr))
-> m (OperationResult DemotedToColdRemoteTr)
-> m (OperationResult DemotedToColdRemoteTr)
forall a b. (a -> b) -> a -> b
$ do
Tracer m (Trace peerAddr handlerTrace)
-> Trace peerAddr handlerTrace -> m ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer m (Trace peerAddr handlerTrace)
tracer (Provenance -> peerAddr -> Trace peerAddr handlerTrace
forall peerAddr handlerTrace.
Provenance -> peerAddr -> Trace peerAddr handlerTrace
TrReleaseConnection Provenance
Inbound peerAddr
peerAddr)
(mbThread, mbTransition, result, mbAssertion) <- STM
m
(Maybe (Async m ()),
Maybe
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))),
OperationResult DemotedToColdRemoteTr,
Maybe (Trace peerAddr handlerTrace))
-> m (Maybe (Async m ()),
Maybe
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))),
OperationResult DemotedToColdRemoteTr,
Maybe (Trace peerAddr handlerTrace))
forall a. (?callStack::CallStack) => STM m a -> m a
forall (m :: * -> *) a.
(MonadSTM m, ?callStack::CallStack) =>
STM m a -> m a
atomically (STM
m
(Maybe (Async m ()),
Maybe
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))),
OperationResult DemotedToColdRemoteTr,
Maybe (Trace peerAddr handlerTrace))
-> m (Maybe (Async m ()),
Maybe
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))),
OperationResult DemotedToColdRemoteTr,
Maybe (Trace peerAddr handlerTrace)))
-> STM
m
(Maybe (Async m ()),
Maybe
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))),
OperationResult DemotedToColdRemoteTr,
Maybe (Trace peerAddr handlerTrace))
-> m (Maybe (Async m ()),
Maybe
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))),
OperationResult DemotedToColdRemoteTr,
Maybe (Trace peerAddr handlerTrace))
forall a b. (a -> b) -> a -> b
$ do
state <- StrictTMVar
m (ConnectionManagerState peerAddr handle handleError version m)
-> STM
m (ConnectionManagerState peerAddr handle handleError version m)
forall (m :: * -> *) a. MonadSTM m => StrictTMVar m a -> STM m a
readTMVar StrictTMVar
m (ConnectionManagerState peerAddr handle handleError version m)
stateVar
case Map.lookup peerAddr state of
Maybe (MutableConnState peerAddr handle handleError version m)
Nothing -> do
(Maybe (Async m ()),
Maybe
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))),
OperationResult DemotedToColdRemoteTr,
Maybe (Trace peerAddr handlerTrace))
-> STM
m
(Maybe (Async m ()),
Maybe
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))),
OperationResult DemotedToColdRemoteTr,
Maybe (Trace peerAddr handlerTrace))
forall a. a -> STM m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ( Maybe (Async m ())
forall a. Maybe a
Nothing
, Maybe
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m)))
forall a. Maybe a
Nothing
, DemotedToColdRemoteTr -> OperationResult DemotedToColdRemoteTr
forall a. a -> OperationResult a
OperationSuccess DemotedToColdRemoteTr
CommitTr
, Maybe (Trace peerAddr handlerTrace)
forall a. Maybe a
Nothing
)
Just MutableConnState { 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 :: StrictTVar
m (ConnectionState peerAddr handle handleError version m)
connVar } -> do
connState <- StrictTVar
m (ConnectionState peerAddr handle handleError version m)
-> STM m (ConnectionState peerAddr handle handleError version m)
forall (m :: * -> *) a. MonadSTM m => StrictTVar m a -> STM m a
readTVar StrictTVar
m (ConnectionState peerAddr handle handleError version m)
connVar
let st = MaybeUnknown
(ConnectionState peerAddr handle handleError version m)
-> AbstractState
forall muxMode peerAddr m a (b :: * -> *).
MaybeUnknown (ConnectionState muxMode peerAddr m a b)
-> AbstractState
abstractState (ConnectionState peerAddr handle handleError version m
-> MaybeUnknown
(ConnectionState peerAddr handle handleError version m)
forall state. state -> MaybeUnknown state
Known ConnectionState peerAddr handle handleError version m
connState)
case connState of
ConnectionState peerAddr handle handleError version m
ReservedOutboundState ->
(Maybe (Async m ()),
Maybe
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))),
OperationResult DemotedToColdRemoteTr,
Maybe (Trace peerAddr handlerTrace))
-> STM
m
(Maybe (Async m ()),
Maybe
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))),
OperationResult DemotedToColdRemoteTr,
Maybe (Trace peerAddr handlerTrace))
forall a. a -> STM m a
forall (m :: * -> *) a. Monad m => a -> m a
return ( Maybe (Async m ())
forall a. Maybe a
Nothing
, Maybe
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m)))
forall a. Maybe a
Nothing
, AbstractState -> OperationResult DemotedToColdRemoteTr
forall a. AbstractState -> OperationResult a
UnsupportedState AbstractState
st
, Maybe (Trace peerAddr handlerTrace)
forall a. Maybe a
Nothing
)
UnnegotiatedState {} ->
(Maybe (Async m ()),
Maybe
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))),
OperationResult DemotedToColdRemoteTr,
Maybe (Trace peerAddr handlerTrace))
-> STM
m
(Maybe (Async m ()),
Maybe
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))),
OperationResult DemotedToColdRemoteTr,
Maybe (Trace peerAddr handlerTrace))
forall a. a -> STM m a
forall (m :: * -> *) a. Monad m => a -> m a
return ( Maybe (Async m ())
forall a. Maybe a
Nothing
, Maybe
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m)))
forall a. Maybe a
Nothing
, AbstractState -> OperationResult DemotedToColdRemoteTr
forall a. AbstractState -> OperationResult a
UnsupportedState AbstractState
st
, Maybe (Trace peerAddr handlerTrace)
forall a. Maybe a
Nothing
)
OutboundDupState ConnectionId peerAddr
connId Async m ()
connThread handle
handle TimeoutExpired
Ticking -> do
let connState' :: ConnectionState peerAddr handle handleError version m
connState' = ConnectionId peerAddr
-> Async m ()
-> handle
-> TimeoutExpired
-> ConnectionState peerAddr handle handleError version m
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
StrictTVar
m (ConnectionState peerAddr handle handleError version m)
-> ConnectionState peerAddr handle handleError version m
-> STM m ()
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'
(Maybe (Async m ()),
Maybe
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))),
OperationResult DemotedToColdRemoteTr,
Maybe (Trace peerAddr handlerTrace))
-> STM
m
(Maybe (Async m ()),
Maybe
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))),
OperationResult DemotedToColdRemoteTr,
Maybe (Trace peerAddr handlerTrace))
forall a. a -> STM m a
forall (m :: * -> *) a. Monad m => a -> m a
return ( Maybe (Async m ())
forall a. Maybe a
Nothing
, Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))
-> Maybe
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m)))
forall a. a -> Maybe a
Just (ConnectionState peerAddr handle handleError version m
-> ConnectionState peerAddr handle handleError version m
-> Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))
forall state. state -> state -> Transition state
mkTransition ConnectionState peerAddr handle handleError version m
connState ConnectionState peerAddr handle handleError version m
connState')
, DemotedToColdRemoteTr -> OperationResult DemotedToColdRemoteTr
forall a. a -> OperationResult a
OperationSuccess DemotedToColdRemoteTr
KeepTr
, Maybe (Trace peerAddr handlerTrace)
forall a. Maybe a
Nothing
)
OutboundDupState ConnectionId peerAddr
connId Async m ()
_connThread handle
_handle TimeoutExpired
Expired ->
Bool
-> STM
m
(Maybe (Async m ()),
Maybe
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))),
OperationResult DemotedToColdRemoteTr,
Maybe (Trace peerAddr handlerTrace))
-> STM
m
(Maybe (Async m ()),
Maybe
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))),
OperationResult DemotedToColdRemoteTr,
Maybe (Trace peerAddr handlerTrace))
forall a. (?callStack::CallStack) => Bool -> a -> a
assert Bool
False (STM
m
(Maybe (Async m ()),
Maybe
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))),
OperationResult DemotedToColdRemoteTr,
Maybe (Trace peerAddr handlerTrace))
-> STM
m
(Maybe (Async m ()),
Maybe
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))),
OperationResult DemotedToColdRemoteTr,
Maybe (Trace peerAddr handlerTrace)))
-> STM
m
(Maybe (Async m ()),
Maybe
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))),
OperationResult DemotedToColdRemoteTr,
Maybe (Trace peerAddr handlerTrace))
-> STM
m
(Maybe (Async m ()),
Maybe
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))),
OperationResult DemotedToColdRemoteTr,
Maybe (Trace peerAddr handlerTrace))
forall a b. (a -> b) -> a -> b
$
(Maybe (Async m ()),
Maybe
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))),
OperationResult DemotedToColdRemoteTr,
Maybe (Trace peerAddr handlerTrace))
-> STM
m
(Maybe (Async m ()),
Maybe
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))),
OperationResult DemotedToColdRemoteTr,
Maybe (Trace peerAddr handlerTrace))
forall a. a -> STM m a
forall (m :: * -> *) a. Monad m => a -> m a
return ( Maybe (Async m ())
forall a. Maybe a
Nothing
, Maybe
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m)))
forall a. Maybe a
Nothing
, DemotedToColdRemoteTr -> OperationResult DemotedToColdRemoteTr
forall a. a -> OperationResult a
OperationSuccess DemotedToColdRemoteTr
KeepTr
, Trace peerAddr handlerTrace -> Maybe (Trace peerAddr handlerTrace)
forall a. a -> Maybe a
Just (AssertionLocation peerAddr -> Trace peerAddr handlerTrace
forall peerAddr handlerTrace.
AssertionLocation peerAddr -> Trace peerAddr handlerTrace
TrUnexpectedlyFalseAssertion
(Maybe (ConnectionId peerAddr)
-> AbstractState -> AssertionLocation peerAddr
forall peerAddr.
Maybe (ConnectionId peerAddr)
-> AbstractState -> AssertionLocation peerAddr
ReleaseInboundConnection (ConnectionId peerAddr -> Maybe (ConnectionId peerAddr)
forall a. a -> Maybe a
Just ConnectionId peerAddr
connId)
AbstractState
st)
)
)
OutboundUniState ConnectionId peerAddr
_connId Async m ()
_connThread handle
_handle ->
(Maybe (Async m ()),
Maybe
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))),
OperationResult DemotedToColdRemoteTr,
Maybe (Trace peerAddr handlerTrace))
-> STM
m
(Maybe (Async m ()),
Maybe
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))),
OperationResult DemotedToColdRemoteTr,
Maybe (Trace peerAddr handlerTrace))
forall a. a -> STM m a
forall (m :: * -> *) a. Monad m => a -> m a
return ( Maybe (Async m ())
forall a. Maybe a
Nothing
, Maybe
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m)))
forall a. Maybe a
Nothing
, AbstractState -> OperationResult DemotedToColdRemoteTr
forall a. AbstractState -> OperationResult a
UnsupportedState AbstractState
st
, Maybe (Trace peerAddr handlerTrace)
forall a. Maybe a
Nothing
)
OutboundIdleState ConnectionId peerAddr
connId Async m ()
_connThread handle
_handle DataFlow
_dataFlow ->
(Maybe (Async m ()),
Maybe
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))),
OperationResult DemotedToColdRemoteTr,
Maybe (Trace peerAddr handlerTrace))
-> STM
m
(Maybe (Async m ()),
Maybe
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))),
OperationResult DemotedToColdRemoteTr,
Maybe (Trace peerAddr handlerTrace))
forall a. a -> STM m a
forall (m :: * -> *) a. Monad m => a -> m a
return ( Maybe (Async m ())
forall a. Maybe a
Nothing
, Maybe
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m)))
forall a. Maybe a
Nothing
, DemotedToColdRemoteTr -> OperationResult DemotedToColdRemoteTr
forall a. a -> OperationResult a
OperationSuccess DemotedToColdRemoteTr
CommitTr
, Trace peerAddr handlerTrace -> Maybe (Trace peerAddr handlerTrace)
forall a. a -> Maybe a
Just (AssertionLocation peerAddr -> Trace peerAddr handlerTrace
forall peerAddr handlerTrace.
AssertionLocation peerAddr -> Trace peerAddr handlerTrace
TrUnexpectedlyFalseAssertion
(Maybe (ConnectionId peerAddr)
-> AbstractState -> AssertionLocation peerAddr
forall peerAddr.
Maybe (ConnectionId peerAddr)
-> AbstractState -> AssertionLocation peerAddr
ReleaseInboundConnection (ConnectionId peerAddr -> Maybe (ConnectionId peerAddr)
forall a. a -> Maybe a
Just ConnectionId peerAddr
connId)
AbstractState
st)
)
)
InboundIdleState ConnectionId peerAddr
connId Async m ()
connThread handle
_handle DataFlow
_dataFlow -> do
let connState' :: ConnectionState peerAddr handle handleError version m
connState' = ConnectionId peerAddr
-> Async m ()
-> Maybe handleError
-> ConnectionState peerAddr handle handleError version m
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
forall a. Maybe a
Nothing
StrictTVar
m (ConnectionState peerAddr handle handleError version m)
-> ConnectionState peerAddr handle handleError version m
-> STM m ()
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'
(Maybe (Async m ()),
Maybe
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))),
OperationResult DemotedToColdRemoteTr,
Maybe (Trace peerAddr handlerTrace))
-> STM
m
(Maybe (Async m ()),
Maybe
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))),
OperationResult DemotedToColdRemoteTr,
Maybe (Trace peerAddr handlerTrace))
forall a. a -> STM m a
forall (m :: * -> *) a. Monad m => a -> m a
return ( Async m () -> Maybe (Async m ())
forall a. a -> Maybe a
Just Async m ()
connThread
, Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))
-> Maybe
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m)))
forall a. a -> Maybe a
Just (ConnectionState peerAddr handle handleError version m
-> ConnectionState peerAddr handle handleError version m
-> Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))
forall state. state -> state -> Transition state
mkTransition ConnectionState peerAddr handle handleError version m
connState ConnectionState peerAddr handle handleError version m
connState')
, DemotedToColdRemoteTr -> OperationResult DemotedToColdRemoteTr
forall a. a -> OperationResult a
OperationSuccess DemotedToColdRemoteTr
CommitTr
, Maybe (Trace peerAddr handlerTrace)
forall a. Maybe a
Nothing
)
InboundState ConnectionId peerAddr
connId Async m ()
connThread handle
_handle DataFlow
_dataFlow -> do
let connState' :: ConnectionState peerAddr handle handleError version m
connState' = ConnectionId peerAddr
-> Async m ()
-> Maybe handleError
-> ConnectionState peerAddr handle handleError version m
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
forall a. Maybe a
Nothing
StrictTVar
m (ConnectionState peerAddr handle handleError version m)
-> ConnectionState peerAddr handle handleError version m
-> STM m ()
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'
(Maybe (Async m ()),
Maybe
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))),
OperationResult DemotedToColdRemoteTr,
Maybe (Trace peerAddr handlerTrace))
-> STM
m
(Maybe (Async m ()),
Maybe
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))),
OperationResult DemotedToColdRemoteTr,
Maybe (Trace peerAddr handlerTrace))
forall a. a -> STM m a
forall (m :: * -> *) a. Monad m => a -> m a
return ( Async m () -> Maybe (Async m ())
forall a. a -> Maybe a
Just Async m ()
connThread
, Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))
-> Maybe
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m)))
forall a. a -> Maybe a
Just (ConnectionState peerAddr handle handleError version m
-> ConnectionState peerAddr handle handleError version m
-> Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))
forall state. state -> state -> Transition state
mkTransition ConnectionState peerAddr handle handleError version m
connState ConnectionState peerAddr handle handleError version m
connState')
, AbstractState -> OperationResult DemotedToColdRemoteTr
forall a. AbstractState -> OperationResult a
UnsupportedState AbstractState
st
, Trace peerAddr handlerTrace -> Maybe (Trace peerAddr handlerTrace)
forall a. a -> Maybe a
Just (AssertionLocation peerAddr -> Trace peerAddr handlerTrace
forall peerAddr handlerTrace.
AssertionLocation peerAddr -> Trace peerAddr handlerTrace
TrUnexpectedlyFalseAssertion
(Maybe (ConnectionId peerAddr)
-> AbstractState -> AssertionLocation peerAddr
forall peerAddr.
Maybe (ConnectionId peerAddr)
-> AbstractState -> AssertionLocation peerAddr
ReleaseInboundConnection (ConnectionId peerAddr -> Maybe (ConnectionId peerAddr)
forall a. a -> Maybe a
Just ConnectionId peerAddr
connId)
AbstractState
st)
)
)
DuplexState ConnectionId peerAddr
connId Async m ()
connThread handle
handle -> do
let connState' :: ConnectionState peerAddr handle handleError version m
connState' = ConnectionId peerAddr
-> Async m ()
-> handle
-> TimeoutExpired
-> ConnectionState peerAddr handle handleError version m
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
StrictTVar
m (ConnectionState peerAddr handle handleError version m)
-> ConnectionState peerAddr handle handleError version m
-> STM m ()
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'
(Maybe (Async m ()),
Maybe
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))),
OperationResult DemotedToColdRemoteTr,
Maybe (Trace peerAddr handlerTrace))
-> STM
m
(Maybe (Async m ()),
Maybe
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))),
OperationResult DemotedToColdRemoteTr,
Maybe (Trace peerAddr handlerTrace))
forall a. a -> STM m a
forall (m :: * -> *) a. Monad m => a -> m a
return ( Maybe (Async m ())
forall a. Maybe a
Nothing
, Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))
-> Maybe
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m)))
forall a. a -> Maybe a
Just (ConnectionState peerAddr handle handleError version m
-> ConnectionState peerAddr handle handleError version m
-> Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))
forall state. state -> state -> Transition state
mkTransition ConnectionState peerAddr handle handleError version m
connState ConnectionState peerAddr handle handleError version m
connState')
, AbstractState -> OperationResult DemotedToColdRemoteTr
forall a. AbstractState -> OperationResult a
UnsupportedState AbstractState
st
, Trace peerAddr handlerTrace -> Maybe (Trace peerAddr handlerTrace)
forall a. a -> Maybe a
Just (AssertionLocation peerAddr -> Trace peerAddr handlerTrace
forall peerAddr handlerTrace.
AssertionLocation peerAddr -> Trace peerAddr handlerTrace
TrUnexpectedlyFalseAssertion
(Maybe (ConnectionId peerAddr)
-> AbstractState -> AssertionLocation peerAddr
forall peerAddr.
Maybe (ConnectionId peerAddr)
-> AbstractState -> AssertionLocation peerAddr
ReleaseInboundConnection (ConnectionId peerAddr -> Maybe (ConnectionId peerAddr)
forall a. a -> Maybe a
Just ConnectionId peerAddr
connId)
AbstractState
st)
)
)
TerminatingState ConnectionId peerAddr
_connId Async m ()
_connThread Maybe handleError
_handleError ->
(Maybe (Async m ()),
Maybe
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))),
OperationResult DemotedToColdRemoteTr,
Maybe (Trace peerAddr handlerTrace))
-> STM
m
(Maybe (Async m ()),
Maybe
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))),
OperationResult DemotedToColdRemoteTr,
Maybe (Trace peerAddr handlerTrace))
forall a. a -> STM m a
forall (m :: * -> *) a. Monad m => a -> m a
return ( Maybe (Async m ())
forall a. Maybe a
Nothing
, Maybe
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m)))
forall a. Maybe a
Nothing
, DemotedToColdRemoteTr -> OperationResult DemotedToColdRemoteTr
forall a. a -> OperationResult a
OperationSuccess DemotedToColdRemoteTr
CommitTr
, Maybe (Trace peerAddr handlerTrace)
forall a. Maybe a
Nothing
)
TerminatedState Maybe handleError
_handleError ->
(Maybe (Async m ()),
Maybe
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))),
OperationResult DemotedToColdRemoteTr,
Maybe (Trace peerAddr handlerTrace))
-> STM
m
(Maybe (Async m ()),
Maybe
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))),
OperationResult DemotedToColdRemoteTr,
Maybe (Trace peerAddr handlerTrace))
forall a. a -> STM m a
forall (m :: * -> *) a. Monad m => a -> m a
return ( Maybe (Async m ())
forall a. Maybe a
Nothing
, Maybe
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m)))
forall a. Maybe a
Nothing
, AbstractState -> OperationResult DemotedToColdRemoteTr
forall a. AbstractState -> OperationResult a
UnsupportedState AbstractState
TerminatedSt
, Maybe (Trace peerAddr handlerTrace)
forall a. Maybe a
Nothing
)
traverse_ (traceWith trTracer . TransitionTrace peerAddr) mbTransition
traceCounters stateVar
traverse_ (flip throwTo AsyncCancelled . asyncThreadId)
mbThread
whenJust mbAssertion $ \Trace peerAddr handlerTrace
tr -> do
Tracer m (Trace peerAddr handlerTrace)
-> Trace peerAddr handlerTrace -> m ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer m (Trace peerAddr handlerTrace)
tracer Trace peerAddr handlerTrace
tr
_ <- (Any -> Any) -> m (Any -> Any)
forall a. a -> m a
forall (m :: * -> *) a. MonadEvaluate m => a -> m a
evaluate (Bool -> Any -> Any
forall a. (?callStack::CallStack) => Bool -> a -> a
assert Bool
False)
pure ()
return result
acquireOutboundConnectionImpl
:: 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)
acquireOutboundConnectionImpl :: (?callStack::CallStack) =>
FreshIdSupply m
-> StrictTMVar
m (ConnectionManagerState peerAddr handle handleError version m)
-> ConnectionHandlerFn
handlerTrace
socket
peerAddr
handle
handleError
(version, versionData)
m
-> AcquireOutboundConnection peerAddr handle handleError m
acquireOutboundConnectionImpl 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
Tracer m (Trace peerAddr handlerTrace)
-> Trace peerAddr handlerTrace -> m ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer m (Trace peerAddr handlerTrace)
tracer (Provenance -> peerAddr -> Trace peerAddr handlerTrace
forall peerAddr handlerTrace.
Provenance -> peerAddr -> Trace peerAddr handlerTrace
TrIncludeConnection Provenance
provenance peerAddr
peerAddr)
(trace, mutableConnState@MutableConnState { connVar }
, eHandleWedge) <- STM
m
(Maybe
(Either
(TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m))
(Trace peerAddr handlerTrace)),
MutableConnState peerAddr handle handleError version m,
Either
(ConnectionManagerError peerAddr)
(Wedge
(Connected peerAddr handle handleError) (ConnectionId peerAddr)))
-> m (Maybe
(Either
(TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m))
(Trace peerAddr handlerTrace)),
MutableConnState peerAddr handle handleError version m,
Either
(ConnectionManagerError peerAddr)
(Wedge
(Connected peerAddr handle handleError) (ConnectionId peerAddr)))
forall a. (?callStack::CallStack) => STM m a -> m a
forall (m :: * -> *) a.
(MonadSTM m, ?callStack::CallStack) =>
STM m a -> m a
atomically (STM
m
(Maybe
(Either
(TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m))
(Trace peerAddr handlerTrace)),
MutableConnState peerAddr handle handleError version m,
Either
(ConnectionManagerError peerAddr)
(Wedge
(Connected peerAddr handle handleError) (ConnectionId peerAddr)))
-> m (Maybe
(Either
(TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m))
(Trace peerAddr handlerTrace)),
MutableConnState peerAddr handle handleError version m,
Either
(ConnectionManagerError peerAddr)
(Wedge
(Connected peerAddr handle handleError) (ConnectionId peerAddr))))
-> STM
m
(Maybe
(Either
(TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m))
(Trace peerAddr handlerTrace)),
MutableConnState peerAddr handle handleError version m,
Either
(ConnectionManagerError peerAddr)
(Wedge
(Connected peerAddr handle handleError) (ConnectionId peerAddr)))
-> m (Maybe
(Either
(TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m))
(Trace peerAddr handlerTrace)),
MutableConnState peerAddr handle handleError version m,
Either
(ConnectionManagerError peerAddr)
(Wedge
(Connected peerAddr handle handleError) (ConnectionId peerAddr)))
forall a b. (a -> b) -> a -> b
$ do
state <- StrictTMVar
m (ConnectionManagerState peerAddr handle handleError version m)
-> STM
m (ConnectionManagerState peerAddr handle handleError version m)
forall (m :: * -> *) a. MonadSTM m => StrictTMVar m a -> STM m a
readTMVar StrictTMVar
m (ConnectionManagerState peerAddr handle handleError version m)
stateVar
case Map.lookup peerAddr state of
Just mutableConnState :: MutableConnState peerAddr handle handleError version m
mutableConnState@MutableConnState { 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 :: StrictTVar
m (ConnectionState peerAddr handle handleError version m)
connVar } -> do
connState <- StrictTVar
m (ConnectionState peerAddr handle handleError version m)
-> STM m (ConnectionState peerAddr handle handleError version m)
forall (m :: * -> *) a. MonadSTM m => StrictTVar m a -> STM m a
readTVar StrictTVar
m (ConnectionState peerAddr handle handleError version m)
connVar
let st = MaybeUnknown
(ConnectionState peerAddr handle handleError version m)
-> AbstractState
forall muxMode peerAddr m a (b :: * -> *).
MaybeUnknown (ConnectionState muxMode peerAddr m a b)
-> AbstractState
abstractState (ConnectionState peerAddr handle handleError version m
-> MaybeUnknown
(ConnectionState peerAddr handle handleError version m)
forall state. state -> MaybeUnknown state
Known ConnectionState peerAddr handle handleError version m
connState)
case connState of
ConnectionState peerAddr handle handleError version m
ReservedOutboundState ->
(Maybe
(Either
(TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m))
(Trace peerAddr handlerTrace)),
MutableConnState peerAddr handle handleError version m,
Either
(ConnectionManagerError peerAddr)
(Wedge
(Connected peerAddr handle handleError) (ConnectionId peerAddr)))
-> STM
m
(Maybe
(Either
(TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m))
(Trace peerAddr handlerTrace)),
MutableConnState peerAddr handle handleError version m,
Either
(ConnectionManagerError peerAddr)
(Wedge
(Connected peerAddr handle handleError) (ConnectionId peerAddr)))
forall a. a -> STM m a
forall (m :: * -> *) a. Monad m => a -> m a
return ( Either
(TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m))
(Trace peerAddr handlerTrace)
-> Maybe
(Either
(TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m))
(Trace peerAddr handlerTrace))
forall a. a -> Maybe a
Just (Trace peerAddr handlerTrace
-> Either
(TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m))
(Trace peerAddr handlerTrace)
forall a b. b -> Either a b
Right (Provenance
-> peerAddr -> AbstractState -> Trace peerAddr handlerTrace
forall peerAddr handlerTrace.
Provenance
-> peerAddr -> AbstractState -> Trace peerAddr handlerTrace
TrConnectionExists Provenance
provenance peerAddr
peerAddr AbstractState
st))
, MutableConnState peerAddr handle handleError version m
mutableConnState
, ConnectionManagerError peerAddr
-> Either
(ConnectionManagerError peerAddr)
(Wedge
(Connected peerAddr handle handleError) (ConnectionId peerAddr))
forall a b. a -> Either a b
Left ((CallStack -> ConnectionManagerError peerAddr)
-> ConnectionManagerError peerAddr
forall a. (?callStack::CallStack) => (CallStack -> a) -> a
withCallStack
(Provenance
-> peerAddr -> CallStack -> ConnectionManagerError peerAddr
forall peerAddr.
Provenance
-> peerAddr -> CallStack -> ConnectionManagerError peerAddr
ConnectionExists Provenance
provenance peerAddr
peerAddr))
)
UnnegotiatedState Provenance
Outbound ConnectionId peerAddr
_connId Async m ()
_connThread -> do
(Maybe
(Either
(TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m))
(Trace peerAddr handlerTrace)),
MutableConnState peerAddr handle handleError version m,
Either
(ConnectionManagerError peerAddr)
(Wedge
(Connected peerAddr handle handleError) (ConnectionId peerAddr)))
-> STM
m
(Maybe
(Either
(TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m))
(Trace peerAddr handlerTrace)),
MutableConnState peerAddr handle handleError version m,
Either
(ConnectionManagerError peerAddr)
(Wedge
(Connected peerAddr handle handleError) (ConnectionId peerAddr)))
forall a. a -> STM m a
forall (m :: * -> *) a. Monad m => a -> m a
return ( Either
(TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m))
(Trace peerAddr handlerTrace)
-> Maybe
(Either
(TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m))
(Trace peerAddr handlerTrace))
forall a. a -> Maybe a
Just (Trace peerAddr handlerTrace
-> Either
(TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m))
(Trace peerAddr handlerTrace)
forall a b. b -> Either a b
Right (Provenance
-> peerAddr -> AbstractState -> Trace peerAddr handlerTrace
forall peerAddr handlerTrace.
Provenance
-> peerAddr -> AbstractState -> Trace peerAddr handlerTrace
TrConnectionExists Provenance
provenance peerAddr
peerAddr AbstractState
st))
, MutableConnState peerAddr handle handleError version m
mutableConnState
, ConnectionManagerError peerAddr
-> Either
(ConnectionManagerError peerAddr)
(Wedge
(Connected peerAddr handle handleError) (ConnectionId peerAddr))
forall a b. a -> Either a b
Left ((CallStack -> ConnectionManagerError peerAddr)
-> ConnectionManagerError peerAddr
forall a. (?callStack::CallStack) => (CallStack -> a) -> a
withCallStack
(Provenance
-> peerAddr -> CallStack -> ConnectionManagerError peerAddr
forall peerAddr.
Provenance
-> peerAddr -> CallStack -> ConnectionManagerError peerAddr
ConnectionExists Provenance
provenance peerAddr
peerAddr))
)
UnnegotiatedState Provenance
Inbound ConnectionId peerAddr
connId Async m ()
_connThread ->
(Maybe
(Either
(TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m))
(Trace peerAddr handlerTrace)),
MutableConnState peerAddr handle handleError version m,
Either
(ConnectionManagerError peerAddr)
(Wedge
(Connected peerAddr handle handleError) (ConnectionId peerAddr)))
-> STM
m
(Maybe
(Either
(TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m))
(Trace peerAddr handlerTrace)),
MutableConnState peerAddr handle handleError version m,
Either
(ConnectionManagerError peerAddr)
(Wedge
(Connected peerAddr handle handleError) (ConnectionId peerAddr)))
forall a. a -> STM m a
forall (m :: * -> *) a. Monad m => a -> m a
return ( Maybe
(Either
(TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m))
(Trace peerAddr handlerTrace))
forall a. Maybe a
Nothing
, MutableConnState peerAddr handle handleError version m
mutableConnState
, Wedge
(Connected peerAddr handle handleError) (ConnectionId peerAddr)
-> Either
(ConnectionManagerError peerAddr)
(Wedge
(Connected peerAddr handle handleError) (ConnectionId peerAddr))
forall a b. b -> Either a b
Right (ConnectionId peerAddr
-> Wedge
(Connected peerAddr handle handleError) (ConnectionId peerAddr)
forall a b. b -> Wedge a b
There ConnectionId peerAddr
connId)
)
OutboundUniState {} -> do
(Maybe
(Either
(TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m))
(Trace peerAddr handlerTrace)),
MutableConnState peerAddr handle handleError version m,
Either
(ConnectionManagerError peerAddr)
(Wedge
(Connected peerAddr handle handleError) (ConnectionId peerAddr)))
-> STM
m
(Maybe
(Either
(TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m))
(Trace peerAddr handlerTrace)),
MutableConnState peerAddr handle handleError version m,
Either
(ConnectionManagerError peerAddr)
(Wedge
(Connected peerAddr handle handleError) (ConnectionId peerAddr)))
forall a. a -> STM m a
forall (m :: * -> *) a. Monad m => a -> m a
return ( Either
(TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m))
(Trace peerAddr handlerTrace)
-> Maybe
(Either
(TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m))
(Trace peerAddr handlerTrace))
forall a. a -> Maybe a
Just (Trace peerAddr handlerTrace
-> Either
(TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m))
(Trace peerAddr handlerTrace)
forall a b. b -> Either a b
Right (Provenance
-> peerAddr -> AbstractState -> Trace peerAddr handlerTrace
forall peerAddr handlerTrace.
Provenance
-> peerAddr -> AbstractState -> Trace peerAddr handlerTrace
TrConnectionExists Provenance
provenance peerAddr
peerAddr AbstractState
st))
, MutableConnState peerAddr handle handleError version m
mutableConnState
, ConnectionManagerError peerAddr
-> Either
(ConnectionManagerError peerAddr)
(Wedge
(Connected peerAddr handle handleError) (ConnectionId peerAddr))
forall a b. a -> Either a b
Left ((CallStack -> ConnectionManagerError peerAddr)
-> ConnectionManagerError peerAddr
forall a. (?callStack::CallStack) => (CallStack -> a) -> a
withCallStack
(Provenance
-> peerAddr -> CallStack -> ConnectionManagerError peerAddr
forall peerAddr.
Provenance
-> peerAddr -> CallStack -> ConnectionManagerError peerAddr
ConnectionExists Provenance
provenance peerAddr
peerAddr))
)
OutboundDupState {} -> do
(Maybe
(Either
(TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m))
(Trace peerAddr handlerTrace)),
MutableConnState peerAddr handle handleError version m,
Either
(ConnectionManagerError peerAddr)
(Wedge
(Connected peerAddr handle handleError) (ConnectionId peerAddr)))
-> STM
m
(Maybe
(Either
(TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m))
(Trace peerAddr handlerTrace)),
MutableConnState peerAddr handle handleError version m,
Either
(ConnectionManagerError peerAddr)
(Wedge
(Connected peerAddr handle handleError) (ConnectionId peerAddr)))
forall a. a -> STM m a
forall (m :: * -> *) a. Monad m => a -> m a
return ( Either
(TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m))
(Trace peerAddr handlerTrace)
-> Maybe
(Either
(TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m))
(Trace peerAddr handlerTrace))
forall a. a -> Maybe a
Just (Trace peerAddr handlerTrace
-> Either
(TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m))
(Trace peerAddr handlerTrace)
forall a b. b -> Either a b
Right (Provenance
-> peerAddr -> AbstractState -> Trace peerAddr handlerTrace
forall peerAddr handlerTrace.
Provenance
-> peerAddr -> AbstractState -> Trace peerAddr handlerTrace
TrConnectionExists Provenance
provenance peerAddr
peerAddr AbstractState
st))
, MutableConnState peerAddr handle handleError version m
mutableConnState
, ConnectionManagerError peerAddr
-> Either
(ConnectionManagerError peerAddr)
(Wedge
(Connected peerAddr handle handleError) (ConnectionId peerAddr))
forall a b. a -> Either a b
Left ((CallStack -> ConnectionManagerError peerAddr)
-> ConnectionManagerError peerAddr
forall a. (?callStack::CallStack) => (CallStack -> a) -> a
withCallStack
(Provenance
-> peerAddr -> CallStack -> ConnectionManagerError peerAddr
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 = MaybeUnknown
(ConnectionState peerAddr handle handleError version m)
-> AbstractState
forall muxMode peerAddr m a (b :: * -> *).
MaybeUnknown (ConnectionState muxMode peerAddr m a b)
-> AbstractState
abstractState (ConnectionState peerAddr handle handleError version m
-> MaybeUnknown
(ConnectionState peerAddr handle handleError version m)
forall state. state -> MaybeUnknown state
Known ConnectionState peerAddr handle handleError version m
connState) in
(Maybe
(Either
(TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m))
(Trace peerAddr handlerTrace)),
MutableConnState peerAddr handle handleError version m,
Either
(ConnectionManagerError peerAddr)
(Wedge
(Connected peerAddr handle handleError) (ConnectionId peerAddr)))
-> STM
m
(Maybe
(Either
(TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m))
(Trace peerAddr handlerTrace)),
MutableConnState peerAddr handle handleError version m,
Either
(ConnectionManagerError peerAddr)
(Wedge
(Connected peerAddr handle handleError) (ConnectionId peerAddr)))
forall a. a -> STM m a
forall (m :: * -> *) a. Monad m => a -> m a
return ( Either
(TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m))
(Trace peerAddr handlerTrace)
-> Maybe
(Either
(TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m))
(Trace peerAddr handlerTrace))
forall a. a -> Maybe a
Just (Trace peerAddr handlerTrace
-> Either
(TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m))
(Trace peerAddr handlerTrace)
forall a b. b -> Either a b
Right (peerAddr -> AbstractState -> Trace peerAddr handlerTrace
forall peerAddr handlerTrace.
peerAddr -> AbstractState -> Trace peerAddr handlerTrace
TrForbiddenOperation peerAddr
peerAddr AbstractState
tr))
, MutableConnState peerAddr handle handleError version m
mutableConnState
, ConnectionManagerError peerAddr
-> Either
(ConnectionManagerError peerAddr)
(Wedge
(Connected peerAddr handle handleError) (ConnectionId peerAddr))
forall a b. a -> Either a b
Left ((CallStack -> ConnectionManagerError peerAddr)
-> ConnectionManagerError peerAddr
forall a. (?callStack::CallStack) => (CallStack -> a) -> a
withCallStack (peerAddr
-> AbstractState -> CallStack -> ConnectionManagerError peerAddr
forall peerAddr.
peerAddr
-> AbstractState -> CallStack -> ConnectionManagerError peerAddr
ForbiddenOperation peerAddr
peerAddr AbstractState
tr))
)
InboundIdleState ConnectionId peerAddr
connId Async m ()
_connThread handle
_handle DataFlow
Unidirectional -> do
(Maybe
(Either
(TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m))
(Trace peerAddr handlerTrace)),
MutableConnState peerAddr handle handleError version m,
Either
(ConnectionManagerError peerAddr)
(Wedge
(Connected peerAddr handle handleError) (ConnectionId peerAddr)))
-> STM
m
(Maybe
(Either
(TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m))
(Trace peerAddr handlerTrace)),
MutableConnState peerAddr handle handleError version m,
Either
(ConnectionManagerError peerAddr)
(Wedge
(Connected peerAddr handle handleError) (ConnectionId peerAddr)))
forall a. a -> STM m a
forall (m :: * -> *) a. Monad m => a -> m a
return ( Either
(TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m))
(Trace peerAddr handlerTrace)
-> Maybe
(Either
(TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m))
(Trace peerAddr handlerTrace))
forall a. a -> Maybe a
Just (Trace peerAddr handlerTrace
-> Either
(TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m))
(Trace peerAddr handlerTrace)
forall a b. b -> Either a b
Right (ConnectionId peerAddr -> Trace peerAddr handlerTrace
forall peerAddr handlerTrace.
ConnectionId peerAddr -> Trace peerAddr handlerTrace
TrForbiddenConnection ConnectionId peerAddr
connId))
, MutableConnState peerAddr handle handleError version m
mutableConnState
, ConnectionManagerError peerAddr
-> Either
(ConnectionManagerError peerAddr)
(Wedge
(Connected peerAddr handle handleError) (ConnectionId peerAddr))
forall a b. a -> Either a b
Left ((CallStack -> ConnectionManagerError peerAddr)
-> ConnectionManagerError peerAddr
forall a. (?callStack::CallStack) => (CallStack -> a) -> a
withCallStack
(ConnectionId peerAddr
-> CallStack -> ConnectionManagerError peerAddr
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
let connState' :: ConnectionState peerAddr handle handleError version m
connState' = ConnectionId peerAddr
-> Async m ()
-> handle
-> TimeoutExpired
-> ConnectionState peerAddr handle handleError version m
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
StrictTVar
m (ConnectionState peerAddr handle handleError version m)
-> ConnectionState peerAddr handle handleError version m
-> STM m ()
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'
(Maybe
(Either
(TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m))
(Trace peerAddr handlerTrace)),
MutableConnState peerAddr handle handleError version m,
Either
(ConnectionManagerError peerAddr)
(Wedge
(Connected peerAddr handle handleError) (ConnectionId peerAddr)))
-> STM
m
(Maybe
(Either
(TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m))
(Trace peerAddr handlerTrace)),
MutableConnState peerAddr handle handleError version m,
Either
(ConnectionManagerError peerAddr)
(Wedge
(Connected peerAddr handle handleError) (ConnectionId peerAddr)))
forall a. a -> STM m a
forall (m :: * -> *) a. Monad m => a -> m a
return ( Either
(TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m))
(Trace peerAddr handlerTrace)
-> Maybe
(Either
(TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m))
(Trace peerAddr handlerTrace))
forall a. a -> Maybe a
Just (TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m)
-> Either
(TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m))
(Trace peerAddr handlerTrace)
forall a b. a -> Either a b
Left (peerAddr
-> Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))
-> TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m)
forall peerAddr state.
peerAddr -> Transition' state -> TransitionTrace' peerAddr state
TransitionTrace
peerAddr
peerAddr
(ConnectionState peerAddr handle handleError version m
-> ConnectionState peerAddr handle handleError version m
-> Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))
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
, Wedge
(Connected peerAddr handle handleError) (ConnectionId peerAddr)
-> Either
(ConnectionManagerError peerAddr)
(Wedge
(Connected peerAddr handle handleError) (ConnectionId peerAddr))
forall a b. b -> Either a b
Right (Connected peerAddr handle handleError
-> Wedge
(Connected peerAddr handle handleError) (ConnectionId peerAddr)
forall a b. a -> Wedge a b
Here (ConnectionId peerAddr
-> DataFlow -> handle -> Connected peerAddr handle handleError
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
(Maybe
(Either
(TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m))
(Trace peerAddr handlerTrace)),
MutableConnState peerAddr handle handleError version m,
Either
(ConnectionManagerError peerAddr)
(Wedge
(Connected peerAddr handle handleError) (ConnectionId peerAddr)))
-> STM
m
(Maybe
(Either
(TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m))
(Trace peerAddr handlerTrace)),
MutableConnState peerAddr handle handleError version m,
Either
(ConnectionManagerError peerAddr)
(Wedge
(Connected peerAddr handle handleError) (ConnectionId peerAddr)))
forall a. a -> STM m a
forall (m :: * -> *) a. Monad m => a -> m a
return ( Either
(TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m))
(Trace peerAddr handlerTrace)
-> Maybe
(Either
(TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m))
(Trace peerAddr handlerTrace))
forall a. a -> Maybe a
Just (Trace peerAddr handlerTrace
-> Either
(TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m))
(Trace peerAddr handlerTrace)
forall a b. b -> Either a b
Right (ConnectionId peerAddr -> Trace peerAddr handlerTrace
forall peerAddr handlerTrace.
ConnectionId peerAddr -> Trace peerAddr handlerTrace
TrForbiddenConnection ConnectionId peerAddr
connId))
, MutableConnState peerAddr handle handleError version m
mutableConnState
, ConnectionManagerError peerAddr
-> Either
(ConnectionManagerError peerAddr)
(Wedge
(Connected peerAddr handle handleError) (ConnectionId peerAddr))
forall a b. a -> Either a b
Left ((CallStack -> ConnectionManagerError peerAddr)
-> ConnectionManagerError peerAddr
forall a. (?callStack::CallStack) => (CallStack -> a) -> a
withCallStack
(ConnectionId peerAddr
-> CallStack -> ConnectionManagerError peerAddr
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
let connState' :: ConnectionState peerAddr handle handleError version m
connState' = ConnectionId peerAddr
-> Async m ()
-> handle
-> ConnectionState peerAddr handle handleError version m
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
StrictTVar
m (ConnectionState peerAddr handle handleError version m)
-> ConnectionState peerAddr handle handleError version m
-> STM m ()
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'
(Maybe
(Either
(TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m))
(Trace peerAddr handlerTrace)),
MutableConnState peerAddr handle handleError version m,
Either
(ConnectionManagerError peerAddr)
(Wedge
(Connected peerAddr handle handleError) (ConnectionId peerAddr)))
-> STM
m
(Maybe
(Either
(TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m))
(Trace peerAddr handlerTrace)),
MutableConnState peerAddr handle handleError version m,
Either
(ConnectionManagerError peerAddr)
(Wedge
(Connected peerAddr handle handleError) (ConnectionId peerAddr)))
forall a. a -> STM m a
forall (m :: * -> *) a. Monad m => a -> m a
return ( Either
(TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m))
(Trace peerAddr handlerTrace)
-> Maybe
(Either
(TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m))
(Trace peerAddr handlerTrace))
forall a. a -> Maybe a
Just (TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m)
-> Either
(TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m))
(Trace peerAddr handlerTrace)
forall a b. a -> Either a b
Left (peerAddr
-> Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))
-> TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m)
forall peerAddr state.
peerAddr -> Transition' state -> TransitionTrace' peerAddr state
TransitionTrace
peerAddr
peerAddr
(ConnectionState peerAddr handle handleError version m
-> ConnectionState peerAddr handle handleError version m
-> Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))
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
, Wedge
(Connected peerAddr handle handleError) (ConnectionId peerAddr)
-> Either
(ConnectionManagerError peerAddr)
(Wedge
(Connected peerAddr handle handleError) (ConnectionId peerAddr))
forall a b. b -> Either a b
Right (Connected peerAddr handle handleError
-> Wedge
(Connected peerAddr handle handleError) (ConnectionId peerAddr)
forall a b. a -> Wedge a b
Here (ConnectionId peerAddr
-> DataFlow -> handle -> Connected peerAddr handle handleError
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 ->
(Maybe
(Either
(TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m))
(Trace peerAddr handlerTrace)),
MutableConnState peerAddr handle handleError version m,
Either
(ConnectionManagerError peerAddr)
(Wedge
(Connected peerAddr handle handleError) (ConnectionId peerAddr)))
-> STM
m
(Maybe
(Either
(TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m))
(Trace peerAddr handlerTrace)),
MutableConnState peerAddr handle handleError version m,
Either
(ConnectionManagerError peerAddr)
(Wedge
(Connected peerAddr handle handleError) (ConnectionId peerAddr)))
forall a. a -> STM m a
forall (m :: * -> *) a. Monad m => a -> m a
return ( Either
(TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m))
(Trace peerAddr handlerTrace)
-> Maybe
(Either
(TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m))
(Trace peerAddr handlerTrace))
forall a. a -> Maybe a
Just (Trace peerAddr handlerTrace
-> Either
(TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m))
(Trace peerAddr handlerTrace)
forall a b. b -> Either a b
Right (Provenance
-> peerAddr -> AbstractState -> Trace peerAddr handlerTrace
forall peerAddr handlerTrace.
Provenance
-> peerAddr -> AbstractState -> Trace peerAddr handlerTrace
TrConnectionExists Provenance
provenance peerAddr
peerAddr AbstractState
st))
, MutableConnState peerAddr handle handleError version m
mutableConnState
, ConnectionManagerError peerAddr
-> Either
(ConnectionManagerError peerAddr)
(Wedge
(Connected peerAddr handle handleError) (ConnectionId peerAddr))
forall a b. a -> Either a b
Left ((CallStack -> ConnectionManagerError peerAddr)
-> ConnectionManagerError peerAddr
forall a. (?callStack::CallStack) => (CallStack -> a) -> a
withCallStack
(Provenance
-> peerAddr -> CallStack -> ConnectionManagerError peerAddr
forall peerAddr.
Provenance
-> peerAddr -> CallStack -> ConnectionManagerError peerAddr
ConnectionExists Provenance
provenance peerAddr
peerAddr))
)
TerminatingState ConnectionId peerAddr
_connId Async m ()
_connThread Maybe handleError
_handleError ->
STM
m
(Maybe
(Either
(TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m))
(Trace peerAddr handlerTrace)),
MutableConnState peerAddr handle handleError version m,
Either
(ConnectionManagerError peerAddr)
(Wedge
(Connected peerAddr handle handleError) (ConnectionId peerAddr)))
forall a. STM m a
forall (m :: * -> *) a. MonadSTM m => STM m a
retry
TerminatedState Maybe handleError
_handleError -> do
retry
Maybe (MutableConnState peerAddr handle handleError version m)
Nothing -> do
let connState' :: ConnectionState peerAddr handle handleError version m
connState' = ConnectionState peerAddr handle handleError version m
forall {peerAddr} {handle} {handleError} {version} {m :: * -> *}.
ConnectionState peerAddr handle handleError version m
ReservedOutboundState
(mutableConnState :: MutableConnState peerAddr handle handleError
version m)
<- peerAddr
-> FreshIdSupply m
-> ConnectionState peerAddr handle handleError version m
-> STM m (MutableConnState peerAddr handle handleError version m)
forall peerAddr handle handleError version (m :: * -> *).
(MonadTraceSTM m, Typeable peerAddr) =>
peerAddr
-> FreshIdSupply m
-> ConnectionState peerAddr handle handleError version m
-> STM m (MutableConnState peerAddr handle handleError version m)
newMutableConnState peerAddr
peerAddr FreshIdSupply m
freshIdSupply ConnectionState peerAddr handle handleError version m
forall {peerAddr} {handle} {handleError} {version} {m :: * -> *}.
ConnectionState peerAddr handle handleError version m
connState'
labelTVar (connVar mutableConnState) ("conn-state-" ++ show peerAddr)
(mbConnState
:: Maybe (ConnectionState peerAddr handle handleError version m))
<- swapTMVar stateVar
(Map.insert peerAddr mutableConnState state)
>>= traverse (readTVar . connVar) . Map.lookup peerAddr
return ( Just (Left (TransitionTrace
peerAddr
Transition {
fromState = maybe Unknown Known mbConnState,
toState = Known connState'
}))
, mutableConnState
, Right Nowhere
)
traverse_ (either (traceWith trTracer) (traceWith tracer)) trace
traceCounters stateVar
case eHandleWedge of
Left ConnectionManagerError peerAddr
e ->
ConnectionManagerError peerAddr
-> m (Connected peerAddr handle handleError)
forall e a. Exception e => e -> m a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwIO ConnectionManagerError peerAddr
e
Right Wedge
(Connected peerAddr handle handleError) (ConnectionId peerAddr)
Nowhere -> do
(reader, writer) <- m (PromiseReader
m
(Either
handleError
(HandshakeConnectionResult handle (version, versionData))),
PromiseWriter
m
(Either
handleError
(HandshakeConnectionResult handle (version, versionData))))
forall (m :: * -> *) a.
(MonadSTM m, MonadThrow (STM m)) =>
m (PromiseReader m a, PromiseWriter m a)
newEmptyPromiseIO
(connId, connThread) <-
mask $ \forall a. m a -> m a
unmask -> do
(socket, connId) <-
m (socket, ConnectionId peerAddr)
-> m (socket, ConnectionId peerAddr)
forall a. m a -> m a
unmask (m (socket, ConnectionId peerAddr)
-> m (socket, ConnectionId peerAddr))
-> m (socket, ConnectionId peerAddr)
-> m (socket, ConnectionId peerAddr)
forall a b. (a -> b) -> a -> b
$ m socket
-> (socket -> m ())
-> (socket -> m (socket, ConnectionId peerAddr))
-> m (socket, ConnectionId peerAddr)
forall a b c. m a -> (a -> m b) -> (a -> m c) -> m c
forall (m :: * -> *) a b c.
MonadCatch m =>
m a -> (a -> m b) -> (a -> m c) -> m c
bracketOnError
(Snocket m socket peerAddr -> peerAddr -> m socket
forall (m :: * -> *) fd addr. Snocket m fd addr -> addr -> m fd
openToConnect Snocket m socket peerAddr
snocket peerAddr
peerAddr)
(\socket
socket -> m () -> m ()
forall a. m a -> m a
forall (m :: * -> *) a. MonadMask m => m a -> m a
uninterruptibleMask_ (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
Snocket m socket peerAddr -> socket -> m ()
forall (m :: * -> *) fd addr. Snocket m fd addr -> fd -> m ()
close Snocket m socket peerAddr
snocket socket
socket
trs <- STM
m
[Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))]
-> m [Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))]
forall a. (?callStack::CallStack) => STM m a -> m a
forall (m :: * -> *) a.
(MonadSTM m, ?callStack::CallStack) =>
STM m a -> m a
atomically (STM
m
[Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))]
-> m [Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))])
-> STM
m
[Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))]
-> m [Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))]
forall a b. (a -> b) -> a -> b
$ StrictTMVar
m (ConnectionManagerState peerAddr handle handleError version m)
-> (ConnectionManagerState peerAddr handle handleError version m
-> STM
m
(ConnectionManagerState peerAddr handle handleError version m,
[Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))]))
-> STM
m
[Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))]
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
-> STM
m
(ConnectionManagerState peerAddr handle handleError version m,
[Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))]))
-> STM
m
[Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))])
-> (ConnectionManagerState peerAddr handle handleError version m
-> STM
m
(ConnectionManagerState peerAddr handle handleError version m,
[Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))]))
-> STM
m
[Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))]
forall a b. (a -> b) -> a -> b
$ \ConnectionManagerState peerAddr handle handleError version m
state -> do
case peerAddr
-> ConnectionManagerState peerAddr handle handleError version m
-> Maybe (MutableConnState peerAddr handle handleError version m)
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
connState <- StrictTVar
m (ConnectionState peerAddr handle handleError version m)
-> STM m (ConnectionState peerAddr handle handleError version m)
forall (m :: * -> *) a. MonadSTM m => StrictTVar m a -> STM m a
readTVar StrictTVar
m (ConnectionState peerAddr handle handleError version m)
connVar
let connState' = Maybe handleError
-> ConnectionState peerAddr handle handleError version m
forall peerAddr handle handleError version (m :: * -> *).
Maybe handleError
-> ConnectionState peerAddr handle handleError version m
TerminatedState Maybe handleError
forall a. Maybe a
Nothing
writeTVar connVar connState'
return
( state
, [ mkTransition connState connState'
, Transition (Known connState') Unknown
]
)
Just MutableConnState peerAddr handle handleError version m
mutableConnState' -> do
connState <- StrictTVar
m (ConnectionState peerAddr handle handleError version m)
-> STM m (ConnectionState peerAddr handle handleError version m)
forall (m :: * -> *) a. MonadSTM m => StrictTVar m a -> STM m a
readTVar StrictTVar
m (ConnectionState peerAddr handle handleError version m)
connVar
case connState of
ConnectionState peerAddr handle handleError version m
ReservedOutboundState | MutableConnState peerAddr handle handleError version m
mutableConnState' MutableConnState peerAddr handle handleError version m
-> MutableConnState peerAddr handle handleError version m -> Bool
forall a. Eq a => a -> a -> Bool
== MutableConnState peerAddr handle handleError version m
mutableConnState -> do
let state' :: ConnectionManagerState peerAddr handle handleError version m
state' = peerAddr
-> ConnectionManagerState peerAddr handle handleError version m
-> ConnectionManagerState peerAddr handle handleError version m
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' = Maybe handleError
-> ConnectionState peerAddr handle handleError version m
forall peerAddr handle handleError version (m :: * -> *).
Maybe handleError
-> ConnectionState peerAddr handle handleError version m
TerminatedState Maybe handleError
forall a. Maybe a
Nothing
StrictTVar
m (ConnectionState peerAddr handle handleError version m)
-> ConnectionState peerAddr handle handleError version m
-> STM m ()
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
forall {peerAddr} {handle} {handleError} {version} {m :: * -> *}.
ConnectionState peerAddr handle handleError version m
connState'
(ConnectionManagerState peerAddr handle handleError version m,
[Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))])
-> STM
m
(ConnectionManagerState peerAddr handle handleError version m,
[Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))])
forall a. a -> STM m a
forall (m :: * -> *) a. Monad m => a -> m a
return
( ConnectionManagerState peerAddr handle handleError version m
state'
, [ ConnectionState peerAddr handle handleError version m
-> ConnectionState peerAddr handle handleError version m
-> Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))
forall state. state -> state -> Transition state
mkTransition ConnectionState peerAddr handle handleError version m
connState ConnectionState peerAddr handle handleError version m
forall {peerAddr} {handle} {handleError} {version} {m :: * -> *}.
ConnectionState peerAddr handle handleError version m
connState'
, MaybeUnknown
(ConnectionState peerAddr handle handleError version m)
-> MaybeUnknown
(ConnectionState peerAddr handle handleError version m)
-> Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))
forall state. state -> state -> Transition' state
Transition (ConnectionState peerAddr handle handleError version m
-> MaybeUnknown
(ConnectionState peerAddr handle handleError version m)
forall state. state -> MaybeUnknown state
Known ConnectionState peerAddr handle handleError version m
forall {peerAddr} {handle} {handleError} {version} {m :: * -> *}.
ConnectionState peerAddr handle handleError version m
connState')
MaybeUnknown
(ConnectionState peerAddr handle handleError version m)
forall state. MaybeUnknown state
Unknown
]
)
ConnectionState peerAddr handle handleError version m
_ -> (ConnectionManagerState peerAddr handle handleError version m,
[Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))])
-> STM
m
(ConnectionManagerState peerAddr handle handleError version m,
[Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))])
forall a. a -> STM m a
forall (m :: * -> *) a. Monad m => a -> m a
return (ConnectionManagerState peerAddr handle handleError version m
state, [])
traverse_ (traceWith trTracer . TransitionTrace peerAddr) trs
traceCounters stateVar
)
((socket -> m (socket, ConnectionId peerAddr))
-> m (socket, ConnectionId peerAddr))
-> (socket -> m (socket, ConnectionId peerAddr))
-> m (socket, ConnectionId peerAddr)
forall a b. (a -> b) -> a -> b
$ \socket
socket -> do
Tracer m (Trace peerAddr handlerTrace)
-> Trace peerAddr handlerTrace -> m ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer m (Trace peerAddr handlerTrace)
tracer (Provenance -> peerAddr -> Trace peerAddr handlerTrace
forall peerAddr handlerTrace.
Provenance -> peerAddr -> Trace peerAddr handlerTrace
TrConnectionNotFound Provenance
provenance peerAddr
peerAddr)
let addr :: Maybe peerAddr
addr = case peerAddr -> Maybe AddressType
addressType peerAddr
peerAddr of
Maybe AddressType
Nothing -> Maybe peerAddr
forall a. Maybe a
Nothing
Just AddressType
IPv4Address -> Maybe peerAddr
ipv4Address
Just AddressType
IPv6Address -> Maybe peerAddr
ipv6Address
socket -> Maybe peerAddr -> m ()
configureSocket socket
socket Maybe peerAddr
addr
case peerAddr -> Maybe AddressType
addressType peerAddr
peerAddr of
Maybe AddressType
Nothing -> () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
Just AddressType
IPv4Address ->
(peerAddr -> m ()) -> Maybe peerAddr -> m ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (Snocket m socket peerAddr -> socket -> peerAddr -> m ()
forall (m :: * -> *) fd addr.
Snocket m fd addr -> fd -> addr -> m ()
bind Snocket m socket peerAddr
snocket socket
socket)
Maybe peerAddr
ipv4Address
Just AddressType
IPv6Address ->
(peerAddr -> m ()) -> Maybe peerAddr -> m ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (Snocket m socket peerAddr -> socket -> peerAddr -> m ()
forall (m :: * -> *) fd addr.
Snocket m fd addr -> fd -> addr -> m ()
bind Snocket m socket peerAddr
snocket socket
socket)
Maybe peerAddr
ipv6Address
Tracer m (Trace peerAddr handlerTrace)
-> Trace peerAddr handlerTrace -> m ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer m (Trace peerAddr handlerTrace)
tracer (Maybe peerAddr -> peerAddr -> Trace peerAddr handlerTrace
forall peerAddr handlerTrace.
Maybe peerAddr -> peerAddr -> Trace peerAddr handlerTrace
TrConnect Maybe peerAddr
addr peerAddr
peerAddr)
Snocket m socket peerAddr -> socket -> peerAddr -> m ()
forall (m :: * -> *) fd addr.
Snocket m fd addr -> fd -> addr -> m ()
connect Snocket m socket peerAddr
snocket socket
socket peerAddr
peerAddr
m () -> (SomeException -> m ()) -> m ()
forall e a. Exception e => m a -> (e -> m a) -> m a
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> (e -> m a) -> m a
`catch` \SomeException
e -> do
Tracer m (Trace peerAddr handlerTrace)
-> Trace peerAddr handlerTrace -> m ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer m (Trace peerAddr handlerTrace)
tracer (Maybe peerAddr
-> peerAddr -> SomeException -> Trace peerAddr handlerTrace
forall peerAddr handlerTrace.
Maybe peerAddr
-> peerAddr -> SomeException -> Trace peerAddr handlerTrace
TrConnectError Maybe peerAddr
addr peerAddr
peerAddr SomeException
e)
SomeException -> m ()
forall e a. Exception e => e -> m a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwIO SomeException
e
localAddress <- Snocket m socket peerAddr -> socket -> m peerAddr
forall (m :: * -> *) fd addr. Snocket m fd addr -> fd -> m addr
getLocalAddr Snocket m socket peerAddr
snocket socket
socket
let connId = ConnectionId { peerAddr
localAddress :: peerAddr
localAddress :: peerAddr
localAddress
, remoteAddress :: peerAddr
remoteAddress = peerAddr
peerAddr
}
return (socket, connId)
connThread <-
forkConnectionHandler
stateVar mutableConnState socket connId writer handler
return (connId, connThread)
(trans, mbAssertion) <- atomically $ do
connState <- readTVar connVar
case connState of
ConnectionState peerAddr handle handleError version m
ReservedOutboundState -> do
let connState' :: ConnectionState peerAddr handle handleError version m
connState' = Provenance
-> ConnectionId peerAddr
-> Async m ()
-> ConnectionState peerAddr handle handleError version m
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
StrictTVar
m (ConnectionState peerAddr handle handleError version m)
-> ConnectionState peerAddr handle handleError version m
-> STM m ()
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'
(Maybe
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))),
Maybe (Trace peerAddr handlerTrace))
-> STM
m
(Maybe
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))),
Maybe (Trace peerAddr handlerTrace))
forall a. a -> STM m a
forall (m :: * -> *) a. Monad m => a -> m a
return ( Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))
-> Maybe
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m)))
forall a. a -> Maybe a
Just (Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))
-> Maybe
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))))
-> Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))
-> Maybe
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m)))
forall a b. (a -> b) -> a -> b
$ ConnectionState peerAddr handle handleError version m
-> ConnectionState peerAddr handle handleError version m
-> Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))
forall state. state -> state -> Transition state
mkTransition ConnectionState peerAddr handle handleError version m
connState ConnectionState peerAddr handle handleError version m
connState'
, Maybe (Trace peerAddr handlerTrace)
forall a. Maybe a
Nothing
)
UnnegotiatedState Provenance
Inbound ConnectionId peerAddr
_connId Async m ()
_connThread -> do
let connState' :: ConnectionState peerAddr handle handleError version m
connState' = Provenance
-> ConnectionId peerAddr
-> Async m ()
-> ConnectionState peerAddr handle handleError version m
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
StrictTVar
m (ConnectionState peerAddr handle handleError version m)
-> ConnectionState peerAddr handle handleError version m
-> STM m ()
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'
(Maybe
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))),
Maybe (Trace peerAddr handlerTrace))
-> STM
m
(Maybe
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))),
Maybe (Trace peerAddr handlerTrace))
forall a. a -> STM m a
forall (m :: * -> *) a. Monad m => a -> m a
return ( Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))
-> Maybe
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m)))
forall a. a -> Maybe a
Just (Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))
-> Maybe
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))))
-> Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))
-> Maybe
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m)))
forall a b. (a -> b) -> a -> b
$ ConnectionState peerAddr handle handleError version m
-> ConnectionState peerAddr handle handleError version m
-> Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))
forall state. state -> state -> Transition state
mkTransition ConnectionState peerAddr handle handleError version m
connState ConnectionState peerAddr handle handleError version m
connState'
, Maybe (Trace peerAddr handlerTrace)
forall a. Maybe a
Nothing
)
TerminatingState {} ->
(Maybe
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))),
Maybe (Trace peerAddr handlerTrace))
-> STM
m
(Maybe
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))),
Maybe (Trace peerAddr handlerTrace))
forall a. a -> STM m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m)))
forall a. Maybe a
Nothing, Maybe (Trace peerAddr handlerTrace)
forall a. Maybe a
Nothing)
TerminatedState {} ->
(Maybe
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))),
Maybe (Trace peerAddr handlerTrace))
-> STM
m
(Maybe
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))),
Maybe (Trace peerAddr handlerTrace))
forall a. a -> STM m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m)))
forall a. Maybe a
Nothing, Maybe (Trace peerAddr handlerTrace)
forall a. Maybe a
Nothing)
ConnectionState peerAddr handle handleError version m
_ ->
(Maybe
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))),
Maybe (Trace peerAddr handlerTrace))
-> STM
m
(Maybe
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))),
Maybe (Trace peerAddr handlerTrace))
forall a. a -> STM m a
forall (m :: * -> *) a. Monad m => a -> m a
return ( Maybe
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m)))
forall a. Maybe a
Nothing
, Trace peerAddr handlerTrace -> Maybe (Trace peerAddr handlerTrace)
forall a. a -> Maybe a
Just (AssertionLocation peerAddr -> Trace peerAddr handlerTrace
forall peerAddr handlerTrace.
AssertionLocation peerAddr -> Trace peerAddr handlerTrace
TrUnexpectedlyFalseAssertion
(Maybe (ConnectionId peerAddr)
-> AbstractState -> AssertionLocation peerAddr
forall peerAddr.
Maybe (ConnectionId peerAddr)
-> AbstractState -> AssertionLocation peerAddr
AcquireOutboundConnection
(ConnectionId peerAddr -> Maybe (ConnectionId peerAddr)
forall a. a -> Maybe a
Just ConnectionId peerAddr
connId)
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m)
-> AbstractState
forall muxMode peerAddr m a (b :: * -> *).
MaybeUnknown (ConnectionState muxMode peerAddr m a b)
-> AbstractState
abstractState (ConnectionState peerAddr handle handleError version m
-> MaybeUnknown
(ConnectionState peerAddr handle handleError version m)
forall state. state -> MaybeUnknown state
Known ConnectionState peerAddr handle handleError version m
connState))
)
)
)
traverse_ (traceWith trTracer . TransitionTrace peerAddr) trans
traverse_ (traceWith tracer >=> evaluate . assert True)
mbAssertion
traceCounters stateVar
res <- atomically (readPromise reader)
case 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 (Maybe handleError -> m (Connected peerAddr handle handleError))
-> Maybe handleError -> m (Connected peerAddr handle handleError)
forall a b. (a -> b) -> a -> b
$ handleError -> Maybe handleError
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 Maybe handleError
forall a. Maybe a
Nothing
Right (HandshakeConnectionResult handle
handle (version
_version, versionData
versionData)) -> do
let dataFlow :: DataFlow
dataFlow = versionData -> DataFlow
connectionDataFlow versionData
versionData
mbTransition <- STM
m
(Maybe
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))))
-> m (Maybe
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))))
forall a. (?callStack::CallStack) => STM m a -> m a
forall (m :: * -> *) a.
(MonadSTM m, ?callStack::CallStack) =>
STM m a -> m a
atomically (STM
m
(Maybe
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))))
-> m (Maybe
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m)))))
-> STM
m
(Maybe
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))))
-> m (Maybe
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))))
forall a b. (a -> b) -> a -> b
$ do
connState <- StrictTVar
m (ConnectionState peerAddr handle handleError version m)
-> STM m (ConnectionState peerAddr handle handleError version m)
forall (m :: * -> *) a. MonadSTM m => StrictTVar m a -> STM m a
readTVar StrictTVar
m (ConnectionState peerAddr handle handleError version m)
connVar
case connState of
UnnegotiatedState Provenance
provenance' ConnectionId peerAddr
_ Async m ()
_ ->
case DataFlow
dataFlow of
DataFlow
Unidirectional -> do
let connState' :: ConnectionState peerAddr handle handleError version m
connState' = ConnectionId peerAddr
-> Async m ()
-> handle
-> ConnectionState peerAddr handle handleError version m
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
StrictTVar
m (ConnectionState peerAddr handle handleError version m)
-> ConnectionState peerAddr handle handleError version m
-> STM m ()
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'
Maybe
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m)))
-> STM
m
(Maybe
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))))
forall a. a -> STM m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))
-> Maybe
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m)))
forall a. a -> Maybe a
Just (Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))
-> Maybe
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))))
-> Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))
-> Maybe
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m)))
forall a b. (a -> b) -> a -> b
$ ConnectionState peerAddr handle handleError version m
-> ConnectionState peerAddr handle handleError version m
-> Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))
forall state. state -> state -> Transition state
mkTransition ConnectionState peerAddr handle handleError version m
connState ConnectionState peerAddr handle handleError version m
connState')
DataFlow
Duplex -> do
let connState' :: ConnectionState peerAddr handle handleError version m
connState' = ConnectionId peerAddr
-> Async m ()
-> handle
-> TimeoutExpired
-> ConnectionState peerAddr handle handleError version m
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
Provenance
Outbound -> Bool
True
StrictTVar
m (ConnectionState peerAddr handle handleError version m)
-> ConnectionState peerAddr handle handleError version m
-> STM m ()
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 ->
InformationChannel (NewConnectionInfo peerAddr handle) m
-> NewConnectionInfo peerAddr handle -> STM m ()
forall a (m :: * -> *). InformationChannel a m -> a -> STM m ()
InfoChannel.writeMessage
InformationChannel (NewConnectionInfo peerAddr handle) m
infoChannel
(Provenance
-> ConnectionId peerAddr
-> DataFlow
-> handle
-> NewConnectionInfo peerAddr handle
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)
_ -> () -> STM m ()
forall a. a -> STM m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Maybe
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m)))
-> STM
m
(Maybe
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))))
forall a. a -> STM m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))
-> Maybe
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m)))
forall a. a -> Maybe a
Just (Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))
-> Maybe
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))))
-> Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))
-> Maybe
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m)))
forall a b. (a -> b) -> a -> b
$ ConnectionState peerAddr handle handleError version m
-> ConnectionState peerAddr handle handleError version m
-> Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))
forall state. state -> state -> Transition state
mkTransition ConnectionState peerAddr handle handleError version m
connState ConnectionState peerAddr handle handleError version m
connState')
InboundIdleState ConnectionId peerAddr
connId' Async m ()
connThread' handle
handle' DataFlow
Unidirectional -> do
let connState' :: ConnectionState peerAddr handle handleError version m
connState' = ConnectionId peerAddr
-> Async m ()
-> handle
-> ConnectionState peerAddr handle handleError version m
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'
StrictTVar
m (ConnectionState peerAddr handle handleError version m)
-> ConnectionState peerAddr handle handleError version m
-> STM m ()
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'
Maybe
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m)))
-> STM
m
(Maybe
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))))
forall a. a -> STM m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))
-> Maybe
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m)))
forall a. a -> Maybe a
Just (Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))
-> Maybe
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))))
-> Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))
-> Maybe
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m)))
forall a b. (a -> b) -> a -> b
$ ConnectionState peerAddr handle handleError version m
-> ConnectionState peerAddr handle handleError version m
-> Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))
forall state. state -> state -> Transition state
mkTransition ConnectionState peerAddr handle handleError version m
connState ConnectionState peerAddr handle handleError version m
connState')
InboundIdleState ConnectionId peerAddr
connId' Async m ()
connThread' handle
handle' DataFlow
Duplex -> do
let connState' :: ConnectionState peerAddr handle handleError version m
connState' = ConnectionId peerAddr
-> Async m ()
-> handle
-> TimeoutExpired
-> ConnectionState peerAddr handle handleError version m
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
StrictTVar
m (ConnectionState peerAddr handle handleError version m)
-> ConnectionState peerAddr handle handleError version m
-> STM m ()
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'
Maybe
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m)))
-> STM
m
(Maybe
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))))
forall a. a -> STM m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))
-> Maybe
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m)))
forall a. a -> Maybe a
Just (Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))
-> Maybe
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))))
-> Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))
-> Maybe
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m)))
forall a b. (a -> b) -> a -> b
$ ConnectionState peerAddr handle handleError version m
-> ConnectionState peerAddr handle handleError version m
-> Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))
forall state. state -> state -> Transition state
mkTransition ConnectionState peerAddr handle handleError version m
connState ConnectionState peerAddr handle handleError version m
connState')
TerminatedState Maybe handleError
_ ->
Maybe
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m)))
-> STM
m
(Maybe
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))))
forall a. a -> STM m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m)))
forall a. Maybe a
Nothing
ConnectionState peerAddr handle handleError version m
_ ->
let st :: AbstractState
st = MaybeUnknown
(ConnectionState peerAddr handle handleError version m)
-> AbstractState
forall muxMode peerAddr m a (b :: * -> *).
MaybeUnknown (ConnectionState muxMode peerAddr m a b)
-> AbstractState
abstractState (ConnectionState peerAddr handle handleError version m
-> MaybeUnknown
(ConnectionState peerAddr handle handleError version m)
forall state. state -> MaybeUnknown state
Known ConnectionState peerAddr handle handleError version m
connState) in
ConnectionManagerError peerAddr
-> STM
m
(Maybe
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))))
forall (m :: * -> *) e a.
(MonadSTM m, MonadThrow (STM m), Exception e) =>
e -> STM m a
throwSTM ((CallStack -> ConnectionManagerError peerAddr)
-> ConnectionManagerError peerAddr
forall a. (?callStack::CallStack) => (CallStack -> a) -> a
withCallStack (peerAddr
-> AbstractState -> CallStack -> ConnectionManagerError peerAddr
forall peerAddr.
peerAddr
-> AbstractState -> CallStack -> ConnectionManagerError peerAddr
ForbiddenOperation peerAddr
peerAddr AbstractState
st))
traverse_ (traceWith trTracer . TransitionTrace peerAddr)
mbTransition
traceCounters stateVar
return $ case mbTransition of
Just Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))
_ -> ConnectionId peerAddr
-> DataFlow -> handle -> Connected peerAddr handle handleError
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 -> ConnectionId peerAddr
-> Maybe handleError -> Connected peerAddr handle handleError
forall peerAddr handle handleError.
ConnectionId peerAddr
-> Maybe handleError -> Connected peerAddr handle handleError
Disconnected ConnectionId peerAddr
connId Maybe handleError
forall a. Maybe a
Nothing
Right (There ConnectionId peerAddr
connId) -> do
(etr, connected) <- STM
m
(Either
(TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m))
(Trace peerAddr handlerTrace),
Connected peerAddr handle handleError)
-> m (Either
(TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m))
(Trace peerAddr handlerTrace),
Connected peerAddr handle handleError)
forall a. (?callStack::CallStack) => STM m a -> m a
forall (m :: * -> *) a.
(MonadSTM m, ?callStack::CallStack) =>
STM m a -> m a
atomically (STM
m
(Either
(TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m))
(Trace peerAddr handlerTrace),
Connected peerAddr handle handleError)
-> m (Either
(TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m))
(Trace peerAddr handlerTrace),
Connected peerAddr handle handleError))
-> STM
m
(Either
(TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m))
(Trace peerAddr handlerTrace),
Connected peerAddr handle handleError)
-> m (Either
(TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m))
(Trace peerAddr handlerTrace),
Connected peerAddr handle handleError)
forall a b. (a -> b) -> a -> b
$ do
connState <- StrictTVar
m (ConnectionState peerAddr handle handleError version m)
-> STM m (ConnectionState peerAddr handle handleError version m)
forall (m :: * -> *) a. MonadSTM m => StrictTVar m a -> STM m a
readTVar StrictTVar
m (ConnectionState peerAddr handle handleError version m)
connVar
case connState of
ReservedOutboundState {} ->
ConnectionManagerError peerAddr
-> STM
m
(Either
(TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m))
(Trace peerAddr handlerTrace),
Connected peerAddr handle handleError)
forall (m :: * -> *) e a.
(MonadSTM m, MonadThrow (STM m), Exception e) =>
e -> STM m a
throwSTM
((CallStack -> ConnectionManagerError peerAddr)
-> ConnectionManagerError peerAddr
forall a. (?callStack::CallStack) => (CallStack -> a) -> a
withCallStack (peerAddr -> CallStack -> ConnectionManagerError peerAddr
forall peerAddr.
peerAddr -> CallStack -> ConnectionManagerError peerAddr
ImpossibleState (ConnectionId peerAddr -> peerAddr
forall addr. ConnectionId addr -> addr
remoteAddress ConnectionId peerAddr
connId)))
UnnegotiatedState Provenance
Outbound ConnectionId peerAddr
_ Async m ()
_ ->
ConnectionManagerError (ConnectionId peerAddr)
-> STM
m
(Either
(TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m))
(Trace peerAddr handlerTrace),
Connected peerAddr handle handleError)
forall (m :: * -> *) e a.
(MonadSTM m, MonadThrow (STM m), Exception e) =>
e -> STM m a
throwSTM
((CallStack -> ConnectionManagerError (ConnectionId peerAddr))
-> ConnectionManagerError (ConnectionId peerAddr)
forall a. (?callStack::CallStack) => (CallStack -> a) -> a
withCallStack (Provenance
-> ConnectionId peerAddr
-> CallStack
-> ConnectionManagerError (ConnectionId peerAddr)
forall peerAddr.
Provenance
-> peerAddr -> CallStack -> ConnectionManagerError peerAddr
ConnectionExists Provenance
provenance ConnectionId peerAddr
connId))
UnnegotiatedState Provenance
Inbound ConnectionId peerAddr
_ Async m ()
_ ->
STM
m
(Either
(TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m))
(Trace peerAddr handlerTrace),
Connected peerAddr handle handleError)
forall a. STM m a
forall (m :: * -> *) a. MonadSTM m => STM m a
retry
OutboundUniState {} ->
ConnectionManagerError (ConnectionId peerAddr)
-> STM
m
(Either
(TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m))
(Trace peerAddr handlerTrace),
Connected peerAddr handle handleError)
forall (m :: * -> *) e a.
(MonadSTM m, MonadThrow (STM m), Exception e) =>
e -> STM m a
throwSTM ((CallStack -> ConnectionManagerError (ConnectionId peerAddr))
-> ConnectionManagerError (ConnectionId peerAddr)
forall a. (?callStack::CallStack) => (CallStack -> a) -> a
withCallStack (Provenance
-> ConnectionId peerAddr
-> CallStack
-> ConnectionManagerError (ConnectionId peerAddr)
forall peerAddr.
Provenance
-> peerAddr -> CallStack -> ConnectionManagerError peerAddr
ConnectionExists Provenance
provenance ConnectionId peerAddr
connId))
OutboundDupState {} ->
ConnectionManagerError (ConnectionId peerAddr)
-> STM
m
(Either
(TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m))
(Trace peerAddr handlerTrace),
Connected peerAddr handle handleError)
forall (m :: * -> *) e a.
(MonadSTM m, MonadThrow (STM m), Exception e) =>
e -> STM m a
throwSTM ((CallStack -> ConnectionManagerError (ConnectionId peerAddr))
-> ConnectionManagerError (ConnectionId peerAddr)
forall a. (?callStack::CallStack) => (CallStack -> a) -> a
withCallStack (Provenance
-> ConnectionId peerAddr
-> CallStack
-> ConnectionManagerError (ConnectionId peerAddr)
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 = MaybeUnknown
(ConnectionState peerAddr handle handleError version m)
-> AbstractState
forall muxMode peerAddr m a (b :: * -> *).
MaybeUnknown (ConnectionState muxMode peerAddr m a b)
-> AbstractState
abstractState (ConnectionState peerAddr handle handleError version m
-> MaybeUnknown
(ConnectionState peerAddr handle handleError version m)
forall state. state -> MaybeUnknown state
Known ConnectionState peerAddr handle handleError version m
connState) in
ConnectionManagerError peerAddr
-> STM
m
(Either
(TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m))
(Trace peerAddr handlerTrace),
Connected peerAddr handle handleError)
forall (m :: * -> *) e a.
(MonadSTM m, MonadThrow (STM m), Exception e) =>
e -> STM m a
throwSTM ((CallStack -> ConnectionManagerError peerAddr)
-> ConnectionManagerError peerAddr
forall a. (?callStack::CallStack) => (CallStack -> a) -> a
withCallStack (peerAddr
-> AbstractState -> CallStack -> ConnectionManagerError peerAddr
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
let connState' :: ConnectionState peerAddr handle handleError version m
connState' = ConnectionId peerAddr
-> Async m ()
-> handle
-> TimeoutExpired
-> ConnectionState peerAddr handle handleError version m
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
StrictTVar
m (ConnectionState peerAddr handle handleError version m)
-> ConnectionState peerAddr handle handleError version m
-> STM m ()
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'
(Either
(TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m))
(Trace peerAddr handlerTrace),
Connected peerAddr handle handleError)
-> STM
m
(Either
(TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m))
(Trace peerAddr handlerTrace),
Connected peerAddr handle handleError)
forall a. a -> STM m a
forall (m :: * -> *) a. Monad m => a -> m a
return ( TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m)
-> Either
(TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m))
(Trace peerAddr handlerTrace)
forall a b. a -> Either a b
Left (peerAddr
-> Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))
-> TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m)
forall peerAddr state.
peerAddr -> Transition' state -> TransitionTrace' peerAddr state
TransitionTrace
peerAddr
peerAddr
(ConnectionState peerAddr handle handleError version m
-> ConnectionState peerAddr handle handleError version m
-> Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))
forall state. state -> state -> Transition state
mkTransition ConnectionState peerAddr handle handleError version m
connState ConnectionState peerAddr handle handleError version m
connState'))
, ConnectionId peerAddr
-> DataFlow -> handle -> Connected peerAddr handle handleError
forall peerAddr handle handleError.
ConnectionId peerAddr
-> DataFlow -> handle -> Connected peerAddr handle handleError
Connected ConnectionId peerAddr
connId DataFlow
dataFlow handle
handle
)
InboundIdleState ConnectionId peerAddr
_connId Async m ()
_connThread handle
_handle DataFlow
Unidirectional ->
ConnectionManagerError peerAddr
-> STM
m
(Either
(TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m))
(Trace peerAddr handlerTrace),
Connected peerAddr handle handleError)
forall (m :: * -> *) e a.
(MonadSTM m, MonadThrow (STM m), Exception e) =>
e -> STM m a
throwSTM
((CallStack -> ConnectionManagerError peerAddr)
-> ConnectionManagerError peerAddr
forall a. (?callStack::CallStack) => (CallStack -> a) -> a
withCallStack (ConnectionId peerAddr
-> CallStack -> ConnectionManagerError peerAddr
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
let connState' :: ConnectionState peerAddr handle handleError version m
connState' = ConnectionId peerAddr
-> Async m ()
-> handle
-> ConnectionState peerAddr handle handleError version m
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
StrictTVar
m (ConnectionState peerAddr handle handleError version m)
-> ConnectionState peerAddr handle handleError version m
-> STM m ()
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'
(Either
(TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m))
(Trace peerAddr handlerTrace),
Connected peerAddr handle handleError)
-> STM
m
(Either
(TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m))
(Trace peerAddr handlerTrace),
Connected peerAddr handle handleError)
forall a. a -> STM m a
forall (m :: * -> *) a. Monad m => a -> m a
return ( TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m)
-> Either
(TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m))
(Trace peerAddr handlerTrace)
forall a b. a -> Either a b
Left (peerAddr
-> Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))
-> TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m)
forall peerAddr state.
peerAddr -> Transition' state -> TransitionTrace' peerAddr state
TransitionTrace
peerAddr
peerAddr
(ConnectionState peerAddr handle handleError version m
-> ConnectionState peerAddr handle handleError version m
-> Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))
forall state. state -> state -> Transition state
mkTransition ConnectionState peerAddr handle handleError version m
connState ConnectionState peerAddr handle handleError version m
connState'))
, ConnectionId peerAddr
-> DataFlow -> handle -> Connected peerAddr handle handleError
forall peerAddr handle handleError.
ConnectionId peerAddr
-> DataFlow -> handle -> Connected peerAddr handle handleError
Connected ConnectionId peerAddr
connId DataFlow
dataFlow handle
handle
)
InboundState ConnectionId peerAddr
_ Async m ()
_ handle
_ DataFlow
Unidirectional ->
ConnectionManagerError peerAddr
-> STM
m
(Either
(TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m))
(Trace peerAddr handlerTrace),
Connected peerAddr handle handleError)
forall (m :: * -> *) e a.
(MonadSTM m, MonadThrow (STM m), Exception e) =>
e -> STM m a
throwSTM ((CallStack -> ConnectionManagerError peerAddr)
-> ConnectionManagerError peerAddr
forall a. (?callStack::CallStack) => (CallStack -> a) -> a
withCallStack (ConnectionId peerAddr
-> CallStack -> ConnectionManagerError peerAddr
forall peerAddr.
ConnectionId peerAddr
-> CallStack -> ConnectionManagerError peerAddr
ForbiddenConnection ConnectionId peerAddr
connId))
DuplexState {} ->
ConnectionManagerError (ConnectionId peerAddr)
-> STM
m
(Either
(TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m))
(Trace peerAddr handlerTrace),
Connected peerAddr handle handleError)
forall (m :: * -> *) e a.
(MonadSTM m, MonadThrow (STM m), Exception e) =>
e -> STM m a
throwSTM ((CallStack -> ConnectionManagerError (ConnectionId peerAddr))
-> ConnectionManagerError (ConnectionId peerAddr)
forall a. (?callStack::CallStack) => (CallStack -> a) -> a
withCallStack (Provenance
-> ConnectionId peerAddr
-> CallStack
-> ConnectionManagerError (ConnectionId peerAddr)
forall peerAddr.
Provenance
-> peerAddr -> CallStack -> ConnectionManagerError peerAddr
ConnectionExists Provenance
provenance ConnectionId peerAddr
connId))
TerminatingState ConnectionId peerAddr
_connId Async m ()
_connThread Maybe handleError
handleError ->
(Either
(TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m))
(Trace peerAddr handlerTrace),
Connected peerAddr handle handleError)
-> STM
m
(Either
(TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m))
(Trace peerAddr handlerTrace),
Connected peerAddr handle handleError)
forall a. a -> STM m a
forall (m :: * -> *) a. Monad m => a -> m a
return ( Trace peerAddr handlerTrace
-> Either
(TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m))
(Trace peerAddr handlerTrace)
forall a b. b -> Either a b
Right (Provenance -> ConnectionId peerAddr -> Trace peerAddr handlerTrace
forall peerAddr handlerTrace.
Provenance -> ConnectionId peerAddr -> Trace peerAddr handlerTrace
TrTerminatingConnection Provenance
provenance ConnectionId peerAddr
connId)
, ConnectionId peerAddr
-> Maybe handleError -> Connected peerAddr handle handleError
forall peerAddr handle handleError.
ConnectionId peerAddr
-> Maybe handleError -> Connected peerAddr handle handleError
Disconnected ConnectionId peerAddr
connId Maybe handleError
handleError
)
TerminatedState Maybe handleError
handleError ->
(Either
(TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m))
(Trace peerAddr handlerTrace),
Connected peerAddr handle handleError)
-> STM
m
(Either
(TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m))
(Trace peerAddr handlerTrace),
Connected peerAddr handle handleError)
forall a. a -> STM m a
forall (m :: * -> *) a. Monad m => a -> m a
return ( Trace peerAddr handlerTrace
-> Either
(TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m))
(Trace peerAddr handlerTrace)
forall a b. b -> Either a b
Right (Provenance -> peerAddr -> Trace peerAddr handlerTrace
forall peerAddr handlerTrace.
Provenance -> peerAddr -> Trace peerAddr handlerTrace
TrTerminatedConnection Provenance
provenance
(ConnectionId peerAddr -> peerAddr
forall addr. ConnectionId addr -> addr
remoteAddress ConnectionId peerAddr
connId))
, ConnectionId peerAddr
-> Maybe handleError -> Connected peerAddr handle handleError
forall peerAddr handle handleError.
ConnectionId peerAddr
-> Maybe handleError -> Connected peerAddr handle handleError
Disconnected ConnectionId peerAddr
connId Maybe handleError
handleError
)
case etr of
Left TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m)
tr' -> Tracer
m
(TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m))
-> TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m)
-> m ()
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)
tr'
Right Trace peerAddr handlerTrace
tr' -> Tracer m (Trace peerAddr handlerTrace)
-> Trace peerAddr handlerTrace -> m ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer m (Trace peerAddr handlerTrace)
tracer Trace peerAddr handlerTrace
tr'
traceCounters stateVar
return connected
Right (Here Connected peerAddr handle handleError
connected) -> do
StrictTMVar
m (ConnectionManagerState peerAddr handle handleError version m)
-> m ()
traceCounters StrictTMVar
m (ConnectionManagerState peerAddr handle handleError version m)
stateVar
Connected peerAddr handle handleError
-> m (Connected peerAddr handle handleError)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Connected peerAddr handle handleError
connected
terminateOutboundWithErrorOrQuery
:: 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
-> 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 Maybe handleError
handleErrorM = do
transitions <- STM
m
[Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))]
-> m [Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))]
forall a. (?callStack::CallStack) => STM m a -> m a
forall (m :: * -> *) a.
(MonadSTM m, ?callStack::CallStack) =>
STM m a -> m a
atomically (STM
m
[Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))]
-> m [Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))])
-> STM
m
[Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))]
-> m [Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))]
forall a b. (a -> b) -> a -> b
$ do
connState <- StrictTVar
m (ConnectionState peerAddr handle handleError version m)
-> STM m (ConnectionState peerAddr handle handleError version m)
forall (m :: * -> *) a. MonadSTM m => StrictTVar m a -> STM m a
readTVar StrictTVar
m (ConnectionState peerAddr handle handleError version m)
connVar
let connState' =
case handleError -> HandleErrorType
classifyHandleError (handleError -> HandleErrorType)
-> Maybe handleError -> Maybe HandleErrorType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe handleError
handleErrorM of
Just HandleErrorType
HandshakeFailure ->
ConnectionId peerAddr
-> Async m ()
-> Maybe handleError
-> ConnectionState peerAddr handle handleError version m
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 ->
Maybe handleError
-> ConnectionState peerAddr handle handleError version m
forall peerAddr handle handleError version (m :: * -> *).
Maybe handleError
-> ConnectionState peerAddr handle handleError version m
TerminatedState Maybe handleError
handleErrorM
Maybe HandleErrorType
Nothing ->
Maybe handleError
-> ConnectionState peerAddr handle handleError version m
forall peerAddr handle handleError version (m :: * -> *).
Maybe handleError
-> ConnectionState peerAddr handle handleError version m
TerminatedState Maybe handleError
handleErrorM
transition = ConnectionState peerAddr handle handleError version m
-> ConnectionState peerAddr handle handleError version m
-> Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))
forall state. state -> state -> Transition state
mkTransition ConnectionState peerAddr handle handleError version m
connState ConnectionState peerAddr handle handleError version m
connState'
absConnState = MaybeUnknown
(ConnectionState peerAddr handle handleError version m)
-> AbstractState
forall muxMode peerAddr m a (b :: * -> *).
MaybeUnknown (ConnectionState muxMode peerAddr m a b)
-> AbstractState
abstractState (ConnectionState peerAddr handle handleError version m
-> MaybeUnknown
(ConnectionState peerAddr handle handleError version m)
forall state. state -> MaybeUnknown state
Known ConnectionState peerAddr handle handleError version m
connState)
shouldTrace = AbstractState
absConnState AbstractState -> AbstractState -> Bool
forall a. Eq a => a -> a -> Bool
/= AbstractState
TerminatedSt
writeTVar connVar connState'
updated <-
modifyTMVarPure
stateVar
( \ConnectionManagerState peerAddr handle handleError version m
state ->
case peerAddr
-> ConnectionManagerState peerAddr handle handleError version m
-> Maybe (MutableConnState peerAddr handle handleError version m)
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
mutableConnState' ->
if MutableConnState peerAddr handle handleError version m
mutableConnState' MutableConnState peerAddr handle handleError version m
-> MutableConnState peerAddr handle handleError version m -> Bool
forall a. Eq a => a -> a -> Bool
== MutableConnState peerAddr handle handleError version m
mutableConnState
then (peerAddr
-> ConnectionManagerState peerAddr handle handleError version m
-> ConnectionManagerState peerAddr handle handleError version m
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 updated
then
return $
if shouldTrace
then [ transition
, Transition
{ fromState = Known (TerminatedState Nothing)
, toState = Unknown
}
]
else [ Transition
{ fromState = Known (TerminatedState Nothing)
, toState = Unknown
}
]
else return [ ]
traverse_ (traceWith trTracer . TransitionTrace peerAddr) transitions
traceCounters stateVar
return (Disconnected connId handleErrorM)
releaseOutboundConnectionImpl
:: StrictTMVar m
(ConnectionManagerState peerAddr handle handleError version m)
-> StrictTVar m StdGen
-> peerAddr
-> m (OperationResult AbstractState)
releaseOutboundConnectionImpl :: StrictTMVar
m (ConnectionManagerState peerAddr handle handleError version m)
-> StrictTVar m StdGen
-> peerAddr
-> m (OperationResult AbstractState)
releaseOutboundConnectionImpl StrictTMVar
m (ConnectionManagerState peerAddr handle handleError version m)
stateVar StrictTVar m StdGen
stdGenVar peerAddr
peerAddr = do
Tracer m (Trace peerAddr handlerTrace)
-> Trace peerAddr handlerTrace -> m ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer m (Trace peerAddr handlerTrace)
tracer (Provenance -> peerAddr -> Trace peerAddr handlerTrace
forall peerAddr handlerTrace.
Provenance -> peerAddr -> Trace peerAddr handlerTrace
TrReleaseConnection Provenance
Outbound peerAddr
peerAddr)
(transition, mbAssertion)
<- STM
m
(DemoteToColdLocal
peerAddr handlerTrace handle handleError version m,
Maybe (Trace peerAddr handlerTrace))
-> m (DemoteToColdLocal
peerAddr handlerTrace handle handleError version m,
Maybe (Trace peerAddr handlerTrace))
forall a. (?callStack::CallStack) => STM m a -> m a
forall (m :: * -> *) a.
(MonadSTM m, ?callStack::CallStack) =>
STM m a -> m a
atomically (STM
m
(DemoteToColdLocal
peerAddr handlerTrace handle handleError version m,
Maybe (Trace peerAddr handlerTrace))
-> m (DemoteToColdLocal
peerAddr handlerTrace handle handleError version m,
Maybe (Trace peerAddr handlerTrace)))
-> STM
m
(DemoteToColdLocal
peerAddr handlerTrace handle handleError version m,
Maybe (Trace peerAddr handlerTrace))
-> m (DemoteToColdLocal
peerAddr handlerTrace handle handleError version m,
Maybe (Trace peerAddr handlerTrace))
forall a b. (a -> b) -> a -> b
$ do
state <- StrictTMVar
m (ConnectionManagerState peerAddr handle handleError version m)
-> STM
m (ConnectionManagerState peerAddr handle handleError version m)
forall (m :: * -> *) a. MonadSTM m => StrictTMVar m a -> STM m a
readTMVar StrictTMVar
m (ConnectionManagerState peerAddr handle handleError version m)
stateVar
case Map.lookup peerAddr state of
Maybe (MutableConnState peerAddr handle handleError version m)
Nothing -> (DemoteToColdLocal
peerAddr handlerTrace handle handleError version m,
Maybe (Trace peerAddr handlerTrace))
-> STM
m
(DemoteToColdLocal
peerAddr handlerTrace handle handleError version m,
Maybe (Trace peerAddr handlerTrace))
forall a. a -> STM m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ( Maybe
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m)))
-> AbstractState
-> DemoteToColdLocal
peerAddr handlerTrace handle handleError version m
forall peerAddr handlerTrace handle handleError version
(m :: * -> *).
Maybe
(Transition
(ConnectionState peerAddr handle handleError version m))
-> AbstractState
-> DemoteToColdLocal
peerAddr handlerTrace handle handleError version m
DemoteToColdLocalNoop Maybe
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m)))
forall a. Maybe a
Nothing AbstractState
UnknownConnectionSt
, Maybe (Trace peerAddr handlerTrace)
forall a. Maybe a
Nothing)
Just MutableConnState { 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 :: StrictTVar
m (ConnectionState peerAddr handle handleError version m)
connVar } -> do
connState <- StrictTVar
m (ConnectionState peerAddr handle handleError version m)
-> STM m (ConnectionState peerAddr handle handleError version m)
forall (m :: * -> *) a. MonadSTM m => StrictTVar m a -> STM m a
readTVar StrictTVar
m (ConnectionState peerAddr handle handleError version m)
connVar
let st = MaybeUnknown
(ConnectionState peerAddr handle handleError version m)
-> AbstractState
forall muxMode peerAddr m a (b :: * -> *).
MaybeUnknown (ConnectionState muxMode peerAddr m a b)
-> AbstractState
abstractState (ConnectionState peerAddr handle handleError version m
-> MaybeUnknown
(ConnectionState peerAddr handle handleError version m)
forall state. state -> MaybeUnknown state
Known ConnectionState peerAddr handle handleError version m
connState)
case connState of
ConnectionState peerAddr handle handleError version m
ReservedOutboundState ->
(DemoteToColdLocal
peerAddr handlerTrace handle handleError version m,
Maybe (Trace peerAddr handlerTrace))
-> STM
m
(DemoteToColdLocal
peerAddr handlerTrace handle handleError version m,
Maybe (Trace peerAddr handlerTrace))
forall a. a -> STM m a
forall (m :: * -> *) a. Monad m => a -> m a
return
( Trace peerAddr handlerTrace
-> AbstractState
-> DemoteToColdLocal
peerAddr handlerTrace handle handleError version m
forall peerAddr handlerTrace handle handleError version
(m :: * -> *).
Trace peerAddr handlerTrace
-> AbstractState
-> DemoteToColdLocal
peerAddr handlerTrace handle handleError version m
DemoteToColdLocalError
(peerAddr -> AbstractState -> Trace peerAddr handlerTrace
forall peerAddr handlerTrace.
peerAddr -> AbstractState -> Trace peerAddr handlerTrace
TrForbiddenOperation peerAddr
peerAddr AbstractState
st)
AbstractState
st
, Maybe (Trace peerAddr handlerTrace)
forall a. Maybe a
Nothing
)
UnnegotiatedState Provenance
_ ConnectionId peerAddr
_ Async m ()
_ ->
(DemoteToColdLocal
peerAddr handlerTrace handle handleError version m,
Maybe (Trace peerAddr handlerTrace))
-> STM
m
(DemoteToColdLocal
peerAddr handlerTrace handle handleError version m,
Maybe (Trace peerAddr handlerTrace))
forall a. a -> STM m a
forall (m :: * -> *) a. Monad m => a -> m a
return
( Trace peerAddr handlerTrace
-> AbstractState
-> DemoteToColdLocal
peerAddr handlerTrace handle handleError version m
forall peerAddr handlerTrace handle handleError version
(m :: * -> *).
Trace peerAddr handlerTrace
-> AbstractState
-> DemoteToColdLocal
peerAddr handlerTrace handle handleError version m
DemoteToColdLocalError
(peerAddr -> AbstractState -> Trace peerAddr handlerTrace
forall peerAddr handlerTrace.
peerAddr -> AbstractState -> Trace peerAddr handlerTrace
TrForbiddenOperation peerAddr
peerAddr AbstractState
st)
AbstractState
st
, Maybe (Trace peerAddr handlerTrace)
forall a. Maybe a
Nothing
)
OutboundUniState ConnectionId peerAddr
connId Async m ()
connThread handle
handle -> do
let connState' :: ConnectionState peerAddr handle handleError version m
connState' = ConnectionId peerAddr
-> Async m ()
-> handle
-> DataFlow
-> ConnectionState peerAddr handle handleError version m
forall peerAddr handle handleError version (m :: * -> *).
ConnectionId peerAddr
-> Async m ()
-> handle
-> DataFlow
-> ConnectionState peerAddr handle handleError version m
OutboundIdleState ConnectionId peerAddr
connId Async m ()
connThread handle
handle
DataFlow
Unidirectional
StrictTVar
m (ConnectionState peerAddr handle handleError version m)
-> ConnectionState peerAddr handle handleError version m
-> STM m ()
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'
(DemoteToColdLocal
peerAddr handlerTrace handle handleError version m,
Maybe (Trace peerAddr handlerTrace))
-> STM
m
(DemoteToColdLocal
peerAddr handlerTrace handle handleError version m,
Maybe (Trace peerAddr handlerTrace))
forall a. a -> STM m a
forall (m :: * -> *) a. Monad m => a -> m a
return ( ConnectionId peerAddr
-> Async m ()
-> StrictTVar
m (ConnectionState peerAddr handle handleError version m)
-> Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))
-> DemoteToColdLocal
peerAddr handlerTrace handle handleError version m
forall peerAddr handlerTrace handle handleError version
(m :: * -> *).
ConnectionId peerAddr
-> Async m ()
-> StrictTVar
m (ConnectionState peerAddr handle handleError version m)
-> Transition
(ConnectionState peerAddr handle handleError version m)
-> DemoteToColdLocal
peerAddr handlerTrace handle handleError version m
DemotedToColdLocal ConnectionId peerAddr
connId Async m ()
connThread StrictTVar
m (ConnectionState peerAddr handle handleError version m)
connVar
(ConnectionState peerAddr handle handleError version m
-> ConnectionState peerAddr handle handleError version m
-> Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))
forall state. state -> state -> Transition state
mkTransition ConnectionState peerAddr handle handleError version m
connState ConnectionState peerAddr handle handleError version m
connState')
, Maybe (Trace peerAddr handlerTrace)
forall a. Maybe a
Nothing
)
OutboundDupState ConnectionId peerAddr
connId Async m ()
connThread handle
handle TimeoutExpired
Expired -> do
let connState' :: ConnectionState peerAddr handle handleError version m
connState' = ConnectionId peerAddr
-> Async m ()
-> handle
-> DataFlow
-> ConnectionState peerAddr handle handleError version m
forall peerAddr handle handleError version (m :: * -> *).
ConnectionId peerAddr
-> Async m ()
-> handle
-> DataFlow
-> ConnectionState peerAddr handle handleError version m
OutboundIdleState ConnectionId peerAddr
connId Async m ()
connThread handle
handle
DataFlow
Duplex
StrictTVar
m (ConnectionState peerAddr handle handleError version m)
-> ConnectionState peerAddr handle handleError version m
-> STM m ()
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'
(DemoteToColdLocal
peerAddr handlerTrace handle handleError version m,
Maybe (Trace peerAddr handlerTrace))
-> STM
m
(DemoteToColdLocal
peerAddr handlerTrace handle handleError version m,
Maybe (Trace peerAddr handlerTrace))
forall a. a -> STM m a
forall (m :: * -> *) a. Monad m => a -> m a
return ( ConnectionId peerAddr
-> Async m ()
-> StrictTVar
m (ConnectionState peerAddr handle handleError version m)
-> Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))
-> DemoteToColdLocal
peerAddr handlerTrace handle handleError version m
forall peerAddr handlerTrace handle handleError version
(m :: * -> *).
ConnectionId peerAddr
-> Async m ()
-> StrictTVar
m (ConnectionState peerAddr handle handleError version m)
-> Transition
(ConnectionState peerAddr handle handleError version m)
-> DemoteToColdLocal
peerAddr handlerTrace handle handleError version m
DemotedToColdLocal ConnectionId peerAddr
connId Async m ()
connThread StrictTVar
m (ConnectionState peerAddr handle handleError version m)
connVar
(ConnectionState peerAddr handle handleError version m
-> ConnectionState peerAddr handle handleError version m
-> Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))
forall state. state -> state -> Transition state
mkTransition ConnectionState peerAddr handle handleError version m
connState ConnectionState peerAddr handle handleError version m
connState')
, Maybe (Trace peerAddr handlerTrace)
forall a. Maybe a
Nothing
)
OutboundDupState ConnectionId peerAddr
connId Async m ()
connThread handle
handle TimeoutExpired
Ticking -> do
let connState' :: ConnectionState peerAddr handle handleError version m
connState' = ConnectionId peerAddr
-> Async m ()
-> handle
-> DataFlow
-> ConnectionState peerAddr handle handleError version m
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
Duplex
tr :: Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))
tr = ConnectionState peerAddr handle handleError version m
-> ConnectionState peerAddr handle handleError version m
-> Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))
forall state. state -> state -> Transition state
mkTransition ConnectionState peerAddr handle handleError version m
connState ConnectionState peerAddr handle handleError version m
connState'
numberOfConns <- ConnectionManagerState peerAddr handle handleError version m
-> STM m Int
countIncomingConnections ConnectionManagerState peerAddr handle handleError version m
state
let numberToPrune =
Int
numberOfConns Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
Int -> Int -> Int
forall a. Num a => a -> a -> a
- Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral
(AcceptedConnectionsLimit -> Word32
acceptedConnectionsHardLimit AcceptedConnectionsLimit
connectionsLimits)
if numberToPrune > 0
then do
(_, prune)
<- mkPruneAction peerAddr numberToPrune state connState' connVar stdGenVar connThread
return
( PruneConnections prune (Left connState)
, Nothing
)
else do
writeTVar connVar connState'
return ( DemoteToColdLocalNoop (Just tr) st
, Nothing
)
OutboundIdleState ConnectionId peerAddr
_connId Async m ()
_connThread handle
_handleError DataFlow
_dataFlow ->
(DemoteToColdLocal
peerAddr handlerTrace handle handleError version m,
Maybe (Trace peerAddr handlerTrace))
-> STM
m
(DemoteToColdLocal
peerAddr handlerTrace handle handleError version m,
Maybe (Trace peerAddr handlerTrace))
forall a. a -> STM m a
forall (m :: * -> *) a. Monad m => a -> m a
return ( Maybe
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m)))
-> AbstractState
-> DemoteToColdLocal
peerAddr handlerTrace handle handleError version m
forall peerAddr handlerTrace handle handleError version
(m :: * -> *).
Maybe
(Transition
(ConnectionState peerAddr handle handleError version m))
-> AbstractState
-> DemoteToColdLocal
peerAddr handlerTrace handle handleError version m
DemoteToColdLocalNoop Maybe
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m)))
forall a. Maybe a
Nothing AbstractState
st
, Maybe (Trace peerAddr handlerTrace)
forall a. Maybe a
Nothing
)
InboundIdleState ConnectionId peerAddr
_connId Async m ()
_connThread handle
_handle DataFlow
_dataFlow ->
(DemoteToColdLocal
peerAddr handlerTrace handle handleError version m,
Maybe (Trace peerAddr handlerTrace))
-> STM
m
(DemoteToColdLocal
peerAddr handlerTrace handle handleError version m,
Maybe (Trace peerAddr handlerTrace))
forall a. a -> STM m a
forall (m :: * -> *) a. Monad m => a -> m a
return ( Maybe
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m)))
-> AbstractState
-> DemoteToColdLocal
peerAddr handlerTrace handle handleError version m
forall peerAddr handlerTrace handle handleError version
(m :: * -> *).
Maybe
(Transition
(ConnectionState peerAddr handle handleError version m))
-> AbstractState
-> DemoteToColdLocal
peerAddr handlerTrace handle handleError version m
DemoteToColdLocalNoop Maybe
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m)))
forall a. Maybe a
Nothing AbstractState
st
, Maybe (Trace peerAddr handlerTrace)
forall a. Maybe a
Nothing
)
InboundState ConnectionId peerAddr
connId Async m ()
_connThread handle
_handle DataFlow
dataFlow -> do
let mbAssertion :: Maybe (Trace peerAddr handlerTrace)
mbAssertion =
if DataFlow
dataFlow DataFlow -> DataFlow -> Bool
forall a. Eq a => a -> a -> Bool
== DataFlow
Duplex
then Maybe (Trace peerAddr handlerTrace)
forall a. Maybe a
Nothing
else Trace peerAddr handlerTrace -> Maybe (Trace peerAddr handlerTrace)
forall a. a -> Maybe a
Just (AssertionLocation peerAddr -> Trace peerAddr handlerTrace
forall peerAddr handlerTrace.
AssertionLocation peerAddr -> Trace peerAddr handlerTrace
TrUnexpectedlyFalseAssertion
(Maybe (ConnectionId peerAddr)
-> AbstractState -> AssertionLocation peerAddr
forall peerAddr.
Maybe (ConnectionId peerAddr)
-> AbstractState -> AssertionLocation peerAddr
ReleaseOutboundConnection
(ConnectionId peerAddr -> Maybe (ConnectionId peerAddr)
forall a. a -> Maybe a
Just ConnectionId peerAddr
connId)
AbstractState
st)
)
(DemoteToColdLocal
peerAddr handlerTrace handle handleError version m,
Maybe (Trace peerAddr handlerTrace))
-> STM
m
(DemoteToColdLocal
peerAddr handlerTrace handle handleError version m,
Maybe (Trace peerAddr handlerTrace))
forall a. a -> STM m a
forall (m :: * -> *) a. Monad m => a -> m a
return
( Trace peerAddr handlerTrace
-> AbstractState
-> DemoteToColdLocal
peerAddr handlerTrace handle handleError version m
forall peerAddr handlerTrace handle handleError version
(m :: * -> *).
Trace peerAddr handlerTrace
-> AbstractState
-> DemoteToColdLocal
peerAddr handlerTrace handle handleError version m
DemoteToColdLocalError
(peerAddr -> AbstractState -> Trace peerAddr handlerTrace
forall peerAddr handlerTrace.
peerAddr -> AbstractState -> Trace peerAddr handlerTrace
TrForbiddenOperation peerAddr
peerAddr AbstractState
st)
AbstractState
st
, Maybe (Trace peerAddr handlerTrace)
mbAssertion
)
DuplexState ConnectionId peerAddr
connId Async m ()
connThread handle
handle -> do
let connState' :: ConnectionState peerAddr handle handleError version m
connState' = ConnectionId peerAddr
-> Async m ()
-> handle
-> DataFlow
-> ConnectionState peerAddr handle handleError version m
forall peerAddr handle handleError version (m :: * -> *).
ConnectionId peerAddr
-> Async m ()
-> handle
-> DataFlow
-> ConnectionState peerAddr handle handleError version m
InboundState ConnectionId peerAddr
connId Async m ()
connThread handle
handle DataFlow
Duplex
tr :: Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))
tr = ConnectionState peerAddr handle handleError version m
-> ConnectionState peerAddr handle handleError version m
-> Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))
forall state. state -> state -> Transition state
mkTransition ConnectionState peerAddr handle handleError version m
connState ConnectionState peerAddr handle handleError version m
connState'
StrictTVar
m (ConnectionState peerAddr handle handleError version m)
-> ConnectionState peerAddr handle handleError version m
-> STM m ()
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'
(DemoteToColdLocal
peerAddr handlerTrace handle handleError version m,
Maybe (Trace peerAddr handlerTrace))
-> STM
m
(DemoteToColdLocal
peerAddr handlerTrace handle handleError version m,
Maybe (Trace peerAddr handlerTrace))
forall a. a -> STM m a
forall (m :: * -> *) a. Monad m => a -> m a
return ( Maybe
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m)))
-> AbstractState
-> DemoteToColdLocal
peerAddr handlerTrace handle handleError version m
forall peerAddr handlerTrace handle handleError version
(m :: * -> *).
Maybe
(Transition
(ConnectionState peerAddr handle handleError version m))
-> AbstractState
-> DemoteToColdLocal
peerAddr handlerTrace handle handleError version m
DemoteToColdLocalNoop (Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))
-> Maybe
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m)))
forall a. a -> Maybe a
Just Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))
tr) AbstractState
st
, Maybe (Trace peerAddr handlerTrace)
forall a. Maybe a
Nothing
)
TerminatingState ConnectionId peerAddr
_connId Async m ()
_connThread Maybe handleError
_handleError ->
(DemoteToColdLocal
peerAddr handlerTrace handle handleError version m,
Maybe (Trace peerAddr handlerTrace))
-> STM
m
(DemoteToColdLocal
peerAddr handlerTrace handle handleError version m,
Maybe (Trace peerAddr handlerTrace))
forall a. a -> STM m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m)))
-> AbstractState
-> DemoteToColdLocal
peerAddr handlerTrace handle handleError version m
forall peerAddr handlerTrace handle handleError version
(m :: * -> *).
Maybe
(Transition
(ConnectionState peerAddr handle handleError version m))
-> AbstractState
-> DemoteToColdLocal
peerAddr handlerTrace handle handleError version m
DemoteToColdLocalNoop Maybe
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m)))
forall a. Maybe a
Nothing AbstractState
st
, Maybe (Trace peerAddr handlerTrace)
forall a. Maybe a
Nothing
)
TerminatedState Maybe handleError
_handleError ->
(DemoteToColdLocal
peerAddr handlerTrace handle handleError version m,
Maybe (Trace peerAddr handlerTrace))
-> STM
m
(DemoteToColdLocal
peerAddr handlerTrace handle handleError version m,
Maybe (Trace peerAddr handlerTrace))
forall a. a -> STM m a
forall (m :: * -> *) a. Monad m => a -> m a
return ( Maybe
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m)))
-> AbstractState
-> DemoteToColdLocal
peerAddr handlerTrace handle handleError version m
forall peerAddr handlerTrace handle handleError version
(m :: * -> *).
Maybe
(Transition
(ConnectionState peerAddr handle handleError version m))
-> AbstractState
-> DemoteToColdLocal
peerAddr handlerTrace handle handleError version m
DemoteToColdLocalNoop Maybe
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m)))
forall a. Maybe a
Nothing AbstractState
st
, Maybe (Trace peerAddr handlerTrace)
forall a. Maybe a
Nothing
)
whenJust mbAssertion $ \Trace peerAddr handlerTrace
tr' -> do
Tracer m (Trace peerAddr handlerTrace)
-> Trace peerAddr handlerTrace -> m ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer m (Trace peerAddr handlerTrace)
tracer Trace peerAddr handlerTrace
tr'
_ <- (Any -> Any) -> m (Any -> Any)
forall a. a -> m a
forall (m :: * -> *) a. MonadEvaluate m => a -> m a
evaluate (Bool -> Any -> Any
forall a. (?callStack::CallStack) => Bool -> a -> a
assert Bool
False)
pure ()
case transition of
DemotedToColdLocal ConnectionId peerAddr
connId Async m ()
connThread StrictTVar
m (ConnectionState peerAddr handle handleError version m)
connVar Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))
tr -> do
Tracer
m
(TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m))
-> TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m)
-> m ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer
m
(TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m))
trTracer (peerAddr
-> Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))
-> TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m)
forall peerAddr state.
peerAddr -> Transition' state -> TransitionTrace' peerAddr state
TransitionTrace peerAddr
peerAddr Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))
tr)
StrictTMVar
m (ConnectionManagerState peerAddr handle handleError version m)
-> m ()
traceCounters StrictTMVar
m (ConnectionManagerState peerAddr handle handleError version m)
stateVar
timeoutVar <- DiffTime -> m (TVar m Bool)
forall (m :: * -> *). MonadTimer m => DiffTime -> m (TVar m Bool)
registerDelay DiffTime
outboundIdleTimeout
r <- atomically $ runFirstToFinish $
FirstToFinish (do connState <- readTVar connVar
check (case connState of
OutboundIdleState {} -> Bool
False
ConnectionState peerAddr handle handleError version m
_ -> Bool
True
)
return (Left connState)
)
<> FirstToFinish (do b <- LazySTM.readTVar timeoutVar
check b
Right <$> readTVar connVar
)
case r of
Right ConnectionState peerAddr handle handleError version m
connState -> do
let connState' :: ConnectionState peerAddr handle handleError version m
connState' = ConnectionId peerAddr
-> Async m ()
-> Maybe handleError
-> ConnectionState peerAddr handle handleError version m
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
forall a. Maybe a
Nothing
STM m () -> m ()
forall a. (?callStack::CallStack) => STM m a -> m a
forall (m :: * -> *) a.
(MonadSTM m, ?callStack::CallStack) =>
STM m a -> m a
atomically (STM m () -> m ()) -> STM m () -> m ()
forall a b. (a -> b) -> a -> b
$ StrictTVar
m (ConnectionState peerAddr handle handleError version m)
-> ConnectionState peerAddr handle handleError version m
-> STM m ()
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'
Tracer
m
(TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m))
-> TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m)
-> m ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer
m
(TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m))
trTracer (peerAddr
-> Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))
-> TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m)
forall peerAddr state.
peerAddr -> Transition' state -> TransitionTrace' peerAddr state
TransitionTrace peerAddr
peerAddr
(ConnectionState peerAddr handle handleError version m
-> ConnectionState peerAddr handle handleError version m
-> Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))
forall state. state -> state -> Transition state
mkTransition ConnectionState peerAddr handle handleError version m
connState ConnectionState peerAddr handle handleError version m
connState'))
StrictTMVar
m (ConnectionManagerState peerAddr handle handleError version m)
-> m ()
traceCounters StrictTMVar
m (ConnectionManagerState peerAddr handle handleError version m)
stateVar
ThreadId m -> AsyncCancelled -> m ()
forall e. Exception e => ThreadId m -> e -> m ()
forall (m :: * -> *) e.
(MonadFork m, Exception e) =>
ThreadId m -> e -> m ()
throwTo (Async m () -> ThreadId m
forall a. Async m a -> ThreadId m
forall (m :: * -> *) a. MonadAsync m => Async m a -> ThreadId m
asyncThreadId Async m ()
connThread)
AsyncCancelled
AsyncCancelled
OperationResult AbstractState -> m (OperationResult AbstractState)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (AbstractState -> OperationResult AbstractState
forall a. a -> OperationResult a
OperationSuccess (MaybeUnknown
(ConnectionState peerAddr handle handleError version m)
-> AbstractState
forall muxMode peerAddr m a (b :: * -> *).
MaybeUnknown (ConnectionState muxMode peerAddr m a b)
-> AbstractState
abstractState (MaybeUnknown
(ConnectionState peerAddr handle handleError version m)
-> AbstractState)
-> MaybeUnknown
(ConnectionState peerAddr handle handleError version m)
-> AbstractState
forall a b. (a -> b) -> a -> b
$ ConnectionState peerAddr handle handleError version m
-> MaybeUnknown
(ConnectionState peerAddr handle handleError version m)
forall state. state -> MaybeUnknown state
Known ConnectionState peerAddr handle handleError version m
connState'))
Left ConnectionState peerAddr handle handleError version m
connState | ConnectionState peerAddr handle handleError version m -> Bool
forall peerAddr handle handleError version (m :: * -> *).
ConnectionState peerAddr handle handleError version m -> Bool
connectionTerminated ConnectionState peerAddr handle handleError version m
connState
->
OperationResult AbstractState -> m (OperationResult AbstractState)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (AbstractState -> OperationResult AbstractState
forall a. a -> OperationResult a
OperationSuccess (MaybeUnknown
(ConnectionState peerAddr handle handleError version m)
-> AbstractState
forall muxMode peerAddr m a (b :: * -> *).
MaybeUnknown (ConnectionState muxMode peerAddr m a b)
-> AbstractState
abstractState (MaybeUnknown
(ConnectionState peerAddr handle handleError version m)
-> AbstractState)
-> MaybeUnknown
(ConnectionState peerAddr handle handleError version m)
-> AbstractState
forall a b. (a -> b) -> a -> b
$ ConnectionState peerAddr handle handleError version m
-> MaybeUnknown
(ConnectionState peerAddr handle handleError version m)
forall state. state -> MaybeUnknown state
Known ConnectionState peerAddr handle handleError version m
connState))
Left ConnectionState peerAddr handle handleError version m
connState ->
OperationResult AbstractState -> m (OperationResult AbstractState)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (AbstractState -> OperationResult AbstractState
forall a. AbstractState -> OperationResult a
UnsupportedState (MaybeUnknown
(ConnectionState peerAddr handle handleError version m)
-> AbstractState
forall muxMode peerAddr m a (b :: * -> *).
MaybeUnknown (ConnectionState muxMode peerAddr m a b)
-> AbstractState
abstractState (MaybeUnknown
(ConnectionState peerAddr handle handleError version m)
-> AbstractState)
-> MaybeUnknown
(ConnectionState peerAddr handle handleError version m)
-> AbstractState
forall a b. (a -> b) -> a -> b
$ ConnectionState peerAddr handle handleError version m
-> MaybeUnknown
(ConnectionState peerAddr handle handleError version m)
forall state. state -> MaybeUnknown state
Known ConnectionState peerAddr handle handleError version m
connState))
PruneConnections PruneAction m
prune Either
(ConnectionState peerAddr handle handleError version m)
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m)))
eTr -> do
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))
-> m ())
-> Either
(ConnectionState peerAddr handle handleError version m)
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m)))
-> m ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (Tracer
m
(TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m))
-> TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m)
-> m ()
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)
-> m ())
-> (Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))
-> TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m))
-> Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))
-> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. peerAddr
-> Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))
-> TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m)
forall peerAddr state.
peerAddr -> Transition' state -> TransitionTrace' peerAddr state
TransitionTrace peerAddr
peerAddr) Either
(ConnectionState peerAddr handle handleError version m)
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m)))
eTr
PruneAction m -> m ()
forall (m :: * -> *). PruneAction m -> m ()
runPruneAction PruneAction m
prune
StrictTMVar
m (ConnectionManagerState peerAddr handle handleError version m)
-> m ()
traceCounters StrictTMVar
m (ConnectionManagerState peerAddr handle handleError version m)
stateVar
OperationResult AbstractState -> m (OperationResult AbstractState)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (AbstractState -> OperationResult AbstractState
forall a. a -> OperationResult a
OperationSuccess (MaybeUnknown
(ConnectionState peerAddr handle handleError version m)
-> AbstractState
forall muxMode peerAddr m a (b :: * -> *).
MaybeUnknown (ConnectionState muxMode peerAddr m a b)
-> AbstractState
abstractState ((ConnectionState peerAddr handle handleError version m
-> MaybeUnknown
(ConnectionState peerAddr handle handleError version m))
-> (Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))
-> MaybeUnknown
(ConnectionState peerAddr handle handleError version m))
-> Either
(ConnectionState peerAddr handle handleError version m)
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m)))
-> MaybeUnknown
(ConnectionState peerAddr handle handleError version m)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ConnectionState peerAddr handle handleError version m
-> MaybeUnknown
(ConnectionState peerAddr handle handleError version m)
forall state. state -> MaybeUnknown state
Known Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))
-> MaybeUnknown
(ConnectionState peerAddr handle handleError version m)
forall state. Transition' state -> state
fromState Either
(ConnectionState peerAddr handle handleError version m)
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m)))
eTr)))
DemoteToColdLocalError Trace peerAddr handlerTrace
trace AbstractState
st -> do
Tracer m (Trace peerAddr handlerTrace)
-> Trace peerAddr handlerTrace -> m ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer m (Trace peerAddr handlerTrace)
tracer Trace peerAddr handlerTrace
trace
OperationResult AbstractState -> m (OperationResult AbstractState)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (AbstractState -> OperationResult AbstractState
forall a. AbstractState -> OperationResult a
UnsupportedState AbstractState
st)
DemoteToColdLocalNoop Maybe
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m)))
tr AbstractState
a -> do
(TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m)
-> m ())
-> Maybe
(TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m))
-> m ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (Tracer
m
(TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m))
-> TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m)
-> m ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer
m
(TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m))
trTracer) (peerAddr
-> Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))
-> TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m)
forall peerAddr state.
peerAddr -> Transition' state -> TransitionTrace' peerAddr state
TransitionTrace peerAddr
peerAddr (Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))
-> TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m))
-> Maybe
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m)))
-> Maybe
(TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m)))
tr)
StrictTMVar
m (ConnectionManagerState peerAddr handle handleError version m)
-> m ()
traceCounters StrictTMVar
m (ConnectionManagerState peerAddr handle handleError version m)
stateVar
OperationResult AbstractState -> m (OperationResult AbstractState)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (AbstractState -> OperationResult AbstractState
forall a. a -> OperationResult a
OperationSuccess AbstractState
a)
promotedToWarmRemoteImpl
:: StrictTMVar m (ConnectionManagerState peerAddr handle handleError version m)
-> StrictTVar m StdGen
-> peerAddr
-> m (OperationResult AbstractState)
promotedToWarmRemoteImpl :: StrictTMVar
m (ConnectionManagerState peerAddr handle handleError version m)
-> StrictTVar m StdGen
-> peerAddr
-> m (OperationResult AbstractState)
promotedToWarmRemoteImpl StrictTMVar
m (ConnectionManagerState peerAddr handle handleError version m)
stateVar StrictTVar m StdGen
stdGenVar peerAddr
peerAddr = m (OperationResult AbstractState)
-> m (OperationResult AbstractState)
forall a. m a -> m a
forall (m :: * -> *) a. MonadMask m => m a -> m a
mask_ (m (OperationResult AbstractState)
-> m (OperationResult AbstractState))
-> m (OperationResult AbstractState)
-> m (OperationResult AbstractState)
forall a b. (a -> b) -> a -> b
$ do
(result, pruneTr, mbAssertion) <- STM
m
(OperationResult
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))),
Maybe (PruneAction m), Maybe (Trace peerAddr handlerTrace))
-> m (OperationResult
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))),
Maybe (PruneAction m), Maybe (Trace peerAddr handlerTrace))
forall a. (?callStack::CallStack) => STM m a -> m a
forall (m :: * -> *) a.
(MonadSTM m, ?callStack::CallStack) =>
STM m a -> m a
atomically (STM
m
(OperationResult
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))),
Maybe (PruneAction m), Maybe (Trace peerAddr handlerTrace))
-> m (OperationResult
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))),
Maybe (PruneAction m), Maybe (Trace peerAddr handlerTrace)))
-> STM
m
(OperationResult
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))),
Maybe (PruneAction m), Maybe (Trace peerAddr handlerTrace))
-> m (OperationResult
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))),
Maybe (PruneAction m), Maybe (Trace peerAddr handlerTrace))
forall a b. (a -> b) -> a -> b
$ do
state <- StrictTMVar
m (ConnectionManagerState peerAddr handle handleError version m)
-> STM
m (ConnectionManagerState peerAddr handle handleError version m)
forall (m :: * -> *) a. MonadSTM m => StrictTMVar m a -> STM m a
readTMVar StrictTMVar
m (ConnectionManagerState peerAddr handle handleError version m)
stateVar
let mbConnVar = peerAddr
-> ConnectionManagerState peerAddr handle handleError version m
-> Maybe (MutableConnState peerAddr handle handleError version m)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup peerAddr
peerAddr ConnectionManagerState peerAddr handle handleError version m
state
case mbConnVar of
Maybe (MutableConnState peerAddr handle handleError version m)
Nothing -> (OperationResult
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))),
Maybe (PruneAction m), Maybe (Trace peerAddr handlerTrace))
-> STM
m
(OperationResult
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))),
Maybe (PruneAction m), Maybe (Trace peerAddr handlerTrace))
forall a. a -> STM m a
forall (m :: * -> *) a. Monad m => a -> m a
return ( AbstractState
-> OperationResult
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m)))
forall a. AbstractState -> OperationResult a
UnsupportedState AbstractState
UnknownConnectionSt
, Maybe (PruneAction m)
forall a. Maybe a
Nothing
, Maybe (Trace peerAddr handlerTrace)
forall a. Maybe a
Nothing
)
Just MutableConnState { 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 :: StrictTVar
m (ConnectionState peerAddr handle handleError version m)
connVar } -> do
connState <- StrictTVar
m (ConnectionState peerAddr handle handleError version m)
-> STM m (ConnectionState peerAddr handle handleError version m)
forall (m :: * -> *) a. MonadSTM m => StrictTVar m a -> STM m a
readTVar StrictTVar
m (ConnectionState peerAddr handle handleError version m)
connVar
let st = MaybeUnknown
(ConnectionState peerAddr handle handleError version m)
-> AbstractState
forall muxMode peerAddr m a (b :: * -> *).
MaybeUnknown (ConnectionState muxMode peerAddr m a b)
-> AbstractState
abstractState (ConnectionState peerAddr handle handleError version m
-> MaybeUnknown
(ConnectionState peerAddr handle handleError version m)
forall state. state -> MaybeUnknown state
Known ConnectionState peerAddr handle handleError version m
connState)
case connState of
ReservedOutboundState {} -> do
(OperationResult
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))),
Maybe (PruneAction m), Maybe (Trace peerAddr handlerTrace))
-> STM
m
(OperationResult
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))),
Maybe (PruneAction m), Maybe (Trace peerAddr handlerTrace))
forall a. a -> STM m a
forall (m :: * -> *) a. Monad m => a -> m a
return ( AbstractState
-> OperationResult
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m)))
forall a. AbstractState -> OperationResult a
UnsupportedState AbstractState
st
, Maybe (PruneAction m)
forall a. Maybe a
Nothing
, Trace peerAddr handlerTrace -> Maybe (Trace peerAddr handlerTrace)
forall a. a -> Maybe a
Just (AssertionLocation peerAddr -> Trace peerAddr handlerTrace
forall peerAddr handlerTrace.
AssertionLocation peerAddr -> Trace peerAddr handlerTrace
TrUnexpectedlyFalseAssertion
(Maybe (ConnectionId peerAddr)
-> AbstractState -> AssertionLocation peerAddr
forall peerAddr.
Maybe (ConnectionId peerAddr)
-> AbstractState -> AssertionLocation peerAddr
PromotedToWarmRemote
Maybe (ConnectionId peerAddr)
forall a. Maybe a
Nothing
AbstractState
st)
)
)
UnnegotiatedState Provenance
_ ConnectionId peerAddr
connId Async m ()
_ ->
(OperationResult
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))),
Maybe (PruneAction m), Maybe (Trace peerAddr handlerTrace))
-> STM
m
(OperationResult
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))),
Maybe (PruneAction m), Maybe (Trace peerAddr handlerTrace))
forall a. a -> STM m a
forall (m :: * -> *) a. Monad m => a -> m a
return ( AbstractState
-> OperationResult
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m)))
forall a. AbstractState -> OperationResult a
UnsupportedState AbstractState
st
, Maybe (PruneAction m)
forall a. Maybe a
Nothing
, Trace peerAddr handlerTrace -> Maybe (Trace peerAddr handlerTrace)
forall a. a -> Maybe a
Just (AssertionLocation peerAddr -> Trace peerAddr handlerTrace
forall peerAddr handlerTrace.
AssertionLocation peerAddr -> Trace peerAddr handlerTrace
TrUnexpectedlyFalseAssertion
(Maybe (ConnectionId peerAddr)
-> AbstractState -> AssertionLocation peerAddr
forall peerAddr.
Maybe (ConnectionId peerAddr)
-> AbstractState -> AssertionLocation peerAddr
PromotedToWarmRemote
(ConnectionId peerAddr -> Maybe (ConnectionId peerAddr)
forall a. a -> Maybe a
Just ConnectionId peerAddr
connId)
AbstractState
st)
)
)
OutboundUniState ConnectionId peerAddr
connId Async m ()
_connThread handle
_handle ->
(OperationResult
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))),
Maybe (PruneAction m), Maybe (Trace peerAddr handlerTrace))
-> STM
m
(OperationResult
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))),
Maybe (PruneAction m), Maybe (Trace peerAddr handlerTrace))
forall a. a -> STM m a
forall (m :: * -> *) a. Monad m => a -> m a
return ( AbstractState
-> OperationResult
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m)))
forall a. AbstractState -> OperationResult a
UnsupportedState AbstractState
st
, Maybe (PruneAction m)
forall a. Maybe a
Nothing
, Trace peerAddr handlerTrace -> Maybe (Trace peerAddr handlerTrace)
forall a. a -> Maybe a
Just (AssertionLocation peerAddr -> Trace peerAddr handlerTrace
forall peerAddr handlerTrace.
AssertionLocation peerAddr -> Trace peerAddr handlerTrace
TrUnexpectedlyFalseAssertion
(Maybe (ConnectionId peerAddr)
-> AbstractState -> AssertionLocation peerAddr
forall peerAddr.
Maybe (ConnectionId peerAddr)
-> AbstractState -> AssertionLocation peerAddr
PromotedToWarmRemote
(ConnectionId peerAddr -> Maybe (ConnectionId peerAddr)
forall a. a -> Maybe a
Just ConnectionId peerAddr
connId)
AbstractState
st)
)
)
OutboundDupState ConnectionId peerAddr
connId Async m ()
connThread handle
handle TimeoutExpired
_expired -> do
let connState' :: ConnectionState peerAddr handle handleError version m
connState' = ConnectionId peerAddr
-> Async m ()
-> handle
-> ConnectionState peerAddr handle handleError version m
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
tr :: Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))
tr = ConnectionState peerAddr handle handleError version m
-> ConnectionState peerAddr handle handleError version m
-> Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))
forall state. state -> state -> Transition state
mkTransition ConnectionState peerAddr handle handleError version m
connState ConnectionState peerAddr handle handleError version m
connState'
numberOfConns <- ConnectionManagerState peerAddr handle handleError version m
-> STM m Int
countIncomingConnections ConnectionManagerState peerAddr handle handleError version m
state
let numberToPrune =
Int
numberOfConns Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
Int -> Int -> Int
forall a. Num a => a -> a -> a
- Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral
(AcceptedConnectionsLimit -> Word32
acceptedConnectionsHardLimit AcceptedConnectionsLimit
connectionsLimits)
if numberToPrune > 0
then do
(pruneSelf, prune)
<- mkPruneAction peerAddr numberToPrune state connState' connVar stdGenVar connThread
when (not pruneSelf)
$ writeTVar connVar connState'
return
( OperationSuccess tr
, Just prune
, Nothing
)
else do
writeTVar connVar connState'
return ( OperationSuccess tr
, Nothing
, Nothing
)
OutboundIdleState ConnectionId peerAddr
connId Async m ()
connThread handle
handle dataFlow :: DataFlow
dataFlow@DataFlow
Duplex -> do
let connState' :: ConnectionState peerAddr handle handleError version m
connState' = ConnectionId peerAddr
-> Async m ()
-> handle
-> DataFlow
-> ConnectionState peerAddr handle handleError version m
forall peerAddr handle handleError version (m :: * -> *).
ConnectionId peerAddr
-> Async m ()
-> handle
-> DataFlow
-> ConnectionState peerAddr handle handleError version m
InboundState ConnectionId peerAddr
connId Async m ()
connThread handle
handle DataFlow
dataFlow
tr :: Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))
tr = ConnectionState peerAddr handle handleError version m
-> ConnectionState peerAddr handle handleError version m
-> Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))
forall state. state -> state -> Transition state
mkTransition ConnectionState peerAddr handle handleError version m
connState ConnectionState peerAddr handle handleError version m
connState'
numberOfConns <- ConnectionManagerState peerAddr handle handleError version m
-> STM m Int
countIncomingConnections ConnectionManagerState peerAddr handle handleError version m
state
let numberToPrune =
Int
numberOfConns Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
Int -> Int -> Int
forall a. Num a => a -> a -> a
- Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral
(AcceptedConnectionsLimit -> Word32
acceptedConnectionsHardLimit AcceptedConnectionsLimit
connectionsLimits)
if numberToPrune > 0
then do
(pruneSelf, prune)
<- mkPruneAction peerAddr numberToPrune state connState' connVar stdGenVar connThread
when (not pruneSelf)
$ writeTVar connVar connState'
return
( OperationSuccess (mkTransition connState (TerminatedState Nothing))
, Just prune
, Nothing
)
else do
writeTVar connVar connState'
return ( OperationSuccess tr
, Nothing
, Nothing
)
OutboundIdleState ConnectionId peerAddr
_connId Async m ()
_connThread handle
_handle DataFlow
Unidirectional ->
(OperationResult
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))),
Maybe (PruneAction m), Maybe (Trace peerAddr handlerTrace))
-> STM
m
(OperationResult
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))),
Maybe (PruneAction m), Maybe (Trace peerAddr handlerTrace))
forall a. a -> STM m a
forall (m :: * -> *) a. Monad m => a -> m a
return ( AbstractState
-> OperationResult
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m)))
forall a. AbstractState -> OperationResult a
UnsupportedState AbstractState
st
, Maybe (PruneAction m)
forall a. Maybe a
Nothing
, Maybe (Trace peerAddr handlerTrace)
forall a. Maybe a
Nothing
)
InboundIdleState ConnectionId peerAddr
connId Async m ()
connThread handle
handle DataFlow
dataFlow -> do
let connState' :: ConnectionState peerAddr handle handleError version m
connState' = ConnectionId peerAddr
-> Async m ()
-> handle
-> DataFlow
-> ConnectionState peerAddr handle handleError version m
forall peerAddr handle handleError version (m :: * -> *).
ConnectionId peerAddr
-> Async m ()
-> handle
-> DataFlow
-> ConnectionState peerAddr handle handleError version m
InboundState ConnectionId peerAddr
connId Async m ()
connThread handle
handle DataFlow
dataFlow
StrictTVar
m (ConnectionState peerAddr handle handleError version m)
-> ConnectionState peerAddr handle handleError version m
-> STM m ()
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'
(OperationResult
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))),
Maybe (PruneAction m), Maybe (Trace peerAddr handlerTrace))
-> STM
m
(OperationResult
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))),
Maybe (PruneAction m), Maybe (Trace peerAddr handlerTrace))
forall a. a -> STM m a
forall (m :: * -> *) a. Monad m => a -> m a
return ( Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))
-> OperationResult
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m)))
forall a. a -> OperationResult a
OperationSuccess (ConnectionState peerAddr handle handleError version m
-> ConnectionState peerAddr handle handleError version m
-> Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))
forall state. state -> state -> Transition state
mkTransition ConnectionState peerAddr handle handleError version m
connState ConnectionState peerAddr handle handleError version m
connState')
, Maybe (PruneAction m)
forall a. Maybe a
Nothing
, Maybe (Trace peerAddr handlerTrace)
forall a. Maybe a
Nothing
)
InboundState ConnectionId peerAddr
connId Async m ()
_ handle
_ DataFlow
_ ->
(OperationResult
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))),
Maybe (PruneAction m), Maybe (Trace peerAddr handlerTrace))
-> STM
m
(OperationResult
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))),
Maybe (PruneAction m), Maybe (Trace peerAddr handlerTrace))
forall a. a -> STM m a
forall (m :: * -> *) a. Monad m => a -> m a
return ( Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))
-> OperationResult
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m)))
forall a. a -> OperationResult a
OperationSuccess (ConnectionState peerAddr handle handleError version m
-> ConnectionState peerAddr handle handleError version m
-> Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))
forall state. state -> state -> Transition state
mkTransition ConnectionState peerAddr handle handleError version m
connState ConnectionState peerAddr handle handleError version m
connState)
, Maybe (PruneAction m)
forall a. Maybe a
Nothing
, Trace peerAddr handlerTrace -> Maybe (Trace peerAddr handlerTrace)
forall a. a -> Maybe a
Just (AssertionLocation peerAddr -> Trace peerAddr handlerTrace
forall peerAddr handlerTrace.
AssertionLocation peerAddr -> Trace peerAddr handlerTrace
TrUnexpectedlyFalseAssertion
(Maybe (ConnectionId peerAddr)
-> AbstractState -> AssertionLocation peerAddr
forall peerAddr.
Maybe (ConnectionId peerAddr)
-> AbstractState -> AssertionLocation peerAddr
PromotedToWarmRemote
(ConnectionId peerAddr -> Maybe (ConnectionId peerAddr)
forall a. a -> Maybe a
Just ConnectionId peerAddr
connId)
AbstractState
st)
)
)
DuplexState {} ->
(OperationResult
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))),
Maybe (PruneAction m), Maybe (Trace peerAddr handlerTrace))
-> STM
m
(OperationResult
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))),
Maybe (PruneAction m), Maybe (Trace peerAddr handlerTrace))
forall a. a -> STM m a
forall (m :: * -> *) a. Monad m => a -> m a
return ( Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))
-> OperationResult
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m)))
forall a. a -> OperationResult a
OperationSuccess (ConnectionState peerAddr handle handleError version m
-> ConnectionState peerAddr handle handleError version m
-> Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))
forall state. state -> state -> Transition state
mkTransition ConnectionState peerAddr handle handleError version m
connState ConnectionState peerAddr handle handleError version m
connState)
, Maybe (PruneAction m)
forall a. Maybe a
Nothing
, Maybe (Trace peerAddr handlerTrace)
forall a. Maybe a
Nothing
)
TerminatingState {} ->
(OperationResult
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))),
Maybe (PruneAction m), Maybe (Trace peerAddr handlerTrace))
-> STM
m
(OperationResult
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))),
Maybe (PruneAction m), Maybe (Trace peerAddr handlerTrace))
forall a. a -> STM m a
forall (m :: * -> *) a. Monad m => a -> m a
return ( AbstractState
-> OperationResult
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m)))
forall a. AbstractState -> OperationResult a
UnsupportedState AbstractState
TerminatingSt
, Maybe (PruneAction m)
forall a. Maybe a
Nothing
, Maybe (Trace peerAddr handlerTrace)
forall a. Maybe a
Nothing
)
TerminatedState {} ->
(OperationResult
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))),
Maybe (PruneAction m), Maybe (Trace peerAddr handlerTrace))
-> STM
m
(OperationResult
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))),
Maybe (PruneAction m), Maybe (Trace peerAddr handlerTrace))
forall a. a -> STM m a
forall (m :: * -> *) a. Monad m => a -> m a
return ( AbstractState
-> OperationResult
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m)))
forall a. AbstractState -> OperationResult a
UnsupportedState AbstractState
TerminatedSt
, Maybe (PruneAction m)
forall a. Maybe a
Nothing
, Maybe (Trace peerAddr handlerTrace)
forall a. Maybe a
Nothing
)
whenJust mbAssertion $ \Trace peerAddr handlerTrace
tr' -> do
Tracer m (Trace peerAddr handlerTrace)
-> Trace peerAddr handlerTrace -> m ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer m (Trace peerAddr handlerTrace)
tracer Trace peerAddr handlerTrace
tr'
_ <- (Any -> Any) -> m (Any -> Any)
forall a. a -> m a
forall (m :: * -> *) a. MonadEvaluate m => a -> m a
evaluate (Bool -> Any -> Any
forall a. (?callStack::CallStack) => Bool -> a -> a
assert Bool
False)
pure ()
case (result, pruneTr) of
(OperationSuccess Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))
tr, Maybe (PruneAction m)
Nothing) -> do
Tracer
m
(TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m))
-> TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m)
-> m ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer
m
(TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m))
trTracer (peerAddr
-> Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))
-> TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m)
forall peerAddr state.
peerAddr -> Transition' state -> TransitionTrace' peerAddr state
TransitionTrace peerAddr
peerAddr Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))
tr)
StrictTMVar
m (ConnectionManagerState peerAddr handle handleError version m)
-> m ()
traceCounters StrictTMVar
m (ConnectionManagerState peerAddr handle handleError version m)
stateVar
(OperationSuccess Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))
tr, Just PruneAction m
prune) -> do
Tracer
m
(TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m))
-> TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m)
-> m ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer
m
(TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m))
trTracer (peerAddr
-> Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))
-> TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m)
forall peerAddr state.
peerAddr -> Transition' state -> TransitionTrace' peerAddr state
TransitionTrace peerAddr
peerAddr Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))
tr)
PruneAction m -> m ()
forall (m :: * -> *). PruneAction m -> m ()
runPruneAction PruneAction m
prune
StrictTMVar
m (ConnectionManagerState peerAddr handle handleError version m)
-> m ()
traceCounters StrictTMVar
m (ConnectionManagerState peerAddr handle handleError version m)
stateVar
(OperationResult
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))),
Maybe (PruneAction m))
_ -> () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
return (abstractState . fromState <$> result)
demotedToColdRemoteImpl
:: StrictTMVar m (ConnectionManagerState peerAddr handle handleError version m)
-> peerAddr
-> m (OperationResult AbstractState)
demotedToColdRemoteImpl :: StrictTMVar
m (ConnectionManagerState peerAddr handle handleError version m)
-> peerAddr -> m (OperationResult AbstractState)
demotedToColdRemoteImpl StrictTMVar
m (ConnectionManagerState peerAddr handle handleError version m)
stateVar peerAddr
peerAddr = do
(result, mbAssertion) <- STM
m
(OperationResult
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))),
Maybe (Trace peerAddr handlerTrace))
-> m (OperationResult
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))),
Maybe (Trace peerAddr handlerTrace))
forall a. (?callStack::CallStack) => STM m a -> m a
forall (m :: * -> *) a.
(MonadSTM m, ?callStack::CallStack) =>
STM m a -> m a
atomically (STM
m
(OperationResult
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))),
Maybe (Trace peerAddr handlerTrace))
-> m (OperationResult
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))),
Maybe (Trace peerAddr handlerTrace)))
-> STM
m
(OperationResult
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))),
Maybe (Trace peerAddr handlerTrace))
-> m (OperationResult
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))),
Maybe (Trace peerAddr handlerTrace))
forall a b. (a -> b) -> a -> b
$ do
mbConnVar <- peerAddr
-> ConnectionManagerState peerAddr handle handleError version m
-> Maybe (MutableConnState peerAddr handle handleError version m)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup peerAddr
peerAddr (ConnectionManagerState peerAddr handle handleError version m
-> Maybe (MutableConnState peerAddr handle handleError version m))
-> STM
m (ConnectionManagerState peerAddr handle handleError version m)
-> STM
m (Maybe (MutableConnState peerAddr handle handleError version m))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StrictTMVar
m (ConnectionManagerState peerAddr handle handleError version m)
-> STM
m (ConnectionManagerState peerAddr handle handleError version m)
forall (m :: * -> *) a. MonadSTM m => StrictTMVar m a -> STM m a
readTMVar StrictTMVar
m (ConnectionManagerState peerAddr handle handleError version m)
stateVar
case mbConnVar of
Maybe (MutableConnState peerAddr handle handleError version m)
Nothing -> (OperationResult
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))),
Maybe (Trace peerAddr handlerTrace))
-> STM
m
(OperationResult
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))),
Maybe (Trace peerAddr handlerTrace))
forall a. a -> STM m a
forall (m :: * -> *) a. Monad m => a -> m a
return ( AbstractState
-> OperationResult
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m)))
forall a. AbstractState -> OperationResult a
UnsupportedState AbstractState
UnknownConnectionSt
, Maybe (Trace peerAddr handlerTrace)
forall a. Maybe a
Nothing
)
Just MutableConnState { 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 :: StrictTVar
m (ConnectionState peerAddr handle handleError version m)
connVar } -> do
connState <- StrictTVar
m (ConnectionState peerAddr handle handleError version m)
-> STM m (ConnectionState peerAddr handle handleError version m)
forall (m :: * -> *) a. MonadSTM m => StrictTVar m a -> STM m a
readTVar StrictTVar
m (ConnectionState peerAddr handle handleError version m)
connVar
let st = MaybeUnknown
(ConnectionState peerAddr handle handleError version m)
-> AbstractState
forall muxMode peerAddr m a (b :: * -> *).
MaybeUnknown (ConnectionState muxMode peerAddr m a b)
-> AbstractState
abstractState (ConnectionState peerAddr handle handleError version m
-> MaybeUnknown
(ConnectionState peerAddr handle handleError version m)
forall state. state -> MaybeUnknown state
Known ConnectionState peerAddr handle handleError version m
connState)
case connState of
ReservedOutboundState {} -> do
(OperationResult
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))),
Maybe (Trace peerAddr handlerTrace))
-> STM
m
(OperationResult
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))),
Maybe (Trace peerAddr handlerTrace))
forall a. a -> STM m a
forall (m :: * -> *) a. Monad m => a -> m a
return ( AbstractState
-> OperationResult
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m)))
forall a. AbstractState -> OperationResult a
UnsupportedState AbstractState
st
, Trace peerAddr handlerTrace -> Maybe (Trace peerAddr handlerTrace)
forall a. a -> Maybe a
Just (AssertionLocation peerAddr -> Trace peerAddr handlerTrace
forall peerAddr handlerTrace.
AssertionLocation peerAddr -> Trace peerAddr handlerTrace
TrUnexpectedlyFalseAssertion
(Maybe (ConnectionId peerAddr)
-> AbstractState -> AssertionLocation peerAddr
forall peerAddr.
Maybe (ConnectionId peerAddr)
-> AbstractState -> AssertionLocation peerAddr
DemotedToColdRemote
Maybe (ConnectionId peerAddr)
forall a. Maybe a
Nothing
AbstractState
st)
)
)
UnnegotiatedState Provenance
_ ConnectionId peerAddr
connId Async m ()
_ ->
(OperationResult
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))),
Maybe (Trace peerAddr handlerTrace))
-> STM
m
(OperationResult
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))),
Maybe (Trace peerAddr handlerTrace))
forall a. a -> STM m a
forall (m :: * -> *) a. Monad m => a -> m a
return ( AbstractState
-> OperationResult
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m)))
forall a. AbstractState -> OperationResult a
UnsupportedState AbstractState
st
, Trace peerAddr handlerTrace -> Maybe (Trace peerAddr handlerTrace)
forall a. a -> Maybe a
Just (AssertionLocation peerAddr -> Trace peerAddr handlerTrace
forall peerAddr handlerTrace.
AssertionLocation peerAddr -> Trace peerAddr handlerTrace
TrUnexpectedlyFalseAssertion
(Maybe (ConnectionId peerAddr)
-> AbstractState -> AssertionLocation peerAddr
forall peerAddr.
Maybe (ConnectionId peerAddr)
-> AbstractState -> AssertionLocation peerAddr
DemotedToColdRemote
(ConnectionId peerAddr -> Maybe (ConnectionId peerAddr)
forall a. a -> Maybe a
Just ConnectionId peerAddr
connId)
AbstractState
st)
)
)
OutboundUniState ConnectionId peerAddr
connId Async m ()
_connThread handle
_handle ->
(OperationResult
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))),
Maybe (Trace peerAddr handlerTrace))
-> STM
m
(OperationResult
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))),
Maybe (Trace peerAddr handlerTrace))
forall a. a -> STM m a
forall (m :: * -> *) a. Monad m => a -> m a
return ( AbstractState
-> OperationResult
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m)))
forall a. AbstractState -> OperationResult a
UnsupportedState AbstractState
st
, Trace peerAddr handlerTrace -> Maybe (Trace peerAddr handlerTrace)
forall a. a -> Maybe a
Just (AssertionLocation peerAddr -> Trace peerAddr handlerTrace
forall peerAddr handlerTrace.
AssertionLocation peerAddr -> Trace peerAddr handlerTrace
TrUnexpectedlyFalseAssertion
(Maybe (ConnectionId peerAddr)
-> AbstractState -> AssertionLocation peerAddr
forall peerAddr.
Maybe (ConnectionId peerAddr)
-> AbstractState -> AssertionLocation peerAddr
DemotedToColdRemote
(ConnectionId peerAddr -> Maybe (ConnectionId peerAddr)
forall a. a -> Maybe a
Just ConnectionId peerAddr
connId)
AbstractState
st)
)
)
OutboundDupState ConnectionId peerAddr
_connId Async m ()
_connThread handle
_handle TimeoutExpired
_expired ->
(OperationResult
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))),
Maybe (Trace peerAddr handlerTrace))
-> STM
m
(OperationResult
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))),
Maybe (Trace peerAddr handlerTrace))
forall a. a -> STM m a
forall (m :: * -> *) a. Monad m => a -> m a
return ( Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))
-> OperationResult
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m)))
forall a. a -> OperationResult a
OperationSuccess (ConnectionState peerAddr handle handleError version m
-> ConnectionState peerAddr handle handleError version m
-> Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))
forall state. state -> state -> Transition state
mkTransition ConnectionState peerAddr handle handleError version m
connState ConnectionState peerAddr handle handleError version m
connState)
, Maybe (Trace peerAddr handlerTrace)
forall a. Maybe a
Nothing
)
OutboundIdleState ConnectionId peerAddr
_connId Async m ()
_connThread handle
_handle DataFlow
_dataFlow ->
(OperationResult
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))),
Maybe (Trace peerAddr handlerTrace))
-> STM
m
(OperationResult
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))),
Maybe (Trace peerAddr handlerTrace))
forall a. a -> STM m a
forall (m :: * -> *) a. Monad m => a -> m a
return ( Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))
-> OperationResult
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m)))
forall a. a -> OperationResult a
OperationSuccess (ConnectionState peerAddr handle handleError version m
-> ConnectionState peerAddr handle handleError version m
-> Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))
forall state. state -> state -> Transition state
mkTransition ConnectionState peerAddr handle handleError version m
connState ConnectionState peerAddr handle handleError version m
connState)
, Maybe (Trace peerAddr handlerTrace)
forall a. Maybe a
Nothing
)
InboundIdleState ConnectionId peerAddr
_connId Async m ()
_connThread handle
_handle DataFlow
_dataFlow ->
(OperationResult
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))),
Maybe (Trace peerAddr handlerTrace))
-> STM
m
(OperationResult
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))),
Maybe (Trace peerAddr handlerTrace))
forall a. a -> STM m a
forall (m :: * -> *) a. Monad m => a -> m a
return ( Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))
-> OperationResult
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m)))
forall a. a -> OperationResult a
OperationSuccess (ConnectionState peerAddr handle handleError version m
-> ConnectionState peerAddr handle handleError version m
-> Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))
forall state. state -> state -> Transition state
mkTransition ConnectionState peerAddr handle handleError version m
connState ConnectionState peerAddr handle handleError version m
connState)
, Maybe (Trace peerAddr handlerTrace)
forall a. Maybe a
Nothing
)
InboundState ConnectionId peerAddr
connId Async m ()
connThread handle
handle DataFlow
dataFlow -> do
let connState' :: ConnectionState peerAddr handle handleError version m
connState' = ConnectionId peerAddr
-> Async m ()
-> handle
-> DataFlow
-> ConnectionState peerAddr handle handleError version m
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
StrictTVar
m (ConnectionState peerAddr handle handleError version m)
-> ConnectionState peerAddr handle handleError version m
-> STM m ()
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'
(OperationResult
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))),
Maybe (Trace peerAddr handlerTrace))
-> STM
m
(OperationResult
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))),
Maybe (Trace peerAddr handlerTrace))
forall a. a -> STM m a
forall (m :: * -> *) a. Monad m => a -> m a
return ( Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))
-> OperationResult
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m)))
forall a. a -> OperationResult a
OperationSuccess (ConnectionState peerAddr handle handleError version m
-> ConnectionState peerAddr handle handleError version m
-> Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))
forall state. state -> state -> Transition state
mkTransition ConnectionState peerAddr handle handleError version m
connState ConnectionState peerAddr handle handleError version m
connState')
, Maybe (Trace peerAddr handlerTrace)
forall a. Maybe a
Nothing
)
DuplexState ConnectionId peerAddr
connId Async m ()
connThread handle
handle -> do
let connState' :: ConnectionState peerAddr handle handleError version m
connState' = ConnectionId peerAddr
-> Async m ()
-> handle
-> TimeoutExpired
-> ConnectionState peerAddr handle handleError version m
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
StrictTVar
m (ConnectionState peerAddr handle handleError version m)
-> ConnectionState peerAddr handle handleError version m
-> STM m ()
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'
(OperationResult
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))),
Maybe (Trace peerAddr handlerTrace))
-> STM
m
(OperationResult
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))),
Maybe (Trace peerAddr handlerTrace))
forall a. a -> STM m a
forall (m :: * -> *) a. Monad m => a -> m a
return ( Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))
-> OperationResult
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m)))
forall a. a -> OperationResult a
OperationSuccess (ConnectionState peerAddr handle handleError version m
-> ConnectionState peerAddr handle handleError version m
-> Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))
forall state. state -> state -> Transition state
mkTransition ConnectionState peerAddr handle handleError version m
connState ConnectionState peerAddr handle handleError version m
connState')
, Maybe (Trace peerAddr handlerTrace)
forall a. Maybe a
Nothing
)
TerminatingState {} ->
(OperationResult
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))),
Maybe (Trace peerAddr handlerTrace))
-> STM
m
(OperationResult
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))),
Maybe (Trace peerAddr handlerTrace))
forall a. a -> STM m a
forall (m :: * -> *) a. Monad m => a -> m a
return ( AbstractState
-> OperationResult
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m)))
forall a. AbstractState -> OperationResult a
TerminatedConnection AbstractState
st
, Maybe (Trace peerAddr handlerTrace)
forall a. Maybe a
Nothing
)
TerminatedState {} ->
(OperationResult
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))),
Maybe (Trace peerAddr handlerTrace))
-> STM
m
(OperationResult
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))),
Maybe (Trace peerAddr handlerTrace))
forall a. a -> STM m a
forall (m :: * -> *) a. Monad m => a -> m a
return ( AbstractState
-> OperationResult
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m)))
forall a. AbstractState -> OperationResult a
TerminatedConnection AbstractState
st
, Maybe (Trace peerAddr handlerTrace)
forall a. Maybe a
Nothing
)
whenJust mbAssertion $ \Trace peerAddr handlerTrace
tr' -> do
Tracer m (Trace peerAddr handlerTrace)
-> Trace peerAddr handlerTrace -> m ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer m (Trace peerAddr handlerTrace)
tracer Trace peerAddr handlerTrace
tr'
_ <- (Any -> Any) -> m (Any -> Any)
forall a. a -> m a
forall (m :: * -> *) a. MonadEvaluate m => a -> m a
evaluate (Bool -> Any -> Any
forall a. (?callStack::CallStack) => Bool -> a -> a
assert Bool
False)
pure ()
case result of
OperationSuccess Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))
tr ->
Tracer
m
(TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m))
-> TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m)
-> m ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer
m
(TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m))
trTracer (peerAddr
-> Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))
-> TransitionTrace
peerAddr (ConnectionState peerAddr handle handleError version m)
forall peerAddr state.
peerAddr -> Transition' state -> TransitionTrace' peerAddr state
TransitionTrace peerAddr
peerAddr Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m))
tr)
OperationResult
(Transition'
(MaybeUnknown
(ConnectionState peerAddr handle handleError version m)))
_ -> () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
traceCounters stateVar
return (abstractState . fromState <$> result)
whenJust :: Applicative m => Maybe a -> (a -> m ()) -> m ()
whenJust :: forall (m :: * -> *) a.
Applicative m =>
Maybe a -> (a -> m ()) -> m ()
whenJust Maybe a
mg a -> m ()
f = m () -> (a -> m ()) -> Maybe a -> m ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) a -> m ()
f Maybe a
mg
modifyTMVar :: ( MonadEvaluate m
, MonadMask m
, MonadSTM m
)
=> StrictTMVar m a
-> (a -> m (a, b))
-> m b
modifyTMVar :: forall (m :: * -> *) a b.
(MonadEvaluate m, MonadMask m, MonadSTM m) =>
StrictTMVar m a -> (a -> m (a, b)) -> m b
modifyTMVar StrictTMVar m a
v a -> m (a, b)
k =
((forall a. m a -> m a) -> m b) -> m b
forall b. ((forall a. m a -> m a) -> m b) -> m b
forall (m :: * -> *) b.
MonadMask m =>
((forall a. m a -> m a) -> m b) -> m b
mask (((forall a. m a -> m a) -> m b) -> m b)
-> ((forall a. m a -> m a) -> m b) -> m b
forall a b. (a -> b) -> a -> b
$ \forall a. m a -> m a
restore -> do
a <- STM m a -> m a
forall a. (?callStack::CallStack) => STM m a -> m a
forall (m :: * -> *) a.
(MonadSTM m, ?callStack::CallStack) =>
STM m a -> m a
atomically (StrictTMVar m a -> STM m a
forall (m :: * -> *) a. MonadSTM m => StrictTMVar m a -> STM m a
takeTMVar StrictTMVar m a
v)
(a',b) <- restore (k a >>= evaluate)
`onException`
atomically (putTMVar v a)
atomically (putTMVar v a')
return b
modifyTMVarSTM :: MonadSTM m => StrictTMVar m a -> (a -> STM m (a, b)) -> STM m b
modifyTMVarSTM :: forall (m :: * -> *) a b.
MonadSTM m =>
StrictTMVar m a -> (a -> STM m (a, b)) -> STM m b
modifyTMVarSTM StrictTMVar m a
v a -> STM m (a, b)
k = do
a <- StrictTMVar m a -> STM m a
forall (m :: * -> *) a. MonadSTM m => StrictTMVar m a -> STM m a
takeTMVar StrictTMVar m a
v
(a',b) <- k a
putTMVar v a'
return b
modifyTMVarPure :: MonadSTM m
=> StrictTMVar m a
-> (a -> (a, b))
-> STM m b
modifyTMVarPure :: forall (m :: * -> *) a b.
MonadSTM m =>
StrictTMVar m a -> (a -> (a, b)) -> STM m b
modifyTMVarPure StrictTMVar m a
v a -> (a, b)
k = do
a <- StrictTMVar m a -> STM m a
forall (m :: * -> *) a. MonadSTM m => StrictTMVar m a -> STM m a
takeTMVar StrictTMVar m a
v
let (a', b) = k a
putTMVar v a'
return b
withCallStack :: HasCallStack => (CallStack -> a) -> a
withCallStack :: forall a. (?callStack::CallStack) => (CallStack -> a) -> a
withCallStack CallStack -> a
k = CallStack -> a
k CallStack
(?callStack::CallStack) => CallStack
callStack
data Trace peerAddr handlerTrace
= TrIncludeConnection Provenance peerAddr
| TrReleaseConnection Provenance peerAddr
| TrConnect (Maybe peerAddr)
peerAddr
| TrConnectError (Maybe peerAddr)
peerAddr
SomeException
| TrTerminatingConnection Provenance (ConnectionId peerAddr)
| TrTerminatedConnection Provenance peerAddr
| TrConnectionHandler (ConnectionId peerAddr) handlerTrace
| TrShutdown
| TrConnectionExists Provenance peerAddr AbstractState
| TrForbiddenConnection (ConnectionId peerAddr)
| TrConnectionFailure (ConnectionId peerAddr)
| TrConnectionNotFound Provenance peerAddr
| TrForbiddenOperation peerAddr AbstractState
| TrPruneConnections (Set peerAddr)
Int
(Set peerAddr)
| TrConnectionCleanup (ConnectionId peerAddr)
| TrConnectionTimeWait (ConnectionId peerAddr)
| TrConnectionTimeWaitDone (ConnectionId peerAddr)
| TrConnectionManagerCounters ConnectionManagerCounters
| TrState (Map peerAddr AbstractState)
| TrUnexpectedlyFalseAssertion (AssertionLocation peerAddr)
deriving Int -> Trace peerAddr handlerTrace -> ShowS
[Trace peerAddr handlerTrace] -> ShowS
Trace peerAddr handlerTrace -> String
(Int -> Trace peerAddr handlerTrace -> ShowS)
-> (Trace peerAddr handlerTrace -> String)
-> ([Trace peerAddr handlerTrace] -> ShowS)
-> Show (Trace peerAddr handlerTrace)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall peerAddr handlerTrace.
(Show handlerTrace, Show peerAddr) =>
Int -> Trace peerAddr handlerTrace -> ShowS
forall peerAddr handlerTrace.
(Show handlerTrace, Show peerAddr) =>
[Trace peerAddr handlerTrace] -> ShowS
forall peerAddr handlerTrace.
(Show handlerTrace, Show peerAddr) =>
Trace peerAddr handlerTrace -> String
$cshowsPrec :: forall peerAddr handlerTrace.
(Show handlerTrace, Show peerAddr) =>
Int -> Trace peerAddr handlerTrace -> ShowS
showsPrec :: Int -> Trace peerAddr handlerTrace -> ShowS
$cshow :: forall peerAddr handlerTrace.
(Show handlerTrace, Show peerAddr) =>
Trace peerAddr handlerTrace -> String
show :: Trace peerAddr handlerTrace -> String
$cshowList :: forall peerAddr handlerTrace.
(Show handlerTrace, Show peerAddr) =>
[Trace peerAddr handlerTrace] -> ShowS
showList :: [Trace peerAddr handlerTrace] -> ShowS
Show