{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE UndecidableSuperClasses #-}
{-# OPTIONS_GHC -Wno-orphans #-}

module Test.Cardano.Ledger.Mary.ImpTest (
  MaryEraImp,
  module Test.Cardano.Ledger.Allegra.ImpTest,
  mkTokenMintingTx,
) where

import Cardano.Ledger.Mary (MaryEra)
import Cardano.Ledger.Mary.Core
import Cardano.Ledger.Mary.Value
import Data.Typeable (Typeable)
import Lens.Micro ((&), (.~))
import Test.Cardano.Ledger.Allegra.ImpTest
import Test.Cardano.Ledger.Imp.Common
import Test.Cardano.Ledger.Mary.Arbitrary ()
import Test.Cardano.Ledger.Mary.Era
import Test.Cardano.Ledger.Mary.TreeDiff ()

instance ShelleyEraImp MaryEra where
  impSatisfyNativeScript :: forall (l :: TxLevel).
Set (KeyHash Witness)
-> TxBody l MaryEra
-> NativeScript MaryEra
-> ImpTestM
     MaryEra (Maybe (Map (KeyHash Witness) (KeyPair Witness)))
impSatisfyNativeScript = Set (KeyHash Witness)
-> TxBody l MaryEra
-> NativeScript MaryEra
-> ImpTestM
     MaryEra (Maybe (Map (KeyHash Witness) (KeyPair Witness)))
forall era (l :: TxLevel).
(ShelleyEraImp era, AllegraEraScript era, AllegraEraTxBody era,
 NativeScript era ~ Timelock era) =>
Set (KeyHash Witness)
-> TxBody l era
-> NativeScript era
-> ImpTestM era (Maybe (Map (KeyHash Witness) (KeyPair Witness)))
impAllegraSatisfyNativeScript
  fixupTx :: HasCallStack =>
Tx TopTx MaryEra -> ImpTestM MaryEra (Tx TopTx MaryEra)
fixupTx = Tx TopTx MaryEra -> ImpTestM MaryEra (Tx TopTx MaryEra)
forall era.
(ShelleyEraImp era, HasCallStack) =>
Tx TopTx era -> ImpTestM era (Tx TopTx era)
shelleyFixupTx
  expectTxSuccess :: HasCallStack => Tx TopTx MaryEra -> ImpTestM MaryEra ()
expectTxSuccess = Tx TopTx MaryEra -> ImpTestM MaryEra ()
forall era.
(ShelleyEraImp era, HasCallStack) =>
Tx TopTx era -> ImpTestM era ()
impShelleyExpectTxSuccess
  modifyImpInitProtVer :: ShelleyEraImp MaryEra =>
Version
-> SpecWith (ImpInit (LedgerSpec MaryEra))
-> SpecWith (ImpInit (LedgerSpec MaryEra))
modifyImpInitProtVer = Version
-> SpecWith (ImpInit (LedgerSpec MaryEra))
-> SpecWith (ImpInit (LedgerSpec MaryEra))
forall era.
ShelleyEraImp era =>
Version
-> SpecWith (ImpInit (LedgerSpec era))
-> SpecWith (ImpInit (LedgerSpec era))
shelleyModifyImpInitProtVer
  genRegTxCert :: Credential Staking -> ImpTestM MaryEra (TxCert MaryEra)
genRegTxCert = Credential Staking -> ImpTestM MaryEra (TxCert MaryEra)
forall era.
ShelleyEraTxCert era =>
Credential Staking -> ImpTestM era (TxCert era)
shelleyGenRegTxCert
  genUnRegTxCert :: Credential Staking -> ImpTestM MaryEra (TxCert MaryEra)
genUnRegTxCert = Credential Staking -> ImpTestM MaryEra (TxCert MaryEra)
forall era.
ShelleyEraTxCert era =>
Credential Staking -> ImpTestM era (TxCert era)
shelleyGenUnRegTxCert
  delegStakeTxCert :: Credential Staking -> KeyHash StakePool -> TxCert MaryEra
delegStakeTxCert = Credential Staking -> KeyHash StakePool -> TxCert MaryEra
forall era.
ShelleyEraTxCert era =>
Credential Staking -> KeyHash StakePool -> TxCert era
shelleyDelegStakeTxCert

class
  ( ShelleyEraImp era
  , MaryEraTest era
  , Value era ~ MaryValue
  ) =>
  MaryEraImp era

instance MaryEraImp MaryEra

mkTokenMintingTx :: (MaryEraImp era, Typeable l) => ScriptHash -> ImpTestM era (Tx l era)
mkTokenMintingTx :: forall era (l :: TxLevel).
(MaryEraImp era, Typeable l) =>
ScriptHash -> ImpTestM era (Tx l era)
mkTokenMintingTx ScriptHash
sh = do
  name <- ImpM (LedgerSpec era) AssetName
forall a (m :: * -> *). (Arbitrary a, MonadGen m) => m a
arbitrary
  count <- choose (1, 10)
  let policyId = ScriptHash -> PolicyID
PolicyID ScriptHash
sh
  let ma = [(PolicyID, AssetName, Integer)] -> MultiAsset
multiAssetFromList [(PolicyID
policyId, AssetName
name, Integer
count)]
  addr <- freshKeyAddr_
  pure $
    mkBasicTx mkBasicTxBody
      & bodyTxL . mintTxBodyL .~ ma
      & bodyTxL . outputsTxBodyL .~ [mkBasicTxOut addr (MaryValue mempty ma)]