{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableSuperClasses #-}
{-# OPTIONS_GHC -Wno-orphans #-}

module Test.Cardano.Ledger.Conway.Era (
  module Test.Cardano.Ledger.Babbage.Era,
  ConwayEraTest,
  mkConwayTestAccountState,
) where

import Cardano.Ledger.Alonzo.Plutus.Context (EraPlutusContext (..), EraPlutusTxInfo)
import Cardano.Ledger.BaseTypes (Inject)
import Cardano.Ledger.Coin
import Cardano.Ledger.Conway
import Cardano.Ledger.Conway.Core
import Cardano.Ledger.Conway.Governance
import Cardano.Ledger.Conway.State
import Cardano.Ledger.Conway.TxInfo (ConwayContextError)
import Cardano.Ledger.Plutus (Language (..))
import Data.Coerce
import Lens.Micro
import Paths_cardano_ledger_conway (getDataFileName)
import Test.Cardano.Ledger.Babbage.Era
import Test.Cardano.Ledger.Conway.Arbitrary ()
import Test.Cardano.Ledger.Conway.Binary.Annotator ()
import Test.Cardano.Ledger.Conway.Examples (
  exampleConwayOnwardsEraPParams,
  exampleConwayOnwardsEraPParamsUpdate,
  exampleConwayTx,
 )
import Test.Cardano.Ledger.Conway.TreeDiff ()
import Test.Cardano.Ledger.Plutus (zeroTestingCostModels)

class
  ( BabbageEraTest era
  , ConwayEraTxBody era
  , ConwayEraCertState era
  , ConwayEraGov era
  , ConwayEraAccounts era
  , EraPlutusTxInfo PlutusV3 era
  , Inject (ConwayContextError era) (ContextError era)
  ) =>
  ConwayEraTest era

instance EraTest ConwayEra where
  type
    EraRulesWithFailures ConwayEra =
      '[ "BBODY"
       , "CERT"
       , "CERTS"
       , "DELEG"
       , "GOVCERT"
       , "GOV"
       , "LEDGER"
       , "LEDGERS"
       , -- , "MEMPOOL" -- TODO: Enable, once we are in Dijkstra era.
         "POOL"
       , "UTXO"
       , "UTXOS"
       , "UTXOW"
       ]

  zeroCostModels :: CostModels
zeroCostModels = HasCallStack => [Language] -> CostModels
[Language] -> CostModels
zeroTestingCostModels [Language
PlutusV1 .. Language
PlutusV3]

  mkTestAccountState :: HasCallStack =>
Maybe Ptr
-> CompactForm Coin
-> Maybe (KeyHash StakePool)
-> Maybe DRep
-> AccountState ConwayEra
mkTestAccountState Maybe Ptr
_mPtr = CompactForm Coin
-> Maybe (KeyHash StakePool)
-> Maybe DRep
-> AccountState ConwayEra
forall era.
ConwayEraAccounts era =>
CompactForm Coin
-> Maybe (KeyHash StakePool) -> Maybe DRep -> AccountState era
mkConwayTestAccountState

  accountsFromAccountsMap :: Map (Credential Staking) (AccountState ConwayEra)
-> Accounts ConwayEra
accountsFromAccountsMap = Map (Credential Staking) (AccountState ConwayEra)
-> Accounts ConwayEra
Map (Credential Staking) (ConwayAccountState ConwayEra)
-> ConwayAccounts ConwayEra
forall a b. Coercible a b => a -> b
coerce

  mkEraFullPath :: FilePath -> IO FilePath
mkEraFullPath = FilePath -> IO FilePath
getDataFileName

  exampleTx :: Tx TopTx ConwayEra
exampleTx = Tx TopTx ConwayEra
exampleConwayTx

  examplePParams :: PParams ConwayEra
examplePParams = PParams ConwayEra
forall era. ConwayEraPParams era => PParams era
exampleConwayOnwardsEraPParams

  examplePParamsUpdate :: PParamsUpdate ConwayEra
examplePParamsUpdate = PParamsUpdate ConwayEra
forall era. ConwayEraPParams era => PParamsUpdate era
exampleConwayOnwardsEraPParamsUpdate

instance ShelleyEraTest ConwayEra

instance AllegraEraTest ConwayEra

instance MaryEraTest ConwayEra

instance AlonzoEraTest ConwayEra

instance BabbageEraTest ConwayEra

instance ConwayEraTest ConwayEra

-- | similar to mkShelleyTestAccountState, but it ignores the mPtr, and doesn't
--   need to test that mDRep is SNothing, since this is the Conway Era, where DReps can be allocated.
mkConwayTestAccountState ::
  ConwayEraAccounts era =>
  CompactForm Coin ->
  Maybe (KeyHash StakePool) ->
  Maybe DRep ->
  AccountState era
mkConwayTestAccountState :: forall era.
ConwayEraAccounts era =>
CompactForm Coin
-> Maybe (KeyHash StakePool) -> Maybe DRep -> AccountState era
mkConwayTestAccountState CompactForm Coin
deposit Maybe (KeyHash StakePool)
mStakePool Maybe DRep
mDRep =
  CompactForm Coin -> AccountState era
forall era.
ConwayEraAccounts era =>
CompactForm Coin -> AccountState era
mkConwayAccountState CompactForm Coin
deposit
    AccountState era
-> (AccountState era -> AccountState era) -> AccountState era
forall a b. a -> (a -> b) -> b
& (Maybe (KeyHash StakePool) -> Identity (Maybe (KeyHash StakePool)))
-> AccountState era -> Identity (AccountState era)
forall era.
EraAccounts era =>
Lens' (AccountState era) (Maybe (KeyHash StakePool))
Lens' (AccountState era) (Maybe (KeyHash StakePool))
stakePoolDelegationAccountStateL ((Maybe (KeyHash StakePool)
  -> Identity (Maybe (KeyHash StakePool)))
 -> AccountState era -> Identity (AccountState era))
-> Maybe (KeyHash StakePool)
-> AccountState era
-> AccountState era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Maybe (KeyHash StakePool)
mStakePool
    AccountState era
-> (AccountState era -> AccountState era) -> AccountState era
forall a b. a -> (a -> b) -> b
& (Maybe DRep -> Identity (Maybe DRep))
-> AccountState era -> Identity (AccountState era)
forall era.
ConwayEraAccounts era =>
Lens' (AccountState era) (Maybe DRep)
Lens' (AccountState era) (Maybe DRep)
dRepDelegationAccountStateL ((Maybe DRep -> Identity (Maybe DRep))
 -> AccountState era -> Identity (AccountState era))
-> Maybe DRep -> AccountState era -> AccountState era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Maybe DRep
mDRep