{-# LANGUAGE DataKinds #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Ouroboros.Network.Protocol.LocalTxMonitor.Server
(
LocalTxMonitorServer (..)
, ServerStIdle (..)
, ServerStAcquiring (..)
, ServerStAcquired (..)
, ServerStBusy (..)
, localTxMonitorServerPeer
) where
import Network.TypedProtocol.Core
import Ouroboros.Network.Protocol.LocalTxMonitor.Type
newtype LocalTxMonitorServer txid tx slot m a = LocalTxMonitorServer {
LocalTxMonitorServer txid tx slot m a
-> m (ServerStIdle txid tx slot m a)
runLocalTxMonitorServer :: m (ServerStIdle txid tx slot m a)
}
data ServerStIdle txid tx slot m a = ServerStIdle
{ ServerStIdle txid tx slot m a
-> m (ServerStAcquiring txid tx slot m a)
recvMsgAcquire :: m (ServerStAcquiring txid tx slot m a)
, ServerStIdle txid tx slot m a -> m a
recvMsgDone :: m a
}
data ServerStAcquiring txid tx slot m a where
SendMsgAcquired
:: slot
-> ServerStAcquired txid tx slot m a
-> ServerStAcquiring txid tx slot m a
data ServerStAcquired txid tx slot m a = ServerStAcquired
{ ServerStAcquired txid tx slot m a
-> m (ServerStBusy 'NextTx txid tx slot m a)
recvMsgNextTx :: m (ServerStBusy NextTx txid tx slot m a)
, ServerStAcquired txid tx slot m a
-> txid -> m (ServerStBusy 'HasTx txid tx slot m a)
recvMsgHasTx :: txid -> m (ServerStBusy HasTx txid tx slot m a)
, ServerStAcquired txid tx slot m a
-> m (ServerStBusy 'GetSizes txid tx slot m a)
recvMsgGetSizes :: m (ServerStBusy GetSizes txid tx slot m a)
, ServerStAcquired txid tx slot m a
-> m (ServerStAcquiring txid tx slot m a)
recvMsgAwaitAcquire :: m (ServerStAcquiring txid tx slot m a)
, ServerStAcquired txid tx slot m a
-> m (ServerStIdle txid tx slot m a)
recvMsgRelease :: m (ServerStIdle txid tx slot m a)
}
data ServerStBusy (kind :: StBusyKind) txid tx slot m a where
SendMsgReplyNextTx
:: Maybe tx
-> ServerStAcquired txid tx slot m a
-> ServerStBusy NextTx txid tx slot m a
SendMsgReplyHasTx
:: Bool
-> ServerStAcquired txid tx slot m a
-> ServerStBusy HasTx txid tx slot m a
SendMsgReplyGetSizes
:: MempoolSizeAndCapacity
-> ServerStAcquired txid tx slot m a
-> ServerStBusy GetSizes txid tx slot m a
localTxMonitorServerPeer ::
forall txid tx slot m a.
( Monad m
)
=> LocalTxMonitorServer txid tx slot m a
-> Peer (LocalTxMonitor txid tx slot) AsServer StIdle m a
localTxMonitorServerPeer :: LocalTxMonitorServer txid tx slot m a
-> Peer (LocalTxMonitor txid tx slot) 'AsServer 'StIdle m a
localTxMonitorServerPeer (LocalTxMonitorServer m (ServerStIdle txid tx slot m a)
mServer) =
m (Peer (LocalTxMonitor txid tx slot) 'AsServer 'StIdle m a)
-> Peer (LocalTxMonitor txid tx slot) 'AsServer 'StIdle m a
forall (m :: * -> *) ps (pr :: PeerRole) (st :: ps) a.
m (Peer ps pr st m a) -> Peer ps pr st m a
Effect (m (Peer (LocalTxMonitor txid tx slot) 'AsServer 'StIdle m a)
-> Peer (LocalTxMonitor txid tx slot) 'AsServer 'StIdle m a)
-> m (Peer (LocalTxMonitor txid tx slot) 'AsServer 'StIdle m a)
-> Peer (LocalTxMonitor txid tx slot) 'AsServer 'StIdle m a
forall a b. (a -> b) -> a -> b
$ ServerStIdle txid tx slot m a
-> Peer (LocalTxMonitor txid tx slot) 'AsServer 'StIdle m a
handleStIdle (ServerStIdle txid tx slot m a
-> Peer (LocalTxMonitor txid tx slot) 'AsServer 'StIdle m a)
-> m (ServerStIdle txid tx slot m a)
-> m (Peer (LocalTxMonitor txid tx slot) 'AsServer 'StIdle m a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (ServerStIdle txid tx slot m a)
mServer
where
handleStIdle ::
ServerStIdle txid tx slot m a
-> Peer (LocalTxMonitor txid tx slot) AsServer StIdle m a
handleStIdle :: ServerStIdle txid tx slot m a
-> Peer (LocalTxMonitor txid tx slot) 'AsServer 'StIdle m a
handleStIdle = \case
ServerStIdle{m a
recvMsgDone :: m a
recvMsgDone :: forall txid tx slot (m :: * -> *) a.
ServerStIdle txid tx slot m a -> m a
recvMsgDone, m (ServerStAcquiring txid tx slot m a)
recvMsgAcquire :: m (ServerStAcquiring txid tx slot m a)
recvMsgAcquire :: forall txid tx slot (m :: * -> *) a.
ServerStIdle txid tx slot m a
-> m (ServerStAcquiring txid tx slot m a)
recvMsgAcquire} ->
TheyHaveAgency 'AsServer 'StIdle
-> (forall (st' :: LocalTxMonitor txid tx slot).
Message (LocalTxMonitor txid tx slot) 'StIdle st'
-> Peer (LocalTxMonitor txid tx slot) 'AsServer st' m a)
-> Peer (LocalTxMonitor txid tx slot) 'AsServer 'StIdle m a
forall (pr :: PeerRole) ps (st :: ps) (m :: * -> *) a.
TheyHaveAgency pr st
-> (forall (st' :: ps). Message ps st st' -> Peer ps pr st' m a)
-> Peer ps pr st m a
Await (ClientHasAgency 'StIdle -> PeerHasAgency 'AsClient 'StIdle
forall ps (st :: ps).
ClientHasAgency st -> PeerHasAgency 'AsClient st
ClientAgency ClientHasAgency 'StIdle
forall k k k (txid :: k) (tx :: k) (slot :: k).
ClientHasAgency 'StIdle
TokIdle) ((forall (st' :: LocalTxMonitor txid tx slot).
Message (LocalTxMonitor txid tx slot) 'StIdle st'
-> Peer (LocalTxMonitor txid tx slot) 'AsServer st' m a)
-> Peer (LocalTxMonitor txid tx slot) 'AsServer 'StIdle m a)
-> (forall (st' :: LocalTxMonitor txid tx slot).
Message (LocalTxMonitor txid tx slot) 'StIdle st'
-> Peer (LocalTxMonitor txid tx slot) 'AsServer st' m a)
-> Peer (LocalTxMonitor txid tx slot) 'AsServer 'StIdle m a
forall a b. (a -> b) -> a -> b
$ \case
Message (LocalTxMonitor txid tx slot) 'StIdle st'
MsgAcquire ->
m (Peer (LocalTxMonitor txid tx slot) 'AsServer 'StAcquiring m a)
-> Peer (LocalTxMonitor txid tx slot) 'AsServer 'StAcquiring m a
forall (m :: * -> *) ps (pr :: PeerRole) (st :: ps) a.
m (Peer ps pr st m a) -> Peer ps pr st m a
Effect (m (Peer (LocalTxMonitor txid tx slot) 'AsServer 'StAcquiring m a)
-> Peer (LocalTxMonitor txid tx slot) 'AsServer 'StAcquiring m a)
-> m (Peer
(LocalTxMonitor txid tx slot) 'AsServer 'StAcquiring m a)
-> Peer (LocalTxMonitor txid tx slot) 'AsServer 'StAcquiring m a
forall a b. (a -> b) -> a -> b
$ ServerStAcquiring txid tx slot m a
-> Peer (LocalTxMonitor txid tx slot) 'AsServer 'StAcquiring m a
handleStAcquiring (ServerStAcquiring txid tx slot m a
-> Peer (LocalTxMonitor txid tx slot) 'AsServer 'StAcquiring m a)
-> m (ServerStAcquiring txid tx slot m a)
-> m (Peer
(LocalTxMonitor txid tx slot) 'AsServer 'StAcquiring m a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (ServerStAcquiring txid tx slot m a)
recvMsgAcquire
Message (LocalTxMonitor txid tx slot) 'StIdle st'
MsgDone ->
m (Peer (LocalTxMonitor txid tx slot) 'AsServer 'StDone m a)
-> Peer (LocalTxMonitor txid tx slot) 'AsServer 'StDone m a
forall (m :: * -> *) ps (pr :: PeerRole) (st :: ps) a.
m (Peer ps pr st m a) -> Peer ps pr st m a
Effect (m (Peer (LocalTxMonitor txid tx slot) 'AsServer 'StDone m a)
-> Peer (LocalTxMonitor txid tx slot) 'AsServer 'StDone m a)
-> m (Peer (LocalTxMonitor txid tx slot) 'AsServer 'StDone m a)
-> Peer (LocalTxMonitor txid tx slot) 'AsServer 'StDone m a
forall a b. (a -> b) -> a -> b
$ NobodyHasAgency 'StDone
-> a -> Peer (LocalTxMonitor txid tx slot) 'AsServer 'StDone m a
forall ps (st :: ps) a (pr :: PeerRole) (m :: * -> *).
NobodyHasAgency st -> a -> Peer ps pr st m a
Done NobodyHasAgency 'StDone
forall k k k (txid :: k) (tx :: k) (slot :: k).
NobodyHasAgency 'StDone
TokDone (a -> Peer (LocalTxMonitor txid tx slot) 'AsServer 'StDone m a)
-> m a
-> m (Peer (LocalTxMonitor txid tx slot) 'AsServer 'StDone m a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m a
recvMsgDone
handleStAcquiring ::
ServerStAcquiring txid tx slot m a
-> Peer (LocalTxMonitor txid tx slot) AsServer StAcquiring m a
handleStAcquiring :: ServerStAcquiring txid tx slot m a
-> Peer (LocalTxMonitor txid tx slot) 'AsServer 'StAcquiring m a
handleStAcquiring = \case
SendMsgAcquired slot
slot ServerStAcquired txid tx slot m a
serverStAcquired ->
WeHaveAgency 'AsServer 'StAcquiring
-> Message (LocalTxMonitor txid tx slot) 'StAcquiring 'StAcquired
-> Peer (LocalTxMonitor txid tx slot) 'AsServer 'StAcquired m a
-> Peer (LocalTxMonitor txid tx slot) 'AsServer 'StAcquiring m a
forall (pr :: PeerRole) ps (st :: ps) (st' :: ps) (m :: * -> *) a.
WeHaveAgency pr st
-> Message ps st st' -> Peer ps pr st' m a -> Peer ps pr st m a
Yield (ServerHasAgency 'StAcquiring -> WeHaveAgency 'AsServer 'StAcquiring
forall ps (st :: ps).
ServerHasAgency st -> PeerHasAgency 'AsServer st
ServerAgency ServerHasAgency 'StAcquiring
forall k k k (txid :: k) (tx :: k) (slot :: k).
ServerHasAgency 'StAcquiring
TokAcquiring) (slot
-> Message (LocalTxMonitor txid tx slot) 'StAcquiring 'StAcquired
forall k k slot (txid :: k) (tx :: k).
slot
-> Message (LocalTxMonitor txid tx slot) 'StAcquiring 'StAcquired
MsgAcquired slot
slot) (Peer (LocalTxMonitor txid tx slot) 'AsServer 'StAcquired m a
-> Peer (LocalTxMonitor txid tx slot) 'AsServer 'StAcquiring m a)
-> Peer (LocalTxMonitor txid tx slot) 'AsServer 'StAcquired m a
-> Peer (LocalTxMonitor txid tx slot) 'AsServer 'StAcquiring m a
forall a b. (a -> b) -> a -> b
$
ServerStAcquired txid tx slot m a
-> Peer (LocalTxMonitor txid tx slot) 'AsServer 'StAcquired m a
handleStAcquired ServerStAcquired txid tx slot m a
serverStAcquired
handleStAcquired ::
ServerStAcquired txid tx slot m a
-> Peer (LocalTxMonitor txid tx slot) AsServer StAcquired m a
handleStAcquired :: ServerStAcquired txid tx slot m a
-> Peer (LocalTxMonitor txid tx slot) 'AsServer 'StAcquired m a
handleStAcquired = \case
ServerStAcquired
{ m (ServerStBusy 'NextTx txid tx slot m a)
recvMsgNextTx :: m (ServerStBusy 'NextTx txid tx slot m a)
recvMsgNextTx :: forall txid tx slot (m :: * -> *) a.
ServerStAcquired txid tx slot m a
-> m (ServerStBusy 'NextTx txid tx slot m a)
recvMsgNextTx
, txid -> m (ServerStBusy 'HasTx txid tx slot m a)
recvMsgHasTx :: txid -> m (ServerStBusy 'HasTx txid tx slot m a)
recvMsgHasTx :: forall txid tx slot (m :: * -> *) a.
ServerStAcquired txid tx slot m a
-> txid -> m (ServerStBusy 'HasTx txid tx slot m a)
recvMsgHasTx
, m (ServerStBusy 'GetSizes txid tx slot m a)
recvMsgGetSizes :: m (ServerStBusy 'GetSizes txid tx slot m a)
recvMsgGetSizes :: forall txid tx slot (m :: * -> *) a.
ServerStAcquired txid tx slot m a
-> m (ServerStBusy 'GetSizes txid tx slot m a)
recvMsgGetSizes
, m (ServerStAcquiring txid tx slot m a)
recvMsgAwaitAcquire :: m (ServerStAcquiring txid tx slot m a)
recvMsgAwaitAcquire :: forall txid tx slot (m :: * -> *) a.
ServerStAcquired txid tx slot m a
-> m (ServerStAcquiring txid tx slot m a)
recvMsgAwaitAcquire
, m (ServerStIdle txid tx slot m a)
recvMsgRelease :: m (ServerStIdle txid tx slot m a)
recvMsgRelease :: forall txid tx slot (m :: * -> *) a.
ServerStAcquired txid tx slot m a
-> m (ServerStIdle txid tx slot m a)
recvMsgRelease
} -> TheyHaveAgency 'AsServer 'StAcquired
-> (forall (st' :: LocalTxMonitor txid tx slot).
Message (LocalTxMonitor txid tx slot) 'StAcquired st'
-> Peer (LocalTxMonitor txid tx slot) 'AsServer st' m a)
-> Peer (LocalTxMonitor txid tx slot) 'AsServer 'StAcquired m a
forall (pr :: PeerRole) ps (st :: ps) (m :: * -> *) a.
TheyHaveAgency pr st
-> (forall (st' :: ps). Message ps st st' -> Peer ps pr st' m a)
-> Peer ps pr st m a
Await (ClientHasAgency 'StAcquired -> PeerHasAgency 'AsClient 'StAcquired
forall ps (st :: ps).
ClientHasAgency st -> PeerHasAgency 'AsClient st
ClientAgency ClientHasAgency 'StAcquired
forall k k k (txid :: k) (tx :: k) (slot :: k).
ClientHasAgency 'StAcquired
TokAcquired) ((forall (st' :: LocalTxMonitor txid tx slot).
Message (LocalTxMonitor txid tx slot) 'StAcquired st'
-> Peer (LocalTxMonitor txid tx slot) 'AsServer st' m a)
-> Peer (LocalTxMonitor txid tx slot) 'AsServer 'StAcquired m a)
-> (forall (st' :: LocalTxMonitor txid tx slot).
Message (LocalTxMonitor txid tx slot) 'StAcquired st'
-> Peer (LocalTxMonitor txid tx slot) 'AsServer st' m a)
-> Peer (LocalTxMonitor txid tx slot) 'AsServer 'StAcquired m a
forall a b. (a -> b) -> a -> b
$ \case
Message (LocalTxMonitor txid tx slot) 'StAcquired st'
MsgNextTx ->
m (Peer
(LocalTxMonitor txid tx slot) 'AsServer ('StBusy 'NextTx) m a)
-> Peer
(LocalTxMonitor txid tx slot) 'AsServer ('StBusy 'NextTx) m a
forall (m :: * -> *) ps (pr :: PeerRole) (st :: ps) a.
m (Peer ps pr st m a) -> Peer ps pr st m a
Effect (m (Peer
(LocalTxMonitor txid tx slot) 'AsServer ('StBusy 'NextTx) m a)
-> Peer
(LocalTxMonitor txid tx slot) 'AsServer ('StBusy 'NextTx) m a)
-> m (Peer
(LocalTxMonitor txid tx slot) 'AsServer ('StBusy 'NextTx) m a)
-> Peer
(LocalTxMonitor txid tx slot) 'AsServer ('StBusy 'NextTx) m a
forall a b. (a -> b) -> a -> b
$ ServerStBusy 'NextTx txid tx slot m a
-> Peer
(LocalTxMonitor txid tx slot) 'AsServer ('StBusy 'NextTx) m a
handleNextTx (ServerStBusy 'NextTx txid tx slot m a
-> Peer
(LocalTxMonitor txid tx slot) 'AsServer ('StBusy 'NextTx) m a)
-> m (ServerStBusy 'NextTx txid tx slot m a)
-> m (Peer
(LocalTxMonitor txid tx slot) 'AsServer ('StBusy 'NextTx) m a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (ServerStBusy 'NextTx txid tx slot m a)
recvMsgNextTx
MsgHasTx txid ->
m (Peer
(LocalTxMonitor txid tx slot) 'AsServer ('StBusy 'HasTx) m a)
-> Peer
(LocalTxMonitor txid tx slot) 'AsServer ('StBusy 'HasTx) m a
forall (m :: * -> *) ps (pr :: PeerRole) (st :: ps) a.
m (Peer ps pr st m a) -> Peer ps pr st m a
Effect (m (Peer
(LocalTxMonitor txid tx slot) 'AsServer ('StBusy 'HasTx) m a)
-> Peer
(LocalTxMonitor txid tx slot) 'AsServer ('StBusy 'HasTx) m a)
-> m (Peer
(LocalTxMonitor txid tx slot) 'AsServer ('StBusy 'HasTx) m a)
-> Peer
(LocalTxMonitor txid tx slot) 'AsServer ('StBusy 'HasTx) m a
forall a b. (a -> b) -> a -> b
$ ServerStBusy 'HasTx txid tx slot m a
-> Peer
(LocalTxMonitor txid tx slot) 'AsServer ('StBusy 'HasTx) m a
handleHasTx (ServerStBusy 'HasTx txid tx slot m a
-> Peer
(LocalTxMonitor txid tx slot) 'AsServer ('StBusy 'HasTx) m a)
-> m (ServerStBusy 'HasTx txid tx slot m a)
-> m (Peer
(LocalTxMonitor txid tx slot) 'AsServer ('StBusy 'HasTx) m a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> txid -> m (ServerStBusy 'HasTx txid tx slot m a)
recvMsgHasTx txid
txid
txid
Message (LocalTxMonitor txid tx slot) 'StAcquired st'
MsgGetSizes ->
m (Peer
(LocalTxMonitor txid tx slot) 'AsServer ('StBusy 'GetSizes) m a)
-> Peer
(LocalTxMonitor txid tx slot) 'AsServer ('StBusy 'GetSizes) m a
forall (m :: * -> *) ps (pr :: PeerRole) (st :: ps) a.
m (Peer ps pr st m a) -> Peer ps pr st m a
Effect (m (Peer
(LocalTxMonitor txid tx slot) 'AsServer ('StBusy 'GetSizes) m a)
-> Peer
(LocalTxMonitor txid tx slot) 'AsServer ('StBusy 'GetSizes) m a)
-> m (Peer
(LocalTxMonitor txid tx slot) 'AsServer ('StBusy 'GetSizes) m a)
-> Peer
(LocalTxMonitor txid tx slot) 'AsServer ('StBusy 'GetSizes) m a
forall a b. (a -> b) -> a -> b
$ ServerStBusy 'GetSizes txid tx slot m a
-> Peer
(LocalTxMonitor txid tx slot) 'AsServer ('StBusy 'GetSizes) m a
handleGetSizes (ServerStBusy 'GetSizes txid tx slot m a
-> Peer
(LocalTxMonitor txid tx slot) 'AsServer ('StBusy 'GetSizes) m a)
-> m (ServerStBusy 'GetSizes txid tx slot m a)
-> m (Peer
(LocalTxMonitor txid tx slot) 'AsServer ('StBusy 'GetSizes) m a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (ServerStBusy 'GetSizes txid tx slot m a)
recvMsgGetSizes
Message (LocalTxMonitor txid tx slot) 'StAcquired st'
MsgAwaitAcquire ->
m (Peer (LocalTxMonitor txid tx slot) 'AsServer 'StAcquiring m a)
-> Peer (LocalTxMonitor txid tx slot) 'AsServer 'StAcquiring m a
forall (m :: * -> *) ps (pr :: PeerRole) (st :: ps) a.
m (Peer ps pr st m a) -> Peer ps pr st m a
Effect (m (Peer (LocalTxMonitor txid tx slot) 'AsServer 'StAcquiring m a)
-> Peer (LocalTxMonitor txid tx slot) 'AsServer 'StAcquiring m a)
-> m (Peer
(LocalTxMonitor txid tx slot) 'AsServer 'StAcquiring m a)
-> Peer (LocalTxMonitor txid tx slot) 'AsServer 'StAcquiring m a
forall a b. (a -> b) -> a -> b
$ ServerStAcquiring txid tx slot m a
-> Peer (LocalTxMonitor txid tx slot) 'AsServer 'StAcquiring m a
handleStAcquiring (ServerStAcquiring txid tx slot m a
-> Peer (LocalTxMonitor txid tx slot) 'AsServer 'StAcquiring m a)
-> m (ServerStAcquiring txid tx slot m a)
-> m (Peer
(LocalTxMonitor txid tx slot) 'AsServer 'StAcquiring m a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (ServerStAcquiring txid tx slot m a)
recvMsgAwaitAcquire
Message (LocalTxMonitor txid tx slot) 'StAcquired st'
MsgRelease ->
m (Peer (LocalTxMonitor txid tx slot) 'AsServer 'StIdle m a)
-> Peer (LocalTxMonitor txid tx slot) 'AsServer 'StIdle m a
forall (m :: * -> *) ps (pr :: PeerRole) (st :: ps) a.
m (Peer ps pr st m a) -> Peer ps pr st m a
Effect (m (Peer (LocalTxMonitor txid tx slot) 'AsServer 'StIdle m a)
-> Peer (LocalTxMonitor txid tx slot) 'AsServer 'StIdle m a)
-> m (Peer (LocalTxMonitor txid tx slot) 'AsServer 'StIdle m a)
-> Peer (LocalTxMonitor txid tx slot) 'AsServer 'StIdle m a
forall a b. (a -> b) -> a -> b
$ ServerStIdle txid tx slot m a
-> Peer (LocalTxMonitor txid tx slot) 'AsServer 'StIdle m a
handleStIdle (ServerStIdle txid tx slot m a
-> Peer (LocalTxMonitor txid tx slot) 'AsServer 'StIdle m a)
-> m (ServerStIdle txid tx slot m a)
-> m (Peer (LocalTxMonitor txid tx slot) 'AsServer 'StIdle m a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (ServerStIdle txid tx slot m a)
recvMsgRelease
handleNextTx ::
ServerStBusy NextTx txid tx slot m a
-> Peer (LocalTxMonitor txid tx slot) AsServer (StBusy NextTx) m a
handleNextTx :: ServerStBusy 'NextTx txid tx slot m a
-> Peer
(LocalTxMonitor txid tx slot) 'AsServer ('StBusy 'NextTx) m a
handleNextTx = \case
SendMsgReplyNextTx Maybe tx
tx ServerStAcquired txid tx slot m a
serverStAcquired ->
WeHaveAgency 'AsServer ('StBusy 'NextTx)
-> Message
(LocalTxMonitor txid tx slot) ('StBusy 'NextTx) 'StAcquired
-> Peer (LocalTxMonitor txid tx slot) 'AsServer 'StAcquired m a
-> Peer
(LocalTxMonitor txid tx slot) 'AsServer ('StBusy 'NextTx) m a
forall (pr :: PeerRole) ps (st :: ps) (st' :: ps) (m :: * -> *) a.
WeHaveAgency pr st
-> Message ps st st' -> Peer ps pr st' m a -> Peer ps pr st m a
Yield (ServerHasAgency ('StBusy 'NextTx)
-> WeHaveAgency 'AsServer ('StBusy 'NextTx)
forall ps (st :: ps).
ServerHasAgency st -> PeerHasAgency 'AsServer st
ServerAgency (TokBusyKind 'NextTx -> ServerHasAgency ('StBusy 'NextTx)
forall k k k (txid :: k) (tx :: k) (slot :: k) (k :: StBusyKind).
TokBusyKind k -> ServerHasAgency ('StBusy k)
TokBusy TokBusyKind 'NextTx
TokNextTx)) (Maybe tx
-> Message
(LocalTxMonitor txid tx slot) ('StBusy 'NextTx) 'StAcquired
forall k k tx (txid :: k) (slot :: k).
Maybe tx
-> Message
(LocalTxMonitor txid tx slot) ('StBusy 'NextTx) 'StAcquired
MsgReplyNextTx Maybe tx
tx) (Peer (LocalTxMonitor txid tx slot) 'AsServer 'StAcquired m a
-> Peer
(LocalTxMonitor txid tx slot) 'AsServer ('StBusy 'NextTx) m a)
-> Peer (LocalTxMonitor txid tx slot) 'AsServer 'StAcquired m a
-> Peer
(LocalTxMonitor txid tx slot) 'AsServer ('StBusy 'NextTx) m a
forall a b. (a -> b) -> a -> b
$
ServerStAcquired txid tx slot m a
-> Peer (LocalTxMonitor txid tx slot) 'AsServer 'StAcquired m a
handleStAcquired ServerStAcquired txid tx slot m a
serverStAcquired
handleHasTx ::
ServerStBusy HasTx txid tx slot m a
-> Peer (LocalTxMonitor txid tx slot) AsServer (StBusy HasTx) m a
handleHasTx :: ServerStBusy 'HasTx txid tx slot m a
-> Peer
(LocalTxMonitor txid tx slot) 'AsServer ('StBusy 'HasTx) m a
handleHasTx = \case
SendMsgReplyHasTx Bool
res ServerStAcquired txid tx slot m a
serverStAcquired ->
WeHaveAgency 'AsServer ('StBusy 'HasTx)
-> Message
(LocalTxMonitor txid tx slot) ('StBusy 'HasTx) 'StAcquired
-> Peer (LocalTxMonitor txid tx slot) 'AsServer 'StAcquired m a
-> Peer
(LocalTxMonitor txid tx slot) 'AsServer ('StBusy 'HasTx) m a
forall (pr :: PeerRole) ps (st :: ps) (st' :: ps) (m :: * -> *) a.
WeHaveAgency pr st
-> Message ps st st' -> Peer ps pr st' m a -> Peer ps pr st m a
Yield (ServerHasAgency ('StBusy 'HasTx)
-> WeHaveAgency 'AsServer ('StBusy 'HasTx)
forall ps (st :: ps).
ServerHasAgency st -> PeerHasAgency 'AsServer st
ServerAgency (TokBusyKind 'HasTx -> ServerHasAgency ('StBusy 'HasTx)
forall k k k (txid :: k) (tx :: k) (slot :: k) (k :: StBusyKind).
TokBusyKind k -> ServerHasAgency ('StBusy k)
TokBusy TokBusyKind 'HasTx
TokHasTx)) (Bool
-> Message
(LocalTxMonitor txid tx slot) ('StBusy 'HasTx) 'StAcquired
forall k k k (txid :: k) (tx :: k) (slot :: k).
Bool
-> Message
(LocalTxMonitor txid tx slot) ('StBusy 'HasTx) 'StAcquired
MsgReplyHasTx Bool
res) (Peer (LocalTxMonitor txid tx slot) 'AsServer 'StAcquired m a
-> Peer
(LocalTxMonitor txid tx slot) 'AsServer ('StBusy 'HasTx) m a)
-> Peer (LocalTxMonitor txid tx slot) 'AsServer 'StAcquired m a
-> Peer
(LocalTxMonitor txid tx slot) 'AsServer ('StBusy 'HasTx) m a
forall a b. (a -> b) -> a -> b
$
ServerStAcquired txid tx slot m a
-> Peer (LocalTxMonitor txid tx slot) 'AsServer 'StAcquired m a
handleStAcquired ServerStAcquired txid tx slot m a
serverStAcquired
handleGetSizes ::
ServerStBusy GetSizes txid tx slot m a
-> Peer (LocalTxMonitor txid tx slot) AsServer (StBusy GetSizes) m a
handleGetSizes :: ServerStBusy 'GetSizes txid tx slot m a
-> Peer
(LocalTxMonitor txid tx slot) 'AsServer ('StBusy 'GetSizes) m a
handleGetSizes = \case
SendMsgReplyGetSizes MempoolSizeAndCapacity
sizes ServerStAcquired txid tx slot m a
serverStAcquired ->
WeHaveAgency 'AsServer ('StBusy 'GetSizes)
-> Message
(LocalTxMonitor txid tx slot) ('StBusy 'GetSizes) 'StAcquired
-> Peer (LocalTxMonitor txid tx slot) 'AsServer 'StAcquired m a
-> Peer
(LocalTxMonitor txid tx slot) 'AsServer ('StBusy 'GetSizes) m a
forall (pr :: PeerRole) ps (st :: ps) (st' :: ps) (m :: * -> *) a.
WeHaveAgency pr st
-> Message ps st st' -> Peer ps pr st' m a -> Peer ps pr st m a
Yield (ServerHasAgency ('StBusy 'GetSizes)
-> WeHaveAgency 'AsServer ('StBusy 'GetSizes)
forall ps (st :: ps).
ServerHasAgency st -> PeerHasAgency 'AsServer st
ServerAgency (TokBusyKind 'GetSizes -> ServerHasAgency ('StBusy 'GetSizes)
forall k k k (txid :: k) (tx :: k) (slot :: k) (k :: StBusyKind).
TokBusyKind k -> ServerHasAgency ('StBusy k)
TokBusy TokBusyKind 'GetSizes
TokGetSizes)) (MempoolSizeAndCapacity
-> Message
(LocalTxMonitor txid tx slot) ('StBusy 'GetSizes) 'StAcquired
forall k k k (txid :: k) (tx :: k) (slot :: k).
MempoolSizeAndCapacity
-> Message
(LocalTxMonitor txid tx slot) ('StBusy 'GetSizes) 'StAcquired
MsgReplyGetSizes MempoolSizeAndCapacity
sizes) (Peer (LocalTxMonitor txid tx slot) 'AsServer 'StAcquired m a
-> Peer
(LocalTxMonitor txid tx slot) 'AsServer ('StBusy 'GetSizes) m a)
-> Peer (LocalTxMonitor txid tx slot) 'AsServer 'StAcquired m a
-> Peer
(LocalTxMonitor txid tx slot) 'AsServer ('StBusy 'GetSizes) m a
forall a b. (a -> b) -> a -> b
$
ServerStAcquired txid tx slot m a
-> Peer (LocalTxMonitor txid tx slot) 'AsServer 'StAcquired m a
handleStAcquired ServerStAcquired txid tx slot m a
serverStAcquired