{-# LANGUAGE DataKinds           #-}
{-# LANGUAGE GADTs               #-}
{-# LANGUAGE NamedFieldPuns      #-}
{-# LANGUAGE RankNTypes          #-}
{-# LANGUAGE RecordWildCards     #-}
{-# LANGUAGE ScopedTypeVariables #-}

-- | A view of the transaction submission protocol from the point of view of
-- the client.
--
-- This provides a view that uses less complex types and should be easier to
-- use than the underlying typed protocol itself.
--
-- For execution, 'txSubmissionClientPeer' is provided for conversion
-- into the typed protocol.
--
module Ouroboros.Network.Protocol.TxSubmission2.Client
  ( -- * Protocol type for the client
    -- | The protocol states from the point of view of the client.
    TxSubmissionClient (..)
  , ClientStIdle (..)
  , ClientStTxIds (..)
  , ClientStTxs (..)
  , TxSizeInBytes
  , TokBlockingStyle (..)
  , BlockingReplyList (..)
    -- * Execution as a typed protocol
  , txSubmissionClientPeer
  ) where

import           Data.Word (Word16)

import           Network.TypedProtocol.Core

import           Ouroboros.Network.Protocol.TxSubmission2.Type


-- | The client side of the transaction submission protocol.
--
-- The peer in the client role submits transactions to the peer in the server
-- role.
--
newtype TxSubmissionClient txid tx m a = TxSubmissionClient {
    TxSubmissionClient txid tx m a -> m (ClientStIdle txid tx m a)
runTxSubmissionClient :: m (ClientStIdle txid tx m a)
  }

-- | In the 'StIdle' protocol state, the client does not have agency. Instead
-- it is waiting for:
--
-- * a request for transaction ids (blocking or non-blocking)
-- * a request for a given list of transactions
-- * a termination message
--
-- It must be prepared to handle any of these.
--
data ClientStIdle txid tx m a = ClientStIdle {

    ClientStIdle txid tx m a
-> forall (blocking :: StBlockingStyle).
   TokBlockingStyle blocking
   -> Word16 -> Word16 -> m (ClientStTxIds blocking txid tx m a)
recvMsgRequestTxIds      :: forall blocking.
                                TokBlockingStyle blocking
                             -> Word16
                             -> Word16
                             -> m (ClientStTxIds blocking txid tx m a),

    ClientStIdle txid tx m a -> [txid] -> m (ClientStTxs txid tx m a)
recvMsgRequestTxs        :: [txid]
                             -> m (ClientStTxs txid tx m a)
  }

data ClientStTxIds blocking txid tx m a where
  SendMsgReplyTxIds :: BlockingReplyList blocking (txid, TxSizeInBytes)
                    -> ClientStIdle           txid tx m a
                    -> ClientStTxIds blocking txid tx m a

  -- | In the blocking case, the client can terminate the protocol. This could
  -- be used when the client knows there will be no more transactions to submit.
  --
  SendMsgDone       :: a -> ClientStTxIds StBlocking txid tx m a


data ClientStTxs txid tx m a where
  SendMsgReplyTxs   :: [tx]
                    -> ClientStIdle txid tx m a
                    -> ClientStTxs  txid tx m a


-- | A non-pipelined 'Peer' representing the 'TxSubmissionClient'.
--
txSubmissionClientPeer :: forall txid tx m a. Monad m
                       => TxSubmissionClient txid tx m a
                       -> Peer (TxSubmission2 txid tx) AsClient StInit m a
txSubmissionClientPeer :: TxSubmissionClient txid tx m a
-> Peer (TxSubmission2 txid tx) 'AsClient 'StInit m a
txSubmissionClientPeer (TxSubmissionClient m (ClientStIdle txid tx m a)
client) =
    WeHaveAgency 'AsClient 'StInit
-> Message (TxSubmission2 txid tx) 'StInit 'StIdle
-> Peer (TxSubmission2 txid tx) 'AsClient 'StIdle m a
-> Peer (TxSubmission2 txid tx) 'AsClient 'StInit 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 (ClientHasAgency 'StInit -> WeHaveAgency 'AsClient 'StInit
forall ps (st :: ps).
ClientHasAgency st -> PeerHasAgency 'AsClient st
ClientAgency ClientHasAgency 'StInit
forall k k (txid :: k) (tx :: k). ClientHasAgency 'StInit
TokInit) Message (TxSubmission2 txid tx) 'StInit 'StIdle
forall k k (txid :: k) (tx :: k).
Message (TxSubmission2 txid tx) 'StInit 'StIdle
MsgInit (Peer (TxSubmission2 txid tx) 'AsClient 'StIdle m a
 -> Peer (TxSubmission2 txid tx) 'AsClient 'StInit m a)
-> Peer (TxSubmission2 txid tx) 'AsClient 'StIdle m a
-> Peer (TxSubmission2 txid tx) 'AsClient 'StInit m a
forall a b. (a -> b) -> a -> b
$
    m (Peer (TxSubmission2 txid tx) 'AsClient 'StIdle m a)
-> Peer (TxSubmission2 txid tx) 'AsClient '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 (TxSubmission2 txid tx) 'AsClient 'StIdle m a)
 -> Peer (TxSubmission2 txid tx) 'AsClient 'StIdle m a)
-> m (Peer (TxSubmission2 txid tx) 'AsClient 'StIdle m a)
-> Peer (TxSubmission2 txid tx) 'AsClient 'StIdle m a
forall a b. (a -> b) -> a -> b
$ ClientStIdle txid tx m a
-> Peer (TxSubmission2 txid tx) 'AsClient 'StIdle m a
go (ClientStIdle txid tx m a
 -> Peer (TxSubmission2 txid tx) 'AsClient 'StIdle m a)
-> m (ClientStIdle txid tx m a)
-> m (Peer (TxSubmission2 txid tx) 'AsClient 'StIdle m a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (ClientStIdle txid tx m a)
client
  where
    go :: ClientStIdle txid tx m a
       -> Peer (TxSubmission2 txid tx) AsClient StIdle m a
    go :: ClientStIdle txid tx m a
-> Peer (TxSubmission2 txid tx) 'AsClient 'StIdle m a
go ClientStIdle {forall (blocking :: StBlockingStyle).
TokBlockingStyle blocking
-> Word16 -> Word16 -> m (ClientStTxIds blocking txid tx m a)
recvMsgRequestTxIds :: forall (blocking :: StBlockingStyle).
TokBlockingStyle blocking
-> Word16 -> Word16 -> m (ClientStTxIds blocking txid tx m a)
recvMsgRequestTxIds :: forall txid tx (m :: * -> *) a.
ClientStIdle txid tx m a
-> forall (blocking :: StBlockingStyle).
   TokBlockingStyle blocking
   -> Word16 -> Word16 -> m (ClientStTxIds blocking txid tx m a)
recvMsgRequestTxIds, [txid] -> m (ClientStTxs txid tx m a)
recvMsgRequestTxs :: [txid] -> m (ClientStTxs txid tx m a)
recvMsgRequestTxs :: forall txid tx (m :: * -> *) a.
ClientStIdle txid tx m a -> [txid] -> m (ClientStTxs txid tx m a)
recvMsgRequestTxs} =
      TheyHaveAgency 'AsClient 'StIdle
-> (forall (st' :: TxSubmission2 txid tx).
    Message (TxSubmission2 txid tx) 'StIdle st'
    -> Peer (TxSubmission2 txid tx) 'AsClient st' m a)
-> Peer (TxSubmission2 txid tx) 'AsClient '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 (ServerHasAgency 'StIdle -> PeerHasAgency 'AsServer 'StIdle
forall ps (st :: ps).
ServerHasAgency st -> PeerHasAgency 'AsServer st
ServerAgency ServerHasAgency 'StIdle
forall k k (txid :: k) (tx :: k). ServerHasAgency 'StIdle
TokIdle) ((forall (st' :: TxSubmission2 txid tx).
  Message (TxSubmission2 txid tx) 'StIdle st'
  -> Peer (TxSubmission2 txid tx) 'AsClient st' m a)
 -> Peer (TxSubmission2 txid tx) 'AsClient 'StIdle m a)
-> (forall (st' :: TxSubmission2 txid tx).
    Message (TxSubmission2 txid tx) 'StIdle st'
    -> Peer (TxSubmission2 txid tx) 'AsClient st' m a)
-> Peer (TxSubmission2 txid tx) 'AsClient 'StIdle m a
forall a b. (a -> b) -> a -> b
$ \Message (TxSubmission2 txid tx) 'StIdle st'
msg -> case Message (TxSubmission2 txid tx) 'StIdle st'
msg of
        MsgRequestTxIds blocking ackNo reqNo -> m (Peer (TxSubmission2 txid tx) 'AsClient ('StTxIds blocking) m a)
-> Peer (TxSubmission2 txid tx) 'AsClient ('StTxIds blocking) 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 (TxSubmission2 txid tx) 'AsClient ('StTxIds blocking) m a)
 -> Peer (TxSubmission2 txid tx) 'AsClient ('StTxIds blocking) m a)
-> m (Peer
        (TxSubmission2 txid tx) 'AsClient ('StTxIds blocking) m a)
-> Peer (TxSubmission2 txid tx) 'AsClient ('StTxIds blocking) m a
forall a b. (a -> b) -> a -> b
$ do
          ClientStTxIds blocking txid tx m a
reply <- TokBlockingStyle blocking
-> Word16 -> Word16 -> m (ClientStTxIds blocking txid tx m a)
forall (blocking :: StBlockingStyle).
TokBlockingStyle blocking
-> Word16 -> Word16 -> m (ClientStTxIds blocking txid tx m a)
recvMsgRequestTxIds TokBlockingStyle blocking
blocking Word16
ackNo Word16
reqNo
          case ClientStTxIds blocking txid tx m a
reply of
            SendMsgReplyTxIds BlockingReplyList blocking (txid, TxSizeInBytes)
txids ClientStIdle txid tx m a
k ->
              Peer (TxSubmission2 txid tx) 'AsClient ('StTxIds blocking) m a
-> m (Peer
        (TxSubmission2 txid tx) 'AsClient ('StTxIds blocking) m a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Peer (TxSubmission2 txid tx) 'AsClient ('StTxIds blocking) m a
 -> m (Peer
         (TxSubmission2 txid tx) 'AsClient ('StTxIds blocking) m a))
-> Peer (TxSubmission2 txid tx) 'AsClient ('StTxIds blocking) m a
-> m (Peer
        (TxSubmission2 txid tx) 'AsClient ('StTxIds blocking) m a)
forall a b. (a -> b) -> a -> b
$ WeHaveAgency 'AsClient ('StTxIds blocking)
-> Message (TxSubmission2 txid tx) ('StTxIds blocking) 'StIdle
-> Peer (TxSubmission2 txid tx) 'AsClient 'StIdle m a
-> Peer (TxSubmission2 txid tx) 'AsClient ('StTxIds blocking) 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 (ClientHasAgency ('StTxIds blocking)
-> WeHaveAgency 'AsClient ('StTxIds blocking)
forall ps (st :: ps).
ClientHasAgency st -> PeerHasAgency 'AsClient st
ClientAgency (TokBlockingStyle blocking -> ClientHasAgency ('StTxIds blocking)
forall k k (txid :: k) (tx :: k) (b :: StBlockingStyle).
TokBlockingStyle b -> ClientHasAgency ('StTxIds b)
TokTxIds TokBlockingStyle blocking
blocking))
                             (BlockingReplyList blocking (txid, TxSizeInBytes)
-> Message (TxSubmission2 txid tx) ('StTxIds blocking) 'StIdle
forall k (blocking :: StBlockingStyle) txid (tx :: k).
BlockingReplyList blocking (txid, TxSizeInBytes)
-> Message (TxSubmission2 txid tx) ('StTxIds blocking) 'StIdle
MsgReplyTxIds BlockingReplyList blocking (txid, TxSizeInBytes)
txids)
                             (ClientStIdle txid tx m a
-> Peer (TxSubmission2 txid tx) 'AsClient 'StIdle m a
go ClientStIdle txid tx m a
k)

            SendMsgDone a
result ->
              Peer (TxSubmission2 txid tx) 'AsClient ('StTxIds 'StBlocking) m a
-> m (Peer
        (TxSubmission2 txid tx) 'AsClient ('StTxIds 'StBlocking) m a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Peer (TxSubmission2 txid tx) 'AsClient ('StTxIds 'StBlocking) m a
 -> m (Peer
         (TxSubmission2 txid tx) 'AsClient ('StTxIds 'StBlocking) m a))
-> Peer
     (TxSubmission2 txid tx) 'AsClient ('StTxIds 'StBlocking) m a
-> m (Peer
        (TxSubmission2 txid tx) 'AsClient ('StTxIds 'StBlocking) m a)
forall a b. (a -> b) -> a -> b
$ WeHaveAgency 'AsClient ('StTxIds 'StBlocking)
-> Message (TxSubmission2 txid tx) ('StTxIds 'StBlocking) 'StDone
-> Peer (TxSubmission2 txid tx) 'AsClient 'StDone m a
-> Peer
     (TxSubmission2 txid tx) 'AsClient ('StTxIds 'StBlocking) 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 (ClientHasAgency ('StTxIds 'StBlocking)
-> WeHaveAgency 'AsClient ('StTxIds 'StBlocking)
forall ps (st :: ps).
ClientHasAgency st -> PeerHasAgency 'AsClient st
ClientAgency (TokBlockingStyle 'StBlocking
-> ClientHasAgency ('StTxIds 'StBlocking)
forall k k (txid :: k) (tx :: k) (b :: StBlockingStyle).
TokBlockingStyle b -> ClientHasAgency ('StTxIds b)
TokTxIds TokBlockingStyle 'StBlocking
TokBlocking))
                              Message (TxSubmission2 txid tx) ('StTxIds 'StBlocking) 'StDone
forall k k (txid :: k) (tx :: k).
Message (TxSubmission2 txid tx) ('StTxIds 'StBlocking) 'StDone
MsgDone
                             (NobodyHasAgency 'StDone
-> a -> Peer (TxSubmission2 txid tx) 'AsClient '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 (txid :: k) (tx :: k). NobodyHasAgency 'StDone
TokDone a
result)

        MsgRequestTxs txids -> m (Peer (TxSubmission2 txid tx) 'AsClient 'StTxs m a)
-> Peer (TxSubmission2 txid tx) 'AsClient 'StTxs 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 (TxSubmission2 txid tx) 'AsClient 'StTxs m a)
 -> Peer (TxSubmission2 txid tx) 'AsClient 'StTxs m a)
-> m (Peer (TxSubmission2 txid tx) 'AsClient 'StTxs m a)
-> Peer (TxSubmission2 txid tx) 'AsClient 'StTxs m a
forall a b. (a -> b) -> a -> b
$ do
          SendMsgReplyTxs [tx]
txs ClientStIdle txid tx m a
k <- [txid] -> m (ClientStTxs txid tx m a)
recvMsgRequestTxs [txid]
[txid]
txids
          Peer (TxSubmission2 txid tx) 'AsClient 'StTxs m a
-> m (Peer (TxSubmission2 txid tx) 'AsClient 'StTxs m a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Peer (TxSubmission2 txid tx) 'AsClient 'StTxs m a
 -> m (Peer (TxSubmission2 txid tx) 'AsClient 'StTxs m a))
-> Peer (TxSubmission2 txid tx) 'AsClient 'StTxs m a
-> m (Peer (TxSubmission2 txid tx) 'AsClient 'StTxs m a)
forall a b. (a -> b) -> a -> b
$ WeHaveAgency 'AsClient 'StTxs
-> Message (TxSubmission2 txid tx) 'StTxs 'StIdle
-> Peer (TxSubmission2 txid tx) 'AsClient 'StIdle m a
-> Peer (TxSubmission2 txid tx) 'AsClient 'StTxs 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 (ClientHasAgency 'StTxs -> WeHaveAgency 'AsClient 'StTxs
forall ps (st :: ps).
ClientHasAgency st -> PeerHasAgency 'AsClient st
ClientAgency ClientHasAgency 'StTxs
forall k k (txid :: k) (tx :: k). ClientHasAgency 'StTxs
TokTxs)
                         ([tx] -> Message (TxSubmission2 txid tx) 'StTxs 'StIdle
forall k tx (txid :: k).
[tx] -> Message (TxSubmission2 txid tx) 'StTxs 'StIdle
MsgReplyTxs [tx]
txs)
                         (ClientStIdle txid tx m a
-> Peer (TxSubmission2 txid tx) 'AsClient 'StIdle m a
go ClientStIdle txid tx m a
k)