From 810790095ac32efa95035e96467a4b6d00b0f9c8 Mon Sep 17 00:00:00 2001 From: Koz Ross Date: Tue, 26 Sep 2023 12:22:23 +1300 Subject: [PATCH 1/2] Clearer Plutip sub-service failure messages --- src/Internal/Plutip/Server.purs | 52 +++++++++++++++++++++++---------- 1 file changed, 36 insertions(+), 16 deletions(-) diff --git a/src/Internal/Plutip/Server.purs b/src/Internal/Plutip/Server.purs index 4b2e52c3d..687c37ed7 100644 --- a/src/Internal/Plutip/Server.purs +++ b/src/Internal/Plutip/Server.purs @@ -20,7 +20,7 @@ import Contract.Address (NetworkId(MainnetId)) import Contract.Chain (waitNSlots) import Contract.Config (defaultSynchronizationParams, defaultTimeParams) import Contract.Monad (Contract, ContractEnv, liftContractM, runContractInEnv) -import Control.Monad.Error.Class (liftEither) +import Control.Monad.Error.Class (liftEither, throwError) import Control.Monad.State (State, execState, modify_) import Control.Monad.Trans.Class (lift) import Control.Monad.Writer (censor, execWriterT, tell) @@ -78,7 +78,7 @@ import Ctl.Internal.Wallet.Key (PrivatePaymentKey(PrivatePaymentKey)) import Data.Array as Array import Data.Bifunctor (lmap) import Data.BigInt as BigInt -import Data.Either (Either(Left), either, isLeft) +import Data.Either (Either(Left, Right), either, isLeft) import Data.Foldable (sum) import Data.HTTP.Method as Method import Data.Log.Level (LogLevel) @@ -103,7 +103,7 @@ import Effect.Aff.Retry , recovering ) import Effect.Class (liftEffect) -import Effect.Exception (error, throw) +import Effect.Exception (error, message, throw) import Effect.Ref (Ref) import Effect.Ref as Ref import Mote (bracket) as Mote @@ -270,19 +270,39 @@ startPlutipContractEnv , clearLogs :: Aff Unit } startPlutipContractEnv plutipCfg distr cleanupRef = do - configCheck plutipCfg - startPlutipServer' - ourKey /\ response <- startPlutipCluster' - startOgmios' response - startKupo' response - { env, printLogs, clearLogs } <- mkContractEnv' - wallets <- mkWallets' env ourKey response - pure - { env - , wallets - , printLogs - , clearLogs - } + configChecked <- try (configCheck plutipCfg) + case configChecked of + Left err -> throwError $ error $ "Config check failed: " <> message err + Right _ -> do + serverStarted <- try startPlutipServer' + case serverStarted of + Left err -> throwError $ error $ "Could not start Plutip server: " <> + message err + Right _ -> do + clusterStarted <- try startPlutipCluster' + case clusterStarted of + Left err -> throwError $ error $ "Could not start Plutip cluster: " + <> message err + Right (ourKey /\ response) -> do + ogmiosStarted <- try (startOgmios' response) + case ogmiosStarted of + Left err -> throwError $ error $ "Could not start Ogmios: " <> + message err + Right _ -> do + kupoStarted <- try (startKupo' response) + case kupoStarted of + Left err -> throwError $ error $ "Could not start Kupo: " <> + message err + Right _ -> do + { env, printLogs, clearLogs } <- + mkContractEnv' + wallets <- mkWallets' env ourKey response + pure + { env + , wallets + , printLogs + , clearLogs + } where -- Similar to `Aff.bracket`, except cleanup is pushed onto a stack to be run -- later. From 94c800ef4cb7265283685827fae5c0920d8e1198 Mon Sep 17 00:00:00 2001 From: Koz Ross Date: Wed, 27 Sep 2023 09:32:07 +1300 Subject: [PATCH 2/2] Reduce nesting using helper, remove additional checks on config --- src/Internal/Plutip/Server.purs | 58 ++++++++++++++------------------- 1 file changed, 25 insertions(+), 33 deletions(-) diff --git a/src/Internal/Plutip/Server.purs b/src/Internal/Plutip/Server.purs index e399f2691..d1f1b5610 100644 --- a/src/Internal/Plutip/Server.purs +++ b/src/Internal/Plutip/Server.purs @@ -270,40 +270,32 @@ startPlutipContractEnv , clearLogs :: Aff Unit } startPlutipContractEnv plutipCfg distr cleanupRef = do - configChecked <- try (configCheck plutipCfg) - case configChecked of - Left err -> throwError $ error $ "Config check failed: " <> message err - Right _ -> do - serverStarted <- try startPlutipServer' - case serverStarted of - Left err -> throwError $ error $ "Could not start Plutip server: " <> - message err - Right _ -> do - clusterStarted <- try startPlutipCluster' - case clusterStarted of - Left err -> throwError $ error $ "Could not start Plutip cluster: " - <> message err - Right (ourKey /\ response) -> do - ogmiosStarted <- try (startOgmios' response) - case ogmiosStarted of - Left err -> throwError $ error $ "Could not start Ogmios: " <> - message err - Right _ -> do - kupoStarted <- try (startKupo' response) - case kupoStarted of - Left err -> throwError $ error $ "Could not start Kupo: " <> - message err - Right _ -> do - { env, printLogs, clearLogs } <- - mkContractEnv' - wallets <- mkWallets' env ourKey response - pure - { env - , wallets - , printLogs - , clearLogs - } + configCheck plutipCfg + tryWithReport startPlutipServer' "Could not start Plutip server" + (ourKey /\ response) <- tryWithReport startPlutipCluster' + "Could not start Plutip cluster" + tryWithReport (startOgmios' response) "Could not start Ogmios" + tryWithReport (startKupo' response) "Could not start Kupo" + { env, printLogs, clearLogs } <- mkContractEnv' + wallets <- mkWallets' env ourKey response + pure + { env + , wallets + , printLogs + , clearLogs + } where + tryWithReport + :: forall (a :: Type) + . Aff a + -> String + -> Aff a + tryWithReport what prefix = do + result <- try what + case result of + Left err -> throwError $ error $ prefix <> ": " <> message err + Right result' -> pure result' + -- Similar to `Aff.bracket`, except cleanup is pushed onto a stack to be run -- later. bracket