Permalink
Browse files

Added Ouroboros.Network.Protocol.TxSubmission.Direct module

  • Loading branch information...
coot committed Jan 10, 2019
1 parent 4bc057c commit 35c505ee10477ea15a5ad12b89d62cd909f95a7e
@@ -49,6 +49,7 @@ library
Ouroboros.Network.Protocol.TxSubmission.Type
Ouroboros.Network.Protocol.TxSubmission.Client
Ouroboros.Network.Protocol.TxSubmission.Server
Ouroboros.Network.Protocol.TxSubmission.Direct
Ouroboros.Network.Protocol.Stream.Type
Ouroboros.Network.Protocol.Stream.Client
Ouroboros.Network.Protocol.Stream.Server
@@ -0,0 +1,32 @@
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}
module Ouroboros.Network.Protocol.TxSubmission.Direct where

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

direct
:: forall (n :: Nat) tx err m a b. Monad m
=> TxSubmissionServer tx err m a
-> TxSubmissionClient n tx err m b
-> m (Either err a, b)
direct = go
where
go :: TxSubmissionServer tx err m a
-> TxSubmissionClient l tx err m b
-> m (Either err a, b)
go handlers@TxSubmissionServer {handleTx,handleTxDone} (TxSubmissionClient mclient) = do
client <- mclient
case client of
TxSubmission tx client' -> do
_ <- handleTx tx
go handlers client'
TxSubmissionDone b (TxSubmissionErrHandler handleErr) ->
handleTxDone >>= \res -> case res of
Left err -> (Left err,) <$> handleErr (Just err)
Right a -> return (Right a, b)

0 comments on commit 35c505e

Please sign in to comment.