remove Mode type

cardano-tx-generator/cardano-tx-generator.cabal

@@ -26,6 +26,7 @@ library
                        Cardano.Benchmarking.GeneratorTx.Benchmark
                        Cardano.Benchmarking.GeneratorTx.Error
                        Cardano.Benchmarking.GeneratorTx.Era
+                       Cardano.Benchmarking.GeneratorTx.Callback
                        Cardano.Benchmarking.GeneratorTx.Genesis
                        Cardano.Benchmarking.GeneratorTx.NodeToNode
                        Cardano.Benchmarking.GeneratorTx.Tx

cardano-tx-generator/src/Cardano/Benchmarking/GeneratorTx.hs

@@ -32,7 +32,7 @@ module Cardano.Benchmarking.GeneratorTx
   ) where
 
 import           Cardano.Prelude
-import           Prelude (error, id)
+import           Prelude (error, id, String)
 
 import           Control.Monad (fail)
 import           Control.Monad.Trans.Except.Extra (left, newExceptT, right)
@@ -75,12 +75,12 @@ readSigningKey =
 secureFunds :: forall era. IsShelleyBasedEra era
   => Tracer IO (TraceBenchTxSubmit TxId)
   -> LocalNodeConnectInfo CardanoMode CardanoBlock
-  -> Benchmark
   -> NetworkId
   -> ShelleyGenesis StandardShelley
+  -> Benchmark
   -> GeneratorFunds
   -> ExceptT TxGenError IO (SigningKey PaymentKey, [(TxIn, TxOut era)])
-secureFunds submitTracer localConnectInfo benchmark networkId genesis funds = case funds of
+secureFunds submitTracer localConnectInfo networkId genesis benchmark funds = case funds of
   FundsGenesis keyF -> do
     let Benchmark{bTxFee, bInitialTTL, bInitCooldown=InitCooldown cooldown} = benchmark
     key <- readSigningKey keyF
@@ -262,28 +262,31 @@ splitFunds
 --   we have 1 Cardano tx and 10 fiscal txs.
 runBenchmark :: forall era .
     (ConfigSupportsTxGen CardanoMode era, IsShelleyBasedEra era)
-  => Benchmark
-  -> Mode
+  => Tracer IO (TraceBenchTxSubmit TxId)
+  -> Tracer IO NodeToNodeSubmissionTrace
+  -> NetworkId
+  -> ConnectClient
+  -> Benchmark
   -> (SigningKey PaymentKey, [(TxIn, TxOut era)])
   -> ExceptT TxGenError IO ()
-runBenchmark b@Benchmark{ bTargets
+runBenchmark traceSubmit
+             traceN2N
+             networkId
+             connectClient
+             b@Benchmark{ bTargets
                         , bTps
                         , bInitCooldown=InitCooldown initCooldown
                         }
-             m (fundsKey, fundsWithSufficientCoins) = do
+             (fundsKey, fundsWithSufficientCoins) = do
   let
-    networkId = modeNetworkIdOverridable m
     recipientAddress = keyAddress networkId fundsKey
+    traceDebug :: String -> ExceptT TxGenError IO ()
+    traceDebug =   liftIO . traceWith traceSubmit . TraceBenchTxSubDebug
 
-  liftIO . traceWith (trTxSubmit m) . TraceBenchTxSubDebug
-    $ "******* Tx generator: waiting " ++ show initCooldown ++ "s *******"
+  traceDebug $ "******* Tx generator: waiting " ++ show initCooldown ++ "s *******"
   liftIO $ threadDelay (initCooldown*1000*1000)
 
-  liftIO . traceWith (trTxSubmit m) . TraceBenchTxSubDebug
-    $ "******* Tx generator, phase 2: pay to recipients *******"
-
-  let localAddr :: Maybe Network.Socket.AddrInfo
-      localAddr = Nothing
+  traceDebug "******* Tx generator, phase 2: pay to recipients *******"
 
   remoteAddresses <- forM bTargets $ \targetNodeAddress -> do
     let targetNodeHost =
@@ -306,16 +309,16 @@ runBenchmark b@Benchmark{ bTargets
   let numTargets :: Natural = fromIntegral $ NE.length bTargets
   txs :: [Tx era] <-
            txGenerator
-              b m
+              traceSubmit
+              b
               recipientAddress
               fundsKey
               (NE.length bTargets)
               fundsWithSufficientCoins
 
+  traceDebug $ "******* Tx generator, launching Tx peers:  " ++ show (NE.length remoteAddresses) ++ " of them"
   liftIO $ do
-    traceWith (trTxSubmit m) . TraceBenchTxSubDebug
-        $ "******* Tx generator, launching Tx peers:  " ++ show (NE.length remoteAddresses) ++ " of them"
-    submission :: Submission IO era  <- mkSubmission (trTxSubmit m) $
+    submission :: Submission IO era  <- mkSubmission traceSubmit $
                     SubmissionParams
                     { spTps           = bTps
                     , spTargets       = numTargets
@@ -325,15 +328,16 @@ runBenchmark b@Benchmark{ bTargets
     allAsyncs <- forM (zip [0..] $ NE.toList remoteAddresses) $
       \(i, remoteAddr) ->
         launchTxPeer
-              m
-              localAddr
+              traceSubmit
+              traceN2N
+              connectClient
               remoteAddr
               submission
               i
     tpsFeeder <- async $ tpsLimitedTxFeeder submission txs
     -- Wait for all threads to complete.
     mapM_ wait (tpsFeeder : allAsyncs)
-    traceWith (trTxSubmit m) =<<
+    traceWith traceSubmit =<<
        TraceBenchTxSubSummary <$> mkSubmissionSummary submission
 
 -- | At this moment 'sourceAddress' contains a huge amount of money (lets call it A).
@@ -348,30 +352,30 @@ runBenchmark b@Benchmark{ bTargets
 txGenerator
   :: forall era
   .  (ConfigSupportsTxGen CardanoMode era, IsShelleyBasedEra era)
-  => Benchmark
-  -> Mode
+  => Tracer IO (TraceBenchTxSubmit TxId)
+  -> Benchmark
   -> AddressInEra era
   -> SigningKey PaymentKey
   -> Int
   -> [(TxIn, TxOut era)]
   -> ExceptT TxGenError IO [Tx era]
-txGenerator Benchmark
+txGenerator tracer Benchmark
             { bTxFee
             , bTxCount=NumberOfTxs numOfTransactions
             , bTxFanIn=NumberOfInputsPerTx numOfInsPerTx
             , bTxFanOut=NumberOfOutputsPerTx numOfOutsPerTx
             , bTxExtraPayload=txAdditionalSize
             }
-            m recipientAddress sourceKey numOfTargetNodes
+            recipientAddress sourceKey numOfTargetNodes
             fundsWithSufficientCoins = do
-  liftIO . traceWith (trTxSubmit m) . TraceBenchTxSubDebug
+  liftIO . traceWith tracer . TraceBenchTxSubDebug
     $ " Generating " ++ show numOfTransactions
       ++ " transactions, for " ++ show numOfTargetNodes
       ++ " peers, fee " ++ show bTxFee
       ++ ", value " ++ show valueForRecipient
       ++ ", totalValue " ++ show totalValue
   txs <- createMainTxs numOfTransactions numOfInsPerTx fundsWithSufficientCoins
-  liftIO . traceWith (trTxSubmit m) . TraceBenchTxSubDebug
+  liftIO . traceWith tracer . TraceBenchTxSubDebug
     $ " Done, " ++ show numOfTransactions ++ " were generated."
   pure txs
  where
@@ -451,17 +455,17 @@ txGenerator Benchmark
 launchTxPeer
   :: forall era
   .  (ConfigSupportsTxGen CardanoMode era, IsShelleyBasedEra era)
-  => Mode
-  -> Maybe Network.Socket.AddrInfo
-  -- local address binding (if wanted)
+  => Tracer IO (TraceBenchTxSubmit TxId)
+  -> Tracer IO NodeToNodeSubmissionTrace
+  -> ConnectClient
   -> Network.Socket.AddrInfo
   -- Remote address
   -> Submission IO  era
   -- Mutable state shared between submission threads
   -> Natural
   -- Thread index
   -> IO (Async ())
-launchTxPeer m localAddr remoteAddr sub tix =
+launchTxPeer traceSubmit traceN2N connectClient remoteAddr sub tix =
   async $
    handle
      (\(SomeException err) -> do
@@ -472,7 +476,7 @@ launchTxPeer m localAddr remoteAddr sub tix =
          submitThreadReport sub tix (Left errDesc)
          case spErrorPolicy $ sParams sub of
            FailOnError -> throwIO err
-           LogErrors   -> traceWith (trTxSubmit m) $
+           LogErrors   -> traceWith traceSubmit $
              TraceBenchTxSubError (pack errDesc))
-     $ benchmarkConnectTxSubmit m localAddr remoteAddr
-        (txSubmissionClient (trN2N m) (trTxSubmit m) sub tix)
+     $ connectClient remoteAddr
+        (txSubmissionClient traceN2N traceSubmit sub tix)

cardano-tx-generator/src/Cardano/Benchmarking/GeneratorTx/Callback.hs

@@ -0,0 +1,100 @@
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE GADTs #-}
+module Cardano.Benchmarking.GeneratorTx.Callback
+  (
+    mkCallback
+  ) where
+
+import           Prelude (error)
+import           Cardano.Prelude hiding (TypeError, show)
+
+import qualified Ouroboros.Consensus.Cardano as Consensus
+import           Ouroboros.Consensus.Config
+                   ( configBlock, configCodec)
+import           Ouroboros.Consensus.Config.SupportsNode
+                   (ConfigSupportsNode(..), getNetworkMagic)
+import           Ouroboros.Consensus.Node.ProtocolInfo
+                   (ProtocolInfo (..))
+import           Ouroboros.Network.NodeToClient (IOManager)
+
+import           Cardano.Chain.Slotting
+import           Cardano.Api
+import           Cardano.Api.Typed
+import qualified Cardano.Api.Typed as Api
+
+-- Node imports
+import           Cardano.Node.Types (SocketPath(..))
+import           Cardano.Tracing.OrphanInstances.Byron()
+import           Cardano.Tracing.OrphanInstances.Common()
+import           Cardano.Tracing.OrphanInstances.Consensus()
+import           Cardano.Tracing.OrphanInstances.Network()
+import           Cardano.Tracing.OrphanInstances.Shelley()
+
+import Cardano.Benchmarking.GeneratorTx.Benchmark
+import Cardano.Benchmarking.GeneratorTx.Era
+import Cardano.Benchmarking.GeneratorTx.NodeToNode
+import Cardano.Benchmarking.GeneratorTx
+import Cardano.Benchmarking.GeneratorTx.Genesis (GeneratorFunds)
+
+type Funding era = Benchmark -> GeneratorFunds -> ExceptT TxGenError IO (SigningKey PaymentKey, [(TxIn, TxOut era)])
+type BenchmarkAction era
+      = Benchmark -> (SigningKey PaymentKey, [(TxIn, TxOut era)]) -> ExceptT TxGenError IO ()
+
+type Action era = Benchmark -> GeneratorFunds -> ExceptT TxGenError IO ()
+
+mkCallback
+  :: forall blok ptcl era.
+     (
+       IsShelleyBasedEra era
+     , ConfigSupportsTxGen CardanoMode era
+     )
+  =>  Consensus.Protocol IO blok ptcl
+  -> Maybe NetworkMagic
+  -> Bool
+  -> IOManager
+  -> SocketPath
+  -> BenchTracers IO CardanoBlock
+  -> Proxy era
+  -> Action era
+
+mkCallback ptcl@(Consensus.ProtocolCardano
+             _
+             Consensus.ProtocolParamsShelleyBased{Consensus.shelleyBasedGenesis}
+              _ _ _ _ _ _)
+            nmagic_opt is_addr_mn iom (SocketPath sock) tracers _proxy
+    = action
+  where
+    action benchmark fundOptions
+      =  funding benchmark fundOptions >>= benchmarkAction benchmark
+
+    ProtocolInfo{pInfoConfig} = Consensus.protocolInfo ptcl
+    localConnectInfo = LocalNodeConnectInfo
+       sock
+       (Api.Testnet . getNetworkMagic . configBlock $ pInfoConfig)
+       (CardanoMode (EpochSlots 21600))        -- TODO: get this from genesis
+
+    connectClient :: ConnectClient
+    connectClient  = benchmarkConnectTxSubmit
+                       iom
+                       (btConnect_ tracers)
+                       (btSubmission_ tracers)
+                       (configCodec pInfoConfig)
+                       (getNetworkMagic $ configBlock pInfoConfig)
+
+    funding :: Funding era
+    funding = secureFunds
+                (btTxSubmit_ tracers)
+                localConnectInfo
+                networkId
+                shelleyBasedGenesis
+
+    benchmarkAction :: BenchmarkAction era
+    benchmarkAction = runBenchmark (btTxSubmit_ tracers) (btN2N_ tracers) networkId connectClient
+
+    networkId = if is_addr_mn
+      then Mainnet
+      else Testnet $ getNetworkMagic $ configBlock pInfoConfig
+
+mkCallback _ _ _ _ _ _ _ = error "mkCallbacks"