Skip to content

Commit

Permalink
Expanded documentation for classy errors
Browse files Browse the repository at this point in the history
* Additional documentation describing the use of classy prisms for
  errors

* Added the missing AsExUnitsError (ValidationError era) instance
  • Loading branch information
choener committed Feb 7, 2025
1 parent 2f61ee7 commit c72f538
Show file tree
Hide file tree
Showing 2 changed files with 41 additions and 8 deletions.
25 changes: 24 additions & 1 deletion src/base/lib/Convex/Class.hs
Original file line number Diff line number Diff line change
Expand Up @@ -6,6 +6,7 @@
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
Expand Down Expand Up @@ -118,6 +119,7 @@ import Control.Exception (
throwIO,
)
import Control.Lens (
Prism',
at,
set,
to,
Expand Down Expand Up @@ -202,8 +204,25 @@ instance AsExUnitsError (ValidationError era) era where
Then functions throwing ExUnitsError throw like this:
@
throwError $ L.review _ExUnitsError $ Phase1Error bla
fun :: (MonadError e m, AsExUnitsError e era) => m ()
fun = do
...
throwError $ L.review _ExUnitsError $ Phase1Error bla
@
and we are not forcing a specific error @e@, but only that @e@ can be created via the prism from an @ExUnitsError@.
It is also possible to have multiple types of errors:
@
fun :: (MonadError e m, AsExUnitsError e era, AsValidationError e era, AsSomeOtherError e) => m ()
fun = do
...
throwError $ L.review _ExUnitsError $ Phase1Error bla
...
throwError $ L.review _PredicateFailures $ []
...
throwError $ L.review _OtherError
@
Note that @OtherError@ is "parallel" to @_ExUnitsError@ and not a descendent, i.e. not related.
The whole tree of exceptions can be mapped in this fashion, which increases the interoperability
between error-throwing functions without the need for explicit 'modifyError' calls.
Expand All @@ -229,6 +248,10 @@ instance (C.IsAlonzoBasedEra era) => Show (ValidationError era) where

makeClassyPrisms ''ValidationError

instance AsExUnitsError (ValidationError era) era where
_ExUnitsError :: Prism' (ValidationError era) (ExUnitsError era)
_ExUnitsError = _VExUnits . _ExUnitsError

-- | Send transactions and resolve tx inputs.
class (Monad m) => MonadBlockchain era m | m -> era where
sendTx
Expand Down
24 changes: 17 additions & 7 deletions src/coin-selection/lib/Convex/CoinSelection.hs
Original file line number Diff line number Diff line change
Expand Up @@ -16,6 +16,9 @@
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE ViewPatterns #-}
-- NOTE: We have an orphan instance for ScriptWitnessIndex, until (or if) upstream provides such an
-- instance.
{-# OPTIONS_GHC -Wno-orphans #-}

-- | Building cardano transactions from tx bodies
module Convex.CoinSelection (
Expand Down Expand Up @@ -227,7 +230,10 @@ bodyError = BodyError . Text.pack . C.docToString . C.prettyError

$(deriveFromJSON defaultOptions{sumEncoding = TaggedObject{tagFieldName = "kind", contentsFieldName = "value"}} ''C.ScriptWitnessIndex)

-- | Balancing errors, including the *special* 'BalancingScriptExecutionErr'.
{- | Balancing errors, including the important 'ScriptExecutionErr'. "Important" in the sense that we
can write prisms such as 'exactScriptExecutionError' that allow for more fine-grained
pattern-matching on the on-chain error.
-}
data BalancingError era
= BalancingError Text
| -- | A single type of balancing error is treated specially: the type with
Expand All @@ -243,10 +249,10 @@ data BalancingError era

makeClassyPrisms ''BalancingError

{- | This prism will either match on the exact error using the script witness index and an error
string, or just on being a script execution error. The latter is necessary, since in non-debug
mode, there is no error to match on and the prism should not fail in its purpose in non-debug
mode.
{- | This prism will match on the exact error using the script witness index and an error
string if this information is available. It will behave as a script execution error if no debug logs
are available. The latter is necessary, since in non-debug mode, there is no error to match on and
the prism should not fail in its purpose in non-debug mode.
-}
exactScriptExecutionError :: forall e era. (AsBalancingError e era) => (Int, Text) -> Prism' e [(C.ScriptWitnessIndex, Text, [Text])]
exactScriptExecutionError (i, s) = prism' tobe frombe
Expand All @@ -267,8 +273,12 @@ exactScriptExecutionError (i, s) = prism' tobe frombe
-- Not the correct error
| otherwise -> Nothing

{- | Sort *most* balancing errors into 'BalancingError', but script execution errors into their own
data constructor.
{- | This convenience function takes @Left@s of type 'C.TxBodyErrorAutoBalance' and throws
'C.TxBodyScriptErecutionError's as 'ScriptExecutionErr', with extraaction of the error log, if
availalbe. Other @Left@s are thrown as 'BalancingError's.
This is a convenient bridge from cardano-api errors to errors where we can pattern-match on script
execution errors and have an error hierarchy.
-}
balancingError :: (MonadError (BalancingError era) m) => Either (C.TxBodyErrorAutoBalance era) a -> m a
balancingError = \case
Expand Down

0 comments on commit c72f538

Please sign in to comment.