{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# 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.Allegra.Rules.Utxo (
AllegraUTXO,
AllegraUtxoEvent (..),
AllegraUtxoPredFailure (..),
validateOutsideValidityIntervalUTxO,
shelleyToAllegraUtxoPredFailure,
) where
import Cardano.Ledger.Address (Addr, RewardAccount)
import Cardano.Ledger.Allegra.Core
import Cardano.Ledger.Allegra.Era (AllegraEra, AllegraUTXO)
import Cardano.Ledger.Allegra.Rules.Ppup ()
import Cardano.Ledger.Allegra.Scripts (inInterval)
import Cardano.Ledger.BaseTypes (
Mismatch (..),
Network,
ProtVer (pvMajor),
Relation (..),
ShelleyBase,
StrictMaybe (..),
networkId,
)
import Cardano.Ledger.Binary (DecCBOR (..), EncCBOR (..), serialize)
import Cardano.Ledger.Binary.Coders
import Cardano.Ledger.Coin (Coin)
import Cardano.Ledger.Rules.ValidationMode (Test, runTest)
import qualified Cardano.Ledger.Shelley.LedgerState as Shelley
import Cardano.Ledger.Shelley.PParams (Update)
import Cardano.Ledger.Shelley.Rules (
PpupEnv (..),
ShelleyPPUP,
ShelleyPpupPredFailure,
)
import qualified Cardano.Ledger.Shelley.Rules as Shelley
import Cardano.Ledger.State
import Cardano.Ledger.TxIn (TxIn)
import qualified Cardano.Ledger.Val as Val
import Cardano.Slotting.Slot (SlotNo)
import Control.DeepSeq (NFData)
import Control.Monad.Trans.Reader (asks)
import Control.State.Transition.Extended
import qualified Data.ByteString.Lazy as BSL (length)
import Data.Foldable (toList)
import Data.Int (Int64)
import qualified Data.Map.Strict as Map
import Data.Set (Set)
import GHC.Generics (Generic)
import Lens.Micro
import NoThunks.Class (NoThunks)
import Validation
data AllegraUtxoPredFailure era
= BadInputsUTxO (Set TxIn)
| OutsideValidityIntervalUTxO
ValidityInterval
SlotNo
| MaxTxSizeUTxO (Mismatch 'RelLTEQ Integer)
| InputSetEmptyUTxO
| FeeTooSmallUTxO (Mismatch 'RelGTEQ Coin)
| ValueNotConservedUTxO (Mismatch 'RelEQ (Value era))
| WrongNetwork
Network
(Set Addr)
| WrongNetworkWithdrawal
Network
(Set RewardAccount)
| OutputTooSmallUTxO
[TxOut era]
| UpdateFailure (EraRuleFailure "PPUP" era)
| OutputBootAddrAttrsTooBig
[TxOut era]
|
TriesToForgeADA
| OutputTooBigUTxO
[TxOut era]
deriving ((forall x.
AllegraUtxoPredFailure era -> Rep (AllegraUtxoPredFailure era) x)
-> (forall x.
Rep (AllegraUtxoPredFailure era) x -> AllegraUtxoPredFailure era)
-> Generic (AllegraUtxoPredFailure era)
forall x.
Rep (AllegraUtxoPredFailure era) x -> AllegraUtxoPredFailure era
forall x.
AllegraUtxoPredFailure era -> Rep (AllegraUtxoPredFailure era) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall era x.
Rep (AllegraUtxoPredFailure era) x -> AllegraUtxoPredFailure era
forall era x.
AllegraUtxoPredFailure era -> Rep (AllegraUtxoPredFailure era) x
$cfrom :: forall era x.
AllegraUtxoPredFailure era -> Rep (AllegraUtxoPredFailure era) x
from :: forall x.
AllegraUtxoPredFailure era -> Rep (AllegraUtxoPredFailure era) x
$cto :: forall era x.
Rep (AllegraUtxoPredFailure era) x -> AllegraUtxoPredFailure era
to :: forall x.
Rep (AllegraUtxoPredFailure era) x -> AllegraUtxoPredFailure era
Generic)
type instance EraRuleFailure "UTXO" AllegraEra = AllegraUtxoPredFailure AllegraEra
instance InjectRuleFailure "UTXO" AllegraUtxoPredFailure AllegraEra
instance InjectRuleFailure "UTXO" ShelleyPpupPredFailure AllegraEra where
injectFailure :: ShelleyPpupPredFailure AllegraEra
-> EraRuleFailure "UTXO" AllegraEra
injectFailure = EraRuleFailure "PPUP" AllegraEra
-> AllegraUtxoPredFailure AllegraEra
ShelleyPpupPredFailure AllegraEra
-> EraRuleFailure "UTXO" AllegraEra
forall era. EraRuleFailure "PPUP" era -> AllegraUtxoPredFailure era
UpdateFailure
instance InjectRuleFailure "UTXO" Shelley.ShelleyUtxoPredFailure AllegraEra where
injectFailure :: ShelleyUtxoPredFailure AllegraEra
-> EraRuleFailure "UTXO" AllegraEra
injectFailure = ShelleyUtxoPredFailure AllegraEra
-> EraRuleFailure "UTXO" AllegraEra
ShelleyUtxoPredFailure AllegraEra
-> AllegraUtxoPredFailure AllegraEra
forall era.
ShelleyUtxoPredFailure era -> AllegraUtxoPredFailure era
shelleyToAllegraUtxoPredFailure
deriving stock instance
( Show (TxOut era)
, Show (Value era)
, Show (EraRuleFailure "PPUP" era)
) =>
Show (AllegraUtxoPredFailure era)
deriving stock instance
( Eq (TxOut era)
, Eq (Value era)
, Eq (EraRuleFailure "PPUP" era)
) =>
Eq (AllegraUtxoPredFailure era)
instance
( NoThunks (TxOut era)
, NoThunks (Value era)
, NoThunks (EraRuleFailure "PPUP" era)
) =>
NoThunks (AllegraUtxoPredFailure era)
instance
( Era era
, NFData (TxOut era)
, NFData (Value era)
, NFData (EraRuleFailure "PPUP" era)
) =>
NFData (AllegraUtxoPredFailure era)
data AllegraUtxoEvent era
= UpdateEvent (Event (EraRule "PPUP" era))
| TotalDeposits (SafeHash EraIndependentTxBody) Coin
|
TxUTxODiff
(UTxO era)
(UTxO era)
deriving ((forall x. AllegraUtxoEvent era -> Rep (AllegraUtxoEvent era) x)
-> (forall x. Rep (AllegraUtxoEvent era) x -> AllegraUtxoEvent era)
-> Generic (AllegraUtxoEvent era)
forall x. Rep (AllegraUtxoEvent era) x -> AllegraUtxoEvent era
forall x. AllegraUtxoEvent era -> Rep (AllegraUtxoEvent era) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall era x. Rep (AllegraUtxoEvent era) x -> AllegraUtxoEvent era
forall era x. AllegraUtxoEvent era -> Rep (AllegraUtxoEvent era) x
$cfrom :: forall era x. AllegraUtxoEvent era -> Rep (AllegraUtxoEvent era) x
from :: forall x. AllegraUtxoEvent era -> Rep (AllegraUtxoEvent era) x
$cto :: forall era x. Rep (AllegraUtxoEvent era) x -> AllegraUtxoEvent era
to :: forall x. Rep (AllegraUtxoEvent era) x -> AllegraUtxoEvent era
Generic)
deriving instance
( Era era
, Eq (TxOut era)
, Eq (Event (EraRule "PPUP" era))
) =>
Eq (AllegraUtxoEvent era)
instance
( Era era
, NFData (TxOut era)
, NFData (Event (EraRule "PPUP" era))
) =>
NFData (AllegraUtxoEvent era)
utxoTransition ::
forall era.
( EraUTxO era
, EraStake era
, EraCertState era
, ShelleyEraTxBody era
, AllegraEraTxBody era
, Eq (EraRuleFailure "PPUP" era)
, Show (EraRuleFailure "PPUP" era)
, Embed (EraRule "PPUP" era) (EraRule "UTXO" era)
, Environment (EraRule "PPUP" era) ~ PpupEnv era
, State (EraRule "PPUP" era) ~ ShelleyGovState era
, Signal (EraRule "PPUP" era) ~ StrictMaybe (Update era)
, GovState era ~ ShelleyGovState era
, InjectRuleFailure "UTXO" AllegraUtxoPredFailure era
, InjectRuleFailure "UTXO" Shelley.ShelleyUtxoPredFailure era
, EraRule "UTXO" era ~ AllegraUTXO era
, SafeToHash (TxWits era)
) =>
TransitionRule (EraRule "UTXO" era)
utxoTransition :: forall era.
(EraUTxO era, EraStake era, EraCertState era, ShelleyEraTxBody era,
AllegraEraTxBody era, Eq (EraRuleFailure "PPUP" era),
Show (EraRuleFailure "PPUP" era),
Embed (EraRule "PPUP" era) (EraRule "UTXO" era),
Environment (EraRule "PPUP" era) ~ PpupEnv era,
State (EraRule "PPUP" era) ~ ShelleyGovState era,
Signal (EraRule "PPUP" era) ~ StrictMaybe (Update era),
GovState era ~ ShelleyGovState era,
InjectRuleFailure "UTXO" AllegraUtxoPredFailure era,
InjectRuleFailure "UTXO" ShelleyUtxoPredFailure era,
EraRule "UTXO" era ~ AllegraUTXO era, SafeToHash (TxWits era)) =>
TransitionRule (EraRule "UTXO" era)
utxoTransition = do
TRC (Shelley.UtxoEnv SlotNo
slot PParams era
pp CertState era
certState, State (AllegraUTXO era)
utxos, Signal (AllegraUTXO era)
tx) <- Rule
(AllegraUTXO era)
'Transition
(RuleContext 'Transition (AllegraUTXO era))
F (Clause (AllegraUTXO era) 'Transition) (TRC (AllegraUTXO era))
forall sts (rtype :: RuleType).
Rule sts rtype (RuleContext rtype sts)
judgmentContext
let Shelley.UTxOState UTxO era
utxo Coin
_ Coin
_ GovState era
ppup InstantStake era
_ Coin
_ = State (AllegraUTXO era)
utxos
txBody :: TxBody era
txBody = Tx era
Signal (AllegraUTXO era)
tx Tx era -> Getting (TxBody era) (Tx era) (TxBody era) -> TxBody era
forall s a. s -> Getting a s a -> a
^. Getting (TxBody era) (Tx era) (TxBody era)
forall era. EraTx era => Lens' (Tx era) (TxBody era)
Lens' (Tx era) (TxBody era)
bodyTxL
genDelegs :: GenDelegs
genDelegs = CertState era
certState CertState era
-> Getting GenDelegs (CertState era) GenDelegs -> GenDelegs
forall s a. s -> Getting a s a -> a
^. (DState era -> Const GenDelegs (DState era))
-> CertState era -> Const GenDelegs (CertState era)
forall era. EraCertState era => Lens' (CertState era) (DState era)
Lens' (CertState era) (DState era)
Shelley.certDStateL ((DState era -> Const GenDelegs (DState era))
-> CertState era -> Const GenDelegs (CertState era))
-> ((GenDelegs -> Const GenDelegs GenDelegs)
-> DState era -> Const GenDelegs (DState era))
-> Getting GenDelegs (CertState era) GenDelegs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GenDelegs -> Const GenDelegs GenDelegs)
-> DState era -> Const GenDelegs (DState era)
forall era (f :: * -> *).
Functor f =>
(GenDelegs -> f GenDelegs) -> DState era -> f (DState era)
Shelley.dsGenDelegsL
Test (AllegraUtxoPredFailure era)
-> Rule (EraRule "UTXO" era) 'Transition ()
forall (rule :: Symbol) (f :: * -> *) era (ctx :: RuleType).
InjectRuleFailure rule f era =>
Test (f era) -> Rule (EraRule rule era) ctx ()
runTest (Test (AllegraUtxoPredFailure era)
-> Rule (EraRule "UTXO" era) 'Transition ())
-> Test (AllegraUtxoPredFailure era)
-> Rule (EraRule "UTXO" era) 'Transition ()
forall a b. (a -> b) -> a -> b
$ SlotNo -> TxBody era -> Test (AllegraUtxoPredFailure era)
forall era.
AllegraEraTxBody era =>
SlotNo -> TxBody era -> Test (AllegraUtxoPredFailure era)
validateOutsideValidityIntervalUTxO SlotNo
slot TxBody era
txBody
Test (ShelleyUtxoPredFailure era)
-> Rule (EraRule "UTXO" era) 'Transition ()
forall (rule :: Symbol) (f :: * -> *) era (ctx :: RuleType).
InjectRuleFailure rule f era =>
Test (f era) -> Rule (EraRule rule era) ctx ()
runTest (Test (ShelleyUtxoPredFailure era)
-> Rule (EraRule "UTXO" era) 'Transition ())
-> Test (ShelleyUtxoPredFailure era)
-> Rule (EraRule "UTXO" era) 'Transition ()
forall a b. (a -> b) -> a -> b
$ TxBody era -> Test (ShelleyUtxoPredFailure era)
forall era.
EraTxBody era =>
TxBody era -> Test (ShelleyUtxoPredFailure era)
Shelley.validateInputSetEmptyUTxO TxBody era
txBody
Test (ShelleyUtxoPredFailure era)
-> Rule (EraRule "UTXO" era) 'Transition ()
forall (rule :: Symbol) (f :: * -> *) era (ctx :: RuleType).
InjectRuleFailure rule f era =>
Test (f era) -> Rule (EraRule rule era) ctx ()
runTest (Test (ShelleyUtxoPredFailure era)
-> Rule (EraRule "UTXO" era) 'Transition ())
-> Test (ShelleyUtxoPredFailure era)
-> Rule (EraRule "UTXO" era) 'Transition ()
forall a b. (a -> b) -> a -> b
$ PParams era
-> Tx era -> UTxO era -> Test (ShelleyUtxoPredFailure era)
forall era.
EraUTxO era =>
PParams era
-> Tx era -> UTxO era -> Test (ShelleyUtxoPredFailure era)
Shelley.validateFeeTooSmallUTxO PParams era
pp Tx era
Signal (AllegraUTXO era)
tx UTxO era
utxo
Test (ShelleyUtxoPredFailure era)
-> Rule (EraRule "UTXO" era) 'Transition ()
forall (rule :: Symbol) (f :: * -> *) era (ctx :: RuleType).
InjectRuleFailure rule f era =>
Test (f era) -> Rule (EraRule rule era) ctx ()
runTest (Test (ShelleyUtxoPredFailure era)
-> Rule (EraRule "UTXO" era) 'Transition ())
-> Test (ShelleyUtxoPredFailure era)
-> Rule (EraRule "UTXO" era) 'Transition ()
forall a b. (a -> b) -> a -> b
$ UTxO era -> Set TxIn -> Test (ShelleyUtxoPredFailure era)
forall era.
UTxO era -> Set TxIn -> Test (ShelleyUtxoPredFailure era)
Shelley.validateBadInputsUTxO UTxO era
utxo (Set TxIn -> Test (ShelleyUtxoPredFailure era))
-> Set TxIn -> Test (ShelleyUtxoPredFailure era)
forall a b. (a -> b) -> a -> b
$ TxBody era
txBody TxBody era
-> Getting (Set TxIn) (TxBody era) (Set TxIn) -> Set TxIn
forall s a. s -> Getting a s a -> a
^. Getting (Set TxIn) (TxBody era) (Set TxIn)
forall era. EraTxBody era => Lens' (TxBody era) (Set TxIn)
Lens' (TxBody era) (Set TxIn)
inputsTxBodyL
Network
netId <- BaseM (AllegraUTXO era) Network
-> Rule (AllegraUTXO era) 'Transition Network
forall sts a (ctx :: RuleType).
STS sts =>
BaseM sts a -> Rule sts ctx a
liftSTS (BaseM (AllegraUTXO era) Network
-> Rule (AllegraUTXO era) 'Transition Network)
-> BaseM (AllegraUTXO era) Network
-> Rule (AllegraUTXO era) 'Transition Network
forall a b. (a -> b) -> a -> b
$ (Globals -> Network) -> ReaderT Globals Identity Network
forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
asks Globals -> Network
networkId
Test (ShelleyUtxoPredFailure era)
-> Rule (EraRule "UTXO" era) 'Transition ()
forall (rule :: Symbol) (f :: * -> *) era (ctx :: RuleType).
InjectRuleFailure rule f era =>
Test (f era) -> Rule (EraRule rule era) ctx ()
runTest (Test (ShelleyUtxoPredFailure era)
-> Rule (EraRule "UTXO" era) 'Transition ())
-> Test (ShelleyUtxoPredFailure era)
-> Rule (EraRule "UTXO" era) 'Transition ()
forall a b. (a -> b) -> a -> b
$ Network -> [TxOut era] -> Test (ShelleyUtxoPredFailure era)
forall era (f :: * -> *).
(EraTxOut era, Foldable f) =>
Network -> f (TxOut era) -> Test (ShelleyUtxoPredFailure era)
Shelley.validateWrongNetwork Network
netId ([TxOut era] -> Test (ShelleyUtxoPredFailure era))
-> (StrictSeq (TxOut era) -> [TxOut era])
-> StrictSeq (TxOut era)
-> Test (ShelleyUtxoPredFailure era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StrictSeq (TxOut era) -> [TxOut era]
forall a. StrictSeq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (StrictSeq (TxOut era) -> Test (ShelleyUtxoPredFailure era))
-> StrictSeq (TxOut era) -> Test (ShelleyUtxoPredFailure era)
forall a b. (a -> b) -> a -> b
$ TxBody era
txBody TxBody era
-> Getting
(StrictSeq (TxOut era)) (TxBody era) (StrictSeq (TxOut era))
-> StrictSeq (TxOut era)
forall s a. s -> Getting a s a -> a
^. Getting
(StrictSeq (TxOut era)) (TxBody era) (StrictSeq (TxOut era))
forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxOut era))
Lens' (TxBody era) (StrictSeq (TxOut era))
outputsTxBodyL
Test (ShelleyUtxoPredFailure era)
-> Rule (EraRule "UTXO" era) 'Transition ()
forall (rule :: Symbol) (f :: * -> *) era (ctx :: RuleType).
InjectRuleFailure rule f era =>
Test (f era) -> Rule (EraRule rule era) ctx ()
runTest (Test (ShelleyUtxoPredFailure era)
-> Rule (EraRule "UTXO" era) 'Transition ())
-> Test (ShelleyUtxoPredFailure era)
-> Rule (EraRule "UTXO" era) 'Transition ()
forall a b. (a -> b) -> a -> b
$ Network -> TxBody era -> Test (ShelleyUtxoPredFailure era)
forall era.
EraTxBody era =>
Network -> TxBody era -> Test (ShelleyUtxoPredFailure era)
Shelley.validateWrongNetworkWithdrawal Network
netId TxBody era
txBody
Test (ShelleyUtxoPredFailure era)
-> Rule (EraRule "UTXO" era) 'Transition ()
forall (rule :: Symbol) (f :: * -> *) era (ctx :: RuleType).
InjectRuleFailure rule f era =>
Test (f era) -> Rule (EraRule rule era) ctx ()
runTest (Test (ShelleyUtxoPredFailure era)
-> Rule (EraRule "UTXO" era) 'Transition ())
-> Test (ShelleyUtxoPredFailure era)
-> Rule (EraRule "UTXO" era) 'Transition ()
forall a b. (a -> b) -> a -> b
$ PParams era
-> UTxO era
-> CertState era
-> TxBody era
-> Test (ShelleyUtxoPredFailure era)
forall era.
(EraUTxO era, EraCertState era) =>
PParams era
-> UTxO era
-> CertState era
-> TxBody era
-> Test (ShelleyUtxoPredFailure era)
Shelley.validateValueNotConservedUTxO PParams era
pp UTxO era
utxo CertState era
certState TxBody era
txBody
ShelleyGovState era
ppup' <-
forall sub super (rtype :: RuleType).
Embed sub super =>
RuleContext rtype sub -> Rule super rtype (State sub)
trans @(EraRule "PPUP" era) (RuleContext 'Transition (EraRule "PPUP" era)
-> Rule (AllegraUTXO era) 'Transition (State (EraRule "PPUP" era)))
-> RuleContext 'Transition (EraRule "PPUP" era)
-> Rule (AllegraUTXO era) 'Transition (State (EraRule "PPUP" era))
forall a b. (a -> b) -> a -> b
$ (Environment (EraRule "PPUP" era), State (EraRule "PPUP" era),
Signal (EraRule "PPUP" era))
-> TRC (EraRule "PPUP" era)
forall sts. (Environment sts, State sts, Signal sts) -> TRC sts
TRC (SlotNo -> PParams era -> GenDelegs -> PpupEnv era
forall era. SlotNo -> PParams era -> GenDelegs -> PpupEnv era
PPUPEnv SlotNo
slot PParams era
pp GenDelegs
genDelegs, GovState era
State (EraRule "PPUP" era)
ppup, TxBody era
txBody TxBody era
-> Getting
(StrictMaybe (Update era)) (TxBody era) (StrictMaybe (Update era))
-> StrictMaybe (Update era)
forall s a. s -> Getting a s a -> a
^. Getting
(StrictMaybe (Update era)) (TxBody era) (StrictMaybe (Update era))
forall era.
ShelleyEraTxBody era =>
Lens' (TxBody era) (StrictMaybe (Update era))
Lens' (TxBody era) (StrictMaybe (Update era))
updateTxBodyL)
let outputs :: UTxO era
outputs = TxBody era -> UTxO era
forall era. EraTxBody era => TxBody era -> UTxO era
txouts TxBody era
txBody
Test (AllegraUtxoPredFailure era)
-> Rule (EraRule "UTXO" era) 'Transition ()
forall (rule :: Symbol) (f :: * -> *) era (ctx :: RuleType).
InjectRuleFailure rule f era =>
Test (f era) -> Rule (EraRule rule era) ctx ()
runTest (Test (AllegraUtxoPredFailure era)
-> Rule (EraRule "UTXO" era) 'Transition ())
-> Test (AllegraUtxoPredFailure era)
-> Rule (EraRule "UTXO" era) 'Transition ()
forall a b. (a -> b) -> a -> b
$ PParams era -> UTxO era -> Test (AllegraUtxoPredFailure era)
forall era.
EraTxOut era =>
PParams era -> UTxO era -> Test (AllegraUtxoPredFailure era)
validateOutputTooSmallUTxO PParams era
pp UTxO era
outputs
Test (AllegraUtxoPredFailure era)
-> Rule (EraRule "UTXO" era) 'Transition ()
forall (rule :: Symbol) (f :: * -> *) era (ctx :: RuleType).
InjectRuleFailure rule f era =>
Test (f era) -> Rule (EraRule rule era) ctx ()
runTest (Test (AllegraUtxoPredFailure era)
-> Rule (EraRule "UTXO" era) 'Transition ())
-> Test (AllegraUtxoPredFailure era)
-> Rule (EraRule "UTXO" era) 'Transition ()
forall a b. (a -> b) -> a -> b
$ PParams era -> UTxO era -> Test (AllegraUtxoPredFailure era)
forall era.
EraTxOut era =>
PParams era -> UTxO era -> Test (AllegraUtxoPredFailure era)
validateOutputTooBigUTxO PParams era
pp UTxO era
outputs
Test (ShelleyUtxoPredFailure era)
-> Rule (EraRule "UTXO" era) 'Transition ()
forall (rule :: Symbol) (f :: * -> *) era (ctx :: RuleType).
InjectRuleFailure rule f era =>
Test (f era) -> Rule (EraRule rule era) ctx ()
runTest (Test (ShelleyUtxoPredFailure era)
-> Rule (EraRule "UTXO" era) 'Transition ())
-> Test (ShelleyUtxoPredFailure era)
-> Rule (EraRule "UTXO" era) 'Transition ()
forall a b. (a -> b) -> a -> b
$ [TxOut era] -> Test (ShelleyUtxoPredFailure era)
forall era (f :: * -> *).
(EraTxOut era, Foldable f) =>
f (TxOut era) -> Test (ShelleyUtxoPredFailure era)
Shelley.validateOutputBootAddrAttrsTooBig (Map TxIn (TxOut era) -> [TxOut era]
forall k a. Map k a -> [a]
Map.elems (UTxO era -> Map TxIn (TxOut era)
forall era. UTxO era -> Map TxIn (TxOut era)
unUTxO UTxO era
outputs))
Test (ShelleyUtxoPredFailure era)
-> Rule (EraRule "UTXO" era) 'Transition ()
forall (rule :: Symbol) (f :: * -> *) era (ctx :: RuleType).
InjectRuleFailure rule f era =>
Test (f era) -> Rule (EraRule rule era) ctx ()
runTest (Test (ShelleyUtxoPredFailure era)
-> Rule (EraRule "UTXO" era) 'Transition ())
-> Test (ShelleyUtxoPredFailure era)
-> Rule (EraRule "UTXO" era) 'Transition ()
forall a b. (a -> b) -> a -> b
$ PParams era -> Tx era -> Test (ShelleyUtxoPredFailure era)
forall era.
EraTx era =>
PParams era -> Tx era -> Test (ShelleyUtxoPredFailure era)
Shelley.validateMaxTxSizeUTxO PParams era
pp Tx era
Signal (AllegraUTXO era)
tx
PParams era
-> UTxOState era
-> TxBody era
-> CertState era
-> GovState era
-> (Coin -> F (Clause (AllegraUTXO era) 'Transition) ())
-> (UTxO era
-> UTxO era -> F (Clause (AllegraUTXO era) 'Transition) ())
-> F (Clause (AllegraUTXO era) 'Transition) (UTxOState era)
forall era (m :: * -> *).
(EraTxBody era, EraStake era, EraCertState era, Monad m) =>
PParams era
-> UTxOState era
-> TxBody era
-> CertState era
-> GovState era
-> (Coin -> m ())
-> (UTxO era -> UTxO era -> m ())
-> m (UTxOState era)
Shelley.updateUTxOState
PParams era
pp
State (AllegraUTXO era)
UTxOState era
utxos
TxBody era
txBody
CertState era
certState
GovState era
ShelleyGovState era
ppup'
(Event (AllegraUTXO era)
-> F (Clause (AllegraUTXO era) 'Transition) ()
AllegraUtxoEvent era -> F (Clause (AllegraUTXO era) 'Transition) ()
forall sts (ctx :: RuleType). Event sts -> Rule sts ctx ()
tellEvent (AllegraUtxoEvent era
-> F (Clause (AllegraUTXO era) 'Transition) ())
-> (Coin -> AllegraUtxoEvent era)
-> Coin
-> F (Clause (AllegraUTXO era) 'Transition) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SafeHash EraIndependentTxBody -> Coin -> AllegraUtxoEvent era
forall era.
SafeHash EraIndependentTxBody -> Coin -> AllegraUtxoEvent era
TotalDeposits (TxBody era -> SafeHash EraIndependentTxBody
forall x i. HashAnnotated x i => x -> SafeHash i
hashAnnotated TxBody era
txBody))
(\UTxO era
a UTxO era
b -> Event (AllegraUTXO era)
-> F (Clause (AllegraUTXO era) 'Transition) ()
forall sts (ctx :: RuleType). Event sts -> Rule sts ctx ()
tellEvent (Event (AllegraUTXO era)
-> F (Clause (AllegraUTXO era) 'Transition) ())
-> Event (AllegraUTXO era)
-> F (Clause (AllegraUTXO era) 'Transition) ()
forall a b. (a -> b) -> a -> b
$ UTxO era -> UTxO era -> AllegraUtxoEvent era
forall era. UTxO era -> UTxO era -> AllegraUtxoEvent era
TxUTxODiff UTxO era
a UTxO era
b)
validateOutsideValidityIntervalUTxO ::
AllegraEraTxBody era =>
SlotNo ->
TxBody era ->
Test (AllegraUtxoPredFailure era)
validateOutsideValidityIntervalUTxO :: forall era.
AllegraEraTxBody era =>
SlotNo -> TxBody era -> Test (AllegraUtxoPredFailure era)
validateOutsideValidityIntervalUTxO SlotNo
slot TxBody era
txb =
Bool
-> AllegraUtxoPredFailure era
-> Validation (NonEmpty (AllegraUtxoPredFailure era)) ()
forall e. Bool -> e -> Validation (NonEmpty e) ()
failureUnless (SlotNo -> ValidityInterval -> Bool
inInterval SlotNo
slot (TxBody era
txb TxBody era
-> Getting ValidityInterval (TxBody era) ValidityInterval
-> ValidityInterval
forall s a. s -> Getting a s a -> a
^. Getting ValidityInterval (TxBody era) ValidityInterval
forall era.
AllegraEraTxBody era =>
Lens' (TxBody era) ValidityInterval
Lens' (TxBody era) ValidityInterval
vldtTxBodyL)) (AllegraUtxoPredFailure era
-> Validation (NonEmpty (AllegraUtxoPredFailure era)) ())
-> AllegraUtxoPredFailure era
-> Validation (NonEmpty (AllegraUtxoPredFailure era)) ()
forall a b. (a -> b) -> a -> b
$
ValidityInterval -> SlotNo -> AllegraUtxoPredFailure era
forall era.
ValidityInterval -> SlotNo -> AllegraUtxoPredFailure era
OutsideValidityIntervalUTxO (TxBody era
txb TxBody era
-> Getting ValidityInterval (TxBody era) ValidityInterval
-> ValidityInterval
forall s a. s -> Getting a s a -> a
^. Getting ValidityInterval (TxBody era) ValidityInterval
forall era.
AllegraEraTxBody era =>
Lens' (TxBody era) ValidityInterval
Lens' (TxBody era) ValidityInterval
vldtTxBodyL) SlotNo
slot
validateOutputTooBigUTxO ::
EraTxOut era =>
PParams era ->
UTxO era ->
Test (AllegraUtxoPredFailure era)
validateOutputTooBigUTxO :: forall era.
EraTxOut era =>
PParams era -> UTxO era -> Test (AllegraUtxoPredFailure era)
validateOutputTooBigUTxO PParams era
pp (UTxO Map TxIn (TxOut era)
outputs) =
Bool
-> AllegraUtxoPredFailure era
-> Validation (NonEmpty (AllegraUtxoPredFailure era)) ()
forall e. Bool -> e -> Validation (NonEmpty e) ()
failureUnless ([TxOut era] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [TxOut era]
outputsTooBig) (AllegraUtxoPredFailure era
-> Validation (NonEmpty (AllegraUtxoPredFailure era)) ())
-> AllegraUtxoPredFailure era
-> Validation (NonEmpty (AllegraUtxoPredFailure era)) ()
forall a b. (a -> b) -> a -> b
$ [TxOut era] -> AllegraUtxoPredFailure era
forall era. [TxOut era] -> AllegraUtxoPredFailure era
OutputTooBigUTxO [TxOut era]
outputsTooBig
where
version :: Version
version = ProtVer -> Version
pvMajor (PParams era
pp PParams era -> Getting ProtVer (PParams era) ProtVer -> ProtVer
forall s a. s -> Getting a s a -> a
^. Getting ProtVer (PParams era) ProtVer
forall era. EraPParams era => Lens' (PParams era) ProtVer
Lens' (PParams era) ProtVer
ppProtocolVersionL)
maxValSize :: Int64
maxValSize = Int64
4000 :: Int64
outputsTooBig :: [TxOut era]
outputsTooBig =
(TxOut era -> Bool) -> [TxOut era] -> [TxOut era]
forall a. (a -> Bool) -> [a] -> [a]
filter
( \TxOut era
out ->
let v :: Value era
v = TxOut era
out TxOut era
-> Getting (Value era) (TxOut era) (Value era) -> Value era
forall s a. s -> Getting a s a -> a
^. Getting (Value era) (TxOut era) (Value era)
forall era. EraTxOut era => Lens' (TxOut era) (Value era)
Lens' (TxOut era) (Value era)
valueTxOutL
in ByteString -> Int64
BSL.length (Version -> Value era -> ByteString
forall a. EncCBOR a => Version -> a -> ByteString
serialize Version
version Value era
v) Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
> Int64
maxValSize
)
(Map TxIn (TxOut era) -> [TxOut era]
forall k a. Map k a -> [a]
Map.elems Map TxIn (TxOut era)
outputs)
validateOutputTooSmallUTxO ::
EraTxOut era =>
PParams era ->
UTxO era ->
Test (AllegraUtxoPredFailure era)
validateOutputTooSmallUTxO :: forall era.
EraTxOut era =>
PParams era -> UTxO era -> Test (AllegraUtxoPredFailure era)
validateOutputTooSmallUTxO PParams era
pp (UTxO Map TxIn (TxOut era)
outputs) =
Bool
-> AllegraUtxoPredFailure era
-> Validation (NonEmpty (AllegraUtxoPredFailure era)) ()
forall e. Bool -> e -> Validation (NonEmpty e) ()
failureUnless ([TxOut era] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [TxOut era]
outputsTooSmall) (AllegraUtxoPredFailure era
-> Validation (NonEmpty (AllegraUtxoPredFailure era)) ())
-> AllegraUtxoPredFailure era
-> Validation (NonEmpty (AllegraUtxoPredFailure era)) ()
forall a b. (a -> b) -> a -> b
$ [TxOut era] -> AllegraUtxoPredFailure era
forall era. [TxOut era] -> AllegraUtxoPredFailure era
OutputTooSmallUTxO [TxOut era]
outputsTooSmall
where
outputsTooSmall :: [TxOut era]
outputsTooSmall =
(TxOut era -> Bool) -> [TxOut era] -> [TxOut era]
forall a. (a -> Bool) -> [a] -> [a]
filter
( \TxOut era
txOut ->
let v :: Value era
v = TxOut era
txOut TxOut era
-> Getting (Value era) (TxOut era) (Value era) -> Value era
forall s a. s -> Getting a s a -> a
^. Getting (Value era) (TxOut era) (Value era)
forall era. EraTxOut era => Lens' (TxOut era) (Value era)
Lens' (TxOut era) (Value era)
valueTxOutL
in (Integer -> Integer -> Bool) -> Value era -> Value era -> Bool
forall t. Val t => (Integer -> Integer -> Bool) -> t -> t -> Bool
Val.pointwise Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
(<) Value era
v (Coin -> Value era
forall t s. Inject t s => t -> s
Val.inject (Coin -> Value era) -> Coin -> Value era
forall a b. (a -> b) -> a -> b
$ PParams era -> TxOut era -> Coin
forall era. EraTxOut era => PParams era -> TxOut era -> Coin
getMinCoinTxOut PParams era
pp TxOut era
txOut)
)
(Map TxIn (TxOut era) -> [TxOut era]
forall k a. Map k a -> [a]
Map.elems Map TxIn (TxOut era)
outputs)
instance
( EraTx era
, EraUTxO era
, EraStake era
, EraCertState era
, ShelleyEraTxBody era
, AllegraEraTxBody era
, Embed (EraRule "PPUP" era) (AllegraUTXO era)
, Environment (EraRule "PPUP" era) ~ PpupEnv era
, State (EraRule "PPUP" era) ~ ShelleyGovState era
, Signal (EraRule "PPUP" era) ~ StrictMaybe (Update era)
, ProtVerAtMost era 8
, Eq (EraRuleFailure "PPUP" era)
, Show (EraRuleFailure "PPUP" era)
, EraRule "UTXO" era ~ AllegraUTXO era
, GovState era ~ ShelleyGovState era
, InjectRuleFailure "UTXO" AllegraUtxoPredFailure era
, InjectRuleFailure "UTXO" Shelley.ShelleyUtxoPredFailure era
, SafeToHash (TxWits era)
) =>
STS (AllegraUTXO era)
where
type State (AllegraUTXO era) = Shelley.UTxOState era
type Signal (AllegraUTXO era) = Tx era
type Environment (AllegraUTXO era) = Shelley.UtxoEnv era
type BaseM (AllegraUTXO era) = ShelleyBase
type PredicateFailure (AllegraUTXO era) = AllegraUtxoPredFailure era
type Event (AllegraUTXO era) = AllegraUtxoEvent era
initialRules :: [InitialRule (AllegraUTXO era)]
initialRules = []
transitionRules :: [TransitionRule (AllegraUTXO era)]
transitionRules = [TransitionRule (EraRule "UTXO" era)
TransitionRule (AllegraUTXO era)
forall era.
(EraUTxO era, EraStake era, EraCertState era, ShelleyEraTxBody era,
AllegraEraTxBody era, Eq (EraRuleFailure "PPUP" era),
Show (EraRuleFailure "PPUP" era),
Embed (EraRule "PPUP" era) (EraRule "UTXO" era),
Environment (EraRule "PPUP" era) ~ PpupEnv era,
State (EraRule "PPUP" era) ~ ShelleyGovState era,
Signal (EraRule "PPUP" era) ~ StrictMaybe (Update era),
GovState era ~ ShelleyGovState era,
InjectRuleFailure "UTXO" AllegraUtxoPredFailure era,
InjectRuleFailure "UTXO" ShelleyUtxoPredFailure era,
EraRule "UTXO" era ~ AllegraUTXO era, SafeToHash (TxWits era)) =>
TransitionRule (EraRule "UTXO" era)
utxoTransition]
assertions :: [Assertion (AllegraUTXO era)]
assertions = [Assertion (AllegraUTXO era)
forall era (rule :: * -> *).
(EraTx era, SafeToHash (TxWits era), Signal (rule era) ~ Tx era) =>
Assertion (rule era)
Shelley.validSizeComputationCheck]
instance
( Era era
, STS (ShelleyPPUP era)
, EraRuleFailure "PPUP" era ~ ShelleyPpupPredFailure era
, Event (EraRule "PPUP" era) ~ Event (ShelleyPPUP era)
) =>
Embed (ShelleyPPUP era) (AllegraUTXO era)
where
wrapFailed :: PredicateFailure (ShelleyPPUP era)
-> PredicateFailure (AllegraUTXO era)
wrapFailed = EraRuleFailure "PPUP" era -> AllegraUtxoPredFailure era
PredicateFailure (ShelleyPPUP era)
-> PredicateFailure (AllegraUTXO era)
forall era. EraRuleFailure "PPUP" era -> AllegraUtxoPredFailure era
UpdateFailure
wrapEvent :: Event (ShelleyPPUP era) -> Event (AllegraUTXO era)
wrapEvent = Event (EraRule "PPUP" era) -> AllegraUtxoEvent era
Event (ShelleyPPUP era) -> Event (AllegraUTXO era)
forall era. Event (EraRule "PPUP" era) -> AllegraUtxoEvent era
UpdateEvent
instance
( Era era
, EncCBOR (Value era)
, EncCBOR (TxOut era)
, EncCBOR (EraRuleFailure "PPUP" era)
) =>
EncCBOR (AllegraUtxoPredFailure era)
where
encCBOR :: AllegraUtxoPredFailure era -> Encoding
encCBOR =
Encode 'Open (AllegraUtxoPredFailure era) -> Encoding
forall (w :: Wrapped) t. Encode w t -> Encoding
encode (Encode 'Open (AllegraUtxoPredFailure era) -> Encoding)
-> (AllegraUtxoPredFailure era
-> Encode 'Open (AllegraUtxoPredFailure era))
-> AllegraUtxoPredFailure era
-> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
BadInputsUTxO Set TxIn
ins -> (Set TxIn -> AllegraUtxoPredFailure era)
-> Word -> Encode 'Open (Set TxIn -> AllegraUtxoPredFailure era)
forall t. t -> Word -> Encode 'Open t
Sum Set TxIn -> AllegraUtxoPredFailure era
forall era. Set TxIn -> AllegraUtxoPredFailure era
BadInputsUTxO Word
0 Encode 'Open (Set TxIn -> AllegraUtxoPredFailure era)
-> Encode ('Closed 'Dense) (Set TxIn)
-> Encode 'Open (AllegraUtxoPredFailure era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> Set TxIn -> Encode ('Closed 'Dense) (Set TxIn)
forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Set TxIn
ins
OutsideValidityIntervalUTxO ValidityInterval
validityInterval SlotNo
slot ->
(ValidityInterval -> SlotNo -> AllegraUtxoPredFailure era)
-> Word
-> Encode
'Open (ValidityInterval -> SlotNo -> AllegraUtxoPredFailure era)
forall t. t -> Word -> Encode 'Open t
Sum ValidityInterval -> SlotNo -> AllegraUtxoPredFailure era
forall era.
ValidityInterval -> SlotNo -> AllegraUtxoPredFailure era
OutsideValidityIntervalUTxO Word
1 Encode
'Open (ValidityInterval -> SlotNo -> AllegraUtxoPredFailure era)
-> Encode ('Closed 'Dense) ValidityInterval
-> Encode 'Open (SlotNo -> AllegraUtxoPredFailure era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> ValidityInterval -> Encode ('Closed 'Dense) ValidityInterval
forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To ValidityInterval
validityInterval Encode 'Open (SlotNo -> AllegraUtxoPredFailure era)
-> Encode ('Closed 'Dense) SlotNo
-> Encode 'Open (AllegraUtxoPredFailure era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> SlotNo -> Encode ('Closed 'Dense) SlotNo
forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To SlotNo
slot
MaxTxSizeUTxO Mismatch 'RelLTEQ Integer
m -> (Mismatch 'RelLTEQ Integer -> AllegraUtxoPredFailure era)
-> Word
-> Encode
'Open (Mismatch 'RelLTEQ Integer -> AllegraUtxoPredFailure era)
forall t. t -> Word -> Encode 'Open t
Sum Mismatch 'RelLTEQ Integer -> AllegraUtxoPredFailure era
forall era. Mismatch 'RelLTEQ Integer -> AllegraUtxoPredFailure era
MaxTxSizeUTxO Word
2 Encode
'Open (Mismatch 'RelLTEQ Integer -> AllegraUtxoPredFailure era)
-> Encode ('Closed 'Dense) (Mismatch 'RelLTEQ Integer)
-> Encode 'Open (AllegraUtxoPredFailure era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> Mismatch 'RelLTEQ Integer
-> Encode ('Closed 'Dense) (Mismatch 'RelLTEQ Integer)
forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Mismatch 'RelLTEQ Integer
m
AllegraUtxoPredFailure era
InputSetEmptyUTxO -> AllegraUtxoPredFailure era
-> Word -> Encode 'Open (AllegraUtxoPredFailure era)
forall t. t -> Word -> Encode 'Open t
Sum AllegraUtxoPredFailure era
forall era. AllegraUtxoPredFailure era
InputSetEmptyUTxO Word
3
FeeTooSmallUTxO Mismatch 'RelGTEQ Coin
m -> (Mismatch 'RelGTEQ Coin -> AllegraUtxoPredFailure era)
-> Word
-> Encode
'Open (Mismatch 'RelGTEQ Coin -> AllegraUtxoPredFailure era)
forall t. t -> Word -> Encode 'Open t
Sum Mismatch 'RelGTEQ Coin -> AllegraUtxoPredFailure era
forall era. Mismatch 'RelGTEQ Coin -> AllegraUtxoPredFailure era
FeeTooSmallUTxO Word
4 Encode 'Open (Mismatch 'RelGTEQ Coin -> AllegraUtxoPredFailure era)
-> Encode ('Closed 'Dense) (Mismatch 'RelGTEQ Coin)
-> Encode 'Open (AllegraUtxoPredFailure era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> Mismatch 'RelGTEQ Coin
-> Encode ('Closed 'Dense) (Mismatch 'RelGTEQ Coin)
forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Mismatch 'RelGTEQ Coin
m
ValueNotConservedUTxO Mismatch 'RelEQ (Value era)
m -> (Mismatch 'RelEQ (Value era) -> AllegraUtxoPredFailure era)
-> Word
-> Encode
'Open (Mismatch 'RelEQ (Value era) -> AllegraUtxoPredFailure era)
forall t. t -> Word -> Encode 'Open t
Sum Mismatch 'RelEQ (Value era) -> AllegraUtxoPredFailure era
forall era.
Mismatch 'RelEQ (Value era) -> AllegraUtxoPredFailure era
ValueNotConservedUTxO Word
5 Encode
'Open (Mismatch 'RelEQ (Value era) -> AllegraUtxoPredFailure era)
-> Encode ('Closed 'Dense) (Mismatch 'RelEQ (Value era))
-> Encode 'Open (AllegraUtxoPredFailure era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> Mismatch 'RelEQ (Value era)
-> Encode ('Closed 'Dense) (Mismatch 'RelEQ (Value era))
forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Mismatch 'RelEQ (Value era)
m
OutputTooSmallUTxO [TxOut era]
outs -> ([TxOut era] -> AllegraUtxoPredFailure era)
-> Word -> Encode 'Open ([TxOut era] -> AllegraUtxoPredFailure era)
forall t. t -> Word -> Encode 'Open t
Sum [TxOut era] -> AllegraUtxoPredFailure era
forall era. [TxOut era] -> AllegraUtxoPredFailure era
OutputTooSmallUTxO Word
6 Encode 'Open ([TxOut era] -> AllegraUtxoPredFailure era)
-> Encode ('Closed 'Dense) [TxOut era]
-> Encode 'Open (AllegraUtxoPredFailure era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> [TxOut era] -> Encode ('Closed 'Dense) [TxOut era]
forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To [TxOut era]
outs
UpdateFailure EraRuleFailure "PPUP" era
fails -> (EraRuleFailure "PPUP" era -> AllegraUtxoPredFailure era)
-> Word
-> Encode
'Open (EraRuleFailure "PPUP" era -> AllegraUtxoPredFailure era)
forall t. t -> Word -> Encode 'Open t
Sum EraRuleFailure "PPUP" era -> AllegraUtxoPredFailure era
forall era. EraRuleFailure "PPUP" era -> AllegraUtxoPredFailure era
UpdateFailure Word
7 Encode
'Open (EraRuleFailure "PPUP" era -> AllegraUtxoPredFailure era)
-> Encode ('Closed 'Dense) (EraRuleFailure "PPUP" era)
-> Encode 'Open (AllegraUtxoPredFailure era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> EraRuleFailure "PPUP" era
-> Encode ('Closed 'Dense) (EraRuleFailure "PPUP" era)
forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To EraRuleFailure "PPUP" era
fails
WrongNetwork Network
right Set Addr
wrongs -> (Network -> Set Addr -> AllegraUtxoPredFailure era)
-> Word
-> Encode 'Open (Network -> Set Addr -> AllegraUtxoPredFailure era)
forall t. t -> Word -> Encode 'Open t
Sum Network -> Set Addr -> AllegraUtxoPredFailure era
forall era. Network -> Set Addr -> AllegraUtxoPredFailure era
WrongNetwork Word
8 Encode 'Open (Network -> Set Addr -> AllegraUtxoPredFailure era)
-> Encode ('Closed 'Dense) Network
-> Encode 'Open (Set Addr -> AllegraUtxoPredFailure era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> Network -> Encode ('Closed 'Dense) Network
forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Network
right Encode 'Open (Set Addr -> AllegraUtxoPredFailure era)
-> Encode ('Closed 'Dense) (Set Addr)
-> Encode 'Open (AllegraUtxoPredFailure era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> Set Addr -> Encode ('Closed 'Dense) (Set Addr)
forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Set Addr
wrongs
WrongNetworkWithdrawal Network
right Set RewardAccount
wrongs -> (Network -> Set RewardAccount -> AllegraUtxoPredFailure era)
-> Word
-> Encode
'Open (Network -> Set RewardAccount -> AllegraUtxoPredFailure era)
forall t. t -> Word -> Encode 'Open t
Sum Network -> Set RewardAccount -> AllegraUtxoPredFailure era
forall era.
Network -> Set RewardAccount -> AllegraUtxoPredFailure era
WrongNetworkWithdrawal Word
9 Encode
'Open (Network -> Set RewardAccount -> AllegraUtxoPredFailure era)
-> Encode ('Closed 'Dense) Network
-> Encode 'Open (Set RewardAccount -> AllegraUtxoPredFailure era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> Network -> Encode ('Closed 'Dense) Network
forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Network
right Encode 'Open (Set RewardAccount -> AllegraUtxoPredFailure era)
-> Encode ('Closed 'Dense) (Set RewardAccount)
-> Encode 'Open (AllegraUtxoPredFailure era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> Set RewardAccount -> Encode ('Closed 'Dense) (Set RewardAccount)
forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Set RewardAccount
wrongs
OutputBootAddrAttrsTooBig [TxOut era]
outs -> ([TxOut era] -> AllegraUtxoPredFailure era)
-> Word -> Encode 'Open ([TxOut era] -> AllegraUtxoPredFailure era)
forall t. t -> Word -> Encode 'Open t
Sum [TxOut era] -> AllegraUtxoPredFailure era
forall era. [TxOut era] -> AllegraUtxoPredFailure era
OutputBootAddrAttrsTooBig Word
10 Encode 'Open ([TxOut era] -> AllegraUtxoPredFailure era)
-> Encode ('Closed 'Dense) [TxOut era]
-> Encode 'Open (AllegraUtxoPredFailure era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> [TxOut era] -> Encode ('Closed 'Dense) [TxOut era]
forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To [TxOut era]
outs
AllegraUtxoPredFailure era
TriesToForgeADA -> AllegraUtxoPredFailure era
-> Word -> Encode 'Open (AllegraUtxoPredFailure era)
forall t. t -> Word -> Encode 'Open t
Sum AllegraUtxoPredFailure era
forall era. AllegraUtxoPredFailure era
TriesToForgeADA Word
11
OutputTooBigUTxO [TxOut era]
outs -> ([TxOut era] -> AllegraUtxoPredFailure era)
-> Word -> Encode 'Open ([TxOut era] -> AllegraUtxoPredFailure era)
forall t. t -> Word -> Encode 'Open t
Sum [TxOut era] -> AllegraUtxoPredFailure era
forall era. [TxOut era] -> AllegraUtxoPredFailure era
OutputTooBigUTxO Word
12 Encode 'Open ([TxOut era] -> AllegraUtxoPredFailure era)
-> Encode ('Closed 'Dense) [TxOut era]
-> Encode 'Open (AllegraUtxoPredFailure era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> [TxOut era] -> Encode ('Closed 'Dense) [TxOut era]
forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To [TxOut era]
outs
instance
( EraTxOut era
, DecCBOR (EraRuleFailure "PPUP" era)
) =>
DecCBOR (AllegraUtxoPredFailure era)
where
decCBOR :: forall s. Decoder s (AllegraUtxoPredFailure era)
decCBOR = Decode ('Closed 'Dense) (AllegraUtxoPredFailure era)
-> Decoder s (AllegraUtxoPredFailure era)
forall t (w :: Wrapped) s. Typeable t => Decode w t -> Decoder s t
decode (Decode ('Closed 'Dense) (AllegraUtxoPredFailure era)
-> Decoder s (AllegraUtxoPredFailure era))
-> ((Word -> Decode 'Open (AllegraUtxoPredFailure era))
-> Decode ('Closed 'Dense) (AllegraUtxoPredFailure era))
-> (Word -> Decode 'Open (AllegraUtxoPredFailure era))
-> Decoder s (AllegraUtxoPredFailure era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text
-> (Word -> Decode 'Open (AllegraUtxoPredFailure era))
-> Decode ('Closed 'Dense) (AllegraUtxoPredFailure era)
forall t.
Text -> (Word -> Decode 'Open t) -> Decode ('Closed 'Dense) t
Summands Text
"AllegraUtxoPredFailure" ((Word -> Decode 'Open (AllegraUtxoPredFailure era))
-> Decoder s (AllegraUtxoPredFailure era))
-> (Word -> Decode 'Open (AllegraUtxoPredFailure era))
-> Decoder s (AllegraUtxoPredFailure era)
forall a b. (a -> b) -> a -> b
$ \case
Word
0 -> (Set TxIn -> AllegraUtxoPredFailure era)
-> Decode 'Open (Set TxIn -> AllegraUtxoPredFailure era)
forall t. t -> Decode 'Open t
SumD Set TxIn -> AllegraUtxoPredFailure era
forall era. Set TxIn -> AllegraUtxoPredFailure era
BadInputsUTxO Decode 'Open (Set TxIn -> AllegraUtxoPredFailure era)
-> Decode ('Closed Any) (Set TxIn)
-> Decode 'Open (AllegraUtxoPredFailure era)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) (Set TxIn)
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
Word
1 -> (ValidityInterval -> SlotNo -> AllegraUtxoPredFailure era)
-> Decode
'Open (ValidityInterval -> SlotNo -> AllegraUtxoPredFailure era)
forall t. t -> Decode 'Open t
SumD ValidityInterval -> SlotNo -> AllegraUtxoPredFailure era
forall era.
ValidityInterval -> SlotNo -> AllegraUtxoPredFailure era
OutsideValidityIntervalUTxO Decode
'Open (ValidityInterval -> SlotNo -> AllegraUtxoPredFailure era)
-> Decode ('Closed Any) ValidityInterval
-> Decode 'Open (SlotNo -> AllegraUtxoPredFailure era)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) ValidityInterval
forall t (w :: Wrapped). DecCBOR t => Decode w t
From Decode 'Open (SlotNo -> AllegraUtxoPredFailure era)
-> Decode ('Closed Any) SlotNo
-> Decode 'Open (AllegraUtxoPredFailure era)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) SlotNo
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
Word
2 -> (Mismatch 'RelLTEQ Integer -> AllegraUtxoPredFailure era)
-> Decode
'Open (Mismatch 'RelLTEQ Integer -> AllegraUtxoPredFailure era)
forall t. t -> Decode 'Open t
SumD Mismatch 'RelLTEQ Integer -> AllegraUtxoPredFailure era
forall era. Mismatch 'RelLTEQ Integer -> AllegraUtxoPredFailure era
MaxTxSizeUTxO Decode
'Open (Mismatch 'RelLTEQ Integer -> AllegraUtxoPredFailure era)
-> Decode ('Closed Any) (Mismatch 'RelLTEQ Integer)
-> Decode 'Open (AllegraUtxoPredFailure era)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) (Mismatch 'RelLTEQ Integer)
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
Word
3 -> AllegraUtxoPredFailure era
-> Decode 'Open (AllegraUtxoPredFailure era)
forall t. t -> Decode 'Open t
SumD AllegraUtxoPredFailure era
forall era. AllegraUtxoPredFailure era
InputSetEmptyUTxO
Word
4 -> (Mismatch 'RelGTEQ Coin -> AllegraUtxoPredFailure era)
-> Decode
'Open (Mismatch 'RelGTEQ Coin -> AllegraUtxoPredFailure era)
forall t. t -> Decode 'Open t
SumD Mismatch 'RelGTEQ Coin -> AllegraUtxoPredFailure era
forall era. Mismatch 'RelGTEQ Coin -> AllegraUtxoPredFailure era
FeeTooSmallUTxO Decode 'Open (Mismatch 'RelGTEQ Coin -> AllegraUtxoPredFailure era)
-> Decode ('Closed Any) (Mismatch 'RelGTEQ Coin)
-> Decode 'Open (AllegraUtxoPredFailure era)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) (Mismatch 'RelGTEQ Coin)
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
Word
5 -> (Mismatch 'RelEQ (Value era) -> AllegraUtxoPredFailure era)
-> Decode
'Open (Mismatch 'RelEQ (Value era) -> AllegraUtxoPredFailure era)
forall t. t -> Decode 'Open t
SumD Mismatch 'RelEQ (Value era) -> AllegraUtxoPredFailure era
forall era.
Mismatch 'RelEQ (Value era) -> AllegraUtxoPredFailure era
ValueNotConservedUTxO Decode
'Open (Mismatch 'RelEQ (Value era) -> AllegraUtxoPredFailure era)
-> Decode ('Closed Any) (Mismatch 'RelEQ (Value era))
-> Decode 'Open (AllegraUtxoPredFailure era)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) (Mismatch 'RelEQ (Value era))
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
Word
6 -> ([TxOut era] -> AllegraUtxoPredFailure era)
-> Decode 'Open ([TxOut era] -> AllegraUtxoPredFailure era)
forall t. t -> Decode 'Open t
SumD [TxOut era] -> AllegraUtxoPredFailure era
forall era. [TxOut era] -> AllegraUtxoPredFailure era
OutputTooSmallUTxO Decode 'Open ([TxOut era] -> AllegraUtxoPredFailure era)
-> Decode ('Closed Any) [TxOut era]
-> Decode 'Open (AllegraUtxoPredFailure era)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) [TxOut era]
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
Word
7 -> (EraRuleFailure "PPUP" era -> AllegraUtxoPredFailure era)
-> Decode
'Open (EraRuleFailure "PPUP" era -> AllegraUtxoPredFailure era)
forall t. t -> Decode 'Open t
SumD EraRuleFailure "PPUP" era -> AllegraUtxoPredFailure era
forall era. EraRuleFailure "PPUP" era -> AllegraUtxoPredFailure era
UpdateFailure Decode
'Open (EraRuleFailure "PPUP" era -> AllegraUtxoPredFailure era)
-> Decode ('Closed Any) (EraRuleFailure "PPUP" era)
-> Decode 'Open (AllegraUtxoPredFailure era)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) (EraRuleFailure "PPUP" era)
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
Word
8 -> (Network -> Set Addr -> AllegraUtxoPredFailure era)
-> Decode 'Open (Network -> Set Addr -> AllegraUtxoPredFailure era)
forall t. t -> Decode 'Open t
SumD Network -> Set Addr -> AllegraUtxoPredFailure era
forall era. Network -> Set Addr -> AllegraUtxoPredFailure era
WrongNetwork Decode 'Open (Network -> Set Addr -> AllegraUtxoPredFailure era)
-> Decode ('Closed Any) Network
-> Decode 'Open (Set Addr -> AllegraUtxoPredFailure era)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) Network
forall t (w :: Wrapped). DecCBOR t => Decode w t
From Decode 'Open (Set Addr -> AllegraUtxoPredFailure era)
-> Decode ('Closed Any) (Set Addr)
-> Decode 'Open (AllegraUtxoPredFailure era)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) (Set Addr)
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
Word
9 -> (Network -> Set RewardAccount -> AllegraUtxoPredFailure era)
-> Decode
'Open (Network -> Set RewardAccount -> AllegraUtxoPredFailure era)
forall t. t -> Decode 'Open t
SumD Network -> Set RewardAccount -> AllegraUtxoPredFailure era
forall era.
Network -> Set RewardAccount -> AllegraUtxoPredFailure era
WrongNetworkWithdrawal Decode
'Open (Network -> Set RewardAccount -> AllegraUtxoPredFailure era)
-> Decode ('Closed Any) Network
-> Decode 'Open (Set RewardAccount -> AllegraUtxoPredFailure era)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) Network
forall t (w :: Wrapped). DecCBOR t => Decode w t
From Decode 'Open (Set RewardAccount -> AllegraUtxoPredFailure era)
-> Decode ('Closed Any) (Set RewardAccount)
-> Decode 'Open (AllegraUtxoPredFailure era)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) (Set RewardAccount)
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
Word
10 -> ([TxOut era] -> AllegraUtxoPredFailure era)
-> Decode 'Open ([TxOut era] -> AllegraUtxoPredFailure era)
forall t. t -> Decode 'Open t
SumD [TxOut era] -> AllegraUtxoPredFailure era
forall era. [TxOut era] -> AllegraUtxoPredFailure era
OutputBootAddrAttrsTooBig Decode 'Open ([TxOut era] -> AllegraUtxoPredFailure era)
-> Decode ('Closed Any) [TxOut era]
-> Decode 'Open (AllegraUtxoPredFailure era)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) [TxOut era]
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
Word
11 -> AllegraUtxoPredFailure era
-> Decode 'Open (AllegraUtxoPredFailure era)
forall t. t -> Decode 'Open t
SumD AllegraUtxoPredFailure era
forall era. AllegraUtxoPredFailure era
TriesToForgeADA
Word
12 -> ([TxOut era] -> AllegraUtxoPredFailure era)
-> Decode 'Open ([TxOut era] -> AllegraUtxoPredFailure era)
forall t. t -> Decode 'Open t
SumD [TxOut era] -> AllegraUtxoPredFailure era
forall era. [TxOut era] -> AllegraUtxoPredFailure era
OutputTooBigUTxO Decode 'Open ([TxOut era] -> AllegraUtxoPredFailure era)
-> Decode ('Closed Any) [TxOut era]
-> Decode 'Open (AllegraUtxoPredFailure era)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) [TxOut era]
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
Word
k -> Word -> Decode 'Open (AllegraUtxoPredFailure era)
forall (w :: Wrapped) t. Word -> Decode w t
Invalid Word
k
shelleyToAllegraUtxoPredFailure :: Shelley.ShelleyUtxoPredFailure era -> AllegraUtxoPredFailure era
shelleyToAllegraUtxoPredFailure :: forall era.
ShelleyUtxoPredFailure era -> AllegraUtxoPredFailure era
shelleyToAllegraUtxoPredFailure = \case
Shelley.BadInputsUTxO Set TxIn
ins -> Set TxIn -> AllegraUtxoPredFailure era
forall era. Set TxIn -> AllegraUtxoPredFailure era
BadInputsUTxO Set TxIn
ins
Shelley.ExpiredUTxO Mismatch {mismatchSupplied :: forall (r :: Relation) a. Mismatch r a -> a
mismatchSupplied = SlotNo
ttl, mismatchExpected :: forall (r :: Relation) a. Mismatch r a -> a
mismatchExpected = SlotNo
current} ->
ValidityInterval -> SlotNo -> AllegraUtxoPredFailure era
forall era.
ValidityInterval -> SlotNo -> AllegraUtxoPredFailure era
OutsideValidityIntervalUTxO (StrictMaybe SlotNo -> StrictMaybe SlotNo -> ValidityInterval
ValidityInterval StrictMaybe SlotNo
forall a. StrictMaybe a
SNothing (SlotNo -> StrictMaybe SlotNo
forall a. a -> StrictMaybe a
SJust SlotNo
ttl)) SlotNo
current
Shelley.MaxTxSizeUTxO Mismatch 'RelLTEQ Integer
m -> Mismatch 'RelLTEQ Integer -> AllegraUtxoPredFailure era
forall era. Mismatch 'RelLTEQ Integer -> AllegraUtxoPredFailure era
MaxTxSizeUTxO Mismatch 'RelLTEQ Integer
m
ShelleyUtxoPredFailure era
Shelley.InputSetEmptyUTxO -> AllegraUtxoPredFailure era
forall era. AllegraUtxoPredFailure era
InputSetEmptyUTxO
Shelley.FeeTooSmallUTxO Mismatch 'RelGTEQ Coin
m -> Mismatch 'RelGTEQ Coin -> AllegraUtxoPredFailure era
forall era. Mismatch 'RelGTEQ Coin -> AllegraUtxoPredFailure era
FeeTooSmallUTxO Mismatch 'RelGTEQ Coin
m
Shelley.ValueNotConservedUTxO Mismatch 'RelEQ (Value era)
m -> Mismatch 'RelEQ (Value era) -> AllegraUtxoPredFailure era
forall era.
Mismatch 'RelEQ (Value era) -> AllegraUtxoPredFailure era
ValueNotConservedUTxO Mismatch 'RelEQ (Value era)
m
Shelley.WrongNetwork Network
n Set Addr
as -> Network -> Set Addr -> AllegraUtxoPredFailure era
forall era. Network -> Set Addr -> AllegraUtxoPredFailure era
WrongNetwork Network
n Set Addr
as
Shelley.WrongNetworkWithdrawal Network
n Set RewardAccount
as -> Network -> Set RewardAccount -> AllegraUtxoPredFailure era
forall era.
Network -> Set RewardAccount -> AllegraUtxoPredFailure era
WrongNetworkWithdrawal Network
n Set RewardAccount
as
Shelley.OutputTooSmallUTxO [TxOut era]
x -> [TxOut era] -> AllegraUtxoPredFailure era
forall era. [TxOut era] -> AllegraUtxoPredFailure era
OutputTooSmallUTxO [TxOut era]
x
Shelley.UpdateFailure EraRuleFailure "PPUP" era
x -> EraRuleFailure "PPUP" era -> AllegraUtxoPredFailure era
forall era. EraRuleFailure "PPUP" era -> AllegraUtxoPredFailure era
UpdateFailure EraRuleFailure "PPUP" era
x
Shelley.OutputBootAddrAttrsTooBig [TxOut era]
outs -> [TxOut era] -> AllegraUtxoPredFailure era
forall era. [TxOut era] -> AllegraUtxoPredFailure era
OutputTooBigUTxO [TxOut era]
outs