{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}

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

import Cardano.Ledger.Allegra
import Cardano.Ledger.Allegra.Core
import Cardano.Ledger.Allegra.Scripts
import Cardano.Ledger.Allegra.TxAuxData
import Cardano.Ledger.Allegra.TxBody
import Cardano.Ledger.AuxiliaryData
import Cardano.Ledger.Coin
import Cardano.Ledger.Genesis (NoGenesis (..))
import Cardano.Ledger.Shelley.PParams (Update (..))
import Cardano.Ledger.Shelley.Scripts
import Cardano.Slotting.Slot
import Data.Proxy
import qualified Data.Sequence.Strict as StrictSeq
import Lens.Micro
import Test.Cardano.Ledger.Core.KeyPair (mkAddr)
import Test.Cardano.Ledger.Core.Utils (mkDummySafeHash)
import Test.Cardano.Ledger.Shelley.Examples.Consensus

-- | ShelleyLedgerExamples for Allegra era
ledgerExamplesAllegra :: ShelleyLedgerExamples Allegra
ledgerExamplesAllegra :: ShelleyLedgerExamples Allegra
ledgerExamplesAllegra =
  forall era.
(ShelleyBasedEra' era, EraSegWits era, EraGov era,
 PredicateFailure (EraRule "DELEGS" era)
 ~ ShelleyDelegsPredFailure era,
 PredicateFailure (EraRule "LEDGER" era)
 ~ ShelleyLedgerPredFailure era,
 Default (StashedAVVMAddresses era), ProtVerAtMost era 4) =>
(TxBody era -> KeyPairWits era -> TxWits era)
-> (ShelleyTx era -> Tx era)
-> Value era
-> TxBody era
-> TxAuxData era
-> TranslationContext era
-> ShelleyLedgerExamples era
defaultShelleyLedgerExamples
    (forall era.
(EraTx era,
 Signable
   (DSIGN (EraCrypto era))
   (Hash (HASH (EraCrypto era)) EraIndependentTxBody)) =>
Proxy era -> TxBody era -> KeyPairWits era -> ShelleyTxWits era
mkWitnessesPreAlonzo (forall {k} (t :: k). Proxy t
Proxy @Allegra))
    forall a. a -> a
id
    Coin
exampleCoin
    (forall era.
(AllegraEraTxBody era, ShelleyEraTxBody era) =>
Value era -> TxBody era
exampleAllegraTxBody Coin
exampleCoin)
    forall era.
(AllegraEraScript era, NativeScript era ~ Timelock era) =>
AllegraTxAuxData era
exampleAllegraTxAuxData
    forall era. NoGenesis era
NoGenesis

exampleAllegraTxBody ::
  forall era.
  ( AllegraEraTxBody era
  , ShelleyEraTxBody era
  ) =>
  Value era ->
  TxBody era
exampleAllegraTxBody :: forall era.
(AllegraEraTxBody era, ShelleyEraTxBody era) =>
Value era -> TxBody era
exampleAllegraTxBody Value era
value =
  forall era. EraTxBody era => TxBody era
mkBasicTxBody
    forall a b. a -> (a -> b) -> b
& forall era.
EraTxBody era =>
Lens' (TxBody era) (Set (TxIn (EraCrypto era)))
inputsTxBodyL forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall c. Crypto c => Set (TxIn c)
exampleTxIns
    forall a b. a -> (a -> b) -> b
& forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxOut era))
outputsTxBodyL
      forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall a. a -> StrictSeq a
StrictSeq.singleton (forall era.
(EraTxOut era, HasCallStack) =>
Addr (EraCrypto era) -> Value era -> TxOut era
mkBasicTxOut (forall c.
Crypto c =>
(KeyPair 'Payment c, KeyPair 'Staking c) -> Addr c
mkAddr (forall c. Crypto c => KeyPair 'Payment c
examplePayKey, forall c. Crypto c => KeyPair 'Staking c
exampleStakeKey)) Value era
value)
    forall a b. a -> (a -> b) -> b
& forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxCert era))
certsTxBodyL forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall era.
(ShelleyEraTxCert era, ProtVerAtMost era 8) =>
StrictSeq (TxCert era)
exampleCerts
    forall a b. a -> (a -> b) -> b
& forall era.
EraTxBody era =>
Lens' (TxBody era) (Withdrawals (EraCrypto era))
withdrawalsTxBodyL forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall c. Crypto c => Withdrawals c
exampleWithdrawals
    forall a b. a -> (a -> b) -> b
& forall era. EraTxBody era => Lens' (TxBody era) Coin
feeTxBodyL forall s t a b. ASetter s t a b -> b -> s -> t
.~ Integer -> Coin
Coin Integer
3
    forall a b. a -> (a -> b) -> b
& forall era.
AllegraEraTxBody era =>
Lens' (TxBody era) ValidityInterval
vldtTxBodyL forall s t a b. ASetter s t a b -> b -> s -> t
.~ StrictMaybe SlotNo -> StrictMaybe SlotNo -> ValidityInterval
ValidityInterval (forall a. a -> StrictMaybe a
SJust (Word64 -> SlotNo
SlotNo Word64
2)) (forall a. a -> StrictMaybe a
SJust (Word64 -> SlotNo
SlotNo Word64
4))
    forall a b. a -> (a -> b) -> b
& forall era.
ShelleyEraTxBody era =>
Lens' (TxBody era) (StrictMaybe (Update era))
updateTxBodyL forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall a. a -> StrictMaybe a
SJust (forall era. ProposedPPUpdates era -> EpochNo -> Update era
Update forall era. EraPParams era => ProposedPPUpdates era
exampleProposedPPUpdates (Word64 -> EpochNo
EpochNo Word64
0))
    forall a b. a -> (a -> b) -> b
& forall era.
EraTxBody era =>
Lens'
  (TxBody era) (StrictMaybe (AuxiliaryDataHash (EraCrypto era)))
auxDataHashTxBodyL forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall a. a -> StrictMaybe a
SJust AuxiliaryDataHash (EraCrypto era)
auxiliaryDataHash
  where
    -- Dummy hash to decouple from the auxiliary data in 'exampleTx'.
    auxiliaryDataHash :: AuxiliaryDataHash (EraCrypto era)
    auxiliaryDataHash :: AuxiliaryDataHash (EraCrypto era)
auxiliaryDataHash =
      forall c. SafeHash c EraIndependentTxAuxData -> AuxiliaryDataHash c
AuxiliaryDataHash forall a b. (a -> b) -> a -> b
$ forall c a. Crypto c => Proxy c -> Int -> SafeHash c a
mkDummySafeHash (forall {k} (t :: k). Proxy t
Proxy @(EraCrypto era)) Int
30

exampleTimelock :: AllegraEraScript era => NativeScript era
exampleTimelock :: forall era. AllegraEraScript era => NativeScript era
exampleTimelock =
  forall era.
ShelleyEraScript era =>
Int -> StrictSeq (NativeScript era) -> NativeScript era
RequireMOf Int
2 forall a b. (a -> b) -> a -> b
$
    forall a. [a] -> StrictSeq a
StrictSeq.fromList
      [ forall era.
ShelleyEraScript era =>
StrictSeq (NativeScript era) -> NativeScript era
RequireAllOf forall a b. (a -> b) -> a -> b
$
          forall a. [a] -> StrictSeq a
StrictSeq.fromList
            [ forall era. AllegraEraScript era => SlotNo -> NativeScript era
RequireTimeStart (Word64 -> SlotNo
SlotNo Word64
0)
            , forall era. AllegraEraScript era => SlotNo -> NativeScript era
RequireTimeExpire (Word64 -> SlotNo
SlotNo Word64
9)
            ]
      , forall era.
ShelleyEraScript era =>
StrictSeq (NativeScript era) -> NativeScript era
RequireAnyOf forall a b. (a -> b) -> a -> b
$
          forall a. [a] -> StrictSeq a
StrictSeq.fromList
            [ forall era.
ShelleyEraScript era =>
KeyHash 'Witness (EraCrypto era) -> NativeScript era
RequireSignature (forall c (discriminator :: KeyRole).
Crypto c =>
Int -> KeyHash discriminator c
mkKeyHash Int
0)
            , forall era.
ShelleyEraScript era =>
KeyHash 'Witness (EraCrypto era) -> NativeScript era
RequireSignature (forall c (discriminator :: KeyRole).
Crypto c =>
Int -> KeyHash discriminator c
mkKeyHash Int
1)
            ]
      , forall era.
ShelleyEraScript era =>
KeyHash 'Witness (EraCrypto era) -> NativeScript era
RequireSignature (forall c (discriminator :: KeyRole).
Crypto c =>
Int -> KeyHash discriminator c
mkKeyHash Int
100)
      ]

exampleAllegraTxAuxData ::
  (AllegraEraScript era, NativeScript era ~ Timelock era) => AllegraTxAuxData era
exampleAllegraTxAuxData :: forall era.
(AllegraEraScript era, NativeScript era ~ Timelock era) =>
AllegraTxAuxData era
exampleAllegraTxAuxData = forall era.
Era era =>
Map Word64 Metadatum
-> StrictSeq (Timelock era) -> AllegraTxAuxData era
AllegraTxAuxData Map Word64 Metadatum
exampleAuxDataMap (forall a. [a] -> StrictSeq a
StrictSeq.fromList [forall era. AllegraEraScript era => NativeScript era
exampleTimelock])