{-# LANGUAGE DataKinds #-}
{-# LANGUAGE UndecidableSuperClasses #-}
{-# OPTIONS_GHC -Wno-orphans #-}

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

import Cardano.Ledger.BaseTypes
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.Plutus (Language (..))
import Cardano.Ledger.UMap
import Data.Coerce
import qualified Data.Map.Strict as Map
import qualified Data.Set as Set
import Lens.Micro
import Test.Cardano.Ledger.Babbage.Era
import Test.Cardano.Ledger.Conway.Arbitrary ()
import Test.Cardano.Ledger.Conway.TreeDiff ()
import Test.Cardano.Ledger.Plutus (zeroTestingCostModels)

class
  ( BabbageEraTest era
  , ConwayEraTxBody era
  , ConwayEraCertState era
  , ConwayEraGov era
  , ConwayEraAccounts era
  ) =>
  ConwayEraTest era

instance EraTest ConwayEra where
  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

  accountsToUMap :: Accounts ConwayEra -> UMap
accountsToUMap = Accounts ConwayEra -> UMap
forall era. ConwayEraAccounts era => Accounts era -> UMap
conwayAccountsToUMap

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

conwayAccountsToUMap :: ConwayEraAccounts era => Accounts era -> UMap
conwayAccountsToUMap :: forall era. ConwayEraAccounts era => Accounts era -> UMap
conwayAccountsToUMap Accounts era
accounts =
  UMap
    { umElems :: Map (Credential 'Staking) UMElem
umElems = (AccountState era -> UMElem)
-> Map (Credential 'Staking) (AccountState era)
-> Map (Credential 'Staking) UMElem
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map AccountState era -> UMElem
forall {era}.
(Assert
   (OrdCond
      (CmpNat (ProtVerLow era) (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerLow era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 ConwayEraAccounts era) =>
AccountState era -> UMElem
toUMElem (Accounts era
accounts Accounts era
-> Getting
     (Map (Credential 'Staking) (AccountState era))
     (Accounts era)
     (Map (Credential 'Staking) (AccountState era))
-> Map (Credential 'Staking) (AccountState era)
forall s a. s -> Getting a s a -> a
^. Getting
  (Map (Credential 'Staking) (AccountState era))
  (Accounts era)
  (Map (Credential 'Staking) (AccountState era))
forall era.
EraAccounts era =>
Lens' (Accounts era) (Map (Credential 'Staking) (AccountState era))
Lens' (Accounts era) (Map (Credential 'Staking) (AccountState era))
accountsMapL)
    , umPtrs :: Map Ptr (Credential 'Staking)
umPtrs = Map Ptr (Credential 'Staking)
forall k a. Map k a
Map.empty
    }
  where
    toUMElem :: AccountState era -> UMElem
toUMElem AccountState era
accountState =
      StrictMaybe RDPair
-> Set Ptr
-> StrictMaybe (KeyHash 'StakePool)
-> StrictMaybe DRep
-> UMElem
UMElem
        (RDPair -> StrictMaybe RDPair
forall a. a -> StrictMaybe a
SJust (CompactForm Coin -> CompactForm Coin -> RDPair
RDPair (AccountState era
accountState AccountState era
-> Getting (CompactForm Coin) (AccountState era) (CompactForm Coin)
-> CompactForm Coin
forall s a. s -> Getting a s a -> a
^. Getting (CompactForm Coin) (AccountState era) (CompactForm Coin)
forall era.
EraAccounts era =>
Lens' (AccountState era) (CompactForm Coin)
Lens' (AccountState era) (CompactForm Coin)
balanceAccountStateL) (AccountState era
accountState AccountState era
-> Getting (CompactForm Coin) (AccountState era) (CompactForm Coin)
-> CompactForm Coin
forall s a. s -> Getting a s a -> a
^. Getting (CompactForm Coin) (AccountState era) (CompactForm Coin)
forall era.
EraAccounts era =>
Lens' (AccountState era) (CompactForm Coin)
Lens' (AccountState era) (CompactForm Coin)
depositAccountStateL)))
        Set Ptr
forall a. Set a
Set.empty
        (Maybe (KeyHash 'StakePool) -> StrictMaybe (KeyHash 'StakePool)
forall a. Maybe a -> StrictMaybe a
maybeToStrictMaybe (AccountState era
accountState AccountState era
-> Getting
     (Maybe (KeyHash 'StakePool))
     (AccountState era)
     (Maybe (KeyHash 'StakePool))
-> Maybe (KeyHash 'StakePool)
forall s a. s -> Getting a s a -> a
^. Getting
  (Maybe (KeyHash 'StakePool))
  (AccountState era)
  (Maybe (KeyHash 'StakePool))
forall era.
EraAccounts era =>
Lens' (AccountState era) (Maybe (KeyHash 'StakePool))
Lens' (AccountState era) (Maybe (KeyHash 'StakePool))
stakePoolDelegationAccountStateL))
        (Maybe DRep -> StrictMaybe DRep
forall a. Maybe a -> StrictMaybe a
maybeToStrictMaybe (AccountState era
accountState AccountState era
-> Getting (Maybe DRep) (AccountState era) (Maybe DRep)
-> Maybe DRep
forall s a. s -> Getting a s a -> a
^. Getting (Maybe DRep) (AccountState era) (Maybe DRep)
forall era.
ConwayEraAccounts era =>
Lens' (AccountState era) (Maybe DRep)
Lens' (AccountState era) (Maybe DRep)
dRepDelegationAccountStateL))