From f2a01a540d7daf506b4e02ce3541b374227ca5cc Mon Sep 17 00:00:00 2001 From: Mateusz Galazyn Date: Tue, 13 Aug 2024 12:47:48 +0200 Subject: [PATCH 1/3] Remove redundant voting proposal conversion functions --- cabal.project | 2 +- cardano-cli/cardano-cli.cabal | 2 +- .../Cardano/CLI/EraBased/Run/Transaction.hs | 26 ++++--- cardano-cli/src/Cardano/CLI/Json/Friendly.hs | 14 ++-- .../CLI/Types/Errors/TxValidationError.hs | 71 ++----------------- flake.lock | 6 +- 6 files changed, 35 insertions(+), 86 deletions(-) diff --git a/cabal.project b/cabal.project index d9ae2d6ee1..ba972eee30 100644 --- a/cabal.project +++ b/cabal.project @@ -14,7 +14,7 @@ repository cardano-haskell-packages -- you need to run if you change them index-state: , hackage.haskell.org 2024-08-08T19:27:29Z - , cardano-haskell-packages 2024-08-08T07:19:00Z + , cardano-haskell-packages 2024-08-13T10:37:21Z packages: cardano-cli diff --git a/cardano-cli/cardano-cli.cabal b/cardano-cli/cardano-cli.cabal index e4c7f57433..2db3b28141 100644 --- a/cardano-cli/cardano-cli.cabal +++ b/cardano-cli/cardano-cli.cabal @@ -213,7 +213,7 @@ library binary, bytestring, canonical-json, - cardano-api ^>=9.1, + cardano-api ^>=9.2, cardano-binary, cardano-crypto, cardano-crypto-class ^>=2.1.2, diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Run/Transaction.hs b/cardano-cli/src/Cardano/CLI/EraBased/Run/Transaction.hs index b62cd7c91c..da45fe7868 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Run/Transaction.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Run/Transaction.hs @@ -761,7 +761,8 @@ runTxBuildRaw first TxCmdTxBodyError $ createAndValidateTransactionBody sbe txBodyContent constructTxBodyContent - :: ShelleyBasedEra era + :: forall era + . ShelleyBasedEra era -> Maybe ScriptValidity -> Maybe (L.PParams (ShelleyLedgerEra era)) -> [(TxIn, Maybe (ScriptWitness WitCtxTxIn era))] @@ -849,7 +850,12 @@ constructTxBodyContent validatedTxScriptValidity <- first TxCmdNotSupportedInEraValidationError $ validateTxScriptValidity sbe mScriptValidity validatedVotingProcedures <- - first TxCmdTxGovDuplicateVotes $ convertToTxVotingProcedures votingProcedures + first (TxCmdTxGovDuplicateVotes . TxGovDuplicateVotes) $ + mkTxVotingProcedures @BuildTx (fromList votingProcedures) + let txProposals = forShelleyBasedEraInEonMaybe sbe $ \w -> do + let txp :: TxProposalProcedures BuildTx era + txp = conwayEraOnwardsConstraints w $ mkTxProposalProcedures $ map (first unProposal) proposals + Featured w txp validatedCurrentTreasuryValue <- first TxCmdNotSupportedInEraValidationError @@ -859,7 +865,8 @@ constructTxBodyContent TxCmdNotSupportedInEraValidationError (validateTxTreasuryDonation sbe (snd <$> mCurrentTreasuryValueAndDonation)) return $ - shelleyBasedEraConstraints sbe $ + shelleyBasedEraConstraints + sbe ( defaultTxBodyContent sbe & setTxIns (validateTxIns inputsAndMaybeScriptWits) & setTxInsCollateral validatedCollateralTxIns @@ -879,14 +886,11 @@ constructTxBodyContent & setTxUpdateProposal txUpdateProposal & setTxMintValue validatedMintValue & setTxScriptValidity validatedTxScriptValidity + & setTxVotingProcedures (mkFeatured validatedVotingProcedures) + & setTxProposalProcedures txProposals + & setTxCurrentTreasuryValue validatedCurrentTreasuryValue + & setTxTreasuryDonation validatedTreasuryDonation ) - { -- TODO: Create set* function for proposal procedures and voting procedures - txProposalProcedures = - forShelleyBasedEraInEonMaybe sbe (`Featured` convToTxProposalProcedures proposals) - , txVotingProcedures = forShelleyBasedEraInEonMaybe sbe (`Featured` validatedVotingProcedures) - } - & setTxCurrentTreasuryValue validatedCurrentTreasuryValue - & setTxTreasuryDonation validatedTreasuryDonation where convertWithdrawals :: (StakeAddress, L.Coin, Maybe (ScriptWitness WitCtxStake era)) @@ -1130,7 +1134,7 @@ validateTxInsCollateral era txins = do validateTxInsReference :: ShelleyBasedEra era -> [TxIn] - -> Either TxCmdError (TxInsReference BuildTx era) + -> Either TxCmdError (TxInsReference era) validateTxInsReference _ [] = return TxInsReferenceNone validateTxInsReference sbe allRefIns = do forShelleyBasedEraInEonMaybe sbe (\supported -> TxInsReference supported allRefIns) diff --git a/cardano-cli/src/Cardano/CLI/Json/Friendly.hs b/cardano-cli/src/Cardano/CLI/Json/Friendly.hs index 0d7db1f89a..c879bc51a4 100644 --- a/cardano-cli/src/Cardano/CLI/Json/Friendly.hs +++ b/cardano-cli/src/Cardano/CLI/Json/Friendly.hs @@ -246,11 +246,13 @@ friendlyTxBodyImpl ++ ( monoidForEraInEon @ConwayEraOnwards era ( \cOnwards -> - case txProposalProcedures of - Nothing -> [] - Just (Featured _ TxProposalProceduresNone) -> [] - Just (Featured _ (TxProposalProcedures lProposals _witnesses)) -> - ["governance actions" .= friendlyLedgerProposals cOnwards (toList lProposals)] + conwayEraOnwardsConstraints cOnwards $ + case txProposalProcedures of + Nothing -> [] + Just (Featured _ TxProposalProceduresNone) -> [] + Just (Featured _ pp) -> do + let lProposals = toList $ convProposalProcedures pp + ["governance actions" .= (friendlyLedgerProposals cOnwards lProposals)] ) ) ++ ( monoidForEraInEon @ConwayEraOnwards @@ -772,7 +774,7 @@ friendlyAuxScripts = \case TxAuxScriptsNone -> Null TxAuxScripts _ scripts -> String $ textShow scripts -friendlyReferenceInputs :: TxInsReference build era -> Aeson.Value +friendlyReferenceInputs :: TxInsReference era -> Aeson.Value friendlyReferenceInputs TxInsReferenceNone = Null friendlyReferenceInputs (TxInsReference _ txins) = toJSON txins diff --git a/cardano-cli/src/Cardano/CLI/Types/Errors/TxValidationError.hs b/cardano-cli/src/Cardano/CLI/Types/Errors/TxValidationError.hs index ae6615b6e4..5cd1c6a2ca 100644 --- a/cardano-cli/src/Cardano/CLI/Types/Errors/TxValidationError.hs +++ b/cardano-cli/src/Cardano/CLI/Types/Errors/TxValidationError.hs @@ -10,8 +10,6 @@ module Cardano.CLI.Types.Errors.TxValidationError ( TxAuxScriptsValidationError (..) , TxGovDuplicateVotes (..) , TxNotSupportedInEraValidationError (..) - , convToTxProposalProcedures - , convertToTxVotingProcedures , validateScriptSupportedInEra , validateTxAuxScripts , validateRequiredSigners @@ -33,12 +31,7 @@ import Cardano.CLI.Types.Common import Prelude -import Control.Monad (foldM) import Data.Bifunctor (first) -import Data.Map.Strict (Map) -import qualified Data.Map.Strict as Map -import Data.Maybe -import qualified Data.OSet.Strict as OSet import qualified Data.Text as T import Prettyprinter (viaShow) @@ -107,14 +100,16 @@ validateTxCurrentTreasuryValue :: () => ShelleyBasedEra era -> Maybe TxCurrentTreasuryValue - -> Either (TxNotSupportedInEraValidationError era) (Maybe (Featured ConwayEraOnwards era L.Coin)) + -> Either + (TxNotSupportedInEraValidationError era) + (Maybe (Featured ConwayEraOnwards era (Maybe L.Coin))) validateTxCurrentTreasuryValue sbe mCurrentTreasuryValue = case mCurrentTreasuryValue of Nothing -> Right Nothing Just (TxCurrentTreasuryValue{unTxCurrentTreasuryValue}) -> caseShelleyToBabbageOrConwayEraOnwards - (const $ Left $ TxNotSupportedInShelleyBasedEraValidationError "Current treasury value" sbe) - (\cOnwards -> Right $ Just $ Featured cOnwards unTxCurrentTreasuryValue) + (const . Left $ TxNotSupportedInShelleyBasedEraValidationError "Current treasury value" sbe) + (const . pure . mkFeatured $ pure unTxCurrentTreasuryValue) sbe validateTxTreasuryDonation @@ -127,8 +122,8 @@ validateTxTreasuryDonation sbe mTreasuryDonation = Nothing -> Right Nothing Just (TxTreasuryDonation{unTxTreasuryDonation}) -> caseShelleyToBabbageOrConwayEraOnwards - (const $ Left $ TxNotSupportedInShelleyBasedEraValidationError "Treasury donation" sbe) - (\cOnwards -> Right $ Just $ Featured cOnwards unTxTreasuryDonation) + (const . Left $ TxNotSupportedInShelleyBasedEraValidationError "Treasury donation" sbe) + (const . pure $ mkFeatured unTxTreasuryDonation) sbe validateTxReturnCollateral @@ -224,21 +219,6 @@ conjureWitness era errF = maybe (cardanoEraConstraints era $ Left . errF $ AnyCardanoEra era) Right $ forEraMaybeEon era -getVotingScriptCredentials - :: VotingProcedures era - -> Maybe (L.Voter (L.EraCrypto (ShelleyLedgerEra era))) -getVotingScriptCredentials (VotingProcedures (L.VotingProcedures m)) = - listToMaybe $ Map.keys m - -votingScriptWitnessSingleton - :: VotingProcedures era - -> Maybe (ScriptWitness WitCtxStake era) - -> Map (L.Voter (L.EraCrypto (ShelleyLedgerEra era))) (ScriptWitness WitCtxStake era) -votingScriptWitnessSingleton _ Nothing = Map.empty -votingScriptWitnessSingleton votingProcedures (Just scriptWitness) = - let voter = fromJust $ getVotingScriptCredentials votingProcedures - in Map.singleton voter scriptWitness - newtype TxGovDuplicateVotes era = TxGovDuplicateVotes (VotesMergingConflict era) @@ -247,40 +227,3 @@ instance Error (TxGovDuplicateVotes era) where "Trying to merge votes with similar action identifiers: " <> viaShow actionIds <> ". This would cause ignoring some of the votes, so not proceeding." - --- TODO: We fold twice, we can do it in a single fold -convertToTxVotingProcedures - :: [(VotingProcedures era, Maybe (ScriptWitness WitCtxStake era))] - -> Either (TxGovDuplicateVotes era) (TxVotingProcedures BuildTx era) -convertToTxVotingProcedures votingProcedures = do - VotingProcedures procedure <- - first TxGovDuplicateVotes $ - foldM f emptyVotingProcedures votingProcedures - pure $ TxVotingProcedures procedure (BuildTxWith votingScriptWitnessMap) - where - votingScriptWitnessMap = - foldl - (\acc next -> acc `Map.union` uncurry votingScriptWitnessSingleton next) - Map.empty - votingProcedures - f acc (procedure, _witness) = mergeVotingProcedures acc procedure - -proposingScriptWitnessSingleton - :: Proposal era - -> Maybe (ScriptWitness WitCtxStake era) - -> Map (L.ProposalProcedure (ShelleyLedgerEra era)) (ScriptWitness WitCtxStake era) -proposingScriptWitnessSingleton _ Nothing = Map.empty -proposingScriptWitnessSingleton (Proposal proposalProcedure) (Just scriptWitness) = - Map.singleton proposalProcedure scriptWitness - -convToTxProposalProcedures - :: L.EraPParams (ShelleyLedgerEra era) - => [(Proposal era, Maybe (ScriptWitness WitCtxStake era))] - -> TxProposalProcedures BuildTx era -convToTxProposalProcedures proposalProcedures = - -- TODO: Ledger does not export snoc so we can't fold here. - let proposals = OSet.fromFoldable $ map (unProposal . fst) proposalProcedures - sWitMap = BuildTxWith $ foldl sWitMapFolder Map.empty proposalProcedures - in TxProposalProcedures proposals sWitMap - where - sWitMapFolder sWitMapAccum nextSWit = sWitMapAccum `Map.union` uncurry proposingScriptWitnessSingleton nextSWit diff --git a/flake.lock b/flake.lock index 56223e4954..5aa1384c1d 100644 --- a/flake.lock +++ b/flake.lock @@ -3,11 +3,11 @@ "CHaP": { "flake": false, "locked": { - "lastModified": 1722918532, - "narHash": "sha256-MO3N6/YoJbuQOLrivuDlN8RzyLX9gd5lycpKfbvNiG8=", + "lastModified": 1723546234, + "narHash": "sha256-XJBgWgieb7U0LoDaVR6sisd6LR9zyXW+AgbpmSGYaZE=", "owner": "intersectmbo", "repo": "cardano-haskell-packages", - "rev": "d738d3e323d71b658ef083b0e05310ec4cfb9436", + "rev": "7542392846fc9f30ea4f78a2fa7ebf35e79e4eca", "type": "github" }, "original": { From 1dc1260c9ca2ddb370ee09e0e28d95b22a98fe5a Mon Sep 17 00:00:00 2001 From: Mateusz Galazyn Date: Tue, 13 Aug 2024 13:25:15 +0200 Subject: [PATCH 2/3] Refactor: use Lovelace type alias instead of L.Coin --- .../EraBased/Commands/Governance/Actions.hs | 16 +++---- .../CLI/EraBased/Commands/Governance/DRep.hs | 4 +- .../Cardano/CLI/EraBased/Options/Common.hs | 44 +++++++++---------- .../src/Cardano/CLI/EraBased/Run/Genesis.hs | 24 +++++----- .../EraBased/Run/Genesis/CreateTestnetData.hs | 12 ++--- .../Cardano/CLI/EraBased/Run/Governance.hs | 6 +-- .../src/Cardano/CLI/EraBased/Run/Query.hs | 6 +-- .../Cardano/CLI/EraBased/Run/StakeAddress.hs | 6 +-- .../Cardano/CLI/EraBased/Run/Transaction.hs | 36 +++++++-------- cardano-cli/src/Cardano/CLI/Json/Friendly.hs | 2 +- .../src/Cardano/CLI/Legacy/Run/Governance.hs | 6 +-- .../src/Cardano/CLI/Legacy/Run/StakePool.hs | 4 +- cardano-cli/src/Cardano/CLI/Types/Common.hs | 2 +- .../CLI/Types/Errors/TxValidationError.hs | 7 ++- cardano-cli/src/Cardano/CLI/Types/Key.hs | 4 +- cardano-cli/src/Cardano/CLI/Types/Output.hs | 6 +-- 16 files changed, 92 insertions(+), 93 deletions(-) diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Commands/Governance/Actions.hs b/cardano-cli/src/Cardano/CLI/EraBased/Commands/Governance/Actions.hs index 135e7dcee3..4fd4e16040 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Commands/Governance/Actions.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Commands/Governance/Actions.hs @@ -47,7 +47,7 @@ data GovernanceActionUpdateCommitteeCmdArgs era = GovernanceActionUpdateCommitteeCmdArgs { eon :: !(ConwayEraOnwards era) , networkId :: !L.Network - , deposit :: !L.Coin + , deposit :: !Lovelace , returnAddress :: !StakeIdentifier , proposalUrl :: !ProposalUrl , proposalHash :: !(L.SafeHash L.StandardCrypto L.AnchorData) @@ -63,7 +63,7 @@ data GovernanceActionCreateConstitutionCmdArgs era = GovernanceActionCreateConstitutionCmdArgs { eon :: !(ConwayEraOnwards era) , networkId :: !L.Network - , deposit :: !L.Coin + , deposit :: !Lovelace , stakeCredential :: !StakeIdentifier , mPrevGovernanceActionId :: !(Maybe (TxId, Word16)) , proposalUrl :: !ProposalUrl @@ -80,7 +80,7 @@ data GovernanceActionInfoCmdArgs era = GovernanceActionInfoCmdArgs { eon :: !(ConwayEraOnwards era) , networkId :: !L.Network - , deposit :: !L.Coin + , deposit :: !Lovelace , returnStakeAddress :: !StakeIdentifier , proposalUrl :: !ProposalUrl , proposalHash :: !(L.SafeHash L.StandardCrypto L.AnchorData) @@ -92,7 +92,7 @@ data GovernanceActionCreateNoConfidenceCmdArgs era = GovernanceActionCreateNoConfidenceCmdArgs { eon :: !(ConwayEraOnwards era) , networkId :: !L.Network - , deposit :: !L.Coin + , deposit :: !Lovelace , returnStakeAddress :: !StakeIdentifier , proposalUrl :: !ProposalUrl , proposalHash :: !(L.SafeHash L.StandardCrypto L.AnchorData) @@ -123,11 +123,11 @@ data GovernanceActionTreasuryWithdrawalCmdArgs era = GovernanceActionTreasuryWithdrawalCmdArgs { eon :: !(ConwayEraOnwards era) , networkId :: !L.Network - , deposit :: !L.Coin + , deposit :: !Lovelace , returnAddr :: !StakeIdentifier , proposalUrl :: !ProposalUrl , proposalHash :: !(L.SafeHash L.StandardCrypto L.AnchorData) - , treasuryWithdrawal :: ![(VerificationKeyOrHashOrFile StakeKey, L.Coin)] + , treasuryWithdrawal :: ![(VerificationKeyOrHashOrFile StakeKey, Lovelace)] , constitutionScriptHash :: !(Maybe ScriptHash) , outFile :: !(File () Out) } @@ -137,7 +137,7 @@ data GovernanceActionHardforkInitCmdArgs era = GovernanceActionHardforkInitCmdArgs { eon :: !(ConwayEraOnwards era) , networkId :: !L.Network - , deposit :: !L.Coin + , deposit :: !Lovelace , returnStakeAddress :: !StakeIdentifier , mPrevGovernanceActionId :: !(Maybe (TxId, Word16)) , proposalUrl :: !ProposalUrl @@ -160,7 +160,7 @@ data UpdateProtocolParametersConwayOnwards era = UpdateProtocolParametersConwayOnwards { eon :: !(ConwayEraOnwards era) , networkId :: !L.Network - , deposit :: !L.Coin + , deposit :: !Lovelace , returnAddr :: !StakeIdentifier , proposalUrl :: !ProposalUrl , proposalHash :: !(L.SafeHash L.StandardCrypto L.AnchorData) diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Commands/Governance/DRep.hs b/cardano-cli/src/Cardano/CLI/EraBased/Commands/Governance/DRep.hs index 138601c0c2..a1d3064a56 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Commands/Governance/DRep.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Commands/Governance/DRep.hs @@ -50,7 +50,7 @@ data GovernanceDRepRegistrationCertificateCmdArgs era = GovernanceDRepRegistrationCertificateCmdArgs { eon :: !(ConwayEraOnwards era) , drepHashSource :: !DRepHashSource - , deposit :: !L.Coin + , deposit :: !Lovelace , mAnchor :: !(Maybe (L.Anchor (L.EraCrypto (ShelleyLedgerEra era)))) , outFile :: !(File () Out) } @@ -59,7 +59,7 @@ data GovernanceDRepRetirementCertificateCmdArgs era = GovernanceDRepRetirementCertificateCmdArgs { eon :: !(ConwayEraOnwards era) , drepHashSource :: !DRepHashSource - , deposit :: !L.Coin + , deposit :: !Lovelace , outFile :: !(File () Out) } diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Options/Common.hs b/cardano-cli/src/Cardano/CLI/EraBased/Options/Common.hs index a3309d3ce0..0e2276705b 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Options/Common.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Options/Common.hs @@ -510,7 +510,7 @@ pFileInDirection l h = , Opt.completer (Opt.bashCompleter "file") ] -parseLovelace :: Parsec.Parser L.Coin +parseLovelace :: Parsec.Parser Lovelace parseLovelace = do i <- decimal if i > toInteger (maxBound :: Word64) @@ -580,7 +580,7 @@ pMIRPot = ] ] -pRewardAmt :: Parser L.Coin +pRewardAmt :: Parser Lovelace pRewardAmt = Opt.option (readerFromParsecParser parseLovelace) $ mconcat @@ -589,7 +589,7 @@ pRewardAmt = , Opt.help "The reward for the relevant reward account." ] -pTransferAmt :: Parser L.Coin +pTransferAmt :: Parser Lovelace pTransferAmt = Opt.option (readerFromParsecParser parseLovelace) $ mconcat @@ -1063,7 +1063,7 @@ pUrl l h = , Opt.help h ] -pGovActionDeposit :: Parser L.Coin +pGovActionDeposit :: Parser Lovelace pGovActionDeposit = Opt.option (readerFromParsecParser parseLovelace) $ mconcat @@ -1072,7 +1072,7 @@ pGovActionDeposit = , Opt.help "Deposit required to submit a governance action." ] -pNewGovActionDeposit :: Parser L.Coin +pNewGovActionDeposit :: Parser Lovelace pNewGovActionDeposit = Opt.option (readerFromParsecParser parseLovelace) $ mconcat @@ -1687,7 +1687,7 @@ pWithdrawal -> BalanceTxExecUnits -> Parser ( StakeAddress - , L.Coin + , Lovelace , Maybe (ScriptWitnessFiles WitCtxStake) ) pWithdrawal sbe balance = @@ -1719,7 +1719,7 @@ pWithdrawal sbe balance = , "a script witness." ] - parseWithdrawal :: Parsec.Parser (StakeAddress, L.Coin) + parseWithdrawal :: Parsec.Parser (StakeAddress, Lovelace) parseWithdrawal = (,) <$> parseStakeAddress <* Parsec.char '+' <*> parseLovelace @@ -2308,7 +2308,7 @@ pReturnCollateral = <*> pure TxOutDatumByNone -- TODO: Babbage era - we should be able to return these <*> pure ReferenceScriptAnyEraNone -- TODO: Babbage era - we should be able to return these -pTotalCollateral :: Parser L.Coin +pTotalCollateral :: Parser Lovelace pTotalCollateral = Opt.option (L.Coin <$> readerFromParsecParser decimal) $ mconcat @@ -2603,7 +2603,7 @@ pInvalidHereafter eon = , pure Nothing ] -pTxFee :: Parser L.Coin +pTxFee :: Parser Lovelace pTxFee = fmap (L.Coin . (fromIntegral :: Natural -> Integer)) $ Opt.option Opt.auto $ @@ -2929,7 +2929,7 @@ pPoolOwnerVerificationKeyOrFile = , VerificationKeyFilePath <$> pPoolOwnerVerificationKeyFile ] -pPoolPledge :: Parser L.Coin +pPoolPledge :: Parser Lovelace pPoolPledge = Opt.option (readerFromParsecParser parseLovelace) $ mconcat @@ -2938,7 +2938,7 @@ pPoolPledge = , Opt.help "The stake pool's pledge." ] -pPoolCost :: Parser L.Coin +pPoolCost :: Parser Lovelace pPoolCost = Opt.option (readerFromParsecParser parseLovelace) $ mconcat @@ -3126,7 +3126,7 @@ pCostModels = , Opt.completer (Opt.bashCompleter "file") ] -pMinFeePerByteFactor :: Parser L.Coin +pMinFeePerByteFactor :: Parser Lovelace pMinFeePerByteFactor = Opt.option (readerFromParsecParser parseLovelace) $ mconcat @@ -3135,7 +3135,7 @@ pMinFeePerByteFactor = , Opt.help "The linear factor per byte for the minimum fee calculation." ] -pMinFeeConstantFactor :: Parser L.Coin +pMinFeeConstantFactor :: Parser Lovelace pMinFeeConstantFactor = Opt.option (readerFromParsecParser parseLovelace) $ mconcat @@ -3144,7 +3144,7 @@ pMinFeeConstantFactor = , Opt.help "The constant factor for the minimum fee calculation." ] -pMinUTxOValue :: Parser L.Coin +pMinUTxOValue :: Parser Lovelace pMinUTxOValue = Opt.option (readerFromParsecParser parseLovelace) $ mconcat @@ -3153,7 +3153,7 @@ pMinUTxOValue = , Opt.help "The minimum allowed UTxO value (Shelley to Mary eras)." ] -pMinPoolCost :: Parser L.Coin +pMinPoolCost :: Parser Lovelace pMinPoolCost = Opt.option (readerFromParsecParser parseLovelace) $ mconcat @@ -3189,7 +3189,7 @@ pMaxBlockHeaderSize = , Opt.help "Maximum block header size." ] -pKeyRegistDeposit :: Parser L.Coin +pKeyRegistDeposit :: Parser Lovelace pKeyRegistDeposit = Opt.option (readerFromParsecParser parseLovelace) $ mconcat @@ -3198,7 +3198,7 @@ pKeyRegistDeposit = , Opt.help "Key registration deposit amount." ] -pDrepDeposit :: Parser L.Coin +pDrepDeposit :: Parser Lovelace pDrepDeposit = Opt.option (readerFromParsecParser parseLovelace) $ mconcat @@ -3207,7 +3207,7 @@ pDrepDeposit = , Opt.help "DRep deposit amount (same at registration and retirement)." ] -pPoolDeposit :: Parser L.Coin +pPoolDeposit :: Parser Lovelace pPoolDeposit = Opt.option (readerFromParsecParser parseLovelace) $ mconcat @@ -3304,7 +3304,7 @@ pExtraEntropy = . BSC.pack =<< some Parsec.hexDigit -pUTxOCostPerByte :: Parser L.Coin +pUTxOCostPerByte :: Parser Lovelace pUTxOCostPerByte = Opt.option (readerFromParsecParser parseLovelace) $ mconcat @@ -3601,7 +3601,7 @@ pGovActionLifetime = , Opt.help "Maximal lifetime of governance actions, in epochs." ] -pDRepDeposit :: Parser L.Coin +pDRepDeposit :: Parser Lovelace pDRepDeposit = Opt.option (readerFromParsecParser parseLovelace) $ mconcat @@ -3710,13 +3710,13 @@ pAlwaysNoConfidence = , Opt.help "Always vote no confidence" ] -pDrepRefund :: Parser (DRepHashSource, L.Coin) +pDrepRefund :: Parser (DRepHashSource, Lovelace) pDrepRefund = (,) <$> pDRepHashSource <*> pDepositRefund -pDepositRefund :: Parser L.Coin +pDepositRefund :: Parser Lovelace pDepositRefund = Opt.option (readerFromParsecParser parseLovelace) $ mconcat diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Run/Genesis.hs b/cardano-cli/src/Cardano/CLI/EraBased/Run/Genesis.hs index 1a6e2edf23..f899aac9c6 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Run/Genesis.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Run/Genesis.hs @@ -729,7 +729,7 @@ updateOutputTemplate -- ^ System start time -> Map (Hash GenesisKey) (Hash GenesisDelegateKey, Hash VrfKey) -- ^ Genesis delegation (not stake-based) - -> Maybe L.Coin + -> Maybe Lovelace -- ^ Amount of lovelace not delegated -> Int -- ^ Number of UTxO addresses that are delegating @@ -739,7 +739,7 @@ updateOutputTemplate -- ^ Pool map -> [(L.KeyHash 'L.Staking L.StandardCrypto, L.KeyHash 'L.StakePool L.StandardCrypto)] -- ^ Delegaton map - -> Maybe L.Coin + -> Maybe Lovelace -- ^ Amount of lovelace to delegate -> Int -- ^ Number of UTxO address for delegation @@ -794,13 +794,13 @@ updateOutputTemplate nonDelegCoin = fromIntegral (maybe maximumLovelaceSupply unLovelace mAmountNonDeleg) delegCoin = maybe 0 fromIntegral amountDeleg - distribute :: Integer -> Int -> [AddressInEra ShelleyEra] -> [(AddressInEra ShelleyEra, L.Coin)] + distribute :: Integer -> Int -> [AddressInEra ShelleyEra] -> [(AddressInEra ShelleyEra, Lovelace)] distribute funds nAddrs addrs = zip addrs (fmap L.Coin (coinPerAddr + remainder : repeat coinPerAddr)) where coinPerAddr, remainder :: Integer (coinPerAddr, remainder) = funds `divMod` fromIntegral nAddrs - mkStuffedUtxo :: [AddressInEra ShelleyEra] -> [(AddressInEra ShelleyEra, L.Coin)] + mkStuffedUtxo :: [AddressInEra ShelleyEra] -> [(AddressInEra ShelleyEra, Lovelace)] mkStuffedUtxo xs = (,L.Coin minUtxoVal) <$> xs where L.Coin minUtxoVal = sgProtocolParams ^. L.ppMinUTxOValueL @@ -814,7 +814,7 @@ updateOutputTemplate toList genDelegMap ] - unLovelace :: Integral a => L.Coin -> a + unLovelace :: Integral a => Lovelace -> a unLovelace (L.Coin coin) = fromIntegral coin createDelegateKeys :: KeyOutputFormat -> FilePath -> Word -> ExceptT GenesisCmdError IO () @@ -1047,13 +1047,13 @@ updateTemplate -- ^ System start time -> Map (Hash GenesisKey) (Hash GenesisDelegateKey, Hash VrfKey) -- ^ Genesis delegation (not stake-based) - -> Maybe L.Coin + -> Maybe Lovelace -- ^ Amount of lovelace not delegated -> [AddressInEra ShelleyEra] -- ^ UTxO addresses that are not delegating -> Map (L.KeyHash 'L.Staking L.StandardCrypto) (L.PoolParams L.StandardCrypto) -- ^ Genesis staking: pools/delegation map & delegated initial UTxO spec - -> L.Coin + -> Lovelace -- ^ Number of UTxO Addresses for delegation -> [AddressInEra ShelleyEra] -- ^ UTxO Addresses for delegation @@ -1109,7 +1109,7 @@ updateTemplate nonDelegCoin = fromIntegral (maybe maximumLovelaceSupply unLovelace mAmountNonDeleg) delegCoin = fromIntegral amountDeleg - distribute :: Integer -> [AddressInEra ShelleyEra] -> [(AddressInEra ShelleyEra, L.Coin)] + distribute :: Integer -> [AddressInEra ShelleyEra] -> [(AddressInEra ShelleyEra, Lovelace)] distribute funds addrs = fst $ List.foldl' folder ([], fromIntegral funds) addrs where @@ -1119,15 +1119,15 @@ updateTemplate splitThreshold = coinPerAddr + nAddrs folder - :: ([(AddressInEra ShelleyEra, L.Coin)], Integer) + :: ([(AddressInEra ShelleyEra, Lovelace)], Integer) -> AddressInEra ShelleyEra - -> ([(AddressInEra ShelleyEra, L.Coin)], Integer) + -> ([(AddressInEra ShelleyEra, Lovelace)], Integer) folder (acc, rest) addr | rest > splitThreshold = ((addr, L.Coin coinPerAddr) : acc, rest - coinPerAddr) | otherwise = ((addr, L.Coin rest) : acc, 0) - mkStuffedUtxo :: [AddressInEra ShelleyEra] -> [(AddressInEra ShelleyEra, L.Coin)] + mkStuffedUtxo :: [AddressInEra ShelleyEra] -> [(AddressInEra ShelleyEra, Lovelace)] mkStuffedUtxo xs = (,L.Coin minUtxoVal) <$> xs where L.Coin minUtxoVal = sgProtocolParams template ^. L.ppMinUTxOValueL @@ -1141,7 +1141,7 @@ updateTemplate toList genDelegMap ] - unLovelace :: Integral a => L.Coin -> a + unLovelace :: Integral a => Lovelace -> a unLovelace (L.Coin coin) = fromIntegral coin writeFileGenesis diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Run/Genesis/CreateTestnetData.hs b/cardano-cli/src/Cardano/CLI/EraBased/Run/Genesis/CreateTestnetData.hs index d7e8514470..62032e0a79 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Run/Genesis/CreateTestnetData.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Run/Genesis/CreateTestnetData.hs @@ -359,7 +359,7 @@ runGenesisCreateTestNetDataCmd ) initialDReps - :: L.Coin + :: Lovelace -> [VerificationKey DRepKey] -> ListMap (L.Credential L.DRepRole L.StandardCrypto) (L.DRepState L.StandardCrypto) initialDReps minDeposit = @@ -665,7 +665,7 @@ updateOutputTemplate -- ^ System start time -> Map (Hash GenesisKey) (Hash GenesisDelegateKey, Hash VrfKey) -- ^ Genesis delegation (not stake-based) - -> Maybe L.Coin + -> Maybe Lovelace -- ^ Total amount of lovelace -> [AddressInEra ShelleyEra] -- ^ UTxO addresses that are not delegating @@ -673,7 +673,7 @@ updateOutputTemplate -- ^ Pool map -> [(L.KeyHash 'L.Staking L.StandardCrypto, L.KeyHash 'L.StakePool L.StandardCrypto)] -- ^ Delegaton map - -> Maybe L.Coin + -> Maybe Lovelace -- ^ Amount of lovelace to delegate -> Int -- ^ Number of UTxO address for delegation @@ -743,14 +743,14 @@ updateOutputTemplate -- Since the user can specify total supply and delegated amount, the non-delegated amount is: nonDelegCoinRaw = totalSupply - delegCoinRaw - distribute :: Natural -> Int -> [AddressInEra ShelleyEra] -> [(AddressInEra ShelleyEra, L.Coin)] + distribute :: Natural -> Int -> [AddressInEra ShelleyEra] -> [(AddressInEra ShelleyEra, Lovelace)] distribute funds nAddrs addrs = zip addrs $ L.Coin . toInteger <$> (coinPerAddr + remainder : repeat coinPerAddr) where coinPerAddr, remainder :: Natural (coinPerAddr, remainder) = funds `divMod` fromIntegral nAddrs - mkStuffedUtxo :: [AddressInEra ShelleyEra] -> [(AddressInEra ShelleyEra, L.Coin)] + mkStuffedUtxo :: [AddressInEra ShelleyEra] -> [(AddressInEra ShelleyEra, Lovelace)] mkStuffedUtxo xs = (,L.Coin minUtxoVal) <$> xs where L.Coin minUtxoVal = sgProtocolParams ^. L.ppMinUTxOValueL @@ -763,7 +763,7 @@ updateOutputTemplate toList genDelegMap ] - unLovelace :: Integral a => L.Coin -> a + unLovelace :: Integral a => Lovelace -> a unLovelace (L.Coin coin) = fromIntegral coin readGenDelegsMap diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Run/Governance.hs b/cardano-cli/src/Cardano/CLI/EraBased/Run/Governance.hs index 18bd606d4d..c982858983 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Run/Governance.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Run/Governance.hs @@ -69,7 +69,7 @@ runGovernanceMIRCertificatePayStakeAddrs -> L.MIRPot -> [StakeAddress] -- ^ Stake addresses - -> [L.Coin] + -> [Lovelace] -- ^ Corresponding reward amounts (same length) -> File () Out -> ExceptT GovernanceCmdError IO () @@ -105,7 +105,7 @@ runGovernanceMIRCertificatePayStakeAddrs w mirPot sAddrs rwdAmts oFp = do runGovernanceCreateMirCertificateTransferToTreasuryCmd :: () => ShelleyToBabbageEra era - -> L.Coin + -> Lovelace -> File () Out -> ExceptT GovernanceCmdError IO () runGovernanceCreateMirCertificateTransferToTreasuryCmd w ll oFp = do @@ -125,7 +125,7 @@ runGovernanceCreateMirCertificateTransferToTreasuryCmd w ll oFp = do runGovernanceCreateMirCertificateTransferToReservesCmd :: () => ShelleyToBabbageEra era - -> L.Coin + -> Lovelace -> File () Out -> ExceptT GovernanceCmdError IO () runGovernanceCreateMirCertificateTransferToReservesCmd w ll oFp = do diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Run/Query.hs b/cardano-cli/src/Cardano/CLI/EraBased/Run/Query.hs index 2302e18836..c75595126b 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Run/Query.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Run/Query.hs @@ -986,7 +986,7 @@ writeStakeAddressInfo :: ShelleyBasedEra era -> Maybe (File () Out) -> DelegationsAndRewards - -> Map StakeAddress L.Coin + -> Map StakeAddress Lovelace -- ^ deposits -> Map StakeAddress (L.DRep L.StandardCrypto) -- ^ vote delegatees @@ -1035,7 +1035,7 @@ writeStakeAddressInfo friendlyDRep (L.DRepCredential cred) = L.credToText cred -- this will pring "keyHash-..." or "scriptHash-...", depending on the type of credential merged - :: [(StakeAddress, Maybe L.Coin, Maybe PoolId, Maybe (L.DRep L.StandardCrypto), Maybe L.Coin)] + :: [(StakeAddress, Maybe Lovelace, Maybe PoolId, Maybe (L.DRep L.StandardCrypto), Maybe Lovelace)] merged = [ (addr, mBalance, mPoolId, mDRep, mDeposit) | addr <- @@ -1661,7 +1661,7 @@ runQueryDRepState where toDRepStateOutput :: () - => Map (L.DRep StandardCrypto) L.Coin + => Map (L.DRep StandardCrypto) Lovelace -> (L.Credential L.DRepRole StandardCrypto, L.DRepState StandardCrypto) -> QueryDRepStateOutput toDRepStateOutput stakeDistr (cred, ds) = diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Run/StakeAddress.hs b/cardano-cli/src/Cardano/CLI/EraBased/Run/StakeAddress.hs index 9ce90fc675..d4bb27e9fa 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Run/StakeAddress.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Run/StakeAddress.hs @@ -131,7 +131,7 @@ runStakeAddressRegistrationCertificateCmd :: () => ShelleyBasedEra era -> StakeIdentifier - -> Maybe L.Coin + -> Maybe Lovelace -- ^ Deposit required in conway era -> File () Out -> ExceptT StakeAddressCmdError IO () @@ -160,7 +160,7 @@ createRegistrationCertRequirements :: () => ShelleyBasedEra era -> StakeCredential - -> Maybe L.Coin + -> Maybe Lovelace -- ^ Deposit required in conway era -> Either StakeAddressRegistrationError (StakeAddressRequirements era) createRegistrationCertRequirements sbe stakeCred mdeposit = @@ -301,7 +301,7 @@ runStakeAddressDeregistrationCertificateCmd :: () => ShelleyBasedEra era -> StakeIdentifier - -> Maybe L.Coin + -> Maybe Lovelace -- ^ Deposit required in conway era -> File () Out -> ExceptT StakeAddressCmdError IO () diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Run/Transaction.hs b/cardano-cli/src/Cardano/CLI/EraBased/Run/Transaction.hs index da45fe7868..9f8e7a4a8f 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Run/Transaction.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Run/Transaction.hs @@ -495,7 +495,7 @@ getConwayDeregistrationPoolId cert = do getDRepDeregistrationInfo :: Certificate era - -> Maybe (L.Credential L.DRepRole L.StandardCrypto, L.Coin) + -> Maybe (L.Credential L.DRepRole L.StandardCrypto, Lovelace) getDRepDeregistrationInfo ShelleyRelatedCertificate{} = Nothing getDRepDeregistrationInfo (ConwayCertificate w cert) = conwayEraOnwardsConstraints w $ getConwayDRepDeregistrationInfo cert @@ -505,12 +505,12 @@ getConwayDRepDeregistrationInfo => L.TxCert (ShelleyLedgerEra era) ~ L.ConwayTxCert (ShelleyLedgerEra era) => L.ConwayEraTxCert (ShelleyLedgerEra era) => L.ConwayTxCert (ShelleyLedgerEra era) - -> Maybe (L.Credential L.DRepRole L.StandardCrypto, L.Coin) + -> Maybe (L.Credential L.DRepRole L.StandardCrypto, Lovelace) getConwayDRepDeregistrationInfo = L.getUnRegDRepTxCert getStakeDeregistrationInfo :: Certificate era - -> Maybe (StakeCredential, L.Coin) + -> Maybe (StakeCredential, Lovelace) getStakeDeregistrationInfo (ShelleyRelatedCertificate w cert) = shelleyToBabbageEraConstraints w $ getShelleyDeregistrationInfo cert getStakeDeregistrationInfo (ConwayCertificate w cert) = @@ -523,7 +523,7 @@ getShelleyDeregistrationInfo => L.ShelleyEraTxCert (ShelleyLedgerEra era) => L.TxCert (ShelleyLedgerEra era) ~ L.ShelleyTxCert (ShelleyLedgerEra era) => L.ShelleyTxCert (ShelleyLedgerEra era) - -> Maybe (StakeCredential, L.Coin) + -> Maybe (StakeCredential, Lovelace) getShelleyDeregistrationInfo cert = do case cert of L.UnRegTxCert stakeCred -> Just (fromShelleyStakeCredential stakeCred, 0) @@ -534,7 +534,7 @@ getConwayDeregistrationInfo => L.TxCert (ShelleyLedgerEra era) ~ L.ConwayTxCert (ShelleyLedgerEra era) => L.ConwayEraTxCert (ShelleyLedgerEra era) => L.ConwayTxCert (ShelleyLedgerEra era) - -> Maybe (StakeCredential, L.Coin) + -> Maybe (StakeCredential, Lovelace) getConwayDeregistrationInfo cert = do case cert of L.UnRegDepositTxCert stakeCred depositRefund -> Just (fromShelleyStakeCredential stakeCred, depositRefund) @@ -686,20 +686,20 @@ runTxBuildRaw -- ^ TxIn for collateral -> Maybe (TxOut CtxTx era) -- ^ Return collateral - -> Maybe L.Coin + -> Maybe Lovelace -- ^ Total collateral -> [TxOut CtxTx era] -> Maybe SlotNo -- ^ Tx lower bound -> TxValidityUpperBound era -- ^ Tx upper bound - -> L.Coin + -> Lovelace -- ^ Tx fee -> (Value, [ScriptWitness WitCtxMint era]) -- ^ Multi-Asset value(s) -> [(Certificate era, Maybe (ScriptWitness WitCtxStake era))] -- ^ Certificate with potential script witness - -> [(StakeAddress, L.Coin, Maybe (ScriptWitness WitCtxStake era))] + -> [(StakeAddress, Lovelace, Maybe (ScriptWitness WitCtxStake era))] -> [Hash PaymentKey] -- ^ Required signers -> TxAuxScripts era @@ -773,7 +773,7 @@ constructTxBodyContent -- ^ TxIn for collateral -> Maybe (TxOut CtxTx era) -- ^ Return collateral - -> Maybe L.Coin + -> Maybe Lovelace -- ^ Total collateral -> [TxOut CtxTx era] -- ^ Normal outputs @@ -785,11 +785,11 @@ constructTxBodyContent -- ^ Multi-Asset value(s) -> [(Certificate era, Maybe (ScriptWitness WitCtxStake era))] -- ^ Certificate with potential script witness - -> [(StakeAddress, L.Coin, Maybe (ScriptWitness WitCtxStake era))] + -> [(StakeAddress, Lovelace, Maybe (ScriptWitness WitCtxStake era))] -- ^ Withdrawals -> [Hash PaymentKey] -- ^ Required signers - -> L.Coin + -> Lovelace -- ^ Tx fee -> TxAuxScripts era -> TxMetadataInEra era @@ -893,8 +893,8 @@ constructTxBodyContent ) where convertWithdrawals - :: (StakeAddress, L.Coin, Maybe (ScriptWitness WitCtxStake era)) - -> (StakeAddress, L.Coin, BuildTxWith BuildTx (Witness WitCtxStake era)) + :: (StakeAddress, Lovelace, Maybe (ScriptWitness WitCtxStake era)) + -> (StakeAddress, Lovelace, BuildTxWith BuildTx (Witness WitCtxStake era)) convertWithdrawals (sAddr, ll, mScriptWitnessFiles) = case mScriptWitnessFiles of Just sWit -> (sAddr, ll, BuildTxWith $ ScriptWitness ScriptWitnessForStakeAddr sWit) @@ -915,7 +915,7 @@ runTxBuild -- ^ TxIn for collateral -> Maybe (TxOut CtxTx era) -- ^ Return collateral - -> Maybe L.Coin + -> Maybe Lovelace -- ^ Total collateral -> [TxOut CtxTx era] -- ^ Normal outputs @@ -929,7 +929,7 @@ runTxBuild -- ^ Tx upper bound -> [(Certificate era, Maybe (ScriptWitness WitCtxStake era))] -- ^ Certificate with potential script witness - -> [(StakeAddress, L.Coin, Maybe (ScriptWitness WitCtxStake era))] + -> [(StakeAddress, Lovelace, Maybe (ScriptWitness WitCtxStake era))] -> [Hash PaymentKey] -- ^ Required signers -> TxAuxScripts era @@ -1144,7 +1144,7 @@ getAllReferenceInputs :: [(TxIn, Maybe (ScriptWitness WitCtxTxIn era))] -> [ScriptWitness WitCtxMint era] -> [(Certificate era, Maybe (ScriptWitness WitCtxStake era))] - -> [(StakeAddress, L.Coin, Maybe (ScriptWitness WitCtxStake era))] + -> [(StakeAddress, Lovelace, Maybe (ScriptWitness WitCtxStake era))] -> [(VotingProcedures era, Maybe (ScriptWitness WitCtxStake era))] -> [(Proposal era, Maybe (ScriptWitness WitCtxStake era))] -> [TxIn] @@ -1542,11 +1542,11 @@ runTransactionCalculateMinFeeCmd -- TODO: move this to Cardano.API.Fee.evaluateTransactionFee. calculateByronWitnessFees :: () - => L.Coin + => Lovelace -- ^ The tx fee per byte (from protocol parameters) -> Int -- ^ The number of Byron key witnesses - -> L.Coin + -> Lovelace calculateByronWitnessFees txFeePerByte byronwitcount = L.Coin $ toInteger txFeePerByte diff --git a/cardano-cli/src/Cardano/CLI/Json/Friendly.hs b/cardano-cli/src/Cardano/CLI/Json/Friendly.hs index c879bc51a4..44246a68ce 100644 --- a/cardano-cli/src/Cardano/CLI/Json/Friendly.hs +++ b/cardano-cli/src/Cardano/CLI/Json/Friendly.hs @@ -703,7 +703,7 @@ friendlyFee :: TxFee era -> Aeson.Value friendlyFee = \case TxFeeExplicit _ fee -> friendlyLovelace fee -friendlyLovelace :: L.Coin -> Aeson.Value +friendlyLovelace :: Lovelace -> Aeson.Value friendlyLovelace value = String $ docToText (pretty value) friendlyMintValue :: TxMintValue ViewTx era -> Aeson.Value diff --git a/cardano-cli/src/Cardano/CLI/Legacy/Run/Governance.hs b/cardano-cli/src/Cardano/CLI/Legacy/Run/Governance.hs index 7856541064..cf6c5f5a13 100644 --- a/cardano-cli/src/Cardano/CLI/Legacy/Run/Governance.hs +++ b/cardano-cli/src/Cardano/CLI/Legacy/Run/Governance.hs @@ -101,7 +101,7 @@ runLegacyGovernanceMIRCertificatePayStakeAddrs -> L.MIRPot -> [StakeAddress] -- ^ Stake addresses - -> [L.Coin] + -> [Lovelace] -- ^ Corresponding reward amounts (same length) -> File () Out -> ExceptT GovernanceCmdError IO () @@ -110,7 +110,7 @@ runLegacyGovernanceMIRCertificatePayStakeAddrs (EraInEon w) = runLegacyGovernanceCreateMirCertificateTransferToTreasuryCmd :: EraInEon ShelleyToBabbageEra - -> L.Coin + -> Lovelace -> File () Out -> ExceptT GovernanceCmdError IO () runLegacyGovernanceCreateMirCertificateTransferToTreasuryCmd (EraInEon w) = @@ -118,7 +118,7 @@ runLegacyGovernanceCreateMirCertificateTransferToTreasuryCmd (EraInEon w) = runLegacyGovernanceCreateMirCertificateTransferToReservesCmd :: EraInEon ShelleyToBabbageEra - -> L.Coin + -> Lovelace -> File () Out -> ExceptT GovernanceCmdError IO () runLegacyGovernanceCreateMirCertificateTransferToReservesCmd (EraInEon w) = diff --git a/cardano-cli/src/Cardano/CLI/Legacy/Run/StakePool.hs b/cardano-cli/src/Cardano/CLI/Legacy/Run/StakePool.hs index 2849e4b903..7ffe0bbb44 100644 --- a/cardano-cli/src/Cardano/CLI/Legacy/Run/StakePool.hs +++ b/cardano-cli/src/Cardano/CLI/Legacy/Run/StakePool.hs @@ -66,9 +66,9 @@ runLegacyStakePoolRegistrationCertificateCmd -- ^ Stake pool verification key. -> VerificationKeyOrFile VrfKey -- ^ VRF Verification key. - -> L.Coin + -> Lovelace -- ^ Pool pledge. - -> L.Coin + -> Lovelace -- ^ Pool cost. -> Rational -- ^ Pool margin. diff --git a/cardano-cli/src/Cardano/CLI/Types/Common.hs b/cardano-cli/src/Cardano/CLI/Types/Common.hs index 13bd306734..ac8229ba10 100644 --- a/cardano-cli/src/Cardano/CLI/Types/Common.hs +++ b/cardano-cli/src/Cardano/CLI/Types/Common.hs @@ -502,7 +502,7 @@ type TxBodyFile = File (TxBody ()) type TxFile = File (Tx ()) -newtype TxTreasuryDonation = TxTreasuryDonation {unTxTreasuryDonation :: L.Coin} +newtype TxTreasuryDonation = TxTreasuryDonation {unTxTreasuryDonation :: Lovelace} deriving Show data TxMempoolQuery diff --git a/cardano-cli/src/Cardano/CLI/Types/Errors/TxValidationError.hs b/cardano-cli/src/Cardano/CLI/Types/Errors/TxValidationError.hs index 5cd1c6a2ca..35ea7ff331 100644 --- a/cardano-cli/src/Cardano/CLI/Types/Errors/TxValidationError.hs +++ b/cardano-cli/src/Cardano/CLI/Types/Errors/TxValidationError.hs @@ -24,7 +24,6 @@ module Cardano.CLI.Types.Errors.TxValidationError where import Cardano.Api -import qualified Cardano.Api.Ledger as L import Cardano.Api.Shelley import Cardano.CLI.Types.Common @@ -87,7 +86,7 @@ instance Error (TxNotSupportedInEraValidationError era) where validateTxTotalCollateral :: ShelleyBasedEra era - -> Maybe L.Coin + -> Maybe Lovelace -> Either (TxNotSupportedInEraValidationError era) (TxTotalCollateral era) validateTxTotalCollateral _ Nothing = return TxTotalCollateralNone validateTxTotalCollateral sbe (Just coll) = do @@ -102,7 +101,7 @@ validateTxCurrentTreasuryValue -> Maybe TxCurrentTreasuryValue -> Either (TxNotSupportedInEraValidationError era) - (Maybe (Featured ConwayEraOnwards era (Maybe L.Coin))) + (Maybe (Featured ConwayEraOnwards era (Maybe Lovelace))) validateTxCurrentTreasuryValue sbe mCurrentTreasuryValue = case mCurrentTreasuryValue of Nothing -> Right Nothing @@ -116,7 +115,7 @@ validateTxTreasuryDonation :: () => ShelleyBasedEra era -> Maybe TxTreasuryDonation - -> Either (TxNotSupportedInEraValidationError era) (Maybe (Featured ConwayEraOnwards era L.Coin)) + -> Either (TxNotSupportedInEraValidationError era) (Maybe (Featured ConwayEraOnwards era Lovelace)) validateTxTreasuryDonation sbe mTreasuryDonation = case mTreasuryDonation of Nothing -> Right Nothing diff --git a/cardano-cli/src/Cardano/CLI/Types/Key.hs b/cardano-cli/src/Cardano/CLI/Types/Key.hs index 1f96066b00..e024c74561 100644 --- a/cardano-cli/src/Cardano/CLI/Types/Key.hs +++ b/cardano-cli/src/Cardano/CLI/Types/Key.hs @@ -134,9 +134,9 @@ data StakePoolRegistrationParserRequirements -- ^ Stake pool verification key. , sprVrfKey :: VerificationKeyOrFile VrfKey -- ^ VRF Verification key. - , sprPoolPledge :: L.Coin + , sprPoolPledge :: Lovelace -- ^ Pool pledge. - , sprPoolCost :: L.Coin + , sprPoolCost :: Lovelace -- ^ Pool cost. , sprPoolMargin :: Rational -- ^ Pool margin. diff --git a/cardano-cli/src/Cardano/CLI/Types/Output.hs b/cardano-cli/src/Cardano/CLI/Types/Output.hs index bab3e2c6b0..1e9c5d1240 100644 --- a/cardano-cli/src/Cardano/CLI/Types/Output.hs +++ b/cardano-cli/src/Cardano/CLI/Types/Output.hs @@ -179,10 +179,10 @@ data QueryDRepStateOutput -- ^ Expiry (Maybe (L.Anchor L.StandardCrypto)) -- ^ Anchor - L.Coin + Lovelace -- ^ Deposit IncludeStake - (Maybe L.Coin) + (Maybe Lovelace) -- ^ Stake instance ToJSON QueryDRepStateOutput where @@ -300,7 +300,7 @@ data ScriptCostOutput = ScriptCostOutput { scScriptHash :: ScriptHash , scExecutionUnits :: ExecutionUnits - , scAda :: L.Coin + , scAda :: Lovelace } instance ToJSON ScriptCostOutput where From 1935756dfe141e2ee1e7e26e663335a8b0d76f6b Mon Sep 17 00:00:00 2001 From: Mateusz Galazyn Date: Tue, 13 Aug 2024 13:26:45 +0200 Subject: [PATCH 3/3] Refactor: Replace ListMap.toList, ListMap.fromList with IsList(toList,fromList) --- cardano-cli/cardano-cli.cabal | 1 - cardano-cli/src/Cardano/CLI/EraBased/Run/Genesis.hs | 6 +++--- .../Cardano/CLI/EraBased/Run/Genesis/CreateTestnetData.hs | 7 +++---- cardano-cli/src/Cardano/CLI/EraBased/Run/Query.hs | 7 +++---- cardano-cli/src/Cardano/CLI/EraBased/Run/Transaction.hs | 3 ++- .../cardano-cli-golden/Test/Golden/CreateTestnetData.hs | 4 ++-- 6 files changed, 13 insertions(+), 15 deletions(-) diff --git a/cardano-cli/cardano-cli.cabal b/cardano-cli/cardano-cli.cabal index 2db3b28141..7311278654 100644 --- a/cardano-cli/cardano-cli.cabal +++ b/cardano-cli/cardano-cli.cabal @@ -372,7 +372,6 @@ test-suite cardano-cli-golden cardano-cli, cardano-cli:cardano-cli-test-lib, cardano-crypto-wrapper, - cardano-data >=1.1, cardano-ledger-byron, cardano-ledger-shelley >=1.10.0.0, cardano-strict-containers ^>=0.1, diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Run/Genesis.hs b/cardano-cli/src/Cardano/CLI/EraBased/Run/Genesis.hs index f899aac9c6..8949681677 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Run/Genesis.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Run/Genesis.hs @@ -769,7 +769,7 @@ updateOutputTemplate , sgMaxLovelaceSupply = fromIntegral $ nonDelegCoin + delegCoin , sgGenDelegs = shelleyDelKeys , sgInitialFunds = - ListMap.fromList + fromList [ (toShelleyAddr addr, v) | (addr, v) <- distribute (nonDelegCoin - subtractForTreasury) nUtxoAddrsNonDeleg utxoAddrsNonDeleg @@ -1080,7 +1080,7 @@ updateTemplate , sgMaxLovelaceSupply = fromIntegral $ nonDelegCoin + delegCoin , sgGenDelegs = shelleyDelKeys , sgInitialFunds = - ListMap.fromList + fromList [ (toShelleyAddr addr, v) | (addr, v) <- distribute (nonDelegCoin - subtractForTreasury) utxoAddrsNonDeleg @@ -1090,7 +1090,7 @@ updateTemplate , sgStaking = ShelleyGenesisStaking { sgsPools = - ListMap.fromList + fromList [ (L.ppId poolParams, poolParams) | poolParams <- Map.elems poolSpecs ] diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Run/Genesis/CreateTestnetData.hs b/cardano-cli/src/Cardano/CLI/EraBased/Run/Genesis/CreateTestnetData.hs index 62032e0a79..98973134de 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Run/Genesis/CreateTestnetData.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Run/Genesis/CreateTestnetData.hs @@ -57,7 +57,6 @@ import qualified Data.Aeson as Aeson import Data.Bifunctor (Bifunctor (..)) import qualified Data.ByteString.Lazy.Char8 as LBS import Data.ListMap (ListMap (..)) -import qualified Data.ListMap as ListMap import Data.Map.Strict (Map) import qualified Data.Map.Strict as Map import Data.Maybe (fromMaybe) @@ -351,7 +350,7 @@ runGenesisCreateTestNetDataCmd :: [(VerificationKey StakeKey, VerificationKey DRepKey)] -> ListMap (L.Credential L.Staking L.StandardCrypto) (L.Delegatee L.StandardCrypto) delegs = - ListMap.fromList + fromList . map ( bimap verificationKeytoStakeCredential @@ -363,7 +362,7 @@ runGenesisCreateTestNetDataCmd -> [VerificationKey DRepKey] -> ListMap (L.Credential L.DRepRole L.StandardCrypto) (L.DRepState L.StandardCrypto) initialDReps minDeposit = - ListMap.fromList + fromList . map ( \c -> ( verificationKeyToDRepCredential c @@ -706,7 +705,7 @@ updateOutputTemplate , sgMaxLovelaceSupply = totalSupply , sgGenDelegs = shelleyDelKeys , sgInitialFunds = - ListMap.fromList + fromList [ (toShelleyAddr addr, v) | (addr, v) <- distribute nonDelegCoin nUtxoAddrsNonDeleg utxoAddrsNonDeleg diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Run/Query.hs b/cardano-cli/src/Cardano/CLI/EraBased/Run/Query.hs index c75595126b..d448a65b93 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Run/Query.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Run/Query.hs @@ -1107,10 +1107,9 @@ writePoolState mOutFile serialisedCurrentEpochState = do let hks :: [L.KeyHash L.StakePool StandardCrypto] hks = toList $ - fromList @(Set (L.KeyHash L.StakePool StandardCrypto)) $ - Map.keys (L.psStakePoolParams poolState) - <> Map.keys (L.psFutureStakePoolParams poolState) - <> Map.keys (L.psRetiring poolState) + Map.keysSet (L.psStakePoolParams poolState) + <> Map.keysSet (L.psFutureStakePoolParams poolState) + <> Map.keysSet (L.psRetiring poolState) let poolStates :: Map (L.KeyHash 'L.StakePool StandardCrypto) (Params StandardCrypto) poolStates = diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Run/Transaction.hs b/cardano-cli/src/Cardano/CLI/EraBased/Run/Transaction.hs index 9f8e7a4a8f..a1261e89f0 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Run/Transaction.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Run/Transaction.hs @@ -64,6 +64,7 @@ import Data.Bifunctor (Bifunctor (..)) import qualified Data.ByteString as Data.Bytestring import qualified Data.ByteString.Char8 as BS import qualified Data.ByteString.Lazy.Char8 as LBS +import Data.Containers.ListUtils (nubOrd) import Data.Data ((:~:) (..)) import qualified Data.Foldable as Foldable import Data.Function ((&)) @@ -199,7 +200,7 @@ runTransactionBuildCmd <$> readTxGovernanceActions eon proposalFiles -- the same collateral input can be used for several plutus scripts - let filteredTxinsc = toList @(Set _) $ fromList txinsc + let filteredTxinsc = nubOrd txinsc let allReferenceInputs = getAllReferenceInputs diff --git a/cardano-cli/test/cardano-cli-golden/Test/Golden/CreateTestnetData.hs b/cardano-cli/test/cardano-cli-golden/Test/Golden/CreateTestnetData.hs index 8cd2d32e66..c7ca5a7bb9 100644 --- a/cardano-cli/test/cardano-cli-golden/Test/Golden/CreateTestnetData.hs +++ b/cardano-cli/test/cardano-cli-golden/Test/Golden/CreateTestnetData.hs @@ -11,9 +11,9 @@ import qualified Cardano.Ledger.Shelley.API as L import Control.Monad import Control.Monad.IO.Class import Data.List (intercalate, sort) -import qualified Data.ListMap as ListMap import qualified Data.Sequence.Strict as Seq import Data.Word (Word32) +import GHC.Exts (IsList (..)) import System.Directory import System.Directory.Extra (listDirectories) import System.FilePath @@ -177,7 +177,7 @@ hprop_golden_create_testnet_data_deleg_non_deleg = -- Because we don't test this elsewhere in this file: (L.sgMaxLovelaceSupply genesis) H.=== (fromIntegral totalSupply) - let initialFunds = ListMap.toList $ L.sgInitialFunds genesis + let initialFunds = toList $ L.sgInitialFunds genesis -- This checks that there is actually only one funded address (length initialFunds) H.=== 1