tx-generator: add literate keys.

This PR adds support for literate keys in benchmarking scripts.
IntersectMBO · Dec 8, 2021 · 9a44f75 · 9a44f75
1 parent 7fd61e9
commit 9a44f75
Show file tree

Hide file tree

Showing 4 changed files with 22 additions and 2 deletions.
diff --git a/bench/script/test-stand-alone.json b/bench/script/test-stand-alone.json
@@ -8,7 +8,13 @@
     { "Set": { "STTL": 1000000 } },
     { "Set": { "SEra": "Allegra" } },
     { "Set": { "SNetworkId": "Mainnet" } },    
-    { "ReadSigningKey": [ "pass-partout", "run/current/genesis/utxo-keys/utxo1.skey" ] },
+    { "DefineSigningKey":
+      [ "pass-partout"
+      , {
+          "type": "GenesisUTxOSigningKey_ed25519",
+          "description": "Genesis Initial UTxO Signing Key",
+          "cborHex": "58200b6c317eb6c9762898fa41ca9d683003f86899ab0f2f6dbaf244e415b62826a2"
+      } ] },
     { "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,7 @@ 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
   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,18 @@ 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
+      ]
+
 getLocalSubmitTx :: ActionM LocalSubmitTx
 getLocalSubmitTx = submitTxToNodeLocal <$> getLocalConnectInfo
 

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)
 
 import           Cardano.Benchmarking.Script.Env
 import           Cardano.Benchmarking.Script.Store
@@ -27,6 +27,7 @@ data Action where
   StartProtocol      :: !FilePath -> Action
   Delay              :: !Double -> Action
   ReadSigningKey     :: !KeyName -> !SigningKeyFile -> Action
+  DefineSigningKey   :: !KeyName -> !TextEnvelope -> Action
   SecureGenesisFund  :: !FundName -> !KeyName -> !KeyName -> Action
   SplitFund          :: [FundName] -> !KeyName -> !FundName -> Action
   SplitFundToList    :: !FundListName -> !KeyName -> !FundName -> Action