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

module Test.Cardano.Ledger.Mary.Examples (
  ledgerExamples,
  exampleMultiAssetValue,
) where

import Cardano.Ledger.Coin
import Cardano.Ledger.Genesis (NoGenesis (..))
import Cardano.Ledger.Mary (ApplyTxError (MaryApplyTxError), MaryEra)
import Cardano.Ledger.Mary.Core
import Cardano.Ledger.Mary.Value
import Cardano.Ledger.Shelley.Rules (
  ShelleyDelegsPredFailure (DelegateeNotRegisteredDELEG),
  ShelleyLedgerPredFailure (DelegsFailure),
 )
import qualified Data.Map.Strict as Map (singleton)
import Data.Proxy
import Lens.Micro
import Test.Cardano.Ledger.Allegra.Examples (exampleAllegraTxAuxData, exampleAllegraTxBody)
import Test.Cardano.Ledger.Shelley.Examples (
  LedgerExamples,
  mkKeyHash,
  mkLedgerExamples,
  mkScriptHash,
  mkWitnessesPreAlonzo,
 )

ledgerExamples :: LedgerExamples MaryEra
ledgerExamples :: LedgerExamples MaryEra
ledgerExamples =
  ApplyTxError MaryEra
-> (TxBody TopTx MaryEra -> [KeyPair Witness] -> TxWits MaryEra)
-> Value MaryEra
-> TxBody TopTx MaryEra
-> TxAuxData MaryEra
-> TranslationContext MaryEra
-> LedgerExamples MaryEra
forall era.
(EraTx era, EraGov era, EraStake era, EraCertState era,
 Default (StashedAVVMAddresses era), AtMostEra "Mary" era) =>
ApplyTxError era
-> (TxBody TopTx era -> [KeyPair Witness] -> TxWits era)
-> Value era
-> TxBody TopTx era
-> TxAuxData era
-> TranslationContext era
-> LedgerExamples era
mkLedgerExamples
    ( NonEmpty (ShelleyLedgerPredFailure MaryEra) -> ApplyTxError MaryEra
MaryApplyTxError (NonEmpty (ShelleyLedgerPredFailure MaryEra)
 -> ApplyTxError MaryEra)
-> (ShelleyDelegsPredFailure MaryEra
    -> NonEmpty (ShelleyLedgerPredFailure MaryEra))
-> ShelleyDelegsPredFailure MaryEra
-> ApplyTxError MaryEra
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShelleyLedgerPredFailure MaryEra
-> NonEmpty (ShelleyLedgerPredFailure MaryEra)
forall a. a -> NonEmpty a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ShelleyLedgerPredFailure MaryEra
 -> NonEmpty (ShelleyLedgerPredFailure MaryEra))
-> (ShelleyDelegsPredFailure MaryEra
    -> ShelleyLedgerPredFailure MaryEra)
-> ShelleyDelegsPredFailure MaryEra
-> NonEmpty (ShelleyLedgerPredFailure MaryEra)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PredicateFailure (EraRule "DELEGS" MaryEra)
-> ShelleyLedgerPredFailure MaryEra
ShelleyDelegsPredFailure MaryEra
-> ShelleyLedgerPredFailure MaryEra
forall era.
PredicateFailure (EraRule "DELEGS" era)
-> ShelleyLedgerPredFailure era
DelegsFailure (ShelleyDelegsPredFailure MaryEra -> ApplyTxError MaryEra)
-> ShelleyDelegsPredFailure MaryEra -> ApplyTxError MaryEra
forall a b. (a -> b) -> a -> b
$
        forall era. KeyHash StakePool -> ShelleyDelegsPredFailure era
DelegateeNotRegisteredDELEG @MaryEra (Int -> KeyHash StakePool
forall (discriminator :: KeyRole). Int -> KeyHash discriminator
mkKeyHash Int
1)
    )
    (Proxy MaryEra
-> TxBody TopTx MaryEra
-> [KeyPair Witness]
-> ShelleyTxWits MaryEra
forall era.
EraTx era =>
Proxy era
-> TxBody TopTx era -> [KeyPair Witness] -> ShelleyTxWits era
mkWitnessesPreAlonzo (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @MaryEra))
    (Int -> MaryValue
exampleMultiAssetValue Int
1)
    ( Value MaryEra -> TxBody TopTx MaryEra
forall era.
(AllegraEraTxBody era, ShelleyEraTxBody era) =>
Value era -> TxBody TopTx era
exampleAllegraTxBody (Int -> MaryValue
exampleMultiAssetValue Int
1)
        TxBody TopTx MaryEra
-> (TxBody TopTx MaryEra -> TxBody TopTx MaryEra)
-> TxBody TopTx MaryEra
forall a b. a -> (a -> b) -> b
& (MultiAsset -> Identity MultiAsset)
-> TxBody TopTx MaryEra -> Identity (TxBody TopTx MaryEra)
forall era (l :: TxLevel).
MaryEraTxBody era =>
Lens' (TxBody l era) MultiAsset
forall (l :: TxLevel). Lens' (TxBody l MaryEra) MultiAsset
mintTxBodyL ((MultiAsset -> Identity MultiAsset)
 -> TxBody TopTx MaryEra -> Identity (TxBody TopTx MaryEra))
-> MultiAsset -> TxBody TopTx MaryEra -> TxBody TopTx MaryEra
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Int -> MultiAsset
exampleMultiAsset Int
1
    )
    AllegraTxAuxData MaryEra
TxAuxData MaryEra
forall era.
(AllegraEraScript era, NativeScript era ~ Timelock era) =>
AllegraTxAuxData era
exampleAllegraTxAuxData
    TranslationContext MaryEra
NoGenesis MaryEra
forall era. NoGenesis era
NoGenesis

exampleMultiAssetValue :: Int -> MaryValue
exampleMultiAssetValue :: Int -> MaryValue
exampleMultiAssetValue Int
x = Coin -> MultiAsset -> MaryValue
MaryValue (Integer -> Coin
Coin Integer
100) (MultiAsset -> MaryValue) -> MultiAsset -> MaryValue
forall a b. (a -> b) -> a -> b
$ Int -> MultiAsset
exampleMultiAsset Int
x

exampleMultiAsset :: Int -> MultiAsset
exampleMultiAsset :: Int -> MultiAsset
exampleMultiAsset Int
x =
  Map PolicyID (Map AssetName Integer) -> MultiAsset
MultiAsset (PolicyID
-> Map AssetName Integer -> Map PolicyID (Map AssetName Integer)
forall k a. k -> a -> Map k a
Map.singleton PolicyID
policyId (Map AssetName Integer -> Map PolicyID (Map AssetName Integer))
-> Map AssetName Integer -> Map PolicyID (Map AssetName Integer)
forall a b. (a -> b) -> a -> b
$ AssetName -> Integer -> Map AssetName Integer
forall k a. k -> a -> Map k a
Map.singleton AssetName
couttsCoin Integer
1000)
  where
    policyId :: PolicyID
policyId = ScriptHash -> PolicyID
PolicyID (ScriptHash -> PolicyID) -> ScriptHash -> PolicyID
forall a b. (a -> b) -> a -> b
$ Int -> ScriptHash
mkScriptHash Int
x
    couttsCoin :: AssetName
    couttsCoin :: AssetName
couttsCoin = ShortByteString -> AssetName
AssetName ShortByteString
"couttsCoin"