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

module Ouroboros.Network.Protocol.LocalTxSubmission.Direct (direct) where

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


direct :: forall tx reject m a b.
          Monad m
       => LocalTxSubmissionClient tx reject m a
       -> LocalTxSubmissionServer tx reject m b
       -> m (a, b)
direct :: forall tx reject (m :: * -> *) a b.
Monad m =>
LocalTxSubmissionClient tx reject m a
-> LocalTxSubmissionServer tx reject m b -> m (a, b)
direct (LocalTxSubmissionClient m (LocalTxClientStIdle tx reject m a)
mclient) LocalTxSubmissionServer tx reject m b
server =
    m (LocalTxClientStIdle tx reject m a)
mclient m (LocalTxClientStIdle tx reject m a)
-> (LocalTxClientStIdle tx reject m a -> m (a, b)) -> m (a, b)
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \LocalTxClientStIdle tx reject m a
client -> LocalTxClientStIdle tx reject m a
-> LocalTxSubmissionServer tx reject m b -> m (a, b)
directSender LocalTxClientStIdle tx reject m a
client LocalTxSubmissionServer tx reject m b
server
  where
    directSender :: LocalTxClientStIdle     tx reject m a
                 -> LocalTxSubmissionServer tx reject m b
                 -> m (a, b)
    directSender :: LocalTxClientStIdle tx reject m a
-> LocalTxSubmissionServer tx reject m b -> m (a, b)
directSender (SendMsgSubmitTx tx
tx SubmitResult reject -> m (LocalTxClientStIdle tx reject m a)
k) LocalTxSubmissionServer{tx
-> m (SubmitResult reject, LocalTxSubmissionServer tx reject m b)
recvMsgSubmitTx :: tx
-> m (SubmitResult reject, LocalTxSubmissionServer tx reject m b)
recvMsgSubmitTx :: forall tx reject (m :: * -> *) a.
LocalTxSubmissionServer tx reject m a
-> tx
-> m (SubmitResult reject, LocalTxSubmissionServer tx reject m a)
recvMsgSubmitTx} = do
        (res, server') <- tx
-> m (SubmitResult reject, LocalTxSubmissionServer tx reject m b)
recvMsgSubmitTx tx
tx
        client' <- k res
        directSender client' server'

    directSender (SendMsgDone a
a) LocalTxSubmissionServer{recvMsgDone :: forall tx reject (m :: * -> *) a.
LocalTxSubmissionServer tx reject m a -> a
recvMsgDone = b
b} =
        (a, b) -> m (a, b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (a
a,b
b)