diff --git a/cardano-api/cardano-api.cabal b/cardano-api/cardano-api.cabal index ee8ef2529e..21caf63a4a 100644 --- a/cardano-api/cardano-api.cabal +++ b/cardano-api/cardano-api.cabal @@ -176,9 +176,9 @@ library internal , ouroboros-network-framework , ouroboros-network-protocols , parsec - , plutus-ledger-api:{plutus-ledger-api, plutus-ledger-api-testlib} ^>= 1.9 + , plutus-ledger-api:{plutus-ledger-api, plutus-ledger-api-testlib} ^>= 1.13 , prettyprinter - , prettyprinter-configurable ^>= 1.9 + , prettyprinter-configurable ^>= 1.13 , random , scientific , serialise @@ -342,8 +342,8 @@ test-suite cardano-api-golden , hedgehog >= 1.1 , hedgehog-extras ^>= 0.4.7.0 , microlens - , plutus-core ^>= 1.9 - , plutus-ledger-api ^>= 1.9 + , plutus-core ^>= 1.13 + , plutus-ledger-api ^>= 1.13 , tasty , tasty-hedgehog , time diff --git a/cardano-api/internal/Cardano/Api/Feature/ConwayEraOnwards.hs b/cardano-api/internal/Cardano/Api/Feature/ConwayEraOnwards.hs index 4931988df7..ffa26d8709 100644 --- a/cardano-api/internal/Cardano/Api/Feature/ConwayEraOnwards.hs +++ b/cardano-api/internal/Cardano/Api/Feature/ConwayEraOnwards.hs @@ -31,6 +31,7 @@ import qualified Cardano.Ledger.Api as L import qualified Cardano.Ledger.BaseTypes as L import qualified Cardano.Ledger.Conway.Core as L import qualified Cardano.Ledger.Conway.Governance as L +import qualified Cardano.Ledger.Conway.PParams as L import qualified Cardano.Ledger.Conway.TxCert as L import qualified Cardano.Ledger.SafeHash as L import qualified Ouroboros.Consensus.Protocol.Abstract as Consensus diff --git a/cardano-api/internal/Cardano/Api/Governance/Actions/ProposalProcedure.hs b/cardano-api/internal/Cardano/Api/Governance/Actions/ProposalProcedure.hs index 37c814bf74..d502152d94 100644 --- a/cardano-api/internal/Cardano/Api/Governance/Actions/ProposalProcedure.hs +++ b/cardano-api/internal/Cardano/Api/Governance/Actions/ProposalProcedure.hs @@ -79,19 +79,15 @@ toGovernanceAction _ (ProposeNewConstitution prevGovAction anchor) = , Gov.constitutionScript = SNothing -- TODO: Conway era } toGovernanceAction _ (ProposeNewCommittee prevGovId oldCommitteeMembers newCommitteeMembers quor) = - Gov.NewCommittee - prevGovId - (Set.fromList $ map toCommitteeMember oldCommitteeMembers) - Gov.Committee - { Gov.committeeMembers = Map.mapKeys toCommitteeMember newCommitteeMembers - , Gov.committeeQuorum = - fromMaybe - (error $ mconcat ["toGovernanceAction: the given quorum " + Gov.UpdateCommittee + prevGovId -- previous governance action id + (Set.fromList $ map toCommitteeMember oldCommitteeMembers) -- members to remove + (Map.mapKeys toCommitteeMember newCommitteeMembers) -- members to add + (fromMaybe (error $ mconcat ["toGovernanceAction: the given quorum " , show quor , " was outside of the unit interval!" ]) - $ boundRational @UnitInterval quor - } + $ boundRational @UnitInterval quor) toGovernanceAction _ InfoAct = Gov.InfoAction toGovernanceAction _ (TreasuryWithdrawal withdrawals) = let m = Map.fromList [(L.mkRwdAcnt nw (toShelleyStakeCredential sc), toShelleyLovelace l) | (nw,sc,l) <- withdrawals] @@ -122,16 +118,12 @@ fromGovernanceAction sbe = \case | (rwdAcnt, coin) <- Map.toList withdrawlMap ] in TreasuryWithdrawal res - Gov.NewCommittee prevGovId oldCommitteeMembers newCommittee -> - let Gov.Committee - { Gov.committeeMembers = newCommitteeMembers - , Gov.committeeQuorum = quor - } = newCommittee - in ProposeNewCommittee - prevGovId - (map fromCommitteeMember $ Set.toList oldCommitteeMembers) - (Map.mapKeys fromCommitteeMember newCommitteeMembers) - (unboundRational quor) + Gov.UpdateCommittee prevGovId oldCommitteeMembers newCommitteeMembers quor -> + ProposeNewCommittee + prevGovId + (map fromCommitteeMember $ Set.toList oldCommitteeMembers) + (Map.mapKeys fromCommitteeMember newCommitteeMembers) + (unboundRational quor) Gov.InfoAction -> InfoAct diff --git a/cardano-api/internal/Cardano/Api/Orphans.hs b/cardano-api/internal/Cardano/Api/Orphans.hs index 4fb0a2b218..b3fe46a4cd 100644 --- a/cardano-api/internal/Cardano/Api/Orphans.hs +++ b/cardano-api/internal/Cardano/Api/Orphans.hs @@ -146,94 +146,94 @@ instance ToJSON (PraosState StandardCrypto) where -- In this instance we take the last 'Just' value or the only 'Just' value instance Semigroup (Ledger.ShelleyPParams StrictMaybe era) where (<>) pp1 pp2 = - let fsppMinFeeA = lastMappend (Ledger.sppMinFeeA pp1) (Ledger.sppMinFeeA pp2) - fsppMinFeeB = lastMappend (Ledger.sppMinFeeB pp1) (Ledger.sppMinFeeB pp2) - fsppMaxBBSize = lastMappend (Ledger.sppMaxBBSize pp1) (Ledger.sppMaxBBSize pp2) - fsppMaxTxSize = lastMappend (Ledger.sppMaxTxSize pp1) (Ledger.sppMaxTxSize pp2) - fsppMaxBHSize = lastMappend (Ledger.sppMaxBHSize pp1) (Ledger.sppMaxBHSize pp2) - fsppKeyDeposit = lastMappend (Ledger.sppKeyDeposit pp1) (Ledger.sppKeyDeposit pp2) - fsppPoolDeposit = lastMappend (Ledger.sppPoolDeposit pp1) (Ledger.sppPoolDeposit pp2) - fsppEMax = lastMappend (Ledger.sppEMax pp1) (Ledger.sppEMax pp2) - fsppNOpt = lastMappend (Ledger.sppNOpt pp1) (Ledger.sppNOpt pp2) - fsppA0 = lastMappend (Ledger.sppA0 pp1) (Ledger.sppA0 pp2) - fsppRho = lastMappend (Ledger.sppRho pp1) (Ledger.sppRho pp2) - fsppTau = lastMappend (Ledger.sppTau pp1) (Ledger.sppTau pp2) - fsppD = lastMappend (Ledger.sppD pp1) (Ledger.sppD pp2) - fsppExtraEntropy = lastMappend (Ledger.sppExtraEntropy pp1) (Ledger.sppExtraEntropy pp2) - fsppProtocolVersion = lastMappend (Ledger.sppProtocolVersion pp1) (Ledger.sppProtocolVersion pp2) - fsppMinUTxOValue = lastMappend (Ledger.sppMinUTxOValue pp1) (Ledger.sppMinUTxOValue pp2) - fsppMinPoolCost = lastMappend (Ledger.sppMinPoolCost pp1) (Ledger.sppMinPoolCost pp2) + let fsppMinFeeA = lastMappendUnder2 Ledger.sppMinFeeA pp1 pp2 + fsppMinFeeB = lastMappendUnder2 Ledger.sppMinFeeB pp1 pp2 + fsppMaxBBSize = lastMappendUnder2 Ledger.sppMaxBBSize pp1 pp2 + fsppMaxTxSize = lastMappendUnder2 Ledger.sppMaxTxSize pp1 pp2 + fsppMaxBHSize = lastMappendUnder2 Ledger.sppMaxBHSize pp1 pp2 + fsppKeyDeposit = lastMappendUnder2 Ledger.sppKeyDeposit pp1 pp2 + fsppPoolDeposit = lastMappendUnder2 Ledger.sppPoolDeposit pp1 pp2 + fsppEMax = lastMappendUnder2 Ledger.sppEMax pp1 pp2 + fsppNOpt = lastMappendUnder2 Ledger.sppNOpt pp1 pp2 + fsppA0 = lastMappendUnder2 Ledger.sppA0 pp1 pp2 + fsppRho = lastMappendUnder2 Ledger.sppRho pp1 pp2 + fsppTau = lastMappendUnder2 Ledger.sppTau pp1 pp2 + fsppD = lastMappendUnder2 Ledger.sppD pp1 pp2 + fsppExtraEntropy = lastMappendUnder2 Ledger.sppExtraEntropy pp1 pp2 + fsppProtocolVersion = lastMappendUnder2 Ledger.sppProtocolVersion pp1 pp2 + fsppMinUTxOValue = lastMappendUnder2 Ledger.sppMinUTxOValue pp1 pp2 + fsppMinPoolCost = lastMappendUnder2 Ledger.sppMinPoolCost pp1 pp2 in Ledger.ShelleyPParams - { Ledger.sppMinFeeA = fsppMinFeeA - , Ledger.sppMinFeeB = fsppMinFeeB - , Ledger.sppMaxBBSize = fsppMaxBBSize - , Ledger.sppMaxTxSize = fsppMaxTxSize - , Ledger.sppMaxBHSize = fsppMaxBHSize - , Ledger.sppKeyDeposit = fsppKeyDeposit - , Ledger.sppPoolDeposit = fsppPoolDeposit - , Ledger.sppEMax = fsppEMax - , Ledger.sppNOpt = fsppNOpt - , Ledger.sppA0 = fsppA0 - , Ledger.sppRho = fsppRho - , Ledger.sppTau = fsppTau - , Ledger.sppD = fsppD - , Ledger.sppExtraEntropy = fsppExtraEntropy + { Ledger.sppMinFeeA = fsppMinFeeA + , Ledger.sppMinFeeB = fsppMinFeeB + , Ledger.sppMaxBBSize = fsppMaxBBSize + , Ledger.sppMaxTxSize = fsppMaxTxSize + , Ledger.sppMaxBHSize = fsppMaxBHSize + , Ledger.sppKeyDeposit = fsppKeyDeposit + , Ledger.sppPoolDeposit = fsppPoolDeposit + , Ledger.sppEMax = fsppEMax + , Ledger.sppNOpt = fsppNOpt + , Ledger.sppA0 = fsppA0 + , Ledger.sppRho = fsppRho + , Ledger.sppTau = fsppTau + , Ledger.sppD = fsppD + , Ledger.sppExtraEntropy = fsppExtraEntropy , Ledger.sppProtocolVersion = fsppProtocolVersion - , Ledger.sppMinUTxOValue = fsppMinUTxOValue - , Ledger.sppMinPoolCost = fsppMinPoolCost + , Ledger.sppMinUTxOValue = fsppMinUTxOValue + , Ledger.sppMinPoolCost = fsppMinPoolCost } instance Semigroup (Ledger.AlonzoPParams StrictMaybe era) where (<>) p1 p2 = - let fappMinFeeA = lastMappend (Ledger.appMinFeeA p1) (Ledger.appMinFeeA p2) - fappMinFeeB = lastMappend (Ledger.appMinFeeB p1) (Ledger.appMinFeeB p2) - fappMaxBBSize = lastMappend (Ledger.appMaxBBSize p1) (Ledger.appMaxBBSize p2) - fappMaxTxSize = lastMappend (Ledger.appMaxTxSize p1) (Ledger.appMaxTxSize p2) - fappMaxBHSize = lastMappend (Ledger.appMaxBHSize p1) (Ledger.appMaxBHSize p2) - fappKeyDeposit = lastMappend (Ledger.appKeyDeposit p1) (Ledger.appKeyDeposit p2) - fappPoolDeposit = lastMappend (Ledger.appPoolDeposit p1) (Ledger.appPoolDeposit p2) - fappEMax = lastMappend (Ledger.appEMax p1) (Ledger.appEMax p2) - fappNOpt = lastMappend (Ledger.appNOpt p1) (Ledger.appNOpt p2) - fappA0 = lastMappend (Ledger.appA0 p1) (Ledger.appA0 p2) - fappRho = lastMappend (Ledger.appRho p1) (Ledger.appRho p2) - fappTau = lastMappend (Ledger.appTau p1) (Ledger.appTau p2) - fappD = lastMappend (Ledger.appD p1) (Ledger.appD p2) - fappExtraEntropy = lastMappend (Ledger.appExtraEntropy p1) (Ledger.appExtraEntropy p2) - fappProtocolVersion = lastMappend (Ledger.appProtocolVersion p1) (Ledger.appProtocolVersion p2) - fappMinPoolCost = lastMappend (Ledger.appMinPoolCost p1) (Ledger.appMinPoolCost p2) - fappCoinsPerUTxOWord = lastMappend (Ledger.appCoinsPerUTxOWord p1) (Ledger.appCoinsPerUTxOWord p2) - fappCostModels = lastMappend (Ledger.appCostModels p1) (Ledger.appCostModels p2) - fappPrices = lastMappend (Ledger.appPrices p1) (Ledger.appPrices p2) - fappMaxTxExUnits = lastMappend (Ledger.appMaxTxExUnits p1) (Ledger.appMaxTxExUnits p2) - fappMaxBlockExUnits = lastMappend (Ledger.appMaxBlockExUnits p1) (Ledger.appMaxBlockExUnits p2) - fappMaxValSize = lastMappend (Ledger.appMaxValSize p1) (Ledger.appMaxValSize p2) - fappCollateralPercentage = lastMappend (Ledger.appCollateralPercentage p1) (Ledger.appCollateralPercentage p2) - fappMaxCollateralInputs = lastMappend (Ledger.appMaxCollateralInputs p1) (Ledger.appMaxCollateralInputs p2) + let fappMinFeeA = lastMappendUnder2 Ledger.appMinFeeA p1 p2 + fappMinFeeB = lastMappendUnder2 Ledger.appMinFeeB p1 p2 + fappMaxBBSize = lastMappendUnder2 Ledger.appMaxBBSize p1 p2 + fappMaxTxSize = lastMappendUnder2 Ledger.appMaxTxSize p1 p2 + fappMaxBHSize = lastMappendUnder2 Ledger.appMaxBHSize p1 p2 + fappKeyDeposit = lastMappendUnder2 Ledger.appKeyDeposit p1 p2 + fappPoolDeposit = lastMappendUnder2 Ledger.appPoolDeposit p1 p2 + fappEMax = lastMappendUnder2 Ledger.appEMax p1 p2 + fappNOpt = lastMappendUnder2 Ledger.appNOpt p1 p2 + fappA0 = lastMappendUnder2 Ledger.appA0 p1 p2 + fappRho = lastMappendUnder2 Ledger.appRho p1 p2 + fappTau = lastMappendUnder2 Ledger.appTau p1 p2 + fappD = lastMappendUnder2 Ledger.appD p1 p2 + fappExtraEntropy = lastMappendUnder2 Ledger.appExtraEntropy p1 p2 + fappProtocolVersion = lastMappendUnder2 Ledger.appProtocolVersion p1 p2 + fappMinPoolCost = lastMappendUnder2 Ledger.appMinPoolCost p1 p2 + fappCoinsPerUTxOWord = lastMappendUnder2 Ledger.appCoinsPerUTxOWord p1 p2 + fappCostModels = lastMappendUnder2 Ledger.appCostModels p1 p2 + fappPrices = lastMappendUnder2 Ledger.appPrices p1 p2 + fappMaxTxExUnits = lastMappendUnder2 Ledger.appMaxTxExUnits p1 p2 + fappMaxBlockExUnits = lastMappendUnder2 Ledger.appMaxBlockExUnits p1 p2 + fappMaxValSize = lastMappendUnder2 Ledger.appMaxValSize p1 p2 + fappCollateralPercentage = lastMappendUnder2 Ledger.appCollateralPercentage p1 p2 + fappMaxCollateralInputs = lastMappendUnder2 Ledger.appMaxCollateralInputs p1 p2 in Ledger.AlonzoPParams - { Ledger.appMinFeeA = fappMinFeeA - , Ledger.appMinFeeB = fappMinFeeB - , Ledger.appMaxBBSize = fappMaxBBSize - , Ledger.appMaxTxSize = fappMaxTxSize - , Ledger.appMaxBHSize = fappMaxBHSize - , Ledger.appKeyDeposit = fappKeyDeposit - , Ledger.appPoolDeposit = fappPoolDeposit - , Ledger.appEMax = fappEMax - , Ledger.appNOpt = fappNOpt - , Ledger.appA0 = fappA0 - , Ledger.appRho = fappRho - , Ledger.appTau = fappTau - , Ledger.appD = fappD - , Ledger.appExtraEntropy = fappExtraEntropy - , Ledger.appProtocolVersion = fappProtocolVersion - , Ledger.appMinPoolCost = fappMinPoolCost - , Ledger.appCoinsPerUTxOWord = fappCoinsPerUTxOWord - , Ledger.appCostModels = fappCostModels - , Ledger.appPrices = fappPrices - , Ledger.appMaxTxExUnits = fappMaxTxExUnits - , Ledger.appMaxBlockExUnits = fappMaxBlockExUnits - , Ledger.appMaxValSize = fappMaxValSize + { Ledger.appMinFeeA = fappMinFeeA + , Ledger.appMinFeeB = fappMinFeeB + , Ledger.appMaxBBSize = fappMaxBBSize + , Ledger.appMaxTxSize = fappMaxTxSize + , Ledger.appMaxBHSize = fappMaxBHSize + , Ledger.appKeyDeposit = fappKeyDeposit + , Ledger.appPoolDeposit = fappPoolDeposit + , Ledger.appEMax = fappEMax + , Ledger.appNOpt = fappNOpt + , Ledger.appA0 = fappA0 + , Ledger.appRho = fappRho + , Ledger.appTau = fappTau + , Ledger.appD = fappD + , Ledger.appExtraEntropy = fappExtraEntropy + , Ledger.appProtocolVersion = fappProtocolVersion + , Ledger.appMinPoolCost = fappMinPoolCost + , Ledger.appCoinsPerUTxOWord = fappCoinsPerUTxOWord + , Ledger.appCostModels = fappCostModels + , Ledger.appPrices = fappPrices + , Ledger.appMaxTxExUnits = fappMaxTxExUnits + , Ledger.appMaxBlockExUnits = fappMaxBlockExUnits + , Ledger.appMaxValSize = fappMaxValSize , Ledger.appCollateralPercentage = fappCollateralPercentage - , Ledger.appMaxCollateralInputs = fappMaxCollateralInputs + , Ledger.appMaxCollateralInputs = fappMaxCollateralInputs } -- We're not interested in trying to mappend the underlying `Maybe` types @@ -244,85 +244,91 @@ lastMappend a b = Ledger.maybeToStrictMaybe . getLast $ strictMaybeToLast a <> s strictMaybeToLast :: StrictMaybe a -> Last a strictMaybeToLast = Last . strictMaybeToMaybe +lastMappendUnder2 :: (a -> StrictMaybe b) -> a -> a -> StrictMaybe b +lastMappendUnder2 l = under2 l lastMappend + where + under2 :: (a -> c) -> (c -> c -> c) -> a -> a -> c + under2 f g x y = g (f x) (f y) + instance Semigroup (Ledger.BabbagePParams StrictMaybe era) where (<>) p1 p2 = - let fbppMinFeeA = lastMappend (Ledger.bppMinFeeA p1) (Ledger.bppMinFeeA p2) - fbppMinFeeB = lastMappend (Ledger.bppMinFeeB p1) (Ledger.bppMinFeeB p2) - fbppMaxBBSize = lastMappend (Ledger.bppMaxBBSize p1) (Ledger.bppMaxBBSize p2) - fbppMaxTxSize = lastMappend (Ledger.bppMaxTxSize p1) (Ledger.bppMaxTxSize p2) - fbppMaxBHSize = lastMappend (Ledger.bppMaxBHSize p1) (Ledger.bppMaxBHSize p2) - fbppKeyDeposit = lastMappend (Ledger.bppKeyDeposit p1) (Ledger.bppKeyDeposit p2) - fbppPoolDeposit = lastMappend (Ledger.bppPoolDeposit p1) (Ledger.bppPoolDeposit p2) - fbppEMax = lastMappend (Ledger.bppEMax p1) (Ledger.bppEMax p2) - fbppNOpt = lastMappend (Ledger.bppNOpt p1) (Ledger.bppNOpt p2) - fbppA0 = lastMappend (Ledger.bppA0 p1) (Ledger.bppA0 p2) - fbppRho = lastMappend (Ledger.bppRho p1) (Ledger.bppRho p2) - fbppTau = lastMappend (Ledger.bppTau p1) (Ledger.bppTau p2) - fbppProtocolVersion = lastMappend (Ledger.bppProtocolVersion p1) (Ledger.bppProtocolVersion p2) - fbppMinPoolCost = lastMappend (Ledger.bppMinPoolCost p1) (Ledger.bppMinPoolCost p2) - fbppCoinsPerUTxOByte = lastMappend (Ledger.bppCoinsPerUTxOByte p1) (Ledger.bppCoinsPerUTxOByte p2) - fbppCostModels = lastMappend (Ledger.bppCostModels p1) (Ledger.bppCostModels p2) - fbppPrices = lastMappend (Ledger.bppPrices p1) (Ledger.bppPrices p2) - fbppMaxTxExUnits = lastMappend (Ledger.bppMaxTxExUnits p1) (Ledger.bppMaxTxExUnits p2) - fbppMaxBlockExUnits = lastMappend (Ledger.bppMaxBlockExUnits p1) (Ledger.bppMaxBlockExUnits p2) - fbppMaxValSize = lastMappend (Ledger.bppMaxValSize p1) (Ledger.bppMaxValSize p2) - fbppCollateralPercentage = lastMappend (Ledger.bppCollateralPercentage p1) (Ledger.bppCollateralPercentage p2) - fbppMaxCollateralInputs = lastMappend (Ledger.bppMaxCollateralInputs p1) (Ledger.bppMaxCollateralInputs p2) + let fbppMinFeeA = lastMappendUnder2 Ledger.bppMinFeeA p1 p2 + fbppMinFeeB = lastMappendUnder2 Ledger.bppMinFeeB p1 p2 + fbppMaxBBSize = lastMappendUnder2 Ledger.bppMaxBBSize p1 p2 + fbppMaxTxSize = lastMappendUnder2 Ledger.bppMaxTxSize p1 p2 + fbppMaxBHSize = lastMappendUnder2 Ledger.bppMaxBHSize p1 p2 + fbppKeyDeposit = lastMappendUnder2 Ledger.bppKeyDeposit p1 p2 + fbppPoolDeposit = lastMappendUnder2 Ledger.bppPoolDeposit p1 p2 + fbppEMax = lastMappendUnder2 Ledger.bppEMax p1 p2 + fbppNOpt = lastMappendUnder2 Ledger.bppNOpt p1 p2 + fbppA0 = lastMappendUnder2 Ledger.bppA0 p1 p2 + fbppRho = lastMappendUnder2 Ledger.bppRho p1 p2 + fbppTau = lastMappendUnder2 Ledger.bppTau p1 p2 + fbppProtocolVersion = lastMappendUnder2 Ledger.bppProtocolVersion p1 p2 + fbppMinPoolCost = lastMappendUnder2 Ledger.bppMinPoolCost p1 p2 + fbppCoinsPerUTxOByte = lastMappendUnder2 Ledger.bppCoinsPerUTxOByte p1 p2 + fbppCostModels = lastMappendUnder2 Ledger.bppCostModels p1 p2 + fbppPrices = lastMappendUnder2 Ledger.bppPrices p1 p2 + fbppMaxTxExUnits = lastMappendUnder2 Ledger.bppMaxTxExUnits p1 p2 + fbppMaxBlockExUnits = lastMappendUnder2 Ledger.bppMaxBlockExUnits p1 p2 + fbppMaxValSize = lastMappendUnder2 Ledger.bppMaxValSize p1 p2 + fbppCollateralPercentage = lastMappendUnder2 Ledger.bppCollateralPercentage p1 p2 + fbppMaxCollateralInputs = lastMappendUnder2 Ledger.bppMaxCollateralInputs p1 p2 in Ledger.BabbagePParams - { Ledger.bppMinFeeA = fbppMinFeeA - , Ledger.bppMinFeeB = fbppMinFeeB - , Ledger.bppMaxBBSize = fbppMaxBBSize - , Ledger.bppMaxTxSize = fbppMaxTxSize - , Ledger.bppMaxBHSize = fbppMaxBHSize - , Ledger.bppKeyDeposit = fbppKeyDeposit - , Ledger.bppPoolDeposit = fbppPoolDeposit - , Ledger.bppEMax = fbppEMax - , Ledger.bppNOpt = fbppNOpt - , Ledger.bppA0 = fbppA0 - , Ledger.bppRho = fbppRho - , Ledger.bppTau = fbppTau - , Ledger.bppProtocolVersion = fbppProtocolVersion - , Ledger.bppMinPoolCost = fbppMinPoolCost - , Ledger.bppCoinsPerUTxOByte = fbppCoinsPerUTxOByte - , Ledger.bppCostModels = fbppCostModels - , Ledger.bppPrices = fbppPrices - , Ledger.bppMaxTxExUnits = fbppMaxTxExUnits - , Ledger.bppMaxBlockExUnits = fbppMaxBlockExUnits - , Ledger.bppMaxValSize = fbppMaxValSize + { Ledger.bppMinFeeA = fbppMinFeeA + , Ledger.bppMinFeeB = fbppMinFeeB + , Ledger.bppMaxBBSize = fbppMaxBBSize + , Ledger.bppMaxTxSize = fbppMaxTxSize + , Ledger.bppMaxBHSize = fbppMaxBHSize + , Ledger.bppKeyDeposit = fbppKeyDeposit + , Ledger.bppPoolDeposit = fbppPoolDeposit + , Ledger.bppEMax = fbppEMax + , Ledger.bppNOpt = fbppNOpt + , Ledger.bppA0 = fbppA0 + , Ledger.bppRho = fbppRho + , Ledger.bppTau = fbppTau + , Ledger.bppProtocolVersion = fbppProtocolVersion + , Ledger.bppMinPoolCost = fbppMinPoolCost + , Ledger.bppCoinsPerUTxOByte = fbppCoinsPerUTxOByte + , Ledger.bppCostModels = fbppCostModels + , Ledger.bppPrices = fbppPrices + , Ledger.bppMaxTxExUnits = fbppMaxTxExUnits + , Ledger.bppMaxBlockExUnits = fbppMaxBlockExUnits + , Ledger.bppMaxValSize = fbppMaxValSize , Ledger.bppCollateralPercentage = fbppCollateralPercentage - , Ledger.bppMaxCollateralInputs = fbppMaxCollateralInputs + , Ledger.bppMaxCollateralInputs = fbppMaxCollateralInputs } instance Semigroup (Ledger.ConwayPParams StrictMaybe era) where (<>) p1 p2 = Ledger.ConwayPParams - { Ledger.cppMinFeeA = Ledger.cppMinFeeA p1 `lastMappend` Ledger.cppMinFeeA p2 - , Ledger.cppMinFeeB = Ledger.cppMinFeeB p1 `lastMappend` Ledger.cppMinFeeB p2 - , Ledger.cppMaxBBSize = Ledger.cppMaxBBSize p1 `lastMappend` Ledger.cppMaxBBSize p2 - , Ledger.cppMaxTxSize = Ledger.cppMaxTxSize p1 `lastMappend` Ledger.cppMaxTxSize p2 - , Ledger.cppMaxBHSize = Ledger.cppMaxBHSize p1 `lastMappend` Ledger.cppMaxBHSize p2 - , Ledger.cppKeyDeposit = Ledger.cppKeyDeposit p1 `lastMappend` Ledger.cppKeyDeposit p2 - , Ledger.cppPoolDeposit = Ledger.cppPoolDeposit p1 `lastMappend` Ledger.cppPoolDeposit p2 - , Ledger.cppEMax = Ledger.cppEMax p1 `lastMappend` Ledger.cppEMax p2 - , Ledger.cppNOpt = Ledger.cppNOpt p1 `lastMappend` Ledger.cppNOpt p2 - , Ledger.cppA0 = Ledger.cppA0 p1 `lastMappend` Ledger.cppA0 p2 - , Ledger.cppRho = Ledger.cppRho p1 `lastMappend` Ledger.cppRho p2 - , Ledger.cppTau = Ledger.cppTau p1 `lastMappend` Ledger.cppTau p2 - , Ledger.cppProtocolVersion = Ledger.cppProtocolVersion p1 `lastMappend` Ledger.cppProtocolVersion p2 - , Ledger.cppMinPoolCost = Ledger.cppMinPoolCost p1 `lastMappend` Ledger.cppMinPoolCost p2 - , Ledger.cppCoinsPerUTxOByte = Ledger.cppCoinsPerUTxOByte p1 `lastMappend` Ledger.cppCoinsPerUTxOByte p2 - , Ledger.cppCostModels = Ledger.cppCostModels p1 `lastMappend` Ledger.cppCostModels p2 - , Ledger.cppPrices = Ledger.cppPrices p1 `lastMappend` Ledger.cppPrices p2 - , Ledger.cppMaxTxExUnits = Ledger.cppMaxTxExUnits p1 `lastMappend` Ledger.cppMaxTxExUnits p2 - , Ledger.cppMaxBlockExUnits = Ledger.cppMaxBlockExUnits p1 `lastMappend` Ledger.cppMaxBlockExUnits p2 - , Ledger.cppMaxValSize = Ledger.cppMaxValSize p1 `lastMappend` Ledger.cppMaxValSize p2 - , Ledger.cppCollateralPercentage = Ledger.cppCollateralPercentage p1 `lastMappend` Ledger.cppCollateralPercentage p2 - , Ledger.cppMaxCollateralInputs = Ledger.cppMaxCollateralInputs p1 `lastMappend` Ledger.cppMaxCollateralInputs p2 - , Ledger.cppPoolVotingThresholds = Ledger.cppPoolVotingThresholds p1 `lastMappend` Ledger.cppPoolVotingThresholds p2 - , Ledger.cppDRepVotingThresholds = Ledger.cppDRepVotingThresholds p1 `lastMappend` Ledger.cppDRepVotingThresholds p2 - , Ledger.cppMinCommitteeSize = Ledger.cppMinCommitteeSize p1 `lastMappend` Ledger.cppMinCommitteeSize p2 - , Ledger.cppCommitteeTermLimit = Ledger.cppCommitteeTermLimit p1 `lastMappend` Ledger.cppCommitteeTermLimit p2 - , Ledger.cppGovActionExpiration = Ledger.cppGovActionExpiration p1 `lastMappend` Ledger.cppGovActionExpiration p2 - , Ledger.cppGovActionDeposit = Ledger.cppGovActionDeposit p1 `lastMappend` Ledger.cppGovActionDeposit p2 - , Ledger.cppDRepDeposit = Ledger.cppDRepDeposit p1 `lastMappend` Ledger.cppDRepDeposit p2 - , Ledger.cppDRepActivity = Ledger.cppDRepActivity p1 `lastMappend` Ledger.cppDRepActivity p2 + { Ledger.cppMinFeeA = lastMappendUnder2 Ledger.cppMinFeeA p1 p2 + , Ledger.cppMinFeeB = lastMappendUnder2 Ledger.cppMinFeeB p1 p2 + , Ledger.cppMaxBBSize = lastMappendUnder2 Ledger.cppMaxBBSize p1 p2 + , Ledger.cppMaxTxSize = lastMappendUnder2 Ledger.cppMaxTxSize p1 p2 + , Ledger.cppMaxBHSize = lastMappendUnder2 Ledger.cppMaxBHSize p1 p2 + , Ledger.cppKeyDeposit = lastMappendUnder2 Ledger.cppKeyDeposit p1 p2 + , Ledger.cppPoolDeposit = lastMappendUnder2 Ledger.cppPoolDeposit p1 p2 + , Ledger.cppEMax = lastMappendUnder2 Ledger.cppEMax p1 p2 + , Ledger.cppNOpt = lastMappendUnder2 Ledger.cppNOpt p1 p2 + , Ledger.cppA0 = lastMappendUnder2 Ledger.cppA0 p1 p2 + , Ledger.cppRho = lastMappendUnder2 Ledger.cppRho p1 p2 + , Ledger.cppTau = lastMappendUnder2 Ledger.cppTau p1 p2 + , Ledger.cppProtocolVersion = lastMappendUnder2 Ledger.cppProtocolVersion p1 p2 + , Ledger.cppMinPoolCost = lastMappendUnder2 Ledger.cppMinPoolCost p1 p2 + , Ledger.cppCoinsPerUTxOByte = lastMappendUnder2 Ledger.cppCoinsPerUTxOByte p1 p2 + , Ledger.cppCostModels = lastMappendUnder2 Ledger.cppCostModels p1 p2 + , Ledger.cppPrices = lastMappendUnder2 Ledger.cppPrices p1 p2 + , Ledger.cppMaxTxExUnits = lastMappendUnder2 Ledger.cppMaxTxExUnits p1 p2 + , Ledger.cppMaxBlockExUnits = lastMappendUnder2 Ledger.cppMaxBlockExUnits p1 p2 + , Ledger.cppMaxValSize = lastMappendUnder2 Ledger.cppMaxValSize p1 p2 + , Ledger.cppCollateralPercentage = lastMappendUnder2 Ledger.cppCollateralPercentage p1 p2 + , Ledger.cppMaxCollateralInputs = lastMappendUnder2 Ledger.cppMaxCollateralInputs p1 p2 + , Ledger.cppPoolVotingThresholds = lastMappendUnder2 Ledger.cppPoolVotingThresholds p1 p2 + , Ledger.cppDRepVotingThresholds = lastMappendUnder2 Ledger.cppDRepVotingThresholds p1 p2 + , Ledger.cppCommitteeMinSize = lastMappendUnder2 Ledger.cppCommitteeMinSize p1 p2 + , Ledger.cppCommitteeMaxTermLength = lastMappendUnder2 Ledger.cppCommitteeMaxTermLength p1 p2 + , Ledger.cppGovActionLifetime = lastMappendUnder2 Ledger.cppGovActionLifetime p1 p2 + , Ledger.cppGovActionDeposit = lastMappendUnder2 Ledger.cppGovActionDeposit p1 p2 + , Ledger.cppDRepDeposit = lastMappendUnder2 Ledger.cppDRepDeposit p1 p2 + , Ledger.cppDRepActivity = lastMappendUnder2 Ledger.cppDRepActivity p1 p2 } diff --git a/cardano-api/internal/Cardano/Api/ProtocolParameters.hs b/cardano-api/internal/Cardano/Api/ProtocolParameters.hs index d71eed9a8a..d4bb28a636 100644 --- a/cardano-api/internal/Cardano/Api/ProtocolParameters.hs +++ b/cardano-api/internal/Cardano/Api/ProtocolParameters.hs @@ -44,6 +44,7 @@ module Cardano.Api.ProtocolParameters ( ShelleyToAlonzoPParams(..), ShelleyToAlonzoPParams'(..), IntroducedInBabbagePParams(..), + IntroducedInConwayPParams(..), createEraBasedProtocolParamUpdate, convertToLedgerProtocolParameters, createPParams, @@ -93,7 +94,6 @@ module Cardano.Api.ProtocolParameters ( -- ** Era-dependent protocol features ProtocolUTxOCostPerByteFeature(..), ProtocolUTxOCostPerWordFeature(..), - ) where import Cardano.Api.Address @@ -125,10 +125,11 @@ import Cardano.Ledger.Api.PParams import qualified Cardano.Ledger.Babbage.Core as Ledger import Cardano.Ledger.BaseTypes (strictMaybeToMaybe) import qualified Cardano.Ledger.BaseTypes as Ledger +import qualified Cardano.Ledger.Conway.PParams as Ledger import Cardano.Ledger.Crypto (StandardCrypto) import qualified Cardano.Ledger.Keys as Ledger import qualified Cardano.Ledger.Shelley.API as Ledger -import Cardano.Slotting.Slot (EpochNo) +import Cardano.Slotting.Slot (EpochNo (..)) import Control.Monad import Data.Aeson (FromJSON (..), ToJSON (..), object, withObject, (.!=), (.:), (.:?), @@ -225,47 +226,40 @@ data EraBasedProtocolParametersUpdate era where :: CommonProtocolParametersUpdate -> AlonzoOnwardsPParams ConwayEra -> IntroducedInBabbagePParams ConwayEra - -- TODO: Conway era - need new ledger release - -- -> IntroducedInConwayPParamsUpdate (ShelleyLedgerEra ConwayEra) + -> IntroducedInConwayPParams (ShelleyLedgerEra ConwayEra) -> EraBasedProtocolParametersUpdate ConwayEra deriving instance Show (EraBasedProtocolParametersUpdate era) -{- - -TODO: Conway era - need new ledger release - -data IntroducedInConwayPParamsUpdate era - = IntroducedInConwayPParamsUpdate - { icPoolVotingThresholds :: StrictMaybe PoolVotingThresholds - , icDRepVotingThresholds :: StrictMaybe DRepVotingThresholds - , icMinCommitteeSize :: StrictMaybe Natural - , icCommitteeTermLimit :: StrictMaybe Natural - , icGovActionExpiration :: StrictMaybe Natural - , icGovActionDeposit :: StrictMaybe Coin - , icDRepDeposit :: StrictMaybe Coin - , icDRepActivity :: StrictMaybe EpochNo - } +data IntroducedInConwayPParams era + = IntroducedInConwayPParams + { icPoolVotingThresholds :: StrictMaybe Ledger.PoolVotingThresholds + , icDRepVotingThresholds :: StrictMaybe Ledger.DRepVotingThresholds + , icMinCommitteeSize :: StrictMaybe Natural + , icCommitteeTermLength :: StrictMaybe Natural + , icGovActionLifetime :: StrictMaybe EpochNo + , icGovActionDeposit :: StrictMaybe Ledger.Coin + , icDRepDeposit :: StrictMaybe Ledger.Coin + , icDRepActivity :: StrictMaybe EpochNo + } deriving Show createIntroducedInConwayPParams :: Ledger.ConwayEraPParams ledgerera - => IntroducedInConwayPParamsUpdate ledgerera + => IntroducedInConwayPParams ledgerera -> Ledger.PParamsUpdate ledgerera -createIntroducedInConwayPParams IntroducedInConwayPParamsUpdate{..} = - +createIntroducedInConwayPParams IntroducedInConwayPParams{..} = Ledger.emptyPParamsUpdate & Ledger.ppuPoolVotingThresholdsL .~ icPoolVotingThresholds & Ledger.ppuDRepVotingThresholdsL .~ icDRepVotingThresholds - & Ledger.ppuMinCommitteeSizeL .~ icMinCommitteeSize - & Ledger.ppuCommitteeTermLimitL .~ icCommitteeTermLimit - & Ledger.ppuGovActionExpirationL .~ icGovActionExpiration + & Ledger.ppuCommitteeMinSizeL .~ icMinCommitteeSize + & Ledger.ppuCommitteeMaxTermLengthL .~ icCommitteeTermLength + & Ledger.ppuGovActionLifetimeL .~ icGovActionLifetime & Ledger.ppuGovActionDepositL .~ icGovActionDeposit & Ledger.ppuDRepDepositL .~ icDRepDeposit & Ledger.ppuDRepActivityL .~ icDRepActivity --} createEraBasedProtocolParamUpdate :: ShelleyBasedEra era @@ -304,12 +298,12 @@ createEraBasedProtocolParamUpdate sbe eraPParamsUpdate = Ledger.PParamsUpdate inBAb = createIntroducedInBabbagePParams sbe introInBabbage in Ledger.PParamsUpdate $ common <> inAlonzoPParams <> inBAb - ConwayEraBasedProtocolParametersUpdate c introInAlonzo introInBabbage -> + ConwayEraBasedProtocolParametersUpdate c introInAlonzo introInBabbage introInConway -> let Ledger.PParamsUpdate common = createCommonPParamsUpdate c Ledger.PParamsUpdate inAlonzoPParams = createPParamsUpdateIntroducedInAlonzo sbe introInAlonzo - Ledger.PParamsUpdate inBAb = createIntroducedInBabbagePParams sbe introInBabbage - -- TODO: Conway era - need new ledger release for updated types - in Ledger.PParamsUpdate $ common <> inAlonzoPParams <> inBAb + Ledger.PParamsUpdate inBab = createIntroducedInBabbagePParams sbe introInBabbage + Ledger.PParamsUpdate inCon = createIntroducedInConwayPParams introInConway + in Ledger.PParamsUpdate $ common <> inAlonzoPParams <> inBab <> inCon -- | Protocol parameters common to each era. This can only ever be reduced diff --git a/cardano-api/src/Cardano/Api/Shelley.hs b/cardano-api/src/Cardano/Api/Shelley.hs index 9e5928f138..f42aa49a2b 100644 --- a/cardano-api/src/Cardano/Api/Shelley.hs +++ b/cardano-api/src/Cardano/Api/Shelley.hs @@ -118,6 +118,7 @@ module Cardano.Api.Shelley ShelleyToAlonzoPParams(..), ShelleyToAlonzoPParams'(..), IntroducedInBabbagePParams(..), + IntroducedInConwayPParams(..), createEraBasedProtocolParamUpdate, convertToLedgerProtocolParameters,