WIP named Wallets: TODO: fix handling of plutus collaterals

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

@@ -18,7 +18,7 @@ import           Cardano.Api
 import           Cardano.Benchmarking.Types
 import           Cardano.Benchmarking.NixOptions
 import           Cardano.Benchmarking.Script.Setters
-import           Cardano.Benchmarking.Script.Store (Name(..))
+import           Cardano.Benchmarking.Script.Store (Name(..), WalletName)
 import           Cardano.Benchmarking.Script.Types
 
 data CompileError where
@@ -34,19 +34,21 @@ runCompiler c o = case runExcept $ runRWST c o 0 of
   Left err -> Left err
   Right ((), _ , l) -> Right $ DL.toList l
 
-testCompiler :: Compiler a -> NixServiceOptions -> Either CompileError (a, (), [Action])
-testCompiler c o = case runExcept $ runRWST c o () of
+testCompiler :: Compiler a -> NixServiceOptions -> Either CompileError (a, Int, [Action])
+testCompiler c o = case runExcept $ runRWST c o 0 of
   Left err -> Left err
   Right (a, s , l) -> Right (a, s, DL.toList l)
 
 compileToScript :: Compiler ()
 compileToScript = do
   initConstants
   emit . StartProtocol =<< askNixOption _nix_nodeConfigFile
-  wallet <- importGenesisFunds
-  initCollaterals
-  splittingPhase
-  benchmarkingPhase
+  genesisWallet <- newWalletName "genesis_wallet"
+  initWallet genesisWallet
+  importGenesisFunds genesisWallet
+  initCollaterals genesisWallet
+  splitWallet <- splittingPhase genesisWallet
+  benchmarkingPhase splitWallet
 
 initConstants :: Compiler ()
 initConstants = do
@@ -67,14 +69,12 @@ initConstants = do
     setN :: Tag v -> (NixServiceOptions -> v) -> Compiler ()
     setN key s = askNixOption s >>= setConst key
 
-importGenesisFunds :: Compiler WalletName
-importGenesisFunds = do
-  wallet <- WalletName <$> newIdentifier
-  emit $ InitWallet wallet
+importGenesisFunds :: WalletName -> Compiler ()
+importGenesisFunds wallet = do
+  initWallet wallet
   cmd1 (ReadSigningKey $ KeyName "pass-partout") _nix_sigKey
   emit $ ImportGenesisFund wallet LocalSocket (KeyName "pass-partout") (KeyName "pass-partout")
   delay
-  return wallet
 
 -- Todo: will not work !!
 initCollaterals :: WalletName -> Compiler ()
@@ -88,45 +88,51 @@ initCollaterals wallet = do
       emit $ CreateChange wallet wallet LocalSocket (PayToCollateral $ KeyName "pass-partout") safeCollateral 1
 
 splittingPhase :: WalletName -> Compiler WalletName
-splittingPhase = do
+splittingPhase srcWallet = do
   (NumberOfTxs tx_count) <- askNixOption _nix_tx_count
   (NumberOfInputsPerTx inputs_per_tx) <- askNixOption _nix_inputs_per_tx
   minValuePerInput <- _minValuePerInput <$> evilFeeMagic
   plutus <- isAnyPlutusMode
-  if plutus then createChangeRecursivePlutus minValuePerInput (tx_count * inputs_per_tx)
-            else createChangeRecursive       minValuePerInput (tx_count * inputs_per_tx)
+  if plutus then createChangeRecursivePlutus srcWallet minValuePerInput (tx_count * inputs_per_tx)
+            else createChangeRecursive       srcWallet minValuePerInput (tx_count * inputs_per_tx)
  where
   createChangeRecursive :: WalletName -> Lovelace -> Int -> Compiler WalletName
   createChangeRecursive inWallet value count = do
-    when (count > 30) $ do
-      tx_fee <- askNixOption _nix_tx_fee
-      w2 <- createChangeRecursive (value * 30 + tx_fee) (count `div` 30 + 1)
-    createChange w2 value count
-
+    if count > 30
+      then do
+        tx_fee <- askNixOption _nix_tx_fee
+        w2 <- createChangeRecursive inWallet (value * 30 + tx_fee) (count `div` 30 + 1)
+        createChange w2 value count
+      else createChange inWallet value count
+
   createChangeRecursivePlutus :: WalletName -> Lovelace -> Int -> Compiler WalletName
   createChangeRecursivePlutus inWallet value count = do
-    when (count > 30) $ do
-      tx_fee <- askNixOption _nix_tx_fee
-      w2 <- createChangeRecursive (value * 30 + tx_fee) (count `div` 30 + 1)
-    createChangePlutus w2 value count
+    if count > 30
+      then do
+        tx_fee <- askNixOption _nix_tx_fee
+        w2 <- createChangeRecursive inWallet (value * 30 + tx_fee) (count `div` 30 + 1)
+        createChangePlutus w2 value count
+      else createChangePlutus inWallet value count
 
   createChange :: WalletName -> Lovelace -> Int -> Compiler WalletName
   createChange inWallet value count = do
-     outWallet <- WalletName <$> newIdentifier
-     initWallet outWallet
+     outWallet <- newWalletName "create_change"
+     emit $ InitWallet outWallet
      emit $ CreateChange inWallet outWallet LocalSocket (PayToAddr $ KeyName "pass-partout") value count
      delay
+     return outWallet
 
   createChangePlutus :: WalletName -> Lovelace -> Int -> Compiler WalletName
   createChangePlutus inWallet value count = do
-     outWallet <- WalletName <$> newIdentifier
+     outWallet <- newWalletName "create_change_plutus"
      initWallet outWallet
      autoMode <- isPlutusAutoMode
      plutusTarget <- if autoMode
        then PayToScript <$> askNixOption _nix_plutusLoopScript <*> pure (ScriptDataNumber 0)
        else PayToScript <$> askNixOption _nix_plutusScript     <*> (ScriptDataNumber <$> askNixOption _nix_plutusData)
      emit $ CreateChange inWallet outWallet LocalSocket plutusTarget value count
      delay
+     return outWallet
 
 benchmarkingPhase :: WalletName -> Compiler ()
 benchmarkingPhase wallet = do
@@ -205,3 +211,9 @@ newIdentifier prefix = do
   n <- get
   put $ succ n
   return $ prefix ++ "_" ++ show n
+
+initWallet :: WalletName -> Compiler ()
+initWallet n = emit $ InitWallet n
+
+newWalletName :: String -> Compiler WalletName
+newWalletName n = WalletName <$> newIdentifier n

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

@@ -19,7 +19,7 @@ import           Cardano.Node.Configuration.Logging (shutdownLoggingLayer)
 import           Cardano.Benchmarking.Tracer (createDebugTracers)
 import           Cardano.Benchmarking.Script.Action
 import           Cardano.Benchmarking.Script.Aeson (parseScriptFileAeson)
-import           Cardano.Benchmarking.Script.Core (initWallet, setProtocolParameters)
+import           Cardano.Benchmarking.Script.Core (setProtocolParameters)
 import           Cardano.Benchmarking.Script.Env
 import           Cardano.Benchmarking.Script.Store
 import           Cardano.Benchmarking.Script.Types

bench/tx-generator/src/Cardano/Benchmarking/Script/Core.hs

@@ -116,12 +116,12 @@ addFund wallet txIn lovelace keyName = do
     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 wallet 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))
+addFundToWallet :: WalletName -> TxIn -> InAnyCardanoEra TxOutValue -> SigningKey PaymentKey -> ActionM ()
+addFundToWallet wallet txIn outVal skey = do
+  walletRef <- getName wallet
+  liftIO (walletRefInsertFund walletRef (FundSet.Fund $ mkFund outVal))
   where
     mkFund = liftAnyEra $ \value -> FundInEra {
            _fundTxIn = txIn
@@ -265,7 +265,8 @@ runBenchmarkInEra sourceWallet submitMode (ThreadName threadName) txCount tps er
   fee <- getUser TFee
   minValuePerUTxO <- getUser TMinValuePerUTxO
   protocolParameters <- getProtocolParameters
-  walletRef <- get globalWallet
+  walletRefSrc <- getName sourceWallet
+  let walletRefDst = walletRefSrc 
   metadata <- makeMetadata
   connectClient <- getConnectClient
   let
@@ -280,7 +281,7 @@ runBenchmarkInEra sourceWallet submitMode (ThreadName threadName) txCount tps er
 --    fundSource :: FundSet.Target -> FundSet.FundSource
 --    fundSource target = mkWalletFundSource walletRef $ FundSet.selectInputs ConfirmedBeforeReuse numInputs minTxValue PlainOldFund target
 
-  fundSource <- liftIO (mkBufferedSource walletRef
+  fundSource <- liftIO (mkBufferedSource walletRefSrc
                    (fromIntegral (unNumberOfTxs txCount) * numInputs)
                    minValuePerInput
                    PlainOldFund numInputs) >>= \case
@@ -296,10 +297,10 @@ runBenchmarkInEra sourceWallet submitMode (ThreadName threadName) txCount tps er
     toUTxO :: FundSet.Target -> FundSet.SeqNumber -> ToUTxO era
     toUTxO target seqNumber = Wallet.mkUTxO networkId fundKey (InFlight target seqNumber)
 
-    fundToStore = mkWalletFundStore walletRef
+    fundToStore = mkWalletFundStore walletRefDst
 
     walletScript :: FundSet.Target -> WalletScript era
-    walletScript = benchmarkWalletScript walletRef txGenerator txCount (const fundSource) inToOut toUTxO fundToStore
+    walletScript = benchmarkWalletScript walletRefSrc txGenerator txCount (const fundSource) inToOut toUTxO fundToStore
 
     coreCall :: AsType era -> ExceptT TxGenError IO AsyncBenchmarkControl
     coreCall eraProxy = GeneratorTx.walletBenchmark (btTxSubmit_ tracers) (btN2N_ tracers) connectClient
@@ -334,12 +335,15 @@ runPlutusBenchmark sourceWallet submitMode scriptFile scriptBudget scriptData sc
   executionUnitPrices <- case protocolParamPrices protocolParameters of
     Just x -> return x
     Nothing -> throwE $ WalletError "unexpected protocolParamPrices == Nothing in runPlutusBenchmark"
-  walletRef <- get globalWallet
+  walletRefSrc <- getName sourceWallet
+  let
+    walletRefDst = walletRefSrc -- TODO
+    walletRefCollateral = error "Core: walletRefCollateral"
   fundKey <- getName $ KeyName "pass-partout"
   script <- liftIO $ PlutusExample.readScript scriptFile
   -- This does not remove the collateral from the wallet, i.e. same collateral is uses for everything.
   -- This is fine unless a script ever fails.
-  collateralFunds <- liftIO ( askWalletRef walletRef (FundSet.selectCollateral . walletFunds)) >>= \case
+  collateralFunds <- liftIO ( askWalletRef walletRefCollateral (FundSet.selectCollateral . walletFunds)) >>= \case
     Right c -> return c
     Left err -> throwE $ WalletError err
   baseFee <- getUser TFee
@@ -389,7 +393,7 @@ runPlutusBenchmark sourceWallet submitMode scriptFile scriptBudget scriptData sc
 --    fundSource :: FundSet.Target -> FundSet.FundSource
 --    fundSource target = mkWalletFundSource walletRef $ FundSet.selectInputs ConfirmedBeforeReuse numInputs minTxValue PlainOldFund target
 
-  fundSource <- liftIO (mkBufferedSource walletRef
+  fundSource <- liftIO (mkBufferedSource walletRefSrc
                    (fromIntegral (unNumberOfTxs txCount) * numInputs)
                    minValuePerInput
                    (PlutusScriptFund scriptFile scriptData) numInputs) >>= \case
@@ -414,13 +418,13 @@ runPlutusBenchmark sourceWallet submitMode scriptFile scriptBudget scriptData sc
     collateral = (TxInsCollateral CollateralInAlonzoEra $  map getFundTxIn collateralFunds, collateralFunds)
     txGenerator = genTx protocolParameters collateral (mkFee totalFee) metadata (ScriptWitness ScriptWitnessForSpending scriptWitness)
 
-    fundToStore = mkWalletFundStore walletRef
+    fundToStore = mkWalletFundStore walletRefDst
 
     toUTxO :: FundSet.Target -> FundSet.SeqNumber -> ToUTxO AlonzoEra
     toUTxO target seqNumber = Wallet.mkUTxO networkId fundKey (InFlight target seqNumber)
 
     walletScript :: FundSet.Target -> WalletScript AlonzoEra
-    walletScript = benchmarkWalletScript walletRef txGenerator txCount (const fundSource) inToOut toUTxO fundToStore
+    walletScript = benchmarkWalletScript walletRefSrc txGenerator txCount (const fundSource) inToOut toUTxO fundToStore
 
   case submitMode of
     NodeToNode -> do
@@ -465,7 +469,7 @@ importGenesisFund wallet submitMode genesisKeyName destKey = do
   result <- liftCoreWithEra coreCall
   case result of 
     Left err -> liftTxGenError err
-    Right ((txIn, outVal), skey) -> addFundToWallet txIn outVal skey
+    Right ((txIn, outVal), skey) -> addFundToWallet wallet txIn outVal skey
 
 initWallet :: WalletName -> ActionM ()
 initWallet name = liftIO Wallet.initWallet >>= setName name
@@ -480,7 +484,7 @@ createChange sourceWallet dstWallet submitMode payMode value count = case payMod
 
 createChangeScriptFunds :: WalletName -> WalletName -> SubmitMode -> FilePath -> ScriptData -> Lovelace -> Int -> ActionM ()
 createChangeScriptFunds sourceWallet dstWallet submitMode scriptFile scriptData value count = do
-  walletRef <- get globalWallet
+  walletRef <- getName dstWallet
   networkId <- getUser TNetworkId
   protocolParameters <- getProtocolParameters
   _fundKey <- getName $ KeyName "pass-partout"
@@ -516,8 +520,8 @@ createChangeInEra :: forall era. IsShelleyBasedEra era
   -> ActionM ()
 createChangeInEra sourceWallet dstWallet submitMode variant keyName value count _proxy = do
   networkId <- getUser TNetworkId
+  walletRef <- getName dstWallet
   fee <- getUser TFee
-  walletRef <- get globalWallet
   protocolParameters <- getProtocolParameters
   fundKey <- getName keyName
   let
@@ -537,7 +541,7 @@ createChangeInEra sourceWallet dstWallet submitMode variant keyName value count
                                                   fundSource inOut toUTxO fundToStore
       return $ fmap txInModeCardano tx
     addressMsg = Text.unpack $ serialiseAddress $ keyAddress @ era networkId fundKey
-  createChangeGeneric  sourceWallet dstWallet submitMode createCoins addressMsg value count
+  createChangeGeneric sourceWallet dstWallet submitMode createCoins addressMsg value count
 
 createChangeGeneric ::
      WalletName
@@ -550,7 +554,7 @@ createChangeGeneric ::
   -> ActionM ()
 createChangeGeneric sourceWallet dstWallet submitMode createCoins addressMsg value count = do
   fee <- getUser TFee
-  walletRef <- get globalWallet
+  walletRef <- getName sourceWallet
   let
     coinsList = replicate count value
     maxTxSize = 30

bench/tx-generator/src/Cardano/Benchmarking/Script/Example.hs

@@ -60,6 +60,7 @@ testScript =
   , Reserved []
   ]
  where
+  globalWalletName = WalletName "test_wallet"
   scriptDef = SpendScript "filePath" (StaticScriptBudget $ ExecutionUnits 70000000 70000000) (ScriptDataNumber 3) (ScriptDataNumber 6)
   passPartout = KeyName "pass-partout"