{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeOperators #-}

module Test.Cardano.Ledger.Dijkstra.Examples (
  ledgerExamples,
  mkDijkstraBasedExampleTx,
  mkDijkstraBasedExampleTxBody,
) where

import Cardano.Ledger.Address (DirectDeposits (..))
import Cardano.Ledger.Alonzo.Plutus.Context (EraPlutusTxInfo)
import Cardano.Ledger.BaseTypes (Exclusive (..), Inclusive (..), Network (..), StrictMaybe (..))
import Cardano.Ledger.Coin (Coin (..))
import Cardano.Ledger.Conway.Core
import Cardano.Ledger.Conway.Rules (ConwayDELEG, ConwayDelegPredFailure (..))
import Cardano.Ledger.Credential (Credential (..))
import Cardano.Ledger.Dijkstra (ApplyTxError (..), DijkstraEra)
import Cardano.Ledger.Dijkstra.Rules (DijkstraLEDGER, DijkstraMEMPOOL)
import Cardano.Ledger.Dijkstra.Scripts (
  AccountBalanceInterval (..),
  AccountBalanceIntervals (..),
  DijkstraPlutusPurpose (..),
 )
import Cardano.Ledger.Dijkstra.TxBody (
  DijkstraEraTxBody,
  accountBalanceIntervalsTxBodyL,
  directDepositsTxBodyL,
  guardsTxBodyL,
  subTransactionsTxBodyL,
 )
import Cardano.Ledger.Dijkstra.TxCert
import Cardano.Ledger.Mary.Value (MaryValue (..))
import Cardano.Ledger.Plutus.Data (
  Datum (..),
  dataToBinaryData,
 )
import Cardano.Ledger.Plutus.Language (Language (..), plutusBinary)
import Control.State.Transition.Extended (Embed (..))
import qualified Data.List.NonEmpty as NE
import qualified Data.Map.Strict as Map
import qualified Data.OSet.Strict as OSet
import qualified Data.Sequence.Strict as StrictSeq
import Lens.Micro ((%~), (&), (.~), (<>~))
import Test.Cardano.Ledger.Alonzo.Arbitrary (alwaysSucceeds)
import Test.Cardano.Ledger.Alonzo.Examples (
  exampleDatum,
  mkAlonzoBasedLedgerExamples,
 )
import Test.Cardano.Ledger.Babbage.Examples (exampleBabbageNewEpochState)
import Test.Cardano.Ledger.Conway.Examples (exampleConwayBasedTxBody, mkConwayBasedExampleTx)
import Test.Cardano.Ledger.Core.KeyPair (mkAddr)
import Test.Cardano.Ledger.Dijkstra.ImpTest (exampleDijkstraGenesis)
import Test.Cardano.Ledger.Mary.Examples (exampleMultiAssetValue)
import Test.Cardano.Ledger.Plutus (alwaysSucceedsPlutus)
import Test.Cardano.Ledger.Shelley.Examples (
  LedgerExamples (..),
  examplePayKey,
  exampleStakeKey,
  exampleStakePoolParams,
  mkKeyHash,
  mkScriptHash,
 )

ledgerExamples :: LedgerExamples DijkstraEra
ledgerExamples :: LedgerExamples DijkstraEra
ledgerExamples =
  ApplyTxError DijkstraEra
-> NewEpochState DijkstraEra
-> Tx TopTx DijkstraEra
-> TranslationContext DijkstraEra
-> LedgerExamples DijkstraEra
forall era.
AlonzoEraPParams era =>
ApplyTxError era
-> NewEpochState era
-> Tx TopTx era
-> TranslationContext era
-> LedgerExamples era
mkAlonzoBasedLedgerExamples
    ( NonEmpty (DijkstraMempoolPredFailure DijkstraEra)
-> ApplyTxError DijkstraEra
DijkstraApplyTxError (NonEmpty (DijkstraMempoolPredFailure DijkstraEra)
 -> ApplyTxError DijkstraEra)
-> NonEmpty (DijkstraMempoolPredFailure DijkstraEra)
-> ApplyTxError DijkstraEra
forall a b. (a -> b) -> a -> b
$
        DijkstraMempoolPredFailure DijkstraEra
-> NonEmpty (DijkstraMempoolPredFailure DijkstraEra)
forall a. a -> NonEmpty a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DijkstraMempoolPredFailure DijkstraEra
 -> NonEmpty (DijkstraMempoolPredFailure DijkstraEra))
-> DijkstraMempoolPredFailure DijkstraEra
-> NonEmpty (DijkstraMempoolPredFailure DijkstraEra)
forall a b. (a -> b) -> a -> b
$
          forall sub super.
Embed sub super =>
PredicateFailure sub -> PredicateFailure super
wrapFailed @(DijkstraLEDGER DijkstraEra) @(DijkstraMEMPOOL DijkstraEra) (PredicateFailure (DijkstraLEDGER DijkstraEra)
 -> PredicateFailure (DijkstraMEMPOOL DijkstraEra))
-> PredicateFailure (DijkstraLEDGER DijkstraEra)
-> PredicateFailure (DijkstraMEMPOOL DijkstraEra)
forall a b. (a -> b) -> a -> b
$
            forall sub super.
Embed sub super =>
PredicateFailure sub -> PredicateFailure super
wrapFailed @(ConwayDELEG DijkstraEra) @(DijkstraLEDGER DijkstraEra) (PredicateFailure (ConwayDELEG DijkstraEra)
 -> PredicateFailure (DijkstraLEDGER DijkstraEra))
-> PredicateFailure (ConwayDELEG DijkstraEra)
-> PredicateFailure (DijkstraLEDGER DijkstraEra)
forall a b. (a -> b) -> a -> b
$
              KeyHash StakePool -> ConwayDelegPredFailure DijkstraEra
forall era. KeyHash StakePool -> ConwayDelegPredFailure era
DelegateeStakePoolNotRegisteredDELEG (Int -> KeyHash StakePool
forall (discriminator :: KeyRole). Int -> KeyHash discriminator
mkKeyHash Int
1)
    )
    NewEpochState DijkstraEra
forall era.
(BabbageEraTest era, Value era ~ MaryValue) =>
NewEpochState era
exampleBabbageNewEpochState
    Tx TopTx DijkstraEra
exampleTxDijkstra
    TranslationContext DijkstraEra
DijkstraGenesis
exampleDijkstraGenesis

exampleTxDijkstra :: Tx TopTx DijkstraEra
exampleTxDijkstra :: Tx TopTx DijkstraEra
exampleTxDijkstra =
  TxBody TopTx DijkstraEra
-> PlutusPurpose AsIx DijkstraEra -> Tx TopTx DijkstraEra
forall era.
(AlonzoEraTx era, AlonzoEraTxAuxData era,
 EraPlutusTxInfo 'PlutusV1 era, EraPlutusTxInfo 'PlutusV2 era,
 EraPlutusTxInfo 'PlutusV3 era, EraPlutusTxInfo 'PlutusV4 era) =>
TxBody TopTx era -> PlutusPurpose AsIx era -> Tx TopTx era
mkDijkstraBasedExampleTx
    (TxBody TopTx DijkstraEra -> TxBody TopTx DijkstraEra
forall era.
(DijkstraEraTxBody era, EraTx era, Value era ~ MaryValue,
 EraPlutusTxInfo 'PlutusV4 era) =>
TxBody TopTx era -> TxBody TopTx era
mkDijkstraBasedExampleTxBody (TxBody TopTx DijkstraEra -> TxBody TopTx DijkstraEra)
-> TxBody TopTx DijkstraEra -> TxBody TopTx DijkstraEra
forall a b. (a -> b) -> a -> b
$ StrictSeq (TxCert DijkstraEra) -> TxBody TopTx DijkstraEra
forall era.
(ConwayEraTxBody era, EraPlutusTxInfo 'PlutusV1 era,
 EraPlutusTxInfo 'PlutusV2 era, EraPlutusTxInfo 'PlutusV3 era,
 Value era ~ MaryValue) =>
StrictSeq (TxCert era) -> TxBody TopTx era
exampleConwayBasedTxBody StrictSeq (TxCert DijkstraEra)
StrictSeq (DijkstraTxCert DijkstraEra)
forall era. StrictSeq (DijkstraTxCert era)
exampleDijkstraCerts)
    (AsIx Word32 TxIn -> DijkstraPlutusPurpose AsIx DijkstraEra
forall (f :: * -> * -> *) era.
f Word32 TxIn -> DijkstraPlutusPurpose f era
DijkstraSpending (AsIx Word32 TxIn -> DijkstraPlutusPurpose AsIx DijkstraEra)
-> AsIx Word32 TxIn -> DijkstraPlutusPurpose AsIx DijkstraEra
forall a b. (a -> b) -> a -> b
$ Word32 -> AsIx Word32 TxIn
forall ix it. ix -> AsIx ix it
AsIx Word32
0)

-- | Reusable Tx builder for Dijkstra onwards with PlutusV4 script witness.
mkDijkstraBasedExampleTx ::
  forall era.
  ( AlonzoEraTx era
  , AlonzoEraTxAuxData era
  , EraPlutusTxInfo 'PlutusV1 era
  , EraPlutusTxInfo 'PlutusV2 era
  , EraPlutusTxInfo 'PlutusV3 era
  , EraPlutusTxInfo 'PlutusV4 era
  ) =>
  TxBody TopTx era ->
  PlutusPurpose AsIx era ->
  Tx TopTx era
mkDijkstraBasedExampleTx :: forall era.
(AlonzoEraTx era, AlonzoEraTxAuxData era,
 EraPlutusTxInfo 'PlutusV1 era, EraPlutusTxInfo 'PlutusV2 era,
 EraPlutusTxInfo 'PlutusV3 era, EraPlutusTxInfo 'PlutusV4 era) =>
TxBody TopTx era -> PlutusPurpose AsIx era -> Tx TopTx era
mkDijkstraBasedExampleTx TxBody TopTx era
txBody PlutusPurpose AsIx era
scriptPurpose =
  TxBody TopTx era -> PlutusPurpose AsIx era -> Tx TopTx era
forall era.
(AlonzoEraTx era, AlonzoEraTxAuxData era,
 EraPlutusTxInfo 'PlutusV1 era, EraPlutusTxInfo 'PlutusV2 era,
 EraPlutusTxInfo 'PlutusV3 era) =>
TxBody TopTx era -> PlutusPurpose AsIx era -> Tx TopTx era
mkConwayBasedExampleTx TxBody TopTx era
txBody PlutusPurpose AsIx era
scriptPurpose
    Tx TopTx era -> (Tx TopTx era -> Tx TopTx era) -> Tx TopTx era
forall a b. a -> (a -> b) -> b
& (TxWits era -> Identity (TxWits era))
-> Tx TopTx era -> Identity (Tx TopTx era)
forall era (l :: TxLevel).
EraTx era =>
Lens' (Tx l era) (TxWits era)
forall (l :: TxLevel). Lens' (Tx l era) (TxWits era)
witsTxL
      ((TxWits era -> Identity (TxWits era))
 -> Tx TopTx era -> Identity (Tx TopTx era))
-> TxWits era -> Tx TopTx era -> Tx TopTx era
forall a s t. Monoid a => ASetter s t a a -> a -> s -> t
<>~ ( TxWits era
forall era. EraTxWits era => TxWits era
mkBasicTxWits
              TxWits era -> (TxWits era -> TxWits era) -> TxWits era
forall a b. a -> (a -> b) -> b
& (Map ScriptHash (Script era)
 -> Identity (Map ScriptHash (Script era)))
-> TxWits era -> Identity (TxWits era)
forall era.
EraTxWits era =>
Lens' (TxWits era) (Map ScriptHash (Script era))
Lens' (TxWits era) (Map ScriptHash (Script era))
scriptTxWitsL
                ((Map ScriptHash (Script era)
  -> Identity (Map ScriptHash (Script era)))
 -> TxWits era -> Identity (TxWits era))
-> Map ScriptHash (Script era) -> TxWits era -> TxWits era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ ScriptHash -> Script era -> Map ScriptHash (Script era)
forall k a. k -> a -> Map k a
Map.singleton
                  (forall era. EraScript era => Script era -> ScriptHash
hashScript @era (Script era -> ScriptHash) -> Script era -> ScriptHash
forall a b. (a -> b) -> a -> b
$ forall (l :: Language) era.
(HasCallStack, EraPlutusTxInfo l era) =>
Natural -> Script era
alwaysSucceeds @'PlutusV4 Natural
3)
                  (forall (l :: Language) era.
(HasCallStack, EraPlutusTxInfo l era) =>
Natural -> Script era
alwaysSucceeds @'PlutusV4 Natural
3)
          )
    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
& (Map Language (NonEmpty PlutusBinary)
 -> Identity (Map Language (NonEmpty PlutusBinary)))
-> TxAuxData era -> Identity (TxAuxData era)
forall era.
AlonzoEraTxAuxData era =>
Lens' (TxAuxData era) (Map Language (NonEmpty PlutusBinary))
Lens' (TxAuxData era) (Map Language (NonEmpty PlutusBinary))
plutusScriptsTxAuxDataL
                ((Map Language (NonEmpty PlutusBinary)
  -> Identity (Map Language (NonEmpty PlutusBinary)))
 -> TxAuxData era -> Identity (TxAuxData era))
-> Map Language (NonEmpty PlutusBinary)
-> TxAuxData era
-> TxAuxData era
forall a s t. Monoid a => ASetter s t a a -> a -> s -> t
<>~ Language
-> NonEmpty PlutusBinary -> Map Language (NonEmpty PlutusBinary)
forall k a. k -> a -> Map k a
Map.singleton Language
PlutusV4 (PlutusBinary -> NonEmpty PlutusBinary
forall a. a -> NonEmpty a
NE.singleton (Plutus 'PlutusV4 -> PlutusBinary
forall (l :: Language). Plutus l -> PlutusBinary
plutusBinary (forall (l :: Language). Natural -> Plutus l
alwaysSucceedsPlutus @'PlutusV4 Natural
3)))
        )

mkDijkstraBasedExampleTxBody ::
  forall era.
  ( DijkstraEraTxBody era
  , EraTx era
  , Value era ~ MaryValue
  , EraPlutusTxInfo PlutusV4 era
  ) =>
  TxBody TopTx era ->
  TxBody TopTx era
mkDijkstraBasedExampleTxBody :: forall era.
(DijkstraEraTxBody era, EraTx era, Value era ~ MaryValue,
 EraPlutusTxInfo 'PlutusV4 era) =>
TxBody TopTx era -> TxBody TopTx era
mkDijkstraBasedExampleTxBody 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
& (StrictSeq (TxOut era) -> Identity (StrictSeq (TxOut era)))
-> TxBody TopTx era -> Identity (TxBody TopTx era)
forall era (l :: TxLevel).
EraTxBody era =>
Lens' (TxBody l era) (StrictSeq (TxOut era))
forall (l :: TxLevel). Lens' (TxBody l era) (StrictSeq (TxOut era))
outputsTxBodyL
      ((StrictSeq (TxOut era) -> Identity (StrictSeq (TxOut era)))
 -> TxBody TopTx era -> Identity (TxBody TopTx era))
-> StrictSeq (TxOut era) -> TxBody TopTx era -> TxBody TopTx era
forall a s t. Monoid a => ASetter s t a a -> a -> s -> t
<>~ [TxOut era] -> StrictSeq (TxOut era)
forall a. [a] -> StrictSeq a
StrictSeq.fromList
        [ Addr -> Value era -> TxOut era
forall era.
(EraTxOut era, HasCallStack) =>
Addr -> Value era -> TxOut era
mkBasicTxOut
            (KeyPair Payment -> KeyPair Staking -> Addr
forall p s.
(MakeCredential p Payment, MakeStakeReference s) =>
p -> s -> Addr
mkAddr KeyPair Payment
examplePayKey KeyPair Staking
exampleStakeKey)
            (Int -> MaryValue
exampleMultiAssetValue Int
2)
            TxOut era -> (TxOut era -> TxOut era) -> TxOut era
forall a b. a -> (a -> b) -> b
& (Datum era -> Identity (Datum era))
-> TxOut era -> Identity (TxOut era)
forall era. BabbageEraTxOut era => Lens' (TxOut era) (Datum era)
Lens' (TxOut era) (Datum era)
datumTxOutL ((Datum era -> Identity (Datum era))
 -> TxOut era -> Identity (TxOut era))
-> Datum era -> TxOut era -> TxOut era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ BinaryData era -> Datum era
forall era. BinaryData era -> Datum era
Datum (Data era -> BinaryData era
forall era. Data era -> BinaryData era
dataToBinaryData Data era
forall era. Era era => Data era
exampleDatum)
            TxOut era -> (TxOut era -> TxOut era) -> TxOut era
forall a b. a -> (a -> b) -> b
& (StrictMaybe (Script era) -> Identity (StrictMaybe (Script era)))
-> TxOut era -> Identity (TxOut era)
forall era.
BabbageEraTxOut era =>
Lens' (TxOut era) (StrictMaybe (Script era))
Lens' (TxOut era) (StrictMaybe (Script era))
referenceScriptTxOutL ((StrictMaybe (Script era) -> Identity (StrictMaybe (Script era)))
 -> TxOut era -> Identity (TxOut era))
-> StrictMaybe (Script era) -> TxOut era -> TxOut era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Script era -> StrictMaybe (Script era)
forall a. a -> StrictMaybe a
SJust (forall (l :: Language) era.
(HasCallStack, EraPlutusTxInfo l era) =>
Natural -> Script era
alwaysSucceeds @'PlutusV4 Natural
3)
        ]
    TxBody TopTx era
-> (TxBody TopTx era -> TxBody TopTx era) -> TxBody TopTx era
forall a b. a -> (a -> b) -> b
& (OSet (Credential Guard) -> Identity (OSet (Credential Guard)))
-> TxBody TopTx era -> Identity (TxBody TopTx era)
forall era (l :: TxLevel).
DijkstraEraTxBody era =>
Lens' (TxBody l era) (OSet (Credential Guard))
forall (l :: TxLevel).
Lens' (TxBody l era) (OSet (Credential Guard))
guardsTxBodyL ((OSet (Credential Guard) -> Identity (OSet (Credential Guard)))
 -> TxBody TopTx era -> Identity (TxBody TopTx era))
-> OSet (Credential Guard) -> TxBody TopTx era -> TxBody TopTx era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [Credential Guard] -> OSet (Credential Guard)
forall a. Ord a => [a] -> OSet a
OSet.fromList [KeyHash Guard -> Credential Guard
forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj (KeyHash Guard -> Credential Guard)
-> KeyHash Guard -> Credential Guard
forall a b. (a -> b) -> a -> b
$ Int -> KeyHash Guard
forall (discriminator :: KeyRole). Int -> KeyHash discriminator
mkKeyHash Int
212, ScriptHash -> Credential Guard
forall (kr :: KeyRole). ScriptHash -> Credential kr
ScriptHashObj (ScriptHash -> Credential Guard) -> ScriptHash -> Credential Guard
forall a b. (a -> b) -> a -> b
$ Int -> ScriptHash
mkScriptHash Int
213]
    TxBody TopTx era
-> (TxBody TopTx era -> TxBody TopTx era) -> TxBody TopTx era
forall a b. a -> (a -> b) -> b
& (OMap TxId (Tx SubTx era) -> Identity (OMap TxId (Tx SubTx era)))
-> TxBody TopTx era -> Identity (TxBody TopTx era)
forall era.
DijkstraEraTxBody era =>
Lens' (TxBody TopTx era) (OMap TxId (Tx SubTx era))
Lens' (TxBody TopTx era) (OMap TxId (Tx SubTx era))
subTransactionsTxBodyL ((OMap TxId (Tx SubTx era) -> Identity (OMap TxId (Tx SubTx era)))
 -> TxBody TopTx era -> Identity (TxBody TopTx era))
-> OMap TxId (Tx SubTx era) -> TxBody TopTx era -> TxBody TopTx era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ OMap TxId (Tx SubTx era)
forall a. Monoid a => a
mempty -- Sub-transactions require complex recursive setup
    TxBody TopTx era
-> (TxBody TopTx era -> TxBody TopTx era) -> TxBody TopTx era
forall a b. a -> (a -> b) -> b
& (DirectDeposits -> Identity DirectDeposits)
-> TxBody TopTx era -> Identity (TxBody TopTx era)
forall era (l :: TxLevel).
DijkstraEraTxBody era =>
Lens' (TxBody l era) DirectDeposits
forall (l :: TxLevel). Lens' (TxBody l era) DirectDeposits
directDepositsTxBodyL ((DirectDeposits -> Identity DirectDeposits)
 -> TxBody TopTx era -> Identity (TxBody TopTx era))
-> DirectDeposits -> TxBody TopTx era -> TxBody TopTx era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ DirectDeposits
exampleDirectDeposits
    TxBody TopTx era
-> (TxBody TopTx era -> TxBody TopTx era) -> TxBody TopTx era
forall a b. a -> (a -> b) -> b
& (AccountBalanceIntervals era
 -> Identity (AccountBalanceIntervals era))
-> TxBody TopTx era -> Identity (TxBody TopTx era)
forall era (l :: TxLevel).
DijkstraEraTxBody era =>
Lens' (TxBody l era) (AccountBalanceIntervals era)
forall (l :: TxLevel).
Lens' (TxBody l era) (AccountBalanceIntervals era)
accountBalanceIntervalsTxBodyL ((AccountBalanceIntervals era
  -> Identity (AccountBalanceIntervals era))
 -> TxBody TopTx era -> Identity (TxBody TopTx era))
-> AccountBalanceIntervals era
-> TxBody TopTx era
-> TxBody TopTx era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ AccountBalanceIntervals era
forall era. AccountBalanceIntervals era
exampleAccountBalanceIntervals

exampleDirectDeposits :: DirectDeposits
exampleDirectDeposits :: DirectDeposits
exampleDirectDeposits =
  Map AccountAddress Coin -> DirectDeposits
DirectDeposits (Map AccountAddress Coin -> DirectDeposits)
-> Map AccountAddress Coin -> DirectDeposits
forall a b. (a -> b) -> a -> b
$
    AccountAddress -> Coin -> Map AccountAddress Coin
forall k a. k -> a -> Map k a
Map.singleton
      (Network -> AccountId -> AccountAddress
AccountAddress Network
Mainnet (Credential Staking -> AccountId
AccountId (Credential Staking -> AccountId)
-> Credential Staking -> AccountId
forall a b. (a -> b) -> a -> b
$ KeyHash Staking -> Credential Staking
forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj (KeyHash Staking -> Credential Staking)
-> KeyHash Staking -> Credential Staking
forall a b. (a -> b) -> a -> b
$ Int -> KeyHash Staking
forall (discriminator :: KeyRole). Int -> KeyHash discriminator
mkKeyHash Int
300))
      (Integer -> Coin
Coin Integer
1000000)

exampleAccountBalanceIntervals :: AccountBalanceIntervals era
exampleAccountBalanceIntervals :: forall era. AccountBalanceIntervals era
exampleAccountBalanceIntervals =
  Map AccountId (AccountBalanceInterval era)
-> AccountBalanceIntervals era
forall era.
Map AccountId (AccountBalanceInterval era)
-> AccountBalanceIntervals era
AccountBalanceIntervals (Map AccountId (AccountBalanceInterval era)
 -> AccountBalanceIntervals era)
-> Map AccountId (AccountBalanceInterval era)
-> AccountBalanceIntervals era
forall a b. (a -> b) -> a -> b
$
    [(AccountId, AccountBalanceInterval era)]
-> Map AccountId (AccountBalanceInterval era)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
      [ (Credential Staking -> AccountId
AccountId (Credential Staking -> AccountId)
-> Credential Staking -> AccountId
forall a b. (a -> b) -> a -> b
$ KeyHash Staking -> Credential Staking
forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj (KeyHash Staking -> Credential Staking)
-> KeyHash Staking -> Credential Staking
forall a b. (a -> b) -> a -> b
$ Int -> KeyHash Staking
forall (discriminator :: KeyRole). Int -> KeyHash discriminator
mkKeyHash Int
400, Inclusive Coin -> AccountBalanceInterval era
forall era. Inclusive Coin -> AccountBalanceInterval era
AccountBalanceLowerBound (Coin -> Inclusive Coin
forall a. a -> Inclusive a
Inclusive (Coin -> Inclusive Coin) -> Coin -> Inclusive Coin
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
500))
      , (Credential Staking -> AccountId
AccountId (Credential Staking -> AccountId)
-> Credential Staking -> AccountId
forall a b. (a -> b) -> a -> b
$ KeyHash Staking -> Credential Staking
forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj (KeyHash Staking -> Credential Staking)
-> KeyHash Staking -> Credential Staking
forall a b. (a -> b) -> a -> b
$ Int -> KeyHash Staking
forall (discriminator :: KeyRole). Int -> KeyHash discriminator
mkKeyHash Int
401, Exclusive Coin -> AccountBalanceInterval era
forall era. Exclusive Coin -> AccountBalanceInterval era
AccountBalanceUpperBound (Coin -> Exclusive Coin
forall a. a -> Exclusive a
Exclusive (Coin -> Exclusive Coin) -> Coin -> Exclusive Coin
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
10000))
      ,
        ( Credential Staking -> AccountId
AccountId (Credential Staking -> AccountId)
-> Credential Staking -> AccountId
forall a b. (a -> b) -> a -> b
$ ScriptHash -> Credential Staking
forall (kr :: KeyRole). ScriptHash -> Credential kr
ScriptHashObj (ScriptHash -> Credential Staking)
-> ScriptHash -> Credential Staking
forall a b. (a -> b) -> a -> b
$ Int -> ScriptHash
mkScriptHash Int
402
        , Inclusive Coin -> Exclusive Coin -> AccountBalanceInterval era
forall era.
Inclusive Coin -> Exclusive Coin -> AccountBalanceInterval era
AccountBalanceBothBounds (Coin -> Inclusive Coin
forall a. a -> Inclusive a
Inclusive (Coin -> Inclusive Coin) -> Coin -> Inclusive Coin
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
100) (Coin -> Exclusive Coin
forall a. a -> Exclusive a
Exclusive (Coin -> Exclusive Coin) -> Coin -> Exclusive Coin
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
5000)
        )
      ]

exampleDijkstraCerts :: StrictSeq.StrictSeq (DijkstraTxCert era)
exampleDijkstraCerts :: forall era. StrictSeq (DijkstraTxCert era)
exampleDijkstraCerts =
  -- TODO should I add the new certs here?
  [DijkstraTxCert era] -> StrictSeq (DijkstraTxCert era)
forall a. [a] -> StrictSeq a
StrictSeq.fromList
    [ PoolCert -> DijkstraTxCert era
forall era. PoolCert -> DijkstraTxCert era
DijkstraTxCertPool (StakePoolParams -> PoolCert
RegPool StakePoolParams
exampleStakePoolParams)
    ]