{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
-- The STS instance for UTXO is technically an orphan.
{-# OPTIONS_GHC -Wno-orphans #-}

module Cardano.Ledger.ShelleyMA.Rules.Utxo where

import Cardano.Binary (FromCBOR (..), ToCBOR (..), encodeListLen)
import qualified Cardano.Ledger.Core as Core
import qualified Cardano.Ledger.Crypto as CryptoClass
import Cardano.Ledger.Era (Crypto)
import Cardano.Ledger.Shelley.Constraints (ShelleyBased)
import Cardano.Ledger.ShelleyMA (MaryOrAllegra, ShelleyMAEra)
import Cardano.Ledger.ShelleyMA.Timelocks
import Cardano.Ledger.ShelleyMA.TxBody (TxBody)
import Cardano.Ledger.Torsor (Torsor (..))
import qualified Cardano.Ledger.Val as Val
import Cardano.Slotting.Slot (SlotNo)
import Control.Iterate.SetAlgebra (dom, eval, (∪), (⊆), (⋪), (◁))
import Control.Monad.Trans.Reader (asks)
import Control.State.Transition.Extended
import Data.Coders
  ( decodeList,
    decodeRecordSum,
    decodeSet,
    encodeFoldable,
    invalidKey,
  )
import Data.Foldable (fold, toList)
import qualified Data.Map.Strict as Map
import Data.Sequence.Strict (StrictSeq)
import Data.Set (Set)
import qualified Data.Set as Set
import Data.Typeable
import Data.Word (Word8)
import GHC.Generics (Generic)
import GHC.Records
import NoThunks.Class (NoThunks)
import Shelley.Spec.Ledger.Address
  ( Addr (AddrBootstrap),
    bootstrapAddressAttrsSize,
    getNetwork,
  )
import Shelley.Spec.Ledger.BaseTypes
  ( Network,
    ShelleyBase,
    StrictMaybe (..),
    networkId,
  )
import Shelley.Spec.Ledger.Coin
import qualified Shelley.Spec.Ledger.LedgerState as Shelley
import Shelley.Spec.Ledger.PParams (PParams, PParams' (..), Update)
import Shelley.Spec.Ledger.STS.Ppup (PPUP, PPUPEnv (..))
import Shelley.Spec.Ledger.STS.Utxo (UTXO)
import qualified Shelley.Spec.Ledger.STS.Utxo as Shelley
import Shelley.Spec.Ledger.Tx (Tx (..), TxIn)
import Shelley.Spec.Ledger.TxBody
  ( DCert,
    RewardAcnt (getRwdNetwork),
    TxOut (TxOut),
    Wdrl,
    unWdrl,
  )
import Shelley.Spec.Ledger.UTxO
  ( UTxO,
    balance,
    totalDeposits,
    txins,
    txouts,
    txup,
    unUTxO,
  )

data UtxoPredicateFailure era
  = BadInputsUTxO
      !(Set (TxIn (Crypto era))) -- The bad transaction inputs
  | OutsideValidityIntervalUTxO
      !ValidityInterval -- transaction's validity interval
      !SlotNo -- current slot
  | MaxTxSizeUTxO
      !Integer -- the actual transaction size
      !Integer -- the max transaction size
  | InputSetEmptyUTxO
  | FeeTooSmallUTxO
      !Coin -- the minimum fee for this transaction
      !Coin -- the fee supplied in this transaction
  | ValueNotConservedUTxO
      !(Delta (Core.Value era)) -- the Coin consumed by this transaction
      !(Delta (Core.Value era)) -- the Coin produced by this transaction
  | WrongNetwork
      !Network -- the expected network id
      !(Set (Addr (Crypto era))) -- the set of addresses with incorrect network IDs
  | WrongNetworkWithdrawal
      !Network -- the expected network id
      !(Set (RewardAcnt (Crypto era))) -- the set of reward addresses with incorrect network IDs
  | OutputTooSmallUTxO
      ![TxOut era] -- list of supplied transaction outputs that are too small
  | UpdateFailure (PredicateFailure (PPUP era)) -- Subtransition Failures
  | OutputBootAddrAttrsTooBig
      ![TxOut era] -- list of supplied bad transaction outputs
  | TriesToForgeADA
  deriving ((forall x.
 UtxoPredicateFailure era -> Rep (UtxoPredicateFailure era) x)
-> (forall x.
    Rep (UtxoPredicateFailure era) x -> UtxoPredicateFailure era)
-> Generic (UtxoPredicateFailure era)
forall x.
Rep (UtxoPredicateFailure era) x -> UtxoPredicateFailure era
forall x.
UtxoPredicateFailure era -> Rep (UtxoPredicateFailure era) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall era x.
Rep (UtxoPredicateFailure era) x -> UtxoPredicateFailure era
forall era x.
UtxoPredicateFailure era -> Rep (UtxoPredicateFailure era) x
$cto :: forall era x.
Rep (UtxoPredicateFailure era) x -> UtxoPredicateFailure era
$cfrom :: forall era x.
UtxoPredicateFailure era -> Rep (UtxoPredicateFailure era) x
Generic)

deriving stock instance
  ShelleyBased era =>
  Show (UtxoPredicateFailure era)

deriving stock instance
  ShelleyBased era =>
  Eq (UtxoPredicateFailure era)

instance NoThunks (Delta (Core.Value era)) => NoThunks (UtxoPredicateFailure era)

-- | Calculate the value consumed by the transation.
--
--   This differs from the corresponding Shelley function @Shelley.consumed@
--   since it also considers the "mint" field which creates or destroys non-Ada
--   tokens.
--
--   Note that this is slightly confusing, since it also covers non-Ada assets
--   _created_ by the transaction, depending on the sign of the quantities in
--   the mint field.
consumed ::
  forall era.
  ( ShelleyBased era,
    HasField "certs" (Core.TxBody era) (StrictSeq (DCert (Crypto era))),
    HasField "inputs" (Core.TxBody era) (Set (TxIn (Crypto era))),
    HasField "mint" (Core.TxBody era) (Core.Value era),
    HasField "wdrls" (Core.TxBody era) (Wdrl (Crypto era))
  ) =>
  PParams era ->
  UTxO era ->
  Core.TxBody era ->
  Core.Value era
consumed :: PParams era -> UTxO era -> TxBody era -> Value era
consumed PParams era
pp UTxO era
u TxBody era
tx =
  UTxO era -> Value era
forall era. ShelleyBased era => UTxO era -> Value era
balance (Exp (Map (TxIn (Crypto era)) (TxOut era)) -> UTxO era
forall s t. Embed s t => Exp t -> s
eval (TxBody era -> Set (TxIn (Crypto era))
forall era.
HasField "inputs" (TxBody era) (Set (TxIn (Crypto era))) =>
TxBody era -> Set (TxIn (Crypto era))
txins @era TxBody era
tx Set (TxIn (Crypto era))
-> UTxO era -> Exp (Map (TxIn (Crypto era)) (TxOut era))
forall k s1 s2 (f :: * -> * -> *) v.
(Ord k, HasExp s1 (Sett k ()), HasExp s2 (f k v)) =>
s1 -> s2 -> Exp (f k v)
 UTxO era
u))
    Value era -> Value era -> Value era
forall a. Semigroup a => a -> a -> a
<> TxBody era -> Value era
forall k (x :: k) r a. HasField x r a => r -> a
getField @"mint" TxBody era
tx
    Value era -> Value era -> Value era
forall a. Semigroup a => a -> a -> a
<> (Coin -> Value era
forall t. Val t => Coin -> t
Val.inject (Coin -> Value era) -> Coin -> Value era
forall a b. (a -> b) -> a -> b
$ Coin
refunds Coin -> Coin -> Coin
forall a. Semigroup a => a -> a -> a
<> Coin
withdrawals)
  where
    -- balance (UTxO (Map.restrictKeys v (txins tx))) + refunds + withdrawals
    refunds :: Coin
refunds = PParams era -> TxBody era -> Coin
forall era.
HasField "certs" (TxBody era) (StrictSeq (DCert (Crypto era))) =>
PParams era -> TxBody era -> Coin
Shelley.keyRefunds PParams era
pp TxBody era
tx
    withdrawals :: Coin
withdrawals = Map (RewardAcnt (Crypto era)) Coin -> Coin
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold (Map (RewardAcnt (Crypto era)) Coin -> Coin)
-> (Wdrl (Crypto era) -> Map (RewardAcnt (Crypto era)) Coin)
-> Wdrl (Crypto era)
-> Coin
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Wdrl (Crypto era) -> Map (RewardAcnt (Crypto era)) Coin
forall crypto. Wdrl crypto -> Map (RewardAcnt crypto) Coin
unWdrl (Wdrl (Crypto era) -> Coin) -> Wdrl (Crypto era) -> Coin
forall a b. (a -> b) -> a -> b
$ TxBody era -> Wdrl (Crypto era)
forall k (x :: k) r a. HasField x r a => r -> a
getField @"wdrls" TxBody era
tx

-- | The UTxO transition rule for the Shelley-MA (Mary and Allegra) eras.
utxoTransition ::
  forall era.
  ( ShelleyBased era,
    STS (UTXO era),
    Embed (PPUP era) (UTXO era),
    BaseM (UTXO era) ~ ShelleyBase,
    Environment (UTXO era) ~ Shelley.UtxoEnv era,
    State (UTXO era) ~ Shelley.UTxOState era,
    Signal (UTXO era) ~ Tx era,
    PredicateFailure (UTXO era) ~ UtxoPredicateFailure era,
    HasField "certs" (Core.TxBody era) (StrictSeq (DCert (Crypto era))),
    HasField "inputs" (Core.TxBody era) (Set (TxIn (Crypto era))),
    HasField "mint" (Core.TxBody era) (Core.Value era),
    HasField "outputs" (Core.TxBody era) (StrictSeq (TxOut era)),
    HasField "wdrls" (Core.TxBody era) (Wdrl (Crypto era)),
    HasField "txfee" (Core.TxBody era) Coin,
    HasField "vldt" (Core.TxBody era) ValidityInterval,
    HasField "update" (Core.TxBody era) (StrictMaybe (Update era))
  ) =>
  TransitionRule (UTXO era)
utxoTransition :: TransitionRule (UTXO era)
utxoTransition = do
  TRC (Shelley.UtxoEnv slot pp stakepools genDelegs, State (UTXO era)
u, Signal (UTXO era)
tx) <- F (Clause (UTXO era) 'Transition) (TRC (UTXO era))
forall sts (rtype :: RuleType).
Rule sts rtype (RuleContext rtype sts)
judgmentContext
  let Shelley.UTxOState UTxO era
utxo Coin
deposits' Coin
fees PPUPState era
ppup = UTxOState era
State (UTXO era)
u
  let txb :: TxBody era
txb = Tx era
-> (TxBodyConstraints era, ToCBOR (AuxiliaryData era)) =>
   TxBody era
forall era.
Tx era
-> (TxBodyConstraints era, ToCBOR (AuxiliaryData era)) =>
   TxBody era
_body Tx era
Signal (UTXO era)
tx

  SlotNo -> ValidityInterval -> Bool
inInterval SlotNo
slot (TxBody era -> ValidityInterval
forall k (x :: k) r a. HasField x r a => r -> a
getField @"vldt" TxBody era
txb)
    Bool
-> PredicateFailure (UTXO era) -> Rule (UTXO era) 'Transition ()
forall sts (ctx :: RuleType).
Bool -> PredicateFailure sts -> Rule sts ctx ()
?! ValidityInterval -> SlotNo -> UtxoPredicateFailure era
forall era. ValidityInterval -> SlotNo -> UtxoPredicateFailure era
OutsideValidityIntervalUTxO (TxBody era -> ValidityInterval
forall k (x :: k) r a. HasField x r a => r -> a
getField @"vldt" TxBody era
txb) SlotNo
slot

  TxBody era -> Set (TxIn (Crypto era))
forall era.
HasField "inputs" (TxBody era) (Set (TxIn (Crypto era))) =>
TxBody era -> Set (TxIn (Crypto era))
txins @era TxBody era
txb Set (TxIn (Crypto era)) -> Set (TxIn (Crypto era)) -> Bool
forall a. Eq a => a -> a -> Bool
/= Set (TxIn (Crypto era))
forall a. Set a
Set.empty Bool
-> PredicateFailure (UTXO era) -> Rule (UTXO era) 'Transition ()
forall sts (ctx :: RuleType).
Bool -> PredicateFailure sts -> Rule sts ctx ()
?! PredicateFailure (UTXO era)
forall era. UtxoPredicateFailure era
InputSetEmptyUTxO

  let minFee :: Coin
minFee = PParams era -> Tx era -> Coin
forall era. PParams era -> Tx era -> Coin
Shelley.minfee PParams era
pp Tx era
Signal (UTXO era)
tx
      txFee :: Coin
txFee = TxBody era -> Coin
forall k (x :: k) r a. HasField x r a => r -> a
getField @"txfee" TxBody era
txb
  Coin
minFee Coin -> Coin -> Bool
forall a. Ord a => a -> a -> Bool
<= Coin
txFee Bool
-> PredicateFailure (UTXO era) -> Rule (UTXO era) 'Transition ()
forall sts (ctx :: RuleType).
Bool -> PredicateFailure sts -> Rule sts ctx ()
?! Coin -> Coin -> UtxoPredicateFailure era
forall era. Coin -> Coin -> UtxoPredicateFailure era
FeeTooSmallUTxO Coin
minFee Coin
txFee

  Exp Bool -> Bool
forall s t. Embed s t => Exp t -> s
eval (TxBody era -> Set (TxIn (Crypto era))
forall era.
HasField "inputs" (TxBody era) (Set (TxIn (Crypto era))) =>
TxBody era -> Set (TxIn (Crypto era))
txins @era TxBody era
txb Set (TxIn (Crypto era))
-> Exp (Sett (TxIn (Crypto era)) ()) -> Exp Bool
forall k (f :: * -> * -> *) (g :: * -> * -> *) s1 v s2 u.
(Ord k, Iter f, Iter g, HasExp s1 (f k v), HasExp s2 (g k u)) =>
s1 -> s2 -> Exp Bool
 UTxO era -> Exp (Sett (TxIn (Crypto era)) ())
forall k s (f :: * -> * -> *) v.
(Ord k, HasExp s (f k v)) =>
s -> Exp (Sett k ())
dom UTxO era
utxo)
    Bool
-> PredicateFailure (UTXO era) -> Rule (UTXO era) 'Transition ()
forall sts (ctx :: RuleType).
Bool -> PredicateFailure sts -> Rule sts ctx ()
?! Set (TxIn (Crypto era)) -> UtxoPredicateFailure era
forall era. Set (TxIn (Crypto era)) -> UtxoPredicateFailure era
BadInputsUTxO (TxBody era -> Set (TxIn (Crypto era))
forall era.
HasField "inputs" (TxBody era) (Set (TxIn (Crypto era))) =>
TxBody era -> Set (TxIn (Crypto era))
txins @era TxBody era
txb Set (TxIn (Crypto era))
-> Set (TxIn (Crypto era)) -> Set (TxIn (Crypto era))
forall a. Ord a => Set a -> Set a -> Set a
`Set.difference` Exp (Sett (TxIn (Crypto era)) ()) -> Set (TxIn (Crypto era))
forall s t. Embed s t => Exp t -> s
eval (UTxO era -> Exp (Sett (TxIn (Crypto era)) ())
forall k s (f :: * -> * -> *) v.
(Ord k, HasExp s (f k v)) =>
s -> Exp (Sett k ())
dom UTxO era
utxo))

  Network
ni <- BaseM (UTXO era) Network -> Rule (UTXO era) 'Transition Network
forall sts a (ctx :: RuleType).
STS sts =>
BaseM sts a -> Rule sts ctx a
liftSTS (BaseM (UTXO era) Network -> Rule (UTXO era) 'Transition Network)
-> BaseM (UTXO era) Network -> Rule (UTXO 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
  let addrsWrongNetwork :: [Addr (Crypto era)]
addrsWrongNetwork =
        (Addr (Crypto era) -> Bool)
-> [Addr (Crypto era)] -> [Addr (Crypto era)]
forall a. (a -> Bool) -> [a] -> [a]
filter
          (\Addr (Crypto era)
a -> Addr (Crypto era) -> Network
forall crypto. Addr crypto -> Network
getNetwork Addr (Crypto era)
a Network -> Network -> Bool
forall a. Eq a => a -> a -> Bool
/= Network
ni)
          ((TxOut era -> Addr (Crypto era))
-> [TxOut era] -> [Addr (Crypto era)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(TxOut Addr (Crypto era)
a Value era
_) -> Addr (Crypto era)
a) ([TxOut era] -> [Addr (Crypto era)])
-> [TxOut era] -> [Addr (Crypto era)]
forall a b. (a -> b) -> a -> b
$ StrictSeq (TxOut era) -> [TxOut era]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (StrictSeq (TxOut era) -> [TxOut era])
-> StrictSeq (TxOut era) -> [TxOut era]
forall a b. (a -> b) -> a -> b
$ TxBody era -> StrictSeq (TxOut era)
forall k (x :: k) r a. HasField x r a => r -> a
getField @"outputs" TxBody era
txb)
  [Addr (Crypto era)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Addr (Crypto era)]
addrsWrongNetwork Bool
-> PredicateFailure (UTXO era) -> Rule (UTXO era) 'Transition ()
forall sts (ctx :: RuleType).
Bool -> PredicateFailure sts -> Rule sts ctx ()
?! Network -> Set (Addr (Crypto era)) -> UtxoPredicateFailure era
forall era.
Network -> Set (Addr (Crypto era)) -> UtxoPredicateFailure era
WrongNetwork Network
ni ([Addr (Crypto era)] -> Set (Addr (Crypto era))
forall a. Ord a => [a] -> Set a
Set.fromList [Addr (Crypto era)]
addrsWrongNetwork)
  let wdrlsWrongNetwork :: [RewardAcnt (Crypto era)]
wdrlsWrongNetwork =
        (RewardAcnt (Crypto era) -> Bool)
-> [RewardAcnt (Crypto era)] -> [RewardAcnt (Crypto era)]
forall a. (a -> Bool) -> [a] -> [a]
filter
          (\RewardAcnt (Crypto era)
a -> RewardAcnt (Crypto era) -> Network
forall crypto. RewardAcnt crypto -> Network
getRwdNetwork RewardAcnt (Crypto era)
a Network -> Network -> Bool
forall a. Eq a => a -> a -> Bool
/= Network
ni)
          (Map (RewardAcnt (Crypto era)) Coin -> [RewardAcnt (Crypto era)]
forall k a. Map k a -> [k]
Map.keys (Map (RewardAcnt (Crypto era)) Coin -> [RewardAcnt (Crypto era)])
-> (TxBody era -> Map (RewardAcnt (Crypto era)) Coin)
-> TxBody era
-> [RewardAcnt (Crypto era)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Wdrl (Crypto era) -> Map (RewardAcnt (Crypto era)) Coin
forall crypto. Wdrl crypto -> Map (RewardAcnt crypto) Coin
unWdrl (Wdrl (Crypto era) -> Map (RewardAcnt (Crypto era)) Coin)
-> (TxBody era -> Wdrl (Crypto era))
-> TxBody era
-> Map (RewardAcnt (Crypto era)) Coin
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k (x :: k) r a. HasField x r a => r -> a
forall r a. HasField "wdrls" r a => r -> a
getField @"wdrls" (TxBody era -> [RewardAcnt (Crypto era)])
-> TxBody era -> [RewardAcnt (Crypto era)]
forall a b. (a -> b) -> a -> b
$ TxBody era
txb)
  [RewardAcnt (Crypto era)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [RewardAcnt (Crypto era)]
wdrlsWrongNetwork
    Bool
-> PredicateFailure (UTXO era) -> Rule (UTXO era) 'Transition ()
forall sts (ctx :: RuleType).
Bool -> PredicateFailure sts -> Rule sts ctx ()
?! Network
-> Set (RewardAcnt (Crypto era)) -> UtxoPredicateFailure era
forall era.
Network
-> Set (RewardAcnt (Crypto era)) -> UtxoPredicateFailure era
WrongNetworkWithdrawal
      Network
ni
      ([RewardAcnt (Crypto era)] -> Set (RewardAcnt (Crypto era))
forall a. Ord a => [a] -> Set a
Set.fromList [RewardAcnt (Crypto era)]
wdrlsWrongNetwork)

  let consumed_ :: Value era
consumed_ = PParams era -> UTxO era -> TxBody era -> Value era
forall era.
(ShelleyBased era,
 HasField "certs" (TxBody era) (StrictSeq (DCert (Crypto era))),
 HasField "inputs" (TxBody era) (Set (TxIn (Crypto era))),
 HasField "mint" (TxBody era) (Value era),
 HasField "wdrls" (TxBody era) (Wdrl (Crypto era))) =>
PParams era -> UTxO era -> TxBody era -> Value era
consumed PParams era
pp UTxO era
utxo TxBody era
txb
      produced_ :: Value era
produced_ = PParams era
-> Map (KeyHash 'StakePool (Crypto era)) (PoolParams (Crypto era))
-> TxBody era
-> Value era
forall era.
(ShelleyBased era,
 HasField "certs" (TxBody era) (StrictSeq (DCert (Crypto era))),
 HasField "outputs" (TxBody era) (StrictSeq (TxOut era)),
 HasField "txfee" (TxBody era) Coin) =>
PParams era
-> Map (KeyHash 'StakePool (Crypto era)) (PoolParams (Crypto era))
-> TxBody era
-> Value era
Shelley.produced PParams era
pp Map (KeyHash 'StakePool (Crypto era)) (PoolParams (Crypto era))
stakepools TxBody era
txb
  Value era
consumed_ Value era -> Value era -> Bool
forall a. Eq a => a -> a -> Bool
== Value era
produced_ Bool
-> PredicateFailure (UTXO era) -> Rule (UTXO era) 'Transition ()
forall sts (ctx :: RuleType).
Bool -> PredicateFailure sts -> Rule sts ctx ()
?! Delta (Value era) -> Delta (Value era) -> UtxoPredicateFailure era
forall era.
Delta (Value era) -> Delta (Value era) -> UtxoPredicateFailure era
ValueNotConservedUTxO (Value era -> Delta (Value era)
forall a. Torsor a => a -> Delta a
toDelta Value era
consumed_) (Value era -> Delta (Value era)
forall a. Torsor a => a -> Delta a
toDelta Value era
produced_)

  -- process Protocol Parameter Update Proposals
  PPUPState era
ppup' <- forall sub super (rtype :: RuleType).
Embed sub super =>
RuleContext rtype sub -> Rule super rtype (State sub)
forall super (rtype :: RuleType).
Embed (PPUP era) super =>
RuleContext rtype (PPUP era) -> Rule super rtype (State (PPUP era))
trans @(PPUP era) (RuleContext 'Transition (PPUP era)
 -> Rule (UTXO era) 'Transition (State (PPUP era)))
-> RuleContext 'Transition (PPUP era)
-> Rule (UTXO era) 'Transition (State (PPUP era))
forall a b. (a -> b) -> a -> b
$ (Environment (PPUP era), State (PPUP era), Signal (PPUP era))
-> TRC (PPUP era)
forall sts. (Environment sts, State sts, Signal sts) -> TRC sts
TRC (SlotNo -> PParams era -> GenDelegs (Crypto era) -> PPUPEnv era
forall era.
SlotNo -> PParams era -> GenDelegs (Crypto era) -> PPUPEnv era
PPUPEnv SlotNo
slot PParams era
pp GenDelegs (Crypto era)
genDelegs, PPUPState era
State (PPUP era)
ppup, Tx era -> Maybe (Update era)
forall era.
(ShelleyBased era,
 HasField "update" (TxBody era) (StrictMaybe (Update era))) =>
Tx era -> Maybe (Update era)
txup Tx era
Signal (UTXO era)
tx)

  -- Check that the mint field does not try to mint ADA. This is equivalent to
  -- the check `adaPolicy ∉ supp mint tx` in the spec.
  Value era -> Coin
forall t. Val t => t -> Coin
Val.coin (TxBody era -> Value era
forall k (x :: k) r a. HasField x r a => r -> a
getField @"mint" TxBody era
txb) Coin -> Coin -> Bool
forall a. Eq a => a -> a -> Bool
== Coin
forall t. Val t => t
Val.zero Bool
-> PredicateFailure (UTXO era) -> Rule (UTXO era) 'Transition ()
forall sts (ctx :: RuleType).
Bool -> PredicateFailure sts -> Rule sts ctx ()
?! PredicateFailure (UTXO era)
forall era. UtxoPredicateFailure era
TriesToForgeADA

  let outputs :: [TxOut era]
outputs = Map (TxIn (Crypto era)) (TxOut era) -> [TxOut era]
forall k a. Map k a -> [a]
Map.elems (Map (TxIn (Crypto era)) (TxOut era) -> [TxOut era])
-> Map (TxIn (Crypto era)) (TxOut era) -> [TxOut era]
forall a b. (a -> b) -> a -> b
$ UTxO era -> Map (TxIn (Crypto era)) (TxOut era)
forall era. UTxO era -> Map (TxIn (Crypto era)) (TxOut era)
unUTxO (TxBody era -> UTxO era
forall era.
(ShelleyBased era,
 HasField "outputs" (TxBody era) (StrictSeq (TxOut era))) =>
TxBody era -> UTxO era
txouts TxBody era
txb)
      minUTxOValue :: HKD Identity Coin
minUTxOValue = PParams era -> HKD Identity Coin
forall (f :: * -> *) era. PParams' f era -> HKD f Coin
_minUTxOValue PParams era
pp
      outputsTooSmall :: [TxOut era]
outputsTooSmall =
        [ TxOut era
out
          | out :: TxOut era
out@(TxOut Addr (Crypto era)
_ Value era
c) <- [TxOut era]
outputs,
            Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$
              (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
c
                (Coin -> Value era
forall t. Val t => Coin -> t
Val.inject (Coin -> Value era) -> Coin -> Value era
forall a b. (a -> b) -> a -> b
$ Value era -> Coin -> Coin
forall v. Val v => v -> Coin -> Coin
Val.scaledMinDeposit Value era
c Coin
HKD Identity Coin
minUTxOValue)
        ]
  [TxOut era] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [TxOut era]
outputsTooSmall Bool
-> PredicateFailure (UTXO era) -> Rule (UTXO era) 'Transition ()
forall sts (ctx :: RuleType).
Bool -> PredicateFailure sts -> Rule sts ctx ()
?! [TxOut era] -> UtxoPredicateFailure era
forall era. [TxOut era] -> UtxoPredicateFailure era
OutputTooSmallUTxO [TxOut era]
outputsTooSmall

  -- Bootstrap (i.e. Byron) addresses have variable sized attributes in them.
  -- It is important to limit their overall size.
  let outputsAttrsTooBig :: [TxOut era]
outputsAttrsTooBig =
        [ TxOut era
out
          | out :: TxOut era
out@(TxOut (AddrBootstrap BootstrapAddress (Crypto era)
addr) Value era
_) <- [TxOut era]
outputs,
            BootstrapAddress (Crypto era) -> Int
forall crypto. BootstrapAddress crypto -> Int
bootstrapAddressAttrsSize BootstrapAddress (Crypto era)
addr Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
64
        ]
  [TxOut era] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [TxOut era]
outputsAttrsTooBig Bool
-> PredicateFailure (UTXO era) -> Rule (UTXO era) 'Transition ()
forall sts (ctx :: RuleType).
Bool -> PredicateFailure sts -> Rule sts ctx ()
?! [TxOut era] -> UtxoPredicateFailure era
forall era. [TxOut era] -> UtxoPredicateFailure era
OutputBootAddrAttrsTooBig [TxOut era]
outputsAttrsTooBig

  let maxTxSize_ :: Integer
maxTxSize_ = Natural -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (PParams era -> HKD Identity Natural
forall (f :: * -> *) era. PParams' f era -> HKD f Natural
_maxTxSize PParams era
pp)
      txSize_ :: Integer
txSize_ = Tx era -> Integer
forall era. Tx era -> Integer
Shelley.txsize Tx era
Signal (UTXO era)
tx
  Integer
txSize_ Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
maxTxSize_ Bool
-> PredicateFailure (UTXO era) -> Rule (UTXO era) 'Transition ()
forall sts (ctx :: RuleType).
Bool -> PredicateFailure sts -> Rule sts ctx ()
?! Integer -> Integer -> UtxoPredicateFailure era
forall era. Integer -> Integer -> UtxoPredicateFailure era
MaxTxSizeUTxO Integer
txSize_ Integer
maxTxSize_

  let refunded :: Coin
refunded = PParams era -> TxBody era -> Coin
forall era.
HasField "certs" (TxBody era) (StrictSeq (DCert (Crypto era))) =>
PParams era -> TxBody era -> Coin
Shelley.keyRefunds PParams era
pp TxBody era
txb
  let txCerts :: [DCert (Crypto era)]
txCerts = StrictSeq (DCert (Crypto era)) -> [DCert (Crypto era)]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (StrictSeq (DCert (Crypto era)) -> [DCert (Crypto era)])
-> StrictSeq (DCert (Crypto era)) -> [DCert (Crypto era)]
forall a b. (a -> b) -> a -> b
$ TxBody era -> StrictSeq (DCert (Crypto era))
forall k (x :: k) r a. HasField x r a => r -> a
getField @"certs" TxBody era
txb
  let depositChange :: Coin
depositChange = PParams era
-> Map (KeyHash 'StakePool (Crypto era)) (PoolParams (Crypto era))
-> [DCert (Crypto era)]
-> Coin
forall era.
PParams era
-> Map (KeyHash 'StakePool (Crypto era)) (PoolParams (Crypto era))
-> [DCert (Crypto era)]
-> Coin
totalDeposits PParams era
pp Map (KeyHash 'StakePool (Crypto era)) (PoolParams (Crypto era))
stakepools [DCert (Crypto era)]
txCerts Coin -> Coin -> Coin
forall t. Val t => t -> t -> t
Val.<-> Coin
refunded

  UTxOState era -> F (Clause (UTXO era) 'Transition) (UTxOState era)
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    UTxOState :: forall era.
UTxO era -> Coin -> Coin -> PPUPState era -> UTxOState era
Shelley.UTxOState
      { _utxo :: UTxO era
Shelley._utxo = Exp (Map (TxIn (Crypto era)) (TxOut era)) -> UTxO era
forall s t. Embed s t => Exp t -> s
eval ((TxBody era -> Set (TxIn (Crypto era))
forall era.
HasField "inputs" (TxBody era) (Set (TxIn (Crypto era))) =>
TxBody era -> Set (TxIn (Crypto era))
txins @era TxBody era
txb Set (TxIn (Crypto era))
-> UTxO era -> Exp (Map (TxIn (Crypto era)) (TxOut era))
forall k (g :: * -> * -> *) s1 s2 (f :: * -> * -> *) v.
(Ord k, Iter g, HasExp s1 (g k ()), HasExp s2 (f k v)) =>
s1 -> s2 -> Exp (f k v)
 UTxO era
utxo) Exp (Map (TxIn (Crypto era)) (TxOut era))
-> UTxO era -> Exp (Map (TxIn (Crypto era)) (TxOut era))
forall k v s1 (f :: * -> * -> *) s2 (g :: * -> * -> *).
(Show k, Show v, Ord k, HasExp s1 (f k v), HasExp s2 (g k v)) =>
s1 -> s2 -> Exp (f k v)
 TxBody era -> UTxO era
forall era.
(ShelleyBased era,
 HasField "outputs" (TxBody era) (StrictSeq (TxOut era))) =>
TxBody era -> UTxO era
txouts TxBody era
txb),
        _deposited :: Coin
Shelley._deposited = Coin
deposits' Coin -> Coin -> Coin
forall a. Semigroup a => a -> a -> a
<> Coin
depositChange,
        _fees :: Coin
Shelley._fees = Coin
fees Coin -> Coin -> Coin
forall a. Semigroup a => a -> a -> a
<> (TxBody era -> Coin
forall k (x :: k) r a. HasField x r a => r -> a
getField @"txfee" TxBody era
txb),
        _ppups :: PPUPState era
Shelley._ppups = PPUPState era
ppup'
      }

--------------------------------------------------------------------------------
-- UTXO STS
--------------------------------------------------------------------------------

instance
  forall c (ma :: MaryOrAllegra).
  ( CryptoClass.Crypto c,
    Typeable ma,
    ShelleyBased (ShelleyMAEra ma c),
    Core.TxBody (ShelleyMAEra ma c) ~ TxBody (ShelleyMAEra ma c)
  ) =>
  STS (UTXO (ShelleyMAEra ma c))
  where
  type State (UTXO (ShelleyMAEra ma c)) = Shelley.UTxOState (ShelleyMAEra ma c)
  type Signal (UTXO (ShelleyMAEra ma c)) = Tx (ShelleyMAEra ma c)
  type
    Environment (UTXO (ShelleyMAEra ma c)) =
      Shelley.UtxoEnv (ShelleyMAEra ma c)
  type BaseM (UTXO (ShelleyMAEra ma c)) = ShelleyBase
  type
    PredicateFailure (UTXO (ShelleyMAEra ma c)) =
      UtxoPredicateFailure (ShelleyMAEra ma c)

  initialRules :: [InitialRule (UTXO (ShelleyMAEra ma c))]
initialRules = []
  transitionRules :: [TransitionRule (UTXO (ShelleyMAEra ma c))]
transitionRules = [TransitionRule (UTXO (ShelleyMAEra ma c))
forall era.
(ShelleyBased era, STS (UTXO era), Embed (PPUP era) (UTXO era),
 BaseM (UTXO era) ~ ShelleyBase,
 Environment (UTXO era) ~ UtxoEnv era,
 State (UTXO era) ~ UTxOState era, Signal (UTXO era) ~ Tx era,
 PredicateFailure (UTXO era) ~ UtxoPredicateFailure era,
 HasField "certs" (TxBody era) (StrictSeq (DCert (Crypto era))),
 HasField "inputs" (TxBody era) (Set (TxIn (Crypto era))),
 HasField "mint" (TxBody era) (Value era),
 HasField "outputs" (TxBody era) (StrictSeq (TxOut era)),
 HasField "wdrls" (TxBody era) (Wdrl (Crypto era)),
 HasField "txfee" (TxBody era) Coin,
 HasField "vldt" (TxBody era) ValidityInterval,
 HasField "update" (TxBody era) (StrictMaybe (Update era))) =>
TransitionRule (UTXO era)
utxoTransition]

instance
  (CryptoClass.Crypto c, Typeable ma) =>
  Embed (PPUP (ShelleyMAEra (ma :: MaryOrAllegra) c)) (UTXO (ShelleyMAEra ma c))
  where
  wrapFailed :: PredicateFailure (PPUP (ShelleyMAEra ma c))
-> PredicateFailure (UTXO (ShelleyMAEra ma c))
wrapFailed = PredicateFailure (PPUP (ShelleyMAEra ma c))
-> PredicateFailure (UTXO (ShelleyMAEra ma c))
forall era. PredicateFailure (PPUP era) -> UtxoPredicateFailure era
UpdateFailure

--------------------------------------------------------------------------------
-- Serialisation
--------------------------------------------------------------------------------
instance
  ShelleyBased era =>
  ToCBOR (UtxoPredicateFailure era)
  where
  toCBOR :: UtxoPredicateFailure era -> Encoding
toCBOR = \case
    BadInputsUTxO Set (TxIn (Crypto era))
ins ->
      Word -> Encoding
encodeListLen Word
2 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word8 -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR (Word8
0 :: Word8) Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Set (TxIn (Crypto era)) -> Encoding
forall a (f :: * -> *). (ToCBOR a, Foldable f) => f a -> Encoding
encodeFoldable Set (TxIn (Crypto era))
ins
    (OutsideValidityIntervalUTxO ValidityInterval
a SlotNo
b) ->
      Word -> Encoding
encodeListLen Word
3 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word8 -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR (Word8
1 :: Word8)
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> ValidityInterval -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR ValidityInterval
a
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> SlotNo -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR SlotNo
b
    (MaxTxSizeUTxO Integer
a Integer
b) ->
      Word -> Encoding
encodeListLen Word
3 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word8 -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR (Word8
2 :: Word8)
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Integer -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR Integer
a
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Integer -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR Integer
b
    UtxoPredicateFailure era
InputSetEmptyUTxO -> Word -> Encoding
encodeListLen Word
1 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word8 -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR (Word8
3 :: Word8)
    (FeeTooSmallUTxO Coin
a Coin
b) ->
      Word -> Encoding
encodeListLen Word
3 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word8 -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR (Word8
4 :: Word8)
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Coin -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR Coin
a
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Coin -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR Coin
b
    (ValueNotConservedUTxO Delta (Value era)
a Delta (Value era)
b) ->
      Word -> Encoding
encodeListLen Word
3 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word8 -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR (Word8
5 :: Word8)
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Delta (Value era) -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR Delta (Value era)
a
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Delta (Value era) -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR Delta (Value era)
b
    OutputTooSmallUTxO [TxOut era]
outs ->
      Word -> Encoding
encodeListLen Word
2 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word8 -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR (Word8
6 :: Word8)
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> [TxOut era] -> Encoding
forall a (f :: * -> *). (ToCBOR a, Foldable f) => f a -> Encoding
encodeFoldable [TxOut era]
outs
    (UpdateFailure PredicateFailure (PPUP era)
a) ->
      Word -> Encoding
encodeListLen Word
2 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word8 -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR (Word8
7 :: Word8)
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> PpupPredicateFailure era -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR PpupPredicateFailure era
PredicateFailure (PPUP era)
a
    (WrongNetwork Network
right Set (Addr (Crypto era))
wrongs) ->
      Word -> Encoding
encodeListLen Word
3 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word8 -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR (Word8
8 :: Word8)
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Network -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR Network
right
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Set (Addr (Crypto era)) -> Encoding
forall a (f :: * -> *). (ToCBOR a, Foldable f) => f a -> Encoding
encodeFoldable Set (Addr (Crypto era))
wrongs
    (WrongNetworkWithdrawal Network
right Set (RewardAcnt (Crypto era))
wrongs) ->
      Word -> Encoding
encodeListLen Word
3 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word8 -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR (Word8
9 :: Word8)
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Network -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR Network
right
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Set (RewardAcnt (Crypto era)) -> Encoding
forall a (f :: * -> *). (ToCBOR a, Foldable f) => f a -> Encoding
encodeFoldable Set (RewardAcnt (Crypto era))
wrongs
    OutputBootAddrAttrsTooBig [TxOut era]
outs ->
      Word -> Encoding
encodeListLen Word
2 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word8 -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR (Word8
10 :: Word8)
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> [TxOut era] -> Encoding
forall a (f :: * -> *). (ToCBOR a, Foldable f) => f a -> Encoding
encodeFoldable [TxOut era]
outs
    UtxoPredicateFailure era
TriesToForgeADA -> Word -> Encoding
encodeListLen Word
1 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word8 -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR (Word8
11 :: Word8)

instance
  ShelleyBased era =>
  FromCBOR (UtxoPredicateFailure era)
  where
  fromCBOR :: Decoder s (UtxoPredicateFailure era)
fromCBOR =
    String
-> (Word -> Decoder s (Int, UtxoPredicateFailure era))
-> Decoder s (UtxoPredicateFailure era)
forall s a. String -> (Word -> Decoder s (Int, a)) -> Decoder s a
decodeRecordSum String
"PredicateFailureUTXO" ((Word -> Decoder s (Int, UtxoPredicateFailure era))
 -> Decoder s (UtxoPredicateFailure era))
-> (Word -> Decoder s (Int, UtxoPredicateFailure era))
-> Decoder s (UtxoPredicateFailure era)
forall a b. (a -> b) -> a -> b
$
      \case
        Word
0 -> do
          Set (TxIn (Crypto era))
ins <- Decoder s (TxIn (Crypto era))
-> Decoder s (Set (TxIn (Crypto era)))
forall a s. Ord a => Decoder s a -> Decoder s (Set a)
decodeSet Decoder s (TxIn (Crypto era))
forall a s. FromCBOR a => Decoder s a
fromCBOR
          (Int, UtxoPredicateFailure era)
-> Decoder s (Int, UtxoPredicateFailure era)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
2, Set (TxIn (Crypto era)) -> UtxoPredicateFailure era
forall era. Set (TxIn (Crypto era)) -> UtxoPredicateFailure era
BadInputsUTxO Set (TxIn (Crypto era))
ins) -- The (2,..) indicates the number of things decoded, INCLUDING the tags, which are decoded by decodeRecordSumNamed
        Word
1 -> do
          ValidityInterval
a <- Decoder s ValidityInterval
forall a s. FromCBOR a => Decoder s a
fromCBOR
          SlotNo
b <- Decoder s SlotNo
forall a s. FromCBOR a => Decoder s a
fromCBOR
          (Int, UtxoPredicateFailure era)
-> Decoder s (Int, UtxoPredicateFailure era)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
3, ValidityInterval -> SlotNo -> UtxoPredicateFailure era
forall era. ValidityInterval -> SlotNo -> UtxoPredicateFailure era
OutsideValidityIntervalUTxO ValidityInterval
a SlotNo
b)
        Word
2 -> do
          Integer
a <- Decoder s Integer
forall a s. FromCBOR a => Decoder s a
fromCBOR
          Integer
b <- Decoder s Integer
forall a s. FromCBOR a => Decoder s a
fromCBOR
          (Int, UtxoPredicateFailure era)
-> Decoder s (Int, UtxoPredicateFailure era)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
3, Integer -> Integer -> UtxoPredicateFailure era
forall era. Integer -> Integer -> UtxoPredicateFailure era
MaxTxSizeUTxO Integer
a Integer
b)
        Word
3 -> (Int, UtxoPredicateFailure era)
-> Decoder s (Int, UtxoPredicateFailure era)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
1, UtxoPredicateFailure era
forall era. UtxoPredicateFailure era
InputSetEmptyUTxO)
        Word
4 -> do
          Coin
a <- Decoder s Coin
forall a s. FromCBOR a => Decoder s a
fromCBOR
          Coin
b <- Decoder s Coin
forall a s. FromCBOR a => Decoder s a
fromCBOR
          (Int, UtxoPredicateFailure era)
-> Decoder s (Int, UtxoPredicateFailure era)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
3, Coin -> Coin -> UtxoPredicateFailure era
forall era. Coin -> Coin -> UtxoPredicateFailure era
FeeTooSmallUTxO Coin
a Coin
b)
        Word
5 -> do
          Delta (Value era)
a <- Decoder s (Delta (Value era))
forall a s. FromCBOR a => Decoder s a
fromCBOR
          Delta (Value era)
b <- Decoder s (Delta (Value era))
forall a s. FromCBOR a => Decoder s a
fromCBOR
          (Int, UtxoPredicateFailure era)
-> Decoder s (Int, UtxoPredicateFailure era)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
3, Delta (Value era) -> Delta (Value era) -> UtxoPredicateFailure era
forall era.
Delta (Value era) -> Delta (Value era) -> UtxoPredicateFailure era
ValueNotConservedUTxO Delta (Value era)
a Delta (Value era)
b)
        Word
6 -> do
          [TxOut era]
outs <- Decoder s (TxOut era) -> Decoder s [TxOut era]
forall s a. Decoder s a -> Decoder s [a]
decodeList Decoder s (TxOut era)
forall a s. FromCBOR a => Decoder s a
fromCBOR
          (Int, UtxoPredicateFailure era)
-> Decoder s (Int, UtxoPredicateFailure era)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
2, [TxOut era] -> UtxoPredicateFailure era
forall era. [TxOut era] -> UtxoPredicateFailure era
OutputTooSmallUTxO [TxOut era]
outs)
        Word
7 -> do
          PpupPredicateFailure era
a <- Decoder s (PpupPredicateFailure era)
forall a s. FromCBOR a => Decoder s a
fromCBOR
          (Int, UtxoPredicateFailure era)
-> Decoder s (Int, UtxoPredicateFailure era)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
2, PredicateFailure (PPUP era) -> UtxoPredicateFailure era
forall era. PredicateFailure (PPUP era) -> UtxoPredicateFailure era
UpdateFailure PpupPredicateFailure era
PredicateFailure (PPUP era)
a)
        Word
8 -> do
          Network
right <- Decoder s Network
forall a s. FromCBOR a => Decoder s a
fromCBOR
          Set (Addr (Crypto era))
wrongs <- Decoder s (Addr (Crypto era))
-> Decoder s (Set (Addr (Crypto era)))
forall a s. Ord a => Decoder s a -> Decoder s (Set a)
decodeSet Decoder s (Addr (Crypto era))
forall a s. FromCBOR a => Decoder s a
fromCBOR
          (Int, UtxoPredicateFailure era)
-> Decoder s (Int, UtxoPredicateFailure era)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
3, Network -> Set (Addr (Crypto era)) -> UtxoPredicateFailure era
forall era.
Network -> Set (Addr (Crypto era)) -> UtxoPredicateFailure era
WrongNetwork Network
right Set (Addr (Crypto era))
wrongs)
        Word
9 -> do
          Network
right <- Decoder s Network
forall a s. FromCBOR a => Decoder s a
fromCBOR
          Set (RewardAcnt (Crypto era))
wrongs <- Decoder s (RewardAcnt (Crypto era))
-> Decoder s (Set (RewardAcnt (Crypto era)))
forall a s. Ord a => Decoder s a -> Decoder s (Set a)
decodeSet Decoder s (RewardAcnt (Crypto era))
forall a s. FromCBOR a => Decoder s a
fromCBOR
          (Int, UtxoPredicateFailure era)
-> Decoder s (Int, UtxoPredicateFailure era)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
3, Network
-> Set (RewardAcnt (Crypto era)) -> UtxoPredicateFailure era
forall era.
Network
-> Set (RewardAcnt (Crypto era)) -> UtxoPredicateFailure era
WrongNetworkWithdrawal Network
right Set (RewardAcnt (Crypto era))
wrongs)
        Word
10 -> do
          [TxOut era]
outs <- Decoder s (TxOut era) -> Decoder s [TxOut era]
forall s a. Decoder s a -> Decoder s [a]
decodeList Decoder s (TxOut era)
forall a s. FromCBOR a => Decoder s a
fromCBOR
          (Int, UtxoPredicateFailure era)
-> Decoder s (Int, UtxoPredicateFailure era)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
2, [TxOut era] -> UtxoPredicateFailure era
forall era. [TxOut era] -> UtxoPredicateFailure era
OutputBootAddrAttrsTooBig [TxOut era]
outs)
        Word
11 -> (Int, UtxoPredicateFailure era)
-> Decoder s (Int, UtxoPredicateFailure era)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
1, UtxoPredicateFailure era
forall era. UtxoPredicateFailure era
TriesToForgeADA)
        Word
k -> Word -> Decoder s (Int, UtxoPredicateFailure era)
forall s a. Word -> Decoder s a
invalidKey Word
k