tx-generator: add literate keys and manual funds in tx-generator scri…

…pts. This PR adds support for literate keys and UTxO in tx-generator scripts. bench/script/test-stand-alone.json is a standalone script that writes TXs to a file without connecting to a node.
IntersectMBO · Dec 9, 2021 · 4100b17 · 4100b17
1 parent 7fd61e9
commit 4100b17
Show file tree

Hide file tree

Showing 4 changed files with 54 additions and 19 deletions.
diff --git a/bench/script/test-stand-alone.json b/bench/script/test-stand-alone.json
@@ -7,8 +7,19 @@
     { "Set": { "SMinValuePerUTxO": 1000000 } },
     { "Set": { "STTL": 1000000 } },
     { "Set": { "SEra": "Allegra" } },
-    { "Set": { "SNetworkId": "Mainnet" } },    
-    { "ReadSigningKey": [ "pass-partout", "run/current/genesis/utxo-keys/utxo1.skey" ] },
+    { "Set": { "SNetworkId": { "Testnet": 42 } } },
+    { "DefineSigningKey":
+      [ "pass-partout"
+      , {
+          "type": "GenesisUTxOSigningKey_ed25519",
+          "description": "Genesis Initial UTxO Signing Key",
+          "cborHex": "58200b6c317eb6c9762898fa41ca9d683003f86899ab0f2f6dbaf244e415b62826a2"
+      } ] },
+    { "AddFund":
+      [ "900fc5da77a0747da53f7675cbb7d149d46779346dea2f879ab811ccc72a2162#0"
+      , 90000000000000
+      , "pass-partout"
+      ] },
     { "CreateChange": [
             { "DumpToFile": "/tmp/script-txs.txt" },
             { "PayToAddr": "pass-partout" },

diff --git a/bench/tx-generator/src/Cardano/Benchmarking/Script/Action.hs b/bench/tx-generator/src/Cardano/Benchmarking/Script/Action.hs
@@ -15,6 +15,8 @@ action a = case a of
   SetProtocolParameters p -> setProtocolParameters p
   StartProtocol filePath -> startProtocol filePath
   ReadSigningKey name filePath -> readSigningKey name filePath
+  DefineSigningKey name descr -> defineSigningKey name descr
+  AddFund txIn lovelace keyName -> addFund txIn lovelace keyName
   SecureGenesisFund fundName fundKey genesisKey -> secureGenesisFund fundName fundKey genesisKey
   SplitFund newFunds newKey sourceFund -> splitFund  newFunds newKey sourceFund
   SplitFundToList fundList destKey sourceFund -> splitFundToList fundList destKey sourceFund

diff --git a/bench/tx-generator/src/Cardano/Benchmarking/Script/Core.hs b/bench/tx-generator/src/Cardano/Benchmarking/Script/Core.hs
@@ -98,6 +98,40 @@ readSigningKey name filePath =
     Left err -> liftTxGenError err
     Right key -> setName name key
 
+defineSigningKey :: KeyName -> TextEnvelope -> ActionM ()
+defineSigningKey name descr
+  = case deserialiseFromTextEnvelopeAnyOf types descr of
+    Right key -> setName name key
+    Left err -> throwE $ ApiError $ show err
+  where
+    types :: [FromSomeType HasTextEnvelope (SigningKey PaymentKey)]
+    types =
+      [ FromSomeType (AsSigningKey AsGenesisUTxOKey) castSigningKey
+      , FromSomeType (AsSigningKey AsPaymentKey) id
+      ]
+
+addFund :: TxIn -> Lovelace -> KeyName -> ActionM ()
+addFund txIn lovelace keyName = do
+  fundKey  <- getName keyName
+  let
+    mkOutValue :: forall era. IsShelleyBasedEra era => AsType era -> ActionM (InAnyCardanoEra TxOutValue)
+    mkOutValue = \_ -> return $ InAnyCardanoEra (cardanoEra @ era) (mkTxOutValueAdaOnly lovelace)
+  outValue <- withEra mkOutValue
+  addFundToWallet txIn outValue fundKey
+
+addFundToWallet :: TxIn -> InAnyCardanoEra TxOutValue -> SigningKey PaymentKey -> ActionM ()
+addFundToWallet txIn outVal skey = do
+  wallet <- get GlobalWallet
+  liftIO (walletRefInsertFund wallet (FundSet.Fund $ mkFund outVal))
+  where
+    mkFund = liftAnyEra $ \value -> FundInEra {
+           _fundTxIn = txIn
+         , _fundVal = value
+         , _fundSigningKey = Just skey
+         , _fundValidity = Confirmed
+         , _fundVariant = PlainOldFund
+         }
+
 getLocalSubmitTx :: ActionM LocalSubmitTx
 getLocalSubmitTx = submitTxToNodeLocal <$> getLocalConnectInfo
 
@@ -507,8 +541,6 @@ dumpToFile filePath tx = liftIO $ dumpToFileIO filePath tx
 dumpToFileIO :: FilePath -> TxInMode CardanoMode -> IO ()
 dumpToFileIO filePath tx = appendFile filePath ('\n' : show tx)
 
--- Todo: make it possible to import several funds
--- (Split init and import)
 importGenesisFund
    :: SubmitMode
    -> KeyName
@@ -536,20 +568,8 @@ importGenesisFund submitMode genesisKeyName destKey = do
   result <- liftCoreWithEra coreCall
   case result of 
     Left err -> liftTxGenError err
-    Right fund -> addToWallet fund
-  where
-    addToWallet ((txIn, outVal), skey) = do
-      let
-        mkFund = liftAnyEra $ \value -> FundInEra {
-           _fundTxIn = txIn
-         , _fundVal = value
-         , _fundSigningKey = Just skey
-         , _fundValidity = Confirmed
-         , _fundVariant = PlainOldFund
-         }
-      wallet <- get GlobalWallet
-      liftIO (walletRefInsertFund wallet (FundSet.Fund $ mkFund outVal))
-
+    Right ((txIn, outVal), skey) -> addFundToWallet txIn outVal skey
+
 initGlobalWallet :: ActionM ()
 initGlobalWallet = liftIO initWallet >>= set GlobalWallet
 

diff --git a/bench/tx-generator/src/Cardano/Benchmarking/Script/Types.hs b/bench/tx-generator/src/Cardano/Benchmarking/Script/Types.hs
@@ -15,7 +15,7 @@ import           Prelude
 import           GHC.Generics
 
 import           Cardano.Benchmarking.OuroborosImports (SigningKeyFile)
-import           Cardano.Api (AnyCardanoEra, ExecutionUnits, Lovelace, ScriptData, ScriptRedeemer)
+import           Cardano.Api (AnyCardanoEra, ExecutionUnits, Lovelace, ScriptData, ScriptRedeemer, TextEnvelope, TxIn)
 
 import           Cardano.Benchmarking.Script.Env
 import           Cardano.Benchmarking.Script.Store
@@ -27,6 +27,8 @@ data Action where
   StartProtocol      :: !FilePath -> Action
   Delay              :: !Double -> Action
   ReadSigningKey     :: !KeyName -> !SigningKeyFile -> Action
+  DefineSigningKey   :: !KeyName -> !TextEnvelope -> Action
+  AddFund            :: !TxIn -> !Lovelace -> !KeyName -> Action
   SecureGenesisFund  :: !FundName -> !KeyName -> !KeyName -> Action
   SplitFund          :: [FundName] -> !KeyName -> !FundName -> Action
   SplitFundToList    :: !FundListName -> !KeyName -> !FundName -> Action