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

module Test.Cardano.Ledger.Mary.Examples.Consensus 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.Consensus
import Test.Cardano.Ledger.MaryEraGen ()
import Test.Cardano.Ledger.Shelley.Examples.Consensus

-- | ShelleyLedgerExamples for Allegra era
ledgerExamplesMary :: ShelleyLedgerExamples MaryEra
ledgerExamplesMary :: ShelleyLedgerExamples MaryEra
ledgerExamplesMary =
  (TxBody MaryEra -> [KeyPair 'Witness] -> TxWits MaryEra)
-> (ShelleyTx MaryEra -> Tx MaryEra)
-> Value MaryEra
-> TxBody MaryEra
-> TxAuxData MaryEra
-> TranslationContext MaryEra
-> ShelleyLedgerExamples MaryEra
forall era.
(EraSegWits 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)
-> (ShelleyTx era -> Tx era)
-> Value era
-> TxBody era
-> TxAuxData era
-> TranslationContext era
-> ShelleyLedgerExamples era
defaultShelleyLedgerExamples
    (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))
    ShelleyTx MaryEra -> Tx MaryEra
ShelleyTx MaryEra -> ShelleyTx MaryEra
forall a. a -> a
id
    (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"