Replace panic with exceptions

Author: Cmdv

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

@@ -196,7 +196,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
@@ -230,8 +230,8 @@ 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
+mkSyncNodeParams staticDir mutableDir CommandLineArgs{..} = do
+  pgconfig <- runOrThrowIO Db.readPGPassDefault
   pure $
     SyncNodeParams
       { enpConfigFile = ConfigFile $ staticDir </> (if claHasConfigFile then "test-db-sync-config.json" else "")

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

@@ -55,7 +55,7 @@ import Cardano.DbSync.Era.Shelley.Offline.Http (
   renderFetchError,
   spodJson,
  )
-import Cardano.DbSync.Error
+import Cardano.DbSync.Error ( renderSyncNodeError, runOrThrowExcept, SyncNodeError )
 import Cardano.DbSync.Ledger.State
 import Cardano.DbSync.Rollback (unsafeRollback)
 import Cardano.DbSync.Sync (runSyncNodeClient)
@@ -66,8 +66,6 @@ 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)
@@ -87,6 +85,8 @@ runDbSyncNode metricsSetters knownMigrations params =
 
     runDbSync metricsSetters knownMigrations iomgr trce params aop
 
+
+
 runDbSync ::
   MetricSetters ->
   [(Text, Text)] ->
@@ -97,7 +97,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 +106,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"
 

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

@@ -1,5 +1,6 @@
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE RankNTypes #-}
 
 module Cardano.DbSync.Error (
   SyncInvariant (..),
@@ -10,6 +11,7 @@ module Cardano.DbSync.Error (
   dbSyncInvariant,
   renderSyncInvariant,
   renderSyncNodeError,
+  runOrThrowIO
 ) where
 
 import qualified Cardano.Chain.Genesis as Byron
@@ -118,3 +120,10 @@ bsBase16Encode bs =
   case Text.decodeUtf8' (Base16.encode bs) of
     Left _ -> Text.pack $ "UTF-8 decode failed for " ++ show bs
     Right txt -> txt
+
+runOrThrowIO :: forall e a. Exception e => IO (Either e a) -> IO a
+runOrThrowIO ioEither = do
+  either <- ioEither
+  case either of
+    Left err -> throwIO err
+    Right a -> pure a

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

@@ -190,7 +190,7 @@ readStateUnsafe :: HasLedgerEnv -> STM LedgerDB
 readStateUnsafe env = do
   mState <- readTVar $ leStateVar env
   case mState of
-    Strict.Nothing -> panic "LedgerState.readStateUnsafe: Ledger state is not found"
+    Strict.Nothing -> throwSTM $ userError "LedgerState.readStateUnsafe: Ledger state is not found"
     Strict.Just st -> pure st
 
 applyBlockAndSnapshot :: HasLedgerEnv -> CardanoBlock -> Bool -> IO (ApplyResult, Bool)

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

@@ -50,13 +50,13 @@ import Data.Functor.Contravariant (contramap)
 import qualified Data.List as List
 import qualified Data.Text as Text
 import Database.Persist.Postgresql (SqlBackend)
+import GHC.Base (error)
 import Network.Mux (MuxTrace, WithMuxBearer)
 import Network.Mux.Types (MuxMode (..))
 import Network.TypedProtocol.Pipelined (N (..), Nat (Succ, Zero))
 import Ouroboros.Consensus.Block.Abstract (CodecConfig)
 import Ouroboros.Consensus.Byron.Node ()
 import Ouroboros.Consensus.Cardano.Node ()
-
 import Ouroboros.Consensus.Config (configCodec)
 import Ouroboros.Consensus.Network.NodeToClient (
   Codecs' (..),
@@ -241,7 +241,7 @@ dbSyncProtocols syncEnv metricsSetters tc codecConfig version bversion _connecti
                     ( Client.chainSyncClientPeer $
                         chainSyncClientFixScripts backend tracer ls
                     )
-              when onlyFix $ panic "All Good! This error is only thrown to exit db-sync" -- TODO fix.
+              when onlyFix $ error "All Good! This error is only thrown to exit db-sync"
               setIsFixed syncEnv AllFixRan
               pure False
             else do

cardano-db-tool/app/cardano-db-tool.hs

@@ -54,7 +54,7 @@ runCommand cmd =
     CmdReport report -> runReport report
     CmdRollback slotNo -> runRollback slotNo
     CmdRunMigrations mdir forceIndexes mockFix mldir -> do
-      pgConfig <- orDie renderPGPassError $ newExceptT (readPGPass PGPassDefaultEnv)
+      pgConfig <- runOrThrowIO (readPGPass PGPassDefaultEnv)
       unofficial <- snd <$> runMigrations pgConfig False mdir mldir Initial
       unless (null unofficial) $
         putStrLn $

cardano-db/src/Cardano/Db/Error.hs

@@ -1,18 +1,22 @@
 {-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RankNTypes #-}
 
 module Cardano.Db.Error (
   LookupFail (..),
   renderLookupFail,
+  runOrThrowIO,
 ) where
 
+import Control.Exception (Exception, throwIO)
 import qualified Data.ByteString.Base16 as Base16
 import Data.ByteString.Char8 (ByteString)
 import Data.Text (Text)
 import qualified Data.Text as Text
 import qualified Data.Text.Encoding as Text
 import Data.Word (Word16, Word64)
-import GHC.Generics
+import GHC.Generics (Generic)
 
 data LookupFail
   = DbLookupBlockHash !ByteString
@@ -25,7 +29,24 @@ data LookupFail
   | DbMetaEmpty
   | DbMetaMultipleRows
   | DBMultipleGenesis
-  deriving (Eq, Show, Generic)
+  deriving (Eq, Generic)
+
+instance Exception LookupFail
+
+instance Show LookupFail where
+  show =
+    \case
+      DbLookupBlockHash h -> "The block hash " <> show (base16encode h) <> " is missing from the DB."
+      DbLookupBlockId blkid -> "block id " <> show blkid
+      DbLookupMessage txt -> show txt
+      DbLookupTxHash h -> "tx hash " <> show (base16encode h)
+      DbLookupTxOutPair h i -> concat ["tx out pair (", show $ base16encode h, ", ", show i, ")"]
+      DbLookupEpochNo e -> "epoch number " ++ show e
+      DbLookupSlotNo s -> "slot number " ++ show s
+      DbMetaEmpty -> "Meta table is empty"
+      DbMetaMultipleRows -> "Multiple rows in Meta table which should only contain one"
+      DBMultipleGenesis ->
+        "Multiple Genesis blocks found. These are blocks without an EpochNo"
 
 renderLookupFail :: LookupFail -> Text
 renderLookupFail lf =
@@ -50,3 +71,10 @@ base16encode = Text.decodeUtf8 . Base16.encode
 
 textShow :: Show a => a -> Text
 textShow = Text.pack . show
+
+runOrThrowIO :: forall e a. Exception e => IO (Either e a) -> IO a
+runOrThrowIO ioEither = do
+  et <- ioEither
+  case et of
+    Left err -> throwIO err
+    Right a -> pure a

cardano-db/src/Cardano/Db/Migration.hs

@@ -74,6 +74,8 @@ import System.IO (
   withFile,
  )
 import Text.Read (readMaybe)
+import Control.Exception (Exception)
+import Cardano.Prelude (Typeable)
 
 newtype MigrationDir
   = MigrationDir FilePath
@@ -92,7 +94,9 @@ data MigrationValidateError = UnknownMigrationsFound
   { missingMigrations :: [MigrationValidate]
   , extraMigrations :: [MigrationValidate]
   }
-  deriving (Eq, Show)
+  deriving (Eq, Show, Typeable)
+
+instance Exception MigrationValidateError
 
 data MigrationToRun = Initial | Full | Fix | Indexes
   deriving (Show, Eq)

cardano-db/src/Cardano/Db/PGConfig.hs

@@ -12,16 +12,13 @@ module Cardano.Db.PGConfig (
   readPGPassFileEnv,
   readPGPassFile,
   readPGPassFileExit,
-  renderPGPassError,
   toConnectionString,
 ) where
 
-import Cardano.Db.Text
 import Control.Exception (IOException)
 import qualified Control.Exception as Exception
 import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as BS
-import Data.Text (Text)
 import qualified Data.Text as Text
 import Database.Persist.Postgresql (ConnectionString)
 import System.Environment (lookupEnv, setEnv)
@@ -132,24 +129,48 @@ data PGPassError
   | FailedToReadPGPassFile FilePath IOException
   | FailedToParsePGPassConfig ByteString
 
-renderPGPassError :: PGPassError -> Text
-renderPGPassError pge =
-  case pge of
-    EnvVarableNotSet str ->
-      mconcat ["Environment variable '", Text.pack str, " not set."]
-    UserFailed err ->
-      mconcat
-        [ "readPGPassFile: User in pgpass file was specified as '*' but "
-        , "getEffectiveUserName failed with "
-        , textShow err
-        ]
-    FailedToReadPGPassFile fpath err ->
-      mconcat
-        [ "Not able to read PGPassFile at "
-        , textShow fpath
-        , "."
-        , "Failed with "
-        , textShow err
-        ]
-    FailedToParsePGPassConfig bs ->
-      "Failed to parse config from " <> textShow bs
+instance Exception.Exception PGPassError
+
+instance Show PGPassError where
+  show e =
+    case e of
+      EnvVarableNotSet str ->
+        mconcat ["Environment variable '", show str, " not set."]
+      UserFailed err ->
+        mconcat
+          [ "readPGPassFile: User in pgpass file was specified as '*' but "
+          , "getEffectiveUserName failed with "
+          , show err
+          ]
+      FailedToReadPGPassFile fpath err ->
+        mconcat
+          [ "Not able to read PGPassFile at "
+          , show $ Text.pack fpath
+          , "."
+          , "Failed with "
+          , show err
+          ]
+      FailedToParsePGPassConfig bs ->
+        "Failed to parse config from " <> show bs
+
+-- renderPGPassError :: PGPassError -> Text
+-- renderPGPassError pge =
+--   case pge of
+--     EnvVarableNotSet str ->
+--       mconcat ["Environment variable '", Text.pack str, " not set."]
+--     UserFailed err ->
+--       mconcat
+--         [ "readPGPassFile: User in pgpass file was specified as '*' but "
+--         , "getEffectiveUserName failed with "
+--         , textShow err
+--         ]
+--     FailedToReadPGPassFile fpath err ->
+--       mconcat
+--         [ "Not able to read PGPassFile at "
+--         , textShow fpath
+--         , "."
+--         , "Failed with "
+--         , textShow err
+--         ]
+--     FailedToParsePGPassConfig bs ->
+--       "Failed to parse config from " <> textShow bs

cardano-db/src/Cardano/Db/Query.hs

@@ -103,7 +103,6 @@ module Cardano.Db.Query (
   isJust,
   listToMaybe,
   maybeToEither,
-  renderLookupFail,
   unBlockId,
   unTxId,
   unTxInId,