From 988a291a0b3a6e4f9ba3bb6c0f8effb6e3d6d618 Mon Sep 17 00:00:00 2001 From: Mateusz Galazyn Date: Mon, 18 Mar 2024 19:06:06 +0100 Subject: [PATCH] Add support for script-based CC members MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Co-authored-by: Clément Hurlin --- .../internal/Cardano/Api/Certificate.hs | 6 ++-- .../Governance/Actions/ProposalProcedure.hs | 32 ++++++------------- .../internal/Cardano/Api/Keys/Class.hs | 15 ++++++--- .../internal/Cardano/Api/Keys/Shelley.hs | 22 ++++++------- 4 files changed, 34 insertions(+), 41 deletions(-) diff --git a/cardano-api/internal/Cardano/Api/Certificate.hs b/cardano-api/internal/Cardano/Api/Certificate.hs index 05abca7a41..46fc3f944e 100644 --- a/cardano-api/internal/Cardano/Api/Certificate.hs +++ b/cardano-api/internal/Cardano/Api/Certificate.hs @@ -423,18 +423,18 @@ makeCommitteeHotKeyAuthorizationCertificate (CommitteeHotKeyAuthorizationRequire data CommitteeColdkeyResignationRequirements era where CommitteeColdkeyResignationRequirements :: ConwayEraOnwards era - -> Ledger.KeyHash Ledger.ColdCommitteeRole (EraCrypto (ShelleyLedgerEra era)) + -> Ledger.Credential Ledger.ColdCommitteeRole (EraCrypto (ShelleyLedgerEra era)) -> Maybe (Ledger.Anchor (EraCrypto (ShelleyLedgerEra era))) -> CommitteeColdkeyResignationRequirements era makeCommitteeColdkeyResignationCertificate :: () => CommitteeColdkeyResignationRequirements era -> Certificate era -makeCommitteeColdkeyResignationCertificate (CommitteeColdkeyResignationRequirements cOnwards coldKeyHash anchor) = +makeCommitteeColdkeyResignationCertificate (CommitteeColdkeyResignationRequirements cOnwards coldKeyCred anchor) = ConwayCertificate cOnwards . Ledger.ConwayTxCertGov $ Ledger.ConwayResignCommitteeColdKey - (Ledger.KeyHashObj coldKeyHash) + coldKeyCred (noInlineMaybeToStrictMaybe anchor) data DRepUnregistrationRequirements era where diff --git a/cardano-api/internal/Cardano/Api/Governance/Actions/ProposalProcedure.hs b/cardano-api/internal/Cardano/Api/Governance/Actions/ProposalProcedure.hs index ebb26b5134..ad2370b476 100644 --- a/cardano-api/internal/Cardano/Api/Governance/Actions/ProposalProcedure.hs +++ b/cardano-api/internal/Cardano/Api/Governance/Actions/ProposalProcedure.hs @@ -37,10 +37,9 @@ import Cardano.Ledger.Keys (KeyRole (ColdCommitteeRole)) import Data.ByteString (ByteString) import Data.Map.Strict (Map) -import qualified Data.Map.Strict as Map import Data.Maybe (fromMaybe) -import qualified Data.Set as Set import Data.Word +import GHC.Exts (IsList (..)) data AnyGovernanceAction = forall era. AnyGovernanceAction (Gov.GovAction era) @@ -54,8 +53,8 @@ data GovernanceAction era (StrictMaybe (Shelley.ScriptHash StandardCrypto)) | ProposeNewCommittee (StrictMaybe (Ledger.GovPurposeId Ledger.CommitteePurpose (ShelleyLedgerEra era))) - [Hash CommitteeColdKey] -- ^ Old constitutional committee - (Map (Hash CommitteeColdKey) EpochNo) -- ^ New committee members with epoch number when each of them expires + [L.Credential ColdCommitteeRole StandardCrypto] -- ^ Old constitutional committee + (Map (L.Credential ColdCommitteeRole StandardCrypto) EpochNo) -- ^ New committee members with epoch number when each of them expires Rational -- ^ Quorum of the committee that is necessary for a successful vote | InfoAct | TreasuryWithdrawal @@ -85,8 +84,8 @@ toGovernanceAction sbe = ProposeNewCommittee prevGovId oldCommitteeMembers newCommitteeMembers quor -> Gov.UpdateCommittee prevGovId -- previous governance action id - (Set.fromList $ map toCommitteeMember oldCommitteeMembers) -- members to remove - (Map.mapKeys toCommitteeMember newCommitteeMembers) -- members to add + (fromList oldCommitteeMembers) -- members to remove + newCommitteeMembers -- members to add (fromMaybe (error $ mconcat ["toGovernanceAction: the given quorum " , show quor , " was outside of the unit interval!" @@ -95,7 +94,7 @@ toGovernanceAction sbe = InfoAct -> Gov.InfoAction TreasuryWithdrawal withdrawals govPol -> - let m = Map.fromList [(L.RewardAcnt nw (toShelleyStakeCredential sc), l) | (nw,sc,l) <- withdrawals] + let m = fromList [(L.RewardAcnt nw (toShelleyStakeCredential sc), l) | (nw,sc,l) <- withdrawals] in Gov.TreasuryWithdrawals m govPol InitiateHardfork prevGovId pVer -> Gov.HardForkInitiation prevGovId pVer @@ -119,14 +118,14 @@ fromGovernanceAction = \case InitiateHardfork prevGovId pVer Gov.TreasuryWithdrawals withdrawlMap govPolicy -> let res = [ (L.getRwdNetwork rwdAcnt, fromShelleyStakeCredential (L.getRwdCred rwdAcnt), coin) - | (rwdAcnt, coin) <- Map.toList withdrawlMap + | (rwdAcnt, coin) <- toList withdrawlMap ] in TreasuryWithdrawal res govPolicy Gov.UpdateCommittee prevGovId oldCommitteeMembers newCommitteeMembers quor -> ProposeNewCommittee prevGovId - (map fromCommitteeMember $ Set.toList oldCommitteeMembers) - (Map.mapKeys fromCommitteeMember newCommitteeMembers) + (toList oldCommitteeMembers) + newCommitteeMembers (unboundRational quor) Gov.InfoAction -> InfoAct @@ -215,16 +214,3 @@ createAnchor url anchorData = , anchorDataHash = hashAnchorData $ Ledger.AnchorData anchorData } --- ---------------------------------------------------------------------------- --- TODO conversions that likely need to live elsewhere and may even deserve --- additional wrapper types - -toCommitteeMember :: Hash CommitteeColdKey -> L.Credential ColdCommitteeRole StandardCrypto -toCommitteeMember (CommitteeColdKeyHash keyhash) = L.KeyHashObj keyhash - -fromCommitteeMember :: L.Credential ColdCommitteeRole StandardCrypto -> Hash CommitteeColdKey -fromCommitteeMember = \case - L.KeyHashObj keyhash -> CommitteeColdKeyHash keyhash - L.ScriptHashObj _scripthash -> error "TODO script committee members not yet supported" - - diff --git a/cardano-api/internal/Cardano/Api/Keys/Class.hs b/cardano-api/internal/Cardano/Api/Keys/Class.hs index 1d7c00729a..5eb4679084 100644 --- a/cardano-api/internal/Cardano/Api/Keys/Class.hs +++ b/cardano-api/internal/Cardano/Api/Keys/Class.hs @@ -20,6 +20,7 @@ import Cardano.Api.SerialiseTextEnvelope import qualified Cardano.Crypto.DSIGN.Class as Crypto import qualified Cardano.Crypto.Seed as Crypto +import Control.Monad.IO.Class import Data.Kind (Type) import qualified System.Random as Random import System.Random (StdGen) @@ -68,19 +69,25 @@ class (Eq (VerificationKey keyrole), -- For KES we can then override it to keep the seed and key in mlocked memory at all times. -- | Generate a 'SigningKey' using a seed from operating system entropy. -- -generateSigningKey :: Key keyrole => AsType keyrole -> IO (SigningKey keyrole) +generateSigningKey + :: MonadIO m + => Key keyrole + => AsType keyrole + -> m (SigningKey keyrole) generateSigningKey keytype = do - seed <- Crypto.readSeedFromSystemEntropy seedSize + seed <- liftIO $ Crypto.readSeedFromSystemEntropy seedSize return $! deterministicSigningKey keytype seed where seedSize = deterministicSigningKeySeedSize keytype generateInsecureSigningKey - :: (Key keyrole, SerialiseAsRawBytes (SigningKey keyrole)) + :: MonadIO m + => Key keyrole + => SerialiseAsRawBytes (SigningKey keyrole) => StdGen -> AsType keyrole - -> IO (SigningKey keyrole, StdGen) + -> m (SigningKey keyrole, StdGen) generateInsecureSigningKey g keytype = do let (bs, g') = Random.genByteString (fromIntegral $ deterministicSigningKeySeedSize keytype) g case deserialiseFromRawBytes (AsSigningKey keytype) bs of diff --git a/cardano-api/internal/Cardano/Api/Keys/Shelley.hs b/cardano-api/internal/Cardano/Api/Keys/Shelley.hs index fb3931f677..c83dac5801 100644 --- a/cardano-api/internal/Cardano/Api/Keys/Shelley.hs +++ b/cardano-api/internal/Cardano/Api/Keys/Shelley.hs @@ -147,7 +147,7 @@ instance SerialiseAsBech32 (SigningKey PaymentKey) where bech32PrefixesPermitted _ = ["addr_sk"] newtype instance Hash PaymentKey = - PaymentKeyHash (Shelley.KeyHash Shelley.Payment StandardCrypto) + PaymentKeyHash { unPaymentKeyHash :: Shelley.KeyHash Shelley.Payment StandardCrypto } deriving stock (Eq, Ord) deriving (Show, IsString) via UsingRawBytesHex (Hash PaymentKey) deriving (ToCBOR, FromCBOR) via UsingRawBytes (Hash PaymentKey) @@ -294,7 +294,7 @@ instance SerialiseAsBech32 (SigningKey PaymentExtendedKey) where newtype instance Hash PaymentExtendedKey = - PaymentExtendedKeyHash (Shelley.KeyHash Shelley.Payment StandardCrypto) + PaymentExtendedKeyHash { unPaymentExtendedKeyHash :: Shelley.KeyHash Shelley.Payment StandardCrypto } deriving stock (Eq, Ord) deriving (Show, IsString) via UsingRawBytesHex (Hash PaymentExtendedKey) deriving (ToCBOR, FromCBOR) via UsingRawBytes (Hash PaymentExtendedKey) @@ -400,7 +400,7 @@ instance SerialiseAsBech32 (SigningKey StakeKey) where newtype instance Hash StakeKey = - StakeKeyHash (Shelley.KeyHash Shelley.Staking StandardCrypto) + StakeKeyHash { unStakeKeyHash :: Shelley.KeyHash Shelley.Staking StandardCrypto } deriving stock (Eq, Ord) deriving (Show, IsString) via UsingRawBytesHex (Hash StakeKey) deriving (ToCBOR, FromCBOR) via UsingRawBytes (Hash StakeKey) @@ -543,7 +543,7 @@ instance SerialiseAsBech32 (SigningKey StakeExtendedKey) where newtype instance Hash StakeExtendedKey = - StakeExtendedKeyHash (Shelley.KeyHash Shelley.Staking StandardCrypto) + StakeExtendedKeyHash { unStakeExtendedKeyHash :: Shelley.KeyHash Shelley.Staking StandardCrypto } deriving stock (Eq, Ord) deriving (Show, IsString) via UsingRawBytesHex (Hash StakeExtendedKey) deriving (ToCBOR, FromCBOR) via UsingRawBytes (Hash StakeExtendedKey) @@ -640,7 +640,7 @@ instance SerialiseAsRawBytes (SigningKey GenesisKey) where newtype instance Hash GenesisKey = - GenesisKeyHash (Shelley.KeyHash Shelley.Genesis StandardCrypto) + GenesisKeyHash { unGenesisKeyHash :: Shelley.KeyHash Shelley.Genesis StandardCrypto } deriving stock (Eq, Ord) deriving (Show, IsString) via UsingRawBytesHex (Hash GenesisKey) deriving (ToCBOR, FromCBOR) via UsingRawBytes (Hash GenesisKey) @@ -738,7 +738,7 @@ instance SerialiseAsRawBytes (SigningKey CommitteeHotKey) where newtype instance Hash CommitteeHotKey = - CommitteeHotKeyHash (Shelley.KeyHash Shelley.HotCommitteeRole StandardCrypto) + CommitteeHotKeyHash { unCommitteeHotKeyHash :: Shelley.KeyHash Shelley.HotCommitteeRole StandardCrypto } deriving stock (Eq, Ord) deriving (Show, IsString) via UsingRawBytesHex (Hash CommitteeHotKey) deriving (ToCBOR, FromCBOR) via UsingRawBytes (Hash CommitteeHotKey) @@ -846,7 +846,7 @@ instance SerialiseAsRawBytes (SigningKey CommitteeColdKey) where newtype instance Hash CommitteeColdKey = - CommitteeColdKeyHash (Shelley.KeyHash Shelley.ColdCommitteeRole StandardCrypto) + CommitteeColdKeyHash { unCommitteeColdKeyHash :: Shelley.KeyHash Shelley.ColdCommitteeRole StandardCrypto } deriving stock (Eq, Ord) deriving (Show, IsString) via UsingRawBytesHex (Hash CommitteeColdKey) deriving (ToCBOR, FromCBOR) via UsingRawBytes (Hash CommitteeColdKey) @@ -1251,7 +1251,7 @@ instance SerialiseAsRawBytes (SigningKey GenesisExtendedKey) where newtype instance Hash GenesisExtendedKey = - GenesisExtendedKeyHash (Shelley.KeyHash Shelley.Staking StandardCrypto) + GenesisExtendedKeyHash { unGenesisExtendedKeyHash :: Shelley.KeyHash Shelley.Staking StandardCrypto } deriving stock (Eq, Ord) deriving (Show, IsString) via UsingRawBytesHex (Hash GenesisExtendedKey) deriving (ToCBOR, FromCBOR) via UsingRawBytes (Hash GenesisExtendedKey) @@ -1349,7 +1349,7 @@ instance SerialiseAsRawBytes (SigningKey GenesisDelegateKey) where newtype instance Hash GenesisDelegateKey = - GenesisDelegateKeyHash (Shelley.KeyHash Shelley.GenesisDelegate StandardCrypto) + GenesisDelegateKeyHash { unGenesisDelegateKeyHash :: Shelley.KeyHash Shelley.GenesisDelegate StandardCrypto } deriving stock (Eq, Ord) deriving (Show, IsString) via UsingRawBytesHex (Hash GenesisDelegateKey) deriving (ToCBOR, FromCBOR) via UsingRawBytes (Hash GenesisDelegateKey) @@ -1492,7 +1492,7 @@ instance SerialiseAsRawBytes (SigningKey GenesisDelegateExtendedKey) where newtype instance Hash GenesisDelegateExtendedKey = - GenesisDelegateExtendedKeyHash (Shelley.KeyHash Shelley.Staking StandardCrypto) + GenesisDelegateExtendedKeyHash { unGenesisDelegateExtendedKeyHash :: Shelley.KeyHash Shelley.Staking StandardCrypto } deriving stock (Eq, Ord) deriving (Show, IsString) via UsingRawBytesHex (Hash GenesisDelegateExtendedKey) deriving (ToCBOR, FromCBOR) via UsingRawBytes (Hash GenesisDelegateExtendedKey) @@ -1589,7 +1589,7 @@ instance SerialiseAsRawBytes (SigningKey GenesisUTxOKey) where newtype instance Hash GenesisUTxOKey = - GenesisUTxOKeyHash (Shelley.KeyHash Shelley.Payment StandardCrypto) + GenesisUTxOKeyHash { unGenesisUTxOKeyHash :: Shelley.KeyHash Shelley.Payment StandardCrypto } deriving stock (Eq, Ord) deriving (Show, IsString) via UsingRawBytesHex (Hash GenesisUTxOKey) deriving (ToCBOR, FromCBOR) via UsingRawBytes (Hash GenesisUTxOKey)