{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}

module Cardano.Ledger.Babbage
  ( BabbageEra,
    Self,
    TxOut,
    TxBody,
    Script,
    AuxiliaryData,
  )
where

import Cardano.Ledger.Alonzo.Data (AuxiliaryData (..))
import Cardano.Ledger.Alonzo.Language (Language (..))
import qualified Cardano.Ledger.Alonzo.Rules.Bbody as Alonzo (AlonzoBBODY)
import Cardano.Ledger.Alonzo.Scripts (Script (..), isPlutusScript)
import Cardano.Ledger.Alonzo.TxInfo (ExtendedUTxO (..), validScript)
import qualified Cardano.Ledger.Alonzo.TxSeq as Alonzo (TxSeq (..), hashTxSeq)
import Cardano.Ledger.Alonzo.TxWitness (TxWitness (..))
import Cardano.Ledger.AuxiliaryData (AuxiliaryDataHash (..), ValidateAuxiliaryData (..))
import Cardano.Ledger.Babbage.Genesis
import Cardano.Ledger.Babbage.PParams
  ( PParams,
    PParams' (..),
    PParamsUpdate,
    updatePParams,
  )
import Cardano.Ledger.Babbage.Rules.Ledger (BabbageLEDGER)
import Cardano.Ledger.Babbage.Rules.Utxo (BabbageUTXO, babbageMinUTxOValue)
import Cardano.Ledger.Babbage.Rules.Utxos (BabbageUTXOS)
import Cardano.Ledger.Babbage.Rules.Utxow (BabbageUTXOW)
import Cardano.Ledger.Babbage.Scripts (babbageInputDataHashes, babbageTxScripts, getDatumBabbage)
import Cardano.Ledger.Babbage.Tx (ValidatedTx (..), minfee)
import Cardano.Ledger.Babbage.TxBody (Datum (..), TxBody, TxOut (TxOut), getBabbageTxOutEitherAddr)
import Cardano.Ledger.Babbage.TxInfo (babbageTxInfo)
import Cardano.Ledger.BaseTypes (BlocksMade (..))
import Cardano.Ledger.Coin
import qualified Cardano.Ledger.Core as Core
import qualified Cardano.Ledger.Crypto as CC
import qualified Cardano.Ledger.Era as EraModule
import Cardano.Ledger.Keys (GenDelegs (GenDelegs))
import qualified Cardano.Ledger.Mary.Value as Mary (Value)
import Cardano.Ledger.PoolDistr (PoolDistr (..))
import Cardano.Ledger.Rules.ValidationMode (applySTSNonStatic)
import Cardano.Ledger.SafeHash (hashAnnotated)
import Cardano.Ledger.Serialization (mkSized)
import Cardano.Ledger.Shelley (nativeMultiSigTag)
import qualified Cardano.Ledger.Shelley.API as API
import Cardano.Ledger.Shelley.API.Validation (ShelleyEraCrypto)
import Cardano.Ledger.Shelley.Constraints
  ( UsesPParams (..),
    UsesTxOut (..),
    UsesValue,
  )
import Cardano.Ledger.Shelley.EpochBoundary
import Cardano.Ledger.Shelley.Genesis (genesisUTxO, sgGenDelegs, sgMaxLovelaceSupply, sgProtocolParams)
import Cardano.Ledger.Shelley.LedgerState
  ( AccountState (..),
    DPState (..),
    EpochState (..),
    LedgerState (..),
    NewEpochState (..),
    smartUTxOState,
    _genDelegs,
  )
import Cardano.Ledger.Shelley.Metadata (validMetadatum)
import qualified Cardano.Ledger.Shelley.Rules.Epoch as Shelley
import qualified Cardano.Ledger.Shelley.Rules.Mir as Shelley
import qualified Cardano.Ledger.Shelley.Rules.Newpp as Shelley
import qualified Cardano.Ledger.Shelley.Rules.Rupd as Shelley
import qualified Cardano.Ledger.Shelley.Rules.Snap as Shelley
import qualified Cardano.Ledger.Shelley.Rules.Tick as Shelley
import qualified Cardano.Ledger.Shelley.Rules.Upec as Shelley
import qualified Cardano.Ledger.Shelley.Tx as Shelley
import Cardano.Ledger.Shelley.UTxO (UTxO (..), balance)
import Cardano.Ledger.ShelleyMA.Rules.Utxo (consumed)
import Cardano.Ledger.ShelleyMA.Timelocks (validateTimelock)
import Cardano.Ledger.Val (Val (inject), coin, (<->))
import Control.Arrow (left)
import Control.Monad.Except (liftEither)
import Control.Monad.Reader (runReader)
import Control.State.Transition.Extended (TRC (TRC))
import Data.Default (def)
import Data.Foldable (toList)
import qualified Data.Map.Strict as Map
import Data.Maybe.Strict
import qualified Data.Set as Set
import GHC.Records (HasField (..))

-- =====================================================

instance (ShelleyEraCrypto c) => API.ApplyTx (BabbageEra c) where
  reapplyTx :: Globals
-> LedgerEnv (BabbageEra c)
-> MempoolState (BabbageEra c)
-> Validated (Tx (BabbageEra c))
-> m (MempoolState (BabbageEra c))
reapplyTx Globals
globals LedgerEnv (BabbageEra c)
env MempoolState (BabbageEra c)
state Validated (Tx (BabbageEra c))
vtx =
    let res :: Either
  [LedgerPredicateFailure (BabbageEra c)]
  (MempoolState (BabbageEra c))
res =
          (Reader
   Globals
   (Either
      [LedgerPredicateFailure (BabbageEra c)]
      (MempoolState (BabbageEra c)))
 -> Globals
 -> Either
      [LedgerPredicateFailure (BabbageEra c)]
      (MempoolState (BabbageEra c)))
-> Globals
-> Reader
     Globals
     (Either
        [LedgerPredicateFailure (BabbageEra c)]
        (MempoolState (BabbageEra c)))
-> Either
     [LedgerPredicateFailure (BabbageEra c)]
     (MempoolState (BabbageEra c))
forall a b c. (a -> b -> c) -> b -> a -> c
flip Reader
  Globals
  (Either
     [LedgerPredicateFailure (BabbageEra c)]
     (MempoolState (BabbageEra c)))
-> Globals
-> Either
     [LedgerPredicateFailure (BabbageEra c)]
     (MempoolState (BabbageEra c))
forall r a. Reader r a -> r -> a
runReader Globals
globals
            (Reader
   Globals
   (Either
      [LedgerPredicateFailure (BabbageEra c)]
      (MempoolState (BabbageEra c)))
 -> Either
      [LedgerPredicateFailure (BabbageEra c)]
      (MempoolState (BabbageEra c)))
-> (TRC (BabbageLEDGER (BabbageEra c))
    -> Reader
         Globals
         (Either
            [LedgerPredicateFailure (BabbageEra c)]
            (MempoolState (BabbageEra c))))
-> TRC (BabbageLEDGER (BabbageEra c))
-> Either
     [LedgerPredicateFailure (BabbageEra c)]
     (MempoolState (BabbageEra c))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (m :: * -> *) (rtype :: RuleType).
(STS s, RuleTypeRep rtype, m ~ BaseM s) =>
RuleContext rtype s -> m (Either [PredicateFailure s] (State s))
forall (m :: * -> *) (rtype :: RuleType).
(STS (EraRule "LEDGER" (BabbageEra c)), RuleTypeRep rtype,
 m ~ BaseM (EraRule "LEDGER" (BabbageEra c))) =>
RuleContext rtype (EraRule "LEDGER" (BabbageEra c))
-> m (Either
        [PredicateFailure (EraRule "LEDGER" (BabbageEra c))]
        (State (EraRule "LEDGER" (BabbageEra c))))
applySTSNonStatic
              @(Core.EraRule "LEDGER" (BabbageEra c))
            (TRC (BabbageLEDGER (BabbageEra c))
 -> Either
      [LedgerPredicateFailure (BabbageEra c)]
      (MempoolState (BabbageEra c)))
-> TRC (BabbageLEDGER (BabbageEra c))
-> Either
     [LedgerPredicateFailure (BabbageEra c)]
     (MempoolState (BabbageEra c))
forall a b. (a -> b) -> a -> b
$ (Environment (BabbageLEDGER (BabbageEra c)),
 State (BabbageLEDGER (BabbageEra c)),
 Signal (BabbageLEDGER (BabbageEra c)))
-> TRC (BabbageLEDGER (BabbageEra c))
forall sts. (Environment sts, State sts, Signal sts) -> TRC sts
TRC (LedgerEnv (BabbageEra c)
Environment (BabbageLEDGER (BabbageEra c))
env, MempoolState (BabbageEra c)
State (BabbageLEDGER (BabbageEra c))
state, Validated (ValidatedTx (BabbageEra c))
-> ValidatedTx (BabbageEra c)
forall tx. Validated tx -> tx
API.extractTx Validated (Tx (BabbageEra c))
Validated (ValidatedTx (BabbageEra c))
vtx)
     in Either (ApplyTxError (BabbageEra c)) (MempoolState (BabbageEra c))
-> m (MempoolState (BabbageEra c))
forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
liftEither (Either (ApplyTxError (BabbageEra c)) (MempoolState (BabbageEra c))
 -> m (MempoolState (BabbageEra c)))
-> (Either
      [LedgerPredicateFailure (BabbageEra c)]
      (MempoolState (BabbageEra c))
    -> Either
         (ApplyTxError (BabbageEra c)) (MempoolState (BabbageEra c)))
-> Either
     [LedgerPredicateFailure (BabbageEra c)]
     (MempoolState (BabbageEra c))
-> m (MempoolState (BabbageEra c))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([LedgerPredicateFailure (BabbageEra c)]
 -> ApplyTxError (BabbageEra c))
-> Either
     [LedgerPredicateFailure (BabbageEra c)]
     (MempoolState (BabbageEra c))
-> Either
     (ApplyTxError (BabbageEra c)) (MempoolState (BabbageEra c))
forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either b d) (Either c d)
left [LedgerPredicateFailure (BabbageEra c)]
-> ApplyTxError (BabbageEra c)
forall era.
[PredicateFailure (EraRule "LEDGER" era)] -> ApplyTxError era
API.ApplyTxError (Either
   [LedgerPredicateFailure (BabbageEra c)]
   (MempoolState (BabbageEra c))
 -> m (MempoolState (BabbageEra c)))
-> Either
     [LedgerPredicateFailure (BabbageEra c)]
     (MempoolState (BabbageEra c))
-> m (MempoolState (BabbageEra c))
forall a b. (a -> b) -> a -> b
$ Either
  [LedgerPredicateFailure (BabbageEra c)]
  (MempoolState (BabbageEra c))
res

instance ShelleyEraCrypto c => API.ApplyBlock (BabbageEra c)

instance ShelleyEraCrypto c => API.ShelleyBasedEra (BabbageEra c)

-- | The Babbage era
data BabbageEra c

instance
  ( CC.Crypto c
  ) =>
  EraModule.Era (BabbageEra c)
  where
  type Crypto (BabbageEra c) = c

  getTxOutEitherAddr :: TxOut (BabbageEra c)
-> Either
     (Addr (Crypto (BabbageEra c)))
     (CompactAddr (Crypto (BabbageEra c)))
getTxOutEitherAddr = TxOut (BabbageEra c)
-> Either
     (Addr (Crypto (BabbageEra c)))
     (CompactAddr (Crypto (BabbageEra c)))
forall era.
HashAlgorithm (ADDRHASH (Crypto era)) =>
TxOut era -> Either (Addr (Crypto era)) (CompactAddr (Crypto era))
getBabbageTxOutEitherAddr

  getAllTxInputs :: TxBody (BabbageEra c) -> Set (TxIn (Crypto (BabbageEra c)))
getAllTxInputs TxBody (BabbageEra c)
txb = Set (TxIn c)
spending Set (TxIn c) -> Set (TxIn c) -> Set (TxIn c)
forall a. Ord a => Set a -> Set a -> Set a
`Set.union` Set (TxIn c)
collateral Set (TxIn c) -> Set (TxIn c) -> Set (TxIn c)
forall a. Ord a => Set a -> Set a -> Set a
`Set.union` Set (TxIn c)
reference
    where
      spending :: Set (TxIn c)
spending = TxBody (BabbageEra c) -> Set (TxIn c)
forall k (x :: k) r a. HasField x r a => r -> a
getField @"inputs" TxBody (BabbageEra c)
TxBody (BabbageEra c)
txb
      collateral :: Set (TxIn c)
collateral = TxBody (BabbageEra c) -> Set (TxIn c)
forall k (x :: k) r a. HasField x r a => r -> a
getField @"collateral" TxBody (BabbageEra c)
TxBody (BabbageEra c)
txb
      reference :: Set (TxIn c)
reference = TxBody (BabbageEra c) -> Set (TxIn c)
forall k (x :: k) r a. HasField x r a => r -> a
getField @"referenceInputs" TxBody (BabbageEra c)
TxBody (BabbageEra c)
txb

instance (CC.Crypto c) => Shelley.ValidateScript (BabbageEra c) where
  isNativeScript :: Script (BabbageEra c) -> Bool
isNativeScript Script (BabbageEra c)
x = Bool -> Bool
not (Script (BabbageEra c) -> Bool
forall era. Script era -> Bool
isPlutusScript Script (BabbageEra c)
Script (BabbageEra c)
x)
  scriptPrefixTag :: Script (BabbageEra c) -> ByteString
scriptPrefixTag Script (BabbageEra c)
script =
    case Script (BabbageEra c)
script of
      (TimelockScript _) -> ByteString
nativeMultiSigTag -- "\x00"
      (PlutusScript PlutusV1 _) -> ByteString
"\x01"
      (PlutusScript PlutusV2 _) -> ByteString
"\x02"
  validateScript :: Script (BabbageEra c) -> Tx (BabbageEra c) -> Bool
validateScript (TimelockScript script) Tx (BabbageEra c)
tx = Timelock (Crypto (BabbageEra c)) -> Tx (BabbageEra c) -> Bool
forall era.
(UsesTxBody era, HasField "vldt" (TxBody era) ValidityInterval,
 HasField
   "addrWits" (Tx era) (Set (WitVKey 'Witness (Crypto era)))) =>
Timelock (Crypto era) -> Tx era -> Bool
validateTimelock @(BabbageEra c) Timelock (Crypto (BabbageEra c))
script Tx (BabbageEra c)
tx
  validateScript (PlutusScript _ _) Tx (BabbageEra c)
_tx = Bool
True

instance
  ( CC.Crypto c
  ) =>
  API.CanStartFromGenesis (BabbageEra c)
  where
  type AdditionalGenesisConfig (BabbageEra c) = AlonzoGenesis

  initialState :: ShelleyGenesis (BabbageEra c)
-> AdditionalGenesisConfig (BabbageEra c)
-> NewEpochState (BabbageEra c)
initialState ShelleyGenesis (BabbageEra c)
sg AdditionalGenesisConfig (BabbageEra c)
ag =
    EpochNo
-> BlocksMade (Crypto (BabbageEra c))
-> BlocksMade (Crypto (BabbageEra c))
-> EpochState (BabbageEra c)
-> StrictMaybe (PulsingRewUpdate (Crypto (BabbageEra c)))
-> PoolDistr (Crypto (BabbageEra c))
-> StashedAVVMAddresses (BabbageEra c)
-> NewEpochState (BabbageEra c)
forall era.
EpochNo
-> BlocksMade (Crypto era)
-> BlocksMade (Crypto era)
-> EpochState era
-> StrictMaybe (PulsingRewUpdate (Crypto era))
-> PoolDistr (Crypto era)
-> StashedAVVMAddresses era
-> NewEpochState era
NewEpochState
      EpochNo
initialEpochNo
      (Map (KeyHash 'StakePool c) Natural -> BlocksMade c
forall crypto.
Map (KeyHash 'StakePool crypto) Natural -> BlocksMade crypto
BlocksMade Map (KeyHash 'StakePool c) Natural
forall k a. Map k a
Map.empty)
      (Map (KeyHash 'StakePool c) Natural -> BlocksMade c
forall crypto.
Map (KeyHash 'StakePool crypto) Natural -> BlocksMade crypto
BlocksMade Map (KeyHash 'StakePool c) Natural
forall k a. Map k a
Map.empty)
      ( AccountState
-> SnapShots (Crypto (BabbageEra c))
-> LedgerState (BabbageEra c)
-> PParams (BabbageEra c)
-> PParams (BabbageEra c)
-> NonMyopic (Crypto (BabbageEra c))
-> EpochState (BabbageEra c)
forall era.
AccountState
-> SnapShots (Crypto era)
-> LedgerState era
-> PParams era
-> PParams era
-> NonMyopic (Crypto era)
-> EpochState era
EpochState
          (Coin -> Coin -> AccountState
AccountState (Integer -> Coin
Coin Integer
0) Coin
reserves)
          SnapShots (Crypto (BabbageEra c))
forall crypto. SnapShots crypto
emptySnapShots
          ( UTxOState (BabbageEra c)
-> DPState (Crypto (BabbageEra c)) -> LedgerState (BabbageEra c)
forall era.
UTxOState era -> DPState (Crypto era) -> LedgerState era
LedgerState
              ( UTxO (BabbageEra c)
-> Coin
-> Coin
-> State (EraRule "PPUP" (BabbageEra c))
-> UTxOState (BabbageEra c)
forall era.
Era era =>
UTxO era
-> Coin -> Coin -> State (EraRule "PPUP" era) -> UTxOState era
smartUTxOState
                  UTxO (BabbageEra c)
initialUtxo
                  (Integer -> Coin
Coin Integer
0)
                  (Integer -> Coin
Coin Integer
0)
                  State (EraRule "PPUP" (BabbageEra c))
forall a. Default a => a
def
              )
              (DState c -> PState c -> DPState c
forall crypto. DState crypto -> PState crypto -> DPState crypto
DPState (DState c
forall a. Default a => a
def {_genDelegs :: GenDelegs c
_genDelegs = Map (KeyHash 'Genesis c) (GenDelegPair c) -> GenDelegs c
forall crypto.
Map (KeyHash 'Genesis crypto) (GenDelegPair crypto)
-> GenDelegs crypto
GenDelegs Map (KeyHash 'Genesis c) (GenDelegPair c)
Map
  (KeyHash 'Genesis (Crypto (BabbageEra c)))
  (GenDelegPair (Crypto (BabbageEra c)))
genDelegs}) PState c
forall a. Default a => a
def)
          )
          (PParams' Identity (BabbageEra c)
-> AlonzoGenesis -> PParams' Identity (BabbageEra c)
forall era1 era2.
PParams' Identity era1 -> AlonzoGenesis -> PParams' Identity era2
extendPPWithGenesis PParams' Identity (BabbageEra c)
pp AlonzoGenesis
AdditionalGenesisConfig (BabbageEra c)
ag)
          (PParams' Identity (BabbageEra c)
-> AlonzoGenesis -> PParams' Identity (BabbageEra c)
forall era1 era2.
PParams' Identity era1 -> AlonzoGenesis -> PParams' Identity era2
extendPPWithGenesis PParams' Identity (BabbageEra c)
pp AlonzoGenesis
AdditionalGenesisConfig (BabbageEra c)
ag)
          NonMyopic (Crypto (BabbageEra c))
forall a. Default a => a
def
      )
      StrictMaybe (PulsingRewUpdate (Crypto (BabbageEra c)))
forall a. StrictMaybe a
SNothing
      (Map (KeyHash 'StakePool c) (IndividualPoolStake c) -> PoolDistr c
forall crypto.
Map (KeyHash 'StakePool crypto) (IndividualPoolStake crypto)
-> PoolDistr crypto
PoolDistr Map (KeyHash 'StakePool c) (IndividualPoolStake c)
forall k a. Map k a
Map.empty)
      ()
    where
      initialEpochNo :: EpochNo
initialEpochNo = EpochNo
0
      initialUtxo :: UTxO (BabbageEra c)
initialUtxo = ShelleyGenesis (BabbageEra c) -> UTxO (BabbageEra c)
forall era.
(Era era, UsesTxOut era) =>
ShelleyGenesis era -> UTxO era
genesisUTxO ShelleyGenesis (BabbageEra c)
sg
      reserves :: Coin
reserves =
        Value c -> Coin
forall t. Val t => t -> Coin
coin (Value c -> Coin) -> Value c -> Coin
forall a b. (a -> b) -> a -> b
$
          Coin -> Value c
forall t. Val t => Coin -> t
inject (Word64 -> Coin
word64ToCoin (ShelleyGenesis (BabbageEra c) -> Word64
forall era. ShelleyGenesis era -> Word64
sgMaxLovelaceSupply ShelleyGenesis (BabbageEra c)
sg))
            Value c -> Value c -> Value c
forall t. Val t => t -> t -> t
<-> UTxO (BabbageEra c) -> Value (BabbageEra c)
forall era. Era era => UTxO era -> Value era
balance UTxO (BabbageEra c)
initialUtxo
      genDelegs :: Map
  (KeyHash 'Genesis (Crypto (BabbageEra c)))
  (GenDelegPair (Crypto (BabbageEra c)))
genDelegs = ShelleyGenesis (BabbageEra c)
-> Map
     (KeyHash 'Genesis (Crypto (BabbageEra c)))
     (GenDelegPair (Crypto (BabbageEra c)))
forall era.
ShelleyGenesis era
-> Map (KeyHash 'Genesis (Crypto era)) (GenDelegPair (Crypto era))
sgGenDelegs ShelleyGenesis (BabbageEra c)
sg
      pp :: PParams' Identity (BabbageEra c)
pp = ShelleyGenesis (BabbageEra c) -> PParams' Identity (BabbageEra c)
forall era. ShelleyGenesis era -> PParams era
sgProtocolParams ShelleyGenesis (BabbageEra c)
sg

instance CC.Crypto c => UsesTxOut (BabbageEra c) where
  makeTxOut :: Proxy (BabbageEra c)
-> Addr (Crypto (BabbageEra c))
-> Value (BabbageEra c)
-> TxOut (BabbageEra c)
makeTxOut Proxy (BabbageEra c)
_proxy Addr (Crypto (BabbageEra c))
addr Value (BabbageEra c)
val = Addr (Crypto (BabbageEra c))
-> Value (BabbageEra c)
-> Datum (BabbageEra c)
-> StrictMaybe (Script (BabbageEra c))
-> TxOut (BabbageEra c)
forall era.
(Era era, Compactible (Value era), Val (Value era),
 HasCallStack) =>
Addr (Crypto era)
-> Value era -> Datum era -> StrictMaybe (Script era) -> TxOut era
TxOut Addr (Crypto (BabbageEra c))
addr Value (BabbageEra c)
val Datum (BabbageEra c)
forall era. Datum era
NoDatum StrictMaybe (Script (BabbageEra c))
forall a. StrictMaybe a
SNothing

instance CC.Crypto c => API.CLI (BabbageEra c) where
  evaluateMinFee :: PParams (BabbageEra c) -> Tx (BabbageEra c) -> Coin
evaluateMinFee = PParams (BabbageEra c) -> Tx (BabbageEra c) -> Coin
forall era.
(HasField "_minfeeA" (PParams era) Natural,
 HasField "_minfeeB" (PParams era) Natural,
 HasField "_prices" (PParams era) Prices,
 HasField "wits" (Tx era) (Witnesses era),
 HasField "txrdmrs" (Witnesses era) (Redeemers era),
 HasField "txsize" (Tx era) Integer) =>
PParams era -> Tx era -> Coin
minfee

  evaluateConsumed :: PParams (BabbageEra c)
-> UTxO (BabbageEra c)
-> TxBody (BabbageEra c)
-> Value (BabbageEra c)
evaluateConsumed = PParams (BabbageEra c)
-> UTxO (BabbageEra c)
-> TxBody (BabbageEra c)
-> Value (BabbageEra c)
forall era.
(Era 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)),
 HasField "_keyDeposit" (PParams era) Coin) =>
PParams era -> UTxO era -> TxBody era -> Value era
consumed

  addKeyWitnesses :: Tx (BabbageEra c)
-> Set (WitVKey 'Witness (Crypto (BabbageEra c)))
-> Tx (BabbageEra c)
addKeyWitnesses (ValidatedTx b ws aux iv) Set (WitVKey 'Witness (Crypto (BabbageEra c)))
newWits = TxBody (BabbageEra c)
-> TxWitness (BabbageEra c)
-> IsValid
-> StrictMaybe (AuxiliaryData (BabbageEra c))
-> ValidatedTx (BabbageEra c)
forall era.
TxBody era
-> TxWitness era
-> IsValid
-> StrictMaybe (AuxiliaryData era)
-> ValidatedTx era
ValidatedTx TxBody (BabbageEra c)
b TxWitness (BabbageEra c)
ws' IsValid
aux StrictMaybe (AuxiliaryData (BabbageEra c))
iv
    where
      ws' :: TxWitness (BabbageEra c)
ws' = TxWitness (BabbageEra c)
ws {txwitsVKey :: Set (WitVKey 'Witness (Crypto (BabbageEra c)))
txwitsVKey = Set (WitVKey 'Witness c)
-> Set (WitVKey 'Witness c) -> Set (WitVKey 'Witness c)
forall a. Ord a => Set a -> Set a -> Set a
Set.union Set (WitVKey 'Witness c)
Set (WitVKey 'Witness (Crypto (BabbageEra c)))
newWits (TxWitness (BabbageEra c)
-> (Era (BabbageEra c),
    Script (BabbageEra c) ~ Script (BabbageEra c)) =>
   Set (WitVKey 'Witness (Crypto (BabbageEra c)))
forall era.
TxWitness era
-> (Era era, Script era ~ Script era) =>
   Set (WitVKey 'Witness (Crypto era))
txwitsVKey TxWitness (BabbageEra c)
ws)}

  evaluateMinLovelaceOutput :: PParams (BabbageEra c) -> TxOut (BabbageEra c) -> Coin
evaluateMinLovelaceOutput PParams (BabbageEra c)
pp TxOut (BabbageEra c)
out = PParams (BabbageEra c) -> Sized (TxOut (BabbageEra c)) -> Coin
forall era.
HasField "_coinsPerUTxOByte" (PParams era) Coin =>
PParams era -> Sized (TxOut era) -> Coin
babbageMinUTxOValue PParams (BabbageEra c)
pp (TxOut (BabbageEra c) -> Sized (TxOut (BabbageEra c))
forall a. ToCBOR a => a -> Sized a
mkSized TxOut (BabbageEra c)
TxOut (BabbageEra c)
out)

type instance Core.Tx (BabbageEra c) = ValidatedTx (BabbageEra c)

type instance Core.TxOut (BabbageEra c) = TxOut (BabbageEra c)

type instance Core.TxBody (BabbageEra c) = TxBody (BabbageEra c)

type instance Core.Value (BabbageEra c) = Mary.Value c

type instance Core.Script (BabbageEra c) = Script (BabbageEra c)

type instance Core.AuxiliaryData (BabbageEra c) = AuxiliaryData (BabbageEra c)

type instance Core.PParams (BabbageEra c) = PParams (BabbageEra c)

type instance Core.Witnesses (BabbageEra c) = TxWitness (BabbageEra c)

type instance Core.PParamsDelta (BabbageEra c) = PParamsUpdate (BabbageEra c)

instance CC.Crypto c => UsesValue (BabbageEra c)

instance (CC.Crypto c) => UsesPParams (BabbageEra c) where
  mergePPUpdates :: proxy (BabbageEra c)
-> PParams (BabbageEra c)
-> PParamsDelta (BabbageEra c)
-> PParams (BabbageEra c)
mergePPUpdates proxy (BabbageEra c)
_ = PParams (BabbageEra c)
-> PParamsDelta (BabbageEra c) -> PParams (BabbageEra c)
forall era. PParams era -> PParamsUpdate era -> PParams era
updatePParams

instance CC.Crypto c => ValidateAuxiliaryData (BabbageEra c) c where
  hashAuxiliaryData :: AuxiliaryData (BabbageEra c) -> AuxiliaryDataHash c
hashAuxiliaryData AuxiliaryData (BabbageEra c)
x = SafeHash c EraIndependentAuxiliaryData -> AuxiliaryDataHash c
forall crypto.
SafeHash crypto EraIndependentAuxiliaryData
-> AuxiliaryDataHash crypto
AuxiliaryDataHash (AuxiliaryData (BabbageEra c)
-> SafeHash c EraIndependentAuxiliaryData
forall c i x.
(HasAlgorithm c, HashAnnotated x i c) =>
x -> SafeHash c i
hashAnnotated AuxiliaryData (BabbageEra c)
AuxiliaryData (BabbageEra c)
x)
  validateAuxiliaryData :: ProtVer -> AuxiliaryData (BabbageEra c) -> Bool
validateAuxiliaryData ProtVer
pv (AuxiliaryData metadata scrips) =
    (Metadatum -> Bool) -> Map Word64 Metadatum -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Metadatum -> Bool
validMetadatum Map Word64 Metadatum
metadata
      Bool -> Bool -> Bool
&& (Script (BabbageEra c) -> Bool)
-> StrictSeq (Script (BabbageEra c)) -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (ProtVer -> Script (BabbageEra c) -> Bool
forall era. ProtVer -> Script era -> Bool
validScript ProtVer
pv) StrictSeq (Script (BabbageEra c))
StrictSeq (Script (BabbageEra c))
scrips

instance CC.Crypto c => EraModule.SupportsSegWit (BabbageEra c) where
  type TxSeq (BabbageEra c) = Alonzo.TxSeq (BabbageEra c)
  fromTxSeq :: TxSeq (BabbageEra c) -> StrictSeq (Tx (BabbageEra c))
fromTxSeq = TxSeq (BabbageEra c) -> StrictSeq (Tx (BabbageEra c))
forall era. TxSeq era -> StrictSeq (ValidatedTx era)
Alonzo.txSeqTxns
  toTxSeq :: StrictSeq (Tx (BabbageEra c)) -> TxSeq (BabbageEra c)
toTxSeq = StrictSeq (Tx (BabbageEra c)) -> TxSeq (BabbageEra c)
forall era.
(Era era, SafeToHash (TxWitness era)) =>
StrictSeq (ValidatedTx era) -> TxSeq era
Alonzo.TxSeq
  hashTxSeq :: TxSeq (BabbageEra c)
-> Hash (HASH (Crypto (BabbageEra c))) EraIndependentBlockBody
hashTxSeq = TxSeq (BabbageEra c)
-> Hash (HASH (Crypto (BabbageEra c))) EraIndependentBlockBody
forall era.
Era era =>
TxSeq era -> Hash (Crypto era) EraIndependentBlockBody
Alonzo.hashTxSeq
  numSegComponents :: Word64
numSegComponents = Word64
4

instance CC.Crypto c => ExtendedUTxO (BabbageEra c) where
  txInfo :: PParams (BabbageEra c)
-> Language
-> EpochInfo (Either Text)
-> SystemStart
-> UTxO (BabbageEra c)
-> Tx (BabbageEra c)
-> Either
     (TranslationError (Crypto (BabbageEra c))) VersionedTxInfo
txInfo = PParams (BabbageEra c)
-> Language
-> EpochInfo (Either Text)
-> SystemStart
-> UTxO (BabbageEra c)
-> Tx (BabbageEra c)
-> Either
     (TranslationError (Crypto (BabbageEra c))) VersionedTxInfo
forall era.
(Era era, ExtendedUTxO era, ValidateScript era,
 Value era ~ Value (Crypto era),
 HasField "wits" (Tx era) (TxWitness era),
 HasField "referenceScript" (TxOut era) (StrictMaybe (Script era)),
 HasField "_protocolVersion" (PParams era) ProtVer,
 HasField "inputs" (TxBody era) (Set (TxIn (Crypto era))),
 HasField "referenceInputs" (TxBody era) (Set (TxIn (Crypto era))),
 HasField
   "reqSignerHashes"
   (TxBody era)
   (Set (KeyHash 'Witness (Crypto era))),
 HasField "certs" (TxBody era) (StrictSeq (DCert (Crypto era))),
 HasField "wdrls" (TxBody era) (Wdrl (Crypto era)),
 HasField "mint" (TxBody era) (Value (Crypto era)),
 HasField "vldt" (TxBody era) ValidityInterval) =>
PParams era
-> Language
-> EpochInfo (Either Text)
-> SystemStart
-> UTxO era
-> Tx era
-> Either (TranslationError (Crypto era)) VersionedTxInfo
babbageTxInfo
  inputDataHashes :: Map (ScriptHash (Crypto (BabbageEra c))) (Script (BabbageEra c))
-> ValidatedTx (BabbageEra c)
-> UTxO (BabbageEra c)
-> (Set (DataHash (Crypto (BabbageEra c))),
    Set (TxIn (Crypto (BabbageEra c))))
inputDataHashes = Map (ScriptHash (Crypto (BabbageEra c))) (Script (BabbageEra c))
-> ValidatedTx (BabbageEra c)
-> UTxO (BabbageEra c)
-> (Set (DataHash (Crypto (BabbageEra c))),
    Set (TxIn (Crypto (BabbageEra c))))
forall era.
(HasField "inputs" (TxBody era) (Set (TxIn (Crypto era))),
 ValidateScript era, TxOut era ~ TxOut era) =>
Map (ScriptHash (Crypto era)) (Script era)
-> ValidatedTx era
-> UTxO era
-> (Set (DataHash (Crypto era)), Set (TxIn (Crypto era)))
babbageInputDataHashes
  txscripts :: UTxO (BabbageEra c)
-> Tx (BabbageEra c)
-> Map (ScriptHash (Crypto (BabbageEra c))) (Script (BabbageEra c))
txscripts = UTxO (BabbageEra c)
-> Tx (BabbageEra c)
-> Map (ScriptHash (Crypto (BabbageEra c))) (Script (BabbageEra c))
forall era.
(ValidateScript era,
 HasField "referenceScript" (TxOut era) (StrictMaybe (Script era)),
 HasField "inputs" (TxBody era) (Set (TxIn (Crypto era))),
 HasField
   "referenceInputs" (TxBody era) (Set (TxIn (Crypto era)))) =>
UTxO era -> Tx era -> Map (ScriptHash (Crypto era)) (Script era)
babbageTxScripts
  getAllowedSupplimentalDataHashes :: TxBody (BabbageEra c)
-> UTxO (BabbageEra c) -> Set (DataHash (Crypto (BabbageEra c)))
getAllowedSupplimentalDataHashes TxBody (BabbageEra c)
txbody (UTxO Map (TxIn (Crypto (BabbageEra c))) (TxOut (BabbageEra c))
utxo) =
    [DataHash c] -> Set (DataHash c)
forall a. Ord a => [a] -> Set a
Set.fromList [DataHash c
dh | TxOut (BabbageEra c)
out <- [TxOut (BabbageEra c)]
outs, SJust DataHash c
dh <- [TxOut (BabbageEra c) -> StrictMaybe (DataHash c)
forall k (x :: k) r a. HasField x r a => r -> a
getField @"datahash" TxOut (BabbageEra c)
out]]
    where
      newOuts :: [TxOut (BabbageEra c)]
newOuts = TxBody (BabbageEra c) -> [TxOut (BabbageEra c)]
forall era. ExtendedUTxO era => TxBody era -> [TxOut era]
allOuts TxBody (BabbageEra c)
txbody
      referencedOuts :: [TxOut (BabbageEra c)]
referencedOuts = Map (TxIn c) (TxOut (BabbageEra c)) -> [TxOut (BabbageEra c)]
forall k a. Map k a -> [a]
Map.elems (Map (TxIn c) (TxOut (BabbageEra c)) -> [TxOut (BabbageEra c)])
-> Map (TxIn c) (TxOut (BabbageEra c)) -> [TxOut (BabbageEra c)]
forall a b. (a -> b) -> a -> b
$ Map (TxIn c) (TxOut (BabbageEra c))
-> Set (TxIn c) -> Map (TxIn c) (TxOut (BabbageEra c))
forall k a. Ord k => Map k a -> Set k -> Map k a
Map.restrictKeys Map (TxIn c) (TxOut (BabbageEra c))
Map (TxIn (Crypto (BabbageEra c))) (TxOut (BabbageEra c))
utxo (TxBody (BabbageEra c) -> Set (TxIn c)
forall k (x :: k) r a. HasField x r a => r -> a
getField @"referenceInputs" TxBody (BabbageEra c)
TxBody (BabbageEra c)
txbody)
      outs :: [TxOut (BabbageEra c)]
outs = [TxOut (BabbageEra c)]
[TxOut (BabbageEra c)]
newOuts [TxOut (BabbageEra c)]
-> [TxOut (BabbageEra c)] -> [TxOut (BabbageEra c)]
forall a. Semigroup a => a -> a -> a
<> [TxOut (BabbageEra c)]
referencedOuts
  getDatum :: Tx (BabbageEra c)
-> UTxO (BabbageEra c)
-> ScriptPurpose (Crypto (BabbageEra c))
-> Maybe (Data (BabbageEra c))
getDatum = Tx (BabbageEra c)
-> UTxO (BabbageEra c)
-> ScriptPurpose (Crypto (BabbageEra c))
-> Maybe (Data (BabbageEra c))
forall era.
(Era era, TxOut era ~ TxOut era, Witnesses era ~ TxWitness era) =>
Tx era
-> UTxO era -> ScriptPurpose (Crypto era) -> Maybe (Data era)
getDatumBabbage
  getTxOutDatum :: TxOut (BabbageEra c) -> Datum (BabbageEra c)
getTxOutDatum (TxOut _ _ datum _) = Datum (BabbageEra c)
datum
  allSizedOuts :: TxBody (BabbageEra c) -> [Sized (TxOut (BabbageEra c))]
allSizedOuts TxBody (BabbageEra c)
txbody = StrictSeq (Sized (TxOut (BabbageEra c)))
-> [Sized (TxOut (BabbageEra c))]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (TxBody (BabbageEra c) -> StrictSeq (Sized (TxOut (BabbageEra c)))
forall k (x :: k) r a. HasField x r a => r -> a
getField @"sizedOutputs" TxBody (BabbageEra c)
TxBody (BabbageEra c)
txbody) [Sized (TxOut (BabbageEra c))]
-> [Sized (TxOut (BabbageEra c))] -> [Sized (TxOut (BabbageEra c))]
forall a. Semigroup a => a -> a -> a
<> [Sized (TxOut (BabbageEra c))]
collOuts
    where
      collOuts :: [Sized (TxOut (BabbageEra c))]
collOuts = case TxBody (BabbageEra c) -> StrictMaybe (Sized (TxOut (BabbageEra c)))
forall k (x :: k) r a. HasField x r a => r -> a
getField @"sizedCollateralReturn" TxBody (BabbageEra c)
TxBody (BabbageEra c)
txbody of
        StrictMaybe (Sized (TxOut (BabbageEra c)))
SNothing -> []
        SJust Sized (TxOut (BabbageEra c))
x -> [Sized (TxOut (BabbageEra c))
x]

-------------------------------------------------------------------------------
-- Era Mapping
-------------------------------------------------------------------------------

-- Rules inherited from Alonzo

type instance Core.EraRule "UTXOS" (BabbageEra c) = BabbageUTXOS (BabbageEra c)

type instance Core.EraRule "UTXO" (BabbageEra c) = BabbageUTXO (BabbageEra c)

type instance Core.EraRule "UTXOW" (BabbageEra c) = BabbageUTXOW (BabbageEra c)

type instance Core.EraRule "LEDGER" (BabbageEra c) = BabbageLEDGER (BabbageEra c)

type instance Core.EraRule "BBODY" (BabbageEra c) = Alonzo.AlonzoBBODY (BabbageEra c)

-- Rules inherited from Shelley

type instance Core.EraRule "DELEG" (BabbageEra c) = API.DELEG (BabbageEra c)

type instance Core.EraRule "DELEGS" (BabbageEra c) = API.DELEGS (BabbageEra c)

type instance Core.EraRule "DELPL" (BabbageEra c) = API.DELPL (BabbageEra c)

type instance Core.EraRule "EPOCH" (BabbageEra c) = Shelley.EPOCH (BabbageEra c)

type instance Core.EraRule "LEDGERS" (BabbageEra c) = API.LEDGERS (BabbageEra c)

type instance Core.EraRule "MIR" (BabbageEra c) = Shelley.MIR (BabbageEra c)

type instance Core.EraRule "NEWEPOCH" (BabbageEra c) = API.NEWEPOCH (BabbageEra c)

type instance Core.EraRule "NEWPP" (BabbageEra c) = Shelley.NEWPP (BabbageEra c)

type instance Core.EraRule "POOL" (BabbageEra c) = API.POOL (BabbageEra c)

type instance Core.EraRule "POOLREAP" (BabbageEra c) = API.POOLREAP (BabbageEra c)

type instance Core.EraRule "PPUP" (BabbageEra c) = API.PPUP (BabbageEra c)

type instance Core.EraRule "RUPD" (BabbageEra c) = Shelley.RUPD (BabbageEra c)

type instance Core.EraRule "SNAP" (BabbageEra c) = Shelley.SNAP (BabbageEra c)

type instance Core.EraRule "TICK" (BabbageEra c) = Shelley.TICK (BabbageEra c)

type instance Core.EraRule "TICKF" (BabbageEra c) = Shelley.TICKF (BabbageEra c)

type instance Core.EraRule "UPEC" (BabbageEra c) = Shelley.UPEC (BabbageEra c)

-- Self-Describing type synomyms

type Self c = BabbageEra c

-- =================================================