Optional launch of chain-index

CHANGELOG.md

@@ -7,6 +7,24 @@ 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-10-26
+
+### Added
+
+- control on `chain-index` launch
+  - `chainIndexPort` in `PlutipConfig` replaced with `chainIndexMode :: ChainIndexMode`
+  - `local-cluster` options added: `--chain-index-port`, `--no-index`
+
+## [1.2.1] - 2022-10-25
+
+### Fixed
+
+- eDSL function to await till wallet is funded `awaitWalletFunded`
+
+### Added
+
+- package with example of how to execute arbitrary contract on private network from Haskell
+
 ## [1.2.0] - 2022-10-21
 
 ### Added

README.md

@@ -41,19 +41,21 @@ NOTE: This branch launches local network in `Vasil`. It was tested with node `1.
 ## Tutorials
 
 * [Running disposable local network and building own runners](./local-cluster/README.md)
+* [Running chain-index](./docs/running-chain-index.md)
 * [Tasty integration](./docs/tasty-integration.md)
 * [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)
 * [Regenerating network configs](./docs/regenerate-network-configs.md)
 
+## Examples
+
+* [Starting private network from Haskell and executing contract](./contract-execution/Main.hs)
+* [Template for setting a Nix flake that includes Plutip](https://github.com/MitchyCola/plutip-flake). Kudos to @MitchyCola
+
 ## Maintenance
 
 * [Important notes on updating `cardano-wallet` dependency](./docs/cardano-wallet-update.md)

docs/running-chain-index.md

@@ -0,0 +1,7 @@
+# Running chain index
+
+It is possible to launch private network with or without `chain-index`.
+
+This can be configured via `PlutipConfig` using `chainIndexMode :: ChainIndexMode` field. BE AWARE, that `chain-index` is required to run contracts with `Plutip` in [tasty integration](./tasty-integration.md), [interactive mode](./interactive-plutip.md) or with [custom runner](../contract-execution/Main.hs).
+
+In case of `local-cluster` launch of `chain-index` can be controlled via options, see [readme](../local-cluster/README.md#available-arguments) for details.

local-cluster/Main.hs

@@ -6,7 +6,7 @@
 module Main (main) where
 
 import Cardano.Ledger.Slot (EpochSize (EpochSize))
-import Control.Applicative (optional, (<**>))
+import Control.Applicative (optional, (<**>), (<|>))
 import Control.Monad (forM_, replicateM, void)
 import Control.Monad.IO.Class (liftIO)
 import Control.Monad.Reader (ReaderT (ReaderT))
@@ -18,7 +18,8 @@ import Numeric.Positive (Positive)
 import Options.Applicative (Parser, helper, info)
 import Options.Applicative qualified as Options
 import Test.Plutip.Config (
-  PlutipConfig (clusterWorkingDir, extraConfig),
+  ChainIndexMode (CustomPort, DefaultPort, NotNeeded),
+  PlutipConfig (chainIndexMode, clusterWorkingDir, extraConfig),
   WorkingDirectory (Fixed, Temporary),
  )
 import Test.Plutip.Internal.BotPlutusInterface.Wallet (
@@ -43,11 +44,11 @@ main = do
   case totalAmount config of
     Left e -> error e
     Right amt -> do
-      let ClusterConfig {numWallets, dirWallets, numUtxos, workDir, slotLength, epochSize} = config
+      let ClusterConfig {numWallets, dirWallets, numUtxos, workDir, slotLength, epochSize, cIndexMode} = config
           workingDir = maybe Temporary (`Fixed` False) workDir
 
           extraConf = ExtraConfig slotLength epochSize
-          plutipConfig = def {clusterWorkingDir = workingDir, extraConfig = extraConf}
+          plutipConfig = def {clusterWorkingDir = workingDir, extraConfig = extraConf, chainIndexMode = cIndexMode}
 
       putStrLn "Starting cluster..."
       (st, _) <- startCluster plutipConfig $ do
@@ -177,6 +178,26 @@ pEpochSize =
             <> Options.value 160
         )
 
+pChainIndexMode :: Parser ChainIndexMode
+pChainIndexMode =
+  noIndex <|> withIndexPort <|> pure DefaultPort
+  where
+    noIndex =
+      Options.flag'
+        NotNeeded
+        ( Options.long "no-index"
+            <> Options.help "Start cluster with chain-index on default port"
+        )
+    withIndexPort = CustomPort <$> portParser
+
+    portParser =
+      Options.option
+        Options.auto
+        ( Options.long "chain-index-port"
+            <> Options.metavar "PORT"
+            <> Options.help "Start cluster with chain-index on custom port"
+        )
+
 pClusterConfig :: Parser ClusterConfig
 pClusterConfig =
   ClusterConfig
@@ -188,6 +209,7 @@ pClusterConfig =
     <*> pWorkDir
     <*> pSlotLen
     <*> pEpochSize
+    <*> pChainIndexMode
 
 -- | Basic info about the cluster, to
 -- be used by the command-line
@@ -200,5 +222,6 @@ data ClusterConfig = ClusterConfig
   , workDir :: Maybe FilePath
   , slotLength :: NominalDiffTime
   , epochSize :: EpochSize
+  , cIndexMode :: ChainIndexMode
   }
   deriving stock (Show, Eq)

local-cluster/README.md

@@ -40,6 +40,8 @@ Full | Short | Description
 --working-dir /path/ | -w /path/ | This determines where the node database, chain-index database, and bot-plutus-interface files will be stored for a running cluster. If specified, this will store cluster data in the provided path (can be relative or absolute), the files will be deleted on cluster shutdown by default. Otherwise, the cluster data is stored in a temporary directory and will be deleted on cluster shutdown.
 --slot-len SECONDS | -s SECONDS | Sets slot length of created network, is seconds. E.g. `--slot-len 1s`, `-s 0.2s`. <br /> Addition of `s` is important for correct parsing of this option.
 --epoch-size NUM | -s NUM | Sets epoch size of created network, is slots.
+--slot-len SECONDS | -s SECONDS | Sets slot length of created network, is seconds. E.g. `--slot-len 1s`, `-s 0.2s`. <br /> Addition of `s` is important for correct parsing of this option.
+--chain-index-port PORT<br />or<br />--no-index| - | With `--chain-index-port` and `PORT` specified `chain-index` will be launched on specified port together with private network.<br /> With `--no-index` only private network will be launched without `chain-index`.<br /> When nothing specified `chain-index` will be launched on default port `9083`.<br />
 
 ## Making own local network launcher
 

plutip-server/Api/Handlers.hs

@@ -21,8 +21,9 @@ import Data.Traversable (for)
 import System.Directory (doesFileExist)
 import System.FilePath (replaceFileName)
 import Test.Plutip.Config (
+  ChainIndexMode (NotNeeded),
   PlutipConfig (extraConfig),
-  chainIndexPort,
+  chainIndexMode,
   relayNodeLogs,
  )
 import Test.Plutip.Internal.BotPlutusInterface.Setup (keysDir)
@@ -80,7 +81,7 @@ startClusterHandler
     isClusterDown <- liftIO $ isEmptyMVar statusMVar
     unless isClusterDown $ throwError ClusterIsRunningAlready
     let extraConf = ExtraConfig slotLength epochSize
-        cfg = def {relayNodeLogs = nodeLogs, chainIndexPort = Nothing, extraConfig = extraConf}
+        cfg = def {relayNodeLogs = nodeLogs, chainIndexMode = NotNeeded, extraConfig = extraConf}
 
     (statusTVar, res@(clusterEnv, _)) <- liftIO $ startCluster cfg setup
     liftIO $ putMVar statusMVar statusTVar

plutip.cabal

@@ -161,6 +161,7 @@ library
     Test.Plutip.Internal.BotPlutusInterface.Setup
     Test.Plutip.Internal.BotPlutusInterface.Types
     Test.Plutip.Internal.BotPlutusInterface.Wallet
+    Test.Plutip.Internal.ChainIndex
     Test.Plutip.Internal.Cluster
     Test.Plutip.Internal.Cluster.Extra.Types
     Test.Plutip.Internal.Cluster.Extra.Utils

src/Test/Plutip/Config.hs

@@ -1,6 +1,7 @@
 module Test.Plutip.Config (
   PlutipConfig (..),
   WorkingDirectory (..),
+  ChainIndexMode (..),
 ) where
 
 import Cardano.Api (PaymentKey, SigningKey)
@@ -35,8 +36,9 @@ data PlutipConfig = PlutipConfig
     clusterDataDir :: Maybe FilePath
   , -- | in case of `Just path` relay node log will be saved to specified file
     relayNodeLogs :: Maybe FilePath
-  , -- | in case of `Nothing` port from `Plutus.ChainIndex.Config.defaultConfig` is used
-    chainIndexPort :: Maybe Natural
+  , -- | the way of how `chain-index` is launched (default port, custom port, not launched),
+    --   default mode - default port
+    chainIndexMode :: ChainIndexMode
   , -- | Multiplier on all BPI transaction budgets
     budgetMultiplier :: Rational
   , -- | cluster file location override, when provided, includes a `shouldKeep`
@@ -50,5 +52,16 @@ data PlutipConfig = PlutipConfig
   }
   deriving stock (Generic, Show)
 
+-- | The way to launch `chain-index`.
+-- It is possible to not launch it at all.
+data ChainIndexMode
+  = -- | launch on default port `9083`
+    DefaultPort
+  | -- | launch on custom port
+    CustomPort Natural
+  | -- | do not launch at all
+    NotNeeded
+  deriving stock (Generic, Eq, Show)
+
 instance Default PlutipConfig where
-  def = PlutipConfig Nothing Nothing Nothing 1 Temporary [] def
+  def = PlutipConfig Nothing Nothing DefaultPort 1 Temporary [] def

src/Test/Plutip/Internal/BotPlutusInterface/Run.hs

@@ -108,23 +108,34 @@ runContractWithLogLvl logLvl cEnv bpiWallet contract = do
     fromRight (error "Could not read protocol parameters file.")
       <$> liftIO (eitherDecodeFileStrict' (BIS.pParamsFile cEnv))
 
-  contactEnv <- liftIO $ mkEnv (mkPabConfig pparams)
+  chIndexUrl <-
+    maybe
+      ( error
+          "To run the contract with Plutip Chain Index must be launched, \
+          \ but it seems to be off.\
+          \ Check `ChainIndexMode` in `PlutipConfig`"
+      )
+      pure
+      (chainIndexUrl cEnv)
+
+  contactEnv <- mkEnv (mkPabConfig pparams chIndexUrl)
 
   runContract' contactEnv
   where
     mkEnv pabConf =
-      ContractEnvironment pabConf
-        <$> ContractInstanceId
-        <$> UUID.nextRandom
-        <*> newTVarIO (ContractState Active (mempty :: w))
-        <*> newTVarIO mempty
-        <*> newTVarIO mempty
-        <*> (Bpi.CollateralVar <$> newTVarIO Nothing)
+      liftIO $
+        ContractEnvironment pabConf
+          <$> ContractInstanceId
+          <$> UUID.nextRandom
+          <*> newTVarIO (ContractState Active (mempty :: w))
+          <*> newTVarIO mempty
+          <*> newTVarIO mempty
+          <*> (Bpi.CollateralVar <$> newTVarIO Nothing)
 
-    mkPabConfig pparams =
+    mkPabConfig pparams chIndexUrl =
       PABConfig
         { pcCliLocation = Local
-        , pcChainIndexUrl = chainIndexUrl cEnv
+        , pcChainIndexUrl = chIndexUrl
         , pcNetwork = networkId cEnv
         , pcProtocolParams = pparams
         , pcScriptFileDir = Text.pack $ BIS.scriptsDir cEnv

src/Test/Plutip/Internal/ChainIndex.hs

@@ -0,0 +1,103 @@
+module Test.Plutip.Internal.ChainIndex (
+  handleChainIndexLaunch,
+) where
+
+import Cardano.Api qualified as CAPI
+import Cardano.BM.Configuration.Model qualified as CM
+import Cardano.BM.Data.Severity qualified as Severity
+import Cardano.Launcher.Node (nodeSocketFile)
+
+import Control.Concurrent.Async (async)
+import Control.Monad (void)
+import Control.Retry (constantDelay, limitRetries, recoverAll)
+import Plutus.ChainIndex.App qualified as ChainIndex
+import Plutus.ChainIndex.Config qualified as ChainIndex
+import Plutus.ChainIndex.Logging (defaultConfig)
+import Servant.Client (BaseUrl (BaseUrl), Scheme (Http), mkClientEnv, runClientM)
+import System.FilePath ((</>))
+import Test.Plutip.Config (
+  ChainIndexMode (CustomPort, DefaultPort, NotNeeded),
+ )
+import Test.Plutip.Internal.Types (
+  RunningNode (RunningNode),
+ )
+import UnliftIO.Exception (throwString)
+
+import Cardano.Wallet.Primitive.Types (
+  NetworkParameters (NetworkParameters),
+  SlotLength (SlotLength),
+  SlottingParameters (SlottingParameters),
+ )
+import Data.Default (Default (def))
+import Data.Function ((&))
+import Data.Time (nominalDiffTimeToSeconds)
+import Ledger (Slot (Slot))
+import Ledger.TimeSlot (SlotConfig (scSlotLength))
+import Network.HTTP.Client (defaultManagerSettings, newManager)
+import Plutus.ChainIndex (Tip (Tip))
+import Plutus.ChainIndex.Client qualified as ChainIndexClient
+import Plutus.ChainIndex.Config qualified as CIC
+import PlutusPrelude ((.~), (^.))
+
+type ChainIndexPort = Int
+
+-- | Handle launch of `chain-index`. Depending on `ChainIndexMode`, it can be
+-- launched on default port, on custom port or not launched at all.
+-- In the latter case no port will be returned.
+handleChainIndexLaunch ::
+  ChainIndexMode ->
+  RunningNode ->
+  FilePath ->
+  IO (Maybe ChainIndexPort)
+handleChainIndexLaunch mode rn dir = do
+  maybePort <-
+    case mode of
+      DefaultPort -> do
+        Just <$> launchChainIndex (CIC.cicPort ChainIndex.defaultConfig) rn dir
+      CustomPort port' -> do
+        Just <$> launchChainIndex (fromEnum port') rn dir
+      NotNeeded -> pure Nothing
+  reportLaunch maybePort
+  pure maybePort
+  where
+    reportLaunch = \case
+      Just p -> putStrLn $ "Chain index started at port " <> show p
+      _ -> pure ()
+
+-- | Launch the chain index in a separate thread.
+launchChainIndex :: Int -> RunningNode -> FilePath -> IO Int
+launchChainIndex port (RunningNode sp _block0 (netParams, _vData) _) dir = do
+  let (NetworkParameters _ (SlottingParameters (SlotLength slotLen) _ _ _) _) = netParams
+
+  config <- defaultConfig
+  CM.setMinSeverity config Severity.Notice
+  let dbPath = dir </> "chain-index.db"
+      chainIndexConfig =
+        CIC.defaultConfig
+          & CIC.socketPath .~ nodeSocketFile sp
+          & CIC.dbPath .~ dbPath
+          & CIC.networkId .~ CAPI.Mainnet
+          & CIC.port .~ port
+          & CIC.slotConfig .~ (def {scSlotLength = toMilliseconds slotLen})
+
+  void $ async $ void $ ChainIndex.runMainWithLog (const $ return ()) config chainIndexConfig
+  waitForChainIndex
+  return $ chainIndexConfig ^. CIC.port
+  where
+    toMilliseconds = floor . (1e3 *) . nominalDiffTimeToSeconds
+
+    waitForChainIndex = do
+      -- TODO: move this to config; ideally, separate chain-index launch from cluster launch
+      let policy = constantDelay 1_000_000 <> limitRetries 60
+      recoverAll policy $ \_ -> do
+        tip <- queryTipWithChIndex
+        case tip of
+          Right (Tip (Slot _) _ _) -> pure ()
+          a ->
+            throwString $
+              "Timeout waiting for chain-index to start indexing. Last response:\n"
+                <> either show show a
+
+    queryTipWithChIndex = do
+      manager' <- newManager defaultManagerSettings
+      runClientM ChainIndexClient.getTip $ mkClientEnv manager' (BaseUrl Http "localhost" port "")