Skip to content

Commit

Permalink
Merge #3427
Browse files Browse the repository at this point in the history
3427: tx-generator: add literate keys and manual funds. r=MarcFontaine a=MarcFontaine

This PR adds support for literate keys in benchmarking scripts
and manual definition of funds.

Co-authored-by: MarcFontaine <MarcFontaine@users.noreply.github.com>
  • Loading branch information
iohk-bors[bot] and MarcFontaine authored Dec 9, 2021
2 parents f37337c + 4100b17 commit 04f50a1
Show file tree
Hide file tree
Showing 4 changed files with 54 additions and 19 deletions.
15 changes: 13 additions & 2 deletions bench/script/test-stand-alone.json
Original file line number Diff line number Diff line change
Expand Up @@ -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" },
Expand Down
2 changes: 2 additions & 0 deletions bench/tx-generator/src/Cardano/Benchmarking/Script/Action.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
52 changes: 36 additions & 16 deletions bench/tx-generator/src/Cardano/Benchmarking/Script/Core.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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

Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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

Expand Down
4 changes: 3 additions & 1 deletion bench/tx-generator/src/Cardano/Benchmarking/Script/Types.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -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
Expand Down

0 comments on commit 04f50a1

Please sign in to comment.