Merge pull request #141 from mlabs-haskell/experimental-config

Configurable slot length and epoch size

CHANGELOG.md

@@ -4,9 +4,15 @@ This format is based on [Keep A Changelog](https://keepachangelog.com/en/1.0.0).
 
 ## Unreleased
 
+- Wallets with Base Address support
+- Lookups for wallets in tasty integration
+
+## [1.2.0] - 2022-10-21
+
 ### Added
 
 - `Plutip` configuration
+  - Ability to set slot length and epoch size
   - Ability to add custom keys constant across runs, e.g. to use them as extra signers
   - Ability to set custom file where relay node log can be saved after tests run
   - Ability to set to set custom port for `chain-idex`

Makefile

@@ -39,13 +39,14 @@ requires_nix_shell:
 FOURMOLU_EXTENSIONS := -o -XTypeApplications -o -XTemplateHaskell -o -XImportQualifiedPost -o -XPatternSynonyms -o -fplugin=RecordDotPreprocessor
 
 # Add folder locations to the list to be reformatted.
+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/ -iregex ".*.hs")
+	fourmolu $(FOURMOLU_EXTENSIONS) --mode inplace --check-idempotence $$(find src/ test/ plutip-server/ local-cluster/ -iregex ".*.hs" -not -path "${excluded}")
 
 format_check:
 	@ echo "> Checking format of all .hs files"
-	fourmolu $(FOURMOLU_EXTENSIONS) --mode check --check-idempotence $$(find src/ test/ plutip-server/ -iregex ".*.hs")
+	fourmolu $(FOURMOLU_EXTENSIONS) --mode check --check-idempotence $$(find src/ test/ plutip-server/ local-cluster/ -iregex ".*.hs" -not -path "${excluded}" )
 
 NIX_SOURCES := $(shell fd -enix)
 
@@ -64,4 +65,4 @@ cabalfmt_check: requires_nix_shell
 	cabal-fmt --check $(CABAL_SOURCES)
 
 lint: requires_nix_shell
-	hlint $$(find src/  -iregex ".*.hs") $$(find test/ -iregex ".*.hs")
+	hlint $$(find src/  -iregex ".*.hs"  -not -path "${excluded}") $$(find test/ -iregex ".*.hs")

README.md

@@ -49,3 +49,7 @@ NOTE: This branch launches local network in `Vasil`. It was tested with node `1.
 
 * [Tweaking local network](./docs/tweaking-network.md)
 * [Regenerating network configs](./docs/regenerate-network-configs.md)
+
+## Maintenance
+
+* [Important notes on updating `cardano-wallet` dependency](./docs/cardano-wallet-update.md)

docs/cardano-wallet-update.md

@@ -0,0 +1,7 @@
+# Cluster launcher update
+
+`Plutip` heavily relies on local cluster testing framework from `cardano-wallet`.
+
+Initially, framework was used as-is, but in order to add to Plutip ability to set slot length and epoch size, module `Cluster.hs` was copied from `cardano-wallet` to Plutip's codebase and adjusted to make this settings possible. So in case of updating `cardano-wallet` dependency be sure that original `Cluster.hs` and Plutip's one differs only in expected way.
+
+At the moment all changes are related to adding `ExtraConfig` to necessary ADTs and functions in Plutip's version of `Cluster.hs` and difference with the original is pretty small.

docs/tweaking-network.md

@@ -1,5 +1,13 @@
 # Tweaking private network
 
+## Setting slot length and epoch size
+
+It is possible to set slot length and epoch size while starting network from haskell via `PlutipConfig` - `extraConfig :: ExtraConfig` holds corresponding fields.
+
+For setting parameters while launching `local-cluster` executable see `--slot-len` and `--epoch-size` options in [documentation](../local-cluster/README.md).
+
+## Tweaking cluster config files
+
 It is possible to change some settings of local network that Plutip starts. By default Plutip uses node config, genesis files and etc. from `cluster-data` directory.
 
 It is not advised to change anything in `cluster-data`. Better way will be to copy `cluster-data` to desired location, change what is needed and then point Plutip  to this custom directory via `PlutipConfig.clusterDataDir` field when calling `withConfiguredCluster` or `startCluster`.

hie.yaml

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

local-cluster/Main.hs

@@ -5,42 +5,56 @@
 
 module Main (main) where
 
+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))
+import Control.Monad.Reader (ReaderT (ReaderT), ask)
 import Data.Default (def)
+import Data.Time (NominalDiffTime)
+import GHC.Natural (Natural)
+import GHC.Word (Word64)
 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.Types (nodeSocket)
-import Test.Plutip.LocalCluster
-  ( mkMainnetAddress,
-    startCluster,
-    stopCluster,
-    waitSeconds,
-  )
-import GHC.Natural (Natural)
+import Test.Plutip.Config (
+  PlutipConfig (clusterWorkingDir, extraConfig),
+  WorkingDirectory (Fixed, Temporary),
+ )
+import Test.Plutip.Internal.BotPlutusInterface.Wallet (
+  addSomeWalletDir,
+  cardanoMainnetAddress,
+  walletPkh,
+ )
+import Test.Plutip.Internal.Cluster.Extra.Types (
+  ExtraConfig (ExtraConfig),
+ )
+import Test.Plutip.Internal.Types (ClusterEnv, nodeSocket)
+import Test.Plutip.LocalCluster (
+  BpiWallet,
+  mkMainnetAddress,
+  startCluster,
+  stopCluster,
+ )
+import Test.Plutip.Tools.Cluster (awaitAddressFunded)
 
 main :: IO ()
 main = do
   config <- Options.execParser (info (pClusterConfig <**> helper) mempty)
   case totalAmount config of
     Left e -> error e
     Right amt -> do
-      let CWalletConfig {numWallets, dirWallets, numUtxos, workDir} = config
+      let ClusterConfig {numWallets, dirWallets, numUtxos, workDir, slotLength, epochSize} = config
           workingDir = maybe Temporary (`Fixed` False) workDir
-          plutipConfig = def {clusterWorkingDir = workingDir}
+
+          exctraCong = ExtraConfig slotLength epochSize
+          plutipConfig = def {clusterWorkingDir = workingDir, extraConfig = exctraCong}
 
       putStrLn "Starting cluster..."
       (st, _) <- startCluster plutipConfig $ do
         ws <- initWallets numWallets numUtxos amt dirWallets
-        waitSeconds 2 -- let wallet Tx finish, it can take more time with bigger slot length
+        liftIO $ putStrLn "Waiting for wallets to be funded..."
+        awaitFunds ws (ceiling slotLength)
 
         separate
         liftIO $ forM_ (zip ws [(1 :: Int) ..]) printWallet
@@ -58,7 +72,7 @@ main = do
 
     separate = liftIO $ putStrLn "\n------------\n"
 
-    totalAmount :: CWalletConfig -> Either String Positive
+    totalAmount :: ClusterConfig -> Either String Positive
     totalAmount cwc =
       case toAda (adaAmount cwc) + lvlAmount cwc of
         0 -> Left "One of --ada or --lovelace arguments should not be 0"
@@ -74,6 +88,15 @@ 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)
+
 pnumWallets :: Parser Int
 pnumWallets =
   Options.option
@@ -134,24 +157,52 @@ pWorkDir =
           <> Options.metavar "FILEPATH"
       )
 
-pClusterConfig :: Parser CWalletConfig
+pSlotLen :: Parser NominalDiffTime
+pSlotLen =
+  Options.option
+    Options.auto
+    ( Options.long "slot-len"
+        <> Options.short 's'
+        <> Options.metavar "SLOT_LEN"
+        <> Options.value 0.2
+    )
+
+pEpochSize :: Parser EpochSize
+pEpochSize =
+  EpochSize <$> wordParser
+  where
+    wordParser :: Parser Word64
+    wordParser =
+      Options.option
+        Options.auto
+        ( Options.long "epoch-size"
+            <> Options.short 'e'
+            <> Options.metavar "EPOCH_SIZE"
+            <> Options.value 160
+        )
+
+pClusterConfig :: Parser ClusterConfig
 pClusterConfig =
-  CWalletConfig
+  ClusterConfig
     <$> pnumWallets
     <*> pdirWallets
     <*> padaAmount
     <*> plvlAmount
     <*> pnumUtxos
     <*> pWorkDir
+    <*> pSlotLen
+    <*> pEpochSize
 
 -- | Basic info about the cluster, to
 -- be used by the command-line
-data CWalletConfig = CWalletConfig
-  { numWallets :: Int,
-    dirWallets :: Maybe FilePath,
-    adaAmount :: Natural,
-    lvlAmount :: Natural,
-    numUtxos :: Int,
-    workDir :: Maybe FilePath
+data ClusterConfig = ClusterConfig
+  { numWallets :: Int
+  , dirWallets :: Maybe FilePath
+  , adaAmount :: Natural
+  , lvlAmount :: Natural
+  , numUtxos :: Int
+  , workDir :: Maybe FilePath
+  , slotLength :: NominalDiffTime
+  , epochSize :: EpochSize
   }
   deriving stock (Show, Eq)

local-cluster/README.md

@@ -38,6 +38,8 @@ Full | Short | Description
 --lovelace AMOUNT | -l AMOUNT | Puts `AMOUNT` Lovelace into each UTxO in every wallet created, in addition to the amount specified by the `--ada` argument. Note that if you don't specify the amount of ADA to add, the total amount will be 10,000 ADA + `AMOUNT` lovelace. <br /> Note that both `--ada` and `--lovelace` can not be 0 at the same time.
 --utxos NUM | -u NUM | Create `NUM` UTxOs in each wallet created. Note that each UTxO created has the amount of ADA determined by the `--ada` and `--lovelace` arguments.
 --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.
 
 ## Making own local network launcher
 

plutip-server/Api/Handlers.hs

@@ -5,7 +5,9 @@ module Api.Handlers (
 
 import Cardano.Api (serialiseToCBOR)
 import Cardano.Launcher.Node (nodeSocketFile)
-import Cardano.Wallet.Shelley.Launch.Cluster (RunningNode (RunningNode))
+
+-- import Cardano.Wallet.Shelley.Launch.Cluster (RunningNode (RunningNode))
+
 import Control.Concurrent.MVar (isEmptyMVar, putMVar, takeMVar)
 import Control.Monad (unless)
 import Control.Monad.Except (runExceptT, throwError)
@@ -19,12 +21,14 @@ import Data.Text.Encoding qualified as Text
 import Data.Traversable (for)
 import System.Directory (doesFileExist)
 import System.FilePath (replaceFileName)
-import Test.Plutip.Config (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)
+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.LocalCluster (startCluster, stopCluster)
 import Test.Plutip.Internal.Types (ClusterEnv (runningNode))
-import Test.Plutip.LocalCluster (waitSeconds)
+import Test.Plutip.Tools.Cluster (awaitAddressFunded)
 import Types (
   AppM,
   ClusterStartupFailureReason (
@@ -43,7 +47,12 @@ import Types (
   Lovelace (unLovelace),
   PrivateKey,
   ServerOptions (ServerOptions, nodeLogs),
-  StartClusterRequest (StartClusterRequest, keysToGenerate),
+  StartClusterRequest (
+    StartClusterRequest,
+    epochSize,
+    keysToGenerate,
+    slotLength
+  ),
   StartClusterResponse (
     ClusterStartupFailure,
     ClusterStartupSuccess
@@ -55,7 +64,7 @@ import Types (
 startClusterHandler :: ServerOptions -> StartClusterRequest -> AppM StartClusterResponse
 startClusterHandler
   ServerOptions {nodeLogs}
-  StartClusterRequest {keysToGenerate} = interpret $ do
+  StartClusterRequest {slotLength, epochSize, keysToGenerate} = interpret $ do
     -- Check that lovelace amounts are positive
     for_ keysToGenerate $ \lovelaceAmounts -> do
       for_ lovelaceAmounts $ \lovelaces -> do
@@ -64,7 +73,9 @@ startClusterHandler
     statusMVar <- asks status
     isClusterDown <- liftIO $ isEmptyMVar statusMVar
     unless isClusterDown $ throwError ClusterIsRunningAlready
-    let cfg = def {relayNodeLogs = nodeLogs, chainIndexPort = Nothing}
+    let extraConf = ExtraConfig slotLength epochSize
+        cfg = def {relayNodeLogs = nodeLogs, chainIndexPort = Nothing, extraConfig = extraConf}
+
     (statusTVar, res@(clusterEnv, _)) <- liftIO $ startCluster cfg setup
     liftIO $ putMVar statusMVar statusTVar
     let nodeConfigPath = getNodeConfigFile clusterEnv
@@ -85,7 +96,8 @@ startClusterHandler
         wallets <- do
           for keysToGenerate $ \lovelaceAmounts -> do
             addSomeWallet (fromInteger . unLovelace <$> lovelaceAmounts)
-        waitSeconds 2 -- wait for transactions to submit
+        liftIO $ putStrLn "Waiting for wallets to be funded..."
+        awaitFunds wallets 2
         pure (env, wallets)
       getNodeSocketFile (runningNode -> RunningNode conn _ _ _) = nodeSocketFile conn
       getNodeConfigFile =
@@ -95,6 +107,15 @@ startClusterHandler
       getWalletPrivateKey = Text.decodeUtf8 . Base16.encode . serialiseToCBOR . signKey
       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)
+
 stopClusterHandler :: StopClusterRequest -> AppM StopClusterResponse
 stopClusterHandler StopClusterRequest = do
   statusMVar <- asks status

plutip-server/Types.hs

@@ -11,7 +11,7 @@ module Types (
   PlutipServerError (PlutipServerError),
   PrivateKey,
   ServerOptions (ServerOptions, nodeLogs, port),
-  StartClusterRequest (StartClusterRequest, keysToGenerate),
+  StartClusterRequest (StartClusterRequest, keysToGenerate, slotLength, epochSize),
   StartClusterResponse (
     ClusterStartupSuccess,
     ClusterStartupFailure
@@ -27,23 +27,20 @@ module Types (
   StopClusterResponse (StopClusterSuccess, StopClusterFailure),
 ) where
 
+import Cardano.Ledger.Slot (EpochSize)
 import Control.Concurrent.MVar (MVar)
 import Control.Monad.Catch (Exception, MonadThrow)
 import Control.Monad.IO.Class (MonadIO)
 import Control.Monad.Reader (MonadReader, ReaderT)
 import Data.Aeson (FromJSON, ToJSON, parseJSON)
 import Data.Kind (Type)
 import Data.Text (Text)
+import Data.Time (NominalDiffTime)
 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
-  ),
+  ClusterStatus,
  )
 import Test.Plutip.Internal.Types (ClusterEnv)
 import UnliftIO.STM (TVar)
@@ -97,8 +94,10 @@ instance FromJSON Lovelace where
       then fail "Lovelace value must not be negative"
       else pure $ Lovelace value
 
-newtype StartClusterRequest = StartClusterRequest
-  { -- | Lovelace amounts for each UTXO of each wallet
+data StartClusterRequest = StartClusterRequest
+  { slotLength :: NominalDiffTime
+  , epochSize :: EpochSize
+  , -- | Lovelace amounts for each UTXO of each wallet
     keysToGenerate :: [[Lovelace]]
   }
   deriving stock (Show, Eq, Generic)