{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE QuantifiedConstraints #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wno-orphans #-}

module Test.Cardano.Ledger.Conway.TreeDiff (
  module Test.Cardano.Ledger.Babbage.TreeDiff,
) where

import Cardano.Ledger.Alonzo.Plutus.Context (ContextError)
import Cardano.Ledger.BaseTypes
import Cardano.Ledger.Conway (ConwayEra)
import Cardano.Ledger.Conway.Core
import Cardano.Ledger.Conway.Governance
import Cardano.Ledger.Conway.PParams
import Cardano.Ledger.Conway.Rules
import Cardano.Ledger.Conway.Scripts
import Cardano.Ledger.Conway.State
import Cardano.Ledger.Conway.TxBody
import Cardano.Ledger.Conway.TxCert
import Cardano.Ledger.Conway.TxInfo (ConwayContextError)
import Cardano.Ledger.HKD
import Control.State.Transition.Extended (STS (..))
import Data.Functor.Identity
import qualified Data.TreeDiff.OMap as OMap
import Test.Cardano.Data.TreeDiff ()
import Test.Cardano.Ledger.Babbage.TreeDiff

-- Core
instance ToExpr PoolVotingThresholds

instance ToExpr DRepVotingThresholds

-- Scripts
instance ToExpr (PlutusScript ConwayEra)

instance ToExpr (ConwayPlutusPurpose AsIx era)

instance
  ( Era era
  , ToExpr (TxCert era)
  , ToExpr (PParamsHKD StrictMaybe era)
  ) =>
  ToExpr (ConwayPlutusPurpose AsItem era)

instance
  ( ToExpr (TxCert era)
  , ToExpr (PParamsHKD StrictMaybe era)
  ) =>
  ToExpr (ConwayPlutusPurpose AsIxItem era)

-- PlutusContext
instance
  ( Era era
  , ToExpr (PParamsHKD StrictMaybe era)
  , ToExpr (TxCert era)
  , ToExpr (PlutusPurpose AsIx era)
  , ToExpr (PlutusPurpose AsItem era)
  ) =>
  ToExpr (ConwayContextError era)

-- Governance/Procedure
instance ToExpr GovActionIx

instance ToExpr GovActionId

instance ToExpr (PParamsHKD StrictMaybe era) => ToExpr (GovActionState era)

instance ToExpr Voter

instance ToExpr Vote

instance Era era => ToExpr (VotingProcedures era)

instance ToExpr (VotingProcedure era)

instance ToExpr (PParamsHKD StrictMaybe era) => ToExpr (ProposalProcedure era)

instance ToExpr (Committee era)

instance ToExpr (GovPurposeId purpose)

instance ToExpr (PParamsHKD StrictMaybe era) => ToExpr (GovAction era)

-- Governance/Proposals
instance ToExpr a => ToExpr (PRoot a)

instance ToExpr a => ToExpr (PEdges a)

instance ToExpr a => ToExpr (PGraph a)

instance
  (forall p. ToExpr (f (GovPurposeId (p :: GovActionPurpose)))) =>
  ToExpr (GovRelation f)

instance (Era era, ToExpr (PParamsHKD StrictMaybe era)) => ToExpr (Proposals era)

-- PParams
instance ToExpr (HKD f a) => ToExpr (THKD t f a) where
  toExpr :: THKD t f a -> Expr
toExpr = HKD f a -> Expr
forall a. ToExpr a => a -> Expr
toExpr (HKD f a -> Expr) -> (THKD t f a -> HKD f a) -> THKD t f a -> Expr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. THKD t f a -> HKD f a
forall (t :: PPGroups) (f :: * -> *) a. THKD t f a -> HKD f a
unTHKD

instance ToExpr (ConwayPParams Identity era)

instance ToExpr (ConwayPParams StrictMaybe era)

instance ToExpr (ConwayInstantStake era)

-- Governance
instance (EraPParams era, ToExpr (PParamsHKD StrictMaybe era)) => ToExpr (PulsingSnapshot era)

instance (Era era, ToExpr (PParams era)) => ToExpr (EnactState era)

instance
  ( EraPParams era
  , ToExpr (PParams era)
  , ToExpr (PParamsHKD StrictMaybe era)
  ) =>
  ToExpr (RatifyState era)

instance
  ( EraStake era
  , EraPParams era
  , ConwayEraAccounts era
  , ToExpr (PParams era)
  , ToExpr (PParamsHKD StrictMaybe era)
  ) =>
  ToExpr (ConwayGovState era)

instance
  ( EraStake era
  , EraPParams era
  , ConwayEraAccounts era
  , ToExpr (PParamsHKD StrictMaybe era)
  , ToExpr (PParams era)
  ) =>
  ToExpr (DRepPulsingState era)
  where
  toExpr :: DRepPulsingState era -> Expr
toExpr (DRComplete PulsingSnapshot era
x RatifyState era
y) = ConstructorName -> [Expr] -> Expr
App ConstructorName
"DRComplete" [PulsingSnapshot era -> Expr
forall a. ToExpr a => a -> Expr
toExpr PulsingSnapshot era
x, RatifyState era -> Expr
forall a. ToExpr a => a -> Expr
toExpr RatifyState era
y]
  toExpr x :: DRepPulsingState era
x@(DRPulsing (DRepPulser {})) = ConstructorName -> [Expr] -> Expr
App ConstructorName
"DRComplete" [PulsingSnapshot era -> Expr
forall a. ToExpr a => a -> Expr
toExpr PulsingSnapshot era
a, RatifyState era -> Expr
forall a. ToExpr a => a -> Expr
toExpr RatifyState era
b]
    where
      (PulsingSnapshot era
a, RatifyState era
b) = DRepPulsingState era -> (PulsingSnapshot era, RatifyState era)
forall era.
(EraStake era, ConwayEraAccounts era) =>
DRepPulsingState era -> (PulsingSnapshot era, RatifyState era)
finishDRepPulser DRepPulsingState era
x

instance
  ( EraStake era
  , EraPParams era
  , ConwayEraAccounts era
  , ToExpr (DRepPulsingState era)
  , ToExpr (RatifyState era)
  , ToExpr (PParamsHKD StrictMaybe era)
  ) =>
  ToExpr (DRepPulser era Identity (RatifyState era))
  where
  toExpr :: DRepPulser era Identity (RatifyState era) -> Expr
toExpr = (PulsingSnapshot era, RatifyState era) -> Expr
forall a. ToExpr a => a -> Expr
toExpr ((PulsingSnapshot era, RatifyState era) -> Expr)
-> (DRepPulser era Identity (RatifyState era)
    -> (PulsingSnapshot era, RatifyState era))
-> DRepPulser era Identity (RatifyState era)
-> Expr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DRepPulsingState era -> (PulsingSnapshot era, RatifyState era)
forall era.
(EraStake era, ConwayEraAccounts era) =>
DRepPulsingState era -> (PulsingSnapshot era, RatifyState era)
finishDRepPulser (DRepPulsingState era -> (PulsingSnapshot era, RatifyState era))
-> (DRepPulser era Identity (RatifyState era)
    -> DRepPulsingState era)
-> DRepPulser era Identity (RatifyState era)
-> (PulsingSnapshot era, RatifyState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DRepPulser era Identity (RatifyState era) -> DRepPulsingState era
forall era.
DRepPulser era Identity (RatifyState era) -> DRepPulsingState era
DRPulsing

instance (ToExpr (InstantStake era), ToExpr (Accounts era)) => ToExpr (RatifyEnv era) where
  toExpr :: RatifyEnv era -> Expr
toExpr (RatifyEnv InstantStake era
stake PoolDistr
pool Map DRep (CompactForm Coin)
drep Map (Credential DRepRole) DRepState
dstate EpochNo
ep CommitteeState era
cs Accounts era
delegatees Map (KeyHash StakePool) StakePoolState
poolps) =
    ConstructorName -> [Expr] -> Expr
App
      ConstructorName
"RatifyEnv"
      [ InstantStake era -> Expr
forall a. ToExpr a => a -> Expr
toExpr InstantStake era
stake
      , PoolDistr -> Expr
forall a. ToExpr a => a -> Expr
toExpr PoolDistr
pool
      , Map DRep (CompactForm Coin) -> Expr
forall a. ToExpr a => a -> Expr
toExpr Map DRep (CompactForm Coin)
drep
      , Map (Credential DRepRole) DRepState -> Expr
forall a. ToExpr a => a -> Expr
toExpr Map (Credential DRepRole) DRepState
dstate
      , EpochNo -> Expr
forall a. ToExpr a => a -> Expr
toExpr EpochNo
ep
      , CommitteeState era -> Expr
forall a. ToExpr a => a -> Expr
toExpr CommitteeState era
cs
      , Accounts era -> Expr
forall a. ToExpr a => a -> Expr
toExpr Accounts era
delegatees
      , Map (KeyHash StakePool) StakePoolState -> Expr
forall a. ToExpr a => a -> Expr
toExpr Map (KeyHash StakePool) StakePoolState
poolps
      ]

-- Rules/Gov
instance (EraPParams era, ToExpr (PParamsHKD StrictMaybe era)) => ToExpr (ConwayGovPredFailure era)

-- TxCert
instance ToExpr Delegatee

instance ToExpr ConwayDelegCert

instance ToExpr ConwayGovCert

instance ToExpr (ConwayTxCert era)

-- Rules
instance ToExpr (ConwayGovCertPredFailure era)

instance ToExpr (ConwayDelegPredFailure era)

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

-- TxBody
instance ToExpr (ConwayTxBodyRaw TopTx ConwayEra) where
  toExpr :: ConwayTxBodyRaw TopTx ConwayEra -> Expr
toExpr ConwayTxBodyRaw {OSet (TxCert ConwayEra)
OSet (ProposalProcedure ConwayEra)
Set (KeyHash Guard)
Set TxIn
StrictMaybe ScriptIntegrityHash
StrictMaybe TxAuxDataHash
StrictMaybe (Sized (TxOut ConwayEra))
StrictMaybe Coin
StrictMaybe Network
ValidityInterval
Withdrawals
VotingProcedures ConwayEra
Coin
MultiAsset
StrictSeq (Sized (TxOut ConwayEra))
ctbrSpendInputs :: Set TxIn
ctbrCollateralInputs :: Set TxIn
ctbrReferenceInputs :: Set TxIn
ctbrOutputs :: StrictSeq (Sized (TxOut ConwayEra))
ctbrCollateralReturn :: StrictMaybe (Sized (TxOut ConwayEra))
ctbrTotalCollateral :: StrictMaybe Coin
ctbrCerts :: OSet (TxCert ConwayEra)
ctbrWithdrawals :: Withdrawals
ctbrFee :: Coin
ctbrVldt :: ValidityInterval
ctbrReqSignerHashes :: Set (KeyHash Guard)
ctbrMint :: MultiAsset
ctbrScriptIntegrityHash :: StrictMaybe ScriptIntegrityHash
ctbrAuxDataHash :: StrictMaybe TxAuxDataHash
ctbrNetworkId :: StrictMaybe Network
ctbrVotingProcedures :: VotingProcedures ConwayEra
ctbrProposalProcedures :: OSet (ProposalProcedure ConwayEra)
ctbrCurrentTreasuryValue :: StrictMaybe Coin
ctbrTreasuryDonation :: Coin
ctbrTreasuryDonation :: forall era. ConwayTxBodyRaw TopTx era -> Coin
ctbrCurrentTreasuryValue :: forall era. ConwayTxBodyRaw TopTx era -> StrictMaybe Coin
ctbrProposalProcedures :: forall era.
ConwayTxBodyRaw TopTx era -> OSet (ProposalProcedure era)
ctbrVotingProcedures :: forall era. ConwayTxBodyRaw TopTx era -> VotingProcedures era
ctbrNetworkId :: forall era. ConwayTxBodyRaw TopTx era -> StrictMaybe Network
ctbrAuxDataHash :: forall era. ConwayTxBodyRaw TopTx era -> StrictMaybe TxAuxDataHash
ctbrScriptIntegrityHash :: forall era.
ConwayTxBodyRaw TopTx era -> StrictMaybe ScriptIntegrityHash
ctbrMint :: forall era. ConwayTxBodyRaw TopTx era -> MultiAsset
ctbrReqSignerHashes :: forall era. ConwayTxBodyRaw TopTx era -> Set (KeyHash Guard)
ctbrVldt :: forall era. ConwayTxBodyRaw TopTx era -> ValidityInterval
ctbrFee :: forall era. ConwayTxBodyRaw TopTx era -> Coin
ctbrWithdrawals :: forall era. ConwayTxBodyRaw TopTx era -> Withdrawals
ctbrCerts :: forall era. ConwayTxBodyRaw TopTx era -> OSet (TxCert era)
ctbrTotalCollateral :: forall era. ConwayTxBodyRaw TopTx era -> StrictMaybe Coin
ctbrCollateralReturn :: forall era.
ConwayTxBodyRaw TopTx era -> StrictMaybe (Sized (TxOut era))
ctbrOutputs :: forall era.
ConwayTxBodyRaw TopTx era -> StrictSeq (Sized (TxOut era))
ctbrReferenceInputs :: forall era. ConwayTxBodyRaw TopTx era -> Set TxIn
ctbrCollateralInputs :: forall era. ConwayTxBodyRaw TopTx era -> Set TxIn
ctbrSpendInputs :: forall era. ConwayTxBodyRaw TopTx era -> Set TxIn
..} =
    ConstructorName -> OMap ConstructorName Expr -> Expr
Rec ConstructorName
"ConwayTxBodyRaw" (OMap ConstructorName Expr -> Expr)
-> OMap ConstructorName Expr -> Expr
forall a b. (a -> b) -> a -> b
$
      [(ConstructorName, Expr)] -> OMap ConstructorName Expr
forall k v. Ord k => [(k, v)] -> OMap k v
OMap.fromList
        [ (ConstructorName
"ctbrSpendInputs", Set TxIn -> Expr
forall a. ToExpr a => a -> Expr
toExpr Set TxIn
ctbrSpendInputs)
        , (ConstructorName
"ctbrCollateralInputs", Set TxIn -> Expr
forall a. ToExpr a => a -> Expr
toExpr Set TxIn
ctbrCollateralInputs)
        , (ConstructorName
"ctbrReferenceInputs", Set TxIn -> Expr
forall a. ToExpr a => a -> Expr
toExpr Set TxIn
ctbrReferenceInputs)
        , (ConstructorName
"ctbrOutputs", StrictSeq (Sized (BabbageTxOut ConwayEra)) -> Expr
forall a. ToExpr a => a -> Expr
toExpr StrictSeq (Sized (TxOut ConwayEra))
StrictSeq (Sized (BabbageTxOut ConwayEra))
ctbrOutputs)
        , (ConstructorName
"ctbrCollateralReturn", StrictMaybe (Sized (BabbageTxOut ConwayEra)) -> Expr
forall a. ToExpr a => a -> Expr
toExpr StrictMaybe (Sized (TxOut ConwayEra))
StrictMaybe (Sized (BabbageTxOut ConwayEra))
ctbrCollateralReturn)
        , (ConstructorName
"ctbrTotalCollateral", StrictMaybe Coin -> Expr
forall a. ToExpr a => a -> Expr
toExpr StrictMaybe Coin
ctbrTotalCollateral)
        , (ConstructorName
"ctbrCerts", OSet (ConwayTxCert ConwayEra) -> Expr
forall a. ToExpr a => a -> Expr
toExpr OSet (TxCert ConwayEra)
OSet (ConwayTxCert ConwayEra)
ctbrCerts)
        , (ConstructorName
"ctbrWithdrawals", Withdrawals -> Expr
forall a. ToExpr a => a -> Expr
toExpr Withdrawals
ctbrWithdrawals)
        , (ConstructorName
"ctbrFee", Coin -> Expr
forall a. ToExpr a => a -> Expr
toExpr Coin
ctbrFee)
        , (ConstructorName
"ctbrVldt", ValidityInterval -> Expr
forall a. ToExpr a => a -> Expr
toExpr ValidityInterval
ctbrVldt)
        , (ConstructorName
"ctbrReqSignerHashes", Set (KeyHash Guard) -> Expr
forall a. ToExpr a => a -> Expr
toExpr Set (KeyHash Guard)
ctbrReqSignerHashes)
        , (ConstructorName
"ctbrMint", MultiAsset -> Expr
forall a. ToExpr a => a -> Expr
toExpr MultiAsset
ctbrMint)
        , (ConstructorName
"ctbrScriptIntegrityHash", StrictMaybe ScriptIntegrityHash -> Expr
forall a. ToExpr a => a -> Expr
toExpr StrictMaybe ScriptIntegrityHash
ctbrScriptIntegrityHash)
        , (ConstructorName
"ctbrAuxDataHash", StrictMaybe TxAuxDataHash -> Expr
forall a. ToExpr a => a -> Expr
toExpr StrictMaybe TxAuxDataHash
ctbrAuxDataHash)
        , (ConstructorName
"ctbrNetworkId", StrictMaybe Network -> Expr
forall a. ToExpr a => a -> Expr
toExpr StrictMaybe Network
ctbrNetworkId)
        , (ConstructorName
"ctbrVotingProcedures", VotingProcedures ConwayEra -> Expr
forall a. ToExpr a => a -> Expr
toExpr VotingProcedures ConwayEra
ctbrVotingProcedures)
        , (ConstructorName
"ctbrProposalProcedures", OSet (ProposalProcedure ConwayEra) -> Expr
forall a. ToExpr a => a -> Expr
toExpr OSet (ProposalProcedure ConwayEra)
ctbrProposalProcedures)
        , (ConstructorName
"ctbrCurrentTreasuryValue", StrictMaybe Coin -> Expr
forall a. ToExpr a => a -> Expr
toExpr StrictMaybe Coin
ctbrCurrentTreasuryValue)
        , (ConstructorName
"ctbrTreasuryDonation", Coin -> Expr
forall a. ToExpr a => a -> Expr
toExpr Coin
ctbrTreasuryDonation)
        ]

instance ToExpr (TxBody TopTx ConwayEra)

-- Rules/Cert
instance
  ( ToExpr (PredicateFailure (EraRule "DELEG" era))
  , ToExpr (PredicateFailure (EraRule "GOVCERT" era))
  , ToExpr (PredicateFailure (EraRule "POOL" era))
  ) =>
  ToExpr (ConwayCertPredFailure era)

-- Rules/Certs
instance
  ToExpr (PredicateFailure (EraRule "CERT" era)) =>
  ToExpr (ConwayCertsPredFailure era)

-- Rules/Ledger
instance
  ( ToExpr (PredicateFailure (EraRule "UTXOW" era))
  , ToExpr (PredicateFailure (EraRule "GOV" era))
  , ToExpr (PredicateFailure (EraRule "CERTS" era))
  ) =>
  ToExpr (ConwayLedgerPredFailure era)

instance ToExpr (Constitution era)

instance
  ( ToExpr (Event (EraRule "EPOCH" era))
  , ToExpr (Event (EraRule "RUPD" era))
  ) =>
  ToExpr (ConwayNewEpochEvent era)

instance ToExpr (ConwayHardForkEvent era)

instance
  ( EraPParams era
  , ToExpr (PParams era)
  , ToExpr (PParamsHKD StrictMaybe era)
  , ToExpr (Event (EraRule "POOLREAP" era))
  , ToExpr (Event (EraRule "SNAP" era))
  , ToExpr (Event (EraRule "HARDFORK" era))
  ) =>
  ToExpr (ConwayEpochEvent era)

instance
  ( ToExpr (Event (EraRule "CERTS" era))
  , ToExpr (Event (EraRule "UTXOW" era))
  , ToExpr (Event (EraRule "GOV" era))
  , ToExpr (Event (EraRule "MEMPOOL" era))
  ) =>
  ToExpr (ConwayLedgerEvent era)

instance
  ToExpr (Event (EraRule "CERT" era)) =>
  ToExpr (ConwayCertsEvent era)

instance
  ( ToExpr (Event (EraRule "DELEG" era))
  , ToExpr (Event (EraRule "GOVCERT" era))
  , ToExpr (Event (EraRule "POOL" era))
  ) =>
  ToExpr (ConwayCertEvent era)

instance ToExpr (TxOut era) => ToExpr (ConwayUtxosEvent era)

instance
  ( Era era
  , ToExpr (PParamsHKD StrictMaybe era)
  ) =>
  ToExpr (ConwayGovEvent era)

instance
  ( EraPParams era
  , ToExpr (PParamsHKD StrictMaybe era)
  , ToExpr (TxCert era)
  ) =>
  ToExpr (GovSignal era)

instance (ToExpr (PParams era), ToExpr (CertState era)) => ToExpr (GovEnv era)

instance
  ( ToExpr (PParams era)
  , ToExpr (PParamsHKD StrictMaybe era)
  ) =>
  ToExpr (ConwayGovCertEnv era)

instance
  ( ToExpr (Value era)
  , ToExpr (TxOut era)
  , ToExpr (PredicateFailure (EraRule "UTXOS" era))
  ) =>
  ToExpr (ConwayUtxoPredFailure era)

instance
  ( Era era
  , ToExpr (PredicateFailure (EraRule "UTXO" era))
  , ToExpr (PlutusPurpose AsIx era)
  , ToExpr (PlutusPurpose AsItem era)
  , ToExpr (TxCert era)
  ) =>
  ToExpr (ConwayUtxowPredFailure era)

instance
  ( ToExpr (PParams era)
  , ToExpr (PParamsHKD StrictMaybe era)
  ) =>
  ToExpr (CertEnv era)

instance ToExpr (PParams era) => ToExpr (ConwayDelegEnv era)

instance ToExpr (PParamsHKD StrictMaybe era) => ToExpr (RatifySignal era)

instance ToExpr (PParamsHKD StrictMaybe era) => ToExpr (EnactSignal era)

instance
  ( ToExpr (PParamsHKD Identity era)
  , ToExpr (PParamsHKD StrictMaybe era)
  , ToExpr (Tx TopTx era)
  ) =>
  ToExpr (CertsEnv era)

instance ToExpr (VState era)

instance (ConwayEraCertState era, ToExpr (Accounts era)) => ToExpr (ConwayCertState era)

instance ToExpr (ConwayAccounts era)

instance ToExpr (ConwayAccountState era)

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

instance ToExpr (Tx TopTx ConwayEra)