diff --git a/cabal.project b/cabal.project index d356c5b4d..0eaa21064 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 2023-07-27T22:41:49Z - , cardano-haskell-packages 2023-07-27T18:37:22Z + , cardano-haskell-packages 2023-08-01T04:45:51Z packages: cardano-cli diff --git a/cardano-cli/cardano-cli.cabal b/cardano-cli/cardano-cli.cabal index 7b73244be..18d91952e 100644 --- a/cardano-cli/cardano-cli.cabal +++ b/cardano-cli/cardano-cli.cabal @@ -116,7 +116,7 @@ library , binary , bytestring , canonical-json - , cardano-api ^>= 8.10.2 + , cardano-api ^>= 8.11 , cardano-binary , cardano-crypto , cardano-crypto-class >= 2.1.1 @@ -203,7 +203,7 @@ test-suite cardano-cli-test , base16-bytestring , bech32 >= 1.1.0 , bytestring - , cardano-api:{cardano-api, internal, gen} ^>= 8.10.2 + , cardano-api:{cardano-api, internal, gen} ^>= 8.11 , cardano-api-gen ^>= 8.1.1.0 , cardano-cli , cardano-cli:cardano-cli-test-lib @@ -246,7 +246,7 @@ test-suite cardano-cli-golden build-depends: aeson >= 1.5.6.0 , base16-bytestring , bytestring - , cardano-api:{cardano-api, gen} ^>= 8.10.2 + , cardano-api:{cardano-api, gen} ^>= 8.11 , cardano-binary , cardano-cli , cardano-cli:cardano-cli-test-lib diff --git a/cardano-cli/src/Cardano/CLI/Commands/Governance.hs b/cardano-cli/src/Cardano/CLI/Commands/Governance.hs index 49f8ff6ef..af668573e 100644 --- a/cardano-cli/src/Cardano/CLI/Commands/Governance.hs +++ b/cardano-cli/src/Cardano/CLI/Commands/Governance.hs @@ -134,18 +134,18 @@ runGovernanceCreateVoteCmd anyEra vChoice vType govActionTxIn votingStakeCred oF votingCred <- hoistEither $ first VotingCredentialDecodeGovCmdEror $ toVotingCredential sbe vStakeCred let govActIdentifier = makeGoveranceActionId sbe govActionTxIn voteProcedure = createVotingProcedure sbe vChoice (VoterCommittee votingCred) govActIdentifier - firstExceptT WriteFileError . newExceptT $ obtainEraPParamsConstraint sbe $ writeFileTextEnvelope oFp Nothing voteProcedure + firstExceptT WriteFileError . newExceptT $ shelleyBasedEraConstraints sbe $ writeFileTextEnvelope oFp Nothing voteProcedure VDR -> do votingCred <- hoistEither $ first VotingCredentialDecodeGovCmdEror $ toVotingCredential sbe vStakeCred let govActIdentifier = makeGoveranceActionId sbe govActionTxIn voteProcedure = createVotingProcedure sbe vChoice (VoterDRep votingCred) govActIdentifier - firstExceptT WriteFileError . newExceptT $ obtainEraPParamsConstraint sbe $ writeFileTextEnvelope oFp Nothing voteProcedure + firstExceptT WriteFileError . newExceptT $ shelleyBasedEraConstraints sbe $ writeFileTextEnvelope oFp Nothing voteProcedure VSP -> do let govActIdentifier = makeGoveranceActionId sbe govActionTxIn voteProcedure = createVotingProcedure sbe vChoice (VoterSpo stakePoolKeyHash) govActIdentifier - firstExceptT WriteFileError . newExceptT $ obtainEraPParamsConstraint sbe $ writeFileTextEnvelope oFp Nothing voteProcedure + firstExceptT WriteFileError . newExceptT $ shelleyBasedEraConstraints sbe $ writeFileTextEnvelope oFp Nothing voteProcedure runGovernanceNewConstitutionCmd @@ -184,6 +184,6 @@ runGovernanceCreateActionCmd anyEra deposit depositReturnAddr govAction oFp = do let proposal = createProposalProcedure sbe deposit depositReturnAddr govAction firstExceptT WriteFileError . newExceptT - $ obtainEraPParamsConstraint sbe + $ shelleyBasedEraConstraints sbe $ writeFileTextEnvelope oFp Nothing proposal diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Certificate.hs b/cardano-cli/src/Cardano/CLI/EraBased/Certificate.hs index 801e199c2..983e84cec 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Certificate.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Certificate.hs @@ -161,13 +161,13 @@ runGovernanceRegistrationCertificate anyReg outfp = } let ledgerStakePoolParams = toShelleyPoolParams stakePoolParams - req = StakePoolRegistrationRequirementsPreConway stoB $ shelleyCertificateConstraints stoB ledgerStakePoolParams + req = StakePoolRegistrationRequirementsPreConway stoB $ shelleyToBabbageEraConstraints stoB ledgerStakePoolParams registrationCert = makeStakePoolRegistrationCertificate req description = Just @TextEnvelopeDescr "Stake Pool Registration Certificate" firstExceptT EraBasedRegistWriteFileError . newExceptT . writeLazyByteStringFile outfp - $ shelleyCertificateConstraints stoB + $ shelleyToBabbageEraConstraints stoB $ textEnvelopeToJSON description registrationCert ShelleyToBabbageStakeKeyRegTarget sToB stakeIdentifier -> do @@ -179,7 +179,7 @@ runGovernanceRegistrationCertificate anyReg outfp = firstExceptT EraBasedRegistWriteFileError . newExceptT . writeLazyByteStringFile outfp - $ shelleyCertificateConstraints sToB + $ shelleyToBabbageEraConstraints sToB $ textEnvelopeToJSON description registrationCert ConwayOnwardRegTarget _ regTarget -> @@ -226,13 +226,13 @@ runGovernanceRegistrationCertificate anyReg outfp = let ledgerStakePoolParams = toShelleyPoolParams stakePoolParams req = StakePoolRegistrationRequirementsConwayOnwards cOnwards - $ conwayCertificateConstraints cOnwards ledgerStakePoolParams + $ conwayEraOnwardsConstraints cOnwards ledgerStakePoolParams registrationCert = makeStakePoolRegistrationCertificate req description = Just @TextEnvelopeDescr "Stake Pool Registration Certificate" firstExceptT EraBasedRegistWriteFileError . newExceptT . writeLazyByteStringFile outfp - $ conwayCertificateConstraints cOnwards + $ conwayEraOnwardsConstraints cOnwards $ textEnvelopeToJSON description registrationCert RegisterStakeKey cOnwards sIdentifier deposit -> do stakeCred <- firstExceptT EraBasedRegistStakeCredReadError @@ -243,13 +243,13 @@ runGovernanceRegistrationCertificate anyReg outfp = firstExceptT EraBasedRegistWriteFileError . newExceptT . writeLazyByteStringFile outfp - $ conwayCertificateConstraints cOnwards + $ conwayEraOnwardsConstraints cOnwards $ textEnvelopeToJSON description registrationCert RegisterDRep cOnwards drepVKey deposit -> do DRepKeyHash drepKeyHash <- firstExceptT EraBasedRegistReadError . newExceptT $ readVerificationKeyOrHashOrFile AsDRepKey drepVKey - let drepCred = Ledger.KeyHashObj $ conwayCertificateConstraints cOnwards drepKeyHash + let drepCred = Ledger.KeyHashObj $ conwayEraOnwardsConstraints cOnwards drepKeyHash votingCredential = VotingCredential drepCred req = DRepRegistrationRequirements cOnwards votingCredential deposit registrationCert = makeDrepRegistrationCertificate req @@ -258,7 +258,7 @@ runGovernanceRegistrationCertificate anyReg outfp = firstExceptT EraBasedRegistWriteFileError . newExceptT . writeLazyByteStringFile outfp - $ conwayCertificateConstraints cOnwards + $ conwayEraOnwardsConstraints cOnwards $ textEnvelopeToJSON description registrationCert -------------------------------------------------------------------------------- diff --git a/cardano-cli/src/Cardano/CLI/Run/Legacy/Query.hs b/cardano-cli/src/Cardano/CLI/Run/Legacy/Query.hs index 6759518c7..aa3acdf3e 100644 --- a/cardano-cli/src/Cardano/CLI/Run/Legacy/Query.hs +++ b/cardano-cli/src/Cardano/CLI/Run/Legacy/Query.hs @@ -898,7 +898,7 @@ runQueryProtocolState socketPath (AnyConsensusModeParams cModeParams) network mO pure $ do case cMode of - CardanoMode -> eligibleWriteProtocolStateConstaints sbe $ writeProtocolState mOutFile result + CardanoMode -> shelleyBasedEraConstraints sbe $ writeProtocolState mOutFile result mode -> left . ShelleyQueryCmdUnsupportedMode $ AnyConsensusMode mode ) & onLeft (left . ShelleyQueryCmdAcquireFailure) @@ -1572,18 +1572,3 @@ utcTimeToSlotNo socketPath (AnyConsensusModeParams cModeParams) network utcTime & onLeft left mode -> left . ShelleyQueryCmdUnsupportedMode $ AnyConsensusMode mode - -eligibleWriteProtocolStateConstaints - :: ShelleyBasedEra era - -> (( FromCBOR (Consensus.ChainDepState (ConsensusProtocol era)) - , ToJSON (Consensus.ChainDepState (ConsensusProtocol era)) - ) => a - ) - -> a -eligibleWriteProtocolStateConstaints = \case - ShelleyBasedEraShelley -> id - ShelleyBasedEraAllegra -> id - ShelleyBasedEraMary -> id - ShelleyBasedEraAlonzo -> id - ShelleyBasedEraBabbage -> id - ShelleyBasedEraConway -> id diff --git a/cardano-cli/src/Cardano/CLI/Run/Legacy/Read.hs b/cardano-cli/src/Cardano/CLI/Run/Legacy/Read.hs index b10387d61..92173e968 100644 --- a/cardano-cli/src/Cardano/CLI/Run/Legacy/Read.hs +++ b/cardano-cli/src/Cardano/CLI/Run/Legacy/Read.hs @@ -78,17 +78,15 @@ import Cardano.CLI.Types.Legacy import Prelude import Control.Exception (bracket) -import Control.Monad (unless) -import Control.Monad.Except (throwError) +import Control.Monad (forM, unless) import Control.Monad.Trans.Except (ExceptT (..), runExceptT) -import Control.Monad.Trans.Except.Extra (firstExceptT, handleIOExceptT, hoistEither, - hoistMaybe, left, newExceptT) +import Control.Monad.Trans.Except.Extra (firstExceptT, handleIOExceptT, hoistEither, left, + newExceptT) import qualified Data.Aeson as Aeson import Data.Bifunctor (first) import qualified Data.ByteString.Builder as Builder import qualified Data.ByteString.Char8 as BS import qualified Data.ByteString.Lazy.Char8 as LBS -import Data.Function import Data.IORef (IORef, newIORef, readIORef, writeIORef) import qualified Data.List as List import Data.Text (Text) @@ -747,26 +745,19 @@ data VoteError deriving Show readTxVotes :: () - => CardanoEra era + => ConwayEraOnwards era -> [VoteFile In] -> IO (Either VoteError (TxVotes era)) readTxVotes _ [] = return $ Right TxVotesNone -readTxVotes era files = runExceptT $ - case cardanoEraStyle era of - LegacyByronEra -> - throwError . VotesNotSupportedInEra $ AnyCardanoEra era - ShelleyBasedEra sbe -> do - supp <- votesSupportedInEra sbe & hoistMaybe (VotesNotSupportedInEra $ AnyCardanoEra era) - votes <- newExceptT $ sequence <$> mapM (readVoteFile sbe) files - pure $ TxVotes supp votes +readTxVotes w files = runExceptT $ do + TxVotes w <$> forM files (ExceptT . readVoteFile w) readVoteFile - :: ShelleyBasedEra era + :: ConwayEraOnwards era -> VoteFile In -> IO (Either VoteError (VotingProcedure era)) -readVoteFile sbe fp = - first VoteErrorFile <$> shelleyBasedEraConstraints sbe (readFileTextEnvelope AsVote fp) - +readVoteFile w fp = + first VoteErrorFile <$> conwayEraOnwardsConstraints w (readFileTextEnvelope AsVote fp) data ConstitutionError = ConstitutionErrorFile (FileError TextEnvelopeError) @@ -778,23 +769,23 @@ readTxNewConstitutionActions -> [NewConstitutionFile In] -> IO (Either ConstitutionError (TxGovernanceActions era)) readTxNewConstitutionActions _ [] = return $ Right TxGovernanceActionsNone -readTxNewConstitutionActions era files = runExceptT $ - case cardanoEraStyle era of - LegacyByronEra -> - throwError . ConstitutionsNotSupportedInEra $ AnyCardanoEra era - ShelleyBasedEra sbe' -> do - supp <- governanceActionsSupportedInEra sbe' & hoistMaybe (ConstitutionsNotSupportedInEra $ AnyCardanoEra era) - constitutions <- newExceptT $ sequence <$> mapM (readConstitution sbe') files - pure $ TxGovernanceActions supp constitutions +readTxNewConstitutionActions era files = + runExceptT $ + featureInEra + (left $ ConstitutionsNotSupportedInEra $ cardanoEraConstraints era $ AnyCardanoEra era) + (\w -> do + constitutions <- newExceptT $ sequence <$> mapM (readConstitution w) files + pure $ TxGovernanceActions w constitutions + ) + era readConstitution - :: ShelleyBasedEra era + :: ConwayEraOnwards era -> NewConstitutionFile In -> IO (Either ConstitutionError (Proposal era)) -readConstitution sbe fp = - fmap (first ConstitutionErrorFile) - $ obtainEraPParamsConstraint sbe - $ shelleyBasedEraConstraints sbe (readFileTextEnvelope AsProposal fp) +readConstitution w fp = + first ConstitutionErrorFile + <$> conwayEraOnwardsConstraints w (readFileTextEnvelope AsProposal fp) -- Misc diff --git a/cardano-cli/src/Cardano/CLI/Run/Legacy/Transaction.hs b/cardano-cli/src/Cardano/CLI/Run/Legacy/Transaction.hs index 8e767e120..6d14099ed 100644 --- a/cardano-cli/src/Cardano/CLI/Run/Legacy/Transaction.hs +++ b/cardano-cli/src/Cardano/CLI/Run/Legacy/Transaction.hs @@ -376,8 +376,11 @@ runTxBuildCmd txOuts <- mapM (toTxOutInAnyEra cEra) txouts -- Conway related - votes <- newExceptT $ first ShelleyTxCmdVoteError - <$> readTxVotes cEra conwayVotes + votes <- + featureInEra + (pure TxVotesNone) + (\w -> firstExceptT ShelleyTxCmdVoteError $ ExceptT (readTxVotes w conwayVotes)) + cEra proposals <- newExceptT $ first ShelleyTxCmdConstitutionError <$> readTxNewConstitutionActions cEra newConstitutions diff --git a/flake.lock b/flake.lock index ca77b9bda..260f8c769 100644 --- a/flake.lock +++ b/flake.lock @@ -3,11 +3,11 @@ "CHaP": { "flake": false, "locked": { - "lastModified": 1690483556, - "narHash": "sha256-UOIamXYb+xLDrTYs41BaaCun2C3P/cscH4jQ+/1R3w0=", + "lastModified": 1690868125, + "narHash": "sha256-XWBliPsoJpjGYNwyblvPoiggUgsenYpgjZ2DbKcyR64=", "owner": "input-output-hk", "repo": "cardano-haskell-packages", - "rev": "290243bf6425a011825ce4afa79d05b4bf1c6024", + "rev": "4336019a843a577decab4bc02ae0de8eaba657cb", "type": "github" }, "original": {