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

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

import Cardano.Ledger.Babbage.TxBody (BabbageTxOut (..))
import Cardano.Ledger.BaseTypes
import Cardano.Ledger.Binary (mkSized)
import Cardano.Ledger.Coin (Coin (..))
import Cardano.Ledger.Conway.Core
import Cardano.Ledger.Conway.Governance (VotingProcedures (..))
import Cardano.Ledger.Conway.Rules (ConwayDELEG, ConwayDelegPredFailure (..), ConwayLEDGER)
import Cardano.Ledger.Conway.Scripts (ConwayPlutusPurpose (..))
import Cardano.Ledger.Dijkstra (DijkstraEra)
import Cardano.Ledger.Dijkstra.TxBody (TxBody (..))
import Cardano.Ledger.Mary.Value (MaryValue (..))
import Cardano.Ledger.Plutus.Data (
  Datum (..),
  dataToBinaryData,
 )
import Cardano.Ledger.Plutus.Language (Language (..))
import Cardano.Ledger.Shelley.API (
  ApplyTxError (..),
  Credential (..),
  RewardAccount (..),
  TxId (..),
 )
import Cardano.Ledger.TxIn (mkTxInPartial)
import Control.State.Transition.Extended (Embed (..))
import qualified Data.Map.Strict as Map
import qualified Data.OSet.Strict as OSet
import qualified Data.Sequence.Strict as StrictSeq
import qualified Data.Set as Set
import Test.Cardano.Ledger.Alonzo.Arbitrary (alwaysSucceeds)
import Test.Cardano.Ledger.Alonzo.Examples (
  exampleDatum,
  exampleTx,
  mkLedgerExamples,
 )
import Test.Cardano.Ledger.Babbage.Examples (exampleBabbageNewEpochState, exampleCollateralOutput)
import Test.Cardano.Ledger.Conway.Examples (exampleConwayCerts)
import Test.Cardano.Ledger.Core.KeyPair (mkAddr)
import Test.Cardano.Ledger.Core.Utils (mkDummySafeHash)
import Test.Cardano.Ledger.Dijkstra.Era ()
import Test.Cardano.Ledger.Dijkstra.ImpTest (exampleDijkstraGenesis)
import Test.Cardano.Ledger.Mary.Examples (exampleMultiAssetValue)
import Test.Cardano.Ledger.Shelley.Examples (
  LedgerExamples (..),
  examplePayKey,
  exampleStakeKey,
  keyToCredential,
  mkKeyHash,
  mkScriptHash,
 )

ledgerExamples :: LedgerExamples DijkstraEra
ledgerExamples :: LedgerExamples DijkstraEra
ledgerExamples =
  ApplyTxError DijkstraEra
-> NewEpochState DijkstraEra
-> Tx DijkstraEra
-> TranslationContext DijkstraEra
-> LedgerExamples DijkstraEra
forall era.
AlonzoEraPParams era =>
ApplyTxError era
-> NewEpochState era
-> Tx era
-> TranslationContext era
-> LedgerExamples era
mkLedgerExamples
    ( NonEmpty (PredicateFailure (EraRule "LEDGER" DijkstraEra))
-> ApplyTxError DijkstraEra
forall era.
NonEmpty (PredicateFailure (EraRule "LEDGER" era))
-> ApplyTxError era
ApplyTxError (NonEmpty (PredicateFailure (EraRule "LEDGER" DijkstraEra))
 -> ApplyTxError DijkstraEra)
-> NonEmpty (PredicateFailure (EraRule "LEDGER" DijkstraEra))
-> ApplyTxError DijkstraEra
forall a b. (a -> b) -> a -> b
$
        PredicateFailure (EraRule "LEDGER" DijkstraEra)
-> NonEmpty (PredicateFailure (EraRule "LEDGER" DijkstraEra))
forall a. a -> NonEmpty a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PredicateFailure (EraRule "LEDGER" DijkstraEra)
 -> NonEmpty (PredicateFailure (EraRule "LEDGER" DijkstraEra)))
-> PredicateFailure (EraRule "LEDGER" DijkstraEra)
-> NonEmpty (PredicateFailure (EraRule "LEDGER" DijkstraEra))
forall a b. (a -> b) -> a -> b
$
          forall sub super.
Embed sub super =>
PredicateFailure sub -> PredicateFailure super
wrapFailed @(ConwayDELEG DijkstraEra) @(ConwayLEDGER DijkstraEra) (PredicateFailure (ConwayDELEG DijkstraEra)
 -> PredicateFailure (ConwayLEDGER DijkstraEra))
-> PredicateFailure (ConwayDELEG DijkstraEra)
-> PredicateFailure (ConwayLEDGER DijkstraEra)
forall a b. (a -> b) -> a -> b
$
            forall era. KeyHash 'StakePool -> ConwayDelegPredFailure era
DelegateeStakePoolNotRegisteredDELEG @DijkstraEra (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 DijkstraEra
exampleTxDijkstra
    TranslationContext DijkstraEra
DijkstraGenesis
exampleDijkstraGenesis

exampleTxDijkstra :: Tx DijkstraEra
exampleTxDijkstra :: Tx DijkstraEra
exampleTxDijkstra = TxBody DijkstraEra
-> PlutusPurpose AsIx DijkstraEra -> Tx DijkstraEra
forall era.
(AlonzoEraTx era, EraPlutusTxInfo 'PlutusV1 era,
 TxAuxData era ~ AlonzoTxAuxData era, Script era ~ AlonzoScript era,
 NativeScript era ~ Timelock era) =>
TxBody era -> PlutusPurpose AsIx era -> Tx era
exampleTx TxBody DijkstraEra
exampleTxBodyDijkstra (AsIx Word32 TxIn -> ConwayPlutusPurpose AsIx DijkstraEra
forall (f :: * -> * -> *) era.
f Word32 TxIn -> ConwayPlutusPurpose f era
ConwaySpending (AsIx Word32 TxIn -> ConwayPlutusPurpose AsIx DijkstraEra)
-> AsIx Word32 TxIn -> ConwayPlutusPurpose AsIx DijkstraEra
forall a b. (a -> b) -> a -> b
$ Word32 -> AsIx Word32 TxIn
forall ix it. ix -> AsIx ix it
AsIx Word32
0)

exampleTxBodyDijkstra :: TxBody DijkstraEra
exampleTxBodyDijkstra :: TxBody DijkstraEra
exampleTxBodyDijkstra =
  Set TxIn
-> Set TxIn
-> Set TxIn
-> StrictSeq (Sized (TxOut DijkstraEra))
-> StrictMaybe (Sized (TxOut DijkstraEra))
-> StrictMaybe Coin
-> OSet (TxCert DijkstraEra)
-> Withdrawals
-> Coin
-> ValidityInterval
-> OSet (Credential 'Guard)
-> MultiAsset
-> StrictMaybe ScriptIntegrityHash
-> StrictMaybe TxAuxDataHash
-> StrictMaybe Network
-> VotingProcedures DijkstraEra
-> OSet (ProposalProcedure DijkstraEra)
-> StrictMaybe Coin
-> Coin
-> TxBody DijkstraEra
DijkstraTxBody
    ([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
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
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
mkDummySafeHash Int
1)) Integer
3]) -- reference inputs
    ( [Sized (BabbageTxOut DijkstraEra)]
-> StrictSeq (Sized (BabbageTxOut DijkstraEra))
forall a. [a] -> StrictSeq a
StrictSeq.fromList
        [ Version
-> BabbageTxOut DijkstraEra -> Sized (BabbageTxOut DijkstraEra)
forall a. EncCBOR a => Version -> a -> Sized a
mkSized (forall era. Era era => Version
eraProtVerHigh @DijkstraEra) (BabbageTxOut DijkstraEra -> Sized (BabbageTxOut DijkstraEra))
-> BabbageTxOut DijkstraEra -> Sized (BabbageTxOut DijkstraEra)
forall a b. (a -> b) -> a -> b
$
            Addr
-> Value DijkstraEra
-> Datum DijkstraEra
-> StrictMaybe (Script DijkstraEra)
-> BabbageTxOut DijkstraEra
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
examplePayKey KeyPair 'Staking
exampleStakeKey)
              (Int -> MaryValue
exampleMultiAssetValue Int
2)
              (BinaryData DijkstraEra -> Datum DijkstraEra
forall era. BinaryData era -> Datum era
Datum (BinaryData DijkstraEra -> Datum DijkstraEra)
-> BinaryData DijkstraEra -> Datum DijkstraEra
forall a b. (a -> b) -> a -> b
$ Data DijkstraEra -> BinaryData DijkstraEra
forall era. Data era -> BinaryData era
dataToBinaryData Data DijkstraEra
forall era. Era era => Data era
exampleDatum) -- inline datum
              (Script DijkstraEra -> StrictMaybe (Script DijkstraEra)
forall a. a -> StrictMaybe a
SJust (Script DijkstraEra -> StrictMaybe (Script DijkstraEra))
-> Script DijkstraEra -> StrictMaybe (Script DijkstraEra)
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 DijkstraEra)
-> StrictMaybe (Sized (TxOut DijkstraEra))
forall a. a -> StrictMaybe a
SJust (Sized (TxOut DijkstraEra)
 -> StrictMaybe (Sized (TxOut DijkstraEra)))
-> Sized (TxOut DijkstraEra)
-> StrictMaybe (Sized (TxOut DijkstraEra))
forall a b. (a -> b) -> a -> b
$ Version
-> BabbageTxOut DijkstraEra -> Sized (BabbageTxOut DijkstraEra)
forall a. EncCBOR a => Version -> a -> Sized a
mkSized (forall era. Era era => Version
eraProtVerHigh @DijkstraEra) BabbageTxOut DijkstraEra
forall era.
(BabbageEraTxOut era, Value era ~ MaryValue) =>
BabbageTxOut era
exampleCollateralOutput) -- 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
    OSet (TxCert DijkstraEra)
OSet (ConwayTxCert DijkstraEra)
forall era. OSet (ConwayTxCert era)
exampleConwayCerts
    ( 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
keyToCredential KeyPair 'Staking
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
    ([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]) -- guards
    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
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
mkDummySafeHash Int
42) -- adHash
    (Network -> StrictMaybe Network
forall a. a -> StrictMaybe a
SJust Network
Mainnet) -- txnetworkid
    (Map Voter (Map GovActionId (VotingProcedure DijkstraEra))
-> VotingProcedures DijkstraEra
forall era.
Map Voter (Map GovActionId (VotingProcedure era))
-> VotingProcedures era
VotingProcedures Map Voter (Map GovActionId (VotingProcedure DijkstraEra))
forall a. Monoid a => a
mempty)
    OSet (ProposalProcedure DijkstraEra)
forall a. Monoid a => a
mempty
    (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
867530900000) -- current treasury value
    Coin
forall a. Monoid a => a
mempty
  where
    MaryValue Coin
_ MultiAsset
exampleMultiAsset = Int -> MaryValue
exampleMultiAssetValue Int
3