SCP-3435: Refactored error types in Wallet.Types (#298)

* Moved error types in `Wallet.Types` to `Plutus.Contract.Error`

* Added a contract error type for chain index errors in `Plutus.Contract.Request (ChainIndexContractError)`

* Added a contract error for endpoing decoding and better formatting (`EndpointDecodeContractError`)

* Renamed the existing constructors for `ContractError`

* Added missing import lists for the modified modules in this commit.

playground-common/src/PSGenerator/Common.hs

@@ -43,6 +43,7 @@ import Plutus.ChainIndex.UtxoState (InsertUtxoFailed, InsertUtxoPosition, Rollba
 import Plutus.Contract.Checkpoint (CheckpointError)
 import Plutus.Contract.Effects (ActiveEndpoint, BalanceTxResponse, ChainIndexQuery, ChainIndexResponse, PABReq, PABResp,
                                 WriteBalancedTxResponse)
+import Plutus.Contract.Error (AssertionError, ContractError, MatchingError)
 import Plutus.Contract.Resumable (IterationID, Request, RequestID, Response)
 import Plutus.Trace.Emulator.Types (ContractInstanceLog, ContractInstanceMsg, ContractInstanceTag, EmulatorRuntimeError,
                                     UserThreadMsg)
@@ -52,9 +53,8 @@ import Schema (FormArgumentF, FormSchema)
 import Wallet.API (WalletAPIError)
 import Wallet.Emulator.Types qualified as EM
 import Wallet.Rollup.Types (AnnotatedTx, BeneficialOwner, DereferencedInput, SequenceId, TxKey)
-import Wallet.Types (AssertionError, ContractActivityStatus, ContractError, ContractInstanceId, EndpointDescription,
-                     EndpointValue, MatchingError, Notification, NotificationError)
-
+import Wallet.Types (ContractActivityStatus, ContractInstanceId, EndpointDescription, EndpointValue, Notification,
+                     NotificationError)
 
 psJson :: PSType
 psJson = TypeInfo "web-common" "Data.RawJson" "RawJson" []

plutus-contract/plutus-contract.cabal

@@ -43,6 +43,7 @@ library
         Data.UUID.Extras
         Plutus.Contract
         Plutus.Contract.Effects
+        Plutus.Contract.Error
         Plutus.Contract.Request
         Plutus.Contract.Checkpoint
         Plutus.Contract.Constraints

plutus-contract/src/Plutus/Contract.hs

@@ -4,24 +4,24 @@
 {-# LANGUAGE MonoLocalBinds     #-}
 module Plutus.Contract(
       Contract(..)
-    , ContractError(..)
-    , AsContractError(..)
-    , IsContract(..)
+    , Plutus.Contract.Types.ContractError(..)
+    , Plutus.Contract.Types.AsContractError(..)
+    , Plutus.Contract.Types.IsContract(..)
     , (>>)
-    , throwError
-    , handleError
-    , mapError
-    , runError
+    , Plutus.Contract.Types.throwError
+    , Plutus.Contract.Types.handleError
+    , Plutus.Contract.Types.mapError
+    , Plutus.Contract.Types.runError
     -- * Select
     , Promise
-    , awaitPromise
-    , promiseMap
-    , promiseBind
+    , Plutus.Contract.Types.awaitPromise
+    , Plutus.Contract.Types.promiseMap
+    , Plutus.Contract.Types.promiseBind
     , both
-    , selectEither
-    , select
-    , selectList
-    , never
+    , Plutus.Contract.Types.selectEither
+    , Plutus.Contract.Types.select
+    , Plutus.Contract.Types.selectList
+    , Plutus.Contract.Types.never
     -- * Dealing with time
     , Request.awaitSlot
     , Request.isSlot
@@ -90,10 +90,10 @@ module Plutus.Contract(
     -- ** Tx output confirmation
     , Request.awaitTxOutStatusChange
     -- * Checkpoints
-    , checkpoint
-    , checkpointLoop
-    , AsCheckpointError(..)
-    , CheckpointError(..)
+    , Plutus.Contract.Types.checkpoint
+    , Plutus.Contract.Types.checkpointLoop
+    , Plutus.Contract.Types.AsCheckpointError(..)
+    , Plutus.Contract.Types.CheckpointError(..)
     -- * Logging
     , module Logging
     -- * Row-related things
@@ -110,10 +110,8 @@ import Plutus.Contract.Request (ContractRow)
 import Plutus.Contract.Request qualified as Request
 import Plutus.Contract.Schema qualified as Schema
 import Plutus.Contract.Typed.Tx as Tx (collectFromScript, collectFromScriptFilter)
-import Plutus.Contract.Types (AsCheckpointError (..), AsContractError (..), CheckpointError (..), Contract (..),
-                              ContractError (..), IsContract (..), Promise (..), checkpoint, checkpointLoop,
-                              handleError, mapError, never, promiseBind, promiseMap, runError, select, selectEither,
-                              selectList, throwError)
+import Plutus.Contract.Types (Contract (Contract), Promise, select)
+import Plutus.Contract.Types qualified
 
 import Control.Monad.Freer.Writer qualified as W
 import Data.Functor.Apply (liftF2)

plutus-contract/src/Plutus/Contract/Error.hs

@@ -0,0 +1,111 @@
+{-# LANGUAGE DataKinds         #-}
+{-# LANGUAGE DeriveAnyClass    #-}
+{-# LANGUAGE DerivingVia       #-}
+{-# LANGUAGE LambdaCase        #-}
+{-# LANGUAGE NamedFieldPuns    #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TemplateHaskell   #-}
+
+module Plutus.Contract.Error
+    ( ContractError(..)
+    , AsContractError(..)
+    , MatchingError(..)
+    , AsMatchingError(..)
+    , AssertionError(..)
+    , AsAssertionError(..)
+    ) where
+
+import Control.Lens (prism')
+import Control.Lens.TH (makeClassyPrisms)
+import Data.Aeson (FromJSON, ToJSON)
+import Data.Aeson qualified as Aeson
+import Data.String (IsString (fromString))
+import Data.Text (Text)
+import Data.Text qualified as T
+import GHC.Generics (Generic)
+import Prettyprinter (Pretty (pretty), viaShow, (<+>))
+
+import Data.Aeson qualified as JSON
+import Ledger.Constraints.OffChain (MkTxError)
+import Plutus.Contract.Checkpoint (AsCheckpointError (_CheckpointError), CheckpointError)
+import Plutus.Contract.Effects (ChainIndexResponse)
+import Wallet.Error (WalletAPIError)
+import Wallet.Types (EndpointDescription (EndpointDescription), EndpointValue (EndpointValue))
+
+-- | An error
+newtype MatchingError = WrongVariantError { unWrongVariantError :: Text }
+    deriving stock (Eq, Ord, Show, Generic)
+    deriving anyclass (Aeson.ToJSON, Aeson.FromJSON)
+makeClassyPrisms ''MatchingError
+
+instance Pretty MatchingError where
+  pretty = \case
+    WrongVariantError t -> "Wrong variant:" <+> pretty t
+
+-- | An error emitted when an 'Assertion' fails.
+newtype AssertionError = GenericAssertion { unAssertionError :: T.Text }
+    deriving stock (Show, Eq, Generic)
+    deriving anyclass (ToJSON, FromJSON)
+makeClassyPrisms ''AssertionError
+
+instance Pretty AssertionError where
+    pretty = \case
+        GenericAssertion t -> "Generic assertion:" <+> pretty t
+
+-- | This lets people use 'T.Text' as their error type.
+instance AsAssertionError T.Text where
+    _AssertionError = prism' (T.pack . show) (const Nothing)
+
+data ContractError =
+    WalletContractError WalletAPIError
+  | ChainIndexContractError T.Text ChainIndexResponse
+  | EmulatorAssertionContractError AssertionError -- TODO: Why do we need this constructor
+  | ConstraintResolutionContractError MkTxError
+  | ResumableContractError MatchingError
+  | CCheckpointContractError CheckpointError
+  | EndpointDecodeContractError
+      { eeEndpointDescription :: EndpointDescription
+      -- ^ The endpoint description which the decoding error occurred from
+      , eeEndpointValue       :: EndpointValue JSON.Value
+      -- ^ The endpoint value that was used as an endpoint parameter
+      , eeErrorMessage        :: T.Text
+      -- ^ JSON decoding error message
+      }
+  | OtherContractError T.Text
+    deriving stock (Show, Eq, Generic)
+    deriving anyclass (Aeson.ToJSON, Aeson.FromJSON)
+makeClassyPrisms ''ContractError
+
+instance Pretty ContractError where
+  pretty = \case
+    WalletContractError e               -> "Wallet error:" <+> pretty e
+    ChainIndexContractError expectedResp actualResp
+        -> "Wrong response type from chain index request: Expected"
+        <+> pretty expectedResp
+        <> ", got"
+        <+> pretty actualResp
+    EmulatorAssertionContractError a    -> "Emulator assertion error:" <+> pretty a
+    ConstraintResolutionContractError e -> "Constraint resolution error:" <+> pretty e
+    ResumableContractError e            -> "Resumable error:" <+> pretty e
+    CCheckpointContractError e          -> "Checkpoint error:" <+> pretty e
+    EndpointDecodeContractError (EndpointDescription ed) (EndpointValue ev) err
+        -> "Failed to decode endpoint \""
+        <> pretty ed
+        <> "\" with value"
+        <+> viaShow ev
+        <> ":"
+        <+> pretty err
+    OtherContractError t                -> "Other error:" <+> pretty t
+
+-- | This lets people use 'T.Text' as their error type.
+instance AsContractError T.Text where
+    _ContractError = prism' (T.pack . show) (const Nothing)
+
+instance IsString ContractError where
+  fromString = OtherContractError . fromString
+
+instance AsAssertionError ContractError where
+    _AssertionError = _EmulatorAssertionContractError
+
+instance AsCheckpointError ContractError where
+  _CheckpointError = _CCheckpointContractError