{-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-} module Test.Cardano.Ledger.Allegra.Examples ( ledgerExamples, mkAllegraBasedExampleTx, exampleAllegraBasedTxBody, exampleAllegraBasedShelleyTxBody, ) where import Cardano.Ledger.Allegra import Cardano.Ledger.Allegra.Core import Cardano.Ledger.Allegra.Scripts import Cardano.Ledger.Allegra.TxBody import Cardano.Ledger.Genesis (NoGenesis (..)) import Cardano.Ledger.Shelley.Rules ( ShelleyDelegPredFailure (DelegateeNotRegisteredDELEG), ShelleyDelegsPredFailure (DelplFailure), ShelleyDelplPredFailure (DelegFailure), ShelleyLedgerPredFailure (DelegsFailure), ) import Cardano.Ledger.Shelley.Scripts import Cardano.Slotting.Slot import qualified Data.Sequence.Strict as StrictSeq import Lens.Micro import Test.Cardano.Ledger.Shelley.Examples ( LedgerExamples, exampleCoin, exampleShelleyBasedShelleyTxBody, exampleShelleyBasedTxBody, mkKeyHash, mkShelleyBasedExampleTx, mkShelleyBasedLedgerExamples, ) ledgerExamples :: LedgerExamples AllegraEra ledgerExamples :: LedgerExamples AllegraEra ledgerExamples = ApplyTxError AllegraEra -> Value AllegraEra -> Tx TopTx AllegraEra -> TranslationContext AllegraEra -> LedgerExamples AllegraEra forall era. (EraTx era, EraGov era, EraStake era, EraCertState era, Default (StashedAVVMAddresses era), AtMostEra "Mary" era) => ApplyTxError era -> Value era -> Tx TopTx era -> TranslationContext era -> LedgerExamples era mkShelleyBasedLedgerExamples ( NonEmpty (ShelleyLedgerPredFailure AllegraEra) -> ApplyTxError AllegraEra AllegraApplyTxError (NonEmpty (ShelleyLedgerPredFailure AllegraEra) -> ApplyTxError AllegraEra) -> (ShelleyDelegPredFailure AllegraEra -> NonEmpty (ShelleyLedgerPredFailure AllegraEra)) -> ShelleyDelegPredFailure AllegraEra -> ApplyTxError AllegraEra forall b c a. (b -> c) -> (a -> b) -> a -> c . ShelleyLedgerPredFailure AllegraEra -> NonEmpty (ShelleyLedgerPredFailure AllegraEra) forall a. a -> NonEmpty a forall (f :: * -> *) a. Applicative f => a -> f a pure (ShelleyLedgerPredFailure AllegraEra -> NonEmpty (ShelleyLedgerPredFailure AllegraEra)) -> (ShelleyDelegPredFailure AllegraEra -> ShelleyLedgerPredFailure AllegraEra) -> ShelleyDelegPredFailure AllegraEra -> NonEmpty (ShelleyLedgerPredFailure AllegraEra) forall b c a. (b -> c) -> (a -> b) -> a -> c . PredicateFailure (EraRule "DELEGS" AllegraEra) -> ShelleyLedgerPredFailure AllegraEra ShelleyDelegsPredFailure AllegraEra -> ShelleyLedgerPredFailure AllegraEra forall era. PredicateFailure (EraRule "DELEGS" era) -> ShelleyLedgerPredFailure era DelegsFailure (ShelleyDelegsPredFailure AllegraEra -> ShelleyLedgerPredFailure AllegraEra) -> (ShelleyDelegPredFailure AllegraEra -> ShelleyDelegsPredFailure AllegraEra) -> ShelleyDelegPredFailure AllegraEra -> ShelleyLedgerPredFailure AllegraEra forall b c a. (b -> c) -> (a -> b) -> a -> c . PredicateFailure (EraRule "DELPL" AllegraEra) -> ShelleyDelegsPredFailure AllegraEra ShelleyDelplPredFailure AllegraEra -> ShelleyDelegsPredFailure AllegraEra forall era. PredicateFailure (EraRule "DELPL" era) -> ShelleyDelegsPredFailure era DelplFailure (ShelleyDelplPredFailure AllegraEra -> ShelleyDelegsPredFailure AllegraEra) -> (ShelleyDelegPredFailure AllegraEra -> ShelleyDelplPredFailure AllegraEra) -> ShelleyDelegPredFailure AllegraEra -> ShelleyDelegsPredFailure AllegraEra forall b c a. (b -> c) -> (a -> b) -> a -> c . PredicateFailure (EraRule "DELEG" AllegraEra) -> ShelleyDelplPredFailure AllegraEra ShelleyDelegPredFailure AllegraEra -> ShelleyDelplPredFailure AllegraEra forall era. PredicateFailure (EraRule "DELEG" era) -> ShelleyDelplPredFailure era DelegFailure (ShelleyDelegPredFailure AllegraEra -> ApplyTxError AllegraEra) -> ShelleyDelegPredFailure AllegraEra -> ApplyTxError AllegraEra forall a b. (a -> b) -> a -> b $ forall era. KeyHash StakePool -> ShelleyDelegPredFailure era DelegateeNotRegisteredDELEG @AllegraEra (Int -> KeyHash StakePool forall (discriminator :: KeyRole). Int -> KeyHash discriminator mkKeyHash Int 1) ) Value AllegraEra Coin exampleCoin (TxBody TopTx AllegraEra -> Tx TopTx AllegraEra forall era. (EraTx era, AllegraEraTxAuxData era, AllegraEraScript era) => TxBody TopTx era -> Tx TopTx era mkAllegraBasedExampleTx (TxBody TopTx AllegraEra -> Tx TopTx AllegraEra) -> TxBody TopTx AllegraEra -> Tx TopTx AllegraEra forall a b. (a -> b) -> a -> b $ Value AllegraEra -> TxBody TopTx AllegraEra forall era. (AllegraEraTxBody era, ShelleyEraTxBody era) => Value era -> TxBody TopTx era exampleAllegraBasedShelleyTxBody Value AllegraEra Coin exampleCoin) TranslationContext AllegraEra NoGenesis AllegraEra forall era. NoGenesis era NoGenesis mkAllegraBasedExampleTx :: forall era. ( EraTx era , AllegraEraTxAuxData era , AllegraEraScript era ) => TxBody TopTx era -> Tx TopTx era mkAllegraBasedExampleTx :: forall era. (EraTx era, AllegraEraTxAuxData era, AllegraEraScript era) => TxBody TopTx era -> Tx TopTx era mkAllegraBasedExampleTx TxBody TopTx era txBody = forall era. EraTx era => TxBody TopTx era -> Tx TopTx era mkShelleyBasedExampleTx @era TxBody TopTx era txBody Tx TopTx era -> (Tx TopTx era -> Tx TopTx era) -> Tx TopTx era forall a b. a -> (a -> b) -> b & (StrictMaybe (TxAuxData era) -> Identity (StrictMaybe (TxAuxData era))) -> Tx TopTx era -> Identity (Tx TopTx era) forall era (l :: TxLevel). EraTx era => Lens' (Tx l era) (StrictMaybe (TxAuxData era)) forall (l :: TxLevel). Lens' (Tx l era) (StrictMaybe (TxAuxData era)) auxDataTxL ((StrictMaybe (TxAuxData era) -> Identity (StrictMaybe (TxAuxData era))) -> Tx TopTx era -> Identity (Tx TopTx era)) -> (StrictMaybe (TxAuxData era) -> StrictMaybe (TxAuxData era)) -> Tx TopTx era -> Tx TopTx era forall s t a b. ASetter s t a b -> (a -> b) -> s -> t %~ (TxAuxData era -> TxAuxData era) -> StrictMaybe (TxAuxData era) -> StrictMaybe (TxAuxData era) forall a b. (a -> b) -> StrictMaybe a -> StrictMaybe b forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap ( \TxAuxData era auxData -> TxAuxData era auxData TxAuxData era -> (TxAuxData era -> TxAuxData era) -> TxAuxData era forall a b. a -> (a -> b) -> b & (StrictSeq (NativeScript era) -> Identity (StrictSeq (NativeScript era))) -> TxAuxData era -> Identity (TxAuxData era) forall era. AllegraEraTxAuxData era => Lens' (TxAuxData era) (StrictSeq (NativeScript era)) Lens' (TxAuxData era) (StrictSeq (NativeScript era)) nativeScriptsTxAuxDataL ((StrictSeq (NativeScript era) -> Identity (StrictSeq (NativeScript era))) -> TxAuxData era -> Identity (TxAuxData era)) -> StrictSeq (NativeScript era) -> TxAuxData era -> TxAuxData era forall a s t. Monoid a => ASetter s t a a -> a -> s -> t <>~ NativeScript era -> StrictSeq (NativeScript era) forall a. a -> StrictSeq a StrictSeq.singleton NativeScript era forall era. AllegraEraScript era => NativeScript era exampleTimelock ) exampleAllegraBasedShelleyTxBody :: forall era. ( AllegraEraTxBody era , ShelleyEraTxBody era ) => Value era -> TxBody TopTx era exampleAllegraBasedShelleyTxBody :: forall era. (AllegraEraTxBody era, ShelleyEraTxBody era) => Value era -> TxBody TopTx era exampleAllegraBasedShelleyTxBody Value era value = TxBody TopTx era -> TxBody TopTx era forall era. AllegraEraTxBody era => TxBody TopTx era -> TxBody TopTx era mkAllegraBasedExampleTxBody (Value era -> TxBody TopTx era forall era. ShelleyEraTxBody era => Value era -> TxBody TopTx era exampleShelleyBasedShelleyTxBody Value era value) exampleAllegraBasedTxBody :: forall era. AllegraEraTxBody era => Value era -> TxBody TopTx era exampleAllegraBasedTxBody :: forall era. AllegraEraTxBody era => Value era -> TxBody TopTx era exampleAllegraBasedTxBody Value era value = TxBody TopTx era -> TxBody TopTx era forall era. AllegraEraTxBody era => TxBody TopTx era -> TxBody TopTx era mkAllegraBasedExampleTxBody (Value era -> TxBody TopTx era forall era. EraTxBody era => Value era -> TxBody TopTx era exampleShelleyBasedTxBody Value era value) mkAllegraBasedExampleTxBody :: forall era. AllegraEraTxBody era => TxBody TopTx era -> TxBody TopTx era mkAllegraBasedExampleTxBody :: forall era. AllegraEraTxBody era => TxBody TopTx era -> TxBody TopTx era mkAllegraBasedExampleTxBody TxBody TopTx era txBody = TxBody TopTx era txBody TxBody TopTx era -> (TxBody TopTx era -> TxBody TopTx era) -> TxBody TopTx era forall a b. a -> (a -> b) -> b & (ValidityInterval -> Identity ValidityInterval) -> TxBody TopTx era -> Identity (TxBody TopTx era) forall era (l :: TxLevel). AllegraEraTxBody era => Lens' (TxBody l era) ValidityInterval forall (l :: TxLevel). Lens' (TxBody l era) ValidityInterval vldtTxBodyL ((ValidityInterval -> Identity ValidityInterval) -> TxBody TopTx era -> Identity (TxBody TopTx era)) -> ValidityInterval -> TxBody TopTx era -> TxBody TopTx era forall s t a b. ASetter s t a b -> b -> s -> t .~ 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)) exampleTimelock :: AllegraEraScript era => NativeScript era exampleTimelock :: forall era. AllegraEraScript era => NativeScript era exampleTimelock = Int -> StrictSeq (NativeScript era) -> NativeScript era forall era. ShelleyEraScript era => Int -> StrictSeq (NativeScript era) -> NativeScript era RequireMOf Int 2 (StrictSeq (NativeScript era) -> NativeScript era) -> StrictSeq (NativeScript era) -> NativeScript era forall a b. (a -> b) -> a -> b $ [NativeScript era] -> StrictSeq (NativeScript era) forall a. [a] -> StrictSeq a StrictSeq.fromList [ StrictSeq (NativeScript era) -> NativeScript era forall era. ShelleyEraScript era => StrictSeq (NativeScript era) -> NativeScript era RequireAllOf (StrictSeq (NativeScript era) -> NativeScript era) -> StrictSeq (NativeScript era) -> NativeScript era forall a b. (a -> b) -> a -> b $ [NativeScript era] -> StrictSeq (NativeScript era) forall a. [a] -> StrictSeq a StrictSeq.fromList [ SlotNo -> NativeScript era forall era. AllegraEraScript era => SlotNo -> NativeScript era RequireTimeStart (Word64 -> SlotNo SlotNo Word64 0) , SlotNo -> NativeScript era forall era. AllegraEraScript era => SlotNo -> NativeScript era RequireTimeExpire (Word64 -> SlotNo SlotNo Word64 9) ] , StrictSeq (NativeScript era) -> NativeScript era forall era. ShelleyEraScript era => StrictSeq (NativeScript era) -> NativeScript era RequireAnyOf (StrictSeq (NativeScript era) -> NativeScript era) -> StrictSeq (NativeScript era) -> NativeScript era forall a b. (a -> b) -> a -> b $ [NativeScript era] -> StrictSeq (NativeScript era) forall a. [a] -> StrictSeq a StrictSeq.fromList [ KeyHash Witness -> NativeScript era forall era. ShelleyEraScript era => KeyHash Witness -> NativeScript era RequireSignature (Int -> KeyHash Witness forall (discriminator :: KeyRole). Int -> KeyHash discriminator mkKeyHash Int 0) , KeyHash Witness -> NativeScript era forall era. ShelleyEraScript era => KeyHash Witness -> NativeScript era RequireSignature (Int -> KeyHash Witness forall (discriminator :: KeyRole). Int -> KeyHash discriminator mkKeyHash Int 1) ] , KeyHash Witness -> NativeScript era forall era. ShelleyEraScript era => KeyHash Witness -> NativeScript era RequireSignature (Int -> KeyHash Witness forall (discriminator :: KeyRole). Int -> KeyHash discriminator mkKeyHash Int 100) ]