{-# LANGUAGE DataKinds #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}

module Test.Cardano.Ledger.Babbage.Examples.Consensus where

import Cardano.Ledger.Alonzo.Scripts (AlonzoPlutusPurpose (..), AlonzoScript (..), ExUnits (..))
import Cardano.Ledger.Alonzo.Translation ()
import Cardano.Ledger.Alonzo.Tx (AlonzoTx (..), IsValid (..))
import Cardano.Ledger.Alonzo.TxAuxData (mkAlonzoTxAuxData)
import Cardano.Ledger.Alonzo.TxWits (AlonzoTxWits (..), Redeemers (..), TxDats (..))
import Cardano.Ledger.Babbage (BabbageEra)
import Cardano.Ledger.Babbage.Core
import Cardano.Ledger.Babbage.Translation ()
import Cardano.Ledger.Babbage.TxBody (BabbageTxOut (..), TxBody (..))
import Cardano.Ledger.BaseTypes (StrictMaybe (..))
import Cardano.Ledger.Binary (mkSized)
import Cardano.Ledger.Coin (Coin (..))
import Cardano.Ledger.Genesis (NoGenesis (..))
import Cardano.Ledger.Keys (asWitness)
import Cardano.Ledger.Mary.Value (MaryValue (..))
import Cardano.Ledger.Plutus.Data (
  Data (..),
  Datum (..),
  dataToBinaryData,
  hashData,
 )
import Cardano.Ledger.Plutus.Language (Language (..))
import Cardano.Ledger.Shelley.API (
  ApplyTxError (..),
  Credential (..),
  Network (..),
  NewEpochState (..),
  ProposedPPUpdates (..),
  RewardAccount (..),
  TxId (..),
  Update (..),
 )
import Cardano.Ledger.Shelley.Rules (ShelleyDelegsPredFailure (..), ShelleyLedgerPredFailure (..))
import Cardano.Ledger.Shelley.Scripts
import Cardano.Ledger.Shelley.Tx (ShelleyTx (..))
import Cardano.Ledger.TxIn (mkTxInPartial)
import Cardano.Slotting.Slot (EpochNo (..), SlotNo (..))
import Data.Default (def)
import qualified Data.Map.Strict as Map
import qualified Data.Sequence.Strict as StrictSeq
import qualified Data.Set as Set
import Lens.Micro
import qualified PlutusLedgerApi.Common as P
import Test.Cardano.Ledger.Alonzo.Arbitrary (alwaysFails, alwaysSucceeds)
import Test.Cardano.Ledger.Core.KeyPair (mkAddr, mkWitnessesVKey)
import qualified Test.Cardano.Ledger.Core.Utils as SLE
import qualified Test.Cardano.Ledger.Mary.Examples.Consensus as MarySLE
import qualified Test.Cardano.Ledger.Shelley.Examples.Consensus as SLE

-- | ShelleyLedgerExamples for Babbage era
ledgerExamplesBabbage :: SLE.ShelleyLedgerExamples BabbageEra
ledgerExamplesBabbage :: ShelleyLedgerExamples BabbageEra
ledgerExamplesBabbage =
  SLE.ShelleyLedgerExamples
    { sleBlock :: Block (BHeader StandardCrypto) BabbageEra
SLE.sleBlock = Tx BabbageEra -> Block (BHeader StandardCrypto) BabbageEra
forall era.
EraSegWits era =>
Tx era -> Block (BHeader StandardCrypto) era
SLE.exampleShelleyLedgerBlock Tx BabbageEra
AlonzoTx BabbageEra
exampleTransactionInBlock
    , sleHashHeader :: HashHeader
SLE.sleHashHeader = HashHeader
SLE.exampleHashHeader
    , sleTx :: Tx BabbageEra
SLE.sleTx = Tx BabbageEra
AlonzoTx BabbageEra
exampleTransactionInBlock
    , sleApplyTxError :: ApplyTxError BabbageEra
SLE.sleApplyTxError =
        NonEmpty (PredicateFailure (EraRule "LEDGER" BabbageEra))
-> ApplyTxError BabbageEra
forall era.
NonEmpty (PredicateFailure (EraRule "LEDGER" era))
-> ApplyTxError era
ApplyTxError (NonEmpty (PredicateFailure (EraRule "LEDGER" BabbageEra))
 -> ApplyTxError BabbageEra)
-> NonEmpty (PredicateFailure (EraRule "LEDGER" BabbageEra))
-> ApplyTxError BabbageEra
forall a b. (a -> b) -> a -> b
$
          PredicateFailure (EraRule "LEDGER" BabbageEra)
-> NonEmpty (PredicateFailure (EraRule "LEDGER" BabbageEra))
forall a. a -> NonEmpty a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PredicateFailure (EraRule "LEDGER" BabbageEra)
 -> NonEmpty (PredicateFailure (EraRule "LEDGER" BabbageEra)))
-> PredicateFailure (EraRule "LEDGER" BabbageEra)
-> NonEmpty (PredicateFailure (EraRule "LEDGER" BabbageEra))
forall a b. (a -> b) -> a -> b
$
            PredicateFailure (EraRule "DELEGS" BabbageEra)
-> ShelleyLedgerPredFailure BabbageEra
forall era.
PredicateFailure (EraRule "DELEGS" era)
-> ShelleyLedgerPredFailure era
DelegsFailure (PredicateFailure (EraRule "DELEGS" BabbageEra)
 -> ShelleyLedgerPredFailure BabbageEra)
-> PredicateFailure (EraRule "DELEGS" BabbageEra)
-> ShelleyLedgerPredFailure BabbageEra
forall a b. (a -> b) -> a -> b
$
              forall era. KeyHash 'StakePool -> ShelleyDelegsPredFailure era
DelegateeNotRegisteredDELEG @BabbageEra (Int -> KeyHash 'StakePool
forall (discriminator :: KeyRole). Int -> KeyHash discriminator
SLE.mkKeyHash Int
1)
    , sleRewardsCredentials :: Set (Either Coin (Credential 'Staking))
SLE.sleRewardsCredentials =
        [Either Coin (Credential 'Staking)]
-> Set (Either Coin (Credential 'Staking))
forall a. Ord a => [a] -> Set a
Set.fromList
          [ Coin -> Either Coin (Credential 'Staking)
forall a b. a -> Either a b
Left (Integer -> Coin
Coin Integer
100)
          , Credential 'Staking -> Either Coin (Credential 'Staking)
forall a b. b -> Either a b
Right (ScriptHash -> Credential 'Staking
forall (kr :: KeyRole). ScriptHash -> Credential kr
ScriptHashObj (Int -> ScriptHash
SLE.mkScriptHash Int
1))
          , Credential 'Staking -> Either Coin (Credential 'Staking)
forall a b. b -> Either a b
Right (KeyHash 'Staking -> Credential 'Staking
forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj (Int -> KeyHash 'Staking
forall (discriminator :: KeyRole). Int -> KeyHash discriminator
SLE.mkKeyHash Int
2))
          ]
    , sleResultExamples :: ShelleyResultExamples BabbageEra
SLE.sleResultExamples = ShelleyResultExamples BabbageEra
resultExamples
    , sleNewEpochState :: NewEpochState BabbageEra
SLE.sleNewEpochState = NewEpochState BabbageEra
exampleBabbageNewEpochState
    , sleChainDepState :: ChainDepState
SLE.sleChainDepState = Word64 -> ChainDepState
SLE.exampleLedgerChainDepState Word64
1
    , sleTranslationContext :: TranslationContext BabbageEra
SLE.sleTranslationContext = TranslationContext BabbageEra
NoGenesis BabbageEra
forall era. NoGenesis era
NoGenesis
    }
  where
    resultExamples :: ShelleyResultExamples BabbageEra
resultExamples =
      SLE.ShelleyResultExamples
        { srePParams :: PParams BabbageEra
SLE.srePParams = PParams BabbageEra
forall a. Default a => a
def
        , sreProposedPPUpdates :: ProposedPPUpdates BabbageEra
SLE.sreProposedPPUpdates = ProposedPPUpdates BabbageEra
examplePPPU
        , srePoolDistr :: PoolDistr
SLE.srePoolDistr = PoolDistr
SLE.examplePoolDistr
        , sreNonMyopicRewards :: Map
  (Either Coin (Credential 'Staking)) (Map (KeyHash 'StakePool) Coin)
SLE.sreNonMyopicRewards = Map
  (Either Coin (Credential 'Staking)) (Map (KeyHash 'StakePool) Coin)
SLE.exampleNonMyopicRewards
        , sreShelleyGenesis :: ShelleyGenesis
SLE.sreShelleyGenesis = ShelleyGenesis
SLE.testShelleyGenesis
        }
    examplePPPU :: ProposedPPUpdates BabbageEra
examplePPPU =
      Map (KeyHash 'Genesis) (PParamsUpdate BabbageEra)
-> ProposedPPUpdates BabbageEra
forall era.
Map (KeyHash 'Genesis) (PParamsUpdate era) -> ProposedPPUpdates era
ProposedPPUpdates (Map (KeyHash 'Genesis) (PParamsUpdate BabbageEra)
 -> ProposedPPUpdates BabbageEra)
-> Map (KeyHash 'Genesis) (PParamsUpdate BabbageEra)
-> ProposedPPUpdates BabbageEra
forall a b. (a -> b) -> a -> b
$
        KeyHash 'Genesis
-> PParamsUpdate BabbageEra
-> Map (KeyHash 'Genesis) (PParamsUpdate BabbageEra)
forall k a. k -> a -> Map k a
Map.singleton
          (Int -> KeyHash 'Genesis
forall (discriminator :: KeyRole). Int -> KeyHash discriminator
SLE.mkKeyHash Int
0)
          (PParamsUpdate BabbageEra
forall era. EraPParams era => PParamsUpdate era
emptyPParamsUpdate PParamsUpdate BabbageEra
-> (PParamsUpdate BabbageEra -> PParamsUpdate BabbageEra)
-> PParamsUpdate BabbageEra
forall a b. a -> (a -> b) -> b
& (StrictMaybe Natural -> Identity (StrictMaybe Natural))
-> PParamsUpdate BabbageEra -> Identity (PParamsUpdate BabbageEra)
forall era.
AlonzoEraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe Natural)
Lens' (PParamsUpdate BabbageEra) (StrictMaybe Natural)
ppuCollateralPercentageL ((StrictMaybe Natural -> Identity (StrictMaybe Natural))
 -> PParamsUpdate BabbageEra -> Identity (PParamsUpdate BabbageEra))
-> StrictMaybe Natural
-> PParamsUpdate BabbageEra
-> PParamsUpdate BabbageEra
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Natural -> StrictMaybe Natural
forall a. a -> StrictMaybe a
SJust Natural
150)

collateralOutput :: BabbageTxOut BabbageEra
collateralOutput :: BabbageTxOut BabbageEra
collateralOutput =
  Addr
-> Value BabbageEra
-> Datum BabbageEra
-> StrictMaybe (Script BabbageEra)
-> BabbageTxOut BabbageEra
forall era.
(Era era, Val (Value era), HasCallStack) =>
Addr
-> Value era
-> Datum era
-> StrictMaybe (Script era)
-> BabbageTxOut era
BabbageTxOut
    (KeyPair 'Payment -> KeyPair 'Staking -> Addr
forall p s.
(MakeCredential p 'Payment, MakeStakeReference s) =>
p -> s -> Addr
mkAddr KeyPair 'Payment
SLE.examplePayKey KeyPair 'Staking
SLE.exampleStakeKey)
    (Coin -> MultiAsset -> MaryValue
MaryValue (Integer -> Coin
Coin Integer
8675309) MultiAsset
forall a. Monoid a => a
mempty)
    Datum BabbageEra
forall era. Datum era
NoDatum
    StrictMaybe (Script BabbageEra)
StrictMaybe (AlonzoScript BabbageEra)
forall a. StrictMaybe a
SNothing

exampleTxBodyBabbage :: TxBody BabbageEra
exampleTxBodyBabbage :: TxBody BabbageEra
exampleTxBodyBabbage =
  Set TxIn
-> Set TxIn
-> Set TxIn
-> StrictSeq (Sized (TxOut BabbageEra))
-> StrictMaybe (Sized (TxOut BabbageEra))
-> StrictMaybe Coin
-> StrictSeq (TxCert BabbageEra)
-> Withdrawals
-> Coin
-> ValidityInterval
-> StrictMaybe (Update BabbageEra)
-> Set (KeyHash 'Witness)
-> MultiAsset
-> StrictMaybe ScriptIntegrityHash
-> StrictMaybe TxAuxDataHash
-> StrictMaybe Network
-> TxBody BabbageEra
BabbageTxBody
    ([TxIn] -> Set TxIn
forall a. Ord a => [a] -> Set a
Set.fromList [HasCallStack => TxId -> Integer -> TxIn
TxId -> Integer -> TxIn
mkTxInPartial (SafeHash EraIndependentTxBody -> TxId
TxId (Int -> SafeHash EraIndependentTxBody
forall a. Int -> SafeHash a
SLE.mkDummySafeHash Int
1)) Integer
0]) -- spending inputs
    ([TxIn] -> Set TxIn
forall a. Ord a => [a] -> Set a
Set.fromList [HasCallStack => TxId -> Integer -> TxIn
TxId -> Integer -> TxIn
mkTxInPartial (SafeHash EraIndependentTxBody -> TxId
TxId (Int -> SafeHash EraIndependentTxBody
forall a. Int -> SafeHash a
SLE.mkDummySafeHash Int
2)) Integer
1]) -- collateral inputs
    ([TxIn] -> Set TxIn
forall a. Ord a => [a] -> Set a
Set.fromList [HasCallStack => TxId -> Integer -> TxIn
TxId -> Integer -> TxIn
mkTxInPartial (SafeHash EraIndependentTxBody -> TxId
TxId (Int -> SafeHash EraIndependentTxBody
forall a. Int -> SafeHash a
SLE.mkDummySafeHash Int
1)) Integer
3]) -- reference inputs
    ( [Sized (BabbageTxOut BabbageEra)]
-> StrictSeq (Sized (BabbageTxOut BabbageEra))
forall a. [a] -> StrictSeq a
StrictSeq.fromList
        [ Version
-> BabbageTxOut BabbageEra -> Sized (BabbageTxOut BabbageEra)
forall a. EncCBOR a => Version -> a -> Sized a
mkSized (forall era. Era era => Version
eraProtVerHigh @BabbageEra) (BabbageTxOut BabbageEra -> Sized (BabbageTxOut BabbageEra))
-> BabbageTxOut BabbageEra -> Sized (BabbageTxOut BabbageEra)
forall a b. (a -> b) -> a -> b
$
            Addr
-> Value BabbageEra
-> Datum BabbageEra
-> StrictMaybe (Script BabbageEra)
-> BabbageTxOut BabbageEra
forall era.
(Era era, Val (Value era), HasCallStack) =>
Addr
-> Value era
-> Datum era
-> StrictMaybe (Script era)
-> BabbageTxOut era
BabbageTxOut
              (KeyPair 'Payment -> KeyPair 'Staking -> Addr
forall p s.
(MakeCredential p 'Payment, MakeStakeReference s) =>
p -> s -> Addr
mkAddr KeyPair 'Payment
SLE.examplePayKey KeyPair 'Staking
SLE.exampleStakeKey)
              (Int -> MaryValue
MarySLE.exampleMultiAssetValue Int
2)
              (BinaryData BabbageEra -> Datum BabbageEra
forall era. BinaryData era -> Datum era
Datum (BinaryData BabbageEra -> Datum BabbageEra)
-> BinaryData BabbageEra -> Datum BabbageEra
forall a b. (a -> b) -> a -> b
$ Data BabbageEra -> BinaryData BabbageEra
forall era. Data era -> BinaryData era
dataToBinaryData Data BabbageEra
datumExample) -- inline datum
              (Script BabbageEra -> StrictMaybe (Script BabbageEra)
forall a. a -> StrictMaybe a
SJust (Script BabbageEra -> StrictMaybe (Script BabbageEra))
-> Script BabbageEra -> StrictMaybe (Script BabbageEra)
forall a b. (a -> b) -> a -> b
$ forall (l :: Language) era.
(HasCallStack, EraPlutusTxInfo l era) =>
Natural -> Script era
alwaysSucceeds @'PlutusV2 Natural
3) -- reference script
        ]
    )
    (Sized (TxOut BabbageEra) -> StrictMaybe (Sized (TxOut BabbageEra))
forall a. a -> StrictMaybe a
SJust (Sized (TxOut BabbageEra)
 -> StrictMaybe (Sized (TxOut BabbageEra)))
-> Sized (TxOut BabbageEra)
-> StrictMaybe (Sized (TxOut BabbageEra))
forall a b. (a -> b) -> a -> b
$ Version
-> BabbageTxOut BabbageEra -> Sized (BabbageTxOut BabbageEra)
forall a. EncCBOR a => Version -> a -> Sized a
mkSized (forall era. Era era => Version
eraProtVerHigh @BabbageEra) BabbageTxOut BabbageEra
collateralOutput) -- collateral return
    (Coin -> StrictMaybe Coin
forall a. a -> StrictMaybe a
SJust (Coin -> StrictMaybe Coin) -> Coin -> StrictMaybe Coin
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
8675309) -- collateral tot
    StrictSeq (TxCert BabbageEra)
forall era.
(ShelleyEraTxCert era, ProtVerAtMost era 8) =>
StrictSeq (TxCert era)
SLE.exampleCerts -- txcerts
    ( Map RewardAccount Coin -> Withdrawals
Withdrawals (Map RewardAccount Coin -> Withdrawals)
-> Map RewardAccount Coin -> Withdrawals
forall a b. (a -> b) -> a -> b
$
        RewardAccount -> Coin -> Map RewardAccount Coin
forall k a. k -> a -> Map k a
Map.singleton
          (Network -> Credential 'Staking -> RewardAccount
RewardAccount Network
Testnet (KeyPair 'Staking -> Credential 'Staking
forall (r :: KeyRole). KeyPair r -> Credential r
SLE.keyToCredential KeyPair 'Staking
SLE.exampleStakeKey))
          (Integer -> Coin
Coin Integer
100) -- txwdrls
    )
    (Integer -> Coin
Coin Integer
999) -- txfee
    (StrictMaybe SlotNo -> StrictMaybe SlotNo -> ValidityInterval
ValidityInterval (SlotNo -> StrictMaybe SlotNo
forall a. a -> StrictMaybe a
SJust (Word64 -> SlotNo
SlotNo Word64
2)) (SlotNo -> StrictMaybe SlotNo
forall a. a -> StrictMaybe a
SJust (Word64 -> SlotNo
SlotNo Word64
4))) -- txvldt
    ( Update BabbageEra -> StrictMaybe (Update BabbageEra)
forall a. a -> StrictMaybe a
SJust (Update BabbageEra -> StrictMaybe (Update BabbageEra))
-> Update BabbageEra -> StrictMaybe (Update BabbageEra)
forall a b. (a -> b) -> a -> b
$
        ProposedPPUpdates BabbageEra -> EpochNo -> Update BabbageEra
forall era. ProposedPPUpdates era -> EpochNo -> Update era
Update
          ( Map (KeyHash 'Genesis) (PParamsUpdate BabbageEra)
-> ProposedPPUpdates BabbageEra
forall era.
Map (KeyHash 'Genesis) (PParamsUpdate era) -> ProposedPPUpdates era
ProposedPPUpdates (Map (KeyHash 'Genesis) (PParamsUpdate BabbageEra)
 -> ProposedPPUpdates BabbageEra)
-> Map (KeyHash 'Genesis) (PParamsUpdate BabbageEra)
-> ProposedPPUpdates BabbageEra
forall a b. (a -> b) -> a -> b
$
              KeyHash 'Genesis
-> PParamsUpdate BabbageEra
-> Map (KeyHash 'Genesis) (PParamsUpdate BabbageEra)
forall k a. k -> a -> Map k a
Map.singleton
                (Int -> KeyHash 'Genesis
forall (discriminator :: KeyRole). Int -> KeyHash discriminator
SLE.mkKeyHash Int
1)
                (PParamsUpdate BabbageEra
forall era. EraPParams era => PParamsUpdate era
emptyPParamsUpdate PParamsUpdate BabbageEra
-> (PParamsUpdate BabbageEra -> PParamsUpdate BabbageEra)
-> PParamsUpdate BabbageEra
forall a b. a -> (a -> b) -> b
& (StrictMaybe Word16 -> Identity (StrictMaybe Word16))
-> PParamsUpdate BabbageEra -> Identity (PParamsUpdate BabbageEra)
forall era.
EraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe Word16)
Lens' (PParamsUpdate BabbageEra) (StrictMaybe Word16)
ppuMaxBHSizeL ((StrictMaybe Word16 -> Identity (StrictMaybe Word16))
 -> PParamsUpdate BabbageEra -> Identity (PParamsUpdate BabbageEra))
-> StrictMaybe Word16
-> PParamsUpdate BabbageEra
-> PParamsUpdate BabbageEra
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Word16 -> StrictMaybe Word16
forall a. a -> StrictMaybe a
SJust Word16
4000)
          )
          (Word64 -> EpochNo
EpochNo Word64
0)
    ) -- txUpdates
    (KeyHash 'Witness -> Set (KeyHash 'Witness)
forall a. a -> Set a
Set.singleton (KeyHash 'Witness -> Set (KeyHash 'Witness))
-> KeyHash 'Witness -> Set (KeyHash 'Witness)
forall a b. (a -> b) -> a -> b
$ Int -> KeyHash 'Witness
forall (discriminator :: KeyRole). Int -> KeyHash discriminator
SLE.mkKeyHash Int
212) -- reqSignerHashes
    MultiAsset
exampleMultiAsset -- mint
    (ScriptIntegrityHash -> StrictMaybe ScriptIntegrityHash
forall a. a -> StrictMaybe a
SJust (ScriptIntegrityHash -> StrictMaybe ScriptIntegrityHash)
-> ScriptIntegrityHash -> StrictMaybe ScriptIntegrityHash
forall a b. (a -> b) -> a -> b
$ Int -> ScriptIntegrityHash
forall a. Int -> SafeHash a
SLE.mkDummySafeHash Int
42) -- scriptIntegrityHash
    (TxAuxDataHash -> StrictMaybe TxAuxDataHash
forall a. a -> StrictMaybe a
SJust (TxAuxDataHash -> StrictMaybe TxAuxDataHash)
-> (SafeHash EraIndependentTxAuxData -> TxAuxDataHash)
-> SafeHash EraIndependentTxAuxData
-> StrictMaybe TxAuxDataHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SafeHash EraIndependentTxAuxData -> TxAuxDataHash
TxAuxDataHash (SafeHash EraIndependentTxAuxData -> StrictMaybe TxAuxDataHash)
-> SafeHash EraIndependentTxAuxData -> StrictMaybe TxAuxDataHash
forall a b. (a -> b) -> a -> b
$ Int -> SafeHash EraIndependentTxAuxData
forall a. Int -> SafeHash a
SLE.mkDummySafeHash Int
42) -- adHash
    (Network -> StrictMaybe Network
forall a. a -> StrictMaybe a
SJust Network
Mainnet) -- txnetworkid
  where
    MaryValue Coin
_ MultiAsset
exampleMultiAsset = Int -> MaryValue
MarySLE.exampleMultiAssetValue Int
3

datumExample :: Data BabbageEra
datumExample :: Data BabbageEra
datumExample = Data -> Data BabbageEra
forall era. Era era => Data -> Data era
Data (Integer -> Data
P.I Integer
191)

redeemerExample :: Data BabbageEra
redeemerExample :: Data BabbageEra
redeemerExample = Data -> Data BabbageEra
forall era. Era era => Data -> Data era
Data (Integer -> Data
P.I Integer
919)

exampleTx :: ShelleyTx BabbageEra
exampleTx :: ShelleyTx BabbageEra
exampleTx =
  TxBody BabbageEra
-> TxWits BabbageEra
-> StrictMaybe (TxAuxData BabbageEra)
-> ShelleyTx BabbageEra
forall era.
TxBody era
-> TxWits era -> StrictMaybe (TxAuxData era) -> ShelleyTx era
ShelleyTx
    TxBody BabbageEra
exampleTxBodyBabbage
    ( Set (WitVKey 'Witness)
-> Set BootstrapWitness
-> Map ScriptHash (Script BabbageEra)
-> TxDats BabbageEra
-> Redeemers BabbageEra
-> AlonzoTxWits BabbageEra
forall era.
AlonzoEraScript era =>
Set (WitVKey 'Witness)
-> Set BootstrapWitness
-> Map ScriptHash (Script era)
-> TxDats era
-> Redeemers era
-> AlonzoTxWits era
AlonzoTxWits
        (SafeHash EraIndependentTxBody
-> [KeyPair 'Witness] -> Set (WitVKey 'Witness)
forall (kr :: KeyRole).
SafeHash EraIndependentTxBody
-> [KeyPair kr] -> Set (WitVKey 'Witness)
mkWitnessesVKey (TxBody BabbageEra -> SafeHash EraIndependentTxBody
forall x i. HashAnnotated x i => x -> SafeHash i
hashAnnotated TxBody BabbageEra
exampleTxBodyBabbage) [KeyPair 'Payment -> KeyPair 'Witness
forall (a :: KeyRole -> *) (r :: KeyRole).
HasKeyRole a =>
a r -> a 'Witness
asWitness KeyPair 'Payment
SLE.examplePayKey]) -- vkey
        Set BootstrapWitness
forall a. Monoid a => a
mempty -- bootstrap
        ( ScriptHash
-> AlonzoScript BabbageEra
-> Map ScriptHash (AlonzoScript BabbageEra)
forall k a. k -> a -> Map k a
Map.singleton
            (forall era. EraScript era => Script era -> ScriptHash
hashScript @BabbageEra (Script BabbageEra -> ScriptHash)
-> Script BabbageEra -> ScriptHash
forall a b. (a -> b) -> a -> b
$ forall (l :: Language) era.
(HasCallStack, EraPlutusTxInfo l era) =>
Natural -> Script era
alwaysSucceeds @'PlutusV1 Natural
3)
            (forall (l :: Language) era.
(HasCallStack, EraPlutusTxInfo l era) =>
Natural -> Script era
alwaysSucceeds @'PlutusV1 Natural
3) -- txscripts
        )
        (Map DataHash (Data BabbageEra) -> TxDats BabbageEra
forall era. Era era => Map DataHash (Data era) -> TxDats era
TxDats (Map DataHash (Data BabbageEra) -> TxDats BabbageEra)
-> Map DataHash (Data BabbageEra) -> TxDats BabbageEra
forall a b. (a -> b) -> a -> b
$ DataHash -> Data BabbageEra -> Map DataHash (Data BabbageEra)
forall k a. k -> a -> Map k a
Map.singleton (Data BabbageEra -> DataHash
forall era. Data era -> DataHash
hashData Data BabbageEra
datumExample) Data BabbageEra
datumExample)
        ( Map (PlutusPurpose AsIx BabbageEra) (Data BabbageEra, ExUnits)
-> Redeemers BabbageEra
forall era.
AlonzoEraScript era =>
Map (PlutusPurpose AsIx era) (Data era, ExUnits) -> Redeemers era
Redeemers (Map (PlutusPurpose AsIx BabbageEra) (Data BabbageEra, ExUnits)
 -> Redeemers BabbageEra)
-> Map (PlutusPurpose AsIx BabbageEra) (Data BabbageEra, ExUnits)
-> Redeemers BabbageEra
forall a b. (a -> b) -> a -> b
$
            AlonzoPlutusPurpose AsIx BabbageEra
-> (Data BabbageEra, ExUnits)
-> Map
     (AlonzoPlutusPurpose AsIx BabbageEra) (Data BabbageEra, ExUnits)
forall k a. k -> a -> Map k a
Map.singleton (AsIx Word32 TxIn -> AlonzoPlutusPurpose AsIx BabbageEra
forall (f :: * -> * -> *) era.
f Word32 TxIn -> AlonzoPlutusPurpose f era
AlonzoSpending (AsIx Word32 TxIn -> AlonzoPlutusPurpose AsIx BabbageEra)
-> AsIx Word32 TxIn -> AlonzoPlutusPurpose AsIx BabbageEra
forall a b. (a -> b) -> a -> b
$ Word32 -> AsIx Word32 TxIn
forall ix it. ix -> AsIx ix it
AsIx Word32
0) (Data BabbageEra
redeemerExample, Natural -> Natural -> ExUnits
ExUnits Natural
5000 Natural
5000)
        ) -- redeemers
    )
    ( TxAuxData BabbageEra -> StrictMaybe (TxAuxData BabbageEra)
forall a. a -> StrictMaybe a
SJust (TxAuxData BabbageEra -> StrictMaybe (TxAuxData BabbageEra))
-> TxAuxData BabbageEra -> StrictMaybe (TxAuxData BabbageEra)
forall a b. (a -> b) -> a -> b
$
        Map Word64 Metadatum
-> [AlonzoScript BabbageEra] -> AlonzoTxAuxData BabbageEra
forall (f :: * -> *) era.
(Foldable f, AlonzoEraScript era) =>
Map Word64 Metadatum -> f (AlonzoScript era) -> AlonzoTxAuxData era
mkAlonzoTxAuxData
          Map Word64 Metadatum
SLE.exampleAuxDataMap -- metadata
          [forall (l :: Language) era.
(HasCallStack, EraPlutusTxInfo l era) =>
Natural -> Script era
alwaysFails @'PlutusV1 Natural
2, Timelock BabbageEra -> AlonzoScript BabbageEra
forall era. Timelock era -> AlonzoScript era
TimelockScript (Timelock BabbageEra -> AlonzoScript BabbageEra)
-> Timelock BabbageEra -> AlonzoScript BabbageEra
forall a b. (a -> b) -> a -> b
$ StrictSeq (NativeScript BabbageEra) -> NativeScript BabbageEra
forall era.
ShelleyEraScript era =>
StrictSeq (NativeScript era) -> NativeScript era
RequireAllOf StrictSeq (Timelock BabbageEra)
StrictSeq (NativeScript BabbageEra)
forall a. Monoid a => a
mempty] -- Scripts
    )

exampleTransactionInBlock :: AlonzoTx BabbageEra
exampleTransactionInBlock :: AlonzoTx BabbageEra
exampleTransactionInBlock = TxBody BabbageEra
-> TxWits BabbageEra
-> IsValid
-> StrictMaybe (TxAuxData BabbageEra)
-> AlonzoTx BabbageEra
forall era.
TxBody era
-> TxWits era
-> IsValid
-> StrictMaybe (TxAuxData era)
-> AlonzoTx era
AlonzoTx TxBody BabbageEra
b TxWits BabbageEra
AlonzoTxWits BabbageEra
w (Bool -> IsValid
IsValid Bool
True) StrictMaybe (TxAuxData BabbageEra)
StrictMaybe (AlonzoTxAuxData BabbageEra)
a
  where
    ShelleyTx TxBody BabbageEra
b TxWits BabbageEra
w StrictMaybe (TxAuxData BabbageEra)
a = ShelleyTx BabbageEra
exampleTx

exampleBabbageNewEpochState :: NewEpochState BabbageEra
exampleBabbageNewEpochState :: NewEpochState BabbageEra
exampleBabbageNewEpochState =
  Value BabbageEra
-> PParams BabbageEra
-> PParams BabbageEra
-> NewEpochState BabbageEra
forall era.
(EraTxOut era, EraGov era, EraStake era, EraCertState era,
 Default (StashedAVVMAddresses era)) =>
Value era -> PParams era -> PParams era -> NewEpochState era
SLE.exampleNewEpochState
    (Int -> MaryValue
MarySLE.exampleMultiAssetValue Int
1)
    PParams BabbageEra
forall era. EraPParams era => PParams era
emptyPParams
    (PParams BabbageEra
forall era. EraPParams era => PParams era
emptyPParams PParams BabbageEra
-> (PParams BabbageEra -> PParams BabbageEra) -> PParams BabbageEra
forall a b. a -> (a -> b) -> b
& (CoinPerByte -> Identity CoinPerByte)
-> PParams BabbageEra -> Identity (PParams BabbageEra)
forall era.
BabbageEraPParams era =>
Lens' (PParams era) CoinPerByte
Lens' (PParams BabbageEra) CoinPerByte
ppCoinsPerUTxOByteL ((CoinPerByte -> Identity CoinPerByte)
 -> PParams BabbageEra -> Identity (PParams BabbageEra))
-> CoinPerByte -> PParams BabbageEra -> PParams BabbageEra
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Coin -> CoinPerByte
CoinPerByte (Integer -> Coin
Coin Integer
1))