diff --git a/local-cluster/Main.hs b/local-cluster/Main.hs index 391a7cac..8d13d47c 100644 --- a/local-cluster/Main.hs +++ b/local-cluster/Main.hs @@ -37,6 +37,7 @@ main = do workingDir = maybe Temporary (`Fixed` False) workDir plutipConfig = def {clusterWorkingDir = workingDir} + 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 diff --git a/src/Test/Plutip/Internal/LocalCluster.hs b/src/Test/Plutip/Internal/LocalCluster.hs index 0eb5c4b4..542ecf9b 100644 --- a/src/Test/Plutip/Internal/LocalCluster.hs +++ b/src/Test/Plutip/Internal/LocalCluster.hs @@ -39,7 +39,7 @@ import Paths_plutip (getDataFileName) 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)) +import Servant.Client (BaseUrl (BaseUrl), Scheme (Http), mkClientEnv, runClientM) import System.Directory (canonicalizePath, copyFile, createDirectoryIfMissing, doesPathExist, findExecutable, removeDirectoryRecursive) import System.Environment (setEnv) import System.Exit (die) @@ -70,7 +70,7 @@ import Test.Plutip.Internal.Types ( import Test.Plutip.Tools.CardanoApi qualified as Tools import Text.Printf (printf) import UnliftIO.Concurrent (forkFinally, myThreadId, throwTo) -import UnliftIO.Exception (bracket, catchIO, finally) +import UnliftIO.Exception (bracket, catchIO, finally, throwString) import UnliftIO.STM (TVar, atomically, newTVarIO, readTVar, retrySTM, writeTVar) import Cardano.Wallet.Primitive.Types ( @@ -81,7 +81,11 @@ import Cardano.Wallet.Primitive.Types ( 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 ((.~), (^.)) @@ -145,7 +149,7 @@ withPlutusInterface conf action = do runActionWthSetup rn dir trCluster userActon = do let tracer' = trMessageText trCluster waitForRelayNode tracer' rn - -- launch chain index in seperate thread, logs to stdout + -- launch chain index in separate thread ciPort <- launchChainIndex conf rn dir traceWith tracer' (ChaiIndexStartedAt ciPort) let cEnv = @@ -250,8 +254,10 @@ waitForRelayNode trCluster rn = getTip = trace >> Tools.queryTip rn trace = traceWith trCluster WaitingRelayNode wait _ = do - -- give some time for setup - (ChainTip (SlotNo ((> 5) -> True)) _ _) <- getTip + tip <- getTip + case tip of + (ChainTip (SlotNo _) _ _) -> pure () + a -> throwString $ "Timeout waiting for node to start. Last 'tip' response:\n" <> show a pure () -- | Launch the chain index in a separate thread. @@ -262,6 +268,7 @@ launchChainIndex conf (RunningNode sp _block0 (netParams, _vData) _) dir = do config <- defaultConfig CM.setMinSeverity config Severity.Notice let dbPath = dir "chain-index.db" + port = maybe (CIC.cicPort ChainIndex.defaultConfig) fromEnum (chainIndexPort conf) chainIndexConfig = CIC.defaultConfig & CIC.socketPath .~ nodeSocketFile sp @@ -271,10 +278,26 @@ launchChainIndex conf (RunningNode sp _block0 (netParams, _vData) _) dir = do & CIC.slotConfig .~ (def {scSlotLength = toMilliseconds slotLen}) void . async $ void $ ChainIndex.runMainWithLog (const $ return ()) config chainIndexConfig + waitForChainIndex port return $ chainIndexConfig ^. CIC.port where toMilliseconds = floor . (1e3 *) . nominalDiffTimeToSeconds + waitForChainIndex port = do + let policy = constantDelay 1_000_000 <> limitRetries 60 + recoverAll policy $ \_ -> do + tip <- queryTipWithChIndex port + case tip of + Right (Tip (Slot _) _ _) -> pure () + a -> + throwString $ + "Timeout waiting for chain-index to start indexing. Last response:\n" + <> show a + + queryTipWithChIndex port = do + manager' <- newManager defaultManagerSettings + runClientM ChainIndexClient.getTip $ mkClientEnv manager' (BaseUrl Http "localhost" port "") + handleLogs :: HasCallStack => FilePath -> PlutipConfig -> IO () handleLogs clusterDir conf = copyRelayLog `catchIO` (error . printf "Failed to save relay node log: %s" . show)