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

module Ouroboros.Network.Protocol.LocalTxMonitor.Examples
  ( localTxMonitorClient
  , localTxMonitorServer
  ) where

import Data.List (find)
import Data.Maybe (isJust)

import Ouroboros.Network.Protocol.LocalTxMonitor.Client
import Ouroboros.Network.Protocol.LocalTxMonitor.Server
import Ouroboros.Network.Protocol.LocalTxMonitor.Type

-- | An example client which acquire a snapshot from the server and fetches all transactions
-- from it, and check presence of each of these transactions.
--
localTxMonitorClient ::
     forall txid tx slot m.
     ( Applicative m
     )
  => (tx -> txid)
  -> LocalTxMonitorClient txid tx slot m ([(tx, Bool)], MempoolSizeAndCapacity)
localTxMonitorClient :: forall txid tx slot (m :: * -> *).
Applicative m =>
(tx -> txid)
-> LocalTxMonitorClient
     txid tx slot m ([(tx, Bool)], MempoolSizeAndCapacity)
localTxMonitorClient tx -> txid
txId =
    m (ClientStIdle
     txid tx slot m ([(tx, Bool)], MempoolSizeAndCapacity))
-> LocalTxMonitorClient
     txid tx slot m ([(tx, Bool)], MempoolSizeAndCapacity)
forall txid tx slot (m :: * -> *) a.
m (ClientStIdle txid tx slot m a)
-> LocalTxMonitorClient txid tx slot m a
LocalTxMonitorClient (ClientStIdle txid tx slot m ([(tx, Bool)], MempoolSizeAndCapacity)
-> m (ClientStIdle
        txid tx slot m ([(tx, Bool)], MempoolSizeAndCapacity))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ClientStIdle txid tx slot m ([(tx, Bool)], MempoolSizeAndCapacity)
clientStIdle)
  where
    clientStIdle ::
      ClientStIdle txid tx slot m ([(tx, Bool)], MempoolSizeAndCapacity)
    clientStIdle :: ClientStIdle txid tx slot m ([(tx, Bool)], MempoolSizeAndCapacity)
clientStIdle =
      (slot
 -> m (ClientStAcquired
         txid tx slot m ([(tx, Bool)], MempoolSizeAndCapacity)))
-> ClientStIdle
     txid tx slot m ([(tx, Bool)], MempoolSizeAndCapacity)
forall slot (m :: * -> *) txid tx a.
(slot -> m (ClientStAcquired txid tx slot m a))
-> ClientStIdle txid tx slot m a
SendMsgAcquire ((slot
  -> m (ClientStAcquired
          txid tx slot m ([(tx, Bool)], MempoolSizeAndCapacity)))
 -> ClientStIdle
      txid tx slot m ([(tx, Bool)], MempoolSizeAndCapacity))
-> (slot
    -> m (ClientStAcquired
            txid tx slot m ([(tx, Bool)], MempoolSizeAndCapacity)))
-> ClientStIdle
     txid tx slot m ([(tx, Bool)], MempoolSizeAndCapacity)
forall a b. (a -> b) -> a -> b
$ \slot
_slot ->
        ClientStAcquired
  txid tx slot m ([(tx, Bool)], MempoolSizeAndCapacity)
-> m (ClientStAcquired
        txid tx slot m ([(tx, Bool)], MempoolSizeAndCapacity))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ClientStAcquired
   txid tx slot m ([(tx, Bool)], MempoolSizeAndCapacity)
 -> m (ClientStAcquired
         txid tx slot m ([(tx, Bool)], MempoolSizeAndCapacity)))
-> ClientStAcquired
     txid tx slot m ([(tx, Bool)], MempoolSizeAndCapacity)
-> m (ClientStAcquired
        txid tx slot m ([(tx, Bool)], MempoolSizeAndCapacity))
forall a b. (a -> b) -> a -> b
$ [(tx, Bool)]
-> ClientStAcquired
     txid tx slot m ([(tx, Bool)], MempoolSizeAndCapacity)
clientStAcquired []

    clientStAcquired ::
         [(tx, Bool)]
      -> ClientStAcquired txid tx slot m ([(tx, Bool)], MempoolSizeAndCapacity)
    clientStAcquired :: [(tx, Bool)]
-> ClientStAcquired
     txid tx slot m ([(tx, Bool)], MempoolSizeAndCapacity)
clientStAcquired [(tx, Bool)]
txs =
      (Maybe tx
 -> m (ClientStAcquired
         txid tx slot m ([(tx, Bool)], MempoolSizeAndCapacity)))
-> ClientStAcquired
     txid tx slot m ([(tx, Bool)], MempoolSizeAndCapacity)
forall tx (m :: * -> *) txid slot a.
(Maybe tx -> m (ClientStAcquired txid tx slot m a))
-> ClientStAcquired txid tx slot m a
SendMsgNextTx ((Maybe tx
  -> m (ClientStAcquired
          txid tx slot m ([(tx, Bool)], MempoolSizeAndCapacity)))
 -> ClientStAcquired
      txid tx slot m ([(tx, Bool)], MempoolSizeAndCapacity))
-> (Maybe tx
    -> m (ClientStAcquired
            txid tx slot m ([(tx, Bool)], MempoolSizeAndCapacity)))
-> ClientStAcquired
     txid tx slot m ([(tx, Bool)], MempoolSizeAndCapacity)
forall a b. (a -> b) -> a -> b
$ \case
        Maybe tx
Nothing -> do
          ClientStAcquired
  txid tx slot m ([(tx, Bool)], MempoolSizeAndCapacity)
-> m (ClientStAcquired
        txid tx slot m ([(tx, Bool)], MempoolSizeAndCapacity))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ClientStAcquired
   txid tx slot m ([(tx, Bool)], MempoolSizeAndCapacity)
 -> m (ClientStAcquired
         txid tx slot m ([(tx, Bool)], MempoolSizeAndCapacity)))
-> ClientStAcquired
     txid tx slot m ([(tx, Bool)], MempoolSizeAndCapacity)
-> m (ClientStAcquired
        txid tx slot m ([(tx, Bool)], MempoolSizeAndCapacity))
forall a b. (a -> b) -> a -> b
$ (MempoolSizeAndCapacity
 -> m (ClientStAcquired
         txid tx slot m ([(tx, Bool)], MempoolSizeAndCapacity)))
-> ClientStAcquired
     txid tx slot m ([(tx, Bool)], MempoolSizeAndCapacity)
forall (m :: * -> *) txid tx slot a.
(MempoolSizeAndCapacity -> m (ClientStAcquired txid tx slot m a))
-> ClientStAcquired txid tx slot m a
SendMsgGetSizes ((MempoolSizeAndCapacity
  -> m (ClientStAcquired
          txid tx slot m ([(tx, Bool)], MempoolSizeAndCapacity)))
 -> ClientStAcquired
      txid tx slot m ([(tx, Bool)], MempoolSizeAndCapacity))
-> (MempoolSizeAndCapacity
    -> m (ClientStAcquired
            txid tx slot m ([(tx, Bool)], MempoolSizeAndCapacity)))
-> ClientStAcquired
     txid tx slot m ([(tx, Bool)], MempoolSizeAndCapacity)
forall a b. (a -> b) -> a -> b
$ \MempoolSizeAndCapacity
sizes ->
            ClientStAcquired
  txid tx slot m ([(tx, Bool)], MempoolSizeAndCapacity)
-> m (ClientStAcquired
        txid tx slot m ([(tx, Bool)], MempoolSizeAndCapacity))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ClientStAcquired
   txid tx slot m ([(tx, Bool)], MempoolSizeAndCapacity)
 -> m (ClientStAcquired
         txid tx slot m ([(tx, Bool)], MempoolSizeAndCapacity)))
-> ClientStAcquired
     txid tx slot m ([(tx, Bool)], MempoolSizeAndCapacity)
-> m (ClientStAcquired
        txid tx slot m ([(tx, Bool)], MempoolSizeAndCapacity))
forall a b. (a -> b) -> a -> b
$ m (ClientStIdle
     txid tx slot m ([(tx, Bool)], MempoolSizeAndCapacity))
-> ClientStAcquired
     txid tx slot m ([(tx, Bool)], MempoolSizeAndCapacity)
forall (m :: * -> *) txid tx slot a.
m (ClientStIdle txid tx slot m a)
-> ClientStAcquired txid tx slot m a
SendMsgRelease (m (ClientStIdle
      txid tx slot m ([(tx, Bool)], MempoolSizeAndCapacity))
 -> ClientStAcquired
      txid tx slot m ([(tx, Bool)], MempoolSizeAndCapacity))
-> m (ClientStIdle
        txid tx slot m ([(tx, Bool)], MempoolSizeAndCapacity))
-> ClientStAcquired
     txid tx slot m ([(tx, Bool)], MempoolSizeAndCapacity)
forall a b. (a -> b) -> a -> b
$
              ClientStIdle txid tx slot m ([(tx, Bool)], MempoolSizeAndCapacity)
-> m (ClientStIdle
        txid tx slot m ([(tx, Bool)], MempoolSizeAndCapacity))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ClientStIdle txid tx slot m ([(tx, Bool)], MempoolSizeAndCapacity)
 -> m (ClientStIdle
         txid tx slot m ([(tx, Bool)], MempoolSizeAndCapacity)))
-> ClientStIdle
     txid tx slot m ([(tx, Bool)], MempoolSizeAndCapacity)
-> m (ClientStIdle
        txid tx slot m ([(tx, Bool)], MempoolSizeAndCapacity))
forall a b. (a -> b) -> a -> b
$ ([(tx, Bool)], MempoolSizeAndCapacity)
-> ClientStIdle
     txid tx slot m ([(tx, Bool)], MempoolSizeAndCapacity)
forall a txid tx slot (m :: * -> *).
a -> ClientStIdle txid tx slot m a
SendMsgDone ([(tx, Bool)] -> [(tx, Bool)]
forall a. [a] -> [a]
reverse [(tx, Bool)]
txs, MempoolSizeAndCapacity
sizes)
        Just tx
tx -> do
          ClientStAcquired
  txid tx slot m ([(tx, Bool)], MempoolSizeAndCapacity)
-> m (ClientStAcquired
        txid tx slot m ([(tx, Bool)], MempoolSizeAndCapacity))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ClientStAcquired
   txid tx slot m ([(tx, Bool)], MempoolSizeAndCapacity)
 -> m (ClientStAcquired
         txid tx slot m ([(tx, Bool)], MempoolSizeAndCapacity)))
-> ClientStAcquired
     txid tx slot m ([(tx, Bool)], MempoolSizeAndCapacity)
-> m (ClientStAcquired
        txid tx slot m ([(tx, Bool)], MempoolSizeAndCapacity))
forall a b. (a -> b) -> a -> b
$ txid
-> (Bool
    -> m (ClientStAcquired
            txid tx slot m ([(tx, Bool)], MempoolSizeAndCapacity)))
-> ClientStAcquired
     txid tx slot m ([(tx, Bool)], MempoolSizeAndCapacity)
forall txid (m :: * -> *) tx slot a.
txid
-> (Bool -> m (ClientStAcquired txid tx slot m a))
-> ClientStAcquired txid tx slot m a
SendMsgHasTx (tx -> txid
txId tx
tx) ((Bool
  -> m (ClientStAcquired
          txid tx slot m ([(tx, Bool)], MempoolSizeAndCapacity)))
 -> ClientStAcquired
      txid tx slot m ([(tx, Bool)], MempoolSizeAndCapacity))
-> (Bool
    -> m (ClientStAcquired
            txid tx slot m ([(tx, Bool)], MempoolSizeAndCapacity)))
-> ClientStAcquired
     txid tx slot m ([(tx, Bool)], MempoolSizeAndCapacity)
forall a b. (a -> b) -> a -> b
$ \Bool
result ->
            ClientStAcquired
  txid tx slot m ([(tx, Bool)], MempoolSizeAndCapacity)
-> m (ClientStAcquired
        txid tx slot m ([(tx, Bool)], MempoolSizeAndCapacity))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ClientStAcquired
   txid tx slot m ([(tx, Bool)], MempoolSizeAndCapacity)
 -> m (ClientStAcquired
         txid tx slot m ([(tx, Bool)], MempoolSizeAndCapacity)))
-> ClientStAcquired
     txid tx slot m ([(tx, Bool)], MempoolSizeAndCapacity)
-> m (ClientStAcquired
        txid tx slot m ([(tx, Bool)], MempoolSizeAndCapacity))
forall a b. (a -> b) -> a -> b
$ [(tx, Bool)]
-> ClientStAcquired
     txid tx slot m ([(tx, Bool)], MempoolSizeAndCapacity)
clientStAcquired ((tx
tx, Bool
result)(tx, Bool) -> [(tx, Bool)] -> [(tx, Bool)]
forall a. a -> [a] -> [a]
:[(tx, Bool)]
txs)

-- | An example server which streams predefined transactions to a client. The preset is the
-- only snapshot of the server, so acquiring/re-acquiring always yield the same transactions.
--
localTxMonitorServer ::
     forall txid tx slot m.
     ( Applicative m
     , Eq txid
     )
  => (tx -> txid)
  -> (slot, [tx])
  -> LocalTxMonitorServer txid tx slot m ()
localTxMonitorServer :: forall txid tx slot (m :: * -> *).
(Applicative m, Eq txid) =>
(tx -> txid)
-> (slot, [tx]) -> LocalTxMonitorServer txid tx slot m ()
localTxMonitorServer tx -> txid
txId (slot
slot, [tx]
allTxs) =
    m (ServerStIdle txid tx slot m ())
-> LocalTxMonitorServer txid tx slot m ()
forall txid tx slot (m :: * -> *) a.
m (ServerStIdle txid tx slot m a)
-> LocalTxMonitorServer txid tx slot m a
LocalTxMonitorServer (ServerStIdle txid tx slot m ()
-> m (ServerStIdle txid tx slot m ())
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ServerStIdle txid tx slot m ()
serverStIdle)
  where
    serverStIdle ::
      ServerStIdle txid tx slot m ()
    serverStIdle :: ServerStIdle txid tx slot m ()
serverStIdle =
      ServerStIdle
        { recvMsgDone :: m ()
recvMsgDone =
            () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
        , recvMsgAcquire :: m (ServerStAcquiring txid tx slot m ())
recvMsgAcquire =
            ServerStAcquiring txid tx slot m ()
-> m (ServerStAcquiring txid tx slot m ())
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ServerStAcquiring txid tx slot m ()
serverStAcquiring
        }

    serverStAcquiring ::
      ServerStAcquiring txid tx slot m ()
    serverStAcquiring :: ServerStAcquiring txid tx slot m ()
serverStAcquiring =
      slot
-> ServerStAcquired txid tx slot m ()
-> ServerStAcquiring txid tx slot m ()
forall slot txid tx (m :: * -> *) a.
slot
-> ServerStAcquired txid tx slot m a
-> ServerStAcquiring txid tx slot m a
SendMsgAcquired slot
slot ([tx] -> ServerStAcquired txid tx slot m ()
serverStAcquired [tx]
allTxs)

    serverStAcquired ::
         [tx]
      -> ServerStAcquired txid tx slot m ()
    serverStAcquired :: [tx] -> ServerStAcquired txid tx slot m ()
serverStAcquired [tx]
txs =
      ServerStAcquired
      { recvMsgAwaitAcquire :: m (ServerStAcquiring txid tx slot m ())
recvMsgAwaitAcquire =
          ServerStAcquiring txid tx slot m ()
-> m (ServerStAcquiring txid tx slot m ())
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ServerStAcquiring txid tx slot m ()
serverStAcquiring
      , recvMsgRelease :: m (ServerStIdle txid tx slot m ())
recvMsgRelease =
          ServerStIdle txid tx slot m ()
-> m (ServerStIdle txid tx slot m ())
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ServerStIdle txid tx slot m ()
serverStIdle
      , recvMsgNextTx :: m (ServerStBusy 'NextTx txid tx slot m ())
recvMsgNextTx =
          case [tx]
txs of
            []    -> ServerStBusy 'NextTx txid tx slot m ()
-> m (ServerStBusy 'NextTx txid tx slot m ())
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ServerStBusy 'NextTx txid tx slot m ()
 -> m (ServerStBusy 'NextTx txid tx slot m ()))
-> ServerStBusy 'NextTx txid tx slot m ()
-> m (ServerStBusy 'NextTx txid tx slot m ())
forall a b. (a -> b) -> a -> b
$ Maybe tx
-> ServerStAcquired txid tx slot m ()
-> ServerStBusy 'NextTx txid tx slot m ()
forall tx txid slot (m :: * -> *) a.
Maybe tx
-> ServerStAcquired txid tx slot m a
-> ServerStBusy 'NextTx txid tx slot m a
SendMsgReplyNextTx Maybe tx
forall a. Maybe a
Nothing ([tx] -> ServerStAcquired txid tx slot m ()
serverStAcquired [])
            (tx
h:[tx]
q) -> ServerStBusy 'NextTx txid tx slot m ()
-> m (ServerStBusy 'NextTx txid tx slot m ())
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ServerStBusy 'NextTx txid tx slot m ()
 -> m (ServerStBusy 'NextTx txid tx slot m ()))
-> ServerStBusy 'NextTx txid tx slot m ()
-> m (ServerStBusy 'NextTx txid tx slot m ())
forall a b. (a -> b) -> a -> b
$ Maybe tx
-> ServerStAcquired txid tx slot m ()
-> ServerStBusy 'NextTx txid tx slot m ()
forall tx txid slot (m :: * -> *) a.
Maybe tx
-> ServerStAcquired txid tx slot m a
-> ServerStBusy 'NextTx txid tx slot m a
SendMsgReplyNextTx (tx -> Maybe tx
forall a. a -> Maybe a
Just tx
h) ([tx] -> ServerStAcquired txid tx slot m ()
serverStAcquired [tx]
q)
      , recvMsgHasTx :: txid -> m (ServerStBusy 'HasTx txid tx slot m ())
recvMsgHasTx = \txid
ix ->
          let result :: Bool
result = Maybe tx -> Bool
forall a. Maybe a -> Bool
isJust (Maybe tx -> Bool) -> Maybe tx -> Bool
forall a b. (a -> b) -> a -> b
$ (tx -> Bool) -> [tx] -> Maybe tx
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((txid -> txid -> Bool
forall a. Eq a => a -> a -> Bool
== txid
ix) (txid -> Bool) -> (tx -> txid) -> tx -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. tx -> txid
txId) [tx]
allTxs
           in ServerStBusy 'HasTx txid tx slot m ()
-> m (ServerStBusy 'HasTx txid tx slot m ())
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ServerStBusy 'HasTx txid tx slot m ()
 -> m (ServerStBusy 'HasTx txid tx slot m ()))
-> ServerStBusy 'HasTx txid tx slot m ()
-> m (ServerStBusy 'HasTx txid tx slot m ())
forall a b. (a -> b) -> a -> b
$ Bool
-> ServerStAcquired txid tx slot m ()
-> ServerStBusy 'HasTx txid tx slot m ()
forall txid tx slot (m :: * -> *) a.
Bool
-> ServerStAcquired txid tx slot m a
-> ServerStBusy 'HasTx txid tx slot m a
SendMsgReplyHasTx Bool
result ([tx] -> ServerStAcquired txid tx slot m ()
serverStAcquired [tx]
txs)
      , recvMsgGetSizes :: m (ServerStBusy 'GetSizes txid tx slot m ())
recvMsgGetSizes =
          let sizes :: MempoolSizeAndCapacity
sizes = MempoolSizeAndCapacity
                { capacityInBytes :: Word32
capacityInBytes = Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([tx] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [tx]
allTxs)
                , sizeInBytes :: Word32
sizeInBytes     = Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([tx] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [tx]
allTxs)
                , numberOfTxs :: Word32
numberOfTxs     = Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([tx] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [tx]
allTxs)
                }
           in ServerStBusy 'GetSizes txid tx slot m ()
-> m (ServerStBusy 'GetSizes txid tx slot m ())
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ServerStBusy 'GetSizes txid tx slot m ()
 -> m (ServerStBusy 'GetSizes txid tx slot m ()))
-> ServerStBusy 'GetSizes txid tx slot m ()
-> m (ServerStBusy 'GetSizes txid tx slot m ())
forall a b. (a -> b) -> a -> b
$ MempoolSizeAndCapacity
-> ServerStAcquired txid tx slot m ()
-> ServerStBusy 'GetSizes txid tx slot m ()
forall txid tx slot (m :: * -> *) a.
MempoolSizeAndCapacity
-> ServerStAcquired txid tx slot m a
-> ServerStBusy 'GetSizes txid tx slot m a
SendMsgReplyGetSizes MempoolSizeAndCapacity
sizes ([tx] -> ServerStAcquired txid tx slot m ()
serverStAcquired [tx]
txs)
      }