Skip to content
Permalink
Browse files

Using Tracers for TxSubmission, WIP

  • Loading branch information...
denisshevchenko committed Aug 13, 2019
1 parent 6f8c06d commit 4fc038f8f8b74e2bc6ff1bd0f868eda9dc681749
Showing with 42 additions and 28 deletions.
  1. +7 −1 app/Run.hs
  2. +20 −20 app/TxGeneration.hs
  3. +15 −7 app/TxSubmission.hs
@@ -128,8 +128,14 @@ runNode nodeCli@NodeCLIArguments{..} loggingLayer cc = do
TxGenerator topology protocol -> do
let trace' = appendName "generator" tr
let tracer = contramap pack $ toLogObject trace'
let tstx' = appendName "bench-observables" trace'
tct' = appendName "conn-observables" trace'
tsr' = appendName "tx-submit-observables" trace'
tstx = contramap pack $ toLogObject tstx'
tct = contramap pack $ toLogObject tct'
tsr = contramap pack $ toLogObject tsr'
SomeProtocol p <- fromProtocol cc protocol
genesisBenchmarkRunner p topology tracer
genesisBenchmarkRunner (tstx, tct, tsr) p topology

TraceAcceptor -> do
let trace' = appendName "acceptor" tr
@@ -52,7 +52,7 @@ import Ouroboros.Consensus.Protocol.ExtNodeConfig
import Ouroboros.Consensus.Protocol.WithEBBs

import Topology
import TxSubmission (submitTx)
import TxSubmission (TxSubmissionTracers, submitTx)

-----------------------------------------------------------------------------------------
-- | Genesis benchmark runner (we call it in 'Run.runNode').
@@ -63,11 +63,11 @@ import TxSubmission (submitTx)

genesisBenchmarkRunner
:: forall blk. RunDemo blk
=> Consensus.Protocol blk
=> TxSubmissionTracers blk
-> Consensus.Protocol blk
-> TopologyInfo
-> Tracer IO String
-> IO ()
genesisBenchmarkRunner protocol@(Consensus.ProtocolRealPBFT genesisConfig _ _ _ _) topologyInfo tracer = do
genesisBenchmarkRunner tracers protocol@(Consensus.ProtocolRealPBFT genesisConfig _ _ _ _) topologyInfo = do
ProtocolInfo{pInfoConfig} <- prepareProtocolInfo protocol topologyInfo
-- _benchmarkConfig <- prepareBenchmarkConfig pathToBenchmarkConfigFile

@@ -84,9 +84,9 @@ genesisBenchmarkRunner protocol@(Consensus.ProtocolRealPBFT genesisConfig _ _ _

-- We have to prepare an initial funds (it's the money we'll send from 'genesisAddress' to
-- 'sourceAddress'), this will be our very first transaction.
prepareInitialFunds pInfoConfig topologyInfo genesisUtxo sourceAddress tracer
prepareInitialFunds tracers pInfoConfig topologyInfo genesisUtxo sourceAddress

runBenchmark pInfoConfig sourceAddress sourceKey recipientAddress topologyInfo tracer
runBenchmark tracers pInfoConfig sourceAddress sourceKey recipientAddress topologyInfo
where
-- TODO: take these paths from CLI
signingKeyFiles =
@@ -297,19 +297,20 @@ mkAddressForKey pInfoConfig = CC.Common.makeVerKeyAddress networkMagic . Crypto.
-- (latter corresponds to 'targetAddress' here) and "remember" it in 'availableFunds'.
prepareInitialFunds
:: RunDemo (ByronBlockOrEBB ByronConfig)
=> NodeConfig ByronEBBExtNodeConfig
=> TxSubmissionTracers (ByronBlockOrEBB ByronConfig)
-> NodeConfig ByronEBBExtNodeConfig
-> TopologyInfo
-> Map Int ((CC.UTxO.TxIn, CC.UTxO.TxOut), Crypto.SigningKey)
-> CC.Common.Address
-> Tracer IO String
-> IO ()
prepareInitialFunds pInfoConfig topologyInfo genesisUtxo targetAddress tracer = do
prepareInitialFunds tracers pInfoConfig topologyInfo genesisUtxo targetAddress = do
let (mFunds, _, initGenTx) = extractInitialFunds
pInfoConfig
(genesisUtxo Map.! 0) -- corresponds to 'genesisAddress'.
targetAddress

submitTx pInfoConfig (node topologyInfo) initGenTx tracer

submitTx tracers pInfoConfig (node topologyInfo) initGenTx

-- Done, the first transaction 'initGenTx' is submitted, now 'sourceAddress' has a lot of money.
case mFunds of
Nothing -> return ()
@@ -350,18 +351,18 @@ extractInitialFunds cfg input address = (funds, fees, initGenTx)
-- we have 1 Cardano tx and 10 fiscal txs.
runBenchmark
:: RunDemo (ByronBlockOrEBB ByronConfig)
=> NodeConfig ByronEBBExtNodeConfig
=> TxSubmissionTracers (ByronBlockOrEBB ByronConfig)
-> NodeConfig ByronEBBExtNodeConfig
-> CC.Common.Address
-> Crypto.SigningKey
-> CC.Common.Address
-> TopologyInfo
-> Tracer IO String
-> IO ()
runBenchmark pInfoConfig _sourceAddress sourceKey _recipientAddress topologyInfo tracer = do
runBenchmark tracers pInfoConfig _sourceAddress sourceKey _recipientAddress topologyInfo = do
let feePerTx = assumeBound . CC.Common.mkLovelace $ 1000000 -- 1 ADA

-- Phase 1, make enough intermediate 'coins' (available UTxO entries).
createMoreFundCoins pInfoConfig sourceKey feePerTx topologyInfo tracer
createMoreFundCoins tracers pInfoConfig sourceKey feePerTx topologyInfo

-- Phase 2 -- pay people, i.e. produce a lot of new transactions from
-- 'sourceAddress' to 'recipientAddress'.
@@ -396,13 +397,13 @@ runBenchmark pInfoConfig _sourceAddress sourceKey _recipientAddress topologyInfo
-- Technically all splitting transactions will send money back to 'sourceAddress'.
createMoreFundCoins
:: RunDemo (ByronBlockOrEBB ByronConfig)
=> NodeConfig ByronEBBExtNodeConfig
=> TxSubmissionTracers (ByronBlockOrEBB ByronConfig)
-> NodeConfig ByronEBBExtNodeConfig
-> Crypto.SigningKey
-> CC.Common.Lovelace
-> TopologyInfo
-> Tracer IO String
-> IO ()
createMoreFundCoins pInfoConfig sourceKey feePerTx topologyInfo tracer = do
createMoreFundCoins tracers pInfoConfig sourceKey feePerTx topologyInfo = do
let numSplittingTxOuts = 10000 -- number of splitting txout entries
numOutsPerSplittingTx = 60 -- near the upper bound so as not to exceed the tx size limit

@@ -439,9 +440,8 @@ createMoreFundCoins pInfoConfig sourceKey feePerTx topologyInfo tracer = do
txOut
[]

traceWith tracer $ "Submitting splitting transactions ..."
forM_ splittingTxs $ \(tx, txDetailsList) -> do
submitTx pInfoConfig (node topologyInfo) tx tracer
submitTx tracers pInfoConfig (node topologyInfo) tx
-- Update available fundValueStatus to reuse the numSplittingTxOuts TxOuts.
forM_ txDetailsList addToAvailableFunds

@@ -13,6 +13,7 @@ module TxSubmission (
-- , handleTxSubmission

TraceSubmitTx(..)
, TxSubmissionTracers
, submitTx

-- , localSocketFilePath
@@ -164,16 +165,23 @@ data TraceSubmitTx blk where
-> ApplyTxErr blk -- ^ error
-> TraceSubmitTx blk

type TxSubmissionTracers blk =
( Tracer IO (TraceSubmitTx blk)
-- ^ benchmarking observables
, Tracer IO (TraceSendRecv (Handshake NodeToClientVersion CBOR.Term)
(SockAddr, SockAddr)
(DecoderFailureOrTooMuchInput DeserialiseFailure))
-- ^ connection establishment observables
, Tracer IO (TraceSendRecv (LocalTxSubmission (GenTx blk) (ApplyTxErr blk))
(SockAddr, SockAddr)
DeserialiseFailure)
-- ^ transaction submission observables
)

-- NOTE missing a tracer for the data diffusion layer - FIX ME
submitTx :: ( RunDemo blk
)
=> ( Tracer IO (TraceSubmitTx blk)
-- ^ benchmarking observables
, Tracer IO (TraceSendRecv (Handshake NodeToClientVersion CBOR.Term) (SockAddr, SockAddr) (DecoderFailureOrTooMuchInput DeserialiseFailure))
-- ^ connection establishment observables
, Tracer IO (TraceSendRecv (LocalTxSubmission (GenTx blk) (ApplyTxErr blk)) (SockAddr, SockAddr) DeserialiseFailure)
-- ^ transaction submission observables
)
=> TxSubmissionTracers blk
-> NodeConfig (BlockProtocol blk)
-> NodeId
-> GenTx blk

0 comments on commit 4fc038f

Please sign in to comment.
You can’t perform that action at this time.