Generator as CLI command.

app/CLI.hs

@@ -41,8 +41,9 @@ data NodeCLIArguments = NodeCLIArguments {
   }
 
 data Command =
-    SimpleNode  TopologyInfo NodeAddress Protocol ViewMode
-  | TxSubmitter TopologyInfo Mock.Tx     Protocol
+    SimpleNode    TopologyInfo NodeAddress Protocol ViewMode
+  | TxSubmitter   TopologyInfo Mock.Tx     Protocol
+  | TxGenerator   TopologyInfo Protocol
   | TraceAcceptor
 
 nodeParser :: Parser NodeCLIArguments
@@ -57,6 +58,8 @@ parseCommand = subparser $ mconcat [
       SimpleNode <$> parseTopologyInfo <*> parseNodeAddress <*> parseProtocol <*> parseViewMode
   , command' "submit" "Submit a transaction." $
       TxSubmitter <$> parseTopologyInfo <*> parseMockTx <*> parseProtocol
+  , command' "generate" "Spawn a transaction generator." $
+      TxGenerator <$> parseTopologyInfo <*> parseProtocol
   , command' "trace-acceptor" "Spawn an acceptor." $
       pure TraceAcceptor
   ]

app/Run.hs

@@ -82,11 +82,11 @@ import           Ouroboros.Consensus.Node.Run
 import           Ouroboros.Consensus.NodeId
 import           Ouroboros.Consensus.NodeNetwork
 import           Ouroboros.Consensus.Protocol hiding (Protocol)
+import qualified Ouroboros.Consensus.Protocol as Consensus
 import           Ouroboros.Consensus.Util.Condense
 import           Ouroboros.Consensus.Util.Orphans ()
 import           Ouroboros.Consensus.Util.STM
 import           Ouroboros.Consensus.Util.ThreadRegistry
-import qualified Ouroboros.Consensus.Protocol as Consensus
 
 import           Ouroboros.Storage.ChainDB (ChainDB)
 import qualified Ouroboros.Storage.ChainDB as ChainDB
@@ -100,6 +100,7 @@ import           Cardano.Node.CLI
 import           CLI
 import           Topology
 import           TraceAcceptor
+import           TxGeneration
 import           TxSubmission
 #ifdef UNIX
 import           LiveView
@@ -124,11 +125,17 @@ runNode nodeCli@NodeCLIArguments{..} loggingLayer = do
     case command of
 
       TxSubmitter topology tx protocol -> do
-        let trace'      = appendName (pack (show (node topology))) tr
+        let trace'      = appendName "submit-tx" tr
         let tracer      = contramap pack $ toLogObject trace'
         SomeProtocol p  <- fromProtocol protocol
         handleTxSubmission p topology tx tracer
 
+      TxGenerator topology protocol -> do
+        let trace'      = appendName "generator" tr
+        let tracer      = contramap pack $ toLogObject trace'
+        SomeProtocol p  <- fromProtocol protocol
+        handleTxGeneration p topology tracer
+
       TraceAcceptor -> do
         let trace'      = appendName "acceptor" tr
         let tracer      = contramap pack $ toLogObject trace'

app/TxGeneration.hs

@@ -0,0 +1,69 @@
+{-# LANGUAGE DataKinds           #-}
+{-# LANGUAGE FlexibleContexts    #-}
+{-# LANGUAGE GADTs               #-}
+{-# LANGUAGE NamedFieldPuns      #-}
+{-# LANGUAGE OverloadedStrings   #-}
+{-# LANGUAGE RankNTypes          #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications    #-}
+
+module TxGeneration (
+      handleTxGeneration
+    ) where
+
+import qualified Data.Set as Set
+import           Data.String (fromString)
+
+import           Control.Tracer
+
+import           Ouroboros.Consensus.Demo.Run
+import qualified Ouroboros.Consensus.Ledger.Mock as Mock
+import           Ouroboros.Consensus.Mempool
+import           Ouroboros.Consensus.Node.ProtocolInfo
+import           Ouroboros.Consensus.NodeId
+import qualified Ouroboros.Consensus.Protocol as Consensus
+
+import           Topology
+import           TxSubmission (submitTx)
+
+{-------------------------------------------------------------------------------
+  Parsers for the generator's arguments
+-------------------------------------------------------------------------------}
+
+
+{-------------------------------------------------------------------------------
+  Main logic
+-------------------------------------------------------------------------------}
+
+handleTxGeneration :: forall blk.
+                      RunDemo blk
+                   => Consensus.Protocol blk
+                   -> TopologyInfo
+                   -> Tracer IO String
+                   -> IO ()
+handleTxGeneration ptcl tinfo tracer = do
+    let hashOfPreviousTx = fromString "aa"
+        mocktx = Mock.Tx (Set.fromList [(hashOfPreviousTx, 0)]) [("a", 1000)]
+    topoE <- readTopologyFile (topologyFile tinfo)
+    NetworkTopology nodeSetups <-
+      case topoE of
+        Left e  -> fail e
+        Right t -> return t
+
+    nid <- case node tinfo of
+      CoreId nid -> return nid
+      RelayId{}  -> fail "Only core nodes are supported targets"
+
+    let ProtocolInfo{pInfoConfig} =
+          protocolInfo (NumCoreNodes (length nodeSetups))
+                       (CoreNodeId nid)
+                       ptcl
+
+        tx :: GenTx blk
+        tx = demoMockTx pInfoConfig mocktx
+
+    traceWith tracer $ "**************************************"
+    traceWith tracer $ "Starting transaction generator"
+    traceWith tracer $ "**************************************"
+
+    submitTx pInfoConfig (node tinfo) tx tracer

app/TxSubmission.hs

@@ -1,8 +1,8 @@
-{-# LANGUAGE FlexibleContexts    #-}
 {-# LANGUAGE DataKinds           #-}
+{-# LANGUAGE FlexibleContexts    #-}
 {-# LANGUAGE GADTs               #-}
-{-# LANGUAGE RankNTypes          #-}
 {-# LANGUAGE NamedFieldPuns      #-}
+{-# LANGUAGE RankNTypes          #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeApplications    #-}
 
@@ -11,17 +11,19 @@ module TxSubmission (
     , parseMockTx
     , handleTxSubmission
 
+    , submitTx
+
     , localSocketFilePath
     , localSocketAddrInfo
     ) where
 
-import           Data.Void (Void)
 import           Data.ByteString.Lazy (ByteString)
+import           Data.Proxy
 import qualified Data.Set as Set
+import           Data.Void (Void)
 import           Options.Applicative
-import           Data.Proxy
 
-import qualified Codec.Serialise as Serialise (encode, decode)
+import qualified Codec.Serialise as Serialise (decode, encode)
 import           Network.Socket as Socket
 
 import           Control.Monad (forever)
@@ -37,27 +39,27 @@ import           Ouroboros.Consensus.Block (BlockProtocol)
 import           Ouroboros.Consensus.Demo.Run
 import qualified Ouroboros.Consensus.Ledger.Mock as Mock
 import           Ouroboros.Consensus.Mempool
-import           Ouroboros.Consensus.NodeId
-import qualified Ouroboros.Consensus.Protocol as Consensus
-import           Ouroboros.Consensus.Protocol hiding (Protocol)
 import           Ouroboros.Consensus.Node.ProtocolInfo
 import           Ouroboros.Consensus.Node.Run
+import           Ouroboros.Consensus.NodeId
+import           Ouroboros.Consensus.Protocol hiding (Protocol)
+import qualified Ouroboros.Consensus.Protocol as Consensus
 import           Ouroboros.Consensus.Util.Condense
 
-import           Network.TypedProtocol.Driver
 import           Network.TypedProtocol.Codec.Cbor
-import           Ouroboros.Network.Mux
+import           Network.TypedProtocol.Driver
 import           Ouroboros.Network.Block (Point)
 import qualified Ouroboros.Network.Block as Block
-import           Ouroboros.Network.Protocol.LocalTxSubmission.Type
-import           Ouroboros.Network.Protocol.LocalTxSubmission.Client
-import           Ouroboros.Network.Protocol.LocalTxSubmission.Codec
-import           Ouroboros.Network.Protocol.ChainSync.Type (ChainSync)
-import           Ouroboros.Network.Protocol.ChainSync.Client
-                   (ChainSyncClient(..), chainSyncClientPeer)
+import           Ouroboros.Network.Mux
+import           Ouroboros.Network.NodeToClient
+import           Ouroboros.Network.Protocol.ChainSync.Client (ChainSyncClient (..),
+                                                              chainSyncClientPeer)
 import           Ouroboros.Network.Protocol.ChainSync.Codec
+import           Ouroboros.Network.Protocol.ChainSync.Type (ChainSync)
 import           Ouroboros.Network.Protocol.Handshake.Version
-import           Ouroboros.Network.NodeToClient
+import           Ouroboros.Network.Protocol.LocalTxSubmission.Client
+import           Ouroboros.Network.Protocol.LocalTxSubmission.Codec
+import           Ouroboros.Network.Protocol.LocalTxSubmission.Type
 
 import           Cardano.Node.CLI
 

cardano-node.cabal

@@ -62,6 +62,7 @@ executable cardano-node
                        GitRevFromGit
                        Paths_cardano_node
                        TraceAcceptor
+                       TxGeneration
                        TxSubmission
                        Run
                        Topology

scripts/demo2.sh

@@ -11,8 +11,8 @@ NOW=`date "+%Y-%m-%d 00:00:00"`
 NETARGS="--system-start '${NOW}' --slot-duration 2 node -t configuration/simple-topology.json ${ALGO}"
 ACCARGS="--system-start '${NOW}' --slot-duration 2 trace-acceptor"
 #SCR="./scripts/start-node.sh"
-#CMD="stack exec --nix cardano-node --"
-CMD=`find dist-newstyle/ -type f -name "cardano-node"`
+CMD="stack exec --nix cardano-node --"
+# CMD=`find dist-newstyle/ -type f -name "cardano-node"`
 #SPECIAL=""
 SPECIAL="--live-view"
 HOST="127.0.0.1"

scripts/generator.sh

@@ -0,0 +1,12 @@
+#!/usr/bin/env bash
+
+now=`date "+%Y-%m-%d 00:00:00"`
+CMD="stack exec --nix cardano-node -- "
+# CMD="cabal new-exec cardano-node -- "
+
+set -x
+${CMD} \
+    --system-start "$now" --slot-duration 2 \
+    --log-config configuration/log-configuration.yaml \
+    generate -t configuration/simple-topology.json \
+           $@

scripts/submit-tx.sh

@@ -1,8 +1,8 @@
 #!/usr/bin/env bash
 
 now=`date "+%Y-%m-%d 00:00:00"`
-#CMD="stack exec --nix cardano-node -- "
-CMD="cabal new-exec cardano-node -- "
+CMD="stack exec --nix cardano-node -- "
+# CMD="cabal new-exec cardano-node -- "
 
 set -x
 ${CMD} \

scripts/trace-acceptor.sh

@@ -3,7 +3,7 @@
 now=`date "+%Y-%m-%d 00:00:00"`
 
 set -x
-#stack exec cardano-node -- \
+# stack exec --nix cardano-node -- \
 #./cardano-node.exe \
 cabal new-exec cardano-node -- \
     --system-start "$now" --slot-duration 2 \