Merge pull request #1471 from input-output-hk/1459-replace-panic-with-exceptions

Replace panic with exceptions

Author: Cmdv

cardano-chain-gen/test/Test/Cardano/Db/Mock/Config.hs

@@ -42,7 +42,7 @@ import qualified Cardano.Db as Db
 import Cardano.DbSync
 import Cardano.DbSync.Config
 import Cardano.DbSync.Config.Cardano
-import Cardano.DbSync.Error
+import Cardano.DbSync.Error (runOrThrowIO)
 import Cardano.DbSync.Types (CardanoBlock, MetricSetters (..))
 import Cardano.Mock.ChainSync.Server
 import Cardano.Mock.Forging.Interpreter
@@ -63,8 +63,7 @@ import Control.Exception (SomeException, bracket)
 import Control.Monad (void)
 import Control.Monad.Extra (eitherM)
 import Control.Monad.Logger (NoLoggingT, runNoLoggingT)
-import Control.Monad.Trans.Except.Exit (orDie)
-import Control.Monad.Trans.Except.Extra (newExceptT, runExceptT)
+import Control.Monad.Trans.Except.Extra (runExceptT)
 import Control.Tracer (nullTracer)
 import Data.Text (Text)
 import qualified Data.Text as Text
@@ -196,7 +195,7 @@ queryDBSync env = Db.runWithConnectionNoLogging (getDBSyncPGPass env)
 
 getPoolLayer :: DBSyncEnv -> IO PoolDataLayer
 getPoolLayer env = do
-  pgconfig <- orDie Db.renderPGPassError $ newExceptT $ Db.readPGPass (enpPGPassSource $ dbSyncParams env)
+  pgconfig <- runOrThrowIO $ Db.readPGPass (enpPGPassSource $ dbSyncParams env)
   pool <- runNoLoggingT $ createPostgresqlPool (Db.toConnectionString pgconfig) 1 -- Pool size of 1 for tests
   pure $
     postgresqlPoolDataLayer
@@ -206,7 +205,7 @@ getPoolLayer env = do
 mkConfig :: FilePath -> FilePath -> CommandLineArgs -> IO Config
 mkConfig staticDir mutableDir cmdLineArgs = do
   config <- readSyncNodeConfig $ ConfigFile (staticDir </> "test-db-sync-config.json")
-  genCfg <- either (error . Text.unpack . renderSyncNodeError) id <$> runExceptT (readCardanoGenesisConfig config)
+  genCfg <- runOrThrowIO $ runExceptT (readCardanoGenesisConfig config)
   let (pInfoDbSync, _) = mkProtocolInfoCardano genCfg []
   creds <- mkShelleyCredentials $ staticDir </> "pools" </> "bulk1.creds"
   let (pInfoForger, forging) = mkProtocolInfoCardano genCfg creds
@@ -231,7 +230,7 @@ mkShelleyCredentials bulkFile = do
 -- | staticDir can be shared by tests running in parallel. mutableDir not.
 mkSyncNodeParams :: FilePath -> FilePath -> CommandLineArgs -> IO SyncNodeParams
 mkSyncNodeParams staticDir mutableDir CommandLineArgs {..} = do
-  pgconfig <- orDie Db.renderPGPassError $ newExceptT Db.readPGPassDefault
+  pgconfig <- runOrThrowIO Db.readPGPassDefault
   pure $
     SyncNodeParams
       { enpConfigFile = ConfigFile $ staticDir </> (if claHasConfigFile then "test-db-sync-config.json" else "")

cardano-db-sync/app/http-get-json-metadata.hs

@@ -6,11 +6,9 @@ import Cardano.DbSync (
   SimplifiedPoolOfflineData (..),
   httpGetPoolOfflineData,
   parsePoolUrl,
-  renderFetchError,
  )
 import Control.Monad.IO.Class (liftIO)
-import Control.Monad.Trans.Except (ExceptT)
-import Control.Monad.Trans.Except.Exit (orDie)
+import Control.Monad.Trans.Except (ExceptT, runExceptT)
 import qualified Data.ByteString.Base16 as Base16
 import qualified Data.ByteString.Char8 as BS
 import qualified Data.Text as Text
@@ -26,6 +24,7 @@ import System.Console.ANSI.Types (
  )
 import System.Environment (getArgs, getProgName)
 import System.Exit (exitFailure)
+import Cardano.DbSync.Error (runOrThrowIO)
 
 main :: IO ()
 main = do
@@ -60,7 +59,7 @@ usageExit = do
 
 runHttpGet :: PoolUrl -> Maybe PoolMetaHash -> IO ()
 runHttpGet poolUrl mHash =
-  reportSuccess =<< orDie renderFetchError httpGet
+  reportSuccess =<< runOrThrowIO (runExceptT httpGet)
   where
     httpGet :: ExceptT FetchError IO SimplifiedPoolOfflineData
     httpGet = do

cardano-db-sync/app/test-http-get-json-metadata.hs

@@ -17,7 +17,6 @@ import Cardano.DbSync.Era.Shelley.Offline.Http (
   FetchError (..),
   httpGetPoolOfflineData,
   parsePoolUrl,
-  renderFetchError,
  )
 import Control.Monad (foldM)
 import Control.Monad.IO.Class (MonadIO)
@@ -28,7 +27,6 @@ import qualified Data.List as List
 import qualified Data.List.Extra as List
 import Data.Ord (Down (..))
 import Data.Text (Text)
-import qualified Data.Text.IO as Text
 import Database.Esqueleto.Experimental (
   SqlBackend,
   from,
@@ -65,7 +63,7 @@ main = do
         httpGetPoolOfflineData manager request poolUrl mHash
       case eres of
         Left err -> do
-          Text.putStrLn $ renderFetchError err
+          print err
           pure $ classifyFetchError accum err
         Right _ ->
           pure accum

cardano-db-sync/cardano-db-sync.cabal

@@ -265,7 +265,6 @@ executable http-get-json-metadata
                       , http-client-tls
                       , text
                       , transformers
-                      , transformers-except
 
 executable test-http-get-json-metadata
   default-language:     Haskell2010

cardano-db-sync/src/Cardano/DbSync.hs

@@ -23,7 +23,6 @@ module Cardano.DbSync (
   SimplifiedPoolOfflineData (..),
   httpGetPoolOfflineData,
   parsePoolUrl,
-  renderFetchError,
 ) where
 
 import Cardano.BM.Trace (Trace, logError, logInfo, logWarning)
@@ -52,22 +51,18 @@ import Cardano.DbSync.Era.Shelley.Offline.Http (
   SimplifiedPoolOfflineData (..),
   httpGetPoolOfflineData,
   parsePoolUrl,
-  renderFetchError,
   spodJson,
  )
-import Cardano.DbSync.Error
+import Cardano.DbSync.Error (SyncNodeError, runOrThrowIO, hasAbortOnPanicEnv)
 import Cardano.DbSync.Ledger.State
 import Cardano.DbSync.Rollback (unsafeRollback)
 import Cardano.DbSync.Sync (runSyncNodeClient)
 import Cardano.DbSync.Tracing.ToObjectOrphans ()
 import Cardano.DbSync.Types
-import Cardano.DbSync.Util (readAbortOnPanic)
 import Cardano.Prelude hiding (Nat, (%))
 import Cardano.Slotting.Slot (EpochNo (..))
 import Control.Concurrent.Async
 import Control.Monad.Extra (whenJust)
-import Control.Monad.Trans.Except.Exit (orDie)
-import Control.Monad.Trans.Except.Extra (newExceptT)
 import qualified Data.Text as Text
 import Data.Version (showVersion)
 import Database.Persist.Postgresql (ConnectionString, withPostgresqlConn)
@@ -82,7 +77,7 @@ runDbSyncNode metricsSetters knownMigrations params =
   withIOManager $ \iomgr -> do
     trce <- configureLogging params "db-sync-node"
 
-    aop <- readAbortOnPanic
+    aop <- hasAbortOnPanicEnv
     startupReport trce aop params
 
     runDbSync metricsSetters knownMigrations iomgr trce params aop
@@ -97,7 +92,7 @@ runDbSync ::
   IO ()
 runDbSync metricsSetters knownMigrations iomgr trce params aop = do
   -- Read the PG connection info
-  pgConfig <- orDie Db.renderPGPassError $ newExceptT (Db.readPGPass $ enpPGPassSource params)
+  pgConfig <- runOrThrowIO (Db.readPGPass $ enpPGPassSource params)
 
   mErrors <- liftIO $ Db.validateMigrations dbMigrationDir knownMigrations
   whenJust mErrors $ \(unknown, stage4orNewStage3) ->
@@ -106,7 +101,7 @@ runDbSync metricsSetters knownMigrations iomgr trce params aop = do
       else do
         let msg = Db.renderMigrationValidateError unknown
         logError trce msg
-        panic msg
+        throwIO unknown
 
   logInfo trce "Schema migration files validated"
 
@@ -174,7 +169,7 @@ runSyncNode metricsSetters trce iomgr dbConnString ranMigrations runMigrationFnc
   logInfo trce $ "Using alonzo genesis file from: " <> (show . unGenesisFile $ dncAlonzoGenesisFile syncNodeConfig)
   Db.runIohkLogging trce $
     withPostgresqlConn dbConnString $ \backend -> liftIO $ do
-      orDie renderSyncNodeError $ do
+      runOrThrowIO $ runExceptT $ do
         genCfg <- readCardanoGenesisConfig syncNodeConfig
         logProtocolMagicId trce $ genesisProtocolMagicId genCfg
 

cardano-db-sync/src/Cardano/DbSync/Api.hs

@@ -383,15 +383,15 @@ mkSyncEnvFromConfig trce connString backend syncOptions genCfg syncNodeParams ra
   case genCfg of
     GenesisCardano _ bCfg sCfg _
       | unProtocolMagicId (Byron.configProtocolMagicId bCfg) /= Shelley.sgNetworkMagic (scConfig sCfg) ->
-          pure . Left . NECardanoConfig $
+          pure . Left . SNErrCardanoConfig $
             mconcat
               [ "ProtocolMagicId "
               , DB.textShow (unProtocolMagicId $ Byron.configProtocolMagicId bCfg)
               , " /= "
               , DB.textShow (Shelley.sgNetworkMagic $ scConfig sCfg)
               ]
       | Byron.gdStartTime (Byron.configGenesisData bCfg) /= Shelley.sgSystemStart (scConfig sCfg) ->
-          pure . Left . NECardanoConfig $
+          pure . Left . SNErrCardanoConfig $
             mconcat
               [ "SystemStart "
               , DB.textShow (Byron.gdStartTime $ Byron.configGenesisData bCfg)

cardano-db-sync/src/Cardano/DbSync/Cache/Epoch.hs

@@ -71,7 +71,7 @@ writeEpochBlockDiffToCache ::
   ReaderT SqlBackend m (Either SyncNodeError ())
 writeEpochBlockDiffToCache cache epCurrent =
   case cache of
-    UninitiatedCache -> pure $ Left $ NEError "writeEpochBlockDiffToCache: Cache is UninitiatedCache"
+    UninitiatedCache -> pure $ Left $ SNErrDefault "writeEpochBlockDiffToCache: Cache is UninitiatedCache"
     Cache ci -> do
       cE <- liftIO $ readTVarIO (cEpoch ci)
       case (ceMapEpoch cE, ceEpochBlockDiff cE) of
@@ -93,12 +93,12 @@ writeToMapEpochCache syncEnv cache latestEpoch = do
           HasLedger hle -> getSecurityParameter $ leProtocolInfo hle
           NoLedger nle -> getSecurityParameter $ nleProtocolInfo nle
   case cache of
-    UninitiatedCache -> pure $ Left $ NEError "writeToMapEpochCache: Cache is UninitiatedCache"
+    UninitiatedCache -> pure $ Left $ SNErrDefault "writeToMapEpochCache: Cache is UninitiatedCache"
     Cache ci -> do
       -- get EpochBlockDiff so we can use the BlockId we stored when inserting blocks
       epochInternalCE <- readEpochBlockDiffFromCache cache
       case epochInternalCE of
-        Nothing -> pure $ Left $ NEError "writeToMapEpochCache: No epochInternalEpochCache"
+        Nothing -> pure $ Left $ SNErrDefault "writeToMapEpochCache: No epochInternalEpochCache"
         Just ei -> do
           cE <- liftIO $ readTVarIO (cEpoch ci)
           let currentBlockId = ebdBlockId ei

cardano-db-sync/src/Cardano/DbSync/Config.hs

@@ -27,14 +27,10 @@ import qualified Cardano.BM.Setup as Logging
 import Cardano.BM.Trace (Trace)
 import qualified Cardano.BM.Trace as Logging
 import Cardano.DbSync.Config.Cardano
-import Cardano.DbSync.Config.Node
+import Cardano.DbSync.Config.Node (NodeConfig(..), parseSyncPreConfig, readByteStringFromFile, parseNodeConfig)
 import Cardano.DbSync.Config.Shelley
 import Cardano.DbSync.Config.Types
-import Cardano.DbSync.Util
 import Cardano.Prelude
-import qualified Data.ByteString.Char8 as BS
-import qualified Data.Text as Text
-import qualified Data.Yaml as Yaml
 import System.FilePath (takeDirectory, (</>))
 
 configureLogging :: SyncNodeParams -> Text -> IO (Trace IO Text)
@@ -48,19 +44,14 @@ configureLogging params loggingName = do
 
 readSyncNodeConfig :: ConfigFile -> IO SyncNodeConfig
 readSyncNodeConfig (ConfigFile fp) = do
-  pcfg <- adjustNodeFilePath . parseSyncPreConfig <$> readByteString fp "DbSync"
-  ncfg <- parseNodeConfig <$> readByteString (pcNodeConfigFilePath pcfg) "node"
+  pcfg <- (adjustNodeFilePath . parseSyncPreConfig) =<< readByteStringFromFile fp "DbSync"
+  ncfg <- parseNodeConfig =<< readByteStringFromFile (pcNodeConfigFilePath pcfg) "node"
   coalesceConfig pcfg ncfg (mkAdjustPath pcfg)
   where
-    parseSyncPreConfig :: ByteString -> SyncPreConfig
-    parseSyncPreConfig bs =
-      case Yaml.decodeEither' bs of
-        Left err -> panic $ "readSyncNodeConfig: Error parsing config: " <> textShow err
-        Right res -> res
-
-    adjustNodeFilePath :: SyncPreConfig -> SyncPreConfig
-    adjustNodeFilePath cfg =
-      cfg {pcNodeConfigFile = adjustNodeConfigFilePath (takeDirectory fp </>) (pcNodeConfigFile cfg)}
+    adjustNodeFilePath :: IO SyncPreConfig -> IO SyncPreConfig
+    adjustNodeFilePath spc = do
+      cfg <- spc
+      pure $ cfg {pcNodeConfigFile = adjustNodeConfigFilePath (takeDirectory fp </>) (pcNodeConfigFile cfg)}
 
 coalesceConfig ::
   SyncPreConfig ->
@@ -97,8 +88,3 @@ coalesceConfig pcfg ncfg adjustGenesisPath = do
 
 mkAdjustPath :: SyncPreConfig -> (FilePath -> FilePath)
 mkAdjustPath cfg fp = takeDirectory (pcNodeConfigFilePath cfg) </> fp
-
-readByteString :: FilePath -> Text -> IO ByteString
-readByteString fp cfgType =
-  catch (BS.readFile fp) $ \(_ :: IOException) ->
-    panic $ mconcat ["Cannot find the ", cfgType, " configuration file at : ", Text.pack fp]

cardano-db-sync/src/Cardano/DbSync/Config/Alonzo.hs

@@ -26,7 +26,7 @@ readAlonzoGenesisConfig ::
   ExceptT SyncNodeError IO AlonzoGenesis
 readAlonzoGenesisConfig enc = do
   let file = unGenesisFile $ dncAlonzoGenesisFile enc
-  firstExceptT (NEAlonzoConfig file . renderAlonzoGenesisError) $
+  firstExceptT (SNErrAlonzoConfig file . renderAlonzoGenesisError) $
     readGenesis (GenesisFile file) Nothing
 
 data AlonzoGenesisError

cardano-db-sync/src/Cardano/DbSync/Config/Byron.hs

@@ -1,6 +1,5 @@
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RankNTypes #-}
 
 module Cardano.DbSync.Config.Byron (
@@ -20,8 +19,8 @@ readByronGenesisConfig ::
 readByronGenesisConfig enc = do
   let file = unGenesisFile $ dncByronGenesisFile enc
   genHash <-
-    firstExceptT NEError
+    firstExceptT SNErrDefault
       . hoistEither
       $ decodeAbstractHash (unGenesisHashByron $ dncByronGenesisHash enc)
-  firstExceptT (NEByronConfig file) $
+  firstExceptT (SNErrByronConfig file) $
     Byron.mkConfigFromFile (dncRequiresNetworkMagic enc) file genHash