From c08c8965bacdec5dfd69b4fcf0638dd0d9a5a459 Mon Sep 17 00:00:00 2001 From: Evgenii Akentev Date: Tue, 27 Jul 2021 13:41:41 +0500 Subject: [PATCH] Use traceError instead of error for better error messages (fix #3608). --- .../Plutus/Contract/StateMachine/OnChain.hs | 2 +- .../src/Plutus/V1/Ledger/Contexts.hs | 9 +++--- plutus-tx/plutus-tx.cabal | 1 + plutus-tx/src/PlutusTx/Enum.hs | 21 +++++++------- plutus-tx/src/PlutusTx/IsData/Class.hs | 4 ++- plutus-tx/src/PlutusTx/List.hs | 9 ++++-- plutus-tx/src/PlutusTx/Prelude.hs | 29 +++++-------------- plutus-tx/src/PlutusTx/Ratio.hs | 9 ++++-- plutus-tx/src/PlutusTx/Trace.hs | 25 ++++++++++++++++ plutus-use-cases/src/Plutus/Contracts/Swap.hs | 4 +-- 10 files changed, 66 insertions(+), 47 deletions(-) create mode 100644 plutus-tx/src/PlutusTx/Trace.hs diff --git a/plutus-contract/src/Plutus/Contract/StateMachine/OnChain.hs b/plutus-contract/src/Plutus/Contract/StateMachine/OnChain.hs index 3726abc5e15..3d2301cffd2 100644 --- a/plutus-contract/src/Plutus/Contract/StateMachine/OnChain.hs +++ b/plutus-contract/src/Plutus/Contract/StateMachine/OnChain.hs @@ -111,7 +111,7 @@ machineAddress = validatorAddress . typedValidator -- | Turn a state machine into a validator script. mkValidator :: forall s i. (PlutusTx.IsData s) => StateMachine s i -> ValidatorType (StateMachine s i) mkValidator (StateMachine step isFinal check threadToken) currentState input ptx = - let vl = maybe (error ()) (txOutValue . txInInfoResolved) (findOwnInput ptx) + let vl = maybe (traceError "Can't find validation input") (txOutValue . txInInfoResolved) (findOwnInput ptx) checkOk = traceIfFalse "State transition invalid - checks failed" (check currentState input ptx) && traceIfFalse "Thread token not found" (TT.checkThreadToken threadToken (ownHash ptx) vl 1) diff --git a/plutus-ledger-api/src/Plutus/V1/Ledger/Contexts.hs b/plutus-ledger-api/src/Plutus/V1/Ledger/Contexts.hs index 25888c849e5..fe486c48543 100644 --- a/plutus-ledger-api/src/Plutus/V1/Ledger/Contexts.hs +++ b/plutus-ledger-api/src/Plutus/V1/Ledger/Contexts.hs @@ -57,7 +57,6 @@ module Plutus.V1.Ledger.Contexts import Data.Text.Prettyprint.Doc (Pretty (..), nest, viaShow, vsep, (<+>)) import GHC.Generics (Generic) import PlutusTx -import qualified PlutusTx.Builtins as Builtins import PlutusTx.Prelude import Plutus.V1.Ledger.Ada (Ada) @@ -181,14 +180,14 @@ findContinuingOutputs :: ScriptContext -> [Integer] findContinuingOutputs ctx | Just TxInInfo{txInInfoResolved=TxOut{txOutAddress}} <- findOwnInput ctx = findIndices (f txOutAddress) (txInfoOutputs $ scriptContextTxInfo ctx) where f addr TxOut{txOutAddress=otherAddress} = addr == otherAddress -findContinuingOutputs _ = Builtins.error() +findContinuingOutputs _ = traceError "Can't find any continuing outputs" {-# INLINABLE getContinuingOutputs #-} getContinuingOutputs :: ScriptContext -> [TxOut] getContinuingOutputs ctx | Just TxInInfo{txInInfoResolved=TxOut{txOutAddress}} <- findOwnInput ctx = filter (f txOutAddress) (txInfoOutputs $ scriptContextTxInfo ctx) where f addr TxOut{txOutAddress=otherAddress} = addr == otherAddress -getContinuingOutputs _ = Builtins.error() +getContinuingOutputs _ = traceError "Can't get any continuing outputs" {- Note [Hashes in validator scripts] @@ -235,7 +234,7 @@ pubKeyOutput TxOut{txOutAddress} = toPubKeyHash txOutAddress -- | Get the validator and datum hashes of the output that is curently being validated ownHashes :: ScriptContext -> (ValidatorHash, DatumHash) ownHashes (findOwnInput -> Just TxInInfo{txInInfoResolved=TxOut{txOutAddress=Address (ScriptCredential s) _, txOutDatumHash=Just dh}}) = (s,dh) -ownHashes _ = Builtins.error () +ownHashes _ = traceError "Can't get validator and datum hashes" {-# INLINABLE ownHash #-} -- | Get the hash of the validator script that is currently being validated. @@ -302,7 +301,7 @@ valueProduced = foldMap txOutValue . txInfoOutputs -- | The 'CurrencySymbol' of the current validator script. ownCurrencySymbol :: ScriptContext -> CurrencySymbol ownCurrencySymbol ScriptContext{scriptContextPurpose=Minting cs} = cs -ownCurrencySymbol _ = Builtins.error () +ownCurrencySymbol _ = traceError "Can't get currency symbol of the current validator script" {-# INLINABLE spendsOutput #-} -- | Check if the pending transaction spends a specific transaction output diff --git a/plutus-tx/plutus-tx.cabal b/plutus-tx/plutus-tx.cabal index 225e4775df5..2950ab18906 100644 --- a/plutus-tx/plutus-tx.cabal +++ b/plutus-tx/plutus-tx.cabal @@ -59,6 +59,7 @@ library PlutusTx.Sqrt PlutusTx.Traversable PlutusTx.AssocMap + PlutusTx.Trace PlutusTx.These PlutusTx.Code PlutusTx.Lift diff --git a/plutus-tx/src/PlutusTx/Enum.hs b/plutus-tx/src/PlutusTx/Enum.hs index 7792595e38a..3a708b99bdd 100644 --- a/plutus-tx/src/PlutusTx/Enum.hs +++ b/plutus-tx/src/PlutusTx/Enum.hs @@ -3,7 +3,8 @@ module PlutusTx.Enum (Enum(..)) where import PlutusTx.Builtins -import Prelude hiding (Enum (..), error) +import PlutusTx.Trace +import Prelude hiding (Enum (..)) -- | Class 'Enum' defines operations on sequentially ordered types. class Enum a where @@ -31,14 +32,14 @@ instance Enum Integer where instance Enum () where {-# INLINABLE succ #-} - succ _ = error (trace "PlutusTx.Enum.().succ: bad argument" ()) + succ _ = traceError "PlutusTx.Enum.().succ: bad argument" {-# INLINABLE pred #-} - pred _ = error (trace "PlutusTx.Enum.().pred: bad argument" ()) + pred _ = traceError "PlutusTx.Enum.().pred: bad argument" {-# INLINABLE toEnum #-} toEnum x | x == 0 = () - | otherwise = error (trace "PlutusTx.Enum.().toEnum: bad argument" ()) + | otherwise = traceError "PlutusTx.Enum.().toEnum: bad argument" {-# INLINABLE fromEnum #-} fromEnum () = 0 @@ -46,16 +47,16 @@ instance Enum () where instance Enum Bool where {-# INLINABLE succ #-} succ False = True - succ True = error (trace "PlutusTx.Enum.Bool.succ: bad argument" ()) + succ True = traceError "PlutusTx.Enum.Bool.succ: bad argument" {-# INLINABLE pred #-} pred True = False - pred False = error (trace "PlutusTx.Enum.Bool.pred: bad argument" ()) + pred False = traceError "PlutusTx.Enum.Bool.pred: bad argument" {-# INLINABLE toEnum #-} toEnum n | n == 0 = False | n == 1 = True - | otherwise = error (trace "PlutusTx.Enum.Bool.toEnum: bad argument" ()) + | otherwise = traceError "PlutusTx.Enum.Bool.toEnum: bad argument" {-# INLINABLE fromEnum #-} fromEnum False = 0 @@ -65,18 +66,18 @@ instance Enum Ordering where {-# INLINABLE succ #-} succ LT = EQ succ EQ = GT - succ GT = error (trace "PlutusTx.Enum.Ordering.succ: bad argument" ()) + succ GT = traceError "PlutusTx.Enum.Ordering.succ: bad argument" {-# INLINABLE pred #-} pred GT = EQ pred EQ = LT - pred LT = error (trace "PlutusTx.Enum.Ordering.pred: bad argument" ()) + pred LT = traceError "PlutusTx.Enum.Ordering.pred: bad argument" {-# INLINABLE toEnum #-} toEnum n | n == 0 = LT | n == 1 = EQ | n == 2 = GT - toEnum _ = error (trace "PlutusTx.Enum.Ordering.toEnum: bad argument" ()) + toEnum _ = traceError "PlutusTx.Enum.Ordering.toEnum: bad argument" {-# INLINABLE fromEnum #-} fromEnum LT = 0 diff --git a/plutus-tx/src/PlutusTx/IsData/Class.hs b/plutus-tx/src/PlutusTx/IsData/Class.hs index 4b7c6c03d63..8158eadbab1 100644 --- a/plutus-tx/src/PlutusTx/IsData/Class.hs +++ b/plutus-tx/src/PlutusTx/IsData/Class.hs @@ -1,6 +1,7 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE KindSignatures #-} {-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE UndecidableInstances #-} @@ -20,6 +21,7 @@ import qualified PlutusTx.Builtins.Internal as BI import PlutusTx.Applicative import PlutusTx.Functor +import PlutusTx.Trace import Data.Kind import Data.Void @@ -116,7 +118,7 @@ instance IsData Void where {-# INLINABLE fromBuiltinData #-} fromBuiltinData _ = Nothing {-# INLINABLE unsafeFromBuiltinData #-} - unsafeFromBuiltinData _ = Builtins.error () + unsafeFromBuiltinData _ = traceError "unsafeFromBuiltinData: Void is not supported" -- | Convert a value to 'PLC.Data'. toData :: (IsData a) => a -> PLC.Data diff --git a/plutus-tx/src/PlutusTx/List.hs b/plutus-tx/src/PlutusTx/List.hs index f107e3a431a..9f94f3ef981 100644 --- a/plutus-tx/src/PlutusTx/List.hs +++ b/plutus-tx/src/PlutusTx/List.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE OverloadedStrings #-} {-# OPTIONS_GHC -fno-omit-interface-pragmas #-} module PlutusTx.List ( map, @@ -21,6 +22,7 @@ module PlutusTx.List ( import PlutusTx.Bool ((||)) import qualified PlutusTx.Builtins as Builtins import PlutusTx.Eq (Eq, (==)) +import PlutusTx.Trace (traceError) import Prelude hiding (Eq (..), all, any, elem, filter, foldl, foldr, head, length, map, null, reverse, tail, take, zip, (!!), (&&), (++), (||)) @@ -101,7 +103,8 @@ findIndex p l = listToMaybe (findIndices p l) -- infixl 9 !! (!!) :: [a] -> Integer -> a -[] !! _ = Builtins.error () +_ !! n | n < 0 = traceError "PlutusTx.List.!!: negative index" +[] !! _ = traceError "PlutusTx.List.!!: index too large" (x : xs) !! i = if Builtins.equalsInteger i 0 then x else xs !! Builtins.subtractInteger i 1 @@ -126,14 +129,14 @@ zip (a:as) (b:bs) = (a,b) : zip as bs {-# INLINABLE head #-} -- | Plutus Tx version of 'Data.List.head'. head :: [a] -> a -head [] = Builtins.error () +head [] = traceError "PlutusTx.List.head: empty list" head (x : _) = x {-# INLINABLE tail #-} -- | Plutus Tx version of 'Data.List.tail'. tail :: [a] -> [a] tail (_:as) = as -tail [] = Builtins.error () +tail [] = traceError "PlutusTx.List.tail: empty list" {-# INLINABLE take #-} -- | Plutus Tx version of 'Data.List.take'. diff --git a/plutus-tx/src/PlutusTx/Prelude.hs b/plutus-tx/src/PlutusTx/Prelude.hs index 60bc5a26afc..f14cdd344e5 100644 --- a/plutus-tx/src/PlutusTx/Prelude.hs +++ b/plutus-tx/src/PlutusTx/Prelude.hs @@ -1,4 +1,5 @@ -- Need some extra imports from the Prelude for doctests, annoyingly +{-# LANGUAGE OverloadedStrings #-} {-# OPTIONS_GHC -Wno-unused-imports #-} {-# OPTIONS_GHC -fno-omit-interface-pragmas #-} {-# OPTIONS_GHC -fmax-simplifier-iterations=0 #-} @@ -28,11 +29,9 @@ module PlutusTx.Prelude ( otherwise, until, flip, - -- * String and tracing functions - trace, - traceIfTrue, - traceIfFalse, - traceError, + -- * Tracing functions + module Trace, + -- * String BuiltinString, appendString, emptyString, @@ -90,7 +89,7 @@ import PlutusTx.Bool as Bool import PlutusTx.Builtins (BuiltinData, BuiltinString, ByteString, appendString, charToString, concatenate, dropByteString, emptyByteString, emptyString, encodeUtf8, equalsByteString, equalsString, error, greaterThanByteString, lessThanByteString, sha2_256, - sha3_256, takeByteString, trace, verifySignature) + sha3_256, takeByteString, verifySignature) import qualified PlutusTx.Builtins as Builtins import PlutusTx.Either as Either import PlutusTx.Enum as Enum @@ -106,6 +105,7 @@ import PlutusTx.Numeric as Numeric import PlutusTx.Ord as Ord import PlutusTx.Ratio as Ratio import PlutusTx.Semigroup as Semigroup +import PlutusTx.Trace as Trace import PlutusTx.Traversable as Traversable import Prelude as Prelude hiding (Applicative (..), Enum (..), Eq (..), Foldable (..), Functor (..), Monoid (..), Num (..), Ord (..), Rational, @@ -134,22 +134,7 @@ import Prelude as Prelude (maximum, minimum) {-# INLINABLE check #-} -- | Checks a 'Bool' and aborts if it is false. check :: Bool -> () -check b = if b then () else error () - -{-# INLINABLE traceError #-} --- | Log a message and then terminate the evaluation with an error. -traceError :: Builtins.BuiltinString -> a -traceError str = error (trace str ()) - -{-# INLINABLE traceIfFalse #-} --- | Emit the given 'BuiltinString' only if the argument evaluates to 'False'. -traceIfFalse :: Builtins.BuiltinString -> Bool -> Bool -traceIfFalse str a = if a then True else trace str False - -{-# INLINABLE traceIfTrue #-} --- | Emit the given 'BuiltinString' only if the argument evaluates to 'True'. -traceIfTrue :: Builtins.BuiltinString -> Bool -> Bool -traceIfTrue str a = if a then trace str True else False +check b = if b then () else traceError "Check has failed" {-# INLINABLE divide #-} -- | Integer division, rounding downwards diff --git a/plutus-tx/src/PlutusTx/Ratio.hs b/plutus-tx/src/PlutusTx/Ratio.hs index 47a3fa130cc..7d7e52f1aab 100644 --- a/plutus-tx/src/PlutusTx/Ratio.hs +++ b/plutus-tx/src/PlutusTx/Ratio.hs @@ -5,6 +5,7 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} {-# OPTIONS_GHC -fno-omit-interface-pragmas #-} {-# OPTIONS_GHC -fplugin-opt PlutusTx.Plugin:debug-context #-} @@ -38,13 +39,15 @@ import qualified PlutusTx.IsData as P import qualified PlutusTx.Lift as P import qualified PlutusTx.Numeric as P import qualified PlutusTx.Ord as P +import qualified PlutusTx.Trace as P import qualified PlutusTx.Builtins as Builtins import Data.Aeson (FromJSON, ToJSON) import GHC.Generics (Generic) import qualified GHC.Real as Ratio -import Prelude (Bool (True), Eq, Integer, Integral, Ord (..), Show (..), showParen, showString, (*)) +import Prelude (Bool (True), Eq, Integer, Integral, Ord (..), Show (..), otherwise, showParen, + showString, (*)) import qualified Prelude as Haskell data Ratio a = a :% a @@ -277,7 +280,7 @@ half = 1 :% 2 -- their greatest common divisor. reduce :: Integer -> Integer -> Ratio Integer reduce x y - | y P.== 0 = Builtins.error () + | y P.== 0 = P.traceError "Ratio has zero denominator" | True = let d = gcd x y in (x `Builtins.quotientInteger` d) :% (y `Builtins.quotientInteger` d) @@ -311,7 +314,7 @@ round x | sig P.== P.negate P.one = n | sig P.== P.zero = if even n then n else m | sig P.== P.one = m - | True = Builtins.error() + | otherwise = P.traceError "round default defn: Bad value" where (n, r) = properFraction x m = if r P.< P.zero then n P.- P.one else n P.+ P.one sig = signumR (abs r P.- half) diff --git a/plutus-tx/src/PlutusTx/Trace.hs b/plutus-tx/src/PlutusTx/Trace.hs new file mode 100644 index 00000000000..68cabd9bed1 --- /dev/null +++ b/plutus-tx/src/PlutusTx/Trace.hs @@ -0,0 +1,25 @@ +{-# OPTIONS_GHC -fno-omit-interface-pragmas #-} +module PlutusTx.Trace ( + trace, + traceError, + traceIfFalse, + traceIfTrue + ) where + +import PlutusTx.Builtins as Builtins +import Prelude hiding (error) + +{-# INLINABLE traceError #-} +-- | Log a message and then terminate the evaluation with an error. +traceError :: Builtins.BuiltinString -> a +traceError str = error (trace str ()) + +{-# INLINABLE traceIfFalse #-} +-- | Emit the given 'BuiltinString' only if the argument evaluates to 'False'. +traceIfFalse :: Builtins.BuiltinString -> Bool -> Bool +traceIfFalse str a = if a then True else trace str False + +{-# INLINABLE traceIfTrue #-} +-- | Emit the given 'BuiltinString' only if the argument evaluates to 'True'. +traceIfTrue :: Builtins.BuiltinString -> Bool -> Bool +traceIfTrue str a = if a then trace str True else False diff --git a/plutus-use-cases/src/Plutus/Contracts/Swap.hs b/plutus-use-cases/src/Plutus/Contracts/Swap.hs index 740056e7c91..a945add2b30 100644 --- a/plutus-use-cases/src/Plutus/Contracts/Swap.hs +++ b/plutus-use-cases/src/Plutus/Contracts/Swap.hs @@ -71,11 +71,11 @@ mkValidator Swap{..} SwapOwners{..} redeemer p@ScriptContext{scriptContextTxInfo extractVerifyAt :: SignedMessage (Observation Rational) -> PubKey -> POSIXTime -> Rational extractVerifyAt sm pk time = case Oracle.verifySignedMessageOnChain p pk sm of - Left _ -> trace "checkSignatureAndDecode failed" (error ()) + Left _ -> traceError "checkSignatureAndDecode failed" Right Observation{obsValue, obsTime} -> if obsTime == time then obsValue - else trace "wrong time" (error ()) + else traceError "wrong time" -- | Convert an [[Integer]] to a [[Rational]] fromInt :: Integer -> Rational