Skip to content

Commit 9680b0b

Browse files
CmdvCmdv
committed
fix review comments for removing panic from codebase
1 parent 57d85bf commit 9680b0b

File tree

11 files changed

+60
-79
lines changed

11 files changed

+60
-79
lines changed

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

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -63,7 +63,7 @@ main = do
6363
httpGetPoolOfflineData manager request poolUrl mHash
6464
case eres of
6565
Left err -> do
66-
putStrLn $ show err
66+
print err
6767
pure $ classifyFetchError accum err
6868
Right _ ->
6969
pure accum

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

Lines changed: 0 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -42,7 +42,6 @@ import qualified Data.Set as Set
4242
import qualified Data.Strict.Maybe as Strict
4343
import Database.Persist.SqlBackend.Internal
4444
import Database.Persist.SqlBackend.Internal.StatementCache
45-
import GHC.Err (error)
4645
import Ouroboros.Consensus.Cardano.Block (HardForkBlock (..))
4746
import qualified Ouroboros.Consensus.HardFork.Combinator as Consensus
4847
import Ouroboros.Network.Block (blockHash, blockNo, getHeaderFields, headerFieldBlockNo, unBlockNo)

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

Lines changed: 0 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -28,7 +28,6 @@ import Control.Monad.Trans.Control (MonadBaseControl)
2828
import Database.Esqueleto.Experimental (SqlBackend, replace)
2929
import Ouroboros.Consensus.Byron.Ledger (ByronBlock (..))
3030
import Ouroboros.Consensus.Cardano.Block (HardForkBlock (..))
31-
import GHC.Err (error)
3231

3332
-- Populating the Epoch table has two mode:
3433
-- * SyncLagging: when the node is far behind the chain tip and is just updating the DB. In this

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

Lines changed: 5 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -104,7 +104,7 @@ insertValidateGenesisDist syncEnv (NetworkName networkName) cfg = do
104104
, DB.blockOpCert = Nothing
105105
, DB.blockOpCertCounter = Nothing
106106
}
107-
lift $ mapM_ (insertTxOuts hasConsumed bid) $ genesisTxos cfg
107+
mapM_ (insertTxOuts hasConsumed bid) $ genesisTxos cfg
108108
liftIO . logInfo tracer $
109109
"Initial genesis distribution populated. Hash "
110110
<> renderByteArray (configGenesisHash cfg)
@@ -176,15 +176,15 @@ insertTxOuts ::
176176
Bool ->
177177
DB.BlockId ->
178178
(Byron.Address, Byron.Lovelace) ->
179-
ReaderT SqlBackend m (Either SyncNodeError ())
179+
ExceptT SyncNodeError (ReaderT SqlBackend m) ()
180180
insertTxOuts hasConsumed blkId (address, value) = do
181181
case txHashOfAddress address of
182-
Left err -> pure $ Left err
182+
Left err -> throwError err
183183
Right val -> do
184184
-- Each address/value pair of the initial coin distribution comes from an artifical transaction
185185
-- with a hash generated by hashing the address.
186186
txId <-
187-
DB.insertTx $
187+
lift $ DB.insertTx $
188188
DB.Tx
189189
{ DB.txHash = Byron.unTxHash val
190190
, DB.txBlockId = blkId
@@ -198,7 +198,7 @@ insertTxOuts hasConsumed blkId (address, value) = do
198198
, DB.txValidContract = True
199199
, DB.txScriptSize = 0
200200
}
201-
void $
201+
lift $ void $
202202
DB.insertTxOutPlex hasConsumed $
203203
DB.TxOut
204204
{ DB.txOutTxId = txId
@@ -213,7 +213,6 @@ insertTxOuts hasConsumed blkId (address, value) = do
213213
, DB.txOutInlineDatumId = Nothing
214214
, DB.txOutReferenceScriptId = Nothing
215215
}
216-
pure $ Right ()
217216

218217
-- -----------------------------------------------------------------------------
219218

‎cardano-db-sync/src/Cardano/DbSync/Era/Shelley/Offline/Http.hs

Lines changed: 5 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -1,7 +1,7 @@
11
{-# LANGUAGE DeriveGeneric #-}
2+
{-# LANGUAGE LambdaCase #-}
23
{-# LANGUAGE OverloadedStrings #-}
34
{-# LANGUAGE NoImplicitPrelude #-}
4-
{-# LANGUAGE LambdaCase #-}
55

66
module Cardano.DbSync.Era.Shelley.Offline.Http (
77
FetchError (..),
@@ -18,7 +18,7 @@ import Cardano.DbSync.Era.Shelley.Offline.Types (
1818
PoolTicker (..),
1919
)
2020
import Cardano.DbSync.Util (renderByteArray)
21-
import Cardano.Prelude
21+
import Cardano.Prelude hiding (show)
2222
import Control.Monad.Extra (whenJust)
2323
import Control.Monad.Trans.Except.Extra (handleExceptT, hoistEither, left)
2424
import qualified Data.Aeson as Aeson
@@ -28,10 +28,10 @@ import qualified Data.CaseInsensitive as CI
2828
import qualified Data.List as List
2929
import qualified Data.Text as Text
3030
import qualified Data.Text.Encoding as Text
31+
import GHC.Show (show)
3132
import Network.HTTP.Client (HttpException (..))
3233
import qualified Network.HTTP.Client as Http
3334
import qualified Network.HTTP.Types as Http
34-
import qualified GHC.Show as GHCS
3535

3636
-- | Fetch error for the HTTP client fetching the pool offline metadata.
3737
data FetchError
@@ -210,7 +210,7 @@ convertHttpException url he =
210210
Http.ConnectionFailure {} -> FEConnectionFailure url
211211
Http.TooManyRedirects {} -> FEHttpException url "Too many redirects"
212212
Http.OverlongHeaders -> FEHttpException url "Overlong headers"
213-
Http.StatusCodeException resp _ -> FEHttpException url ("Status code exception " <> show (Http.responseStatus resp))
213+
Http.StatusCodeException resp _ -> FEHttpException url ("Status code exception " <> Text.pack (show $ Http.responseStatus resp))
214214
Http.InvalidStatusLine {} -> FEHttpException url "Invalid status line"
215-
other -> FEHttpException url (Text.take 100 $ show other)
215+
other -> FEHttpException url (Text.take 100 $ Text.pack $ show other)
216216
InvalidUrlException urlx err -> FEUrlParseFail (PoolUrl $ Text.pack urlx) (Text.pack err)

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

Lines changed: 19 additions & 14 deletions
Original file line numberDiff line numberDiff line change
@@ -6,13 +6,14 @@
66
module Cardano.DbSync.Error (
77
SyncInvariant (..),
88
SyncNodeError (..),
9-
NodeConfigError(..),
9+
NodeConfigError (..),
1010
annotateInvariantTx,
1111
bsBase16Encode,
1212
dbSyncNodeError,
1313
dbSyncInvariant,
1414
renderSyncInvariant,
1515
runOrThrowIO,
16+
fromEitherSTM,
1617
logAndThrowIO,
1718
shouldAbortOnPanic,
1819
hasAbortOnPanicEnv,
@@ -31,10 +32,9 @@ import Data.String (String)
3132
import qualified Data.Text as Text
3233
import qualified Data.Text.Encoding as Text
3334
import GHC.IO.Exception (userError)
34-
import qualified GHC.Show as GShow
3535
import System.Environment (lookupEnv)
3636
import System.Posix.Process (exitImmediately)
37-
import qualified Text.Show as Text
37+
import qualified Text.Show as Show
3838

3939
data SyncInvariant
4040
= EInvInOut !Word64 !Word64
@@ -53,23 +53,24 @@ data SyncNodeError
5353
| SNErrLedgerState !String
5454
| SNErrNodeConfig NodeConfigError
5555
| SNErrLocalStateQuery !String
56+
| SNErrByronGenesis !String
5657

5758
instance Exception SyncNodeError
5859

5960
instance Show SyncNodeError where
6061
show =
6162
\case
62-
SNErrDefault t -> "Error SNErrDefault: " <> Text.show t
63-
SNErrInvariant loc i -> "Error SNErrInvariant: " <> Text.show loc <> ": " <> Text.show (renderSyncInvariant i)
63+
SNErrDefault t -> "Error SNErrDefault: " <> show t
64+
SNErrInvariant loc i -> "Error SNErrInvariant: " <> Show.show loc <> ": " <> show (renderSyncInvariant i)
6465
SNEErrBlockMismatch blkNo hashDb hashBlk ->
6566
mconcat
6667
[ "Error SNEErrBlockMismatch: "
6768
, "Block mismatch for block number "
6869
, show blkNo
6970
, ", db has "
70-
, Text.show $ bsBase16Encode hashDb
71+
, show $ bsBase16Encode hashDb
7172
, " but chain provided "
72-
, Text.show $ bsBase16Encode hashBlk
73+
, show $ bsBase16Encode hashBlk
7374
]
7475
SNErrIgnoreShelleyInitiation ->
7576
mconcat
@@ -81,23 +82,23 @@ instance Show SyncNodeError where
8182
mconcat
8283
[ "Error SNErrByronConfig: "
8384
, "Failed reading Byron genesis file "
84-
, Text.show $ textShow fp
85+
, show fp
8586
, ": "
86-
, Text.show $ textShow ce
87+
, show ce
8788
]
8889
SNErrShelleyConfig fp txt ->
8990
mconcat
9091
[ "Error SNErrShelleyConfig: "
9192
, "Failed reading Shelley genesis file "
92-
, Text.show $ textShow fp
93+
, show fp
9394
, ": "
9495
, show txt
9596
]
9697
SNErrAlonzoConfig fp txt ->
9798
mconcat
98-
["Error SNErrAlonzoConfig: "
99+
[ "Error SNErrAlonzoConfig: "
99100
, "Failed reading Alonzo genesis file "
100-
, Text.show $ textShow fp
101+
, show fp
101102
, ": "
102103
, show txt
103104
]
@@ -112,6 +113,7 @@ instance Show SyncNodeError where
112113
SNErrLedgerState err -> "Error SNErrLedgerState: " <> err
113114
SNErrNodeConfig err -> "Error SNErrNodeConfig: " <> show err
114115
SNErrLocalStateQuery err -> "Error SNErrLocalStateQuery: " <> show err
116+
SNErrByronGenesis err -> "Error SNErrByronGenesis:" <> show err
115117

116118
data NodeConfigError
117119
= NodeConfigParseError !String
@@ -156,13 +158,16 @@ renderSyncInvariant ei =
156158
, textShow tx
157159
]
158160

161+
fromEitherSTM :: (Exception e) => Either e a -> STM a
162+
fromEitherSTM = either throwSTM return
163+
159164
bsBase16Encode :: ByteString -> Text
160165
bsBase16Encode bs =
161166
case Text.decodeUtf8' (Base16.encode bs) of
162-
Left _ -> Text.pack $ "UTF-8 decode failed for " ++ Text.show bs
167+
Left _ -> Text.pack $ "UTF-8 decode failed for " ++ Show.show bs
163168
Right txt -> txt
164169

165-
runOrThrowIO :: forall e a. Exception e => IO (Either e a) -> IO a
170+
runOrThrowIO :: forall e a m. (MonadIO m) => Exception e => m (Either e a) -> m a
166171
runOrThrowIO ioEither = do
167172
et <- ioEither
168173
case et of

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

Lines changed: 17 additions & 31 deletions
Original file line numberDiff line numberDiff line change
@@ -65,7 +65,7 @@ import qualified Control.Exception as Exception
6565
import qualified Data.ByteString.Base16 as Base16
6666

6767
import Cardano.DbSync.Api.Types (LedgerEnv (..), SyncOptions (..))
68-
import Cardano.DbSync.Error (SyncNodeError (..))
68+
import Cardano.DbSync.Error (SyncNodeError (..), fromEitherSTM)
6969
import qualified Data.ByteString.Char8 as BS
7070
import qualified Data.ByteString.Lazy.Char8 as LBS
7171
import qualified Data.ByteString.Short as SBS
@@ -119,7 +119,6 @@ import System.Directory (doesFileExist, listDirectory, removeFile)
119119
import System.FilePath (dropExtension, takeExtension, (</>))
120120
import System.Mem (performMajorGC)
121121
import Prelude (String, id)
122-
import GHC.Err (error)
123122

124123
-- Note: The decision on whether a ledger-state is written to disk is based on the block number
125124
-- rather than the slot number because while the block number is fully populated (for every block
@@ -211,39 +210,26 @@ applyBlock env blk = do
211210
atomically $ do
212211
!ledgerDB <- readStateUnsafe env
213212
let oldState = ledgerDbCurrent ledgerDB
214-
!result <- applyBlk (ExtLedgerCfg (getTopLevelconfigHasLedger env)) blk (clsState oldState)
213+
!result <- fromEitherSTM $ tickThenReapplyCheckHash (ExtLedgerCfg (getTopLevelconfigHasLedger env)) blk (clsState oldState)
215214
let !ledgerEvents = mapMaybe convertAuxLedgerEvent (lrEvents result)
216215
let !newLedgerState = lrResult result
217216
!details <- getSlotDetails env (ledgerState newLedgerState) time (cardanoBlockSlotNo blk)
218-
let !newEpochE = mkNewEpoch (clsState oldState) newLedgerState (findAdaPots ledgerEvents)
219-
case newEpochE of
220-
Left err -> throwSTM err
221-
Right newEpoch -> do
222-
let !newEpochBlockNo = applyToEpochBlockNo (isJust $ blockIsEBB blk) (isJust newEpoch) (clsEpochBlockNo oldState)
223-
let !newState = CardanoLedgerState newLedgerState newEpochBlockNo
224-
let !ledgerDB' = pushLedgerDB ledgerDB newState
225-
writeTVar (leStateVar env) (Strict.Just ledgerDB')
226-
let !appResult =
227-
ApplyResult
228-
{ apPrices = getPrices newState
229-
, apPoolsRegistered = getRegisteredPools oldState
230-
, apNewEpoch = maybeToStrict newEpoch
231-
, apSlotDetails = details
232-
, apStakeSlice = stakeSlice newState details
233-
, apEvents = ledgerEvents
234-
}
235-
pure (oldState, appResult)
217+
!newEpoch <- fromEitherSTM $ mkNewEpoch (clsState oldState) newLedgerState (findAdaPots ledgerEvents)
218+
let !newEpochBlockNo = applyToEpochBlockNo (isJust $ blockIsEBB blk) (isJust newEpoch) (clsEpochBlockNo oldState)
219+
let !newState = CardanoLedgerState newLedgerState newEpochBlockNo
220+
let !ledgerDB' = pushLedgerDB ledgerDB newState
221+
writeTVar (leStateVar env) (Strict.Just ledgerDB')
222+
let !appResult =
223+
ApplyResult
224+
{ apPrices = getPrices newState
225+
, apPoolsRegistered = getRegisteredPools oldState
226+
, apNewEpoch = maybeToStrict newEpoch
227+
, apSlotDetails = details
228+
, apStakeSlice = stakeSlice newState details
229+
, apEvents = ledgerEvents
230+
}
231+
pure (oldState, appResult)
236232
where
237-
applyBlk ::
238-
ExtLedgerCfg CardanoBlock ->
239-
CardanoBlock ->
240-
ExtLedgerState CardanoBlock ->
241-
STM (LedgerResult (ExtLedgerState CardanoBlock) (ExtLedgerState CardanoBlock))
242-
applyBlk cfg block lsb =
243-
case tickThenReapplyCheckHash cfg block lsb of
244-
Left err -> throwSTM err
245-
Right result -> pure result
246-
247233
mkNewEpoch :: ExtLedgerState CardanoBlock -> ExtLedgerState CardanoBlock -> Maybe AdaPots -> Either SyncNodeError (Maybe Generic.NewEpoch)
248234
mkNewEpoch oldState newState mPots = do
249235
let currEpochE = ledgerEpochNo env newState

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

Lines changed: 1 addition & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -50,7 +50,6 @@ import Data.Functor.Contravariant (contramap)
5050
import qualified Data.List as List
5151
import qualified Data.Text as Text
5252
import Database.Persist.Postgresql (SqlBackend)
53-
import GHC.Base (error)
5453
import Network.Mux (MuxTrace, WithMuxBearer)
5554
import Network.Mux.Types (MuxMode (..))
5655
import Network.TypedProtocol.Pipelined (N (..), Nat (Succ, Zero))
@@ -241,7 +240,7 @@ dbSyncProtocols syncEnv metricsSetters tc codecConfig version bversion _connecti
241240
( Client.chainSyncClientPeer $
242241
chainSyncClientFixScripts backend tracer ls
243242
)
244-
when onlyFix $ error "All Good! This error is only thrown to exit db-sync"
243+
when onlyFix $ panic "All Good! This error is only thrown to exit db-sync"
245244
setIsFixed syncEnv AllFixRan
246245
pure False
247246
else do

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

Lines changed: 9 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -6,15 +6,18 @@
66
module Cardano.Db.Error (
77
LookupFail (..),
88
runOrThrowIODb,
9+
logAndThrowIO,
910
) where
1011

11-
import Control.Exception (Exception, throwIO)
12+
import Control.Exception (Exception)
1213
import qualified Data.ByteString.Base16 as Base16
1314
import Data.ByteString.Char8 (ByteString)
1415
import qualified Data.Text.Encoding as Text
1516
import Data.Word (Word16, Word64)
1617
import GHC.Generics (Generic)
1718
import Data.Text (Text)
19+
import Cardano.BM.Trace (Trace, logError)
20+
import Cardano.Prelude (throwIO)
1821

1922
data LookupFail
2023
= DbLookupBlockHash !ByteString
@@ -55,3 +58,8 @@ runOrThrowIODb ioEither = do
5558
case et of
5659
Left err -> throwIO err
5760
Right a -> pure a
61+
62+
logAndThrowIO :: Trace IO Text -> Text -> IO ()
63+
logAndThrowIO tracer msg = do
64+
logError tracer msg
65+
throwIO $ userError $ show msg

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

Lines changed: 3 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -11,7 +11,8 @@ module Cardano.Db.Multiplex (
1111
ExtraCons.deleteConsumedTxOut,
1212
) where
1313

14-
import Cardano.BM.Trace (Trace, logError, logInfo)
14+
import Cardano.BM.Trace (Trace, logInfo)
15+
import Cardano.Db.Error (logAndThrowIO)
1516
import Cardano.Db.Insert
1617
import qualified Cardano.Db.Migration.Extra.CosnumedTxOut.Queries as ExtraCons
1718
import qualified Cardano.Db.Migration.Extra.CosnumedTxOut.Schema as ExtraCons
@@ -22,7 +23,6 @@ import Control.Monad.Trans.Reader (ReaderT)
2223
import Data.Text (Text)
2324
import Data.Word (Word64)
2425
import Database.Persist.Sql (SqlBackend, ToBackendKey (..))
25-
import Control.Exception (throwIO)
2626

2727
insertTxOutPlex ::
2828
(MonadBaseControl IO m, MonadIO m) =>
@@ -83,9 +83,7 @@ runExtraMigrations trce blockNoDiff consumed pruned = do
8383
liftIO $ logInfo trce "No extra migration specified"
8484
(True, True, False) -> do
8585
liftIO $ logInfo trce "Extra migration consumed_tx_out already executed"
86-
(True, False, False) -> do
87-
liftIO $ logError trce migratedButNotSet
88-
liftIO $ throwIO $ userError (show migratedButNotSet)
86+
(True, False, False) -> liftIO $ logAndThrowIO trce migratedButNotSet
8987
(False, True, False) -> do
9088
liftIO $ logInfo trce "Running extra migration consumed_tx_out"
9189
ExtraCons.migrateTxOut $ Just trce

0 commit comments

Comments
 (0)