{-# 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
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))