Update to BPI with adjusted collateral creation

CHANGELOG.md

@@ -7,6 +7,16 @@ This format is based on [Keep A Changelog](https://keepachangelog.com/en/1.0.0).
 - Wallets with Base Address support
 - Lookups for wallets in tasty integration
 
+## [1.3.1] - 2022-11-04
+
+### Fixed
+
+- collateral creation - happens now before user contract execution
+
+### Added
+
+- collateral handling documentation
+
 ## [1.3.0] - 2022-10-26
 
 ### Added

README.md

@@ -36,7 +36,11 @@ If your project is importing and making use of `Plutip`s library you will need t
 
 And the following ghc flag must to be set for the test execution: `-Wall -threaded -rtsopts`
 
-NOTE: This branch launches local network in `Vasil`. It was tested with node `1.35.3` (this node version used in nix environment as well). Please use appropriate node version when setting up own binaries in `PATH`.
+## NOTES
+
+⚠️ This branch launches local network in `Vasil`. It was tested with node `1.35.3` (this node version used in nix environment as well). Please use appropriate node version when setting up own binaries in `PATH`.
+
+⚠️ [Collateral handling](./docs/collateral-handling.md)
 
 ## Tutorials
 

contract-execution/Main.hs

@@ -41,9 +41,12 @@ main = do
       extraConf = def {ecSlotLength = slotLen}
       plutipConfig = def {extraConfig = extraConf}
 
+      addSomeWalletWithCollateral funds =
+        addSomeWallet (toAda 10 : funds)
+
   putStrLn "Starting cluster..."
   (st, _) <- startCluster plutipConfig $ do
-    w <- addSomeWallet [toAda 10]
+    w <- addSomeWalletWithCollateral [toAda 100]
     liftIO $ putStrLn "Waiting for wallets to be funded..."
     CI.awaitWalletFunded w slotLen
 

docs/collateral-handling.md

@@ -0,0 +1,38 @@
+# Collateral handling
+
+Before running *any* contract `Plutip` under the hood creates dedicated UTxO at "own" wallet address to be used *only* as collateral. This UTxO is created by submitting transaction and spending "own" wallet's funds . For collateral `Plutip` always uses **10 Ada** at this point and if wallet address already has UTxO with 10 Ada on it, then Plutip will use it as collateral.
+
+UTxO that was created or picked for collateral is stored in memory, so during Contract execution `Plutip` will always use this exact same UTxO. Collateral UTxO has special properties - to guard it from being consumed by accident it is not accessible from Contract. I.e. calls like `utxosAt` ***will not return*** UTxO used for collateral. This means, that users don't have to care really about collateral UTxO during contract execution.
+
+The only place where collateral "sticks out" is the moment of wallet creation. Ii is also visible for `cardano-cli` queries.
+
+## Cluster runner
+
+With [cluster runners](../local-cluster/README.md), when creating wallet with `addSomeWallet [100_000_000]`, if you want to have UTxO with exactly 100 Ada while running the Contract, you should add 10 Ada more to wallet's initial distribution, or UTxO with 100 Ada will be used to create collateral.
+
+E.g.:
+
+```haskell
+main :: IO ()
+main = do
+  let executeContract wallet contract =
+     ask >>= \cEnv -> runContract cEnv wallet contract
+
+  (st, _) <- startCluster def $ do
+    w <- addSomeWallet [100_000_000, 10_000_000] -- 10 Ada will be used as collateral
+    awaitWalletFunded w 1
+    result <- executeContract w someContract
+    doSomething result
+  stopCluster st
+```
+
+Or just make helper function:
+
+```haskell
+addSomeWalletWithCollateral funds =
+  addSomeWallet (toAda 10 : funds)
+```
+
+## Tasty integration
+
+For collateral handling in tasty integration see [Collateral handling section](./tasty-integration.md#collateral-handling).

docs/tasty-integration.md

@@ -126,7 +126,9 @@ To assert the final `Value` which `wallet` will have after contract execution sp
 * `initAdaAssertValue [100] 133` - initialize `wallet` with single UTxO with 100 Ada and check that after contract execution final `Value` of all `wallet`'s UTxOs is equal to 133 Ada.
 * `initAndAssertLovelaceWith [1_000_000] VGt 2_000_000` - initialize `wallet` with single UTxO with 1000000 Lovelace and check that after contract execution final `Value` of all `wallet`'s UTxOs is *greater than* 2000000 Lovelace.
 
-***One important note*** is that Plutip creates dedicated UTxO to be used *only* as collateral under the hood. This UTxO would normally be created by spending wallets funds, and the transaction fee and Ada amount used for collateral UTxO would mess up balance assertions. So when using assertions for `Value` it is advised to wrap `wallets` initialization with `withCollateral` function. This simply adds a small UTxO to the `wallets`'s balance during network setup that is then picked up for collateral instead avoiding the problem. Use it like so:
+#### Collateral handling
+
+***One important note*** is that Plutip creates dedicated UTxO to be used *only* as collateral under the hood. This UTxO would normally be created by spending wallets funds, and the transaction fee and Ada amount used for collateral UTxO would mess up balance assertions. So when using any kind of assertions for `Value` it is advised to wrap `wallets` initialization with `withCollateral` function. This simply adds a small UTxO to the `wallets`'s balance during network setup that is then picked up for collateral instead avoiding the problem. Use it like so:
 
 ```haskell
 ( withCollateral $

flake.nix

@@ -11,7 +11,7 @@
       flake = false;
     };
     bot-plutus-interface.url =
-      "github:mlabs-haskell/bot-plutus-interface?ref=d6cf1e3686bc31bb2571c6feefbe28e3a2c8bb06";
+      "github:mlabs-haskell/bot-plutus-interface?ref=2f4b4c5104bd573039995d6d7eef0c9235ddbc32";
   };
 
   outputs =

local-cluster/Main.hs

@@ -79,8 +79,11 @@ main = do
         amt -> Right $ fromInteger . toInteger $ amt
 
     initWallets numWallets numUtxos amt dirWallets = do
+      let collateralAmount = 10_000_000
       replicateM (max 0 numWallets) $
-        addSomeWalletDir (replicate numUtxos amt) dirWallets
+        addSomeWalletDir
+          (collateralAmount : replicate numUtxos amt)
+          dirWallets
 
     printWallet (w, n) = do
       putStrLn $ "Wallet " ++ show n ++ " PKH: " ++ show (walletPkh w)

local-cluster/README.md

@@ -55,7 +55,7 @@ main = do
      ask >>= \cEnv -> runContract cEnv wallet contract
 
   (st, _) <- startCluster def $ do
-    w <- addSomeWallet [100_000_000]
+    w <- addSomeWallet [100_000_000, 10_000_000] -- 10 Ada will be used as collateral
     awaitWalletFunded w 1
     result <- executeContract w someContract
     doSomething result

plutip-server/Main.hs

@@ -1,5 +1,3 @@
-{-# LANGUAGE NumericUnderscores #-}
-
 module Main (main) where
 
 import Api (app)

src/Test/Plutip/Contract.hs

@@ -141,7 +141,13 @@ import BotPlutusInterface.Types (
  )
 
 import Control.Arrow (left)
-import Control.Monad.Reader (MonadIO (liftIO), MonadReader (ask), ReaderT, runReaderT, void)
+import Control.Monad.Reader (
+  MonadIO (liftIO),
+  MonadReader (ask),
+  ReaderT,
+  runReaderT,
+  withReaderT,
+ )
 import Data.Bool (bool)
 import Data.Kind (Type)
 import Data.List.NonEmpty (NonEmpty)
@@ -151,9 +157,8 @@ import Data.Row (Row)
 import Data.Tagged (Tagged (Tagged))
 import Data.Text qualified as Text
 import Ledger (PaymentPubKeyHash)
-import Ledger.Address (pubKeyHashAddress)
 import Ledger.Value (Value)
-import Plutus.Contract (Contract, waitNSlots)
+import Plutus.Contract (Contract)
 import PlutusPrelude (render)
 import Prettyprinter (Doc, Pretty (pretty), vcat, (<+>))
 import Test.Plutip.Contract.Init (
@@ -177,14 +182,15 @@ import Test.Plutip.Contract.Types (
   TestWallets (TestWallets, unTestWallets),
   ValueOrdering (VEq, VGEq, VGt, VLEq, VLt),
  )
-import Test.Plutip.Contract.Values (assertValues, valueAt)
+import Test.Plutip.Contract.Values (assertValues)
 import Test.Plutip.Internal.BotPlutusInterface.Run (runContract, runContractWithLogLvl)
 import Test.Plutip.Internal.BotPlutusInterface.Wallet (BpiWallet, ledgerPaymentPkh)
 import Test.Plutip.Internal.Types (
   ClusterEnv,
   ExecutionResult (contractLogs, outcome),
   budgets,
  )
+import Test.Plutip.LocalCluster (plutusValueFromWallet)
 import Test.Plutip.Options (TraceOption (ShowBudgets, ShowTrace, ShowTraceButOnlyContext))
 import Test.Plutip.Predicate (Predicate, noBudgetsMessage, pTag)
 import Test.Plutip.Tools.Format (fmtTxBudgets)
@@ -317,35 +323,23 @@ withContractAs walletIdx toContract = do
       -- to the user in `withContractAs`
       (ownWallet, otherWallets) = separateWallets walletIdx wallets'
 
-      {- these are `PaymentPubKeyHash`es of all wallets used in test case
-      they stay in list is same order as `TestWallets` defined in test case
-      so collected Values will be in same order as well
-      it is important to preserve this order for Values check with `assertValues`
-      as there is no other mechanism atm to match `TestWallet` with collected `Value`
-      -}
-      collectValuesPkhs :: NonEmpty PaymentPubKeyHash
-      collectValuesPkhs = fmap ledgerPaymentPkh wallets'
-
       -- wallet `PaymentPubKeyHash`es that will be available in
       -- `withContract` and `withContractAs`
       otherWalletsPkhs :: [PaymentPubKeyHash]
       otherWalletsPkhs = fmap ledgerPaymentPkh otherWallets
 
-      -- contract that gets all the values present at the test wallets.
-      valuesAtWallet :: Contract w s e (NonEmpty Value)
-      valuesAtWallet =
-        void (waitNSlots 1)
-          >> traverse (valueAt . (`pubKeyHashAddress` Nothing)) collectValuesPkhs
-
+      collectValues = do
+        vs <- traverse plutusValueFromWallet wallets'
+        return $ sequence vs
   -- run the test contract
   execRes <- liftIO $ runContract cEnv ownWallet (toContract otherWalletsPkhs)
 
   -- get all the values present at the test wallets after the user given contracts has been executed.
-  execValues <- liftIO $ runContract cEnv ownWallet valuesAtWallet
+  values <- withReaderT fst collectValues
 
-  case outcome execValues of
+  case values of
     Left e -> fail $ "Failed to get values. Error: " ++ show e
-    Right values -> return $ execRes {outcome = (,values) <$> outcome execRes}
+    Right vs -> return $ execRes {outcome = (,vs) <$> outcome execRes}
   where
     separateWallets :: forall b. Int -> NonEmpty b -> (b, [b])
     separateWallets i xss

src/Test/Plutip/Contract/Init.hs

@@ -114,8 +114,7 @@ withCollateral TestWallets {..} = TestWallets $ NonEmpty.map go unTestWallets
     go TestWallet {..} =
       TestWallet
         { twInitDistribuition = fromInteger defCollateralSize : twInitDistribuition
-        , twExpected =
-            second (Value.unionWith (+) $ Ada.lovelaceValueOf defCollateralSize) <$> twExpected
+        , twExpected = second (Value.unionWith (+) $ Ada.lovelaceValueOf defCollateralSize) <$> twExpected
         }
 
 -- | Library functions works with amounts in `Lovelace`.

src/Test/Plutip/Contract/Types.hs

@@ -72,8 +72,10 @@ data TestWallet = TestWallet
   { twInitDistribuition :: [Positive]
   , twExpected :: Maybe (ValueOrdering, Value)
   }
+  deriving stock (Show)
 
 data ValueOrdering = VEq | VGt | VLt | VGEq | VLEq
+  deriving stock (Show)
 
 -- | Value doesn't have an Ord instance, so we cannot use `compare`
 compareValuesWith :: ValueOrdering -> Value -> Value -> Bool

src/Test/Plutip/Contract/Values.hs

@@ -17,13 +17,14 @@ import Data.Row (Row)
 import Data.Text (Text)
 import Data.Text qualified as Text
 import Data.Text.Encoding (decodeUtf8')
-import Ledger (Address, ChainIndexTxOut (PublicKeyChainIndexTxOut, ScriptChainIndexTxOut))
 import Ledger.Ada qualified as Ada
 import Ledger.Value (CurrencySymbol (unCurrencySymbol), TokenName (unTokenName), Value)
 import Ledger.Value qualified as Value
 import Plutus.Contract (AsContractError, Contract, utxosAt)
 import PlutusTx.Builtins (fromBuiltin)
 
+import Ledger (Address, ciTxOutValue)
+import PlutusPrelude ((^.))
 import Test.Plutip.Contract.Types (
   ValueOrdering (VEq, VGEq, VGt, VLEq, VLt),
   compareValuesWith,
@@ -36,11 +37,7 @@ valueAt ::
   Contract w s e Value
 valueAt addr = do
   utxos <- utxosAt addr
-  pure . mconcat . map utxoValue . Map.elems $ utxos
-  where
-    utxoValue :: ChainIndexTxOut -> Value
-    utxoValue (PublicKeyChainIndexTxOut _ v _ _) = v
-    utxoValue (ScriptChainIndexTxOut _ v _ _ _) = v
+  pure . mconcat . map (^. ciTxOutValue) . Map.elems $ utxos
 
 assertValues :: NonEmpty (Maybe (ValueOrdering, Value)) -> NonEmpty Value -> Either Text ()
 assertValues expected values =

src/Test/Plutip/LocalCluster.hs

@@ -11,15 +11,17 @@ module Test.Plutip.LocalCluster (
   withConfiguredCluster,
   startCluster,
   stopCluster,
+  plutusValueFromWallet,
 ) where
 
 import Control.Concurrent (threadDelay)
-import Control.Monad.IO.Class (liftIO)
+import Control.Monad.IO.Class (MonadIO, liftIO)
 import Control.Monad.Reader (MonadReader (ask), ReaderT, ask)
 import Data.Bifunctor (second)
 import Data.Default (def)
 import Data.List.NonEmpty (NonEmpty)
 import Data.List.NonEmpty qualified as NE
+import Ledger (Value)
 import Numeric.Natural (Natural)
 import Numeric.Positive (Positive)
 import Test.Plutip.Config (PlutipConfig (extraConfig))
@@ -38,6 +40,7 @@ import Test.Plutip.Internal.BotPlutusInterface.Wallet (
 import Test.Plutip.Internal.Cluster.Extra.Types (ecSlotLength)
 import Test.Plutip.Internal.LocalCluster (startCluster, stopCluster)
 import Test.Plutip.Internal.Types (ClusterEnv)
+import Test.Plutip.Tools.CardanoApi (CardanoApiError, plutusValueFromAddress)
 import Test.Plutip.Tools.ChainIndex qualified as CI
 import Test.Tasty (testGroup, withResource)
 import Test.Tasty.Providers (TestTree)
@@ -113,3 +116,12 @@ type RetryDelay = Positive
 
 imap :: (Int -> a -> b) -> [a] -> [b]
 imap fn = zipWith fn [0 ..]
+
+-- Get total `Value` of all UTxOs at `BpiWallet` address.
+plutusValueFromWallet ::
+  MonadIO m =>
+  BpiWallet ->
+  ReaderT ClusterEnv m (Either CardanoApiError Value)
+plutusValueFromWallet bw = do
+  cEnv <- ask
+  liftIO . plutusValueFromAddress cEnv . cardanoMainnetAddress $ bw

src/Test/Plutip/Tools/CardanoApi.hs

@@ -5,10 +5,12 @@ module Test.Plutip.Tools.CardanoApi (
   queryProtocolParams,
   queryTip,
   awaitAddressFunded,
+  plutusValueFromAddress,
+  CardanoApiError,
 ) where
 
 import Cardano.Api qualified as C
-import Cardano.Api.Shelley (ProtocolParameters, UTxO (UTxO))
+import Cardano.Api.Shelley (ProtocolParameters, TxOut (TxOut), UTxO (UTxO, unUTxO), txOutValueToValue)
 import Cardano.Launcher.Node (nodeSocketFile)
 import Cardano.Slotting.Slot (WithOrigin)
 import Test.Plutip.Internal.Cluster (RunningNode (RunningNode))
@@ -22,6 +24,8 @@ import Data.Map qualified as Map
 import Data.Set qualified as Set
 import Data.Time (NominalDiffTime, nominalDiffTimeToSeconds)
 import GHC.Generics (Generic)
+import Ledger (Value)
+import Ledger.Tx.CardanoAPI (fromCardanoValue)
 import Ouroboros.Consensus.HardFork.Combinator.AcrossEras (EraMismatch)
 import Ouroboros.Network.Protocol.LocalStateQuery.Type (AcquireFailure)
 import Test.Plutip.Internal.Types (ClusterEnv (runningNode))
@@ -106,3 +110,14 @@ awaitAddressFunded addr retryDelay = do
         | Map.null utxo' ->
           throwString "No UTxOs returned by cardano API query for address"
       _ -> pure ()
+
+-- | Get total `Value` of all UTxOs at address.
+plutusValueFromAddress ::
+  ClusterEnv ->
+  C.AddressAny ->
+  IO (Either CardanoApiError Value)
+plutusValueFromAddress cEnv addr = do
+  let getValues = mconcat . fmap extract . (Map.elems . unUTxO)
+      extract (TxOut _ txoV _ _) = fromCardanoValue $ txOutValueToValue txoV
+  res <- utxosAtAddress cEnv addr
+  return $ getValues <$> res