Update selectStakeCredentialWitness to use cardano-ledger's getVKeyWi…

…tnessTxCert and getScriptWitnessTxCert which keeps track of which certificates need witnessing.
IntersectMBO · Feb 23, 2024 · 83c47ea · 83c47ea
1 parent e75f8b0
commit 83c47ea
Show file tree

Hide file tree

Showing 2 changed files with 18 additions and 28 deletions.
diff --git a/cardano-api/internal/Cardano/Api/Certificate.hs b/cardano-api/internal/Cardano/Api/Certificate.hs
@@ -85,12 +85,15 @@ import           Cardano.Api.Keys.Praos
 import           Cardano.Api.Keys.Shelley
 import           Cardano.Api.ReexposeLedger (EraCrypto, StandardCrypto)
 import qualified Cardano.Api.ReexposeLedger as Ledger
+import           Cardano.Api.Script
 import           Cardano.Api.SerialiseCBOR
 import           Cardano.Api.SerialiseTextEnvelope
 import           Cardano.Api.StakePoolMetadata
 import           Cardano.Api.Utils (noInlineMaybeToStrictMaybe)
 import           Cardano.Api.Value
 
+import qualified Cardano.Ledger.Keys as Ledger
+
 import           Data.ByteString (ByteString)
 import qualified Data.ByteString as BS
 import qualified Data.Foldable as Foldable
@@ -487,40 +490,27 @@ makeDrepUpdateCertificate (DRepUpdateRequirements conwayOnwards vcred) mAnchor =
 -- Helper functions
 --
 
+getTxCertWitness
+  :: ShelleyBasedEra era
+  -> Ledger.TxCert (ShelleyLedgerEra era)
+  -> Maybe StakeCredential
+getTxCertWitness sbe ledgerCert = shelleyBasedEraConstraints sbe $
+  case Ledger.getVKeyWitnessTxCert ledgerCert of
+    Just keyHash -> Just $ StakeCredentialByKey $ StakeKeyHash $ Ledger.coerceKeyRole keyHash
+    Nothing ->
+      StakeCredentialByScript . fromShelleyScriptHash
+        <$> Ledger.getScriptWitnessTxCert ledgerCert
+
 -- | Get the stake credential witness for a certificate that requires it.
 -- Only stake address deregistration and delegation requires witnessing (witness can be script or key).
 selectStakeCredentialWitness
   :: Certificate era
   -> Maybe StakeCredential
-selectStakeCredentialWitness = fmap fromShelleyStakeCredential . \case
+selectStakeCredentialWitness = \case
   ShelleyRelatedCertificate stbEra shelleyCert -> shelleyToBabbageEraConstraints stbEra $
-    case shelleyCert of
-      Ledger.RegTxCert _               -> Nothing -- contains stake cred
-      Ledger.UnRegTxCert sCred         -> Just sCred
-      Ledger.DelegStakeTxCert sCred _  -> Just sCred
-      -- StakePool is always controlled by key, i.e. it is never a script. In other words,
-      -- @Credential StakePool@ cannot exist, because @ScriptHashObj@ constructor can't be used for that type.
-      Ledger.RegPoolTxCert _           -> Nothing -- contains StakePool key which cannot be a credential
-      Ledger.RetirePoolTxCert _ _      -> Nothing -- contains StakePool key which cannot be a credential
-      Ledger.MirTxCert _               -> Nothing
-      Ledger.GenesisDelegTxCert{}      -> Nothing
-
+    getTxCertWitness (shelleyToBabbageEraToShelleyBasedEra stbEra) shelleyCert
   ConwayCertificate cEra conwayCert -> conwayEraOnwardsConstraints cEra $
-    case conwayCert of
-      Ledger.RegPoolTxCert _                 -> Nothing -- contains StakePool key which cannot be a credential
-      Ledger.RetirePoolTxCert _ _            -> Nothing -- contains StakePool key which cannot be a credential
-      Ledger.RegTxCert{}                     -> Nothing -- contains stake cred
-      Ledger.UnRegTxCert sCred               -> Just sCred
-      Ledger.RegDepositTxCert{}              -> Nothing -- contains stake cred
-      Ledger.UnRegDepositTxCert sCred _      -> Just sCred
-      Ledger.DelegTxCert sCred _             -> Just sCred
-      Ledger.RegDepositDelegTxCert sCred _ _ -> Just sCred
-      Ledger.AuthCommitteeHotKeyTxCert{}     -> Nothing
-      Ledger.ResignCommitteeColdTxCert _ _   -> Nothing
-      Ledger.RegDRepTxCert{}                 -> Nothing
-      Ledger.UnRegDRepTxCert{}               -> Nothing
-      Ledger.UpdateDRepTxCert{}              -> Nothing
-
+    getTxCertWitness (conwayEraOnwardsToShelleyBasedEra cEra) conwayCert
 
 filterUnRegCreds
   :: Certificate era -> Maybe StakeCredential

diff --git a/cardano-api/internal/Cardano/Api/Governance/Actions/ProposalProcedure.hs b/cardano-api/internal/Cardano/Api/Governance/Actions/ProposalProcedure.hs
@@ -80,7 +80,7 @@ toGovernanceAction sbe =
     ProposeNewConstitution prevGovAction anchor mConstitutionScriptHash ->
       Gov.NewConstitution prevGovAction Gov.Constitution
         { Gov.constitutionAnchor = anchor
-        , Gov.constitutionScript = mConstitutionScriptHash   -- TODO: Conway era
+        , Gov.constitutionScript = mConstitutionScriptHash
         }
     ProposeNewCommittee prevGovId oldCommitteeMembers newCommitteeMembers quor ->
       Gov.UpdateCommittee