removal of panic and replacing with Exceptions

Author: Cmdv

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

@@ -30,13 +30,9 @@ import Cardano.DbSync.Config.Cardano
 import Cardano.DbSync.Config.Node
 import Cardano.DbSync.Config.Shelley
 import Cardano.DbSync.Config.Types
-import Cardano.DbSync.Util
+import Cardano.DbSync.Error (runOrThrowIO)
 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, (</>))
-import Cardano.DbSync.Error (runOrThrowIO)
 
 configureLogging :: SyncNodeParams -> Text -> IO (Trace IO Text)
 configureLogging params loggingName = do
@@ -49,16 +45,11 @@ configureLogging params loggingName = do
 
 readSyncNodeConfig :: ConfigFile -> IO SyncNodeConfig
 readSyncNodeConfig (ConfigFile fp) = do
-  pcfg <- adjustNodeFilePath . parseSyncPreConfig <$> readByteString fp "DbSync"
-  ncfg <- runOrThrowIO . parseNodeConfig =<< readByteString (pcNodeConfigFilePath pcfg) "node"
-  coalesceConfig pcfg ncfg (mkAdjustPath pcfg)
+  pcfg <- runOrThrowIO . parseSyncPreConfig =<< runOrThrowIO (readByteStringFromFile fp "DbSync")
+  let afp = adjustNodeFilePath pcfg
+  ncfg <- runOrThrowIO . parseNodeConfig =<< runOrThrowIO (readByteStringFromFile (pcNodeConfigFilePath afp) "node")
+  coalesceConfig afp 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)}
@@ -98,8 +89,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/Node.hs

@@ -8,6 +8,8 @@
 module Cardano.DbSync.Config.Node (
   NodeConfig (..),
   parseNodeConfig,
+  parseSyncPreConfig,
+  readByteStringFromFile,
 ) where
 
 -- Node really should export something like this, but doesn't and it actually seemed to
@@ -20,9 +22,10 @@ import Cardano.Prelude
 import Data.Aeson (FromJSON (..), Object, (.:), (.:?))
 import qualified Data.Aeson as Aeson
 import Data.Aeson.Types (Parser)
+import qualified Data.ByteString.Char8 as BS
+import Data.String (String)
 import qualified Data.Yaml as Yaml
 import qualified Ouroboros.Consensus.Cardano.CanHardFork as Shelley
-import Data.String (String)
 
 data NodeConfig = NodeConfig
   { ncProtocol :: !SyncProtocol
@@ -49,8 +52,10 @@ data NodeConfig = NodeConfig
     ncConwayHardFork :: !Shelley.TriggerHardFork
   }
 
-newtype NodeConfigParseError =
-  NodeConfigParseError String
+data NodeConfigParseError
+  = NodeConfigParseError String
+  | ParseSyncPreConfigError String
+  | ReadByteStringFromFileError String
   deriving (Show)
 
 instance Exception NodeConfigParseError
@@ -61,6 +66,19 @@ parseNodeConfig bs =
     Left err -> pure $ Left $ NodeConfigParseError ("Error parsing node config: " <> show err)
     Right nc -> pure $ Right nc
 
+parseSyncPreConfig :: ByteString -> IO (Either NodeConfigParseError SyncPreConfig)
+parseSyncPreConfig bs =
+  case Yaml.decodeEither' bs of
+    Left err -> pure $ Left $ ParseSyncPreConfigError ("Error parseSyncPreConfig: Error parsing config: " <> show err)
+    Right res -> pure $ Right res
+
+readByteStringFromFile :: FilePath -> Text -> IO (Either NodeConfigParseError ByteString)
+readByteStringFromFile fp cfgType = do
+  result <- try (BS.readFile fp) :: IO (Either SomeException BS.ByteString)
+  case result of
+    Left _ -> pure $ Left $ ReadByteStringFromFileError ("Error Cannot find the " <> show cfgType <> " configuration file at : " <> show fp)
+    Right res -> pure $ Right res
+
 -- -------------------------------------------------------------------------------------------------
 
 instance FromJSON NodeConfig where
@@ -70,15 +88,15 @@ instance FromJSON NodeConfig where
       parse :: Object -> Parser NodeConfig
       parse o =
         NodeConfig
-          <$> o .: "Protocol"
-          <*> o .:? "PBftSignatureThreshold"
+          <$> (o .: "Protocol")
+          <*> (o .:? "PBftSignatureThreshold")
           <*> fmap GenesisFile (o .: "ByronGenesisFile")
           <*> fmap GenesisHashByron (o .: "ByronGenesisHash")
           <*> fmap GenesisFile (o .: "ShelleyGenesisFile")
           <*> fmap GenesisHashShelley (o .: "ShelleyGenesisHash")
           <*> fmap GenesisFile (o .: "AlonzoGenesisFile")
           <*> fmap GenesisHashAlonzo (o .: "AlonzoGenesisHash")
-          <*> o .: "RequiresNetworkMagic"
+          <*> (o .: "RequiresNetworkMagic")
           <*> parseByronProtocolVersion o
           <*> parseShelleyHardForkEpoch o
           <*> parseAllegraHardForkEpoch o
@@ -90,9 +108,9 @@ instance FromJSON NodeConfig where
       parseByronProtocolVersion :: Object -> Parser Byron.ProtocolVersion
       parseByronProtocolVersion o =
         Byron.ProtocolVersion
-          <$> o .: "LastKnownBlockVersion-Major"
-          <*> o .: "LastKnownBlockVersion-Minor"
-          <*> o .: "LastKnownBlockVersion-Alt"
+          <$> (o .: "LastKnownBlockVersion-Major")
+          <*> (o .: "LastKnownBlockVersion-Minor")
+          <*> (o .: "LastKnownBlockVersion-Alt")
 
       parseShelleyHardForkEpoch :: Object -> Parser Shelley.TriggerHardFork
       parseShelleyHardForkEpoch o =

cardano-db-sync/src/Cardano/DbSync/Era/Byron/Genesis.hs

@@ -171,39 +171,49 @@ validateGenesisDistribution prunes tracer networkName cfg bid =
 
 -- -----------------------------------------------------------------------------
 
-insertTxOuts :: (MonadBaseControl IO m, MonadIO m) => Bool -> DB.BlockId -> (Byron.Address, Byron.Lovelace) -> ReaderT SqlBackend m ()
+insertTxOuts ::
+  (MonadBaseControl IO m, MonadIO m) =>
+  Bool ->
+  DB.BlockId ->
+  (Byron.Address, Byron.Lovelace) ->
+  ReaderT SqlBackend m (Either SyncNodeError ())
 insertTxOuts hasConsumed blkId (address, value) = do
-  -- Each address/value pair of the initial coin distribution comes from an artifical transaction
-  -- with a hash generated by hashing the address.
-  txId <-
-    DB.insertTx $
-      DB.Tx
-        { DB.txHash = Byron.unTxHash $ txHashOfAddress address
-        , DB.txBlockId = blkId
-        , DB.txBlockIndex = 0
-        , DB.txOutSum = DB.DbLovelace (Byron.unsafeGetLovelace value)
-        , DB.txFee = DB.DbLovelace 0
-        , DB.txDeposit = 0
-        , DB.txSize = 0 -- Genesis distribution address to not have a size.
-        , DB.txInvalidHereafter = Nothing
-        , DB.txInvalidBefore = Nothing
-        , DB.txValidContract = True
-        , DB.txScriptSize = 0
-        }
-  void . DB.insertTxOutPlex hasConsumed $
-    DB.TxOut
-      { DB.txOutTxId = txId
-      , DB.txOutIndex = 0
-      , DB.txOutAddress = Text.decodeUtf8 $ Byron.addrToBase58 address
-      , DB.txOutAddressRaw = Binary.serialize' address
-      , DB.txOutAddressHasScript = False
-      , DB.txOutPaymentCred = Nothing
-      , DB.txOutStakeAddressId = Nothing
-      , DB.txOutValue = DB.DbLovelace (Byron.unsafeGetLovelace value)
-      , DB.txOutDataHash = Nothing
-      , DB.txOutInlineDatumId = Nothing
-      , DB.txOutReferenceScriptId = Nothing
-      }
+  case txHashOfAddress address of
+    Left err -> pure $ Left err
+    Right val -> do
+      -- Each address/value pair of the initial coin distribution comes from an artifical transaction
+      -- with a hash generated by hashing the address.
+      txId <-
+        DB.insertTx $
+          DB.Tx
+            { DB.txHash = Byron.unTxHash val
+            , DB.txBlockId = blkId
+            , DB.txBlockIndex = 0
+            , DB.txOutSum = DB.DbLovelace (Byron.unsafeGetLovelace value)
+            , DB.txFee = DB.DbLovelace 0
+            , DB.txDeposit = 0
+            , DB.txSize = 0 -- Genesis distribution address to not have a size.
+            , DB.txInvalidHereafter = Nothing
+            , DB.txInvalidBefore = Nothing
+            , DB.txValidContract = True
+            , DB.txScriptSize = 0
+            }
+      void $
+        DB.insertTxOutPlex hasConsumed $
+          DB.TxOut
+            { DB.txOutTxId = txId
+            , DB.txOutIndex = 0
+            , DB.txOutAddress = Text.decodeUtf8 $ Byron.addrToBase58 address
+            , DB.txOutAddressRaw = Binary.serialize' address
+            , DB.txOutAddressHasScript = False
+            , DB.txOutPaymentCred = Nothing
+            , DB.txOutStakeAddressId = Nothing
+            , DB.txOutValue = DB.DbLovelace (Byron.unsafeGetLovelace value)
+            , DB.txOutDataHash = Nothing
+            , DB.txOutInlineDatumId = Nothing
+            , DB.txOutReferenceScriptId = Nothing
+            }
+      pure $ Right ()
 
 -- -----------------------------------------------------------------------------
 
@@ -231,9 +241,13 @@ genesisTxos config =
     nonAvvmBalances =
       Map.toList $ Byron.unGenesisNonAvvmBalances (Byron.configNonAvvmBalances config)
 
-txHashOfAddress :: Byron.Address -> Crypto.Hash Byron.Tx
-txHashOfAddress =
-  fromMaybe (panic "Cardano.DbSync.Era.Byron.Genesis.txHashOfAddress")
-    . Crypto.abstractHashFromBytes
-    . Crypto.abstractHashToBytes
-    . Crypto.serializeCborHash
+txHashOfAddress :: Byron.Address -> Either SyncNodeError (Crypto.Hash Byron.Tx)
+txHashOfAddress ba = do
+  case hashFromBS of
+    Just res -> Right res
+    Nothing -> Left $ SNErrInsertGenesis "Cardano.DbSync.Era.Byron.Genesis.txHashOfAddress"
+  where
+    hashFromBS =
+      Crypto.abstractHashFromBytes
+        . Crypto.abstractHashToBytes
+        $ Crypto.serializeCborHash ba

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

@@ -16,13 +16,13 @@ import Cardano.Db.Insert
 import qualified Cardano.Db.Migration.Extra.CosnumedTxOut.Queries as ExtraCons
 import qualified Cardano.Db.Migration.Extra.CosnumedTxOut.Schema as ExtraCons
 import Cardano.Db.Schema
-import Cardano.Prelude (panic)
 import Control.Monad.IO.Class (MonadIO, liftIO)
 import Control.Monad.Trans.Control (MonadBaseControl)
 import Control.Monad.Trans.Reader (ReaderT)
 import Data.Text (Text)
 import Data.Word (Word64)
 import Database.Persist.Sql (SqlBackend, ToBackendKey (..))
+import Control.Exception (throwIO)
 
 insertTxOutPlex ::
   (MonadBaseControl IO m, MonadIO m) =>
@@ -85,7 +85,7 @@ runExtraMigrations trce blockNoDiff consumed pruned = do
       liftIO $ logInfo trce "Extra migration consumed_tx_out already executed"
     (True, False, False) -> do
       liftIO $ logError trce migratedButNotSet
-      panic migratedButNotSet
+      liftIO $ throwIO $ userError (show migratedButNotSet)
     (False, True, False) -> do
       liftIO $ logInfo trce "Running extra migration consumed_tx_out"
       ExtraCons.migrateTxOut $ Just trce

doc/validation.md

@@ -72,6 +72,8 @@ the fees associated with the transaction are recorded in the database.
 
 ## Runtime Reward Validations
 
+-- TODO: Vince - probably too late unless we deprecate, but could this be a command line argument?
+
 Due to recent issues with reward related tables, extra validation was added. When that validation
 fails, there are now two options. `db-sync` can abort or continue running. The behaviour is
 specified by the presence or absence of the `DbSyncAbortOnPanic` environemnt variable. If the