Skip to content

Commit

Permalink
Use new inject function instead of the XToY era functions
Browse files Browse the repository at this point in the history
  • Loading branch information
smelc committed Nov 15, 2024
1 parent fe918b3 commit bbbd8b4
Show file tree
Hide file tree
Showing 12 changed files with 52 additions and 46 deletions.
6 changes: 3 additions & 3 deletions cardano-cli/src/Cardano/CLI/Compatible/Transaction.hs
Original file line number Diff line number Diff line change
Expand Up @@ -270,18 +270,18 @@ readUpdateProposalFile
:: Featured ShelleyToBabbageEra era (Maybe UpdateProposalFile)
-> ExceptT CompatibleTransactionError IO (AnyProtocolUpdate era)
readUpdateProposalFile (Featured sToB Nothing) =
return $ NoPParamsUpdate $ shelleyToBabbageEraToShelleyBasedEra sToB
return $ NoPParamsUpdate $ inject sToB
readUpdateProposalFile (Featured sToB (Just updateProposalFile)) = do
prop <- firstExceptT CompatibleFileError $ readTxUpdateProposal sToB updateProposalFile
case prop of
TxUpdateProposalNone -> return $ NoPParamsUpdate $ shelleyToBabbageEraToShelleyBasedEra sToB
TxUpdateProposalNone -> return $ NoPParamsUpdate $ inject sToB
TxUpdateProposal _ proposal -> return $ ProtocolUpdate sToB proposal

readProposalProcedureFile
:: Featured ConwayEraOnwards era [(ProposalFile In, Maybe (ScriptWitnessFiles WitCtxStake))]
-> ExceptT CompatibleTransactionError IO (AnyProtocolUpdate era)
readProposalProcedureFile (Featured cEraOnwards []) =
let sbe = conwayEraOnwardsToShelleyBasedEra cEraOnwards
let sbe = inject cEraOnwards
in return $ NoPParamsUpdate sbe
readProposalProcedureFile (Featured cEraOnwards proposals) = do
props <-
Expand Down
Original file line number Diff line number Diff line change
Expand Up @@ -185,11 +185,11 @@ pUpdateProtocolParametersCmd
pUpdateProtocolParametersCmd =
caseShelleyToBabbageOrConwayEraOnwards
( \shelleyToBab ->
let sbe = shelleyToBabbageEraToShelleyBasedEra shelleyToBab
let sbe = inject shelleyToBab
in subParser "create-protocol-parameters-update"
$ Opt.info
( Cmd.GovernanceActionProtocolParametersUpdateCmdArgs
(shelleyToBabbageEraToShelleyBasedEra shelleyToBab)
(inject shelleyToBab)
<$> fmap Just (pUpdateProtocolParametersPreConway shelleyToBab)
<*> pure Nothing
<*> dpGovActionProtocolParametersUpdate sbe
Expand All @@ -199,11 +199,11 @@ pUpdateProtocolParametersCmd =
$ Opt.progDesc "Create a protocol parameters update."
)
( \conwayOnwards ->
let sbe = conwayEraOnwardsToShelleyBasedEra conwayOnwards
let sbe = inject conwayOnwards
in subParser "create-protocol-parameters-update"
$ Opt.info
( Cmd.GovernanceActionProtocolParametersUpdateCmdArgs
(conwayEraOnwardsToShelleyBasedEra conwayOnwards)
(inject conwayOnwards)
Nothing
<$> fmap Just (pUpdateProtocolParametersPostConway conwayOnwards)
<*> dpGovActionProtocolParametersUpdate sbe
Expand Down
4 changes: 2 additions & 2 deletions cardano-cli/src/Cardano/CLI/EraBased/Options/Query.hs
Original file line number Diff line number Diff line change
Expand Up @@ -678,7 +678,7 @@ pQueryTreasuryValueCmd era envCli = do
<*> optional pOutputFile

pQueryNoArgCmdArgs
:: ()
:: forall era. ()
=> ConwayEraOnwards era
-> EnvCli
-> Parser (QueryNoArgCmdArgs era)
Expand All @@ -687,5 +687,5 @@ pQueryNoArgCmdArgs w envCli =
<$> pSocketPath envCli
<*> pConsensusModeParams
<*> pNetworkId envCli
<*> pTarget (conwayEraOnwardsToShelleyBasedEra w)
<*> pTarget (inject w :: ShelleyBasedEra era)
<*> optional pOutputFile
4 changes: 2 additions & 2 deletions cardano-cli/src/Cardano/CLI/EraBased/Options/StakeAddress.hs
Original file line number Diff line number Diff line change
Expand Up @@ -121,7 +121,7 @@ pStakeAddressDeregistrationCertificateCmd =
( \shelleyToBabbage ->
subParser "deregistration-certificate"
$ Opt.info
( StakeAddressDeregistrationCertificateCmd (shelleyToBabbageEraToShelleyBasedEra shelleyToBabbage)
( StakeAddressDeregistrationCertificateCmd (inject shelleyToBabbage)
<$> pStakeIdentifier Nothing
<*> pure Nothing
<*> pOutputFile
Expand All @@ -131,7 +131,7 @@ pStakeAddressDeregistrationCertificateCmd =
( \conwayOnwards ->
subParser "deregistration-certificate"
$ Opt.info
( StakeAddressDeregistrationCertificateCmd (conwayEraOnwardsToShelleyBasedEra conwayOnwards)
( StakeAddressDeregistrationCertificateCmd (inject conwayOnwards)
<$> pStakeIdentifier Nothing
<*> fmap Just pKeyRegistDeposit
<*> pOutputFile
Expand Down
Original file line number Diff line number Diff line change
Expand Up @@ -227,7 +227,7 @@ pTransactionBuildEstimateCmd eon' _envCli = do
where
pCmd :: Exp.Era era -> Parser (TransactionCmds era)
pCmd era' = do
let sbe = Exp.eraToSbe era'
let sbe = inject era'
fmap TransactionBuildEstimateCmd $
TransactionBuildEstimateCmdArgs era'
<$> optional pScriptValidity
Expand Down
15 changes: 9 additions & 6 deletions cardano-cli/src/Cardano/CLI/EraBased/Run/Governance.hs
Original file line number Diff line number Diff line change
Expand Up @@ -65,7 +65,7 @@ runGovernanceCmds = \case
runGovernanceVoteCmds cmds

runGovernanceMIRCertificatePayStakeAddrs
:: ShelleyToBabbageEra era
:: forall era. ShelleyToBabbageEra era
-> L.MIRPot
-> [StakeAddress]
-- ^ Stake addresses
Expand All @@ -92,18 +92,19 @@ runGovernanceMIRCertificatePayStakeAddrs w mirPot sAddrs rwdAmts oFp = do
makeMIRCertificate $
MirCertificateRequirements w mirPot $
shelleyToBabbageEraConstraints w mirTarget
sbe :: ShelleyBasedEra era = inject w

firstExceptT GovernanceCmdTextEnvWriteError
. newExceptT
$ shelleyBasedEraConstraints (shelleyToBabbageEraToShelleyBasedEra w)
$ shelleyBasedEraConstraints sbe
$ writeLazyByteStringFile oFp
$ textEnvelopeToJSON (Just mirCertDesc) mirCert
where
mirCertDesc :: TextEnvelopeDescr
mirCertDesc = "Move Instantaneous Rewards Certificate"

runGovernanceCreateMirCertificateTransferToTreasuryCmd
:: ()
:: forall era. ()
=> ShelleyToBabbageEra era
-> Lovelace
-> File () Out
Expand All @@ -112,18 +113,19 @@ runGovernanceCreateMirCertificateTransferToTreasuryCmd w ll oFp = do
let mirTarget = L.SendToOppositePotMIR ll

let mirCert = makeMIRCertificate $ MirCertificateRequirements w L.ReservesMIR mirTarget
sbe :: ShelleyBasedEra era = inject w

firstExceptT GovernanceCmdTextEnvWriteError
. newExceptT
$ shelleyBasedEraConstraints (shelleyToBabbageEraToShelleyBasedEra w)
$ shelleyBasedEraConstraints sbe
$ writeLazyByteStringFile oFp
$ textEnvelopeToJSON (Just mirCertDesc) mirCert
where
mirCertDesc :: TextEnvelopeDescr
mirCertDesc = "MIR Certificate Send To Treasury"

runGovernanceCreateMirCertificateTransferToReservesCmd
:: ()
:: forall era. ()
=> ShelleyToBabbageEra era
-> Lovelace
-> File () Out
Expand All @@ -132,10 +134,11 @@ runGovernanceCreateMirCertificateTransferToReservesCmd w ll oFp = do
let mirTarget = L.SendToOppositePotMIR ll

let mirCert = makeMIRCertificate $ MirCertificateRequirements w L.TreasuryMIR mirTarget
sbe :: ShelleyBasedEra era = inject w

firstExceptT GovernanceCmdTextEnvWriteError
. newExceptT
$ shelleyBasedEraConstraints (shelleyToBabbageEraToShelleyBasedEra w)
$ shelleyBasedEraConstraints sbe
$ writeLazyByteStringFile oFp
$ textEnvelopeToJSON (Just mirCertDesc) mirCert
where
Expand Down
31 changes: 16 additions & 15 deletions cardano-cli/src/Cardano/CLI/EraBased/Run/Governance/Actions.hs
Original file line number Diff line number Diff line change
Expand Up @@ -3,6 +3,7 @@
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}

module Cardano.CLI.EraBased.Run.Governance.Actions
Expand Down Expand Up @@ -77,7 +78,7 @@ runGovernanceActionViewCmd
proposal

runGovernanceActionInfoCmd
:: ()
:: forall era. ()
=> GovernanceActionInfoCmdArgs era
-> ExceptT GovernanceActionsError IO ()
runGovernanceActionInfoCmd
Expand All @@ -103,7 +104,7 @@ runGovernanceActionInfoCmd

carryHashChecks checkProposalHash proposalAnchor ProposalCheck

let sbe = conwayEraOnwardsToShelleyBasedEra eon
let sbe :: ShelleyBasedEra era = inject eon
govAction = InfoAct
proposalProcedure = createProposalProcedure sbe networkId deposit depositStakeCredential govAction proposalAnchor

Expand All @@ -117,7 +118,7 @@ fetchURLErrorToGovernanceActionError adt = withExceptT (GovernanceActionsProposa

-- TODO: Conway era - update with new ledger types from cardano-ledger-conway-1.7.0.0
runGovernanceActionCreateNoConfidenceCmd
:: ()
:: forall era. ()
=> GovernanceActionCreateNoConfidenceCmdArgs era
-> ExceptT GovernanceActionsError IO ()
runGovernanceActionCreateNoConfidenceCmd
Expand All @@ -144,7 +145,7 @@ runGovernanceActionCreateNoConfidenceCmd

carryHashChecks checkProposalHash proposalAnchor ProposalCheck

let sbe = conwayEraOnwardsToShelleyBasedEra eon
let sbe :: ShelleyBasedEra era = inject eon
previousGovernanceAction =
MotionOfNoConfidence $
L.maybeToStrictMaybe $
Expand All @@ -165,7 +166,7 @@ runGovernanceActionCreateNoConfidenceCmd
writeFileTextEnvelope outFile (Just "Motion of no confidence proposal") proposalProcedure

runGovernanceActionCreateConstitutionCmd
:: ()
:: forall era. ()
=> GovernanceActionCreateConstitutionCmdArgs era
-> ExceptT GovernanceActionsError IO ()
runGovernanceActionCreateConstitutionCmd
Expand Down Expand Up @@ -210,7 +211,7 @@ runGovernanceActionCreateConstitutionCmd
prevGovActId
constitutionAnchor
(toShelleyScriptHash <$> L.maybeToStrictMaybe constitutionScript)
sbe = conwayEraOnwardsToShelleyBasedEra eon
sbe :: ShelleyBasedEra era = inject eon
proposalProcedure = createProposalProcedure sbe networkId deposit depositStakeCredential govAct proposalAnchor

carryHashChecks checkConstitutionHash constitutionAnchor ConstitutionCheck
Expand All @@ -225,7 +226,7 @@ runGovernanceActionCreateConstitutionCmd
-- TODO: Conway era - After ledger bump update this function
-- with the new ledger types
runGovernanceActionUpdateCommitteeCmd
:: ()
:: forall era. ()
=> GovernanceActionUpdateCommitteeCmdArgs era
-> ExceptT GovernanceActionsError IO ()
runGovernanceActionUpdateCommitteeCmd
Expand All @@ -243,7 +244,7 @@ runGovernanceActionUpdateCommitteeCmd
, Cmd.mPrevGovernanceActionId
, Cmd.outFile
} = do
let sbe = conwayEraOnwardsToShelleyBasedEra eon
let sbe :: ShelleyBasedEra era = inject eon
govActIdentifier =
L.maybeToStrictMaybe $
shelleyBasedEraConstraints sbe $
Expand Down Expand Up @@ -301,15 +302,15 @@ runGovernanceActionUpdateCommitteeCmd
proposal

runGovernanceActionCreateProtocolParametersUpdateCmd
:: ()
:: forall era. ()
=> Cmd.GovernanceActionProtocolParametersUpdateCmdArgs era
-> ExceptT GovernanceActionsError IO ()
runGovernanceActionCreateProtocolParametersUpdateCmd eraBasedPParams' = do
let sbe = uppShelleyBasedEra eraBasedPParams'
caseShelleyToBabbageOrConwayEraOnwards
( \sToB -> do
let oFp = uppFilePath eraBasedPParams'
anyEra = AnyShelleyBasedEra $ shelleyToBabbageEraToShelleyBasedEra sToB
anyEra = AnyShelleyBasedEra (inject sToB :: ShelleyBasedEra era)
UpdateProtocolParametersPreConway _stB expEpoch genesisVerKeys <-
hoistMaybe (GovernanceActionsValueUpdateProtocolParametersNotFound anyEra) $
uppPreConway eraBasedPParams'
Expand All @@ -335,7 +336,7 @@ runGovernanceActionCreateProtocolParametersUpdateCmd eraBasedPParams' = do
)
( \conwayOnwards -> do
let oFp = uppFilePath eraBasedPParams'
anyEra = AnyShelleyBasedEra $ conwayEraOnwardsToShelleyBasedEra conwayOnwards
anyEra = AnyShelleyBasedEra (inject conwayOnwards :: ShelleyBasedEra era)

UpdateProtocolParametersConwayOnwards
_cOnwards
Expand Down Expand Up @@ -413,7 +414,7 @@ addCostModelsToEraBasedProtocolParametersUpdate
ConwayEraBasedProtocolParametersUpdate common (aOn{alCostModels = SJust cmdls}) inB inC

runGovernanceActionTreasuryWithdrawalCmd
:: ()
:: forall era. ()
=> GovernanceActionTreasuryWithdrawalCmdArgs era
-> ExceptT GovernanceActionsError IO ()
runGovernanceActionTreasuryWithdrawalCmd
Expand Down Expand Up @@ -446,7 +447,7 @@ runGovernanceActionTreasuryWithdrawalCmd
firstExceptT GovernanceActionsReadStakeCredErrror $ getStakeCredentialFromIdentifier stakeIdentifier
pure (networkId, stakeCredential, lovelace)

let sbe = conwayEraOnwardsToShelleyBasedEra eon
let sbe :: ShelleyBasedEra era = inject eon
treasuryWithdrawals =
TreasuryWithdrawal
withdrawals
Expand All @@ -465,7 +466,7 @@ runGovernanceActionTreasuryWithdrawalCmd
writeFileTextEnvelope outFile (Just "Treasury withdrawal proposal") proposal

runGovernanceActionHardforkInitCmd
:: ()
:: forall era. ()
=> GovernanceActionHardforkInitCmdArgs era
-> ExceptT GovernanceActionsError IO ()
runGovernanceActionHardforkInitCmd
Expand Down Expand Up @@ -493,7 +494,7 @@ runGovernanceActionHardforkInitCmd

carryHashChecks checkProposalHash proposalAnchor ProposalCheck

let sbe = conwayEraOnwardsToShelleyBasedEra eon
let sbe :: ShelleyBasedEra era = inject eon
govActIdentifier =
L.maybeToStrictMaybe $
shelleyBasedEraConstraints sbe $
Expand Down
Original file line number Diff line number Diff line change
@@ -1,5 +1,7 @@
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}

module Cardano.CLI.EraBased.Run.Governance.GenesisKeyDelegationCertificate
( runGovernanceGenesisKeyDelegationCertificate
Expand All @@ -13,7 +15,7 @@ import Cardano.CLI.Types.Errors.GovernanceCmdError
import Cardano.CLI.Types.Key

runGovernanceGenesisKeyDelegationCertificate
:: ShelleyToBabbageEra era
:: forall era. ShelleyToBabbageEra era
-> VerificationKeyOrHashOrFile GenesisKey
-> VerificationKeyOrHashOrFile GenesisDelegateKey
-> VerificationKeyOrHashOrFile VrfKey
Expand Down Expand Up @@ -41,7 +43,7 @@ runGovernanceGenesisKeyDelegationCertificate
firstExceptT GovernanceCmdTextEnvWriteError
. newExceptT
$ writeLazyByteStringFile oFp
$ shelleyBasedEraConstraints (shelleyToBabbageEraToShelleyBasedEra stb)
$ shelleyBasedEraConstraints (inject stb :: ShelleyBasedEra era)
$ textEnvelopeToJSON (Just genKeyDelegCertDesc) genKeyDelegCert
where
genKeyDelegCertDesc :: TextEnvelopeDescr
Expand Down
8 changes: 4 additions & 4 deletions cardano-cli/src/Cardano/CLI/EraBased/Run/Governance/Vote.hs
Original file line number Diff line number Diff line change
Expand Up @@ -41,7 +41,7 @@ runGovernanceVoteCmds = \case
& firstExceptT CmdGovernanceVoteError

runGovernanceVoteCreateCmd
:: ()
:: forall era. ()
=> Cmd.GovernanceVoteCreateCmdArgs era
-> ExceptT GovernanceVoteCmdError IO ()
runGovernanceVoteCreateCmd
Expand All @@ -54,7 +54,7 @@ runGovernanceVoteCreateCmd
, outFile
} = do
let (govActionTxId, govActionIndex) = governanceAction
sbe = conwayEraOnwardsToShelleyBasedEra eon -- TODO: Conway era - update vote creation related function to take ConwayEraOnwards
sbe :: ShelleyBasedEra era = inject eon -- TODO: Conway era - update vote creation related function to take ConwayEraOnwards
mAnchor' =
fmap
( \pca@PotentiallyCheckedAnchor{pcaAnchor = (VoteUrl url, voteHash)} ->
Expand Down Expand Up @@ -92,7 +92,7 @@ runGovernanceVoteCreateCmd
writeFileTextEnvelope outFile Nothing votingProcedures

runGovernanceVoteViewCmd
:: ()
:: forall era. ()
=> Cmd.GovernanceVoteViewCmdArgs era
-> ExceptT GovernanceVoteCmdError IO ()
runGovernanceVoteViewCmd
Expand All @@ -102,7 +102,7 @@ runGovernanceVoteViewCmd
, voteFile
, mOutFile
} = do
let sbe = conwayEraOnwardsToShelleyBasedEra eon
let sbe :: ShelleyBasedEra era = inject eon

shelleyBasedEraConstraints sbe $ do
voteProcedures <-
Expand Down
6 changes: 3 additions & 3 deletions cardano-cli/src/Cardano/CLI/EraBased/Run/Transaction.hs
Original file line number Diff line number Diff line change
Expand Up @@ -136,7 +136,7 @@ runTransactionBuildCmd
, treasuryDonation -- Maybe TxTreasuryDonation
, buildOutputOptions
} = do
let eon = Exp.eraToSbe currentEra
let eon = inject currentEra
era' = toCardanoEra eon

-- The user can specify an era prior to the era that the node is currently in.
Expand Down Expand Up @@ -350,8 +350,8 @@ runTransactionBuildEstimateCmd -- TODO change type
, currentTreasuryValueAndDonation
, txBodyOutFile
} = do
let sbe = Exp.eraToSbe currentEra
meo = babbageEraOnwardsToMaryEraOnwards $ Exp.eraToBabbageEraOnwards currentEra
let sbe = inject currentEra
meo = babbageEraOnwardsToMaryEraOnwards $ inject currentEra

ledgerPParams <-
firstExceptT TxCmdProtocolParamsError $ readProtocolParameters sbe protocolParamsFile
Expand Down
4 changes: 2 additions & 2 deletions cardano-cli/src/Cardano/CLI/Json/Friendly.hs
Original file line number Diff line number Diff line change
Expand Up @@ -786,10 +786,10 @@ friendlyFee = \case
friendlyLovelace :: Lovelace -> Aeson.Value
friendlyLovelace value = String $ docToText (pretty value)

friendlyMintValue :: TxMintValue ViewTx era -> Aeson.Value
friendlyMintValue :: forall era. TxMintValue ViewTx era -> Aeson.Value
friendlyMintValue = \case
TxMintNone -> Null
TxMintValue sbe v _ -> friendlyValue (maryEraOnwardsToShelleyBasedEra sbe) v
TxMintValue sbe v _ -> friendlyValue ((inject sbe) :: ShelleyBasedEra era) v

friendlyTxOutValue :: TxOutValue era -> Aeson.Value
friendlyTxOutValue = \case
Expand Down
Loading

0 comments on commit bbbd8b4

Please sign in to comment.