View on GitHub
File Changes
    bp = blockchainParameters @n

                      
    serveApp socket = do
-
        let nl = newNetworkLayer nullTracer bp addrInfo (versionData @n)
+
        nl <- newNetworkLayer nullTracer bp addrInfo (versionData @n)
        byronApi   <- apiLayer (newTransactionLayer @n) nl
        icarusApi  <- apiLayer (newTransactionLayer @n) nl
        startServer socket byronApi icarusApi $> ExitSuccess
    , genesisTip
    , toByronHash
    , toEpochSlots
+
    , toGenTx
    , toPoint
    )
import Cardano.Wallet.Logging
    ( Cursor
    , ErrGetBlock (..)
    , ErrNetworkUnavailable (..)
+
    , ErrPostTx (..)
    , NetworkLayer (..)
    , NextBlocksResult (..)
    , mapCursor
import Control.Monad.IO.Class
    ( MonadIO )
import Control.Monad.Trans.Except
-
    ( ExceptT (..), withExceptT )
+
    ( ExceptT (..), throwE, withExceptT )
import Control.Tracer
    ( Tracer, contramap )
import Data.ByteString.Lazy
    , NodeToClientVersion (..)
    , NodeToClientVersionData (..)
    , connectTo
-
    , localTxSubmissionClientNull
    )
import Ouroboros.Network.Point
    ( fromWithOrigin )
import Ouroboros.Network.Protocol.Handshake.Version
    ( DictVersion (..), simpleSingletonVersions )
import Ouroboros.Network.Protocol.LocalTxSubmission.Client
-
    ( LocalTxSubmissionClient (..), localTxSubmissionClientPeer )
+
    ( LocalTxClientStIdle (..)
+
    , LocalTxSubmissionClient (..)
+
    , localTxSubmissionClientPeer
+
    )
import Ouroboros.Network.Protocol.LocalTxSubmission.Codec
    ( codecLocalTxSubmission )
import Ouroboros.Network.Protocol.LocalTxSubmission.Type
        -- ^ Socket for communicating with the node
    -> (NodeToClientVersionData, CodecCBORTerm Text NodeToClientVersionData)
        -- ^ Codecs for the node's client
-
    -> NetworkLayer IO (IO Byron) ByronBlock
-
newNetworkLayer tr bp addrInfo versionData = NetworkLayer
-
    { currentNodeTip = _currentNodeTip
-
    , nextBlocks = _nextBlocks
-
    , initCursor = _initCursor
-
    , cursorSlotId = _cursorSlotId
-
    , postTx = _postTx
-
    , staticBlockchainParameters = _staticBlockchainParameters
-
    , stakeDistribution = _stakeDistribution
-
    , getAccountBalance = _getAccountBalance
-
    }
+
    -> IO (NetworkLayer IO (IO Byron) ByronBlock)
+
newNetworkLayer tr bp addrInfo versionData = do
+
    localTxSubmissionQ <- atomically newTQueue
+
    pure NetworkLayer
+
        { currentNodeTip = _currentNodeTip
+
        , nextBlocks = _nextBlocks
+
        , initCursor = _initCursor localTxSubmissionQ
+
        , cursorSlotId = _cursorSlotId
+
        , postTx = _postTx localTxSubmissionQ
+
        , staticBlockchainParameters = _staticBlockchainParameters
+
        , stakeDistribution = _stakeDistribution
+
        , getAccountBalance = _getAccountBalance
+
        }
  where
    _initCursor localTxSubmissionQ headers = do
        chainSyncQ <- atomically newTQueue
    _currentNodeTip =
        notImplemented "currentNodeTip"

                      
-
    _postTx =
-
        notImplemented "postTx"
+
    _postTx localTxSubmissionQ tx = do
+
        result <- withExceptT ErrPostTxNetworkUnreachable $
+
            ExceptT (localTxSubmissionQ `send` CmdSubmitTx (toGenTx tx))
+
        case result of
+
            Nothing  -> pure ()
+
            Just err -> throwE $ ErrPostTxBadRequest $ T.pack err

                      
    _stakeDistribution =
        notImplemented "stakeDistribution"
-- callback.
--
-- See also 'send' for invoking commands.
-
data NetworkClientCmd (m :: * -> *)
+
data ChainSyncCmd (m :: * -> *)
    = CmdFindIntersection
        [Point ByronBlock]
        (Maybe (Point ByronBlock) -> m ())
    | CmdNextBlocks
-
        (NextBlocksResult (m Byron) ByronBlock -> m ())
+
        (NextBlocksResult (Point ByronBlock) ByronBlock -> m ())
    | CmdCurrentNodeTip
        (Tip ByronBlock -> m ())

                      
+
-- | Sending command to the localTxSubmission client. See also 'ChainSyncCmd'.
+
data LocalTxSubmissionCmd (m :: * -> *)
+
    = CmdSubmitTx
+
        (GenTx ByronBlock)
+
        (Maybe String -> m ())
+

                      
-- | Helper function to easily send commands to the node's client and read
-- responses back.
--
        -- ^ Static blockchain parameters
    -> TQueue m (ChainSyncCmd m)
        -- ^ Communication channel with the ChainSync client
+
    -> TQueue m (LocalTxSubmissionCmd m)
+
        -- ^ Communication channel with the LocalTxSubmission client
    -> NetworkClient m
-
mkNetworkClient tr bp chainSyncQ =
+
mkNetworkClient tr bp chainSyncQ localTxSubmissionQ =
    OuroborosInitiatorApplication $ \pid -> \case
        ChainSyncWithBlocksPtcl ->
            let tr' = contramap (T.pack . show) $ trMessage tr in
            chainSyncWithBlocks tr' pid (W.getGenesisBlockHash bp) chainSyncQ
        LocalTxSubmissionPtcl ->
-
            localTxSubmission nullTracer pid
+
            let tr' = contramap (T.pack . show) $ trMessage tr in
+
            localTxSubmission tr' pid localTxSubmissionQ

                      
-- Connect a client to a network, see `mkNetworkClient` to construct a network
-- client interface.
        -- ^ Base tracer for the mini-protocols
    -> peerId
        -- ^ An abstract peer identifier for 'runPeer'
+
    -> TQueue m (LocalTxSubmissionCmd m)
+
        -- ^ We use a 'TQueue' as a communication channel to drive queries from
+
        -- outside of the network client to the client itself.
+
        -- Requests are pushed to the queue which are then transformed into
+
        -- messages to keep the state-machine moving.
    -> Channel m ByteString
        -- ^ A 'Channel' is a abstract communication instrument which
        -- transports serialized messages between peers (e.g. a unix
        -- socket).
    -> m Void
-
localTxSubmission tr pid channel =
+
localTxSubmission tr pid queue channel =
    runPeer tr codec pid channel (localTxSubmissionClientPeer client)
  where
    codec :: Codec protocol DeserialiseFailure m ByteString
        CBOR.encode      -- String -> CBOR.Encoding
        CBOR.decode      -- CBOR.Decoder s String

                      
-
    client :: LocalTxSubmissionClient (GenTx ByronBlock) String m Void
-
    client = localTxSubmissionClientNull
+
    client
+
        :: LocalTxSubmissionClient (GenTx ByronBlock) String m Void
+
    client = LocalTxSubmissionClient clientStIdle
+
      where
+
        clientStIdle
+
            :: m (LocalTxClientStIdle (GenTx ByronBlock) String m Void)
+
        clientStIdle = atomically (readTQueue queue) <&> \case
+
            CmdSubmitTx tx respond ->
+
                SendMsgSubmitTx tx (\e -> respond e >> clientStIdle)
+

                      

                      
--------------------------------------------------------------------------------
--