{-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE EmptyDataDeriving #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE UndecidableInstances #-} {-# OPTIONS_GHC -Wno-orphans #-} module Cardano.Ledger.Dijkstra.Rules.SubLedger ( SUBLEDGER, DijkstraSubLedgerPredFailure (..), DijkstraSubLedgerEvent (..), SubLedgerEnv (..), ) where import qualified Cardano.Ledger.Alonzo.Rules as Alonzo import Cardano.Ledger.BaseTypes import Cardano.Ledger.Binary ( DecCBOR (..), EncCBOR (..), ) import Cardano.Ledger.Binary.Coders import Cardano.Ledger.Coin (Coin) import Cardano.Ledger.Conway.Core import Cardano.Ledger.Conway.Governance import qualified Cardano.Ledger.Conway.Rules as Conway import Cardano.Ledger.Conway.State import Cardano.Ledger.Dijkstra.Era ( DijkstraEra, SUBCERT, SUBCERTS, SUBDELEG, SUBENTITIES, SUBGOV, SUBGOVCERT, SUBLEDGER, SUBPOOL, SUBUTXO, SUBUTXOW, ) import Cardano.Ledger.Dijkstra.Rules.Gov (DijkstraGovPredFailure (..)) import Cardano.Ledger.Dijkstra.Rules.SubCerts ( DijkstraSubCertsPredFailure (..), SubCertsEnv (..), ) import Cardano.Ledger.Dijkstra.Rules.SubDeleg (DijkstraSubDelegPredFailure) import Cardano.Ledger.Dijkstra.Rules.SubEntities ( SubEntitiesEvent, SubEntitiesPredFailure (..), ) import Cardano.Ledger.Dijkstra.Rules.SubGov (DijkstraSubGovEvent, DijkstraSubGovPredFailure (..)) import Cardano.Ledger.Dijkstra.Rules.SubGovCert (DijkstraSubGovCertPredFailure) import Cardano.Ledger.Dijkstra.Rules.SubPool (DijkstraSubPoolEvent, DijkstraSubPoolPredFailure) import Cardano.Ledger.Dijkstra.Rules.SubUtxo (SubUtxoEnv (..)) import Cardano.Ledger.Dijkstra.Rules.SubUtxow ( DijkstraSubUtxowEvent (..), DijkstraSubUtxowPredFailure (..), ) import Cardano.Ledger.Dijkstra.Rules.Utxow (DijkstraUtxowPredFailure (..)) import Cardano.Ledger.Dijkstra.TxCert import Cardano.Ledger.Rules.ValidationMode (runTest) import Cardano.Ledger.Shelley.LedgerState import qualified Cardano.Ledger.Shelley.Rules as Shelley import Cardano.Ledger.Slot (epochFromSlot) import Control.DeepSeq (NFData) import Control.State.Transition.Extended ( BaseM, Embed (..), Environment, Event, PredicateFailure, STS, Signal, State, TRC (TRC), TransitionRule, judgmentContext, liftSTS, trans, transitionRules, ) import qualified Data.Sequence.Strict as StrictSeq import GHC.Generics (Generic) import Lens.Micro data SubLedgerEnv era = SubLedgerEnv { forall era. SubLedgerEnv era -> SlotNo sleSlotNo :: SlotNo , forall era. SubLedgerEnv era -> Maybe EpochNo sleEpochNo :: Maybe EpochNo , forall era. SubLedgerEnv era -> TxIx sleTxIx :: TxIx , forall era. SubLedgerEnv era -> PParams era slePParams :: PParams era , forall era. SubLedgerEnv era -> ChainAccountState sleAccount :: ChainAccountState , forall era. SubLedgerEnv era -> UTxO era sleOriginalUtxo :: UTxO era , forall era. SubLedgerEnv era -> IsValid sleTopTxIsValid :: IsValid } data DijkstraSubLedgerPredFailure era = SubUtxowFailure (PredicateFailure (EraRule "SUBUTXOW" era)) | SubEntitiesFailure (PredicateFailure (EraRule "SUBENTITIES" era)) | SubGovFailure (PredicateFailure (EraRule "SUBGOV" era)) | SubTreasuryValueMismatch (Mismatch RelEQ Coin) deriving ((forall x. DijkstraSubLedgerPredFailure era -> Rep (DijkstraSubLedgerPredFailure era) x) -> (forall x. Rep (DijkstraSubLedgerPredFailure era) x -> DijkstraSubLedgerPredFailure era) -> Generic (DijkstraSubLedgerPredFailure era) forall x. Rep (DijkstraSubLedgerPredFailure era) x -> DijkstraSubLedgerPredFailure era forall x. DijkstraSubLedgerPredFailure era -> Rep (DijkstraSubLedgerPredFailure era) x forall a. (forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a forall era x. Rep (DijkstraSubLedgerPredFailure era) x -> DijkstraSubLedgerPredFailure era forall era x. DijkstraSubLedgerPredFailure era -> Rep (DijkstraSubLedgerPredFailure era) x $cfrom :: forall era x. DijkstraSubLedgerPredFailure era -> Rep (DijkstraSubLedgerPredFailure era) x from :: forall x. DijkstraSubLedgerPredFailure era -> Rep (DijkstraSubLedgerPredFailure era) x $cto :: forall era x. Rep (DijkstraSubLedgerPredFailure era) x -> DijkstraSubLedgerPredFailure era to :: forall x. Rep (DijkstraSubLedgerPredFailure era) x -> DijkstraSubLedgerPredFailure era Generic) deriving stock instance ( Eq (PredicateFailure (EraRule "SUBGOV" era)) , Eq (PredicateFailure (EraRule "SUBENTITIES" era)) , Eq (PredicateFailure (EraRule "SUBUTXOW" era)) ) => Eq (DijkstraSubLedgerPredFailure era) deriving stock instance ( Show (PredicateFailure (EraRule "SUBGOV" era)) , Show (PredicateFailure (EraRule "SUBENTITIES" era)) , Show (PredicateFailure (EraRule "SUBUTXOW" era)) ) => Show (DijkstraSubLedgerPredFailure era) instance ( NFData (PredicateFailure (EraRule "SUBGOV" era)) , NFData (PredicateFailure (EraRule "SUBENTITIES" era)) , NFData (PredicateFailure (EraRule "SUBUTXOW" era)) ) => NFData (DijkstraSubLedgerPredFailure era) type instance EraRuleFailure "SUBLEDGER" DijkstraEra = DijkstraSubLedgerPredFailure DijkstraEra type instance EraRuleEvent "SUBLEDGER" DijkstraEra = DijkstraSubLedgerEvent DijkstraEra instance InjectRuleFailure "SUBLEDGER" DijkstraSubLedgerPredFailure DijkstraEra instance InjectRuleFailure "SUBLEDGER" DijkstraSubGovPredFailure DijkstraEra where injectFailure :: DijkstraSubGovPredFailure DijkstraEra -> EraRuleFailure "SUBLEDGER" DijkstraEra injectFailure = PredicateFailure (EraRule "SUBGOV" DijkstraEra) -> DijkstraSubLedgerPredFailure DijkstraEra DijkstraSubGovPredFailure DijkstraEra -> EraRuleFailure "SUBLEDGER" DijkstraEra forall era. PredicateFailure (EraRule "SUBGOV" era) -> DijkstraSubLedgerPredFailure era SubGovFailure instance InjectRuleFailure "SUBLEDGER" DijkstraSubUtxowPredFailure DijkstraEra where injectFailure :: DijkstraSubUtxowPredFailure DijkstraEra -> EraRuleFailure "SUBLEDGER" DijkstraEra injectFailure = PredicateFailure (EraRule "SUBUTXOW" DijkstraEra) -> DijkstraSubLedgerPredFailure DijkstraEra DijkstraSubUtxowPredFailure DijkstraEra -> EraRuleFailure "SUBLEDGER" DijkstraEra forall era. PredicateFailure (EraRule "SUBUTXOW" era) -> DijkstraSubLedgerPredFailure era SubUtxowFailure instance InjectRuleFailure "SUBLEDGER" SubEntitiesPredFailure DijkstraEra where injectFailure :: SubEntitiesPredFailure DijkstraEra -> EraRuleFailure "SUBLEDGER" DijkstraEra injectFailure = PredicateFailure (EraRule "SUBENTITIES" DijkstraEra) -> DijkstraSubLedgerPredFailure DijkstraEra SubEntitiesPredFailure DijkstraEra -> EraRuleFailure "SUBLEDGER" DijkstraEra forall era. PredicateFailure (EraRule "SUBENTITIES" era) -> DijkstraSubLedgerPredFailure era SubEntitiesFailure instance InjectRuleFailure "SUBLEDGER" DijkstraSubCertsPredFailure DijkstraEra where injectFailure :: DijkstraSubCertsPredFailure DijkstraEra -> EraRuleFailure "SUBLEDGER" DijkstraEra injectFailure = PredicateFailure (EraRule "SUBENTITIES" DijkstraEra) -> DijkstraSubLedgerPredFailure DijkstraEra SubEntitiesPredFailure DijkstraEra -> DijkstraSubLedgerPredFailure DijkstraEra forall era. PredicateFailure (EraRule "SUBENTITIES" era) -> DijkstraSubLedgerPredFailure era SubEntitiesFailure (SubEntitiesPredFailure DijkstraEra -> DijkstraSubLedgerPredFailure DijkstraEra) -> (DijkstraSubCertsPredFailure DijkstraEra -> SubEntitiesPredFailure DijkstraEra) -> DijkstraSubCertsPredFailure DijkstraEra -> DijkstraSubLedgerPredFailure DijkstraEra forall b c a. (b -> c) -> (a -> b) -> a -> c . PredicateFailure (EraRule "SUBCERTS" DijkstraEra) -> SubEntitiesPredFailure DijkstraEra DijkstraSubCertsPredFailure DijkstraEra -> SubEntitiesPredFailure DijkstraEra forall era. PredicateFailure (EraRule "SUBCERTS" era) -> SubEntitiesPredFailure era SubCertsFailure instance InjectRuleFailure "SUBLEDGER" Conway.ConwayLedgerPredFailure DijkstraEra where injectFailure :: ConwayLedgerPredFailure DijkstraEra -> EraRuleFailure "SUBLEDGER" DijkstraEra injectFailure = ConwayLedgerPredFailure DijkstraEra -> EraRuleFailure "SUBLEDGER" DijkstraEra ConwayLedgerPredFailure DijkstraEra -> DijkstraSubLedgerPredFailure DijkstraEra forall era. (InjectRuleFailure "SUBUTXOW" DijkstraUtxowPredFailure era, PredicateFailure (EraRule "UTXOW" era) ~ DijkstraUtxowPredFailure era, InjectRuleFailure "SUBENTITIES" ConwayCertsPredFailure era, PredicateFailure (EraRule "SUBENTITIES" era) ~ SubEntitiesPredFailure era, PredicateFailure (EraRule "CERTS" era) ~ ConwayCertsPredFailure era, InjectRuleFailure "SUBGOV" DijkstraGovPredFailure era, PredicateFailure (EraRule "GOV" era) ~ DijkstraGovPredFailure era) => ConwayLedgerPredFailure era -> DijkstraSubLedgerPredFailure era conwayToDijkstraSubLedgerPredFailure data DijkstraSubLedgerEvent era = SubEntitiesEvent (Event (EraRule "SUBENTITIES" era)) | SubGovEvent (Event (EraRule "SUBGOV" era)) | SubUtxowEvent (Event (EraRule "SUBUTXOW" era)) deriving ((forall x. DijkstraSubLedgerEvent era -> Rep (DijkstraSubLedgerEvent era) x) -> (forall x. Rep (DijkstraSubLedgerEvent era) x -> DijkstraSubLedgerEvent era) -> Generic (DijkstraSubLedgerEvent era) forall x. Rep (DijkstraSubLedgerEvent era) x -> DijkstraSubLedgerEvent era forall x. DijkstraSubLedgerEvent era -> Rep (DijkstraSubLedgerEvent era) x forall a. (forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a forall era x. Rep (DijkstraSubLedgerEvent era) x -> DijkstraSubLedgerEvent era forall era x. DijkstraSubLedgerEvent era -> Rep (DijkstraSubLedgerEvent era) x $cfrom :: forall era x. DijkstraSubLedgerEvent era -> Rep (DijkstraSubLedgerEvent era) x from :: forall x. DijkstraSubLedgerEvent era -> Rep (DijkstraSubLedgerEvent era) x $cto :: forall era x. Rep (DijkstraSubLedgerEvent era) x -> DijkstraSubLedgerEvent era to :: forall x. Rep (DijkstraSubLedgerEvent era) x -> DijkstraSubLedgerEvent era Generic) deriving instance ( Eq (Event (EraRule "SUBENTITIES" era)) , Eq (Event (EraRule "SUBGOV" era)) , Eq (Event (EraRule "SUBUTXOW" era)) ) => Eq (DijkstraSubLedgerEvent era) instance ( NFData (Event (EraRule "SUBENTITIES" era)) , NFData (Event (EraRule "SUBGOV" era)) , NFData (Event (EraRule "SUBUTXOW" era)) ) => NFData (DijkstraSubLedgerEvent era) instance InjectRuleEvent "SUBLEDGER" DijkstraSubLedgerEvent DijkstraEra instance ( EraTx era , ConwayEraTxBody era , ConwayEraGov era , ConwayEraCertState era , EraRule "SUBLEDGER" era ~ SUBLEDGER era , EraRule "SUBGOV" era ~ SUBGOV era , EraRule "SUBUTXO" era ~ SUBUTXO era , EraRule "SUBUTXOW" era ~ SUBUTXOW era , EraRule "SUBENTITIES" era ~ SUBENTITIES era , EraRule "SUBCERTS" era ~ SUBCERTS era , EraRule "SUBCERT" era ~ SUBCERT era , EraRule "SUBDELEG" era ~ SUBDELEG era , EraRule "SUBPOOL" era ~ SUBPOOL era , EraRule "SUBGOVCERT" era ~ SUBGOVCERT era , Embed (EraRule "SUBGOV" era) (SUBLEDGER era) , Embed (EraRule "SUBUTXOW" era) (SUBLEDGER era) , Embed (EraRule "SUBENTITIES" era) (SUBLEDGER era) , InjectRuleEvent "SUBPOOL" Shelley.PoolEvent era , InjectRuleEvent "SUBPOOL" DijkstraSubPoolEvent era , InjectRuleFailure "SUBPOOL" Shelley.ShelleyPoolPredFailure era , InjectRuleFailure "SUBPOOL" DijkstraSubPoolPredFailure era , InjectRuleFailure "SUBGOVCERT" DijkstraSubGovCertPredFailure era , InjectRuleFailure "SUBGOVCERT" Conway.ConwayGovCertPredFailure era , InjectRuleFailure "SUBDELEG" Conway.ConwayDelegPredFailure era , InjectRuleFailure "SUBDELEG" DijkstraSubDelegPredFailure era , InjectRuleFailure "SUBLEDGER" Conway.ConwayLedgerPredFailure era , InjectRuleFailure "SUBUTXOW" Alonzo.AlonzoUtxowPredFailure era , TxCert era ~ DijkstraTxCert era ) => STS (SUBLEDGER era) where type State (SUBLEDGER era) = LedgerState era type Signal (SUBLEDGER era) = StAnnTx SubTx era type Environment (SUBLEDGER era) = SubLedgerEnv era type BaseM (SUBLEDGER era) = ShelleyBase type PredicateFailure (SUBLEDGER era) = DijkstraSubLedgerPredFailure era type Event (SUBLEDGER era) = DijkstraSubLedgerEvent era transitionRules :: [TransitionRule (SUBLEDGER era)] transitionRules = [forall era. (EraTx era, ConwayEraTxBody era, ConwayEraGov era, EraRule "SUBLEDGER" era ~ SUBLEDGER era, EraRule "SUBGOV" era ~ SUBGOV era, EraRule "SUBUTXOW" era ~ SUBUTXOW era, EraRule "SUBENTITIES" era ~ SUBENTITIES era, Embed (EraRule "SUBGOV" era) (SUBLEDGER era), Embed (EraRule "SUBUTXOW" era) (SUBLEDGER era), Embed (EraRule "SUBENTITIES" era) (SUBLEDGER era), InjectRuleFailure "SUBLEDGER" ConwayLedgerPredFailure era, STS (EraRule "SUBLEDGER" era)) => TransitionRule (EraRule "SUBLEDGER" era) dijkstraSubLedgersTransition @era] dijkstraSubLedgersTransition :: forall era. ( EraTx era , ConwayEraTxBody era , ConwayEraGov era , EraRule "SUBLEDGER" era ~ SUBLEDGER era , EraRule "SUBGOV" era ~ SUBGOV era , EraRule "SUBUTXOW" era ~ SUBUTXOW era , EraRule "SUBENTITIES" era ~ SUBENTITIES era , Embed (EraRule "SUBGOV" era) (SUBLEDGER era) , Embed (EraRule "SUBUTXOW" era) (SUBLEDGER era) , Embed (EraRule "SUBENTITIES" era) (SUBLEDGER era) , InjectRuleFailure "SUBLEDGER" Conway.ConwayLedgerPredFailure era , STS (EraRule "SUBLEDGER" era) ) => TransitionRule (EraRule "SUBLEDGER" era) dijkstraSubLedgersTransition :: forall era. (EraTx era, ConwayEraTxBody era, ConwayEraGov era, EraRule "SUBLEDGER" era ~ SUBLEDGER era, EraRule "SUBGOV" era ~ SUBGOV era, EraRule "SUBUTXOW" era ~ SUBUTXOW era, EraRule "SUBENTITIES" era ~ SUBENTITIES era, Embed (EraRule "SUBGOV" era) (SUBLEDGER era), Embed (EraRule "SUBUTXOW" era) (SUBLEDGER era), Embed (EraRule "SUBENTITIES" era) (SUBLEDGER era), InjectRuleFailure "SUBLEDGER" ConwayLedgerPredFailure era, STS (EraRule "SUBLEDGER" era)) => TransitionRule (EraRule "SUBLEDGER" era) dijkstraSubLedgersTransition = do TRC ( SubLedgerEnv slot mbCurEpochNo _ pp chainAccountState originalUtxo topIsValid , LedgerState utxoState certState , stAnnTx ) <- Rule (SUBLEDGER era) 'Transition (RuleContext 'Transition (SUBLEDGER era)) F (Clause (SUBLEDGER era) 'Transition) (TRC (SUBLEDGER era)) forall sts (rtype :: RuleType). Rule sts rtype (RuleContext rtype sts) judgmentContext let tx = StAnnTx SubTx era Signal (SUBLEDGER era) stAnnTx StAnnTx SubTx era -> Getting (Tx SubTx era) (StAnnTx SubTx era) (Tx SubTx era) -> Tx SubTx era forall s a. s -> Getting a s a -> a ^. Getting (Tx SubTx era) (StAnnTx SubTx era) (Tx SubTx era) forall era (l :: TxLevel). EraTx era => SimpleGetter (StAnnTx l era) (Tx l era) forall (l :: TxLevel). SimpleGetter (StAnnTx l era) (Tx l era) txStAnnTxG curEpochNo <- maybe (liftSTS $ epochFromSlot slot) pure mbCurEpochNo let txBody = Tx SubTx era tx Tx SubTx era -> Getting (TxBody SubTx era) (Tx SubTx era) (TxBody SubTx era) -> TxBody SubTx era forall s a. s -> Getting a s a -> a ^. Getting (TxBody SubTx era) (Tx SubTx era) (TxBody SubTx era) forall era (l :: TxLevel). EraTx era => Lens' (Tx l era) (TxBody l era) forall (l :: TxLevel). Lens' (Tx l era) (TxBody l era) bodyTxL let govState = UTxOState era utxoState UTxOState era -> Getting (GovState era) (UTxOState era) (GovState era) -> GovState era forall s a. s -> Getting a s a -> a ^. Getting (GovState era) (UTxOState era) (GovState era) forall era (f :: * -> *). Functor f => (GovState era -> f (GovState era)) -> UTxOState era -> f (UTxOState era) utxosGovStateL let committee = GovState era govState GovState era -> Getting (StrictMaybe (Committee era)) (GovState era) (StrictMaybe (Committee era)) -> StrictMaybe (Committee era) forall s a. s -> Getting a s a -> a ^. Getting (StrictMaybe (Committee era)) (GovState era) (StrictMaybe (Committee era)) forall era. ConwayEraGov era => Lens' (GovState era) (StrictMaybe (Committee era)) Lens' (GovState era) (StrictMaybe (Committee era)) committeeGovStateL let proposals = GovState era govState GovState era -> Getting (Proposals era) (GovState era) (Proposals era) -> Proposals era forall s a. s -> Getting a s a -> a ^. Getting (Proposals era) (GovState era) (Proposals era) forall era. ConwayEraGov era => Lens' (GovState era) (Proposals era) Lens' (GovState era) (Proposals era) proposalsGovStateL (utxoStateBeforeSubUtxow, certStateFinal) <- if topIsValid == IsValid True then do runTest $ Conway.validateTreasuryValue txBody (chainAccountState ^. casTreasuryL) certStateAfterSubEntities <- trans @(EraRule "SUBENTITIES" era) $ TRC ( SubCertsEnv tx pp curEpochNo committee (proposalsWithPurpose grCommitteeL proposals) , certState , StrictSeq.fromStrict $ txBody ^. certsTxBodyL ) let govEnv = TxId -> EpochNo -> PParams era -> StrictMaybe ScriptHash -> CertState era -> StrictMaybe (Committee era) -> GovEnv era forall era. TxId -> EpochNo -> PParams era -> StrictMaybe ScriptHash -> CertState era -> StrictMaybe (Committee era) -> GovEnv era Conway.GovEnv (TxBody SubTx era -> TxId forall era (l :: TxLevel). EraTxBody era => TxBody l era -> TxId txIdTxBody TxBody SubTx era txBody) EpochNo curEpochNo PParams era pp (GovState era govState GovState era -> Getting (StrictMaybe ScriptHash) (GovState era) (StrictMaybe ScriptHash) -> StrictMaybe ScriptHash forall s a. s -> Getting a s a -> a ^. (Constitution era -> Const (StrictMaybe ScriptHash) (Constitution era)) -> GovState era -> Const (StrictMaybe ScriptHash) (GovState era) forall era. ConwayEraGov era => Lens' (GovState era) (Constitution era) Lens' (GovState era) (Constitution era) constitutionGovStateL ((Constitution era -> Const (StrictMaybe ScriptHash) (Constitution era)) -> GovState era -> Const (StrictMaybe ScriptHash) (GovState era)) -> ((StrictMaybe ScriptHash -> Const (StrictMaybe ScriptHash) (StrictMaybe ScriptHash)) -> Constitution era -> Const (StrictMaybe ScriptHash) (Constitution era)) -> Getting (StrictMaybe ScriptHash) (GovState era) (StrictMaybe ScriptHash) forall b c a. (b -> c) -> (a -> b) -> a -> c . (StrictMaybe ScriptHash -> Const (StrictMaybe ScriptHash) (StrictMaybe ScriptHash)) -> Constitution era -> Const (StrictMaybe ScriptHash) (Constitution era) forall era (f :: * -> *). Functor f => (StrictMaybe ScriptHash -> f (StrictMaybe ScriptHash)) -> Constitution era -> f (Constitution era) constitutionGuardrailsScriptHashL) CertState era certStateAfterSubEntities StrictMaybe (Committee era) committee let govSignal = Conway.GovSignal { gsVotingProcedures :: VotingProcedures era Conway.gsVotingProcedures = TxBody SubTx era txBody TxBody SubTx era -> Getting (VotingProcedures era) (TxBody SubTx era) (VotingProcedures era) -> VotingProcedures era forall s a. s -> Getting a s a -> a ^. Getting (VotingProcedures era) (TxBody SubTx era) (VotingProcedures era) forall era (l :: TxLevel). ConwayEraTxBody era => Lens' (TxBody l era) (VotingProcedures era) forall (l :: TxLevel). Lens' (TxBody l era) (VotingProcedures era) votingProceduresTxBodyL , gsProposalProcedures :: OSet (ProposalProcedure era) Conway.gsProposalProcedures = TxBody SubTx era txBody TxBody SubTx era -> Getting (OSet (ProposalProcedure era)) (TxBody SubTx era) (OSet (ProposalProcedure era)) -> OSet (ProposalProcedure era) forall s a. s -> Getting a s a -> a ^. Getting (OSet (ProposalProcedure era)) (TxBody SubTx era) (OSet (ProposalProcedure era)) forall era (l :: TxLevel). ConwayEraTxBody era => Lens' (TxBody l era) (OSet (ProposalProcedure era)) forall (l :: TxLevel). Lens' (TxBody l era) (OSet (ProposalProcedure era)) proposalProceduresTxBodyL , gsCertificates :: StrictSeq (TxCert era) Conway.gsCertificates = TxBody SubTx era txBody TxBody SubTx era -> Getting (StrictSeq (TxCert era)) (TxBody SubTx era) (StrictSeq (TxCert era)) -> StrictSeq (TxCert era) forall s a. s -> Getting a s a -> a ^. Getting (StrictSeq (TxCert era)) (TxBody SubTx era) (StrictSeq (TxCert era)) forall era (l :: TxLevel). EraTxBody era => Lens' (TxBody l era) (StrictSeq (TxCert era)) forall (l :: TxLevel). Lens' (TxBody l era) (StrictSeq (TxCert era)) certsTxBodyL } proposalsState <- trans @(EraRule "SUBGOV" era) $ TRC ( govEnv , proposals , govSignal ) pure ( utxoState & utxosGovStateL . proposalsGovStateL .~ proposalsState , certStateAfterSubEntities ) else pure (utxoState, certState) utxoStateAfterSubUtxow <- trans @(EraRule "SUBUTXOW" era) $ TRC ( SubUtxoEnv slot pp certState originalUtxo topIsValid , utxoStateBeforeSubUtxow , stAnnTx ) pure $ LedgerState utxoStateAfterSubUtxow certStateFinal instance ( STS (SUBGOV era) , PredicateFailure (EraRule "SUBGOV" era) ~ DijkstraSubGovPredFailure era , Event (EraRule "SUBGOV" era) ~ DijkstraSubGovEvent era ) => Embed (SUBGOV era) (SUBLEDGER era) where wrapFailed :: PredicateFailure (SUBGOV era) -> PredicateFailure (SUBLEDGER era) wrapFailed = PredicateFailure (EraRule "SUBGOV" era) -> DijkstraSubLedgerPredFailure era PredicateFailure (SUBGOV era) -> PredicateFailure (SUBLEDGER era) forall era. PredicateFailure (EraRule "SUBGOV" era) -> DijkstraSubLedgerPredFailure era SubGovFailure wrapEvent :: Event (SUBGOV era) -> Event (SUBLEDGER era) wrapEvent = Event (EraRule "SUBGOV" era) -> DijkstraSubLedgerEvent era Event (SUBGOV era) -> Event (SUBLEDGER era) forall era. Event (EraRule "SUBGOV" era) -> DijkstraSubLedgerEvent era SubGovEvent instance ( STS (SUBUTXOW era) , PredicateFailure (EraRule "SUBUTXOW" era) ~ DijkstraSubUtxowPredFailure era , Event (EraRule "SUBUTXOW" era) ~ DijkstraSubUtxowEvent era ) => Embed (SUBUTXOW era) (SUBLEDGER era) where wrapFailed :: PredicateFailure (SUBUTXOW era) -> PredicateFailure (SUBLEDGER era) wrapFailed = PredicateFailure (EraRule "SUBUTXOW" era) -> DijkstraSubLedgerPredFailure era PredicateFailure (SUBUTXOW era) -> PredicateFailure (SUBLEDGER era) forall era. PredicateFailure (EraRule "SUBUTXOW" era) -> DijkstraSubLedgerPredFailure era SubUtxowFailure wrapEvent :: Event (SUBUTXOW era) -> Event (SUBLEDGER era) wrapEvent = Event (EraRule "SUBUTXOW" era) -> DijkstraSubLedgerEvent era Event (SUBUTXOW era) -> Event (SUBLEDGER era) forall era. Event (EraRule "SUBUTXOW" era) -> DijkstraSubLedgerEvent era SubUtxowEvent instance ( STS (SUBENTITIES era) , PredicateFailure (EraRule "SUBENTITIES" era) ~ SubEntitiesPredFailure era , Event (EraRule "SUBENTITIES" era) ~ SubEntitiesEvent era ) => Embed (SUBENTITIES era) (SUBLEDGER era) where wrapFailed :: PredicateFailure (SUBENTITIES era) -> PredicateFailure (SUBLEDGER era) wrapFailed = PredicateFailure (EraRule "SUBENTITIES" era) -> DijkstraSubLedgerPredFailure era PredicateFailure (SUBENTITIES era) -> PredicateFailure (SUBLEDGER era) forall era. PredicateFailure (EraRule "SUBENTITIES" era) -> DijkstraSubLedgerPredFailure era SubEntitiesFailure wrapEvent :: Event (SUBENTITIES era) -> Event (SUBLEDGER era) wrapEvent = Event (EraRule "SUBENTITIES" era) -> DijkstraSubLedgerEvent era Event (SUBENTITIES era) -> Event (SUBLEDGER era) forall era. Event (EraRule "SUBENTITIES" era) -> DijkstraSubLedgerEvent era SubEntitiesEvent instance ( Era era , EncCBOR (PredicateFailure (EraRule "SUBUTXOW" era)) , EncCBOR (PredicateFailure (EraRule "SUBENTITIES" era)) , EncCBOR (PredicateFailure (EraRule "SUBGOV" era)) ) => EncCBOR (DijkstraSubLedgerPredFailure era) where encCBOR :: DijkstraSubLedgerPredFailure era -> Encoding encCBOR = Encode Open (DijkstraSubLedgerPredFailure era) -> Encoding forall (w :: Wrapped) t. Encode w t -> Encoding encode (Encode Open (DijkstraSubLedgerPredFailure era) -> Encoding) -> (DijkstraSubLedgerPredFailure era -> Encode Open (DijkstraSubLedgerPredFailure era)) -> DijkstraSubLedgerPredFailure era -> Encoding forall b c a. (b -> c) -> (a -> b) -> a -> c . \case SubUtxowFailure PredicateFailure (EraRule "SUBUTXOW" era) x -> (PredicateFailure (EraRule "SUBUTXOW" era) -> DijkstraSubLedgerPredFailure era) -> Word -> Encode Open (PredicateFailure (EraRule "SUBUTXOW" era) -> DijkstraSubLedgerPredFailure era) forall t. t -> Word -> Encode Open t Sum (forall era. PredicateFailure (EraRule "SUBUTXOW" era) -> DijkstraSubLedgerPredFailure era SubUtxowFailure @era) Word 1 Encode Open (PredicateFailure (EraRule "SUBUTXOW" era) -> DijkstraSubLedgerPredFailure era) -> Encode (Closed Dense) (PredicateFailure (EraRule "SUBUTXOW" era)) -> Encode Open (DijkstraSubLedgerPredFailure era) forall (w :: Wrapped) a t (r :: Density). Encode w (a -> t) -> Encode (Closed r) a -> Encode w t !> PredicateFailure (EraRule "SUBUTXOW" era) -> Encode (Closed Dense) (PredicateFailure (EraRule "SUBUTXOW" era)) forall t. EncCBOR t => t -> Encode (Closed Dense) t To PredicateFailure (EraRule "SUBUTXOW" era) x SubEntitiesFailure PredicateFailure (EraRule "SUBENTITIES" era) x -> (PredicateFailure (EraRule "SUBENTITIES" era) -> DijkstraSubLedgerPredFailure era) -> Word -> Encode Open (PredicateFailure (EraRule "SUBENTITIES" era) -> DijkstraSubLedgerPredFailure era) forall t. t -> Word -> Encode Open t Sum (forall era. PredicateFailure (EraRule "SUBENTITIES" era) -> DijkstraSubLedgerPredFailure era SubEntitiesFailure @era) Word 2 Encode Open (PredicateFailure (EraRule "SUBENTITIES" era) -> DijkstraSubLedgerPredFailure era) -> Encode (Closed Dense) (PredicateFailure (EraRule "SUBENTITIES" era)) -> Encode Open (DijkstraSubLedgerPredFailure era) forall (w :: Wrapped) a t (r :: Density). Encode w (a -> t) -> Encode (Closed r) a -> Encode w t !> PredicateFailure (EraRule "SUBENTITIES" era) -> Encode (Closed Dense) (PredicateFailure (EraRule "SUBENTITIES" era)) forall t. EncCBOR t => t -> Encode (Closed Dense) t To PredicateFailure (EraRule "SUBENTITIES" era) x SubGovFailure PredicateFailure (EraRule "SUBGOV" era) x -> (PredicateFailure (EraRule "SUBGOV" era) -> DijkstraSubLedgerPredFailure era) -> Word -> Encode Open (PredicateFailure (EraRule "SUBGOV" era) -> DijkstraSubLedgerPredFailure era) forall t. t -> Word -> Encode Open t Sum (forall era. PredicateFailure (EraRule "SUBGOV" era) -> DijkstraSubLedgerPredFailure era SubGovFailure @era) Word 3 Encode Open (PredicateFailure (EraRule "SUBGOV" era) -> DijkstraSubLedgerPredFailure era) -> Encode (Closed Dense) (PredicateFailure (EraRule "SUBGOV" era)) -> Encode Open (DijkstraSubLedgerPredFailure era) forall (w :: Wrapped) a t (r :: Density). Encode w (a -> t) -> Encode (Closed r) a -> Encode w t !> PredicateFailure (EraRule "SUBGOV" era) -> Encode (Closed Dense) (PredicateFailure (EraRule "SUBGOV" era)) forall t. EncCBOR t => t -> Encode (Closed Dense) t To PredicateFailure (EraRule "SUBGOV" era) x SubTreasuryValueMismatch Mismatch RelEQ Coin mm -> (Mismatch RelEQ Coin -> DijkstraSubLedgerPredFailure era) -> Word -> Encode Open (Mismatch RelEQ Coin -> DijkstraSubLedgerPredFailure era) forall t. t -> Word -> Encode Open t Sum (forall era. Mismatch RelEQ Coin -> DijkstraSubLedgerPredFailure era SubTreasuryValueMismatch @era) Word 5 Encode Open (Mismatch RelEQ Coin -> DijkstraSubLedgerPredFailure era) -> Encode (Closed Dense) (Mismatch RelEQ Coin) -> Encode Open (DijkstraSubLedgerPredFailure era) forall (w :: Wrapped) a t (r :: Density). Encode w (a -> t) -> Encode (Closed r) a -> Encode w t !> Mismatch RelEQ Coin -> Encode (Closed Dense) (Mismatch RelEQ Coin) forall t. EncCBOR t => t -> Encode (Closed Dense) t To Mismatch RelEQ Coin mm instance ( Era era , DecCBOR (PredicateFailure (EraRule "SUBUTXOW" era)) , DecCBOR (PredicateFailure (EraRule "SUBENTITIES" era)) , DecCBOR (PredicateFailure (EraRule "SUBGOV" era)) ) => DecCBOR (DijkstraSubLedgerPredFailure era) where decCBOR :: forall s. Decoder s (DijkstraSubLedgerPredFailure era) decCBOR = Decode (Closed Dense) (DijkstraSubLedgerPredFailure era) -> Decoder s (DijkstraSubLedgerPredFailure era) forall t (w :: Wrapped) s. Typeable t => Decode w t -> Decoder s t decode (Decode (Closed Dense) (DijkstraSubLedgerPredFailure era) -> Decoder s (DijkstraSubLedgerPredFailure era)) -> ((Word -> Decode Open (DijkstraSubLedgerPredFailure era)) -> Decode (Closed Dense) (DijkstraSubLedgerPredFailure era)) -> (Word -> Decode Open (DijkstraSubLedgerPredFailure era)) -> Decoder s (DijkstraSubLedgerPredFailure era) forall b c a. (b -> c) -> (a -> b) -> a -> c . Text -> (Word -> Decode Open (DijkstraSubLedgerPredFailure era)) -> Decode (Closed Dense) (DijkstraSubLedgerPredFailure era) forall t. Text -> (Word -> Decode Open t) -> Decode (Closed Dense) t Summands Text "DijkstraSubLedgerPredFailure" ((Word -> Decode Open (DijkstraSubLedgerPredFailure era)) -> Decoder s (DijkstraSubLedgerPredFailure era)) -> (Word -> Decode Open (DijkstraSubLedgerPredFailure era)) -> Decoder s (DijkstraSubLedgerPredFailure era) forall a b. (a -> b) -> a -> b $ \case Word 1 -> (PredicateFailure (EraRule "SUBUTXOW" era) -> DijkstraSubLedgerPredFailure era) -> Decode Open (PredicateFailure (EraRule "SUBUTXOW" era) -> DijkstraSubLedgerPredFailure era) forall t. t -> Decode Open t SumD PredicateFailure (EraRule "SUBUTXOW" era) -> DijkstraSubLedgerPredFailure era forall era. PredicateFailure (EraRule "SUBUTXOW" era) -> DijkstraSubLedgerPredFailure era SubUtxowFailure Decode Open (PredicateFailure (EraRule "SUBUTXOW" era) -> DijkstraSubLedgerPredFailure era) -> Decode (Closed (ZonkAny 0)) (PredicateFailure (EraRule "SUBUTXOW" era)) -> Decode Open (DijkstraSubLedgerPredFailure 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)) (PredicateFailure (EraRule "SUBUTXOW" era)) forall t (w :: Wrapped). DecCBOR t => Decode w t From Word 2 -> (PredicateFailure (EraRule "SUBENTITIES" era) -> DijkstraSubLedgerPredFailure era) -> Decode Open (PredicateFailure (EraRule "SUBENTITIES" era) -> DijkstraSubLedgerPredFailure era) forall t. t -> Decode Open t SumD PredicateFailure (EraRule "SUBENTITIES" era) -> DijkstraSubLedgerPredFailure era forall era. PredicateFailure (EraRule "SUBENTITIES" era) -> DijkstraSubLedgerPredFailure era SubEntitiesFailure Decode Open (PredicateFailure (EraRule "SUBENTITIES" era) -> DijkstraSubLedgerPredFailure era) -> Decode (Closed (ZonkAny 1)) (PredicateFailure (EraRule "SUBENTITIES" era)) -> Decode Open (DijkstraSubLedgerPredFailure 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)) (PredicateFailure (EraRule "SUBENTITIES" era)) forall t (w :: Wrapped). DecCBOR t => Decode w t From Word 3 -> (PredicateFailure (EraRule "SUBGOV" era) -> DijkstraSubLedgerPredFailure era) -> Decode Open (PredicateFailure (EraRule "SUBGOV" era) -> DijkstraSubLedgerPredFailure era) forall t. t -> Decode Open t SumD PredicateFailure (EraRule "SUBGOV" era) -> DijkstraSubLedgerPredFailure era forall era. PredicateFailure (EraRule "SUBGOV" era) -> DijkstraSubLedgerPredFailure era SubGovFailure Decode Open (PredicateFailure (EraRule "SUBGOV" era) -> DijkstraSubLedgerPredFailure era) -> Decode (Closed (ZonkAny 2)) (PredicateFailure (EraRule "SUBGOV" era)) -> Decode Open (DijkstraSubLedgerPredFailure 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)) (PredicateFailure (EraRule "SUBGOV" era)) forall t (w :: Wrapped). DecCBOR t => Decode w t From Word 5 -> (Mismatch RelEQ Coin -> DijkstraSubLedgerPredFailure era) -> Decode Open (Mismatch RelEQ Coin -> DijkstraSubLedgerPredFailure era) forall t. t -> Decode Open t SumD Mismatch RelEQ Coin -> DijkstraSubLedgerPredFailure era forall era. Mismatch RelEQ Coin -> DijkstraSubLedgerPredFailure era SubTreasuryValueMismatch Decode Open (Mismatch RelEQ Coin -> DijkstraSubLedgerPredFailure era) -> Decode (Closed (ZonkAny 3)) (Mismatch RelEQ Coin) -> Decode Open (DijkstraSubLedgerPredFailure 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)) (Mismatch RelEQ Coin) forall t (w :: Wrapped). DecCBOR t => Decode w t From Word n -> Word -> Decode Open (DijkstraSubLedgerPredFailure era) forall (w :: Wrapped) t. Word -> Decode w t Invalid Word n conwayToDijkstraSubLedgerPredFailure :: forall era. ( InjectRuleFailure "SUBUTXOW" DijkstraUtxowPredFailure era , PredicateFailure (EraRule "UTXOW" era) ~ DijkstraUtxowPredFailure era , InjectRuleFailure "SUBENTITIES" Conway.ConwayCertsPredFailure era , PredicateFailure (EraRule "SUBENTITIES" era) ~ SubEntitiesPredFailure era , PredicateFailure (EraRule "CERTS" era) ~ Conway.ConwayCertsPredFailure era , InjectRuleFailure "SUBGOV" DijkstraGovPredFailure era , PredicateFailure (EraRule "GOV" era) ~ DijkstraGovPredFailure era ) => Conway.ConwayLedgerPredFailure era -> DijkstraSubLedgerPredFailure era conwayToDijkstraSubLedgerPredFailure :: forall era. (InjectRuleFailure "SUBUTXOW" DijkstraUtxowPredFailure era, PredicateFailure (EraRule "UTXOW" era) ~ DijkstraUtxowPredFailure era, InjectRuleFailure "SUBENTITIES" ConwayCertsPredFailure era, PredicateFailure (EraRule "SUBENTITIES" era) ~ SubEntitiesPredFailure era, PredicateFailure (EraRule "CERTS" era) ~ ConwayCertsPredFailure era, InjectRuleFailure "SUBGOV" DijkstraGovPredFailure era, PredicateFailure (EraRule "GOV" era) ~ DijkstraGovPredFailure era) => ConwayLedgerPredFailure era -> DijkstraSubLedgerPredFailure era conwayToDijkstraSubLedgerPredFailure = \case Conway.ConwayUtxowFailure PredicateFailure (EraRule "UTXOW" era) f -> PredicateFailure (EraRule "SUBUTXOW" era) -> DijkstraSubLedgerPredFailure era forall era. PredicateFailure (EraRule "SUBUTXOW" era) -> DijkstraSubLedgerPredFailure era SubUtxowFailure (forall (rule :: Symbol) (t :: * -> *) era. InjectRuleFailure rule t era => t era -> EraRuleFailure rule era injectFailure @"SUBUTXOW" PredicateFailure (EraRule "UTXOW" era) DijkstraUtxowPredFailure era f) Conway.ConwayCertsFailure PredicateFailure (EraRule "CERTS" era) f -> PredicateFailure (EraRule "SUBENTITIES" era) -> DijkstraSubLedgerPredFailure era forall era. PredicateFailure (EraRule "SUBENTITIES" era) -> DijkstraSubLedgerPredFailure era SubEntitiesFailure (forall (rule :: Symbol) (t :: * -> *) era. InjectRuleFailure rule t era => t era -> EraRuleFailure rule era injectFailure @"SUBENTITIES" PredicateFailure (EraRule "CERTS" era) ConwayCertsPredFailure era f) Conway.ConwayGovFailure PredicateFailure (EraRule "GOV" era) f -> PredicateFailure (EraRule "SUBGOV" era) -> DijkstraSubLedgerPredFailure era forall era. PredicateFailure (EraRule "SUBGOV" era) -> DijkstraSubLedgerPredFailure era SubGovFailure (forall (rule :: Symbol) (t :: * -> *) era. InjectRuleFailure rule t era => t era -> EraRuleFailure rule era injectFailure @"SUBGOV" PredicateFailure (EraRule "GOV" era) DijkstraGovPredFailure era f) Conway.ConwayWdrlNotDelegatedToDRep NonEmpty (KeyHash Staking) x -> PredicateFailure (EraRule "SUBENTITIES" era) -> DijkstraSubLedgerPredFailure era forall era. PredicateFailure (EraRule "SUBENTITIES" era) -> DijkstraSubLedgerPredFailure era SubEntitiesFailure (NonEmpty (KeyHash Staking) -> SubEntitiesPredFailure era forall era. NonEmpty (KeyHash Staking) -> SubEntitiesPredFailure era SubWdrlNotDelegatedToDRep NonEmpty (KeyHash Staking) x) Conway.ConwayWithdrawalsMissingAccounts Withdrawals x -> PredicateFailure (EraRule "SUBENTITIES" era) -> DijkstraSubLedgerPredFailure era forall era. PredicateFailure (EraRule "SUBENTITIES" era) -> DijkstraSubLedgerPredFailure era SubEntitiesFailure (Withdrawals -> SubEntitiesPredFailure era forall era. Withdrawals -> SubEntitiesPredFailure era SubWithdrawalsMissingAccounts Withdrawals x) Conway.ConwayTreasuryValueMismatch Mismatch RelEQ Coin x -> Mismatch RelEQ Coin -> DijkstraSubLedgerPredFailure era forall era. Mismatch RelEQ Coin -> DijkstraSubLedgerPredFailure era SubTreasuryValueMismatch Mismatch RelEQ Coin x Conway.ConwayTxRefScriptsSizeTooBig Mismatch RelLTEQ Int _ -> String -> DijkstraSubLedgerPredFailure era forall a. HasCallStack => String -> a error String "Impossible: `ConwayTxRefScriptsSizeTooBig` for SUBLEDGER" Conway.ConwayMempoolFailure Text _ -> String -> DijkstraSubLedgerPredFailure era forall a. HasCallStack => String -> a error String "Impossible: `ConwayMempoolFailure` for SUBLEDGER" Conway.ConwayIncompleteWithdrawals NonEmptyMap AccountAddress (Mismatch RelEQ Coin) _ -> String -> DijkstraSubLedgerPredFailure era forall a. HasCallStack => String -> a error String "Impossible: `ConwayIncompleteWithdrawals` for SUBLEDGER"