{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MonoLocalBinds #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wno-orphans #-}

module Test.Cardano.Ledger.Alonzo.TreeDiff (
  module Test.Cardano.Ledger.Mary.TreeDiff,
) where

import Cardano.Ledger.Alonzo (AlonzoEra)
import Cardano.Ledger.Alonzo.Core
import Cardano.Ledger.Alonzo.PParams
import Cardano.Ledger.Alonzo.Plutus.Context
import Cardano.Ledger.Alonzo.Plutus.Evaluate
import Cardano.Ledger.Alonzo.Plutus.TxInfo
import Cardano.Ledger.Alonzo.Rules
import Cardano.Ledger.Alonzo.Scripts
import Cardano.Ledger.Alonzo.Tx
import Cardano.Ledger.Alonzo.TxAuxData
import Cardano.Ledger.Alonzo.TxBody
import Cardano.Ledger.Alonzo.TxWits
import Cardano.Ledger.Alonzo.UTxO
import Cardano.Ledger.BaseTypes
import Cardano.Ledger.Compactible
import Cardano.Ledger.Plutus.Evaluate (PlutusWithContext (..))
import Cardano.Ledger.Shelley.Rules
import qualified Data.TreeDiff.OMap as OMap
import PlutusLedgerApi.Common (EvaluationError (..), ExBudget, ExCPU, ExMemory, SatInt)
import Test.Cardano.Ledger.Mary.TreeDiff

-- Scripts
instance ToExpr (PlutusScript AlonzoEra)

instance (ToExpr (PlutusScript era), ToExpr (NativeScript era)) => ToExpr (AlonzoScript era)

instance ToExpr (AlonzoPlutusPurpose AsIx era)

instance ToExpr (TxCert era) => ToExpr (AlonzoPlutusPurpose AsItem era)

deriving newtype instance ToExpr ix => ToExpr (AsIx ix it)

deriving newtype instance ToExpr it => ToExpr (AsItem ix it)

instance (ToExpr ix, ToExpr it) => ToExpr (AsIxItem ix it)

instance ToExpr (PlutusPurpose AsIxItem era) => ToExpr (AlonzoScriptsNeeded era)

instance ToExpr (TxCert era) => ToExpr (AlonzoPlutusPurpose AsIxItem era)

-- Core
deriving newtype instance ToExpr CoinPerWord

-- TxAuxData
instance ToExpr (NativeScript era) => ToExpr (AlonzoTxAuxDataRaw era)

instance ToExpr (NativeScript era) => ToExpr (AlonzoTxAuxData era)

-- PParams
deriving newtype instance ToExpr OrdExUnits

instance ToExpr (AlonzoPParams StrictMaybe era)

instance ToExpr (AlonzoPParams Identity era)

-- TxWits
instance ToExpr (PlutusPurpose AsIx era) => ToExpr (RedeemersRaw era)

instance ToExpr (PlutusPurpose AsIx era) => ToExpr (Redeemers era)

instance
  ( Era era
  , ToExpr (TxDats era)
  , ToExpr (Redeemers era)
  , ToExpr (Script era)
  ) =>
  ToExpr (AlonzoTxWitsRaw era)

instance
  ( Era era
  , ToExpr (TxDats era)
  , ToExpr (Redeemers era)
  , ToExpr (Script era)
  ) =>
  ToExpr (AlonzoTxWits era)

instance ToExpr (Data era) => ToExpr (TxDatsRaw era)

instance ToExpr (Data era) => ToExpr (TxDats era)

-- TxOut
instance ToExpr Addr28Extra

instance ToExpr DataHash32

instance ToExpr (CompactForm (Value era)) => ToExpr (AlonzoTxOut era)

-- TxBody
instance ToExpr (AlonzoTxBodyRaw TopTx AlonzoEra) where
  toExpr :: AlonzoTxBodyRaw TopTx AlonzoEra -> Expr
toExpr AlonzoTxBodyRaw {Set (KeyHash Guard)
Set TxIn
StrictMaybe ScriptIntegrityHash
StrictMaybe TxAuxDataHash
StrictMaybe Network
StrictMaybe (Update AlonzoEra)
ValidityInterval
Withdrawals
Coin
MultiAsset
StrictSeq (TxOut AlonzoEra)
StrictSeq (TxCert AlonzoEra)
atbrInputs :: Set TxIn
atbrCollateral :: Set TxIn
atbrOutputs :: StrictSeq (TxOut AlonzoEra)
atbrCerts :: StrictSeq (TxCert AlonzoEra)
atbrWithdrawals :: Withdrawals
atbrTxFee :: Coin
atbrValidityInterval :: ValidityInterval
atbrUpdate :: StrictMaybe (Update AlonzoEra)
atbrReqSignerHashes :: Set (KeyHash Guard)
atbrMint :: MultiAsset
atbrScriptIntegrityHash :: StrictMaybe ScriptIntegrityHash
atbrAuxDataHash :: StrictMaybe TxAuxDataHash
atbrTxNetworkId :: StrictMaybe Network
atbrTxNetworkId :: forall era. AlonzoTxBodyRaw TopTx era -> StrictMaybe Network
atbrAuxDataHash :: forall era. AlonzoTxBodyRaw TopTx era -> StrictMaybe TxAuxDataHash
atbrScriptIntegrityHash :: forall era.
AlonzoTxBodyRaw TopTx era -> StrictMaybe ScriptIntegrityHash
atbrMint :: forall era. AlonzoTxBodyRaw TopTx era -> MultiAsset
atbrReqSignerHashes :: forall era. AlonzoTxBodyRaw TopTx era -> Set (KeyHash Guard)
atbrUpdate :: forall era. AlonzoTxBodyRaw TopTx era -> StrictMaybe (Update era)
atbrValidityInterval :: forall era. AlonzoTxBodyRaw TopTx era -> ValidityInterval
atbrTxFee :: forall era. AlonzoTxBodyRaw TopTx era -> Coin
atbrWithdrawals :: forall era. AlonzoTxBodyRaw TopTx era -> Withdrawals
atbrCerts :: forall era. AlonzoTxBodyRaw TopTx era -> StrictSeq (TxCert era)
atbrOutputs :: forall era. AlonzoTxBodyRaw TopTx era -> StrictSeq (TxOut era)
atbrCollateral :: forall era. AlonzoTxBodyRaw TopTx era -> Set TxIn
atbrInputs :: forall era. AlonzoTxBodyRaw TopTx era -> Set TxIn
..} =
    FieldName -> OMap FieldName Expr -> Expr
Rec FieldName
"AlonzoTxBodyRaw" (OMap FieldName Expr -> Expr) -> OMap FieldName Expr -> Expr
forall a b. (a -> b) -> a -> b
$
      [(FieldName, Expr)] -> OMap FieldName Expr
forall k v. Ord k => [(k, v)] -> OMap k v
OMap.fromList
        [ (FieldName
"atbrInputs", Set TxIn -> Expr
forall a. ToExpr a => a -> Expr
toExpr Set TxIn
atbrInputs)
        , (FieldName
"atbrCollateral", Set TxIn -> Expr
forall a. ToExpr a => a -> Expr
toExpr Set TxIn
atbrCollateral)
        , (FieldName
"atbrOutputs", StrictSeq (AlonzoTxOut AlonzoEra) -> Expr
forall a. ToExpr a => a -> Expr
toExpr StrictSeq (TxOut AlonzoEra)
StrictSeq (AlonzoTxOut AlonzoEra)
atbrOutputs)
        , (FieldName
"atbrCerts", StrictSeq (ShelleyTxCert AlonzoEra) -> Expr
forall a. ToExpr a => a -> Expr
toExpr StrictSeq (TxCert AlonzoEra)
StrictSeq (ShelleyTxCert AlonzoEra)
atbrCerts)
        , (FieldName
"atbrWithdrawals", Withdrawals -> Expr
forall a. ToExpr a => a -> Expr
toExpr Withdrawals
atbrWithdrawals)
        , (FieldName
"atbrTxFee", Coin -> Expr
forall a. ToExpr a => a -> Expr
toExpr Coin
atbrTxFee)
        , (FieldName
"atbrValidityInterval", ValidityInterval -> Expr
forall a. ToExpr a => a -> Expr
toExpr ValidityInterval
atbrValidityInterval)
        , (FieldName
"atbrUpdate", StrictMaybe (Update AlonzoEra) -> Expr
forall a. ToExpr a => a -> Expr
toExpr StrictMaybe (Update AlonzoEra)
atbrUpdate)
        , (FieldName
"atbrReqSignerHashes", Set (KeyHash Guard) -> Expr
forall a. ToExpr a => a -> Expr
toExpr Set (KeyHash Guard)
atbrReqSignerHashes)
        , (FieldName
"atbrMint", MultiAsset -> Expr
forall a. ToExpr a => a -> Expr
toExpr MultiAsset
atbrMint)
        , (FieldName
"atbrScriptIntegrityHash", StrictMaybe ScriptIntegrityHash -> Expr
forall a. ToExpr a => a -> Expr
toExpr StrictMaybe ScriptIntegrityHash
atbrScriptIntegrityHash)
        , (FieldName
"atbrAuxDataHash", StrictMaybe TxAuxDataHash -> Expr
forall a. ToExpr a => a -> Expr
toExpr StrictMaybe TxAuxDataHash
atbrAuxDataHash)
        , (FieldName
"atbrTxNetworkId", StrictMaybe Network -> Expr
forall a. ToExpr a => a -> Expr
toExpr StrictMaybe Network
atbrTxNetworkId)
        ]

instance ToExpr (TxBody TopTx AlonzoEra)

-- Tx
instance ToExpr IsValid

instance
  (ToExpr (TxBody TopTx era), ToExpr (TxWits era), ToExpr (TxAuxData era)) =>
  ToExpr (AlonzoTx TopTx era)
  where
  toExpr :: AlonzoTx TopTx era -> Expr
toExpr AlonzoTx {StrictMaybe (TxAuxData era)
TxBody TopTx era
TxWits era
IsValid
atBody :: TxBody TopTx era
atWits :: TxWits era
atIsValid :: IsValid
atAuxData :: StrictMaybe (TxAuxData era)
atAuxData :: forall era. AlonzoTx TopTx era -> StrictMaybe (TxAuxData era)
atIsValid :: forall era. AlonzoTx TopTx era -> IsValid
atWits :: forall era. AlonzoTx TopTx era -> TxWits era
atBody :: forall era. AlonzoTx TopTx era -> TxBody TopTx era
..} =
    FieldName -> OMap FieldName Expr -> Expr
Rec FieldName
"AlonzoTx" (OMap FieldName Expr -> Expr) -> OMap FieldName Expr -> Expr
forall a b. (a -> b) -> a -> b
$
      [(FieldName, Expr)] -> OMap FieldName Expr
forall k v. Ord k => [(k, v)] -> OMap k v
OMap.fromList
        [ (FieldName
"atBody", TxBody TopTx era -> Expr
forall a. ToExpr a => a -> Expr
toExpr TxBody TopTx era
atBody)
        , (FieldName
"atWits", TxWits era -> Expr
forall a. ToExpr a => a -> Expr
toExpr TxWits era
atWits)
        , (FieldName
"atIsValid", IsValid -> Expr
forall a. ToExpr a => a -> Expr
toExpr IsValid
atIsValid)
        , (FieldName
"atAuxData", StrictMaybe (TxAuxData era) -> Expr
forall a. ToExpr a => a -> Expr
toExpr StrictMaybe (TxAuxData era)
atAuxData)
        ]

-- Plutus/TxInfo
instance ToExpr (AlonzoContextError era)

instance
  ( ToExpr (ContextError era)
  , ToExpr (PlutusPurpose AsItem era)
  , ToExpr (TxCert era)
  ) =>
  ToExpr (CollectError era)

-- Rules/Utxo
instance
  ( ToExpr (Value era)
  , ToExpr (TxOut era)
  , ToExpr (PredicateFailure (EraRule "UTXOS" era))
  ) =>
  ToExpr (AlonzoUtxoPredFailure era)

-- Rules/Utxos
instance ToExpr FailureDescription

instance ToExpr TagMismatchDescription

instance
  ( ToExpr (PlutusPurpose AsItem era)
  , ToExpr (EraRuleFailure "PPUP" era)
  , ToExpr (ContextError era)
  , ToExpr (TxCert era)
  ) =>
  ToExpr (AlonzoUtxosPredFailure era)

-- Rules/Utxow
instance
  ( Era era
  , ToExpr (PlutusPurpose AsIx era)
  , ToExpr (PlutusPurpose AsItem era)
  , ToExpr (PredicateFailure (EraRule "UTXO" era))
  , ToExpr (TxCert era)
  ) =>
  ToExpr (AlonzoUtxowPredFailure era)

instance ToExpr (Event (EraRule "UTXO" era)) => ToExpr (AlonzoUtxowEvent era)

instance ToExpr (Event (EraRule "UTXOS" era)) => ToExpr (AlonzoUtxoEvent era)

instance
  ( ToExpr (EraRuleEvent "PPUP" era)
  , ToExpr (TxOut era)
  , ToExpr PlutusWithContext
  ) =>
  ToExpr (AlonzoUtxosEvent era)

instance
  ToExpr ScriptHash =>
  ToExpr PlutusWithContext
  where
  toExpr :: PlutusWithContext -> Expr
toExpr PlutusWithContext {Either (Plutus l) (PlutusRunnable l)
ScriptHash
CostModel
ExUnits
Version
PlutusArgs l
pwcProtocolVersion :: Version
pwcScript :: Either (Plutus l) (PlutusRunnable l)
pwcScriptHash :: ScriptHash
pwcArgs :: PlutusArgs l
pwcExUnits :: ExUnits
pwcCostModel :: CostModel
pwcCostModel :: PlutusWithContext -> CostModel
pwcExUnits :: PlutusWithContext -> ExUnits
pwcArgs :: ()
pwcScriptHash :: PlutusWithContext -> ScriptHash
pwcScript :: ()
pwcProtocolVersion :: PlutusWithContext -> Version
..} =
    FieldName -> OMap FieldName Expr -> Expr
Rec FieldName
"PlutusWithContext" (OMap FieldName Expr -> Expr) -> OMap FieldName Expr -> Expr
forall a b. (a -> b) -> a -> b
$
      [(FieldName, Expr)] -> OMap FieldName Expr
forall k v. Ord k => [(k, v)] -> OMap k v
OMap.fromList
        [ (FieldName
"pwcProtocolVersion", Version -> Expr
forall a. ToExpr a => a -> Expr
toExpr Version
pwcProtocolVersion)
        , (FieldName
"pwcScriptHash", ScriptHash -> Expr
forall a. ToExpr a => a -> Expr
toExpr ScriptHash
pwcScriptHash)
        , (FieldName
"pwcExUnits", ExUnits -> Expr
forall a. ToExpr a => a -> Expr
toExpr ExUnits
pwcExUnits)
        , (FieldName
"pwcCostModel", CostModel -> Expr
forall a. ToExpr a => a -> Expr
toExpr CostModel
pwcCostModel)
        ]

instance
  ToExpr (PredicateFailure (EraRule "LEDGERS" era)) =>
  ToExpr (AlonzoBbodyPredFailure era)

instance
  ToExpr (Event (EraRule "LEDGERS" era)) =>
  ToExpr (AlonzoBbodyEvent era)

instance ToExpr EvaluationError where
  toExpr :: EvaluationError -> Expr
toExpr = FieldName -> Expr
forall a. ToExpr a => a -> Expr
toExpr (FieldName -> Expr)
-> (EvaluationError -> FieldName) -> EvaluationError -> Expr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EvaluationError -> FieldName
forall a. Show a => a -> FieldName
show

instance ToExpr SatInt

instance ToExpr ExCPU

instance ToExpr ExMemory

instance ToExpr ExBudget

instance
  ( ToExpr (PlutusPurpose AsIx era)
  , ToExpr (PlutusPurpose AsItem era)
  , ToExpr (PlutusScript era)
  , ToExpr (ContextError era)
  ) =>
  ToExpr (TransactionScriptFailure era)

deriving newtype instance ToExpr (Tx TopTx AlonzoEra)