Support for addresses with staking keys and wallet lookups.

CHANGELOG.md

@@ -48,6 +48,8 @@ This format is based on [Keep A Changelog](https://keepachangelog.com/en/1.0.0).
     - `initLovelaceAssertValue`
     - `initLovelaceAssertValueWith`
     - `withCollateral`
+  - Initialising wallets with staking keys.
+  - Access to initialised wallets via `WalletLookups`
 
 ## 0.1 -- 2022-02-14
 

docs/interactive-plutip.md

@@ -42,8 +42,11 @@ setup = do
   waitSeconds 2
   pure (env, ownWallet)
 
-addWalletWithAdas :: [Ada] -> ReaderT ClusterEnv IO BpiWallet
-addWalletWithAdas = addSomeWallet . map (fromInteger . Ada.toLovelace)
+addWalletWithAdas :: [Ada] -> ReaderT ClusterEnv IO (BpiWallet k)
+addWalletWithAdas funds = addSomeWallet $ testWallet'
+  (map (fromInteger . Ada.toLovelace) funds)
+  Nothing
+  (PkhTag ())
 ```
 
 > Aside: Feel free to choose the amount of ada you want to fund your wallet with. Just remember: `addSomeWallet` takes a list of _lovelace_ amounts. Here, I've actually made my custom `Ada` type as well some helper utilities (not the same as `Plutus.V1.Ledger.Ada` as that is removed in newer `plutus-ledger-api` versions).
@@ -89,7 +92,7 @@ Once you have that, you can simply use `runContract` from `import Test.Plutip.In
 runContract ::
   (ToJSON w, Monoid w, MonadIO m) =>
   ClusterEnv ->
-  BpiWallet ->
+  BpiWallet k ->
   Contract w s e a ->
   m (ExecutionResult w e a)
 ```
@@ -179,7 +182,7 @@ import Test.Plutip.Contract.Types (TestContractConstraints)
 newtype ContractRunner = ContrRunner
   { runContr ::
       forall w e a.
-      TestContractConstraints w e a =>
+      TestContractConstraints w e Int a =>
       Contract w EmptySchema e a ->
       IO (Either (FailureReason e) a)
   }
@@ -192,7 +195,7 @@ begin = do
     setup = do
       env <- ask
       -- Gotta have all those utxos for the collaterals.
-      ownWallet <- addWalletWithAdas $ 300 : replicate 50 10
+      ownWallet <- addWalletWithAdas $ testWallet' (300 :  replicate 50 10) Nothing (PkhTag 0)
       -- Wait for faucet funds to be added.
       waitSeconds 2
       pure (env, ownWallet)

docs/tasty-integration.md

@@ -10,8 +10,8 @@ test =
   withConfiguredCluster def -- 1
     "Basic integration: launch, add wallet, tx from wallet to wallet" -- 2
     $ [ assertExecution "Contract 1" -- 3
-          (initAda [100,200] <> initLovelace 10_000_000) -- 3.1
-          (withContract $ \[wallet2pkh] -> someContract) -- 3.2
+          (initAda (PkhTag (0 :: Int)) [100,200] <> initLovelace (BaseTag 1) 10_000_000) -- 3.1
+          (withContract $ \wl -> someContract) -- 3.2
           [ shouldSucceed -- 3.3
           ]
       ]
@@ -20,8 +20,8 @@ test =
 1. Will start the local network with default config (more on configuring below)
 2. Description of test group that will be run on current instance of the network
 3. Test scenario that will be performed on the local network with it's description. Scenario includes:
-   1. (3.1.) Initialization of `wallets`. In this case two addresses will be funded: first will have 2 UTxOs with 100 and 200 Ada, second - single UTxO with 10 Ada.
-   2. (3.2) Execution of "`someContract :: Contract w s e a`". `PaymentPubKeyHash` of *first wallet* will be accessible in `someContract` as "own PaymentPubKeyHash". e.g with `ownFirstPaymentPubKeyHash`. `PaymentPubKeyHash` of *second* initiated wallet is brought into scope by `wallet2pkh` during pattern match on list (more on that below).
+   1. (3.1.) Initialization of `wallets`. In this case two addresses will be funded: first - enterprise address - will have 2 UTxOs with 100 and 200 Ada, second - base address - single UTxO with 10 Ada.
+   2. (3.2) Execution of "`someContract :: Contract w s e a`". `PaymentPubKeyHash` of *first wallet* will be accessible in `someContract` as "own PaymentPubKeyHash". e.g with `ownFirstPaymentPubKeyHash`. `PaymentPubKeyHash` of *second* initiated wallet is accessible through `wl :: WalletLookups`  (more on that below).
    3. (3.3) List of checks or `predicates` which will be performed for the result of `someContract` execution.
 
 It is possible to run several scenarios on single network instance - note that `withConfiguredCluster` accepts list of `assertExecution`'s.
@@ -33,39 +33,61 @@ It is possible to initialize arbitrary number of `wallets` in second argument of
 E.g. if `wallets` initialized like
 
 ```haskell
-(initAda [100] <> initAda [200] <> initAda [300])
+(initAda (PkhTag (0 :: Int)) [100] <> initAda (PkhTag 1) [200] <> initAda (BaseTag 2) [300])
 ```
 
 we will get 3 funded addresses represented by 3 corresponding `wallets`: 
 
-* `PaymentPubKeyHash` of wallet `initAda [100]` will be "own" `PaymentPubKeyHash` for contract executed it test case.
-* `PaymentPubKeyHash` of `wallets` `initAda [200]` and `initAda [300]` will be available via lambda argument. I.e.:
+* `PaymentPubKeyHash` of wallet 0 will be "own" `PaymentPubKeyHash` for contract executed it test case.
+* `PaymentPubKeyHash` of `wallets` 1 and 2 will be available via lambda wallet lookups argument. I.e.:
 
 
 ```haskell
-withContract $ \[pkh1, pkh2] -> someContract
+withContract $ \wl -> do
+  PkhWallet pkh1 <- lookupWallet wl (PkhTag 1)
+  BaseWallet pkh2 spkh2 <- lookupWallet wl (BaseTag 2)
+  someContract
 ```
 
-where
+note that the lookup return type depends on a query tag. Unfortunetely the type hint is needed to avoid cryptic error message.
 
-* `pkh1` is `PaymentPubKeyHash` of `wallet` `initAda [200]`
-* `pkh2` is `PaymentPubKeyHash` of `wallet` `initAda [300]`
 
-`PaymentPubKeyHash` of `wallet` `initAda [100]` is meant to be `pkh0` and not presented in the list.
+* `pkh1` is `PaymentPubKeyHash` of `wallet` `initAda (PkhTag 1) [200]`
+* `pkh2` is `PaymentPubKeyHash` of `wallet` `initAda (BaseTag 2) [300]` and `spkh2` is its `StakePubKeyHash`
+
+`PaymentPubKeyHash` of `wallet` `initAda (PkhTag 0) [100]` is meant to be `pkh0` and not presented in the lookups.
+
+
+You can execute a contract with base address as contracts address:
+```haskell
+(initAda (BaseTag 0) [100])
+```
+
+and witness in contract
+
+```haskell
+withContract $ \_ -> do
+  ourAddr :| _ <- Contract.ownAddresses
+  case addr of
+    Address (PubKeyCredential ourPkh) (Just (StakingHash (PubKeyCredential ourSpkh))) -> logInfo "This is the address we will get."
+    _ -> error "Nothing else matters"
+```
+
+Use `mustPayToPubKeyAddress` instead of `mustPayToPubKey` when your address has staking keys.
 
 ## Executing contracts
 
 It is possible to run arbitrary number of contracts in 3d argument of `assertExecution` using its monadic nature. E.g.:
 
 ```haskell
   assertExecution "Some description"
-          ( initAda [100])
+          ( initAda (PkhTag ()) [100])
           ( do
               void $
                 withContract $
-                  \pkhs -> contract1
+                  \wl -> contract1
               withContractAs 1 $
-                \pkhs -> contract2
+                \wl -> contract2
           )
           [shouldSucceed]
 ```
@@ -85,29 +107,29 @@ For example, consider the following scenario:
 
 ```haskell
   assertExecution "Some description"
-          ( initAda [100] -- walletA
-            <> initAda [200] -- walletB
-            <> initAda [300] -- walletC
+          ( initAda (PkhTag 'a') [100] -- walletA
+            <> initAda (PkhTag 'b') [200] -- walletB
+            <> initAda (PkhTag 'c') [300] -- walletC
           )
           ( do
               void $
-                withContractAs 1 $ -- running contract with walletB
-                  \[walletA_PKH, walletC_PKH] -> setupContract1
+                withContractAs 'b' $ -- running contract with walletB
+                  \wl -> do
+                    wallA <- lookupWallet wl (PkhTag 'a')
+                    setupContract1
               void $
-                withContractAs 2 $  -- running contract with walletC
-                  \[walletA_PKH, walletB_PKH] -> setupContract2
-              withContract $
-                \pkhs -> theContract
+                withContractAs 'c' $  -- running contract with walletC
+                  \wl -> do 
+                    wallB <- lookupWallet wl (PkhTag 'b')
+                    setupContract2
+              withContract $  -- uses first wallet, walletA
+                \wl -> theContract
           )
           [shouldSucceed]
 ```
 
-Under the hood, test runner builds list of wallets like this `[walletA, walletB, walletC]` and by calling `withContractAs` we can refer to an index (0 based) of specific wallet in this list. In that case, `PaymentPubKeyHash` of referenced `wallet` becomes "own" `PaymentPubKeyHash` of the contract, and `PaymentPubKeyHash`'es in argument of lambda  will be rearranged. E.g. in case of  `withContractAs 1`:
-
-* `PaymentPubKeyHash` of `walletB` will become own `PaymentPubKeyHash`
-* argument of lambada will contain `PaymentPubKeyHash`'es of `walletA` and `walletC`.
-
-Actually, `withContract` is just shortcut for `withContractAs 0`.
+`withContractAs` asks explicitly for the name of a wallet to be used as contract's.
+Instead `withContract` uses the first wallet, first in the order of how the initializations are written.
 
 ## Assertions
 
@@ -148,7 +170,7 @@ E.g. scenario like this
         assertExecutionWith
           [ShowBudgets]
           "Lock then spend contract"
-          (initAda (replicate 3 300))
+          (initAda (PkhTag ()) (replicate 3 300))
           (withContract $ const lockThenSpend)
           [ shouldSucceed
           ]

flake.nix

@@ -11,7 +11,7 @@
       flake = false;
     };
     bot-plutus-interface.url =
-      "github:mlabs-haskell/bot-plutus-interface?ref=857ec745d50f7f0ebd5cd934110403fae301ef6f";
+      "github:mlabs-haskell/bot-plutus-interface/7431b1137ca8afe47782638f1f9e4a9499015e42";
   };
 
   outputs =

local-cluster/Main.hs

@@ -6,26 +6,29 @@
 module Main (main) where
 
 import Control.Applicative (optional, (<**>))
-import Control.Monad (forM_, replicateM, void)
+import Control.Monad (forM_, void)
 import Control.Monad.IO.Class (liftIO)
 import Control.Monad.Reader (ReaderT (ReaderT))
 import Data.Default (def)
+import Data.Traversable (for)
 import Numeric.Positive (Positive)
 import Options.Applicative (Parser, helper, info)
 import Options.Applicative qualified as Options
 import Test.Plutip.Config
   ( PlutipConfig (clusterWorkingDir),
     WorkingDirectory (Fixed, Temporary),
   )
-import Test.Plutip.Internal.BotPlutusInterface.Wallet (addSomeWalletDir, walletPkh)
+import Test.Plutip.Internal.BotPlutusInterface.Wallet (addSomeWalletDir)
 import Test.Plutip.Internal.Types (nodeSocket)
 import Test.Plutip.LocalCluster
   ( mkMainnetAddress,
     startCluster,
     stopCluster,
     waitSeconds,
+    walletPaymentPkh
   )
 import GHC.Natural (Natural)
+import Test.Plutip.Internal.BotPlutusInterface.Types (WalletTag(PkhTag), testWallet')
 
 main :: IO ()
 main = do
@@ -65,11 +68,11 @@ main = do
         amt -> Right $ fromInteger . toInteger $ amt
 
     initWallets numWallets numUtxos amt dirWallets = do
-      replicateM (max 0 numWallets) $
-        addSomeWalletDir (replicate numUtxos amt) dirWallets
+      for [0..(max 0 numWallets - 1)] $ \idx ->
+        addSomeWalletDir (testWallet' (replicate numUtxos amt) Nothing (PkhTag idx)) dirWallets
 
     printWallet (w, n) = do
-      putStrLn $ "Wallet " ++ show n ++ " PKH: " ++ show (walletPkh w)
+      putStrLn $ "Wallet " ++ show n ++ " PKH: " ++ show (walletPaymentPkh w)
       putStrLn $ "Wallet " ++ show n ++ " mainnet address: " ++ show (mkMainnetAddress w)
 
     toAda = (* 1_000_000)

plutip-server/Api/Handlers.hs

@@ -20,8 +20,10 @@ import Data.Traversable (for)
 import System.Directory (doesFileExist)
 import System.FilePath (replaceFileName)
 import Test.Plutip.Config (chainIndexPort, relayNodeLogs)
+import Test.Plutip.Internal.BotPlutusInterface.Keys (KeyPair (sKey))
 import Test.Plutip.Internal.BotPlutusInterface.Setup (keysDir)
-import Test.Plutip.Internal.BotPlutusInterface.Wallet (BpiWallet (signKey), addSomeWallet)
+import Test.Plutip.Internal.BotPlutusInterface.Types (WalletTag (PkhTag), testWallet')
+import Test.Plutip.Internal.BotPlutusInterface.Wallet (BpiWallet (payKeys), addSomeWallet)
 import Test.Plutip.Internal.LocalCluster (startCluster, stopCluster)
 import Test.Plutip.Internal.Types (ClusterEnv (runningNode))
 import Test.Plutip.LocalCluster (waitSeconds)
@@ -79,20 +81,20 @@ startClusterHandler
           , keysDirectory = keysDir clusterEnv
           }
     where
-      setup :: ReaderT ClusterEnv IO (ClusterEnv, [BpiWallet])
+      setup :: ReaderT ClusterEnv IO (ClusterEnv, [BpiWallet Int])
       setup = do
         env <- ask
         wallets <- do
-          for keysToGenerate $ \lovelaceAmounts -> do
-            addSomeWallet (fromInteger . unLovelace <$> lovelaceAmounts)
+          for (zip [0 ..] keysToGenerate) $ \(idx, lovelaceAmounts) ->
+            addSomeWallet (testWallet' (fromInteger . unLovelace <$> lovelaceAmounts) Nothing (PkhTag idx))
         waitSeconds 2 -- wait for transactions to submit
         pure (env, wallets)
       getNodeSocketFile (runningNode -> RunningNode conn _ _ _) = nodeSocketFile conn
       getNodeConfigFile =
         -- assumption is that node.config lies in the same directory as node.socket
         flip replaceFileName "node.config" . getNodeSocketFile
-      getWalletPrivateKey :: BpiWallet -> PrivateKey
-      getWalletPrivateKey = Text.decodeUtf8 . Base16.encode . serialiseToCBOR . signKey
+      getWalletPrivateKey :: BpiWallet k -> PrivateKey
+      getWalletPrivateKey = Text.decodeUtf8 . Base16.encode . serialiseToCBOR . sKey . payKeys
       interpret = fmap (either ClusterStartupFailure id) . runExceptT
 
 stopClusterHandler :: StopClusterRequest -> AppM StopClusterResponse

plutip-server/Types.hs

@@ -37,14 +37,7 @@ import Data.Text (Text)
 import GHC.Generics (Generic)
 import Network.Wai.Handler.Warp (Port)
 import Test.Plutip.Internal.BotPlutusInterface.Wallet (BpiWallet)
-import Test.Plutip.Internal.LocalCluster (
-  ClusterStatus (
-    ClusterClosed,
-    ClusterClosing,
-    ClusterStarted,
-    ClusterStarting
-  ),
- )
+import Test.Plutip.Internal.LocalCluster (ClusterStatus)
 import Test.Plutip.Internal.Types (ClusterEnv)
 import UnliftIO.STM (TVar)
 
@@ -54,7 +47,7 @@ import UnliftIO.STM (TVar)
 -- cluster at any given moment).
 -- This MVar is used by start/stop handlers.
 -- The payload of ClusterStatus is irrelevant.
-type ClusterStatusRef = MVar (TVar (ClusterStatus (ClusterEnv, [BpiWallet])))
+type ClusterStatusRef = MVar (TVar (ClusterStatus (ClusterEnv, [BpiWallet Int])))
 
 data Env = Env
   { status :: ClusterStatusRef

plutip.cabal

@@ -29,6 +29,7 @@ common common-imports
     , cardano-addresses
     , cardano-api
     , cardano-crypto
+    , cardano-crypto-class
     , cardano-crypto-wrapper
     , cardano-ledger-core
     , cardano-slotting
@@ -47,6 +48,7 @@ common common-imports
     , http-client
     , http-types
     , iohk-monitoring
+    , lens
     , memory
     , mtl
     , openapi3
@@ -145,6 +147,7 @@ library
     Test.Plutip.Contract.Types
     Test.Plutip.Contract.Values
     Test.Plutip.Internal.BotPlutusInterface.Keys
+    Test.Plutip.Internal.BotPlutusInterface.Lookups
     Test.Plutip.Internal.BotPlutusInterface.Run
     Test.Plutip.Internal.BotPlutusInterface.Setup
     Test.Plutip.Internal.BotPlutusInterface.Types
@@ -174,7 +177,6 @@ test-suite plutip-tests
   ghc-options:        -Wall -threaded -rtsopts
   build-depends:
     , base
-    , lens
     , plutip
     , tasty
     , tasty-expected-failure