Merge pull request #988 from IntersectMBO/smelc/update-api-to-10.4.0.0

Update API to 10.4.0.0
IntersectMBO · Dec 10, 2024 · 740bcc3 · 740bcc3
2 parents 0e98188 + 5768460
commit 740bcc3
Show file tree

Hide file tree

Showing 18 changed files with 85 additions and 74 deletions.
diff --git 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-10-11T15:49:11Z
-  , cardano-haskell-packages 2024-11-20T20:05:41Z
+  , cardano-haskell-packages 2024-12-05T13:51:16Z
 
 packages:
   cardano-cli

diff --git a/cardano-cli/cardano-cli.cabal b/cardano-cli/cardano-cli.cabal
@@ -207,7 +207,7 @@ library
     binary,
     bytestring,
     canonical-json,
-    cardano-api ^>=10.3,
+    cardano-api ^>=10.4,
     cardano-binary,
     cardano-crypto,
     cardano-crypto-class ^>=2.1.2,

diff --git a/cardano-cli/src/Cardano/CLI/Compatible/Transaction.hs b/cardano-cli/src/Cardano/CLI/Compatible/Transaction.hs
@@ -270,18 +270,18 @@ readUpdateProposalFile
   :: Featured ShelleyToBabbageEra era (Maybe UpdateProposalFile)
   -> ExceptT CompatibleTransactionError IO (AnyProtocolUpdate era)
 readUpdateProposalFile (Featured sToB Nothing) =
-  return $ NoPParamsUpdate $ inject sToB
+  return $ NoPParamsUpdate $ convert sToB
 readUpdateProposalFile (Featured sToB (Just updateProposalFile)) = do
   prop <- firstExceptT CompatibleFileError $ readTxUpdateProposal sToB updateProposalFile
   case prop of
-    TxUpdateProposalNone -> return $ NoPParamsUpdate $ inject sToB
+    TxUpdateProposalNone -> return $ NoPParamsUpdate $ convert 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 = inject cEraOnwards
+  let sbe = convert cEraOnwards
    in return $ NoPParamsUpdate sbe
 readProposalProcedureFile (Featured cEraOnwards proposals) = do
   props <-

diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Options/Governance/Actions.hs b/cardano-cli/src/Cardano/CLI/EraBased/Options/Governance/Actions.hs
@@ -185,11 +185,11 @@ pUpdateProtocolParametersCmd
 pUpdateProtocolParametersCmd =
   caseShelleyToBabbageOrConwayEraOnwards
     ( \shelleyToBab ->
-        let sbe = inject shelleyToBab
+        let sbe = convert shelleyToBab
          in subParser "create-protocol-parameters-update"
               $ Opt.info
                 ( Cmd.GovernanceActionProtocolParametersUpdateCmdArgs
-                    (inject shelleyToBab)
+                    (convert shelleyToBab)
                     <$> fmap Just (pUpdateProtocolParametersPreConway shelleyToBab)
                     <*> pure Nothing
                     <*> dpGovActionProtocolParametersUpdate sbe
@@ -199,11 +199,11 @@ pUpdateProtocolParametersCmd =
               $ Opt.progDesc "Create a protocol parameters update."
     )
     ( \conwayOnwards ->
-        let sbe = inject conwayOnwards
+        let sbe = convert conwayOnwards
          in subParser "create-protocol-parameters-update"
               $ Opt.info
                 ( Cmd.GovernanceActionProtocolParametersUpdateCmdArgs
-                    (inject conwayOnwards)
+                    (convert conwayOnwards)
                     Nothing
                     <$> fmap Just (pUpdateProtocolParametersPostConway conwayOnwards)
                     <*> dpGovActionProtocolParametersUpdate sbe

diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Options/Query.hs b/cardano-cli/src/Cardano/CLI/EraBased/Options/Query.hs
@@ -631,7 +631,7 @@ pQueryNoArgCmdArgs
   -> Parser (QueryNoArgCmdArgs era)
 pQueryNoArgCmdArgs w envCli =
   QueryNoArgCmdArgs w
-    <$> pQueryCommons (inject w :: ShelleyBasedEra era) envCli
+    <$> pQueryCommons (convert w) envCli
     <*> pMaybeOutputFile
 
 pQueryCommons

diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Options/StakeAddress.hs b/cardano-cli/src/Cardano/CLI/EraBased/Options/StakeAddress.hs
@@ -121,7 +121,7 @@ pStakeAddressDeregistrationCertificateCmd =
     ( \shelleyToBabbage ->
         subParser "deregistration-certificate"
           $ Opt.info
-            ( StakeAddressDeregistrationCertificateCmd (inject shelleyToBabbage)
+            ( StakeAddressDeregistrationCertificateCmd (convert shelleyToBabbage)
                 <$> pStakeIdentifier Nothing
                 <*> pure Nothing
                 <*> pOutputFile
@@ -131,7 +131,7 @@ pStakeAddressDeregistrationCertificateCmd =
     ( \conwayOnwards ->
         subParser "deregistration-certificate"
           $ Opt.info
-            ( StakeAddressDeregistrationCertificateCmd (inject conwayOnwards)
+            ( StakeAddressDeregistrationCertificateCmd (convert conwayOnwards)
                 <$> pStakeIdentifier Nothing
                 <*> fmap Just pKeyRegistDeposit
                 <*> pOutputFile

diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Options/Transaction.hs b/cardano-cli/src/Cardano/CLI/EraBased/Options/Transaction.hs
@@ -227,7 +227,7 @@ pTransactionBuildEstimateCmd eon' _envCli = do
  where
   pCmd :: Exp.Era era -> Parser (TransactionCmds era)
   pCmd era' = do
-    let sbe = inject era'
+    let sbe = convert era'
     fmap TransactionBuildEstimateCmd $
       TransactionBuildEstimateCmdArgs era'
         <$> optional pScriptValidity

diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Run/Genesis.hs b/cardano-cli/src/Cardano/CLI/EraBased/Run/Genesis.hs
@@ -332,11 +332,11 @@ generateShelleyNodeSecrets shelleyDelegateKeys shelleyGenesisvkeys = do
     createOpCert (kesKey, delegateKey) = either (error . show) id eResult
      where
       eResult = issueOperationalCertificate kesKey (Right delegateKey) (KESPeriod 0) counter
-      counter = OperationalCertificateIssueCounter 0 (convert . getVerificationKey $ delegateKey)
-      convert
+      counter = OperationalCertificateIssueCounter 0 (convertFun . getVerificationKey $ delegateKey)
+      convertFun
         :: VerificationKey GenesisDelegateExtendedKey
         -> VerificationKey StakePoolKey
-      convert =
+      convertFun =
         ( castVerificationKey
             :: VerificationKey GenesisDelegateKey
             -> VerificationKey StakePoolKey

diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Run/Governance.hs b/cardano-cli/src/Cardano/CLI/EraBased/Run/Governance.hs
@@ -93,7 +93,7 @@ runGovernanceMIRCertificatePayStakeAddrs w mirPot sAddrs rwdAmts oFp = do
         makeMIRCertificate $
           MirCertificateRequirements w mirPot $
             shelleyToBabbageEraConstraints w mirTarget
-      sbe :: ShelleyBasedEra era = inject w
+      sbe = convert w
 
   firstExceptT GovernanceCmdTextEnvWriteError
     . newExceptT
@@ -115,7 +115,7 @@ runGovernanceCreateMirCertificateTransferToTreasuryCmd w ll oFp = do
   let mirTarget = L.SendToOppositePotMIR ll
 
   let mirCert = makeMIRCertificate $ MirCertificateRequirements w L.ReservesMIR mirTarget
-      sbe :: ShelleyBasedEra era = inject w
+      sbe = convert w
 
   firstExceptT GovernanceCmdTextEnvWriteError
     . newExceptT
@@ -137,7 +137,7 @@ runGovernanceCreateMirCertificateTransferToReservesCmd w ll oFp = do
   let mirTarget = L.SendToOppositePotMIR ll
 
   let mirCert = makeMIRCertificate $ MirCertificateRequirements w L.TreasuryMIR mirTarget
-      sbe :: ShelleyBasedEra era = inject w
+      sbe = convert w
 
   firstExceptT GovernanceCmdTextEnvWriteError
     . newExceptT

diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Run/Governance/Actions.hs b/cardano-cli/src/Cardano/CLI/EraBased/Run/Governance/Actions.hs
@@ -105,7 +105,7 @@ runGovernanceActionInfoCmd
 
     carryHashChecks checkProposalHash proposalAnchor ProposalCheck
 
-    let sbe :: ShelleyBasedEra era = inject eon
+    let sbe = convert eon
         govAction = InfoAct
         proposalProcedure = createProposalProcedure sbe networkId deposit depositStakeCredential govAction proposalAnchor
 
@@ -147,7 +147,7 @@ runGovernanceActionCreateNoConfidenceCmd
 
     carryHashChecks checkProposalHash proposalAnchor ProposalCheck
 
-    let sbe :: ShelleyBasedEra era = inject eon
+    let sbe = convert eon
         previousGovernanceAction =
           MotionOfNoConfidence $
             L.maybeToStrictMaybe $
@@ -214,7 +214,7 @@ runGovernanceActionCreateConstitutionCmd
             prevGovActId
             constitutionAnchor
             (toShelleyScriptHash <$> L.maybeToStrictMaybe constitutionScript)
-        sbe :: ShelleyBasedEra era = inject eon
+        sbe = convert eon
         proposalProcedure = createProposalProcedure sbe networkId deposit depositStakeCredential govAct proposalAnchor
 
     carryHashChecks checkConstitutionHash constitutionAnchor ConstitutionCheck
@@ -248,7 +248,7 @@ runGovernanceActionUpdateCommitteeCmd
     , Cmd.mPrevGovernanceActionId
     , Cmd.outFile
     } = do
-    let sbe :: ShelleyBasedEra era = inject eon
+    let sbe = convert eon
         govActIdentifier =
           L.maybeToStrictMaybe $
             shelleyBasedEraConstraints sbe $
@@ -315,7 +315,7 @@ runGovernanceActionCreateProtocolParametersUpdateCmd eraBasedPParams' = do
   caseShelleyToBabbageOrConwayEraOnwards
     ( \sToB -> do
         let oFp = uppFilePath eraBasedPParams'
-            anyEra = AnyShelleyBasedEra (inject sToB :: ShelleyBasedEra era)
+            anyEra = AnyShelleyBasedEra (convert sToB)
         UpdateProtocolParametersPreConway _stB expEpoch genesisVerKeys <-
           hoistMaybe (GovernanceActionsValueUpdateProtocolParametersNotFound anyEra) $
             uppPreConway eraBasedPParams'
@@ -341,7 +341,7 @@ runGovernanceActionCreateProtocolParametersUpdateCmd eraBasedPParams' = do
     )
     ( \conwayOnwards -> do
         let oFp = uppFilePath eraBasedPParams'
-            anyEra = AnyShelleyBasedEra (inject conwayOnwards :: ShelleyBasedEra era)
+            anyEra = AnyShelleyBasedEra (convert conwayOnwards)
 
         UpdateProtocolParametersConwayOnwards
           _cOnwards
@@ -453,7 +453,7 @@ runGovernanceActionTreasuryWithdrawalCmd
         firstExceptT GovernanceActionsReadStakeCredErrror $ getStakeCredentialFromIdentifier stakeIdentifier
       pure (networkId, stakeCredential, lovelace)
 
-    let sbe :: ShelleyBasedEra era = inject eon
+    let sbe = convert eon
         treasuryWithdrawals =
           TreasuryWithdrawal
             withdrawals
@@ -501,7 +501,7 @@ runGovernanceActionHardforkInitCmd
 
     carryHashChecks checkProposalHash proposalAnchor ProposalCheck
 
-    let sbe :: ShelleyBasedEra era = inject eon
+    let sbe = convert eon
         govActIdentifier =
           L.maybeToStrictMaybe $
             shelleyBasedEraConstraints sbe $

diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Run/Governance/GenesisKeyDelegationCertificate.hs b/cardano-cli/src/Cardano/CLI/EraBased/Run/Governance/GenesisKeyDelegationCertificate.hs
@@ -44,7 +44,7 @@ runGovernanceGenesisKeyDelegationCertificate
     firstExceptT GovernanceCmdTextEnvWriteError
       . newExceptT
       $ writeLazyByteStringFile oFp
-      $ shelleyBasedEraConstraints (inject stb :: ShelleyBasedEra era)
+      $ shelleyBasedEraConstraints (convert stb)
       $ textEnvelopeToJSON (Just genKeyDelegCertDesc) genKeyDelegCert
    where
     genKeyDelegCertDesc :: TextEnvelopeDescr

diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Run/Governance/Vote.hs b/cardano-cli/src/Cardano/CLI/EraBased/Run/Governance/Vote.hs
@@ -55,7 +55,7 @@ runGovernanceVoteCreateCmd
     , outFile
     } = do
     let (govActionTxId, govActionIndex) = governanceAction
-        sbe :: ShelleyBasedEra era = inject eon -- TODO: Conway era - update vote creation related function to take ConwayEraOnwards
+        sbe = convert eon -- TODO: Conway era - update vote creation related function to take ConwayEraOnwards
         mAnchor' =
           fmap
             ( \pca@PotentiallyCheckedAnchor{pcaAnchor = (VoteUrl url, voteHash)} ->
@@ -104,7 +104,7 @@ runGovernanceVoteViewCmd
     , voteFile
     , mOutFile
     } = do
-    let sbe :: ShelleyBasedEra era = inject eon
+    let sbe :: ShelleyBasedEra era = convert eon
 
     shelleyBasedEraConstraints sbe $ do
       voteProcedures <-

diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Run/Transaction.hs b/cardano-cli/src/Cardano/CLI/EraBased/Run/Transaction.hs
@@ -52,6 +52,7 @@ import           Cardano.CLI.EraBased.Script.Mint.Read
 import           Cardano.CLI.EraBased.Script.Mint.Types
 import           Cardano.CLI.EraBased.Transaction.HashCheck (checkCertificateHashes,
                    checkProposalHashes, checkVotingProcedureHashes)
+import           Cardano.CLI.Orphans ()
 import           Cardano.CLI.Read
 import           Cardano.CLI.Types.Common
 import           Cardano.CLI.Types.Errors.BootstrapWitnessError
@@ -139,7 +140,7 @@ runTransactionBuildCmd
     , treasuryDonation -- Maybe TxTreasuryDonation
     , buildOutputOptions
     } = do
-    let eon = inject currentEra
+    let eon = convert currentEra
         era' = toCardanoEra eon
 
     -- The user can specify an era prior to the era that the node is currently in.
@@ -217,9 +218,9 @@ runTransactionBuildCmd
 
     let returnAddrHashes =
           fromList
-            [ StakeCredentialByKey returnAddrHash
+            [ stakeCred
             | (proposal, _) <- proposals
-            , let (_, returnAddrHash, _) = fromProposalProcedure eon proposal -- fromProposalProcedure needs to be adjusted so that it works with script hashes.
+            , let (_, stakeCred, _) = fromProposalProcedure eon proposal
             ]
         treasuryWithdrawalAddresses =
           fromList
@@ -395,8 +396,8 @@ runTransactionBuildEstimateCmd -- TODO change type
     , currentTreasuryValueAndDonation
     , txBodyOutFile
     } = do
-    let sbe = inject currentEra
-        meo = inject @(BabbageEraOnwards era) $ inject currentEra
+    let sbe = convert currentEra
+        meo = convert currentEra
 
     ledgerPParams <-
       firstExceptT TxCmdProtocolParamsError $ readProtocolParameters sbe protocolParamsFile
@@ -522,8 +523,8 @@ runTransactionBuildEstimateCmd -- TODO change type
 
     let noWitTx = makeSignedTransaction [] balancedTxBody
     lift
-      ( cardanoEraConstraints (toCardanoEra meo) $
-          writeTxFileTextEnvelopeCddl (inject meo) txBodyOutFile noWitTx
+      ( cardanoEraConstraints (toCardanoEra sbe) $
+          writeTxFileTextEnvelopeCddl sbe txBodyOutFile noWitTx
       )
       & onLeft (left . TxCmdWriteFileError)
 
@@ -1145,11 +1146,11 @@ convertCertificates sbe certsAndScriptWitnesses =
   TxCertificates sbe certs $ BuildTxWith reqWits
  where
   certs = map fst certsAndScriptWitnesses
-  reqWits = fromList $ mapMaybe convert certsAndScriptWitnesses
-  convert
+  reqWits = fromList $ mapMaybe convertCert certsAndScriptWitnesses
+  convertCert
     :: (Certificate era, Maybe (ScriptWitness WitCtxStake era))
     -> Maybe (StakeCredential, Witness WitCtxStake era)
-  convert (cert, mScriptWitnessFiles) = do
+  convertCert (cert, mScriptWitnessFiles) = do
     sCred <- selectStakeCredentialWitness cert
     Just $ case mScriptWitnessFiles of
       Just sWit -> (sCred, ScriptWitness ScriptWitnessForStakeAddr sWit)
@@ -1178,12 +1179,12 @@ txFeatureMismatchPure era feature =
 validateTxIns
   :: [(TxIn, Maybe (ScriptWitness WitCtxTxIn era))]
   -> [(TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn era))]
-validateTxIns = map convert
+validateTxIns = map convertTxIn
  where
-  convert
+  convertTxIn
     :: (TxIn, Maybe (ScriptWitness WitCtxTxIn era))
     -> (TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn era))
-  convert (txin, mScriptWitness) =
+  convertTxIn (txin, mScriptWitness) =
     case mScriptWitness of
       Just sWit ->
         (txin, BuildTxWith $ ScriptWitness ScriptWitnessForSpending sWit)

diff --git a/cardano-cli/src/Cardano/CLI/Json/Friendly.hs b/cardano-cli/src/Cardano/CLI/Json/Friendly.hs
@@ -789,7 +789,7 @@ friendlyLovelace value = String $ docToText (pretty value)
 friendlyMintValue :: forall era. TxMintValue ViewTx era -> Aeson.Value
 friendlyMintValue = \case
   TxMintNone -> Null
-  txMintValue@(TxMintValue w _) -> friendlyValue @era (inject w) $ txMintValueToValue txMintValue
+  txMintValue@(TxMintValue w _) -> friendlyValue @era (convert w) $ txMintValueToValue txMintValue
 
 friendlyTxOutValue :: TxOutValue era -> Aeson.Value
 friendlyTxOutValue = \case

diff --git a/cardano-cli/src/Cardano/CLI/Orphans.hs b/cardano-cli/src/Cardano/CLI/Orphans.hs
@@ -1,3 +1,6 @@
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
 {-# OPTIONS_GHC -Wno-orphans #-}
 
 module Cardano.CLI.Orphans
@@ -6,6 +9,7 @@ module Cardano.CLI.Orphans
 where
 
 import           Cardano.Api
+import qualified Cardano.Api.Experimental as Exp
 import qualified Cardano.Api.Ledger as L
 import           Cardano.Api.Shelley (scriptDataToJsonDetailedSchema)
 
@@ -29,3 +33,9 @@ instance ToJSON HashableScriptData where
       [ "hash" .= hashScriptDataBytes hsd
       , "json" .= scriptDataToJsonDetailedSchema hsd
       ]
+
+-- TODO Delete me when added in API
+instance Convert Exp.Era MaryEraOnwards where
+  convert = \case
+    Exp.BabbageEra -> MaryEraOnwardsBabbage
+    Exp.ConwayEra -> MaryEraOnwardsConway
diff --git a/cardano-cli/src/Cardano/CLI/Read.hs b/cardano-cli/src/Cardano/CLI/Read.hs
@@ -985,7 +985,7 @@ readSingleVote w (voteFp, mScriptWitFiles) = do
   case mScriptWitFiles of
     Nothing -> pure $ (,Nothing) <$> votProceds
     sWitFile -> do
-      let sbe = inject w
+      let sbe = convert w
       runExceptT $ do
         sWits <-
           firstExceptT VoteErrorScriptWitness $
@@ -1031,7 +1031,7 @@ readProposal w (fp, mScriptWit) = do
   case mScriptWit of
     Nothing -> pure $ (,Nothing) <$> prop
     sWitFile -> do
-      let sbe = inject w
+      let sbe = convert w
       runExceptT $ do
         sWit <-
           firstExceptT ProposalErrorScriptWitness $