Merge #4460

4460: tx-generator: reusable API and library r=mgmeier a=mgmeier



Co-authored-by: Michael Karg <[email protected]>
Co-authored-by: Nadia Yvette Chambers <[email protected]>

Author: 3 people

bench/tx-generator/src/Cardano/Benchmarking/Command.hs

@@ -13,19 +13,20 @@ where
 import           Prelude
 import           System.Exit
 
+import           Data.Aeson (fromJSON)
 import           Data.ByteString.Lazy as BSL
 import           Data.Text.IO as T
 import           Options.Applicative as Opt
 
 import           Ouroboros.Network.NodeToClient (withIOManager)
 
 import           Cardano.Benchmarking.Compiler (compileOptions)
-import           Cardano.Benchmarking.NixOptions (NixServiceOptions, _nix_nodeConfigFile, _nix_cardanoTracerSocket,
-                   parseNixServiceOptions, setNodeConfigFile)
 import           Cardano.Benchmarking.Script (parseScriptFileAeson, runScript)
-import           Cardano.Benchmarking.Script.Aeson (prettyPrint)
+import           Cardano.Benchmarking.Script.Aeson (parseJSONFile, prettyPrint)
 import           Cardano.Benchmarking.Script.Selftest (runSelftest)
 import           Cardano.Benchmarking.Version as Version
+import           Cardano.TxGenerator.Setup.NixService
+
 
 data Command
   = Json FilePath
@@ -44,13 +45,13 @@ runCommand = withIOManager $ \iocp -> do
       script <- parseScriptFileAeson file
       runScript script iocp >>= handleError
     JsonHL file nodeConfigOverwrite cardanoTracerOverwrite -> do
-      opts <- parseNixServiceOptions file
+      opts <- parseJSONFile fromJSON file
       finalOpts <- mangleTracerConfig cardanoTracerOverwrite <$> mangleNodeConfig nodeConfigOverwrite opts
       case compileOptions finalOpts of
         Right script -> runScript script iocp >>= handleError
         err -> handleError err
     Compile file -> do
-      o <- parseNixServiceOptions file
+      o <- parseJSONFile fromJSON file
       case compileOptions o of
         Right script -> BSL.putStr $ prettyPrint script
         err -> handleError err
@@ -63,7 +64,7 @@ runCommand = withIOManager $ \iocp -> do
     Left err -> die $ show err
 
   mangleNodeConfig :: Maybe FilePath -> NixServiceOptions -> IO NixServiceOptions
-  mangleNodeConfig fp opts = case (_nix_nodeConfigFile opts, fp) of
+  mangleNodeConfig fp opts = case (getNodeConfigFile opts, fp) of
     (_      , Just newFilePath) -> return $ setNodeConfigFile opts newFilePath
     (Just _ , Nothing) -> return opts
     (Nothing, Nothing) -> die "No node-configFile set"

bench/tx-generator/src/Cardano/Benchmarking/Compiler.hs

@@ -1,39 +1,41 @@
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE LambdaCase #-}
+{-# OPTIONS_GHC -fno-warn-incomplete-uni-patterns #-}
 module Cardano.Benchmarking.Compiler
 where
 
 import           Prelude
 
 import           Control.Applicative (liftA2)
 import           Control.Monad
+import           Control.Monad.Trans.Class (lift)
 import           Control.Monad.Trans.Except
 import           Control.Monad.Trans.RWS.CPS
-import           Data.ByteString.Base16 as Base16
 import           Data.ByteString as BS (ByteString)
-import           Data.Dependent.Sum ( (==>) )
 import           Data.DList (DList)
 import qualified Data.DList as DL
 import           Data.Text (Text)
 import qualified Data.Text as Text
 
 import           Cardano.Api
-
-import           Cardano.Benchmarking.NixOptions
-import           Cardano.Benchmarking.Script.Setters
-import           Cardano.Benchmarking.Script.Store (KeyName, Name(..), WalletName)
 import           Cardano.Benchmarking.Script.Types
+import           Cardano.TxGenerator.Setup.NixService
+import           Cardano.TxGenerator.Setup.SigningKey
+import           Cardano.TxGenerator.Types (TxGenTxParams (..))
 
 data CompileError where
-  SomeCompilerError :: CompileError
+  SomeCompilerError :: String -> CompileError
   deriving (Show)
 type Compiler a = RWST NixServiceOptions (DList Action) Int (Except CompileError) a
 
+throwCompileError :: CompileError -> Compiler a
+throwCompileError = lift . throwE
+
 maxOutputsPerTx :: Int
 maxOutputsPerTx = 30
 
-type SrcWallet = WalletName
-type DstWallet = WalletName
+type SrcWallet = String
+type DstWallet = String
 
 compileOptions :: NixServiceOptions -> Either CompileError [Action]
 compileOptions opts = runCompiler opts compileToScript
@@ -51,84 +53,82 @@ testCompiler o c = case runExcept $ runRWST c o 0 of
 compileToScript :: Compiler ()
 compileToScript = do
   initConstants
-  StartProtocol <$> askNixOption getNodeConfigFile <*> askNixOption _nix_cardanoTracerSocket >>= emit
+  nc <- askNixOption getNodeConfigFile >>= maybe
+        (throwCompileError $ SomeCompilerError "nodeConfigFile not set in Nix options")
+        pure
+  tc <- askNixOption _nix_cardanoTracerSocket
+  emit $ StartProtocol nc tc
   genesisWallet <- importGenesisFunds
   collateralWallet <- addCollaterals genesisWallet
   splitWallet <- splittingPhase genesisWallet
   void $ benchmarkingPhase splitWallet collateralWallet
 
 initConstants :: Compiler ()
 initConstants = do
-  setN TLocalSocket          _nix_localNodeSocketPath
-  setConst  TTTL             1000000
+  p <- askNixOption _nix_localNodeSocketPath
+  emit $ SetSocketPath p
   emit $ DefineSigningKey keyNameTxGenFunds keyTxGenFunds
   emit $ DefineSigningKey keyNameCollaterals keyCollaterals
   emit $ DefineSigningKey keyNameSplitPhase keySplitPhase
   emit $ DefineSigningKey keyNameBenchmarkInputs keyBenchmarkInputs
   emit $ DefineSigningKey keyNameBenchmarkDone keyBenchmarkDone
-  where
-    setConst :: Tag v -> v -> Compiler ()
-    setConst key val = emit $ Set $ key ==> val 
 
-    setN :: Tag v -> (NixServiceOptions -> v) -> Compiler ()
-    setN key s = askNixOption s >>= setConst key
-
-importGenesisFunds :: Compiler WalletName
+importGenesisFunds :: Compiler String
 importGenesisFunds = do
   logMsg "Importing Genesis Fund."
   wallet <- newWallet "genesis_wallet"
   era <- askNixOption _nix_era
-  fee <- askNixOption _nix_tx_fee  
+  txParams <- askNixOption txGenTxParams
   cmd1 (ReadSigningKey keyNameGenesisInputFund) _nix_sigKey
-  emit $ Submit era LocalSocket $ SecureGenesis fee wallet keyNameGenesisInputFund keyNameTxGenFunds
+  emit $ Submit era LocalSocket txParams $ SecureGenesis wallet keyNameGenesisInputFund keyNameTxGenFunds
   delay
   logMsg "Importing Genesis Fund. Done."
   return wallet
 
-addCollaterals :: SrcWallet -> Compiler (Maybe WalletName)
+addCollaterals :: SrcWallet -> Compiler (Maybe String)
 addCollaterals src = do
   era <- askNixOption _nix_era
+  txParams <- askNixOption txGenTxParams
   isAnyPlutusMode >>= \case
     False -> return Nothing
     True -> do
       logMsg "Create collaterals."
       safeCollateral <- _safeCollateral <$> evilFeeMagic
       collateralWallet <- newWallet "collateral_wallet"
-      fee <- askNixOption _nix_tx_fee
-      let generator = Split fee src
+      let generator = Split src
                         (PayToAddr keyNameCollaterals collateralWallet)
                         (PayToAddr keyNameTxGenFunds src)
                         [ safeCollateral ]
-      emit $ Submit era LocalSocket generator
+      emit $ Submit era LocalSocket txParams generator
       logMsg "Create collaterals. Done."
       return $ Just collateralWallet
 
 splittingPhase :: SrcWallet -> Compiler DstWallet
 splittingPhase srcWallet = do
   tx_count <- askNixOption _nix_tx_count
   inputs_per_tx <- askNixOption _nix_inputs_per_tx
-  tx_fee <- askNixOption _nix_tx_fee
-  era <- askNixOption _nix_era  
+  era <- askNixOption _nix_era
+  txParams <- askNixOption txGenTxParams
   minValuePerInput <- _minValuePerInput <$> evilFeeMagic
   finalDest <- newWallet "final_split_wallet"
-  splitSteps <- splitSequenceWalletNames srcWallet finalDest $ unfoldSplitSequence tx_fee minValuePerInput (tx_count * inputs_per_tx)
+  splitSteps <- splitSequenceWalletNames srcWallet finalDest $
+    unfoldSplitSequence (txParamFee txParams) minValuePerInput (tx_count * inputs_per_tx)
   isPlutus <- isAnyPlutusMode
-  forM_ (init splitSteps) $ createChange False False era
-  createChange True isPlutus era $ last splitSteps
+  forM_ (init splitSteps) $ createChange txParams False False era
+  createChange txParams True isPlutus era $ last splitSteps
   return finalDest
  where
-  createChange :: Bool -> Bool -> AnyCardanoEra -> (SrcWallet, DstWallet, Split) -> Compiler ()
-  createChange isLastStep isPlutus era (src, dst, split) = do
+  createChange :: TxGenTxParams -> Bool -> Bool -> AnyCardanoEra -> (SrcWallet, DstWallet, Split) -> Compiler ()
+  createChange txParams isLastStep isPlutus era (src, dst, split) = do
     logMsg $ Text.pack $ "Splitting step: " ++ show split
-    tx_fee <- askNixOption _nix_tx_fee
     let valuePayMode = PayToAddr (if isLastStep then keyNameSplitPhase else keyNameBenchmarkInputs) dst
     payMode <- if isPlutus then plutusPayMode dst else return valuePayMode
     let generator = case split of
-          SplitWithChange lovelace count -> Split tx_fee src payMode (PayToAddr keyNameTxGenFunds src) $ replicate count lovelace
-          FullSplits txCount -> Take txCount $ Cycle $ SplitN tx_fee src payMode maxOutputsPerTx
-    emit $ Submit era LocalSocket generator
+          SplitWithChange lovelace count -> Split src payMode (PayToAddr keyNameTxGenFunds src) $ replicate count lovelace
+          FullSplits txCount -> Take txCount $ Cycle $ SplitN src payMode maxOutputsPerTx
+    emit $ Submit era LocalSocket txParams generator
     delay
-    logMsg "Splitting step: Done"    
+    logMsg "Splitting step: Done"
 
   plutusPayMode :: DstWallet -> Compiler PayMode
   plutusPayMode dst = do
@@ -175,44 +175,43 @@ unfoldSplitSequence fee value outputs
      (x, 0) -> x
      (x, _rest) -> x+1
 
-benchmarkingPhase :: WalletName -> Maybe WalletName -> Compiler WalletName
+benchmarkingPhase :: String -> Maybe String -> Compiler String
 benchmarkingPhase wallet collateralWallet = do
   debugMode <- askNixOption _nix_debugMode
   targetNodes <- askNixOption _nix_targetNodes
   tps <- askNixOption _nix_tps
   era <- askNixOption _nix_era
   txCount <- askNixOption _nix_tx_count
-  fee <- askNixOption _nix_tx_fee
   inputs <- askNixOption _nix_inputs_per_tx
   outputs <- askNixOption _nix_outputs_per_tx
-  metadataSize <- askNixOption _nix_add_tx_size
+  txParams <- askNixOption txGenTxParams
   doneWallet <- newWallet "done_wallet"
   let
     payMode = PayToAddr keyNameBenchmarkDone doneWallet
     submitMode = if debugMode
         then LocalSocket
-        else Benchmark targetNodes (ThreadName "tx-submit-benchmark") tps txCount
-    generator = Take txCount $ Cycle $ NtoM fee wallet payMode inputs outputs (Just metadataSize) collateralWallet
-  emit $ Submit era submitMode generator
+        else Benchmark targetNodes "tx-submit-benchmark" tps txCount
+    generator = Take txCount $ Cycle $ NtoM wallet payMode inputs outputs (Just $ txParamAddTxSize txParams) collateralWallet
+  emit $ Submit era submitMode txParams generator
   unless debugMode $ do
-    emit $ WaitBenchmark $ ThreadName "tx-submit-benchmark"
+    emit $ WaitBenchmark "tx-submit-benchmark"
   return doneWallet
 
 data Fees = Fees {
     _safeCollateral :: Lovelace
   , _minValuePerInput :: Lovelace
   }
-  
+
 evilFeeMagic :: Compiler Fees
 evilFeeMagic = do
   (Quantity tx_fee) <- lovelaceToQuantity <$> askNixOption _nix_tx_fee
-  plutusMode <- askNixOption _nix_plutusMode  
+  plutusMode <- askNixOption _nix_plutusMode
   inputs_per_tx <- askNixOption _nix_inputs_per_tx
-  outputs_per_tx <- askNixOption _nix_outputs_per_tx  
+  outputs_per_tx <- askNixOption _nix_outputs_per_tx
   (Quantity min_utxo_value)  <- lovelaceToQuantity <$> askNixOption _nix_min_utxo_value
   let
-    scriptFees = 5000000;
-    collateralPercentage = 200;
+    scriptFees = 5000000;           -- FIXME: should be taken from ProtocolParameters
+    collateralPercentage = 200;     -- FIXME: should be taken from ProtocolParameters
 
     totalFee = if plutusMode
                then tx_fee + scriptFees * fromIntegral inputs_per_tx
@@ -233,7 +232,7 @@ logMsg = emit . LogMsg
 
 cmd1 :: (v -> Action) -> (NixServiceOptions -> v) -> Compiler ()
 cmd1 cmd arg = emit . cmd =<< askNixOption arg
-  
+
 askNixOption :: (NixServiceOptions -> v) -> Compiler v
 askNixOption = asks
 
@@ -255,60 +254,55 @@ newIdentifier prefix = do
   put $ succ n
   return $ prefix ++ "_" ++ show n
 
-newWallet :: String -> Compiler WalletName
+newWallet :: String -> Compiler String
 newWallet n = do
-  name <- WalletName <$> newIdentifier n
+  name <- newIdentifier n
   emit $ InitWallet name
   return name
 
-parseKey :: BS.ByteString -> TextEnvelope
-parseKey x = case Base16.decode x of
-  Left err -> error $ "parsing of key failed : " ++ show err
-  Right addr ->  TextEnvelope
-    { teType = TextEnvelopeType "PaymentSigningKeyShelley_ed25519"
-    , teDescription = "Payment Signing Key"
-    , teRawCBOR = addr
-    }
-
+-- we assume the hardcoded base16 keys to successfully evaluate to a SigningKey PaymentKey
+parseKey :: BS.ByteString -> SigningKey PaymentKey
+parseKey k
+  = let ~(Right k') = parseSigningKeyBase16 k in k'
 
-keyNameGenesisInputFund :: KeyName
-keyNameGenesisInputFund = KeyName "GenesisInputFund"
+keyNameGenesisInputFund :: String
+keyNameGenesisInputFund = "GenesisInputFund"
 
-keyNameTxGenFunds :: KeyName
-keyNameTxGenFunds = KeyName "TxGenFunds"
+keyNameTxGenFunds :: String
+keyNameTxGenFunds = "TxGenFunds"
 
 {-|
 The key that is used for the very first transaction, i.e. the secure Genesis transaction.
 addr_test1vzd3muund27y5nw83vymqj3a83pcuzkkejej6s75e5lfjcc85nc3p is the actual address (in Testnet 42).
 It is also used as change addresse in the first splitting-step.
 -}
-keyTxGenFunds :: TextEnvelope
+keyTxGenFunds :: SigningKey PaymentKey
 keyTxGenFunds = parseKey "5820617f846fc8b0e753bd51790de5f5a916de500175c6f5a0e27dde9da7879e1d35"
 
-keyNameSplitPhase :: KeyName
-keyNameSplitPhase = KeyName "SplitPhase"
+keyNameSplitPhase :: String
+keyNameSplitPhase = "SplitPhase"
 
 {-|
 UTxOs that are generated in intermediate splitting steps use:
 addr_test1vz45dtkyzk6s3245qw8hmaddaatcx8td3pvmntl8ty7q99c22eahm
 -}
 
-keySplitPhase :: TextEnvelope
+keySplitPhase :: SigningKey PaymentKey
 keySplitPhase = parseKey "5820cf0083c2a5d4c90ab255bc8e68f407d52eebd9408de60a0b9e4c468f9714f076"
 
 {-|
 UTxOs of the final splitting steps, i.e. the inputs of the benchmarking phase, use:
 addr_test1vzj7zv9msmdasvy5nc9jhnn2gqvrvu33v5rlg332zdfrkugklxkau
 (Plutus script addresses are ofc different.)
 -}
-keyNameBenchmarkInputs :: KeyName
-keyNameBenchmarkInputs = KeyName "BenchmarkInputs"
+keyNameBenchmarkInputs :: String
+keyNameBenchmarkInputs = "BenchmarkInputs"
 
-keyBenchmarkInputs :: TextEnvelope
+keyBenchmarkInputs :: SigningKey PaymentKey
 keyBenchmarkInputs = parseKey "58205b7f272602661d4ad3d9a4081f25fdcdcdf64fdc4892107de50e50937b77ea42"
 
-keyNameBenchmarkDone :: KeyName
-keyNameBenchmarkDone = KeyName "BenchmarkingDone"
+keyNameBenchmarkDone :: String
+keyNameBenchmarkDone = "BenchmarkingDone"
 
 {-|
 The output of the actual benchmarking transactions use:
@@ -317,15 +311,15 @@ Query the progress of the benchmarking phase:
 `cardano-node query utxo --testnet-magic 42 --address addr_test1vz4qz2ayucp7xvnthrx93uhha7e04gvxttpnuq4e6mx2n5gzfw23z`
 -}
 
-keyBenchmarkDone :: TextEnvelope
+keyBenchmarkDone :: SigningKey PaymentKey
 keyBenchmarkDone = parseKey "582016ca4f13fa17557e56a7d0dd3397d747db8e1e22fdb5b9df638abdb680650d50"
 
-keyNameCollaterals :: KeyName
-keyNameCollaterals = KeyName "Collaterals"
+keyNameCollaterals :: String
+keyNameCollaterals = "Collaterals"
 
 {-|
 Collateral inputs for Plutus transactions:
 addr_test1vpckd9muw3l4f8ne4uzumy28p0k84rvx48q46kssjkta5ng4v6sfs
 -}
-keyCollaterals :: TextEnvelope
+keyCollaterals :: SigningKey PaymentKey
 keyCollaterals = parseKey "58204babdb63537ccdac393ea23d042af3b7c3587d7dc88ed3b66c959f198ad358fa"