{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilyDependencies #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE UndecidableSuperClasses #-}
-- Recursive definition constraints of `EraPlutusContext` and `EraPlutusTxInfo` lead to a wrongful
-- redundant constraint warning in the definition of `lookupTxInfoResult`.
--
-- Also `mkSupportedPlutusScript` has a constraint that is not required by the type system, but is
-- necessary for the safety of the function.
{-# OPTIONS_GHC -Wno-redundant-constraints #-}

module Cardano.Ledger.Alonzo.Plutus.Context (
  CollectError (..),
  LedgerTxInfo (..),
  EraPlutusTxInfo (..),
  PlutusTxInfoResult (..),
  mkPlutusTxInfoFromResult,
  toPlutusTxInfoForPurpose,
  EraPlutusContext (..),
  lookupTxInfoResultImpossible,
  SupportedLanguage (..),
  mkSupportedLanguageM,
  supportedLanguages,
  mkSupportedPlutusScript,
  mkSupportedBinaryPlutusScript,

  -- * Language dependent translation
  PlutusTxInfo,
  PlutusTxCert,
  PlutusScriptPurpose,
  PlutusScriptContext,
  PlutusTxInInfo,
) where

import Cardano.Ledger.Alonzo.Era (AlonzoEra)
import Cardano.Ledger.Alonzo.Scripts (
  AlonzoEraScript (eraMaxLanguage, mkPlutusScript),
  AsItem (..),
  AsIxItem (..),
  AsPurpose,
  PlutusPurpose,
  PlutusScript (..),
 )
import Cardano.Ledger.BaseTypes (ProtVer (..), kindObject)
import Cardano.Ledger.Binary (DecCBOR (..), EncCBOR (..))
import Cardano.Ledger.Binary.Coders
import Cardano.Ledger.Core
import Cardano.Ledger.Plutus (
  CostModel,
  Data,
  ExUnits,
  Language (..),
  Plutus (..),
  PlutusArgs,
  PlutusBinary,
  PlutusLanguage,
  PlutusScriptContext,
  PlutusWithContext (..),
  SLanguage (..),
  asSLanguage,
  plutusLanguage,
 )
import Cardano.Ledger.State (UTxO (..))
import Cardano.Ledger.TxIn (TxId, TxIn)
import Cardano.Slotting.EpochInfo (EpochInfo)
import Cardano.Slotting.Time (SystemStart)
import Control.DeepSeq (NFData)
import Control.Monad (join)
import Control.Monad.Trans.Fail.String (errorFail)
import Data.Aeson (ToJSON (..), (.=), pattern String)
import Data.Kind (Type)
import Data.List.NonEmpty (NonEmpty, nonEmpty)
import Data.Map.Strict (Map)
import Data.Text (Text)
import GHC.Generics
import GHC.Stack
import qualified PlutusLedgerApi.V1 as PV1
import qualified PlutusLedgerApi.V2 as PV2
import qualified PlutusLedgerApi.V3 as PV3

-- | All information that is necessary from the ledger to construct Plutus' TxInfo.
data LedgerTxInfo era where
  LedgerTxInfo ::
    { forall era. LedgerTxInfo era -> ProtVer
ltiProtVer :: !ProtVer
    , forall era. LedgerTxInfo era -> EpochInfo (Either Text)
ltiEpochInfo :: !(EpochInfo (Either Text))
    , forall era. LedgerTxInfo era -> SystemStart
ltiSystemStart :: !SystemStart
    , forall era. LedgerTxInfo era -> UTxO era
ltiUTxO :: !(UTxO era)
    , ()
ltiTx :: !(Tx level era)
    , forall era. LedgerTxInfo era -> Map TxId (TxInfoResult era)
ltiMemoizedSubTransactions :: Map TxId (TxInfoResult era)
    -- ^ This is a tricky field that is only used starting with Dijkstra era and only by top level
    -- transactions. It is always safe to leave it as `mempty` upon construction, even for Dijkstra
    } ->
    LedgerTxInfo era

class
  ( PlutusLanguage l
  , EraPlutusContext era
  , EraTxLevel era
  , Eq (PlutusTxInfo l)
  , Show (PlutusTxInfo l)
  ) =>
  EraPlutusTxInfo (l :: Language) era
  where
  toPlutusTxCert ::
    proxy l ->
    ProtVer ->
    TxCert era ->
    Either (ContextError era) (PlutusTxCert l)

  toPlutusScriptPurpose ::
    proxy l ->
    ProtVer ->
    PlutusPurpose AsIxItem era ->
    Either (ContextError era) (PlutusScriptPurpose l)

  toPlutusTxInfo ::
    proxy l ->
    LedgerTxInfo era ->
    PlutusTxInfoResult l era

  toPlutusArgs ::
    proxy l ->
    ProtVer ->
    PlutusTxInfo l ->
    PlutusPurpose AsIxItem era ->
    Maybe (Data era) ->
    Data era ->
    Either (ContextError era) (PlutusArgs l)

  toPlutusTxInInfo ::
    proxy l ->
    UTxO era ->
    TxIn ->
    Either (ContextError era) (PlutusTxInInfo era l)

-- | This is the helper type that captures translation of `Tx` to `PlutusTxInfo`.
--
-- It is important to note that `TxInfo` is always the same per Plutus version for each `Tx`. This
-- invariant allows us to avoid duplicate computation by memoizing all possible `PlutusTxInfo`s per
-- transaction. Starting with Dijkstra era there is a slight complication introduced to this
-- invariant where top level transaction has a different `PlutusTxInfo` for "Guarding" purpose, when
-- compared to all other purposes. That is the reason why result is somewhat strange, namely a
-- function from `PlutusPurpose` to `PlutusTxInfo`. It is also done this way, instead of adding
-- `ScriptPurpose` as an argument to `toPlutusTxInfo` to preserve capability of memoization, hence
-- nested `Either`
newtype PlutusTxInfoResult l era
  = PlutusTxInfoResult
  { forall (l :: Language) era.
PlutusTxInfoResult l era
-> Either
     (ContextError era)
     (PlutusPurpose AsPurpose era
      -> Either (ContextError era) (PlutusTxInfo l))
unPlutusTxInfoResult ::
      Either
        (ContextError era)
        ( PlutusPurpose AsPurpose era ->
          Either (ContextError era) (PlutusTxInfo l)
        )
  }

-- | Given the prepared `PlutusTxInfoResult` and the purpose this function allows constructing the `PlutusTxInfo`, while memoizing the computation from  `PlutusTxInfoResult` for its subsequent uses.
mkPlutusTxInfoFromResult ::
  PlutusPurpose AsPurpose era ->
  PlutusTxInfoResult l era ->
  Either (ContextError era) (PlutusTxInfo l)
mkPlutusTxInfoFromResult :: forall era (l :: Language).
PlutusPurpose AsPurpose era
-> PlutusTxInfoResult l era
-> Either (ContextError era) (PlutusTxInfo l)
mkPlutusTxInfoFromResult PlutusPurpose AsPurpose era
sp (PlutusTxInfoResult Either
  (ContextError era)
  (PlutusPurpose AsPurpose era
   -> Either (ContextError era) (PlutusTxInfo l))
txInfoResult) =
  Either
  (ContextError era) (Either (ContextError era) (PlutusTxInfo l))
-> Either (ContextError era) (PlutusTxInfo l)
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (Either
   (ContextError era) (Either (ContextError era) (PlutusTxInfo l))
 -> Either (ContextError era) (PlutusTxInfo l))
-> Either
     (ContextError era) (Either (ContextError era) (PlutusTxInfo l))
-> Either (ContextError era) (PlutusTxInfo l)
forall a b. (a -> b) -> a -> b
$ ((PlutusPurpose AsPurpose era
 -> Either (ContextError era) (PlutusTxInfo l))
-> PlutusPurpose AsPurpose era
-> Either (ContextError era) (PlutusTxInfo l)
forall a b. (a -> b) -> a -> b
$ PlutusPurpose AsPurpose era
sp) ((PlutusPurpose AsPurpose era
  -> Either (ContextError era) (PlutusTxInfo l))
 -> Either (ContextError era) (PlutusTxInfo l))
-> Either
     (ContextError era)
     (PlutusPurpose AsPurpose era
      -> Either (ContextError era) (PlutusTxInfo l))
-> Either
     (ContextError era) (Either (ContextError era) (PlutusTxInfo l))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either
  (ContextError era)
  (PlutusPurpose AsPurpose era
   -> Either (ContextError era) (PlutusTxInfo l))
txInfoResult

-- | This is what `toPlutusTxInfo` would be without the intermediate `PlutusTxInfoResult`.
--
-- /Note/ - Using this function totally drops any memoization of `TxInfo`, as such use it only for
-- testing or tooling that doesn't care about performance.
toPlutusTxInfoForPurpose ::
  EraPlutusTxInfo l era =>
  proxy l ->
  LedgerTxInfo era ->
  PlutusPurpose AsPurpose era ->
  Either (ContextError era) (PlutusTxInfo l)
toPlutusTxInfoForPurpose :: forall (l :: Language) era (proxy :: Language -> *).
EraPlutusTxInfo l era =>
proxy l
-> LedgerTxInfo era
-> PlutusPurpose AsPurpose era
-> Either (ContextError era) (PlutusTxInfo l)
toPlutusTxInfoForPurpose proxy l
proxy LedgerTxInfo era
lti PlutusPurpose AsPurpose era
sp =
  PlutusPurpose AsPurpose era
-> PlutusTxInfoResult l era
-> Either (ContextError era) (PlutusTxInfo l)
forall era (l :: Language).
PlutusPurpose AsPurpose era
-> PlutusTxInfoResult l era
-> Either (ContextError era) (PlutusTxInfo l)
mkPlutusTxInfoFromResult PlutusPurpose AsPurpose era
sp (PlutusTxInfoResult l era
 -> Either (ContextError era) (PlutusTxInfo l))
-> PlutusTxInfoResult l era
-> Either (ContextError era) (PlutusTxInfo l)
forall a b. (a -> b) -> a -> b
$ proxy l -> LedgerTxInfo era -> PlutusTxInfoResult l era
forall (l :: Language) era (proxy :: Language -> *).
EraPlutusTxInfo l era =>
proxy l -> LedgerTxInfo era -> PlutusTxInfoResult l era
forall (proxy :: Language -> *).
proxy l -> LedgerTxInfo era -> PlutusTxInfoResult l era
toPlutusTxInfo proxy l
proxy LedgerTxInfo era
lti

class
  ( AlonzoEraScript era
  , Eq (ContextError era)
  , Show (ContextError era)
  , NFData (ContextError era)
  , EncCBOR (ContextError era)
  , DecCBOR (ContextError era)
  , ToJSON (ContextError era)
  ) =>
  EraPlutusContext era
  where
  type ContextError era = (r :: Type) | r -> era

  -- | This data type family is used to memoize the results of `toPlutusTxInfo`, so the outcome can
  -- be shared between execution of different scripts with the same language version.
  data TxInfoResult era :: Type

  mkSupportedLanguage :: Language -> Maybe (SupportedLanguage era)

  -- | Construct `PlutusTxInfo` for all supported languages in this era.
  mkTxInfoResult :: LedgerTxInfo era -> TxInfoResult era

  -- | `TxInfo` for the same language can be shared between executions of every script of the same
  -- version in a single transaction.
  --
  -- /Note/ - The `EraPlutusTxInfo` is here only to enforce this function is not called with an
  -- unsupported plutus language version.
  lookupTxInfoResult ::
    EraPlutusTxInfo l era =>
    SLanguage l ->
    TxInfoResult era ->
    PlutusTxInfoResult l era

  mkPlutusWithContext ::
    PlutusScript era ->
    ScriptHash ->
    PlutusPurpose AsIxItem era ->
    LedgerTxInfo era ->
    TxInfoResult era ->
    (Data era, ExUnits) ->
    CostModel ->
    Either (ContextError era) PlutusWithContext

-- | Helper function to use when implementing `lookupTxInfoResult` for plutus languages that are not
-- supported by the era.
lookupTxInfoResultImpossible ::
  (HasCallStack, EraPlutusTxInfo l era) => SLanguage l -> PlutusTxInfoResult l era
lookupTxInfoResultImpossible :: forall (l :: Language) era.
(HasCallStack, EraPlutusTxInfo l era) =>
SLanguage l -> PlutusTxInfoResult l era
lookupTxInfoResultImpossible SLanguage l
slang =
  [Char] -> PlutusTxInfoResult l era
forall a. HasCallStack => [Char] -> a
error ([Char] -> PlutusTxInfoResult l era)
-> [Char] -> PlutusTxInfoResult l era
forall a b. (a -> b) -> a -> b
$ [Char]
"Impossible: Attempt to lookup TxInfoResult for an unsupported language: " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> SLanguage l -> [Char]
forall a. Show a => a -> [Char]
show SLanguage l
slang

-- =============================================
-- Type families that specify Plutus types that are different from one version to another

type family PlutusTxCert (l :: Language) where
  PlutusTxCert 'PlutusV1 = PV1.DCert
  PlutusTxCert 'PlutusV2 = PV2.DCert
  PlutusTxCert 'PlutusV3 = PV3.TxCert
  PlutusTxCert 'PlutusV4 = PV3.TxCert

type family PlutusScriptPurpose (l :: Language) where
  PlutusScriptPurpose 'PlutusV1 = PV1.ScriptPurpose
  PlutusScriptPurpose 'PlutusV2 = PV2.ScriptPurpose
  PlutusScriptPurpose 'PlutusV3 = PV3.ScriptPurpose
  PlutusScriptPurpose 'PlutusV4 = PV3.ScriptPurpose

type family PlutusTxInfo (l :: Language) where
  PlutusTxInfo 'PlutusV1 = PV1.TxInfo
  PlutusTxInfo 'PlutusV2 = PV2.TxInfo
  PlutusTxInfo 'PlutusV3 = PV3.TxInfo
  PlutusTxInfo 'PlutusV4 = PV3.TxInfo

type family PlutusTxInInfo era (l :: Language) where
  -- This special case is here because Alonzo does not have a ContextError
  -- for the case where it encounters a Byron address in a TxIn
  PlutusTxInInfo AlonzoEra PlutusV1 = Maybe PV1.TxInInfo
  PlutusTxInInfo _ 'PlutusV1 = PV1.TxInInfo
  PlutusTxInInfo _ 'PlutusV2 = PV2.TxInInfo
  PlutusTxInInfo _ 'PlutusV3 = PV3.TxInInfo
  PlutusTxInInfo _ 'PlutusV4 = PV3.TxInInfo

-- | This is just like `mkPlutusScript`, except it is guaranteed to be total through the enforcement
-- of support by the type system and `EraPlutusTxInfo` type class instances for supported plutus
-- versions.
mkSupportedPlutusScript ::
  forall l era.
  (HasCallStack, EraPlutusTxInfo l era) =>
  Plutus l ->
  PlutusScript era
mkSupportedPlutusScript :: forall (l :: Language) era.
(HasCallStack, EraPlutusTxInfo l era) =>
Plutus l -> PlutusScript era
mkSupportedPlutusScript Plutus l
plutus =
  case Plutus l -> Maybe (PlutusScript era)
forall era (l :: Language) (m :: * -> *).
(AlonzoEraScript era, PlutusLanguage l, MonadFail m) =>
Plutus l -> m (PlutusScript era)
forall (l :: Language) (m :: * -> *).
(PlutusLanguage l, MonadFail m) =>
Plutus l -> m (PlutusScript era)
mkPlutusScript Plutus l
plutus of
    Maybe (PlutusScript era)
Nothing ->
      [Char] -> PlutusScript era
forall a. HasCallStack => [Char] -> a
error ([Char] -> PlutusScript era) -> [Char] -> PlutusScript era
forall a b. (a -> b) -> a -> b
$
        [Char]
"Impossible: "
          [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Plutus l -> [Char]
forall a. Show a => a -> [Char]
show Plutus l
plutus
          [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" language version should be supported by the "
          [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ forall era. Era era => [Char]
eraName @era
    Just PlutusScript era
plutusScript -> PlutusScript era
plutusScript

-- | This is just like `mkBinaryPlutusScript`, except it is guaranteed to be total through the enforcement
-- of support by the type system and `EraPlutusTxInfo` type class instances (via calling `mkSupportedPlutusScript) for supported plutus
-- versions.
mkSupportedBinaryPlutusScript ::
  forall era.
  (HasCallStack, AlonzoEraScript era) =>
  SupportedLanguage era ->
  PlutusBinary ->
  PlutusScript era
mkSupportedBinaryPlutusScript :: forall era.
(HasCallStack, AlonzoEraScript era) =>
SupportedLanguage era -> PlutusBinary -> PlutusScript era
mkSupportedBinaryPlutusScript SupportedLanguage era
supportedLanguage PlutusBinary
plutus =
  case SupportedLanguage era
supportedLanguage of
    SupportedLanguage SLanguage l
sLang ->
      Plutus l -> PlutusScript era
forall (l :: Language) era.
(HasCallStack, EraPlutusTxInfo l era) =>
Plutus l -> PlutusScript era
mkSupportedPlutusScript (SLanguage l -> Plutus l -> Plutus l
forall (l :: Language) (proxy :: Language -> *).
SLanguage l -> proxy l -> proxy l
asSLanguage SLanguage l
sLang (PlutusBinary -> Plutus l
forall (l :: Language). PlutusBinary -> Plutus l
Plutus PlutusBinary
plutus))

data SupportedLanguage era where
  SupportedLanguage :: EraPlutusTxInfo l era => SLanguage l -> SupportedLanguage era

instance Show (SupportedLanguage era) where
  show :: SupportedLanguage era -> [Char]
show (SupportedLanguage SLanguage l
sLang) = [Char]
"(SupportedLanguage (" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ SLanguage l -> [Char]
forall a. Show a => a -> [Char]
show SLanguage l
sLang [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"))"

instance Eq (SupportedLanguage era) where
  SupportedLanguage SLanguage l
sLang1 == :: SupportedLanguage era -> SupportedLanguage era -> Bool
== SupportedLanguage SLanguage l
sLang2 =
    SLanguage l -> Language
forall (l :: Language) (proxy :: Language -> *).
PlutusLanguage l =>
proxy l -> Language
plutusLanguage SLanguage l
sLang1 Language -> Language -> Bool
forall a. Eq a => a -> a -> Bool
== SLanguage l -> Language
forall (l :: Language) (proxy :: Language -> *).
PlutusLanguage l =>
proxy l -> Language
plutusLanguage SLanguage l
sLang2

instance Ord (SupportedLanguage era) where
  compare :: SupportedLanguage era -> SupportedLanguage era -> Ordering
compare (SupportedLanguage SLanguage l
sLang1) (SupportedLanguage SLanguage l
sLang2) =
    Language -> Language -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (SLanguage l -> Language
forall (l :: Language) (proxy :: Language -> *).
PlutusLanguage l =>
proxy l -> Language
plutusLanguage SLanguage l
sLang1) (SLanguage l -> Language
forall (l :: Language) (proxy :: Language -> *).
PlutusLanguage l =>
proxy l -> Language
plutusLanguage SLanguage l
sLang2)

instance Era era => EncCBOR (SupportedLanguage era) where
  encCBOR :: SupportedLanguage era -> Encoding
encCBOR (SupportedLanguage SLanguage l
sLang) = SLanguage l -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR SLanguage l
sLang

instance EraPlutusContext era => DecCBOR (SupportedLanguage era) where
  decCBOR :: forall s. Decoder s (SupportedLanguage era)
decCBOR = Decoder s Language
forall s. Decoder s Language
forall a s. DecCBOR a => Decoder s a
decCBOR Decoder s Language
-> (Language -> Decoder s (SupportedLanguage era))
-> Decoder s (SupportedLanguage era)
forall a b. Decoder s a -> (a -> Decoder s b) -> Decoder s b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Language -> Decoder s (SupportedLanguage era)
forall era (m :: * -> *).
(EraPlutusContext era, MonadFail m) =>
Language -> m (SupportedLanguage era)
mkSupportedLanguageM

supportedLanguages ::
  forall era.
  (HasCallStack, EraPlutusContext era) =>
  NonEmpty (SupportedLanguage era)
supportedLanguages :: forall era.
(HasCallStack, EraPlutusContext era) =>
NonEmpty (SupportedLanguage era)
supportedLanguages =
  let langs :: [SupportedLanguage era]
langs =
        [ Fail (SupportedLanguage era) -> SupportedLanguage era
forall a. HasCallStack => Fail a -> a
errorFail (Language -> Fail (SupportedLanguage era)
forall era (m :: * -> *).
(EraPlutusContext era, MonadFail m) =>
Language -> m (SupportedLanguage era)
mkSupportedLanguageM Language
lang)
        | Language
lang <- [Language
forall a. Bounded a => a
minBound .. forall era. AlonzoEraScript era => Language
eraMaxLanguage @era]
        ]
   in case [SupportedLanguage era] -> Maybe (NonEmpty (SupportedLanguage era))
forall a. [a] -> Maybe (NonEmpty a)
nonEmpty [SupportedLanguage era]
langs of
        Maybe (NonEmpty (SupportedLanguage era))
Nothing -> [Char] -> NonEmpty (SupportedLanguage era)
forall a. HasCallStack => [Char] -> a
error [Char]
"Impossible: there are no supported languages"
        Just NonEmpty (SupportedLanguage era)
neLangs -> NonEmpty (SupportedLanguage era)
neLangs

mkSupportedLanguageM ::
  forall era m.
  (EraPlutusContext era, MonadFail m) =>
  Language ->
  m (SupportedLanguage era)
mkSupportedLanguageM :: forall era (m :: * -> *).
(EraPlutusContext era, MonadFail m) =>
Language -> m (SupportedLanguage era)
mkSupportedLanguageM Language
lang =
  case Language -> Maybe (SupportedLanguage era)
forall era.
EraPlutusContext era =>
Language -> Maybe (SupportedLanguage era)
mkSupportedLanguage Language
lang of
    Maybe (SupportedLanguage era)
Nothing -> [Char] -> m (SupportedLanguage era)
forall a. [Char] -> m a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char] -> m (SupportedLanguage era))
-> [Char] -> m (SupportedLanguage era)
forall a b. (a -> b) -> a -> b
$ Language -> [Char]
forall a. Show a => a -> [Char]
show Language
lang [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" language is not supported in " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ forall era. Era era => [Char]
eraName @era
    Just SupportedLanguage era
supportedLanguage -> SupportedLanguage era -> m (SupportedLanguage era)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SupportedLanguage era
supportedLanguage

-- | When collecting inputs for two phase scripts, these are the things that can go wrong.
data CollectError era
  = NoRedeemer !(PlutusPurpose AsItem era)
  | NoWitness !ScriptHash
  | NoCostModel !Language
  | BadTranslation !(ContextError era)
  deriving ((forall x. CollectError era -> Rep (CollectError era) x)
-> (forall x. Rep (CollectError era) x -> CollectError era)
-> Generic (CollectError era)
forall x. Rep (CollectError era) x -> CollectError era
forall x. CollectError era -> Rep (CollectError era) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall era x. Rep (CollectError era) x -> CollectError era
forall era x. CollectError era -> Rep (CollectError era) x
$cfrom :: forall era x. CollectError era -> Rep (CollectError era) x
from :: forall x. CollectError era -> Rep (CollectError era) x
$cto :: forall era x. Rep (CollectError era) x -> CollectError era
to :: forall x. Rep (CollectError era) x -> CollectError era
Generic)

deriving instance
  (AlonzoEraScript era, Eq (ContextError era)) =>
  Eq (CollectError era)

deriving instance
  (AlonzoEraScript era, Show (ContextError era)) =>
  Show (CollectError era)

instance
  (AlonzoEraScript era, NFData (ContextError era)) =>
  NFData (CollectError era)

instance (AlonzoEraScript era, EncCBOR (ContextError era)) => EncCBOR (CollectError era) where
  encCBOR :: CollectError era -> Encoding
encCBOR (NoRedeemer PlutusPurpose AsItem era
x) = Encode Open (CollectError era) -> Encoding
forall (w :: Wrapped) t. Encode w t -> Encoding
encode (Encode Open (CollectError era) -> Encoding)
-> Encode Open (CollectError era) -> Encoding
forall a b. (a -> b) -> a -> b
$ (PlutusPurpose AsItem era -> CollectError era)
-> Word
-> Encode Open (PlutusPurpose AsItem era -> CollectError era)
forall t. t -> Word -> Encode Open t
Sum PlutusPurpose AsItem era -> CollectError era
forall era. PlutusPurpose AsItem era -> CollectError era
NoRedeemer Word
0 Encode Open (PlutusPurpose AsItem era -> CollectError era)
-> Encode (Closed Dense) (PlutusPurpose AsItem era)
-> Encode Open (CollectError era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode (Closed r) a -> Encode w t
!> PlutusPurpose AsItem era
-> Encode (Closed Dense) (PlutusPurpose AsItem era)
forall t. EncCBOR t => t -> Encode (Closed Dense) t
To PlutusPurpose AsItem era
x
  encCBOR (NoWitness ScriptHash
x) = Encode Open (CollectError era) -> Encoding
forall (w :: Wrapped) t. Encode w t -> Encoding
encode (Encode Open (CollectError era) -> Encoding)
-> Encode Open (CollectError era) -> Encoding
forall a b. (a -> b) -> a -> b
$ (ScriptHash -> CollectError era)
-> Word -> Encode Open (ScriptHash -> CollectError era)
forall t. t -> Word -> Encode Open t
Sum (forall era. ScriptHash -> CollectError era
NoWitness @era) Word
1 Encode Open (ScriptHash -> CollectError era)
-> Encode (Closed Dense) ScriptHash
-> Encode Open (CollectError era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode (Closed r) a -> Encode w t
!> ScriptHash -> Encode (Closed Dense) ScriptHash
forall t. EncCBOR t => t -> Encode (Closed Dense) t
To ScriptHash
x
  encCBOR (NoCostModel Language
x) = Encode Open (CollectError (ZonkAny 4)) -> Encoding
forall (w :: Wrapped) t. Encode w t -> Encoding
encode (Encode Open (CollectError (ZonkAny 4)) -> Encoding)
-> Encode Open (CollectError (ZonkAny 4)) -> Encoding
forall a b. (a -> b) -> a -> b
$ (Language -> CollectError (ZonkAny 4))
-> Word -> Encode Open (Language -> CollectError (ZonkAny 4))
forall t. t -> Word -> Encode Open t
Sum Language -> CollectError (ZonkAny 4)
forall era. Language -> CollectError era
NoCostModel Word
2 Encode Open (Language -> CollectError (ZonkAny 4))
-> Encode (Closed Dense) Language
-> Encode Open (CollectError (ZonkAny 4))
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode (Closed r) a -> Encode w t
!> Language -> Encode (Closed Dense) Language
forall t. EncCBOR t => t -> Encode (Closed Dense) t
To Language
x
  encCBOR (BadTranslation ContextError era
x) = Encode Open (CollectError era) -> Encoding
forall (w :: Wrapped) t. Encode w t -> Encoding
encode (Encode Open (CollectError era) -> Encoding)
-> Encode Open (CollectError era) -> Encoding
forall a b. (a -> b) -> a -> b
$ (ContextError era -> CollectError era)
-> Word -> Encode Open (ContextError era -> CollectError era)
forall t. t -> Word -> Encode Open t
Sum (forall era. ContextError era -> CollectError era
BadTranslation @era) Word
3 Encode Open (ContextError era -> CollectError era)
-> Encode (Closed Dense) (ContextError era)
-> Encode Open (CollectError era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode (Closed r) a -> Encode w t
!> ContextError era -> Encode (Closed Dense) (ContextError era)
forall t. EncCBOR t => t -> Encode (Closed Dense) t
To ContextError era
x

instance (AlonzoEraScript era, DecCBOR (ContextError era)) => DecCBOR (CollectError era) where
  decCBOR :: forall s. Decoder s (CollectError era)
decCBOR = Decode (Closed Dense) (CollectError era)
-> Decoder s (CollectError era)
forall t (w :: Wrapped) s. Typeable t => Decode w t -> Decoder s t
decode (Text
-> (Word -> Decode Open (CollectError era))
-> Decode (Closed Dense) (CollectError era)
forall t.
Text -> (Word -> Decode Open t) -> Decode (Closed Dense) t
Summands Text
"CollectError" Word -> Decode Open (CollectError era)
forall {era}.
(DecCBOR (PlutusPurpose AsItem era), DecCBOR (ContextError era)) =>
Word -> Decode Open (CollectError era)
dec)
    where
      dec :: Word -> Decode Open (CollectError era)
dec Word
0 = (PlutusPurpose AsItem era -> CollectError era)
-> Decode Open (PlutusPurpose AsItem era -> CollectError era)
forall t. t -> Decode Open t
SumD PlutusPurpose AsItem era -> CollectError era
forall era. PlutusPurpose AsItem era -> CollectError era
NoRedeemer Decode Open (PlutusPurpose AsItem era -> CollectError era)
-> Decode (Closed (ZonkAny 0)) (PlutusPurpose AsItem era)
-> Decode Open (CollectError era)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode (Closed w) a -> Decode w1 t
<! Decode (Closed (ZonkAny 0)) (PlutusPurpose AsItem era)
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
      dec Word
1 = (ScriptHash -> CollectError era)
-> Decode Open (ScriptHash -> CollectError era)
forall t. t -> Decode Open t
SumD ScriptHash -> CollectError era
forall era. ScriptHash -> CollectError era
NoWitness Decode Open (ScriptHash -> CollectError era)
-> Decode (Closed (ZonkAny 1)) ScriptHash
-> Decode Open (CollectError era)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode (Closed w) a -> Decode w1 t
<! Decode (Closed (ZonkAny 1)) ScriptHash
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
      dec Word
2 = (Language -> CollectError era)
-> Decode Open (Language -> CollectError era)
forall t. t -> Decode Open t
SumD Language -> CollectError era
forall era. Language -> CollectError era
NoCostModel Decode Open (Language -> CollectError era)
-> Decode (Closed (ZonkAny 2)) Language
-> Decode Open (CollectError era)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode (Closed w) a -> Decode w1 t
<! Decode (Closed (ZonkAny 2)) Language
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
      dec Word
3 = (ContextError era -> CollectError era)
-> Decode Open (ContextError era -> CollectError era)
forall t. t -> Decode Open t
SumD ContextError era -> CollectError era
forall era. ContextError era -> CollectError era
BadTranslation Decode Open (ContextError era -> CollectError era)
-> Decode (Closed (ZonkAny 3)) (ContextError era)
-> Decode Open (CollectError era)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode (Closed w) a -> Decode w1 t
<! Decode (Closed (ZonkAny 3)) (ContextError era)
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
      dec Word
n = Word -> Decode Open (CollectError era)
forall (w :: Wrapped) t. Word -> Decode w t
Invalid Word
n

instance
  ( Era era
  , ToJSON (PlutusPurpose AsItem era)
  , ToJSON (ContextError era)
  ) =>
  ToJSON (CollectError era)
  where
  toJSON :: CollectError era -> Value
toJSON = \case
    NoRedeemer PlutusPurpose AsItem era
sPurpose ->
      Text -> [Pair] -> Value
kindObject Text
"CollectError" ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$
        [ Key
"error" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"NoRedeemer"
        , Key
"plutusPurpose" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= PlutusPurpose AsItem era -> Value
forall a. ToJSON a => a -> Value
toJSON PlutusPurpose AsItem era
sPurpose
        ]
    NoWitness ScriptHash
sHash ->
      Text -> [Pair] -> Value
kindObject Text
"CollectError" ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$
        [ Key
"error" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"NoWitness"
        , Key
"scriptHash" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= ScriptHash -> Value
forall a. ToJSON a => a -> Value
toJSON ScriptHash
sHash
        ]
    NoCostModel Language
lang ->
      Text -> [Pair] -> Value
kindObject Text
"CollectError" ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$
        [ Key
"error" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"NoCostModel"
        , Key
"language" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Language -> Value
forall a. ToJSON a => a -> Value
toJSON Language
lang
        ]
    BadTranslation ContextError era
err ->
      Text -> [Pair] -> Value
kindObject Text
"BadTranslation" [Key
"error" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= ContextError era -> Value
forall a. ToJSON a => a -> Value
toJSON ContextError era
err]