Use chain-index to wait till cluster wallets will be funded

Makefile

@@ -42,7 +42,7 @@ FOURMOLU_EXTENSIONS := -o -XTypeApplications -o -XTemplateHaskell -o -XImportQua
 excluded := src/Test/Plutip/Internal/Cluster.hs
 format:
 	@ echo "> Formatting all .hs files"
-	fourmolu $(FOURMOLU_EXTENSIONS) --mode inplace --check-idempotence $$(find src/ test/ plutip-server/ local-cluster/ -iregex ".*.hs" -not -path "${excluded}")
+	fourmolu $(FOURMOLU_EXTENSIONS) --mode inplace --check-idempotence $$(find src/ test/ plutip-server/ local-cluster/ contract-execution/ -iregex ".*.hs" -not -path "${excluded}")
 
 format_check:
 	@ echo "> Checking format of all .hs files"

README.md

@@ -45,6 +45,10 @@ NOTE: This branch launches local network in `Vasil`. It was tested with node `1.
 * [Running Contracts is REPL](./docs/interactive-plutip.md)
 * [Providing constant keys](./docs/constant-keys.md)
 
+## Examples
+
+* [Starting private network from Haskell and executing contract](./contract-execution/Main.hs)
+
 ## Advanced network setup
 
 * [Tweaking local network](./docs/tweaking-network.md)

contract-execution/ExampleContracts.hs

@@ -0,0 +1,39 @@
+module ExampleContracts (
+  ownValueToState,
+) where
+
+import Plutus.Contract (
+  Contract,
+  utxosAt,
+ )
+import Plutus.Contract qualified as Contract
+
+import Ledger (
+  ChainIndexTxOut,
+  TxOutRef,
+  Value,
+  ciTxOutValue,
+ )
+
+import Data.Map (Map)
+
+import Control.Lens ((^.))
+import Data.List.NonEmpty qualified as NonEmpty
+import Data.Monoid (Last (Last))
+import Data.Text (Text)
+import Plutus.PAB.Effects.Contract.Builtin (EmptySchema)
+
+getUtxos :: Monoid m => Contract m EmptySchema Text (Map TxOutRef ChainIndexTxOut)
+getUtxos = do
+  addr <- NonEmpty.head <$> Contract.ownAddresses
+  utxosAt addr
+
+ownValue :: Monoid m => Contract m EmptySchema Text Value
+ownValue = foldMap (^. ciTxOutValue) <$> getUtxos
+
+-- this Contract fails, but state should change in expected way
+ownValueToState :: Contract (Last Value) EmptySchema Text Value
+ownValueToState = do
+  ow <- ownValue
+  Contract.tell (Last $ Just ow)
+  return ow

contract-execution/Main.hs

@@ -0,0 +1,86 @@
+{-# LANGUAGE DerivingStrategies #-}
+{-# LANGUAGE ImportQualifiedPost #-}
+{-# LANGUAGE NumericUnderscores #-}
+
+module Main (main) where
+
+import Control.Monad.IO.Class (liftIO)
+import Control.Monad.Reader (ReaderT (ReaderT), ask)
+import Data.Default (def)
+import Data.Monoid (Last (getLast))
+import Data.Text.Lazy qualified as T
+import ExampleContracts (ownValueToState)
+import Test.Plutip.Config (
+  PlutipConfig (extraConfig),
+ )
+import Test.Plutip.Contract (runContract)
+import Test.Plutip.Internal.BotPlutusInterface.Wallet (
+  BpiWallet,
+  addSomeWallet,
+  mkMainnetAddress,
+  walletPkh,
+ )
+import Test.Plutip.Internal.Cluster.Extra.Types (
+  ExtraConfig (ecSlotLength),
+ )
+import Test.Plutip.Internal.LocalCluster (
+  startCluster,
+  stopCluster,
+ )
+import Test.Plutip.Internal.Types (
+  ClusterEnv,
+  ExecutionResult (contractState, outcome),
+  nodeSocket,
+ )
+import Test.Plutip.Tools.ChainIndex qualified as CI
+import Text.Pretty.Simple (pShow)
+
+main :: IO ()
+main = do
+  let slotLen = 1
+      extraConf = def {ecSlotLength = slotLen}
+      plutipConfig = def {extraConfig = extraConf}
+
+  putStrLn "Starting cluster..."
+  (st, _) <- startCluster plutipConfig $ do
+    w <- addSomeWallet [toAda 10]
+    liftIO $ putStrLn "Waiting for wallets to be funded..."
+    CI.awaitWalletFunded w slotLen
+
+    separate
+    printWallet (w, 1)
+    printNodeRelatedInfo
+
+    separate
+    res <- executeContract w ownValueToState
+    printResult res
+
+    separate
+
+  putStrLn "Stopping cluster"
+
+  stopCluster st
+  where
+    printNodeRelatedInfo = ReaderT $ \cEnv -> do
+      putStrLn $ "Node socket: " <> show (nodeSocket cEnv)
+
+    separate = liftIO $ putStrLn "\n------------\n"
+
+    printWallet :: (BpiWallet, Int) -> ReaderT ClusterEnv IO ()
+    printWallet (w, n) = liftIO $ do
+      putStrLn $ "Wallet " ++ show n ++ " PKH: " ++ show (walletPkh w)
+      putStrLn $ "Wallet " ++ show n ++ " mainnet address: " ++ show (mkMainnetAddress w)
+
+    toAda = (* 1_000_000)
+
+    executeContract wallet contract =
+      ask >>= \cEnv -> runContract cEnv wallet contract
+
+    printResult res = do
+      liftIO . putStrLn $ "Execution outcome:\n" <> pShow' (outcome res)
+      liftIO . putStrLn $
+        "Contract state:\n"
+          <> pShow' (getLast $ contractState res)
+
+    pShow' :: Show a => a -> String
+    pShow' = T.unpack . pShow

contract-execution/README.md

@@ -0,0 +1,3 @@
+# Contract execution example
+
+An example of how to start private network from Haskell and execute arbitrary contract.

hie.yaml

@@ -6,5 +6,7 @@ cradle:
       component: "test-suite:plutip-tests"
     - path: "./local-cluster/"
       component: "exe:local-cluster"
+    - path: "./contract-execution/"
+      component: "exe:contract-execution"
     - path: "./plutip-server/"
       component: "exe:plutip-server"

local-cluster/Main.hs

@@ -9,7 +9,7 @@ import Cardano.Ledger.Slot (EpochSize (EpochSize))
 import Control.Applicative (optional, (<**>))
 import Control.Monad (forM_, replicateM, void)
 import Control.Monad.IO.Class (liftIO)
-import Control.Monad.Reader (ReaderT (ReaderT), ask)
+import Control.Monad.Reader (ReaderT (ReaderT))
 import Data.Default (def)
 import Data.Time (NominalDiffTime)
 import GHC.Natural (Natural)
@@ -29,14 +29,13 @@ import Test.Plutip.Internal.BotPlutusInterface.Wallet (
 import Test.Plutip.Internal.Cluster.Extra.Types (
   ExtraConfig (ExtraConfig),
  )
-import Test.Plutip.Internal.Types (ClusterEnv, nodeSocket)
+import Test.Plutip.Internal.Types (nodeSocket)
 import Test.Plutip.LocalCluster (
-  BpiWallet,
   mkMainnetAddress,
   startCluster,
   stopCluster,
  )
-import Test.Plutip.Tools.Cluster (awaitAddressFunded)
+import Test.Plutip.Tools.CardanoApi (awaitAddressFunded)
 
 main :: IO ()
 main = do
@@ -47,14 +46,14 @@ main = do
       let ClusterConfig {numWallets, dirWallets, numUtxos, workDir, slotLength, epochSize} = config
           workingDir = maybe Temporary (`Fixed` False) workDir
 
-          exctraCong = ExtraConfig slotLength epochSize
-          plutipConfig = def {clusterWorkingDir = workingDir, extraConfig = exctraCong}
+          extraConf = ExtraConfig slotLength epochSize
+          plutipConfig = def {clusterWorkingDir = workingDir, extraConfig = extraConf}
 
       putStrLn "Starting cluster..."
       (st, _) <- startCluster plutipConfig $ do
         ws <- initWallets numWallets numUtxos amt dirWallets
         liftIO $ putStrLn "Waiting for wallets to be funded..."
-        awaitFunds ws (ceiling slotLength)
+        awaitFunds ws slotLength
 
         separate
         liftIO $ forM_ (zip ws [(1 :: Int) ..]) printWallet
@@ -89,13 +88,10 @@ main = do
     toAda = (* 1_000_000)
 
     -- waits for the last wallet to be funded
-    awaitFunds :: [BpiWallet] -> Int -> ReaderT ClusterEnv IO ()
     awaitFunds ws delay = do
-      env <- ask
       let lastWallet = last ws
-      liftIO $ do
-        putStrLn "Waiting till all wallets will be funded..."
-        awaitAddressFunded env delay (cardanoMainnetAddress lastWallet)
+      liftIO $ putStrLn "Waiting till all wallets will be funded..."
+      awaitAddressFunded (cardanoMainnetAddress lastWallet) delay
 
 pnumWallets :: Parser Int
 pnumWallets =

local-cluster/README.md

@@ -55,8 +55,10 @@ main = do
 
   (st, _) <- startCluster def $ do
     w <- addSomeWallet [100_000_000]
-    waitSeconds 2
+    awaitWalletFunded w 1
     result <- executeContract w someContract
     doSomething result
   stopCluster st
 ```
+
+For working example see [contract-execution](../contract-execution/Main.hs).

plutip-server/Api.hs

@@ -65,7 +65,7 @@ server serverOptions =
     :<|> stopClusterHandler
 
 appServer :: Env -> Server Api
-appServer env@(Env {options}) =
+appServer env@Env {options} =
   hoistServer api appHandler (server options)
   where
     appHandler :: forall (a :: Type). AppM a -> Handler a

plutip-server/Api/Handlers.hs

@@ -5,8 +5,7 @@ module Api.Handlers (
 
 import Cardano.Api (serialiseToCBOR)
 import Cardano.Launcher.Node (nodeSocketFile)
-
--- import Cardano.Wallet.Shelley.Launch.Cluster (RunningNode (RunningNode))
+import Test.Plutip.Tools.CardanoApi qualified as Tools
 
 import Control.Concurrent.MVar (isEmptyMVar, putMVar, takeMVar)
 import Control.Monad (unless)
@@ -21,14 +20,21 @@ import Data.Text.Encoding qualified as Text
 import Data.Traversable (for)
 import System.Directory (doesFileExist)
 import System.FilePath (replaceFileName)
-import Test.Plutip.Config (PlutipConfig (extraConfig), chainIndexPort, relayNodeLogs)
+import Test.Plutip.Config (
+  PlutipConfig (extraConfig),
+  chainIndexPort,
+  relayNodeLogs,
+ )
 import Test.Plutip.Internal.BotPlutusInterface.Setup (keysDir)
-import Test.Plutip.Internal.BotPlutusInterface.Wallet (BpiWallet (signKey), addSomeWallet, cardanoMainnetAddress)
+import Test.Plutip.Internal.BotPlutusInterface.Wallet (
+  BpiWallet (signKey),
+  addSomeWallet,
+  cardanoMainnetAddress,
+ )
 import Test.Plutip.Internal.Cluster (RunningNode (RunningNode))
-import Test.Plutip.Internal.Cluster.Extra.Types (ExtraConfig (ExtraConfig))
+import Test.Plutip.Internal.Cluster.Extra.Types (ExtraConfig (ExtraConfig, ecSlotLength))
 import Test.Plutip.Internal.LocalCluster (startCluster, stopCluster)
-import Test.Plutip.Internal.Types (ClusterEnv (runningNode))
-import Test.Plutip.Tools.Cluster (awaitAddressFunded)
+import Test.Plutip.Internal.Types (ClusterEnv (plutipConf, runningNode))
 import Types (
   AppM,
   ClusterStartupFailureReason (
@@ -97,7 +103,7 @@ startClusterHandler
           for keysToGenerate $ \lovelaceAmounts -> do
             addSomeWallet (fromInteger . unLovelace <$> lovelaceAmounts)
         liftIO $ putStrLn "Waiting for wallets to be funded..."
-        awaitFunds wallets 2
+        awaitFunds wallets (ecSlotLength $ extraConfig $ plutipConf env)
         pure (env, wallets)
       getNodeSocketFile (runningNode -> RunningNode conn _ _ _) = nodeSocketFile conn
       getNodeConfigFile =
@@ -108,13 +114,10 @@ startClusterHandler
       interpret = fmap (either ClusterStartupFailure id) . runExceptT
 
       -- waits for the last wallet to be funded
-      awaitFunds :: [BpiWallet] -> Int -> ReaderT ClusterEnv IO ()
       awaitFunds ws delay = do
-        env <- ask
-        let lastWallet = last ws
-        liftIO $ do
-          putStrLn $ "Waiting till all wallets will be funded..."
-          awaitAddressFunded env delay (cardanoMainnetAddress lastWallet)
+        let lastWalletPkh = cardanoMainnetAddress $ last ws
+        liftIO $ putStrLn "Waiting till all wallets will be funded..."
+        Tools.awaitAddressFunded lastWalletPkh delay
 
 stopClusterHandler :: StopClusterRequest -> AppM StopClusterResponse
 stopClusterHandler StopClusterRequest = do
@@ -125,4 +128,4 @@ stopClusterHandler StopClusterRequest = do
     else do
       statusTVar <- liftIO $ takeMVar statusMVar
       liftIO $ stopCluster statusTVar
-      pure $ StopClusterSuccess
+      pure StopClusterSuccess

plutip.cabal

@@ -172,7 +172,6 @@ library
     Test.Plutip.Tools.Address
     Test.Plutip.Tools.CardanoApi
     Test.Plutip.Tools.ChainIndex
-    Test.Plutip.Tools.Cluster
     Test.Plutip.Tools.DebugCli
     Test.Plutip.Tools.Format
 
@@ -268,3 +267,29 @@ executable local-cluster
     , time
 
   ghc-options:   -Wall -threaded -rtsopts
+
+executable contract-execution
+  import:         common-language
+  import:         common-ghc-options
+  hs-source-dirs: contract-execution
+  main-is:        Main.hs
+  build-depends:
+    , base
+    , cardano-ledger-core
+    , containers
+    , data-default
+    , lens
+    , mtl
+    , optparse-applicative
+    , plutip
+    , plutus-contract
+    , plutus-ledger
+    , plutus-ledger-constraints
+    , plutus-pab
+    , positive
+    , pretty-simple
+    , text
+    , time
+
+  other-modules:  ExampleContracts
+  ghc-options:    -Wall -threaded -rtsopts

src/Test/Plutip/Contract.hs

@@ -157,6 +157,7 @@ import Plutus.Contract (Contract, waitNSlots)
 import PlutusPrelude (render)
 import Prettyprinter (Doc, Pretty (pretty), vcat, (<+>))
 import Test.Plutip.Contract.Init (
+  ada,
   initAda,
   initAdaAssertValue,
   initAdaAssertValueWith,
@@ -186,7 +187,6 @@ import Test.Plutip.Internal.Types (
  )
 import Test.Plutip.Options (TraceOption (ShowBudgets, ShowTrace, ShowTraceButOnlyContext))
 import Test.Plutip.Predicate (Predicate, noBudgetsMessage, pTag)
-import Test.Plutip.Tools.Cluster (ada)
 import Test.Plutip.Tools.Format (fmtTxBudgets)
 import Test.Tasty (testGroup, withResource)
 import Test.Tasty.HUnit (assertFailure, testCase)

src/Test/Plutip/Contract/Init.hs

@@ -11,6 +11,7 @@ module Test.Plutip.Contract.Init (
   initAndAssertAdaWith,
   initAndAssertAda,
   withCollateral,
+  ada,
 ) where
 
 import Data.List.NonEmpty (NonEmpty ((:|)))
@@ -30,7 +31,6 @@ import Test.Plutip.Contract.Types (
   ValueOrdering (VEq),
  )
 import Test.Plutip.Internal.BotPlutusInterface.Run (defCollateralSize)
-import Test.Plutip.Tools.Cluster (ada)
 
 -- | Create a wallet with the given amounts of lovelace.
 --  Each amount will be sent to address as separate UTXO.
@@ -117,3 +117,8 @@ withCollateral TestWallets {..} = TestWallets $ NonEmpty.map go unTestWallets
         , twExpected =
             second (Value.unionWith (+) $ Ada.lovelaceValueOf defCollateralSize) <$> twExpected
         }
+
+-- | Library functions works with amounts in `Lovelace`.
+-- This function helps to specify amounts in `Ada` easier.
+ada :: Positive -> Positive
+ada = (* 1_000_000)