Fixme estimateScriptsCost

- Do not throw from a pure function - Introduce new constructor ErrTranslationError - Remove BadTranslationException - remove the FIXME
input-output-hk · Sep 25, 2022 · 42a2d81 · 42a2d81
1 parent 57f6d76
commit 42a2d81
Show file tree

Hide file tree

Showing 2 changed files with 6 additions and 14 deletions.
diff --git a/hydra-node/src/Hydra/Chain/Direct/Wallet.hs b/hydra-node/src/Hydra/Chain/Direct/Wallet.hs
@@ -32,7 +32,6 @@ import Cardano.Ledger.Val (Val (..), invert)
 import Cardano.Slotting.EpochInfo (EpochInfo)
 import Cardano.Slotting.Time (SystemStart (..))
 import Control.Arrow (left)
-import Control.Exception (throw)
 import Control.Monad.Class.MonadSTM (
   check,
   newTVarIO,
@@ -197,6 +196,7 @@ data ErrCoverFee
   | ErrUnknownInput {input :: TxIn}
   | ErrNoPaymentUTxOFound
   | ErrScriptExecutionFailed (RdmrPtr, TransactionScriptFailure StandardCrypto)
+  | ErrTranslationError (TranslationError StandardCrypto)
   deriving (Show)
 
 data ChangeError = ChangeError {inputBalance :: Coin, outputBalance :: Coin}
@@ -222,8 +222,7 @@ coverFee_ pparams systemStart epochInfo lookupUTxO walletUTxO partialTx@Validate
   resolvedInputs <- traverse resolveInput (toList inputs')
 
   estimatedScriptCosts <-
-    left ErrScriptExecutionFailed $
-      estimateScriptsCost pparams systemStart epochInfo (lookupUTxO <> walletUTxO) partialTx
+    estimateScriptsCost pparams systemStart epochInfo (lookupUTxO <> walletUTxO) partialTx
   let adjustedRedeemers =
         adjustRedeemers
           (inputs body)
@@ -361,15 +360,13 @@ estimateScriptsCost ::
   Map TxIn TxOut ->
   -- | The pre-constructed transaction
   ValidatedTx LedgerEra ->
-  Either (RdmrPtr, TransactionScriptFailure StandardCrypto) (Map RdmrPtr ExUnits)
+  Either ErrCoverFee (Map RdmrPtr ExUnits)
 estimateScriptsCost pparams systemStart epochInfo utxo tx = do
-  -- FIXME: throwing exceptions in pure code is discouraged! Convert them to
-  -- throwM or throwIO or represent thes situations in the return type!
   case result of
     Left translationError ->
-      throw $ BadTranslationException translationError
+      Left $ ErrTranslationError translationError
     Right units ->
-      Map.traverseWithKey (\ptr -> left (ptr,)) units
+      Map.traverseWithKey (\ptr -> left $ ErrScriptExecutionFailed . (ptr,)) units
  where
   result =
     evaluateTransactionExecutionUnits
@@ -385,12 +382,6 @@ estimateScriptsCost pparams systemStart epochInfo utxo tx = do
       (fst (Map.findMin m), fst (Map.findMax m))
       (Map.toList m)
 
-newtype BadTranslationException
-  = BadTranslationException (TranslationError StandardCrypto)
-  deriving (Show)
-
-instance Exception BadTranslationException
-
 --
 -- Logs
 --

diff --git a/hydra-node/test/Hydra/Chain/Direct/TxSpec.hs b/hydra-node/test/Hydra/Chain/Direct/TxSpec.hs
@@ -179,6 +179,7 @@ spec =
                                           ErrNotEnoughFunds{} -> "Not enough funds"
                                           ErrUnknownInput{} -> "Unknown input"
                                           ErrScriptExecutionFailed{} -> "Script(s) execution failed"
+                                          ErrTranslationError{} -> "Transaction context translation error"
                                       )
                                 Right (_, fromLedgerTx -> txAbortWithFees) ->
                                   let actualExecutionCost = totalExecutionCost ledgerPParams txAbortWithFees