{-# LANGUAGE DataKinds           #-}
{-# LANGUAGE GADTs               #-}
{-# LANGUAGE KindSignatures      #-}
{-# LANGUAGE LambdaCase          #-}
{-# LANGUAGE NamedFieldPuns      #-}
{-# LANGUAGE ScopedTypeVariables #-}

-- | A view of the transaction monitor protocol from the point of view of
-- the server.
--
-- This provides simple access to the local mempool snapshots, to allow building
-- more monitoring logic from the client side after submitting transactions.
--
-- For execution, 'localTxMonitorServerPeer' is provided for conversion
-- into the typed protocol.
--
module Ouroboros.Network.Protocol.LocalTxMonitor.Server
  ( -- * Protocol type for the server
    -- | The protocol states from the point of view of the server.
    LocalTxMonitorServer (..)
  , ServerStIdle (..)
  , ServerStAcquiring (..)
  , ServerStAcquired (..)
  , ServerStBusy (..)
    -- * Execution as a typed protocol
  , localTxMonitorServerPeer
  ) where

import Network.TypedProtocol.Core
import Network.TypedProtocol.Peer.Server

import Ouroboros.Network.Protocol.LocalTxMonitor.Type

-- | A local tx monitor protocol server, on top of some effect 'm'.
--
newtype LocalTxMonitorServer txid tx slot m a = LocalTxMonitorServer {
      forall txid tx slot (m :: * -> *) a.
LocalTxMonitorServer txid tx slot m a
-> m (ServerStIdle txid tx slot m a)
runLocalTxMonitorServer :: m (ServerStIdle txid tx slot m a)
    }

-- | In the 'StIdle' protocol state, the server does not have agency. Instead,
-- it is waiting for:
--
-- * an acquire request,
-- * a termination message.
--
data ServerStIdle txid tx slot m a = ServerStIdle
    { forall txid tx slot (m :: * -> *) a.
ServerStIdle txid tx slot m a
-> m (ServerStAcquiring txid tx slot m a)
recvMsgAcquire :: m (ServerStAcquiring txid tx slot m a)
    , forall txid tx slot (m :: * -> *) a.
ServerStIdle txid tx slot m a -> m a
recvMsgDone    :: m a
    }

-- | In the 'StAcquiring' protocol state, the server has agency and must acquire,
-- and hold on to, the current / latest snapshot of its mempool.
--
data ServerStAcquiring txid tx slot m a where
  SendMsgAcquired
    :: slot
    -> ServerStAcquired txid tx slot m a
    -> ServerStAcquiring txid tx slot m a

-- | In the 'StAcquired' protocol state, the server does not have agency and is
-- waiting for a client to either:
--
-- * request the next transaction from the snapshot;
-- * check the presence of a given transaction, by its id;
-- * await a change in the snapshot and acquire it;
-- * release and go back to the 'StIdle' state;
--
data ServerStAcquired txid tx slot m a = ServerStAcquired
    { forall txid tx slot (m :: * -> *) a.
ServerStAcquired txid tx slot m a
-> m (ServerStBusy 'NextTx txid tx slot m a)
recvMsgNextTx       :: m (ServerStBusy NextTx txid tx slot m a)
    , forall 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)
    , forall 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)
    , forall 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)
    , forall 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)
    }

-- In the 'StBusy' protocol state, the server has agency and is responding to
-- one of the client request. The state is parameterized by a kind 'StBusyKind'
-- to highlight the fact that, the server is in a busy state in response to a
-- particular query, and only responses for this query may be sent back to the
-- client.
--
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

-- | Interpret a 'LocalTxMonitorServer' action sequence as a 'Peer' on the
-- client-side of the 'LocalTxMonitor' protocol.
--
localTxMonitorServerPeer ::
     forall txid tx slot m a.
     ( Monad m
     )
  => LocalTxMonitorServer txid tx slot m a
  -> Server (LocalTxMonitor txid tx slot) NonPipelined StIdle m a
localTxMonitorServerPeer :: forall txid tx slot (m :: * -> *) a.
Monad m =>
LocalTxMonitorServer txid tx slot m a
-> Server (LocalTxMonitor txid tx slot) 'NonPipelined 'StIdle m a
localTxMonitorServerPeer (LocalTxMonitorServer m (ServerStIdle txid tx slot m a)
mServer) =
    m (Server (LocalTxMonitor txid tx slot) 'NonPipelined 'StIdle m a)
-> Server (LocalTxMonitor txid tx slot) 'NonPipelined 'StIdle m a
forall ps (pl :: IsPipelined) (st :: ps) (m :: * -> *) a.
m (Server ps pl st m a) -> Server ps pl st m a
Effect (m (Server (LocalTxMonitor txid tx slot) 'NonPipelined 'StIdle m a)
 -> Server (LocalTxMonitor txid tx slot) 'NonPipelined 'StIdle m a)
-> m (Server
        (LocalTxMonitor txid tx slot) 'NonPipelined 'StIdle m a)
-> Server (LocalTxMonitor txid tx slot) 'NonPipelined 'StIdle m a
forall a b. (a -> b) -> a -> b
$ ServerStIdle txid tx slot m a
-> Server (LocalTxMonitor txid tx slot) 'NonPipelined 'StIdle m a
handleStIdle (ServerStIdle txid tx slot m a
 -> Server (LocalTxMonitor txid tx slot) 'NonPipelined 'StIdle m a)
-> m (ServerStIdle txid tx slot m a)
-> m (Server
        (LocalTxMonitor txid tx slot) 'NonPipelined '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
      -> Server (LocalTxMonitor txid tx slot) NonPipelined StIdle m a
    handleStIdle :: ServerStIdle txid tx slot m a
-> Server (LocalTxMonitor txid tx slot) 'NonPipelined 'StIdle m a
handleStIdle = \case
      ServerStIdle{m a
recvMsgDone :: forall txid tx slot (m :: * -> *) a.
ServerStIdle txid tx slot m a -> m a
recvMsgDone :: m a
recvMsgDone, 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 :: m (ServerStAcquiring txid tx slot m a)
recvMsgAcquire} ->
        (forall (st' :: LocalTxMonitor txid tx slot).
 Message (LocalTxMonitor txid tx slot) 'StIdle st'
 -> Server (LocalTxMonitor txid tx slot) 'NonPipelined st' m a)
-> Server (LocalTxMonitor txid tx slot) 'NonPipelined 'StIdle m a
forall ps (pl :: IsPipelined) (st :: ps) (m :: * -> *) a.
(StateTokenI st, StateAgency st ~ 'ClientAgency,
 Outstanding pl ~ 'Z) =>
(forall (st' :: ps). Message ps st st' -> Server ps pl st' m a)
-> Server ps pl st m a
Await ((forall (st' :: LocalTxMonitor txid tx slot).
  Message (LocalTxMonitor txid tx slot) 'StIdle st'
  -> Server (LocalTxMonitor txid tx slot) 'NonPipelined st' m a)
 -> Server (LocalTxMonitor txid tx slot) 'NonPipelined 'StIdle m a)
-> (forall (st' :: LocalTxMonitor txid tx slot).
    Message (LocalTxMonitor txid tx slot) 'StIdle st'
    -> Server (LocalTxMonitor txid tx slot) 'NonPipelined st' m a)
-> Server (LocalTxMonitor txid tx slot) 'NonPipelined 'StIdle m a
forall a b. (a -> b) -> a -> b
$ \case
          Message (LocalTxMonitor txid tx slot) 'StIdle st'
R:MessageLocalTxMonitorfromto (*) (*) (*) txid tx slot 'StIdle st'
MsgAcquire ->
            m (Server (LocalTxMonitor txid tx slot) 'NonPipelined st' m a)
-> Server (LocalTxMonitor txid tx slot) 'NonPipelined st' m a
forall ps (pl :: IsPipelined) (st :: ps) (m :: * -> *) a.
m (Server ps pl st m a) -> Server ps pl st m a
Effect (m (Server (LocalTxMonitor txid tx slot) 'NonPipelined st' m a)
 -> Server (LocalTxMonitor txid tx slot) 'NonPipelined st' m a)
-> m (Server (LocalTxMonitor txid tx slot) 'NonPipelined st' m a)
-> Server (LocalTxMonitor txid tx slot) 'NonPipelined st' m a
forall a b. (a -> b) -> a -> b
$ ServerStAcquiring txid tx slot m a
-> Server (LocalTxMonitor txid tx slot) 'NonPipelined st' m a
ServerStAcquiring txid tx slot m a
-> Server
     (LocalTxMonitor txid tx slot) 'NonPipelined 'StAcquiring m a
handleStAcquiring (ServerStAcquiring txid tx slot m a
 -> Server (LocalTxMonitor txid tx slot) 'NonPipelined st' m a)
-> m (ServerStAcquiring txid tx slot m a)
-> m (Server (LocalTxMonitor txid tx slot) 'NonPipelined st' 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'
R:MessageLocalTxMonitorfromto (*) (*) (*) txid tx slot 'StIdle st'
MsgDone ->
            m (Server (LocalTxMonitor txid tx slot) 'NonPipelined st' m a)
-> Server (LocalTxMonitor txid tx slot) 'NonPipelined st' m a
forall ps (pl :: IsPipelined) (st :: ps) (m :: * -> *) a.
m (Server ps pl st m a) -> Server ps pl st m a
Effect (m (Server (LocalTxMonitor txid tx slot) 'NonPipelined st' m a)
 -> Server (LocalTxMonitor txid tx slot) 'NonPipelined st' m a)
-> m (Server (LocalTxMonitor txid tx slot) 'NonPipelined st' m a)
-> Server (LocalTxMonitor txid tx slot) 'NonPipelined st' m a
forall a b. (a -> b) -> a -> b
$ a -> Server (LocalTxMonitor txid tx slot) 'NonPipelined st' m a
forall ps (pl :: IsPipelined) (st :: ps) (m :: * -> *) a.
(StateTokenI st, StateAgency st ~ 'NobodyAgency,
 Outstanding pl ~ 'Z) =>
a -> Server ps pl st m a
Done (a -> Server (LocalTxMonitor txid tx slot) 'NonPipelined st' m a)
-> m a
-> m (Server (LocalTxMonitor txid tx slot) 'NonPipelined st' m a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m a
recvMsgDone

    handleStAcquiring ::
         ServerStAcquiring txid tx slot m a
      -> Server (LocalTxMonitor txid tx slot) NonPipelined StAcquiring m a
    handleStAcquiring :: ServerStAcquiring txid tx slot m a
-> Server
     (LocalTxMonitor txid tx slot) 'NonPipelined 'StAcquiring m a
handleStAcquiring = \case
      SendMsgAcquired slot
slot ServerStAcquired txid tx slot m a
serverStAcquired ->
        Message (LocalTxMonitor txid tx slot) 'StAcquiring 'StAcquired
-> Server
     (LocalTxMonitor txid tx slot) 'NonPipelined 'StAcquired m a
-> Server
     (LocalTxMonitor txid tx slot) 'NonPipelined 'StAcquiring m a
forall ps (pl :: IsPipelined) (st :: ps) (m :: * -> *) a
       (st' :: ps).
(StateTokenI st, StateTokenI st', StateAgency st ~ 'ServerAgency,
 Outstanding pl ~ 'Z) =>
Message ps st st' -> Server ps pl st' m a -> Server ps pl st m a
Yield (slot
-> Message (LocalTxMonitor txid tx slot) 'StAcquiring 'StAcquired
forall {k} {k1} slot1 (txid :: k) (tx :: k1).
slot1
-> Message (LocalTxMonitor txid tx slot1) 'StAcquiring 'StAcquired
MsgAcquired slot
slot) (Server (LocalTxMonitor txid tx slot) 'NonPipelined 'StAcquired m a
 -> Server
      (LocalTxMonitor txid tx slot) 'NonPipelined 'StAcquiring m a)
-> Server
     (LocalTxMonitor txid tx slot) 'NonPipelined 'StAcquired m a
-> Server
     (LocalTxMonitor txid tx slot) 'NonPipelined 'StAcquiring m a
forall a b. (a -> b) -> a -> b
$
          ServerStAcquired txid tx slot m a
-> Server
     (LocalTxMonitor txid tx slot) 'NonPipelined 'StAcquired m a
handleStAcquired ServerStAcquired txid tx slot m a
serverStAcquired

    handleStAcquired ::
         ServerStAcquired txid tx slot m a
      -> Server (LocalTxMonitor txid tx slot) NonPipelined StAcquired m a
    handleStAcquired :: ServerStAcquired txid tx slot m a
-> Server
     (LocalTxMonitor txid tx slot) 'NonPipelined 'StAcquired m a
handleStAcquired = \case
      ServerStAcquired
        { 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 :: m (ServerStBusy 'NextTx txid tx slot m a)
recvMsgNextTx
        , 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 :: txid -> m (ServerStBusy 'HasTx txid tx slot m a)
recvMsgHasTx
        , 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 (ServerStBusy 'GetSizes txid tx slot m a)
recvMsgGetSizes
        , 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 (ServerStAcquiring txid tx slot m a)
recvMsgAwaitAcquire
        , 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 :: m (ServerStIdle txid tx slot m a)
recvMsgRelease
        } -> (forall (st' :: LocalTxMonitor txid tx slot).
 Message (LocalTxMonitor txid tx slot) 'StAcquired st'
 -> Server (LocalTxMonitor txid tx slot) 'NonPipelined st' m a)
-> Server
     (LocalTxMonitor txid tx slot) 'NonPipelined 'StAcquired m a
forall ps (pl :: IsPipelined) (st :: ps) (m :: * -> *) a.
(StateTokenI st, StateAgency st ~ 'ClientAgency,
 Outstanding pl ~ 'Z) =>
(forall (st' :: ps). Message ps st st' -> Server ps pl st' m a)
-> Server ps pl st m a
Await ((forall (st' :: LocalTxMonitor txid tx slot).
  Message (LocalTxMonitor txid tx slot) 'StAcquired st'
  -> Server (LocalTxMonitor txid tx slot) 'NonPipelined st' m a)
 -> Server
      (LocalTxMonitor txid tx slot) 'NonPipelined 'StAcquired m a)
-> (forall (st' :: LocalTxMonitor txid tx slot).
    Message (LocalTxMonitor txid tx slot) 'StAcquired st'
    -> Server (LocalTxMonitor txid tx slot) 'NonPipelined st' m a)
-> Server
     (LocalTxMonitor txid tx slot) 'NonPipelined 'StAcquired m a
forall a b. (a -> b) -> a -> b
$ \case
          Message (LocalTxMonitor txid tx slot) 'StAcquired st'
R:MessageLocalTxMonitorfromto
  (*) (*) (*) txid tx slot 'StAcquired st'
MsgNextTx ->
            m (Server (LocalTxMonitor txid tx slot) 'NonPipelined st' m a)
-> Server (LocalTxMonitor txid tx slot) 'NonPipelined st' m a
forall ps (pl :: IsPipelined) (st :: ps) (m :: * -> *) a.
m (Server ps pl st m a) -> Server ps pl st m a
Effect (m (Server (LocalTxMonitor txid tx slot) 'NonPipelined st' m a)
 -> Server (LocalTxMonitor txid tx slot) 'NonPipelined st' m a)
-> m (Server (LocalTxMonitor txid tx slot) 'NonPipelined st' m a)
-> Server (LocalTxMonitor txid tx slot) 'NonPipelined st' m a
forall a b. (a -> b) -> a -> b
$ ServerStBusy 'NextTx txid tx slot m a
-> Server (LocalTxMonitor txid tx slot) 'NonPipelined st' m a
ServerStBusy 'NextTx txid tx slot m a
-> Server
     (LocalTxMonitor txid tx slot) 'NonPipelined ('StBusy 'NextTx) m a
handleNextTx (ServerStBusy 'NextTx txid tx slot m a
 -> Server (LocalTxMonitor txid tx slot) 'NonPipelined st' m a)
-> m (ServerStBusy 'NextTx txid tx slot m a)
-> m (Server (LocalTxMonitor txid tx slot) 'NonPipelined st' m a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (ServerStBusy 'NextTx txid tx slot m a)
recvMsgNextTx
          MsgHasTx txid1
txid ->
            m (Server (LocalTxMonitor txid tx slot) 'NonPipelined st' m a)
-> Server (LocalTxMonitor txid tx slot) 'NonPipelined st' m a
forall ps (pl :: IsPipelined) (st :: ps) (m :: * -> *) a.
m (Server ps pl st m a) -> Server ps pl st m a
Effect (m (Server (LocalTxMonitor txid tx slot) 'NonPipelined st' m a)
 -> Server (LocalTxMonitor txid tx slot) 'NonPipelined st' m a)
-> m (Server (LocalTxMonitor txid tx slot) 'NonPipelined st' m a)
-> Server (LocalTxMonitor txid tx slot) 'NonPipelined st' m a
forall a b. (a -> b) -> a -> b
$ ServerStBusy 'HasTx txid tx slot m a
-> Server (LocalTxMonitor txid tx slot) 'NonPipelined st' m a
ServerStBusy 'HasTx txid tx slot m a
-> Server
     (LocalTxMonitor txid tx slot) 'NonPipelined ('StBusy 'HasTx) m a
handleHasTx (ServerStBusy 'HasTx txid tx slot m a
 -> Server (LocalTxMonitor txid tx slot) 'NonPipelined st' m a)
-> m (ServerStBusy 'HasTx txid tx slot m a)
-> m (Server (LocalTxMonitor txid tx slot) 'NonPipelined st' 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
txid1
txid
          Message (LocalTxMonitor txid tx slot) 'StAcquired st'
R:MessageLocalTxMonitorfromto
  (*) (*) (*) txid tx slot 'StAcquired st'
MsgGetSizes ->
            m (Server (LocalTxMonitor txid tx slot) 'NonPipelined st' m a)
-> Server (LocalTxMonitor txid tx slot) 'NonPipelined st' m a
forall ps (pl :: IsPipelined) (st :: ps) (m :: * -> *) a.
m (Server ps pl st m a) -> Server ps pl st m a
Effect (m (Server (LocalTxMonitor txid tx slot) 'NonPipelined st' m a)
 -> Server (LocalTxMonitor txid tx slot) 'NonPipelined st' m a)
-> m (Server (LocalTxMonitor txid tx slot) 'NonPipelined st' m a)
-> Server (LocalTxMonitor txid tx slot) 'NonPipelined st' m a
forall a b. (a -> b) -> a -> b
$ ServerStBusy 'GetSizes txid tx slot m a
-> Server (LocalTxMonitor txid tx slot) 'NonPipelined st' m a
ServerStBusy 'GetSizes txid tx slot m a
-> Server
     (LocalTxMonitor txid tx slot) 'NonPipelined ('StBusy 'GetSizes) m a
handleGetSizes (ServerStBusy 'GetSizes txid tx slot m a
 -> Server (LocalTxMonitor txid tx slot) 'NonPipelined st' m a)
-> m (ServerStBusy 'GetSizes txid tx slot m a)
-> m (Server (LocalTxMonitor txid tx slot) 'NonPipelined st' 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'
R:MessageLocalTxMonitorfromto
  (*) (*) (*) txid tx slot 'StAcquired st'
MsgAwaitAcquire ->
            m (Server (LocalTxMonitor txid tx slot) 'NonPipelined st' m a)
-> Server (LocalTxMonitor txid tx slot) 'NonPipelined st' m a
forall ps (pl :: IsPipelined) (st :: ps) (m :: * -> *) a.
m (Server ps pl st m a) -> Server ps pl st m a
Effect (m (Server (LocalTxMonitor txid tx slot) 'NonPipelined st' m a)
 -> Server (LocalTxMonitor txid tx slot) 'NonPipelined st' m a)
-> m (Server (LocalTxMonitor txid tx slot) 'NonPipelined st' m a)
-> Server (LocalTxMonitor txid tx slot) 'NonPipelined st' m a
forall a b. (a -> b) -> a -> b
$ ServerStAcquiring txid tx slot m a
-> Server (LocalTxMonitor txid tx slot) 'NonPipelined st' m a
ServerStAcquiring txid tx slot m a
-> Server
     (LocalTxMonitor txid tx slot) 'NonPipelined 'StAcquiring m a
handleStAcquiring (ServerStAcquiring txid tx slot m a
 -> Server (LocalTxMonitor txid tx slot) 'NonPipelined st' m a)
-> m (ServerStAcquiring txid tx slot m a)
-> m (Server (LocalTxMonitor txid tx slot) 'NonPipelined st' 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'
R:MessageLocalTxMonitorfromto
  (*) (*) (*) txid tx slot 'StAcquired st'
MsgRelease ->
            m (Server (LocalTxMonitor txid tx slot) 'NonPipelined st' m a)
-> Server (LocalTxMonitor txid tx slot) 'NonPipelined st' m a
forall ps (pl :: IsPipelined) (st :: ps) (m :: * -> *) a.
m (Server ps pl st m a) -> Server ps pl st m a
Effect (m (Server (LocalTxMonitor txid tx slot) 'NonPipelined st' m a)
 -> Server (LocalTxMonitor txid tx slot) 'NonPipelined st' m a)
-> m (Server (LocalTxMonitor txid tx slot) 'NonPipelined st' m a)
-> Server (LocalTxMonitor txid tx slot) 'NonPipelined st' m a
forall a b. (a -> b) -> a -> b
$ ServerStIdle txid tx slot m a
-> Server (LocalTxMonitor txid tx slot) 'NonPipelined st' m a
ServerStIdle txid tx slot m a
-> Server (LocalTxMonitor txid tx slot) 'NonPipelined 'StIdle m a
handleStIdle (ServerStIdle txid tx slot m a
 -> Server (LocalTxMonitor txid tx slot) 'NonPipelined st' m a)
-> m (ServerStIdle txid tx slot m a)
-> m (Server (LocalTxMonitor txid tx slot) 'NonPipelined st' 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
      -> Server (LocalTxMonitor txid tx slot) NonPipelined (StBusy NextTx) m a
    handleNextTx :: ServerStBusy 'NextTx txid tx slot m a
-> Server
     (LocalTxMonitor txid tx slot) 'NonPipelined ('StBusy 'NextTx) m a
handleNextTx = \case
      SendMsgReplyNextTx Maybe tx
tx ServerStAcquired txid tx slot m a
serverStAcquired ->
        Message (LocalTxMonitor txid tx slot) ('StBusy 'NextTx) 'StAcquired
-> Server
     (LocalTxMonitor txid tx slot) 'NonPipelined 'StAcquired m a
-> Server
     (LocalTxMonitor txid tx slot) 'NonPipelined ('StBusy 'NextTx) m a
forall ps (pl :: IsPipelined) (st :: ps) (m :: * -> *) a
       (st' :: ps).
(StateTokenI st, StateTokenI st', StateAgency st ~ 'ServerAgency,
 Outstanding pl ~ 'Z) =>
Message ps st st' -> Server ps pl st' m a -> Server ps pl st m a
Yield (Maybe tx
-> Message
     (LocalTxMonitor txid tx slot) ('StBusy 'NextTx) 'StAcquired
forall {k} {k2} tx1 (txid :: k) (slot :: k2).
Maybe tx1
-> Message
     (LocalTxMonitor txid tx1 slot) ('StBusy 'NextTx) 'StAcquired
MsgReplyNextTx Maybe tx
tx) (Server (LocalTxMonitor txid tx slot) 'NonPipelined 'StAcquired m a
 -> Server
      (LocalTxMonitor txid tx slot) 'NonPipelined ('StBusy 'NextTx) m a)
-> Server
     (LocalTxMonitor txid tx slot) 'NonPipelined 'StAcquired m a
-> Server
     (LocalTxMonitor txid tx slot) 'NonPipelined ('StBusy 'NextTx) m a
forall a b. (a -> b) -> a -> b
$
          ServerStAcquired txid tx slot m a
-> Server
     (LocalTxMonitor txid tx slot) 'NonPipelined 'StAcquired m a
handleStAcquired ServerStAcquired txid tx slot m a
serverStAcquired

    handleHasTx ::
         ServerStBusy HasTx txid tx slot m a
      -> Server (LocalTxMonitor txid tx slot) NonPipelined (StBusy HasTx) m a
    handleHasTx :: ServerStBusy 'HasTx txid tx slot m a
-> Server
     (LocalTxMonitor txid tx slot) 'NonPipelined ('StBusy 'HasTx) m a
handleHasTx = \case
      SendMsgReplyHasTx Bool
res ServerStAcquired txid tx slot m a
serverStAcquired ->
        Message (LocalTxMonitor txid tx slot) ('StBusy 'HasTx) 'StAcquired
-> Server
     (LocalTxMonitor txid tx slot) 'NonPipelined 'StAcquired m a
-> Server
     (LocalTxMonitor txid tx slot) 'NonPipelined ('StBusy 'HasTx) m a
forall ps (pl :: IsPipelined) (st :: ps) (m :: * -> *) a
       (st' :: ps).
(StateTokenI st, StateTokenI st', StateAgency st ~ 'ServerAgency,
 Outstanding pl ~ 'Z) =>
Message ps st st' -> Server ps pl st' m a -> Server ps pl st m a
Yield (Bool
-> Message
     (LocalTxMonitor txid tx slot) ('StBusy 'HasTx) 'StAcquired
forall {k} {k1} {k2} (txid :: k) (tx :: k1) (slot :: k2).
Bool
-> Message
     (LocalTxMonitor txid tx slot) ('StBusy 'HasTx) 'StAcquired
MsgReplyHasTx Bool
res) (Server (LocalTxMonitor txid tx slot) 'NonPipelined 'StAcquired m a
 -> Server
      (LocalTxMonitor txid tx slot) 'NonPipelined ('StBusy 'HasTx) m a)
-> Server
     (LocalTxMonitor txid tx slot) 'NonPipelined 'StAcquired m a
-> Server
     (LocalTxMonitor txid tx slot) 'NonPipelined ('StBusy 'HasTx) m a
forall a b. (a -> b) -> a -> b
$
          ServerStAcquired txid tx slot m a
-> Server
     (LocalTxMonitor txid tx slot) 'NonPipelined 'StAcquired m a
handleStAcquired ServerStAcquired txid tx slot m a
serverStAcquired

    handleGetSizes ::
         ServerStBusy GetSizes txid tx slot m a
      -> Server (LocalTxMonitor txid tx slot) NonPipelined (StBusy GetSizes) m a
    handleGetSizes :: ServerStBusy 'GetSizes txid tx slot m a
-> Server
     (LocalTxMonitor txid tx slot) 'NonPipelined ('StBusy 'GetSizes) m a
handleGetSizes = \case
      SendMsgReplyGetSizes MempoolSizeAndCapacity
sizes ServerStAcquired txid tx slot m a
serverStAcquired ->
        Message
  (LocalTxMonitor txid tx slot) ('StBusy 'GetSizes) 'StAcquired
-> Server
     (LocalTxMonitor txid tx slot) 'NonPipelined 'StAcquired m a
-> Server
     (LocalTxMonitor txid tx slot) 'NonPipelined ('StBusy 'GetSizes) m a
forall ps (pl :: IsPipelined) (st :: ps) (m :: * -> *) a
       (st' :: ps).
(StateTokenI st, StateTokenI st', StateAgency st ~ 'ServerAgency,
 Outstanding pl ~ 'Z) =>
Message ps st st' -> Server ps pl st' m a -> Server ps pl st m a
Yield (MempoolSizeAndCapacity
-> Message
     (LocalTxMonitor txid tx slot) ('StBusy 'GetSizes) 'StAcquired
forall {k} {k1} {k2} (txid :: k) (tx :: k1) (slot :: k2).
MempoolSizeAndCapacity
-> Message
     (LocalTxMonitor txid tx slot) ('StBusy 'GetSizes) 'StAcquired
MsgReplyGetSizes MempoolSizeAndCapacity
sizes) (Server (LocalTxMonitor txid tx slot) 'NonPipelined 'StAcquired m a
 -> Server
      (LocalTxMonitor txid tx slot)
      'NonPipelined
      ('StBusy 'GetSizes)
      m
      a)
-> Server
     (LocalTxMonitor txid tx slot) 'NonPipelined 'StAcquired m a
-> Server
     (LocalTxMonitor txid tx slot) 'NonPipelined ('StBusy 'GetSizes) m a
forall a b. (a -> b) -> a -> b
$
          ServerStAcquired txid tx slot m a
-> Server
     (LocalTxMonitor txid tx slot) 'NonPipelined 'StAcquired m a
handleStAcquired ServerStAcquired txid tx slot m a
serverStAcquired