From 8b7c7d0ff9708a9df45145d05fe72d947673eeef Mon Sep 17 00:00:00 2001 From: TimSheard Date: Thu, 4 Nov 2021 12:47:27 -0400 Subject: [PATCH] Added HasFied address (Core.Txout era) Addr, to Wellformed. --- .../Cardano/Ledger/Alonzo/PlutusScriptApi.hs | 5 +--- .../src/Cardano/Ledger/Alonzo/Rules/Utxow.hs | 3 +-- .../test/Test/Cardano/Ledger/Alonzo/Trials.hs | 2 -- .../src/Cardano/Ledger/Shelley/API/Wallet.hs | 12 ++++------ .../src/Cardano/Ledger/Shelley/LedgerState.hs | 23 ++++++++----------- .../impl/src/Cardano/Ledger/Shelley/UTxO.hs | 3 +-- .../Ledger/Shelley/Generator/Trace/Chain.hs | 5 +--- .../Cardano/Ledger/Shelley/Rules/Chain.hs | 2 -- .../Ledger/Shelley/Rules/ClassifyTraces.hs | 5 +--- .../Cardano/Ledger/Shelley/Rules/TestChain.hs | 14 ++++------- .../src/Cardano/Ledger/Era.hs | 2 ++ .../src/Cardano/Ledger/Pretty.hs | 4 ++-- .../Ledger/Examples/TwoPhaseValidation.hs | 7 ++---- 13 files changed, 28 insertions(+), 59 deletions(-) diff --git a/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/PlutusScriptApi.hs b/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/PlutusScriptApi.hs index 9c93f78fc8d..dfc15e3eb29 100644 --- a/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/PlutusScriptApi.hs +++ b/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/PlutusScriptApi.hs @@ -22,7 +22,6 @@ module Cardano.Ledger.Alonzo.PlutusScriptApi where import Cardano.Binary (FromCBOR (..), ToCBOR (..)) -import Cardano.Ledger.Address (Addr) import Cardano.Ledger.Alonzo.Data (getPlutusData) import Cardano.Ledger.Alonzo.Language (Language (..)) import Cardano.Ledger.Alonzo.Scripts (CostModel (..), ExUnits (..)) @@ -253,7 +252,6 @@ scriptsNeeded :: HasField "inputs" (Core.TxBody era) (Set (TxIn (Crypto era))), HasField "wdrls" (Core.TxBody era) (Wdrl (Crypto era)), HasField "certs" (Core.TxBody era) (StrictSeq (DCert (Crypto era))), - HasField "address" (Core.TxOut era) (Addr (Crypto era)), HasField "body" tx (Core.TxBody era) ) => UTxO era -> @@ -278,8 +276,7 @@ scriptsNeededFromBody :: ( Era era, HasField "inputs" (Core.TxBody era) (Set (TxIn (Crypto era))), HasField "wdrls" (Core.TxBody era) (Wdrl (Crypto era)), - HasField "certs" (Core.TxBody era) (StrictSeq (DCert (Crypto era))), - HasField "address" (Core.TxOut era) (Addr (Crypto era)) + HasField "certs" (Core.TxBody era) (StrictSeq (DCert (Crypto era))) ) => UTxO era -> Core.TxBody era -> diff --git a/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Rules/Utxow.hs b/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Rules/Utxow.hs index 103ca68d722..3d760bd918d 100644 --- a/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Rules/Utxow.hs +++ b/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Rules/Utxow.hs @@ -360,8 +360,7 @@ witsVKeyNeeded :: HasField "certs" (Core.TxBody era) (StrictSeq (DCert (Crypto era))), HasField "inputs" (Core.TxBody era) (Set (TxIn (Crypto era))), HasField "collateral" (Core.TxBody era) (Set (TxIn (Crypto era))), - HasField "update" (Core.TxBody era) (StrictMaybe (Update era)), - HasField "address" (Core.TxOut era) (Addr (Crypto era)) + HasField "update" (Core.TxBody era) (StrictMaybe (Update era)) ) => UTxO era -> tx -> diff --git a/eras/alonzo/test-suite/test/Test/Cardano/Ledger/Alonzo/Trials.hs b/eras/alonzo/test-suite/test/Test/Cardano/Ledger/Alonzo/Trials.hs index a68d0ddd2df..2d0dd41f1e1 100644 --- a/eras/alonzo/test-suite/test/Test/Cardano/Ledger/Alonzo/Trials.hs +++ b/eras/alonzo/test-suite/test/Test/Cardano/Ledger/Alonzo/Trials.hs @@ -50,7 +50,6 @@ module Test.Cardano.Ledger.Alonzo.Trials where import Cardano.Binary (ToCBOR) -import Cardano.Ledger.Address (Addr) import Cardano.Ledger.Alonzo (AlonzoEra) import Cardano.Ledger.Alonzo.Data (Data (..)) import Cardano.Ledger.Alonzo.PParams (PParams' (..)) @@ -150,7 +149,6 @@ import Test.Tasty.QuickCheck -- See genAlonzoTx and genAlonzoBlock as examples of its use. genstuff :: ( EraGen era, - HasField "address" (Core.TxOut era) (Addr (Crypto era)), Default (State (Core.EraRule "PPUP" era)) ) => Proxy era -> diff --git a/eras/shelley/impl/src/Cardano/Ledger/Shelley/API/Wallet.hs b/eras/shelley/impl/src/Cardano/Ledger/Shelley/API/Wallet.hs index ad52fd8b000..ee522c63926 100644 --- a/eras/shelley/impl/src/Cardano/Ledger/Shelley/API/Wallet.hs +++ b/eras/shelley/impl/src/Cardano/Ledger/Shelley/API/Wallet.hs @@ -216,7 +216,7 @@ getPoolParameters = Map.restrictKeys . f -- This is not based on any snapshot, but uses the current ledger state. poolsByTotalStakeFraction :: forall era. - (UsesValue era, HasField "address" (Core.TxOut era) (Addr (Crypto era))) => + (UsesValue era) => Globals -> NewEpochState era -> PoolDistr (Crypto era) @@ -251,8 +251,7 @@ getTotalStake globals ss = getNonMyopicMemberRewards :: ( UsesValue era, HasField "_a0" (Core.PParams era) NonNegativeInterval, - HasField "_nOpt" (Core.PParams era) Natural, - HasField "address" (Core.TxOut era) (Addr (Crypto era)) + HasField "_nOpt" (Core.PParams era) Natural ) => Globals -> NewEpochState era -> @@ -325,9 +324,7 @@ getNonMyopicMemberRewards globals ss creds = -- do not want to use one of the regular snapshots, but rather the most recent -- ledger state. currentSnapshot :: - ( UsesValue era, - HasField "address" (Core.TxOut era) (Addr (Crypto era)) - ) => + (UsesValue era) => NewEpochState era -> EB.SnapShot (Crypto era) currentSnapshot ss = @@ -398,8 +395,7 @@ deriving instance ToJSON RewardParams getRewardInfoPools :: ( UsesValue era, HasField "_a0" (Core.PParams era) NonNegativeInterval, - HasField "_nOpt" (Core.PParams era) Natural, - HasField "address" (Core.TxOut era) (Addr (Crypto era)) + HasField "_nOpt" (Core.PParams era) Natural ) => Globals -> NewEpochState era -> diff --git a/eras/shelley/impl/src/Cardano/Ledger/Shelley/LedgerState.hs b/eras/shelley/impl/src/Cardano/Ledger/Shelley/LedgerState.hs index 9bfef713c64..3ece66268ca 100644 --- a/eras/shelley/impl/src/Cardano/Ledger/Shelley/LedgerState.hs +++ b/eras/shelley/impl/src/Cardano/Ledger/Shelley/LedgerState.hs @@ -541,8 +541,8 @@ pvCanFollow (ProtVer m n) (SJust (ProtVer m' n')) = -- | Incremental Stake, Stake along with possible missed coins from danging Ptrs data IncrementalStake crypto = IStake - { getStake :: !(Map (Credential 'Staking crypto) Coin), - dangling :: !(Map Ptr Coin) + { credMap :: !(Map (Credential 'Staking crypto) Coin), + ptrMap :: !(Map Ptr Coin) } deriving (Generic, Show, Eq, Ord, NoThunks, NFData) @@ -895,8 +895,7 @@ witsVKeyNeeded :: HasField "wdrls" (Core.TxBody era) (Wdrl (Crypto era)), HasField "certs" (Core.TxBody era) (StrictSeq (DCert (Crypto era))), HasField "inputs" (Core.TxBody era) (Set (TxIn (Crypto era))), - HasField "update" (Core.TxBody era) (StrictMaybe (Update era)), - HasField "address" (Core.TxOut era) (Addr (Crypto era)) + HasField "update" (Core.TxBody era) (StrictMaybe (Update era)) ) => UTxO era -> tx -> @@ -1039,7 +1038,7 @@ reapRewards dStateRewards withdrawals = -- Now its is called in the tests to see that its incremental analog 'incrementaStakeDistr' agrees. stakeDistr :: forall era. - (Era era, HasField "address" (Core.TxOut era) (Addr (Crypto era))) => + Era era => UTxO era -> DState (Crypto era) -> PState (Crypto era) -> @@ -1068,8 +1067,7 @@ stakeDistr u ds ps = -- incremental analog. See 'incrementalAggregateUtxoCoinByCredential' aggregateUtxoCoinByCredential :: forall era. - ( Era era, - HasField "address" (Core.TxOut era) (Addr (Crypto era)) + ( Era era ) => Map Ptr (Credential 'Staking (Crypto era)) -> UTxO era -> @@ -1093,8 +1091,7 @@ aggregateUtxoCoinByCredential ptrs (UTxO u) initial = -- | Incrementally add the inserts 'utxoAdd' and the deletes 'utxoDel' to the IncrementalStake. updateStakeDistribution :: - ( Era era, - HasField "address" (Core.TxOut era) (Addr (Crypto era)) + ( Era era ) => IncrementalStake (Crypto era) -> UTxO era -> @@ -1111,8 +1108,7 @@ updateStakeDistribution incStake0 utxoDel utxoAdd = incStake2 -- analog 'aggregateUtxoCoinByCredential' incrementalAggregateUtxoCoinByCredential :: forall era. - ( Era era, - HasField "address" (Core.TxOut era) (Addr (Crypto era)) + ( Era era ) => (Coin -> Coin) -> UTxO era -> @@ -1176,8 +1172,7 @@ incrementalStakeDistr incstake ds ps = -- which defeats the purpose of memoizing the _stakeDistro field. So use of this function should be -- restricted to tests and initializations, where the invariant should be maintained. smartUTxOState :: - ( Era era, - HasField "address" (Core.TxOut era) (Addr (Crypto era)) + ( Era era ) => UTxO era -> Coin -> @@ -1525,7 +1520,7 @@ updateNES returnRedeemAddrsToReserves :: forall era. - (Era era, HasField "address" (Core.TxOut era) (Addr (Crypto era))) => + (Era era) => EpochState era -> EpochState era returnRedeemAddrsToReserves es = es {esAccountState = acnt', esLState = ls'} diff --git a/eras/shelley/impl/src/Cardano/Ledger/Shelley/UTxO.hs b/eras/shelley/impl/src/Cardano/Ledger/Shelley/UTxO.hs index 57180b9b8f5..25aef943e4c 100644 --- a/eras/shelley/impl/src/Cardano/Ledger/Shelley/UTxO.hs +++ b/eras/shelley/impl/src/Cardano/Ledger/Shelley/UTxO.hs @@ -323,8 +323,7 @@ scriptsNeeded :: HasField "body" tx (Core.TxBody era), HasField "certs" (Core.TxBody era) (StrictSeq (DCert (Crypto era))), HasField "wdrls" (Core.TxBody era) (Wdrl (Crypto era)), - HasField "inputs" (Core.TxBody era) (Set (TxIn (Crypto era))), - HasField "address" (Core.TxOut era) (Addr (Crypto era)) + HasField "inputs" (Core.TxBody era) (Set (TxIn (Crypto era))) ) => UTxO era -> tx -> diff --git a/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Generator/Trace/Chain.hs b/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Generator/Trace/Chain.hs index 7c1b2975cbd..96168d81f27 100644 --- a/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Generator/Trace/Chain.hs +++ b/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Generator/Trace/Chain.hs @@ -138,7 +138,6 @@ lastByronHeaderHash _ = HashHeader $ mkHash 0 mkGenesisChainState :: forall era a. ( Default (State (Core.EraRule "PPUP" era)), - HasField "address" (Core.TxOut era) (Addr (Crypto era)), EraGen era ) => GenEnv era -> @@ -193,9 +192,7 @@ mkOCertIssueNos (GenDelegs delegs0) = -- This allows stake pools to produce blocks from genesis. registerGenesisStaking :: forall era. - ( Era era, - HasField "address" (Core.TxOut era) (Addr (Crypto era)) - ) => + (Era era) => ShelleyGenesisStaking (Crypto era) -> ChainState era -> ChainState era diff --git a/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Rules/Chain.hs b/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Rules/Chain.hs index 15fb6752a7f..3a3907aefdd 100644 --- a/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Rules/Chain.hs +++ b/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Rules/Chain.hs @@ -26,7 +26,6 @@ module Test.Cardano.Ledger.Shelley.Rules.Chain ) where -import Cardano.Ledger.Address (Addr) import Cardano.Ledger.BHeaderView (BHeaderView) import Cardano.Ledger.BaseTypes (BlocksMade (..), Globals (..), Nonce (..), ProtVer (..), ShelleyBase, StrictMaybe (..), UnitInterval) import Cardano.Ledger.Block (Block (..)) @@ -183,7 +182,6 @@ instance -- | Creates a valid initial chain state initialShelleyState :: ( Era era, - HasField "address" (Core.TxOut era) (Addr (Crypto era)), Default (State (Core.EraRule "PPUP" era)) ) => WithOrigin (LastAppliedBlock (Crypto era)) -> diff --git a/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Rules/ClassifyTraces.hs b/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Rules/ClassifyTraces.hs index 627e7d08640..f94a362adf2 100644 --- a/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Rules/ClassifyTraces.hs +++ b/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Rules/ClassifyTraces.hs @@ -113,7 +113,6 @@ relevantCasesAreCovered :: HasField "certs" (Core.TxBody era) (StrictSeq (DCert (Crypto era))), HasField "wdrls" (Core.TxBody era) (Wdrl (Crypto era)), HasField "update" (Core.TxBody era) (StrictMaybe (PParams.Update era)) - -- HasField "address" (Core.TxOut era) (Addr (Crypto era)) ) => Property relevantCasesAreCovered = do @@ -133,7 +132,6 @@ relevantCasesAreCoveredForTrace :: HasField "certs" (Core.TxBody era) (StrictSeq (DCert (Crypto era))), HasField "wdrls" (Core.TxBody era) (Wdrl (Crypto era)), HasField "update" (Core.TxBody era) (StrictMaybe (PParams.Update era)) - -- HasField "address" (Core.TxOut era) (Addr (Crypto era)) ) => Trace (CHAIN era) -> Property @@ -255,7 +253,7 @@ ratioInt x y = -- | Transaction has script locked TxOuts txScriptOutputsRatio :: forall era. - HasField "address" (Core.TxOut era) (Addr (Crypto era)) => + Era era => Proxy era -> [StrictSeq (Core.TxOut era)] -> Double @@ -401,7 +399,6 @@ onlyValidChainSignalsAreGenerated :: forall era. ( EraGen era, Default (State (Core.EraRule "PPUP" era)), - HasField "address" (Core.TxOut era) (Addr (Crypto era)), QC.HasTrace (CHAIN era) (GenEnv era), Show (TxSeq era) ) => diff --git a/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Rules/TestChain.hs b/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Rules/TestChain.hs index 3dc3bdb8c68..1d4bb5e5de0 100644 --- a/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Rules/TestChain.hs +++ b/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Rules/TestChain.hs @@ -30,7 +30,6 @@ module Test.Cardano.Ledger.Shelley.Rules.TestChain ) where -import Cardano.Ledger.Address (Addr) import Cardano.Ledger.BaseTypes (Globals, ProtVer, StrictMaybe (..)) import Cardano.Ledger.Block ( Block (..), @@ -253,7 +252,7 @@ incrStakeComp SourceSignalTarget {source = chainSt, signal = block} = counterExampleTooBig x = Map.size (unUTxO x) > 50 utxoBal = Val.coin $ balance u' - incrStakeBal = fold (getStake sd') <> fold (dangling sd') + incrStakeBal = fold (credMap sd') <> fold (ptrMap sd') ptrs = _ptrs . _dstate $ dp ptrs' = _ptrs . _dstate $ dp' @@ -1192,7 +1191,6 @@ forAllChainTrace :: ( Testable prop, Default (State (Core.EraRule "PPUP" era)), EraGen era, - HasField "address" (Core.TxOut era) (Addr (Crypto era)), QC.HasTrace (CHAIN era) (GenEnv era) ) => Word64 -> -- trace length @@ -1226,8 +1224,7 @@ atEpoch :: ( EraGen era, Testable prop, QC.HasTrace (CHAIN era) (GenEnv era), - Default (State (Core.EraRule "PPUP" era)), - HasField "address" (Core.TxOut era) (Addr (Crypto era)) + Default (State (Core.EraRule "PPUP" era)) ) => (LedgerState era -> LedgerState era -> prop) -> Property @@ -1244,9 +1241,7 @@ ledgerStateFromChainState = esLState . nesEs . chainNes testIncrementalStake :: forall era. - ( Era era, - HasField "address" (Core.TxOut era) (Addr (Crypto era)) - ) => + (Era era) => LedgerState era -> LedgerState era -> Property @@ -1264,8 +1259,7 @@ incrementalStakeProp :: forall era. ( EraGen era, QC.HasTrace (CHAIN era) (GenEnv era), - Default (State (Core.EraRule "PPUP" era)), - HasField "address" (Core.TxOut era) (Addr (Crypto era)) + Default (State (Core.EraRule "PPUP" era)) ) => Proxy era -> Property diff --git a/libs/cardano-ledger-core/src/Cardano/Ledger/Era.hs b/libs/cardano-ledger-core/src/Cardano/Ledger/Era.hs index afb31abfdd9..9aa46ec78ee 100644 --- a/libs/cardano-ledger-core/src/Cardano/Ledger/Era.hs +++ b/libs/cardano-ledger-core/src/Cardano/Ledger/Era.hs @@ -27,6 +27,7 @@ module Cardano.Ledger.Era where import qualified Cardano.Crypto.Hash as Hash +import Cardano.Ledger.Address (Addr) import Cardano.Ledger.AuxiliaryData (AuxiliaryDataHash) import Cardano.Ledger.Coin (Coin) import Cardano.Ledger.Compactible (Compactible) @@ -255,6 +256,7 @@ type WellFormed era = HasField "scriptWits" (Core.Tx era) (Map (ScriptHash (Crypto era)) (Core.Script era)), -- TxOut HasField "value" (Core.TxOut era) (Core.Value era), + HasField "address" (Core.TxOut era) (Addr (Crypto era)), -- HashAnnotated HashAnnotated (Core.AuxiliaryData era) EraIndependentAuxiliaryData (Crypto era), HashAnnotated (Core.TxBody era) EraIndependentTxBody (Crypto era), diff --git a/libs/cardano-ledger-pretty/src/Cardano/Ledger/Pretty.hs b/libs/cardano-ledger-pretty/src/Cardano/Ledger/Pretty.hs index c77119a7799..044dc503498 100644 --- a/libs/cardano-ledger-pretty/src/Cardano/Ledger/Pretty.hs +++ b/libs/cardano-ledger-pretty/src/Cardano/Ledger/Pretty.hs @@ -657,8 +657,8 @@ ppIncrementalStake :: IncrementalStake crypto -> PDoc ppIncrementalStake (IStake st dangle) = ppRecord "IncrementalStake" - [ ("getStake", ppStake (Stake st)), - ("dangling", ppMap ppPtr ppCoin dangle) + [ ("credMap", ppStake (Stake st)), + ("ptrMap", ppMap ppPtr ppCoin dangle) ] ppUTxOState :: diff --git a/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Examples/TwoPhaseValidation.hs b/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Examples/TwoPhaseValidation.hs index 54fed3dadef..d04ed0ba17b 100644 --- a/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Examples/TwoPhaseValidation.hs +++ b/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Examples/TwoPhaseValidation.hs @@ -83,8 +83,7 @@ import Cardano.Ledger.Shelley.API ) import Cardano.Ledger.Shelley.BlockChain (bBodySize) import Cardano.Ledger.Shelley.LedgerState - ( IncrementalStake (..), - UTxOState (..), + ( UTxOState (..), WitHashes (..), smartUTxOState, ) @@ -122,7 +121,6 @@ import Data.Maybe (fromJust) import qualified Data.Sequence.Strict as StrictSeq import qualified Data.Set as Set import Data.Time.Clock.POSIX (posixSecondsToUTCTime) -import GHC.Records (HasField (..)) import Numeric.Natural (Natural) import Plutus.V1.Ledger.Api (defaultCostModelParams) import qualified Plutus.V1.Ledger.Api as Plutus @@ -1129,8 +1127,7 @@ utxoEx12 pf = expectedUTxO pf (ExpectSuccess (nonScriptOutWithDatumTxBody pf) (o utxoStEx12 :: ( Default (State (EraRule "PPUP" era)), - PostShelley era, - HasField "address" (Core.TxOut era) (Addr (Crypto era)) + PostShelley era ) => Proof era -> UTxOState era