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

module Ouroboros.Network.Protocol.TxSubmission2.Direct (directPipelined) where

import Network.TypedProtocol.Core
import Network.TypedProtocol.Proofs (Queue (..), enqueue)

import Ouroboros.Network.Protocol.TxSubmission2.Client
import Ouroboros.Network.Protocol.TxSubmission2.Server


directPipelined
  :: forall txid tx m a b.
     Monad m
  => TxSubmissionServerPipelined txid tx m a
  -> TxSubmissionClient          txid tx m b
  -> m (a, b)
directPipelined :: forall txid tx (m :: * -> *) a b.
Monad m =>
TxSubmissionServerPipelined txid tx m a
-> TxSubmissionClient txid tx m b -> m (a, b)
directPipelined (TxSubmissionServerPipelined m (ServerStIdle 'Z txid tx m a)
mserver)
                (TxSubmissionClient m (ClientStIdle txid tx m b)
mclient) = do
    server <- m (ServerStIdle 'Z txid tx m a)
mserver
    client <- mclient
    directSender EmptyQ server client
  where
    directSender :: forall (n :: N).
                    Queue        n (Collect txid tx)
                 -> ServerStIdle n txid tx m a
                 -> ClientStIdle   txid tx m b
                 -> m (a, b)
    directSender :: forall (n :: N).
Queue n (Collect txid tx)
-> ServerStIdle n txid tx m a
-> ClientStIdle txid tx m b
-> m (a, b)
directSender Queue n (Collect txid tx)
q (SendMsgRequestTxIdsBlocking NumTxIdsToAck
ackNo NumTxIdsToReq
reqNo m a
a NonEmpty (txid, SizeInBytes) -> m (ServerStIdle 'Z txid tx m a)
serverNext)
                   ClientStIdle{forall (blocking :: StBlockingStyle).
SingBlockingStyle blocking
-> NumTxIdsToAck
-> NumTxIdsToReq
-> m (ClientStTxIds blocking txid tx m b)
recvMsgRequestTxIds :: forall (blocking :: StBlockingStyle).
SingBlockingStyle blocking
-> NumTxIdsToAck
-> NumTxIdsToReq
-> m (ClientStTxIds blocking txid tx m b)
recvMsgRequestTxIds :: forall txid tx (m :: * -> *) a.
ClientStIdle txid tx m a
-> forall (blocking :: StBlockingStyle).
   SingBlockingStyle blocking
   -> NumTxIdsToAck
   -> NumTxIdsToReq
   -> m (ClientStTxIds blocking txid tx m a)
recvMsgRequestTxIds} = do
      reply <- SingBlockingStyle 'StBlocking
-> NumTxIdsToAck
-> NumTxIdsToReq
-> m (ClientStTxIds 'StBlocking txid tx m b)
forall (blocking :: StBlockingStyle).
SingBlockingStyle blocking
-> NumTxIdsToAck
-> NumTxIdsToReq
-> m (ClientStTxIds blocking txid tx m b)
recvMsgRequestTxIds SingBlockingStyle 'StBlocking
SingBlocking NumTxIdsToAck
ackNo NumTxIdsToReq
reqNo
      case reply of
        SendMsgReplyTxIds (BlockingReply NonEmpty (txid, SizeInBytes)
txids) ClientStIdle txid tx m b
client' -> do
          server' <- NonEmpty (txid, SizeInBytes) -> m (ServerStIdle 'Z txid tx m a)
serverNext NonEmpty (txid, SizeInBytes)
txids
          directSender q server' client'
        SendMsgDone b
b -> (,b
b) (a -> (a, b)) -> m a -> m (a, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m a
a

    directSender Queue n (Collect txid tx)
q (SendMsgRequestTxIdsPipelined NumTxIdsToAck
ackNo NumTxIdsToReq
reqNo m (ServerStIdle ('S n) txid tx m a)
serverNext)
                   ClientStIdle{forall (blocking :: StBlockingStyle).
SingBlockingStyle blocking
-> NumTxIdsToAck
-> NumTxIdsToReq
-> m (ClientStTxIds blocking txid tx m b)
recvMsgRequestTxIds :: forall txid tx (m :: * -> *) a.
ClientStIdle txid tx m a
-> forall (blocking :: StBlockingStyle).
   SingBlockingStyle blocking
   -> NumTxIdsToAck
   -> NumTxIdsToReq
   -> m (ClientStTxIds blocking txid tx m a)
recvMsgRequestTxIds :: forall (blocking :: StBlockingStyle).
SingBlockingStyle blocking
-> NumTxIdsToAck
-> NumTxIdsToReq
-> m (ClientStTxIds blocking txid tx m b)
recvMsgRequestTxIds} = do
      reply <- SingBlockingStyle 'StNonBlocking
-> NumTxIdsToAck
-> NumTxIdsToReq
-> m (ClientStTxIds 'StNonBlocking txid tx m b)
forall (blocking :: StBlockingStyle).
SingBlockingStyle blocking
-> NumTxIdsToAck
-> NumTxIdsToReq
-> m (ClientStTxIds blocking txid tx m b)
recvMsgRequestTxIds SingBlockingStyle 'StNonBlocking
SingNonBlocking NumTxIdsToAck
ackNo NumTxIdsToReq
reqNo
      case reply of
        SendMsgReplyTxIds (NonBlockingReply [(txid, SizeInBytes)]
txids) ClientStIdle txid tx m b
client' -> do
          server' <- m (ServerStIdle ('S n) txid tx m a)
serverNext
          directSender (enqueue (CollectTxIds reqNo txids) q) server' client'

    directSender Queue n (Collect txid tx)
q (SendMsgRequestTxsPipelined [txid]
txids m (ServerStIdle ('S n) txid tx m a)
serverNext)
                   ClientStIdle{[txid] -> m (ClientStTxs txid tx m b)
recvMsgRequestTxs :: [txid] -> m (ClientStTxs txid tx m b)
recvMsgRequestTxs :: forall txid tx (m :: * -> *) a.
ClientStIdle txid tx m a -> [txid] -> m (ClientStTxs txid tx m a)
recvMsgRequestTxs} = do
      server' <- m (ServerStIdle ('S n) txid tx m a)
serverNext
      SendMsgReplyTxs txs client' <- recvMsgRequestTxs txids
      directSender (enqueue (CollectTxs txids txs) q) server' client'

    directSender Queue n (Collect txid tx)
q (CollectPipelined (Just ServerStIdle ('S n1) txid tx m a
server') Collect txid tx -> m (ServerStIdle n1 txid tx m a)
_) ClientStIdle txid tx m b
client =
      Queue n (Collect txid tx)
-> ServerStIdle n txid tx m a
-> ClientStIdle txid tx m b
-> m (a, b)
forall (n :: N).
Queue n (Collect txid tx)
-> ServerStIdle n txid tx m a
-> ClientStIdle txid tx m b
-> m (a, b)
directSender Queue n (Collect txid tx)
q ServerStIdle n txid tx m a
ServerStIdle ('S n1) txid tx m a
server' ClientStIdle txid tx m b
client

    directSender (ConsQ Collect txid tx
c Queue n1 (Collect txid tx)
q) (CollectPipelined Maybe (ServerStIdle ('S n1) txid tx m a)
_ Collect txid tx -> m (ServerStIdle n1 txid tx m a)
collect) ClientStIdle txid tx m b
client = do
      server' <- Collect txid tx -> m (ServerStIdle n1 txid tx m a)
collect Collect txid tx
c
      directSender q server' client