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

module Ouroboros.Network.Protocol.LocalTxSubmission.Examples
  ( localTxSubmissionClient
  , localTxSubmissionServer
  ) where

import Ouroboros.Network.Protocol.LocalTxSubmission.Client
import Ouroboros.Network.Protocol.LocalTxSubmission.Server



--
-- Example client
--

-- | An example @'LocalTxSubmissionClient'@ which submits a fixed list of
-- transactions. The result is those transactions annotated with whether they
-- were accepted or rejected.
--
localTxSubmissionClient
  :: forall tx reject m.
     Applicative m
  => [tx]
  -> LocalTxSubmissionClient tx reject m [(tx, SubmitResult reject)]
localTxSubmissionClient :: forall tx reject (m :: * -> *).
Applicative m =>
[tx]
-> LocalTxSubmissionClient tx reject m [(tx, SubmitResult reject)]
localTxSubmissionClient =
    m (LocalTxClientStIdle tx reject m [(tx, SubmitResult reject)])
-> LocalTxSubmissionClient tx reject m [(tx, SubmitResult reject)]
forall tx reject (m :: * -> *) a.
m (LocalTxClientStIdle tx reject m a)
-> LocalTxSubmissionClient tx reject m a
LocalTxSubmissionClient (m (LocalTxClientStIdle tx reject m [(tx, SubmitResult reject)])
 -> LocalTxSubmissionClient tx reject m [(tx, SubmitResult reject)])
-> ([tx]
    -> m (LocalTxClientStIdle tx reject m [(tx, SubmitResult reject)]))
-> [tx]
-> LocalTxSubmissionClient tx reject m [(tx, SubmitResult reject)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LocalTxClientStIdle tx reject m [(tx, SubmitResult reject)]
-> m (LocalTxClientStIdle tx reject m [(tx, SubmitResult reject)])
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (LocalTxClientStIdle tx reject m [(tx, SubmitResult reject)]
 -> m (LocalTxClientStIdle tx reject m [(tx, SubmitResult reject)]))
-> ([tx]
    -> LocalTxClientStIdle tx reject m [(tx, SubmitResult reject)])
-> [tx]
-> m (LocalTxClientStIdle tx reject m [(tx, SubmitResult reject)])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(tx, SubmitResult reject)]
-> [tx]
-> LocalTxClientStIdle tx reject m [(tx, SubmitResult reject)]
forall {m :: * -> *} {a} {reject}.
Applicative m =>
[(a, SubmitResult reject)]
-> [a] -> LocalTxClientStIdle a reject m [(a, SubmitResult reject)]
client []
  where
    client :: [(a, SubmitResult reject)]
-> [a] -> LocalTxClientStIdle a reject m [(a, SubmitResult reject)]
client [(a, SubmitResult reject)]
acc [] =
      [(a, SubmitResult reject)]
-> LocalTxClientStIdle a reject m [(a, SubmitResult reject)]
forall a tx reject (m :: * -> *).
a -> LocalTxClientStIdle tx reject m a
SendMsgDone ([(a, SubmitResult reject)] -> [(a, SubmitResult reject)]
forall a. [a] -> [a]
reverse [(a, SubmitResult reject)]
acc)

    client [(a, SubmitResult reject)]
acc (a
tx:[a]
txs) =
      a
-> (SubmitResult reject
    -> m (LocalTxClientStIdle a reject m [(a, SubmitResult reject)]))
-> LocalTxClientStIdle a reject m [(a, SubmitResult reject)]
forall tx reject (m :: * -> *) a.
tx
-> (SubmitResult reject -> m (LocalTxClientStIdle tx reject m a))
-> LocalTxClientStIdle tx reject m a
SendMsgSubmitTx a
tx ((SubmitResult reject
  -> m (LocalTxClientStIdle a reject m [(a, SubmitResult reject)]))
 -> LocalTxClientStIdle a reject m [(a, SubmitResult reject)])
-> (SubmitResult reject
    -> m (LocalTxClientStIdle a reject m [(a, SubmitResult reject)]))
-> LocalTxClientStIdle a reject m [(a, SubmitResult reject)]
forall a b. (a -> b) -> a -> b
$ \SubmitResult reject
mreject -> LocalTxClientStIdle a reject m [(a, SubmitResult reject)]
-> m (LocalTxClientStIdle a reject m [(a, SubmitResult reject)])
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([(a, SubmitResult reject)]
-> [a] -> LocalTxClientStIdle a reject m [(a, SubmitResult reject)]
client ((a
tx, SubmitResult reject
mreject)(a, SubmitResult reject)
-> [(a, SubmitResult reject)] -> [(a, SubmitResult reject)]
forall a. a -> [a] -> [a]
:[(a, SubmitResult reject)]
acc) [a]
txs)


--
-- Example server
--

localTxSubmissionServer
  :: forall tx reject m.
     Applicative m
  => (tx -> SubmitResult reject)
  -> LocalTxSubmissionServer tx reject m [(tx, SubmitResult reject)]
localTxSubmissionServer :: forall tx reject (m :: * -> *).
Applicative m =>
(tx -> SubmitResult reject)
-> LocalTxSubmissionServer tx reject m [(tx, SubmitResult reject)]
localTxSubmissionServer tx -> SubmitResult reject
p =
    [(tx, SubmitResult reject)]
-> LocalTxSubmissionServer tx reject m [(tx, SubmitResult reject)]
server []
  where
    server :: [(tx, SubmitResult reject)]
-> LocalTxSubmissionServer tx reject m [(tx, SubmitResult reject)]
server [(tx, SubmitResult reject)]
acc = LocalTxSubmissionServer {
      recvMsgSubmitTx :: tx
-> m (SubmitResult reject,
      LocalTxSubmissionServer tx reject m [(tx, SubmitResult reject)])
recvMsgSubmitTx = \tx
tx ->
        let mreject :: SubmitResult reject
mreject = tx -> SubmitResult reject
p tx
tx in
        (SubmitResult reject,
 LocalTxSubmissionServer tx reject m [(tx, SubmitResult reject)])
-> m (SubmitResult reject,
      LocalTxSubmissionServer tx reject m [(tx, SubmitResult reject)])
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SubmitResult reject
mreject, [(tx, SubmitResult reject)]
-> LocalTxSubmissionServer tx reject m [(tx, SubmitResult reject)]
server ((tx
tx, SubmitResult reject
mreject) (tx, SubmitResult reject)
-> [(tx, SubmitResult reject)] -> [(tx, SubmitResult reject)]
forall a. a -> [a] -> [a]
: [(tx, SubmitResult reject)]
acc)),

      recvMsgDone :: [(tx, SubmitResult reject)]
recvMsgDone = [(tx, SubmitResult reject)] -> [(tx, SubmitResult reject)]
forall a. [a] -> [a]
reverse [(tx, SubmitResult reject)]
acc
    }