Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Jump to bottom

Debug help for failed Plutus scripts #2430

Merged
merged 2 commits into from
Aug 24, 2021
Merged

Debug help for failed Plutus scripts #2430

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
2 commits
Select commit Hold shift + click to select a range
b9e0555
Debug help for failed plutus scripts
Aug 20, 2021
baef2ff
separate plutus debug info in predicate failure
Aug 23, 2021
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
4 changes: 3 additions & 1 deletion alonzo/impl/cardano-ledger-alonzo.cabal
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -54,6 +54,7 @@ library
build-depends:
array,
base-deriving-via,
base64-bytestring,
bytestring,
cardano-binary,
cardano-crypto-class,
Expand All @@ -77,6 +78,7 @@ library
strict-containers,
text,
time,
transformers
transformers,
utf8-string,
hs-source-dirs:
src
12 changes: 10 additions & 2 deletions alonzo/impl/src/Cardano/Ledger/Alonzo/PlutusScriptApi.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -35,7 +35,14 @@ import Cardano.Ledger.Alonzo.Tx
txdats',
)
import qualified Cardano.Ledger.Alonzo.TxBody as Alonzo (TxBody (..), TxOut (..), vldt')
import Cardano.Ledger.Alonzo.TxInfo (ScriptResult (..), andResult, runPLCScript, txInfo, valContext)
import Cardano.Ledger.Alonzo.TxInfo
( FailureDescription (..),
ScriptResult (..),
andResult,
runPLCScript,
txInfo,
valContext,
)
import Cardano.Ledger.Alonzo.TxWitness (TxWitness (txwitsVKey'), txscripts', unTxDats)
import Cardano.Ledger.BaseTypes (StrictMaybe (..))
import qualified Cardano.Ledger.Core as Core
Expand All @@ -56,6 +63,7 @@ import Data.Proxy (Proxy (..))
import Data.Sequence.Strict (StrictSeq)
import Data.Set (Set)
import qualified Data.Set as Set
import Data.Text (pack)
import GHC.Generics
import GHC.Records (HasField (..))
import NoThunks.Class (NoThunks)
Expand Down Expand Up @@ -225,7 +233,7 @@ evalScripts tx ((AlonzoScript.TimelockScript timelock, _, _, _) : rest) =
where
vhks = Set.map witKeyHash (txwitsVKey' (getField @"wits" tx))
lift True = Passes
lift False = Fails ["Timelock: " ++ show timelock ++ " fails."]
lift False = Fails [OnePhaseFailure . pack . show $ timelock]
evalScripts tx ((AlonzoScript.PlutusScript pscript, ds, units, cost) : rest) =
runPLCScript (Proxy @era) cost pscript units (map getPlutusData ds) `andResult` evalScripts tx rest

Expand Down
35 changes: 28 additions & 7 deletions alonzo/impl/src/Cardano/Ledger/Alonzo/Rules/Utxos.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,4 +1,5 @@
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleContexts #-}
Expand All @@ -15,6 +16,7 @@ module Cardano.Ledger.Alonzo.Rules.Utxos
UtxosPredicateFailure (..),
constructValidated,
lbl2Phase,
TagMismatchDescription (..),
)
where

Expand All @@ -34,7 +36,7 @@ import Cardano.Ledger.Alonzo.Tx
txouts,
)
import qualified Cardano.Ledger.Alonzo.TxBody as Alonzo
import Cardano.Ledger.Alonzo.TxInfo (ScriptResult (..))
import Cardano.Ledger.Alonzo.TxInfo (FailureDescription (..), ScriptResult (..))
import qualified Cardano.Ledger.Alonzo.TxWitness as Alonzo
import Cardano.Ledger.BaseTypes
( Globals,
Expand All @@ -59,7 +61,6 @@ import Data.Foldable (toList)
import qualified Data.Map.Strict as Map
import Data.Sequence.Strict (StrictSeq)
import Data.Set (Set)
import Data.Text
import GHC.Generics (Generic)
import GHC.Records (HasField (..))
import NoThunks.Class (NoThunks)
Expand Down Expand Up @@ -183,7 +184,11 @@ scriptsValidateTransition = do
case collectTwoPhaseScriptInputs ei sysSt pp tx utxo of
Right sLst ->
case evalScripts @era tx sLst of
Fails sss -> False ?!## ValidationTagMismatch (getField @"isValidating" tx) (pack (Prelude.unlines sss))
Fails sss ->
False
?!## ValidationTagMismatch
(getField @"isValidating" tx)
(FailedUnexpectedly sss)
Passes -> pure ()
Left info -> failBecause (CollectErrors info)
pup' <-
Expand Down Expand Up @@ -228,7 +233,7 @@ scriptsNotValidateTransition = do
case collectTwoPhaseScriptInputs ei sysSt pp tx utxo of
Right sLst ->
case (evalScripts @era tx sLst) of
Passes -> False ?!## ValidationTagMismatch (getField @"isValidating" tx) (pack ("Script expected to fail, passes."))
Passes -> False ?!## ValidationTagMismatch (getField @"isValidating" tx) PassedUnexpectedly
Fails _sss -> pure ()
Left info -> failBecause (CollectErrors info)
pure $
Expand All @@ -237,11 +242,27 @@ scriptsNotValidateTransition = do
_fees = fees <> Val.coin (balance @era (eval (getField @"collateral" txb ◁ utxo)))
}

data TagMismatchDescription
= PassedUnexpectedly
| FailedUnexpectedly [FailureDescription]
deriving (Show, Eq, Generic, NoThunks)
Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Deriving NoThunks here is a bit weird, since it's not obvious that we will have no thunks. Are we forcing the descriptions during construction?


instance ToCBOR TagMismatchDescription where
toCBOR PassedUnexpectedly = encode (Sum PassedUnexpectedly 0)
toCBOR (FailedUnexpectedly fs) = encode (Sum FailedUnexpectedly 1 !> To fs)

instance FromCBOR TagMismatchDescription where
fromCBOR = decode (Summands "TagMismatchDescription" dec)
where
dec 0 = SumD PassedUnexpectedly
dec 1 = SumD FailedUnexpectedly <! From
dec n = Invalid n

data UtxosPredicateFailure era
= -- | The 'isValid' tag on the transaction is incorrect. The tag given
-- here is that provided on the transaction (whereas evaluation of the
-- scripts gives the opposite.). The Text tries to explain why it failed.
ValidationTagMismatch IsValid Text
ValidationTagMismatch IsValid TagMismatchDescription
| -- | We could not find all the necessary inputs for a Plutus Script.
-- Previous PredicateFailure tests should make this impossible, but the
-- consequences of not detecting this means scripts get dropped, so things
Expand All @@ -258,7 +279,7 @@ instance
) =>
ToCBOR (UtxosPredicateFailure era)
where
toCBOR (ValidationTagMismatch v txt) = encode (Sum ValidationTagMismatch 0 !> To v !> To txt)
toCBOR (ValidationTagMismatch v descr) = encode (Sum ValidationTagMismatch 0 !> To v !> To descr)
toCBOR (CollectErrors cs) =
encode (Sum (CollectErrors @era) 1 !> To cs)
toCBOR (UpdateFailure pf) = encode (Sum (UpdateFailure @era) 2 !> To pf)
Expand Down Expand Up @@ -288,7 +309,7 @@ instance
) =>
Eq (UtxosPredicateFailure era)
where
(ValidationTagMismatch a _) == (ValidationTagMismatch b _) = a == b -- Do not compare the Text in an Eq check.
(ValidationTagMismatch a x) == (ValidationTagMismatch b y) = a == b && x == y
(CollectErrors x) == (CollectErrors y) = x == y
(UpdateFailure x) == (UpdateFailure y) = x == y
_ == _ = False
Expand Down
Loading