From aa84fe95501799146614d81a729238555db8ee5b Mon Sep 17 00:00:00 2001 From: Pablo Lamela Date: Fri, 25 Oct 2024 15:31:57 +0200 Subject: [PATCH 1/2] Add function to extract anchor data from certificate --- .../internal/Cardano/Api/Certificate.hs | 70 ++++++++++++++++++- cardano-api/src/Cardano/Api.hs | 4 ++ 2 files changed, 73 insertions(+), 1 deletion(-) diff --git a/cardano-api/internal/Cardano/Api/Certificate.hs b/cardano-api/internal/Cardano/Api/Certificate.hs index cfc09a514a..94ef89fab7 100644 --- a/cardano-api/internal/Cardano/Api/Certificate.hs +++ b/cardano-api/internal/Cardano/Api/Certificate.hs @@ -3,6 +3,7 @@ {-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GADTs #-} +{-# LANGUAGE InstanceSigs #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE ScopedTypeVariables #-} @@ -56,6 +57,10 @@ module Cardano.Api.Certificate , Ledger.MIRPot (..) , selectStakeCredentialWitness + -- * Anchor data + , AnchorDataFromCertificateError (..) + , getAnchorDataFromCertificate + -- * Internal conversion functions , toShelleyCertificate , fromShelleyCertificate @@ -77,10 +82,12 @@ import Cardano.Api.Eon.ConwayEraOnwards import Cardano.Api.Eon.ShelleyBasedEra import Cardano.Api.Eon.ShelleyToBabbageEra import Cardano.Api.Eras +import Cardano.Api.Error (Error (..)) import Cardano.Api.Governance.Actions.VotingProcedure import Cardano.Api.HasTypeProxy import Cardano.Api.Keys.Praos import Cardano.Api.Keys.Shelley +import Cardano.Api.Pretty (Doc) import Cardano.Api.ReexposeLedger (EraCrypto, StandardCrypto) import qualified Cardano.Api.ReexposeLedger as Ledger import Cardano.Api.Script @@ -90,9 +97,11 @@ import Cardano.Api.StakePoolMetadata import Cardano.Api.Utils (noInlineMaybeToStrictMaybe) import Cardano.Api.Value +import Cardano.Ledger.BaseTypes (strictMaybe) import qualified Cardano.Ledger.Coin as L import qualified Cardano.Ledger.Keys as Ledger +import Control.Monad.Except (MonadError (..)) import Data.ByteString (ByteString) import qualified Data.ByteString as BS import Data.IP (IPv4, IPv6) @@ -101,7 +110,7 @@ import Data.Text (Text) import qualified Data.Text as Text import qualified Data.Text.Encoding as Text import Data.Typeable -import GHC.Exts (IsList (..)) +import GHC.Exts (IsList (..), fromString) import Network.Socket (PortNumber) -- ---------------------------------------------------------------------------- @@ -724,3 +733,62 @@ fromShelleyPoolParams fromShelleyDnsName = Text.encodeUtf8 . Ledger.dnsToText + +data AnchorDataFromCertificateError + = InvalidPoolMetadataHashError Ledger.Url ByteString + deriving (Eq, Show) + +instance Error AnchorDataFromCertificateError where + prettyError :: AnchorDataFromCertificateError -> Doc ann + prettyError (InvalidPoolMetadataHashError url hash) = + "Invalid pool metadata hash for URL " <> fromString (show url) <> ": " <> fromString (show hash) + +-- | Get anchor data hash from a certificate. A return value of `Nothing` +-- means that the certificate does not contain anchor data. +getAnchorDataFromCertificate + :: Certificate era + -> Either AnchorDataFromCertificateError (Maybe (Ledger.Anchor StandardCrypto)) +getAnchorDataFromCertificate c = + case c of + ShelleyRelatedCertificate stbe scert -> + shelleyToBabbageEraConstraints stbe $ + case scert of + Ledger.RegTxCert _ -> return Nothing + Ledger.UnRegTxCert _ -> return Nothing + Ledger.DelegStakeTxCert _ _ -> return Nothing + Ledger.RegPoolTxCert poolParams -> strictMaybe (return Nothing) anchorDataFromPoolMetadata $ Ledger.ppMetadata poolParams + Ledger.RetirePoolTxCert _ _ -> return Nothing + Ledger.GenesisDelegTxCert{} -> return Nothing + Ledger.MirTxCert _ -> return Nothing + ConwayCertificate ceo ccert -> + conwayEraOnwardsConstraints ceo $ + case ccert of + Ledger.RegTxCert _ -> return Nothing + Ledger.UnRegTxCert _ -> return Nothing + Ledger.RegDepositTxCert _ _ -> return Nothing + Ledger.UnRegDepositTxCert _ _ -> return Nothing + Ledger.RegDepositDelegTxCert{} -> return Nothing + Ledger.DelegTxCert{} -> return Nothing + Ledger.RegPoolTxCert poolParams -> strictMaybe (return Nothing) anchorDataFromPoolMetadata $ Ledger.ppMetadata poolParams + Ledger.RetirePoolTxCert _ _ -> return Nothing + Ledger.RegDRepTxCert _ _ mAnchor -> return $ Ledger.strictMaybeToMaybe mAnchor + Ledger.UnRegDRepTxCert _ _ -> return Nothing + Ledger.UpdateDRepTxCert _ mAnchor -> return $ Ledger.strictMaybeToMaybe mAnchor + Ledger.AuthCommitteeHotKeyTxCert _ _ -> return Nothing + Ledger.ResignCommitteeColdTxCert _ mAnchor -> return $ Ledger.strictMaybeToMaybe mAnchor + where + anchorDataFromPoolMetadata + :: MonadError AnchorDataFromCertificateError m + => Ledger.PoolMetadata + -> m (Maybe (Ledger.Anchor StandardCrypto)) + anchorDataFromPoolMetadata (Ledger.PoolMetadata{Ledger.pmUrl = url, Ledger.pmHash = hashBytes}) = do + hash <- + maybe (throwError $ InvalidPoolMetadataHashError url hashBytes) return $ + Ledger.hashFromBytes hashBytes + return $ + Just + ( Ledger.Anchor + { Ledger.anchorUrl = url + , Ledger.anchorDataHash = Ledger.unsafeMakeSafeHash hash + } + ) diff --git a/cardano-api/src/Cardano/Api.hs b/cardano-api/src/Cardano/Api.hs index 08f681038a..1fccca78e5 100644 --- a/cardano-api/src/Cardano/Api.hs +++ b/cardano-api/src/Cardano/Api.hs @@ -483,6 +483,10 @@ module Cardano.Api , StakePoolRelay , StakePoolMetadataReference + -- ** Anchor data + , AnchorDataFromCertificateError (..) + , getAnchorDataFromCertificate + -- * Rewards , DelegationsAndRewards (..) , mergeDelegsAndRewards From 62a42f41030b6cce960253221a11878b80b50eb4 Mon Sep 17 00:00:00 2001 From: Pablo Lamela Date: Thu, 31 Oct 2024 14:15:22 +0100 Subject: [PATCH 2/2] Add function to access anchor data from `GovAction` and fix typo --- cardano-api/internal/Cardano/Api/Certificate.hs | 2 +- .../Api/Governance/Actions/ProposalProcedure.hs | 16 ++++++++++++++++ cardano-api/src/Cardano/Api.hs | 3 +++ 3 files changed, 20 insertions(+), 1 deletion(-) diff --git a/cardano-api/internal/Cardano/Api/Certificate.hs b/cardano-api/internal/Cardano/Api/Certificate.hs index 94ef89fab7..dc1c7ee494 100644 --- a/cardano-api/internal/Cardano/Api/Certificate.hs +++ b/cardano-api/internal/Cardano/Api/Certificate.hs @@ -743,7 +743,7 @@ instance Error AnchorDataFromCertificateError where prettyError (InvalidPoolMetadataHashError url hash) = "Invalid pool metadata hash for URL " <> fromString (show url) <> ": " <> fromString (show hash) --- | Get anchor data hash from a certificate. A return value of `Nothing` +-- | Get anchor data url and hash from a certificate. A return value of `Nothing` -- means that the certificate does not contain anchor data. getAnchorDataFromCertificate :: Certificate era diff --git a/cardano-api/internal/Cardano/Api/Governance/Actions/ProposalProcedure.hs b/cardano-api/internal/Cardano/Api/Governance/Actions/ProposalProcedure.hs index 6f4b202ae0..fb4ff3b934 100644 --- a/cardano-api/internal/Cardano/Api/Governance/Actions/ProposalProcedure.hs +++ b/cardano-api/internal/Cardano/Api/Governance/Actions/ProposalProcedure.hs @@ -230,3 +230,19 @@ createAnchor url anchorData = { anchorUrl = url , anchorDataHash = hashAnchorData $ Ledger.AnchorData anchorData } + +-- | Get anchor data url and hash from a governance action. A return value of `Nothing` +-- means that the governance action does not contain anchor data. +getAnchorDataFromGovernanceAction + :: EraCrypto (ShelleyLedgerEra era) ~ StandardCrypto + => Gov.GovAction (ShelleyLedgerEra era) + -> Maybe (Ledger.Anchor StandardCrypto) +getAnchorDataFromGovernanceAction govAction = + case govAction of + Gov.ParameterChange{} -> Nothing + Gov.HardForkInitiation _ _ -> Nothing + Gov.TreasuryWithdrawals _ _ -> Nothing + Gov.NoConfidence _ -> Nothing + Gov.UpdateCommittee{} -> Nothing + Gov.NewConstitution _ constitution -> Just $ Ledger.constitutionAnchor constitution + Gov.InfoAction -> Nothing diff --git a/cardano-api/src/Cardano/Api.hs b/cardano-api/src/Cardano/Api.hs index 1fccca78e5..edc09c5299 100644 --- a/cardano-api/src/Cardano/Api.hs +++ b/cardano-api/src/Cardano/Api.hs @@ -999,6 +999,9 @@ module Cardano.Api , DRepMetadataReference , hashDRepMetadata + -- ** Governance actions + , getAnchorDataFromGovernanceAction + -- ** Governance related certificates , AnchorDataHash (..) , AnchorUrl (..)