From 67a089a487bc85db5503fae96d803c0156684b82 Mon Sep 17 00:00:00 2001 From: Mateusz Galazyn Date: Fri, 7 Jul 2023 14:22:03 +0200 Subject: [PATCH] Vote procedure some work --- .../Api/Governance/Actions/VotingProcedure.hs | 49 ++++--- .../internal/Cardano/Api/Keys/Shelley.hs | 120 ++++++++++++++++++ 2 files changed, 151 insertions(+), 18 deletions(-) diff --git a/cardano-api/internal/Cardano/Api/Governance/Actions/VotingProcedure.hs b/cardano-api/internal/Cardano/Api/Governance/Actions/VotingProcedure.hs index 35e4503948..681d49764d 100644 --- a/cardano-api/internal/Cardano/Api/Governance/Actions/VotingProcedure.hs +++ b/cardano-api/internal/Cardano/Api/Governance/Actions/VotingProcedure.hs @@ -30,11 +30,12 @@ import qualified Cardano.Ledger.Conway.Governance as Gov import Cardano.Ledger.Core (EraCrypto) import qualified Cardano.Ledger.Core as Shelley import qualified Cardano.Ledger.Credential as Ledger -import Cardano.Ledger.Keys +import Cardano.Ledger.Keys hiding (Hash) import qualified Cardano.Ledger.TxIn as Ledger import Data.ByteString.Lazy (ByteString) import Data.Maybe.Strict +import Cardano.Api.Keys.Shelley (DRepKey, StakePoolKey, CommitteeKey) -- | A representation of whether the era supports tx voting on governance actions. -- @@ -91,27 +92,39 @@ makeGoveranceActionIdentifier sbe txin = -- toVotingCredential :: _ -> Ledger.Credential 'Voting (EraCrypto ledgerera) -- toVotingCredential = undefined +data CommitteeCredential + = CommitteeCredentialByKey (Hash CommitteeKey) + | CommitteeCredentialByScript ScriptHash + deriving (Eq, Ord, Show) + +data DRepCredential + = DRepCredentialByKey (Hash DRepKey) + | DRepCredentialByScript ScriptHash + deriving (Eq, Ord, Show) + data VoterType - = CC -- ^ Constitutional committee - | DR -- ^ Delegated representative - | SP -- ^ Stake pool operator + = CC CommitteeCredential -- ^ Constitutional committee + | DR DRepCredential-- ^ Delegated representative + | SP (Hash StakePoolKey) -- ^ Stake pool operator deriving (Show, Eq) -data VoteChoice - = No - | Yes - | Abst -- ^ Abstain - deriving (Show, Eq) +-- data VoteChoice +-- = No +-- | Yes +-- | Abst -- ^ Abstain +-- deriving (Show, Eq) -toVoterRole :: VoterType -> Gov.Voter -toVoterRole CC = Gov.CommitteeVoter -toVoterRole DR = Gov.DRepVoter -toVoterRole SP = Gov.StakePoolVoter +toVoterRole :: VoterType -> Gov.Voter c +toVoterRole (CC (CommitteeCredentialByKey kh)) = Gov.CommitteeVoter $ undefined +toVoterRole (CC (CommitteeCredentialByScript sh)) = Gov.CommitteeVoter undefined +toVoterRole (DR (DRepCredentialByKey kh)) = Gov.DRepVoter undefined +toVoterRole (DR (DRepCredentialByScript sh)) = Gov.DRepVoter undefined +toVoterRole (SP kh) = Gov.StakePoolVoter undefined -toVote :: VoteChoice -> Gov.Vote -toVote No = Gov.VoteNo -toVote Yes = Gov.VoteYes -toVote Abst = Gov.Abstain +-- toVote :: VoteChoice -> Gov.Vote +-- toVote No = Gov.VoteNo +-- toVote Yes = Gov.VoteYes +-- toVote Abst = Gov.Abstain toVotingCredential :: ShelleyBasedEra era @@ -157,7 +170,7 @@ createVotingProcedure sbe vChoice vt (GovernanceActionIdentifier govActId) (Voti obtainEraCryptoConstraints sbe $ Vote $ Gov.VotingProcedure { Gov.vProcGovActionId = govActId - , Gov.vProcVoter = toVoterRole vt + , Gov.vProcVoter = toVoterRole vt govWitnessCredential , Gov.vProcVote = toVote vChoice , Gov.vProcAnchor = SNothing -- TODO: Conway } diff --git a/cardano-api/internal/Cardano/Api/Keys/Shelley.hs b/cardano-api/internal/Cardano/Api/Keys/Shelley.hs index 91f42a912b..63a8bf922d 100644 --- a/cardano-api/internal/Cardano/Api/Keys/Shelley.hs +++ b/cardano-api/internal/Cardano/Api/Keys/Shelley.hs @@ -20,6 +20,7 @@ module Cardano.Api.Keys.Shelley ( CommitteeColdKey, CommitteeHotKey, DRepKey, + CommitteeKey, PaymentKey, PaymentExtendedKey, StakeKey, @@ -1584,3 +1585,122 @@ instance HasTextEnvelope (SigningKey DRepKey) where where proxy :: Proxy (Shelley.DSIGN StandardCrypto) proxy = Proxy + +-- +-- Committee keys +-- + +data CommitteeKey + +instance HasTypeProxy CommitteeKey where + data AsType CommitteeKey = AsCommitteeKey + proxyToAsType _ = AsCommitteeKey + +instance Key CommitteeKey where + + newtype VerificationKey CommitteeKey = + CommitteeVerificationKey (Shelley.VKey {- TODO cip-1694: replace with Shelley.Committee -} Shelley.CommitteeHotKey StandardCrypto) + deriving stock (Eq) + deriving (Show, IsString) via UsingRawBytesHex (VerificationKey CommitteeKey) + deriving newtype (ToCBOR, FromCBOR) + deriving anyclass SerialiseAsCBOR + + newtype SigningKey CommitteeKey = + CommitteeSigningKey (Shelley.SignKeyDSIGN StandardCrypto) + deriving (Show, IsString) via UsingRawBytesHex (SigningKey CommitteeKey) + deriving newtype (ToCBOR, FromCBOR) + deriving anyclass SerialiseAsCBOR + + deterministicSigningKey :: AsType CommitteeKey -> Crypto.Seed -> SigningKey CommitteeKey + deterministicSigningKey AsCommitteeKey seed = + CommitteeSigningKey (Crypto.genKeyDSIGN seed) + + deterministicSigningKeySeedSize :: AsType CommitteeKey -> Word + deterministicSigningKeySeedSize AsCommitteeKey = + Crypto.seedSizeDSIGN proxy + where + proxy :: Proxy (Shelley.DSIGN StandardCrypto) + proxy = Proxy + + getVerificationKey :: SigningKey CommitteeKey -> VerificationKey CommitteeKey + getVerificationKey (CommitteeSigningKey sk) = + CommitteeVerificationKey (Shelley.VKey (Crypto.deriveVerKeyDSIGN sk)) + + verificationKeyHash :: VerificationKey CommitteeKey -> Hash CommitteeKey + verificationKeyHash (CommitteeVerificationKey vkey) = + CommitteeKeyHash (Shelley.hashKey vkey) + +instance SerialiseAsRawBytes (VerificationKey CommitteeKey) where + serialiseToRawBytes (CommitteeVerificationKey (Shelley.VKey vk)) = + Crypto.rawSerialiseVerKeyDSIGN vk + + deserialiseFromRawBytes (AsVerificationKey AsCommitteeKey) bs = + maybeToRight (SerialiseAsRawBytesError "Unable to deserialise VerificationKey CommitteeKey") $ + CommitteeVerificationKey . Shelley.VKey <$> + Crypto.rawDeserialiseVerKeyDSIGN bs + +instance SerialiseAsRawBytes (SigningKey CommitteeKey) where + serialiseToRawBytes (CommitteeSigningKey sk) = + Crypto.rawSerialiseSignKeyDSIGN sk + + deserialiseFromRawBytes (AsSigningKey AsCommitteeKey) bs = + maybe + (Left (SerialiseAsRawBytesError "Unable to deserialise SigningKey CommitteeKey")) + (Right . CommitteeSigningKey) + (Crypto.rawDeserialiseSignKeyDSIGN bs) + +instance SerialiseAsBech32 (VerificationKey CommitteeKey) where + bech32PrefixFor _ = "drep_vk" + bech32PrefixesPermitted _ = ["drep_vk"] + +instance SerialiseAsBech32 (SigningKey CommitteeKey) where + bech32PrefixFor _ = "drep_sk" + bech32PrefixesPermitted _ = ["drep_sk"] + +newtype instance Hash CommitteeKey = + CommitteeKeyHash { unCommitteeKeyHash :: Shelley.KeyHash {- TODO cip-1694: replace with Shelley.Committee -} Shelley.CommitteeHotKey StandardCrypto } + deriving stock (Eq, Ord) + deriving (Show, IsString) via UsingRawBytesHex (Hash CommitteeKey) + deriving (ToCBOR, FromCBOR) via UsingRawBytes (Hash CommitteeKey) + deriving anyclass SerialiseAsCBOR + +instance SerialiseAsRawBytes (Hash CommitteeKey) where + serialiseToRawBytes (CommitteeKeyHash (Shelley.KeyHash vkh)) = + Crypto.hashToBytes vkh + + deserialiseFromRawBytes (AsHash AsCommitteeKey) bs = + maybeToRight + (SerialiseAsRawBytesError "Unable to deserialise Hash CommitteeKey") + (CommitteeKeyHash . Shelley.KeyHash <$> Crypto.hashFromBytes bs) + +instance SerialiseAsBech32 (Hash CommitteeKey) where + bech32PrefixFor _ = "drep" + bech32PrefixesPermitted _ = ["drep"] + +instance ToJSON (Hash CommitteeKey) where + toJSON = toJSON . serialiseToBech32 + +instance ToJSONKey (Hash CommitteeKey) where + toJSONKey = toJSONKeyText serialiseToBech32 + +instance FromJSON (Hash CommitteeKey) where + parseJSON = withText "CommitteeId" $ \str -> + case deserialiseFromBech32 (AsHash AsCommitteeKey) str of + Left err -> + fail $ "Error deserialising Hash CommitteeKey: " <> Text.unpack str <> + " Error: " <> displayError err + Right h -> pure h + +instance HasTextEnvelope (VerificationKey CommitteeKey) where + textEnvelopeType _ = "CommitteeVerificationKey_" + <> fromString (Crypto.algorithmNameDSIGN proxy) + where + proxy :: Proxy (Shelley.DSIGN StandardCrypto) + proxy = Proxy + +instance HasTextEnvelope (SigningKey CommitteeKey) where + textEnvelopeType _ = "CommitteeSigningKey_" + <> fromString (Crypto.algorithmNameDSIGN proxy) + where + proxy :: Proxy (Shelley.DSIGN StandardCrypto) + proxy = Proxy