{-# 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 (MaryEra)
import Cardano.Ledger.Mary.Core
import Cardano.Ledger.Mary.Value
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,
  mkLedgerExamples,
  mkScriptHash,
  mkWitnessesPreAlonzo,
 )

ledgerExamples :: LedgerExamples MaryEra
ledgerExamples :: LedgerExamples MaryEra
ledgerExamples =
  (TxBody MaryEra -> [KeyPair 'Witness] -> TxWits MaryEra)
-> Value MaryEra
-> TxBody MaryEra
-> TxAuxData MaryEra
-> TranslationContext MaryEra
-> LedgerExamples MaryEra
forall era.
(EraTx era, EraGov era, EraStake era, EraCertState era,
 PredicateFailure (EraRule "DELEGS" era)
 ~ ShelleyDelegsPredFailure era,
 PredicateFailure (EraRule "LEDGER" era)
 ~ ShelleyLedgerPredFailure era,
 Default (StashedAVVMAddresses era), ProtVerAtMost era 4) =>
(TxBody era -> [KeyPair 'Witness] -> TxWits era)
-> Value era
-> TxBody era
-> TxAuxData era
-> TranslationContext era
-> LedgerExamples era
mkLedgerExamples
    (Proxy MaryEra
-> TxBody MaryEra -> [KeyPair 'Witness] -> ShelleyTxWits MaryEra
forall era.
EraTx era =>
Proxy era -> TxBody 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 MaryEra
forall era.
(AllegraEraTxBody era, ShelleyEraTxBody era) =>
Value era -> TxBody era
exampleAllegraTxBody (Int -> MaryValue
exampleMultiAssetValue Int
1)
        TxBody MaryEra
-> (TxBody MaryEra -> TxBody MaryEra) -> TxBody MaryEra
forall a b. a -> (a -> b) -> b
& (MultiAsset -> Identity MultiAsset)
-> TxBody MaryEra -> Identity (TxBody MaryEra)
forall era. MaryEraTxBody era => Lens' (TxBody era) MultiAsset
Lens' (TxBody MaryEra) MultiAsset
mintTxBodyL ((MultiAsset -> Identity MultiAsset)
 -> TxBody MaryEra -> Identity (TxBody MaryEra))
-> MultiAsset -> TxBody MaryEra -> TxBody 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"