From 90a031a2a749d160b5f9c787b2867d48f3790a9b Mon Sep 17 00:00:00 2001 From: John Ky Date: Fri, 26 May 2023 16:29:59 +1000 Subject: [PATCH 01/11] New types and functions for committee keys and certificates: * CommitteeColdKey * CommitteeDelegationCertificate * CommitteeHotKey * CommitteeHotKeyUnregistrationCertificate * GenesisKeyDelegationCertificate * makeCommitteeDelegationCertificate * makeCommitteeHotKeyUnregistrationCertificate --- .../internal/Cardano/Api/Certificate.hs | 42 +++- .../internal/Cardano/Api/Keys/Shelley.hs | 199 ++++++++++++++++++ cardano-api/src/Cardano/Api.hs | 10 + 3 files changed, 248 insertions(+), 3 deletions(-) diff --git a/cardano-api/internal/Cardano/Api/Certificate.hs b/cardano-api/internal/Cardano/Api/Certificate.hs index 52f176d1c4..ca50d0ac75 100644 --- a/cardano-api/internal/Cardano/Api/Certificate.hs +++ b/cardano-api/internal/Cardano/Api/Certificate.hs @@ -22,6 +22,9 @@ module Cardano.Api.Certificate ( StakePoolRelay(..), StakePoolMetadataReference(..), + makeCommitteeDelegationCertificate, + makeCommitteeHotKeyUnregistrationCertificate, + -- * Special certificates makeMIRCertificate, makeGenesisKeyDelegationCertificate, @@ -87,9 +90,18 @@ data Certificate = | StakePoolRetirementCertificate PoolId EpochNo -- Special certificates - | GenesisKeyDelegationCertificate (Hash GenesisKey) - (Hash GenesisDelegateKey) - (Hash VrfKey) + | GenesisKeyDelegationCertificate + (Hash GenesisKey) + (Hash GenesisDelegateKey) + (Hash VrfKey) + + | CommitteeDelegationCertificate + (Hash CommitteeColdKey) + (Hash CommitteeHotKey) + + | CommitteeHotKeyUnregistrationCertificate + (Hash CommitteeColdKey) + | MIRCertificate MIRPot MIRTarget deriving stock (Eq, Show) @@ -114,6 +126,8 @@ instance HasTextEnvelope Certificate where StakePoolRegistrationCertificate{} -> "Pool registration" StakePoolRetirementCertificate{} -> "Pool retirement" GenesisKeyDelegationCertificate{} -> "Genesis key delegation" + CommitteeDelegationCertificate{} -> "Constitution Committee key delegation" + CommitteeHotKeyUnregistrationCertificate{} -> "Constitution Committee hot key unregistration" MIRCertificate{} -> "MIR" -- | The 'MIRTarget' determines the target of a 'MIRCertificate'. @@ -203,6 +217,17 @@ makeGenesisKeyDelegationCertificate :: Hash GenesisKey -> Certificate makeGenesisKeyDelegationCertificate = GenesisKeyDelegationCertificate +makeCommitteeDelegationCertificate :: () + => Hash CommitteeColdKey + -> Hash CommitteeHotKey + -> Certificate +makeCommitteeDelegationCertificate = CommitteeDelegationCertificate + +makeCommitteeHotKeyUnregistrationCertificate :: () + => Hash CommitteeColdKey + -> Certificate +makeCommitteeHotKeyUnregistrationCertificate = CommitteeHotKeyUnregistrationCertificate + makeMIRCertificate :: MIRPot -> MIRTarget -> Certificate makeMIRCertificate = MIRCertificate @@ -252,6 +277,17 @@ toShelleyCertificate (GenesisKeyDelegationCertificate delegatekh vrfkh +toShelleyCertificate + ( CommitteeDelegationCertificate + (CommitteeColdKeyHash _ckh) + (CommitteeHotKeyHash _hkh) + ) = error "TODO CIP-1694 Need ledger types for CommitteeDelegationCertificate" + +toShelleyCertificate + ( CommitteeHotKeyUnregistrationCertificate + (CommitteeColdKeyHash _ckh) + ) = error "TODO CIP-1694 Need ledger types for CommitteeHotKeyUnregistrationCertificate" + toShelleyCertificate (MIRCertificate mirpot (StakeAddressesMIR amounts)) = Shelley.DCertMir $ Shelley.MIRCert diff --git a/cardano-api/internal/Cardano/Api/Keys/Shelley.hs b/cardano-api/internal/Cardano/Api/Keys/Shelley.hs index 85711f6c7d..9fe3544ba1 100644 --- a/cardano-api/internal/Cardano/Api/Keys/Shelley.hs +++ b/cardano-api/internal/Cardano/Api/Keys/Shelley.hs @@ -17,6 +17,8 @@ module Cardano.Api.Keys.Shelley ( -- * Key types + CommitteeColdKey, + CommitteeHotKey, PaymentKey, PaymentExtendedKey, StakeKey, @@ -667,6 +669,203 @@ instance CastVerificationKeyRole GenesisKey PaymentKey where PaymentVerificationKey (Shelley.VKey vk) +-- +-- Constitutional Committee Hot Keys +-- + +type KeyRoleCommitteeHotKey = Shelley.Genesis -- TODO CIP-1694 this should be a newtype Shelley.CommitteeHotKey + +data CommitteeHotKey + +instance HasTypeProxy CommitteeHotKey where + data AsType CommitteeHotKey = AsCommitteeHotKey + proxyToAsType _ = AsCommitteeHotKey + +instance Key CommitteeHotKey where + + newtype VerificationKey CommitteeHotKey = + CommitteeHotVerificationKey (Shelley.VKey KeyRoleCommitteeHotKey StandardCrypto) + deriving stock (Eq) + deriving (Show, IsString) via UsingRawBytesHex (VerificationKey CommitteeHotKey) + deriving newtype (ToCBOR, FromCBOR) + deriving anyclass SerialiseAsCBOR + + newtype SigningKey CommitteeHotKey = + CommitteeHotSigningKey (Shelley.SignKeyDSIGN StandardCrypto) + deriving (Show, IsString) via UsingRawBytesHex (SigningKey CommitteeHotKey) + deriving newtype (ToCBOR, FromCBOR) + deriving anyclass SerialiseAsCBOR + + deterministicSigningKey :: AsType CommitteeHotKey -> Crypto.Seed -> SigningKey CommitteeHotKey + deterministicSigningKey AsCommitteeHotKey seed = + CommitteeHotSigningKey (Crypto.genKeyDSIGN seed) + + deterministicSigningKeySeedSize :: AsType CommitteeHotKey -> Word + deterministicSigningKeySeedSize AsCommitteeHotKey = + Crypto.seedSizeDSIGN proxy + where + proxy :: Proxy (Shelley.DSIGN StandardCrypto) + proxy = Proxy + + getVerificationKey :: SigningKey CommitteeHotKey -> VerificationKey CommitteeHotKey + getVerificationKey (CommitteeHotSigningKey sk) = + CommitteeHotVerificationKey (Shelley.VKey (Crypto.deriveVerKeyDSIGN sk)) + + verificationKeyHash :: VerificationKey CommitteeHotKey -> Hash CommitteeHotKey + verificationKeyHash (CommitteeHotVerificationKey vkey) = + CommitteeHotKeyHash (Shelley.hashKey vkey) + + +instance SerialiseAsRawBytes (VerificationKey CommitteeHotKey) where + serialiseToRawBytes (CommitteeHotVerificationKey (Shelley.VKey vk)) = + Crypto.rawSerialiseVerKeyDSIGN vk + + deserialiseFromRawBytes (AsVerificationKey AsCommitteeHotKey) bs = + maybeToRight (SerialiseAsRawBytesError "Unable to deserialise VerificationKey Constitutional Committee Hot Key") $ + CommitteeHotVerificationKey . Shelley.VKey <$> + Crypto.rawDeserialiseVerKeyDSIGN bs + +instance SerialiseAsRawBytes (SigningKey CommitteeHotKey) where + serialiseToRawBytes (CommitteeHotSigningKey sk) = + Crypto.rawSerialiseSignKeyDSIGN sk + + deserialiseFromRawBytes (AsSigningKey AsCommitteeHotKey) bs = + maybeToRight (SerialiseAsRawBytesError "Unable to deserialise SigningKey Constitional Committee Hot Key") $ + CommitteeHotSigningKey <$> Crypto.rawDeserialiseSignKeyDSIGN bs + + +newtype instance Hash CommitteeHotKey = + CommitteeHotKeyHash (Shelley.KeyHash KeyRoleCommitteeHotKey StandardCrypto) + deriving stock (Eq, Ord) + deriving (Show, IsString) via UsingRawBytesHex (Hash CommitteeHotKey) + deriving (ToCBOR, FromCBOR) via UsingRawBytes (Hash CommitteeHotKey) + deriving anyclass SerialiseAsCBOR + +instance SerialiseAsRawBytes (Hash CommitteeHotKey) where + serialiseToRawBytes (CommitteeHotKeyHash (Shelley.KeyHash vkh)) = + Crypto.hashToBytes vkh + + deserialiseFromRawBytes (AsHash AsCommitteeHotKey) bs = + maybeToRight (SerialiseAsRawBytesError "Unable to deserialise Hash Constitional Committee Hot Key") $ + CommitteeHotKeyHash . Shelley.KeyHash <$> Crypto.hashFromBytes bs + +instance HasTextEnvelope (VerificationKey CommitteeHotKey) where + textEnvelopeType _ = "ConstitionalCommitteeHotVerificationKey_" + <> fromString (Crypto.algorithmNameDSIGN proxy) + where + proxy :: Proxy (Shelley.DSIGN StandardCrypto) + proxy = Proxy + +instance HasTextEnvelope (SigningKey CommitteeHotKey) where + textEnvelopeType _ = "ConstitionalCommitteeHotSigningKey_" + <> fromString (Crypto.algorithmNameDSIGN proxy) + where + proxy :: Proxy (Shelley.DSIGN StandardCrypto) + proxy = Proxy + +instance CastVerificationKeyRole CommitteeHotKey PaymentKey where + castVerificationKey (CommitteeHotVerificationKey (Shelley.VKey vk)) = + PaymentVerificationKey (Shelley.VKey vk) + + +-- +-- Constitutional Committee Cold Keys +-- + +type KeyRoleCommitteeColdKey = Shelley.Genesis -- TODO CIP-1694 this should be a newtype Shelley.CommitteeColdKey + +data CommitteeColdKey + +instance HasTypeProxy CommitteeColdKey where + data AsType CommitteeColdKey = AsCommitteeColdKey + proxyToAsType _ = AsCommitteeColdKey + +instance Key CommitteeColdKey where + + newtype VerificationKey CommitteeColdKey = + CommitteeColdVerificationKey (Shelley.VKey KeyRoleCommitteeColdKey StandardCrypto) + deriving stock (Eq) + deriving (Show, IsString) via UsingRawBytesHex (VerificationKey CommitteeColdKey) + deriving newtype (ToCBOR, FromCBOR) + deriving anyclass SerialiseAsCBOR + + newtype SigningKey CommitteeColdKey = + CommitteeColdSigningKey (Shelley.SignKeyDSIGN StandardCrypto) + deriving (Show, IsString) via UsingRawBytesHex (SigningKey CommitteeColdKey) + deriving newtype (ToCBOR, FromCBOR) + deriving anyclass SerialiseAsCBOR + + deterministicSigningKey :: AsType CommitteeColdKey -> Crypto.Seed -> SigningKey CommitteeColdKey + deterministicSigningKey AsCommitteeColdKey seed = + CommitteeColdSigningKey (Crypto.genKeyDSIGN seed) + + deterministicSigningKeySeedSize :: AsType CommitteeColdKey -> Word + deterministicSigningKeySeedSize AsCommitteeColdKey = + Crypto.seedSizeDSIGN proxy + where + proxy :: Proxy (Shelley.DSIGN StandardCrypto) + proxy = Proxy + + getVerificationKey :: SigningKey CommitteeColdKey -> VerificationKey CommitteeColdKey + getVerificationKey (CommitteeColdSigningKey sk) = + CommitteeColdVerificationKey (Shelley.VKey (Crypto.deriveVerKeyDSIGN sk)) + + verificationKeyHash :: VerificationKey CommitteeColdKey -> Hash CommitteeColdKey + verificationKeyHash (CommitteeColdVerificationKey vkey) = + CommitteeColdKeyHash (Shelley.hashKey vkey) + + +instance SerialiseAsRawBytes (VerificationKey CommitteeColdKey) where + serialiseToRawBytes (CommitteeColdVerificationKey (Shelley.VKey vk)) = + Crypto.rawSerialiseVerKeyDSIGN vk + + deserialiseFromRawBytes (AsVerificationKey AsCommitteeColdKey) bs = + maybeToRight (SerialiseAsRawBytesError "Unable to deserialise VerificationKey Constitutional Committee Cold Key") $ + CommitteeColdVerificationKey . Shelley.VKey <$> + Crypto.rawDeserialiseVerKeyDSIGN bs + +instance SerialiseAsRawBytes (SigningKey CommitteeColdKey) where + serialiseToRawBytes (CommitteeColdSigningKey sk) = + Crypto.rawSerialiseSignKeyDSIGN sk + + deserialiseFromRawBytes (AsSigningKey AsCommitteeColdKey) bs = + maybeToRight (SerialiseAsRawBytesError "Unable to deserialise SigningKey Constitional Committee Cold Key") $ + CommitteeColdSigningKey <$> Crypto.rawDeserialiseSignKeyDSIGN bs + + +newtype instance Hash CommitteeColdKey = + CommitteeColdKeyHash (Shelley.KeyHash KeyRoleCommitteeColdKey StandardCrypto) + deriving stock (Eq, Ord) + deriving (Show, IsString) via UsingRawBytesHex (Hash CommitteeColdKey) + deriving (ToCBOR, FromCBOR) via UsingRawBytes (Hash CommitteeColdKey) + deriving anyclass SerialiseAsCBOR + +instance SerialiseAsRawBytes (Hash CommitteeColdKey) where + serialiseToRawBytes (CommitteeColdKeyHash (Shelley.KeyHash vkh)) = + Crypto.hashToBytes vkh + + deserialiseFromRawBytes (AsHash AsCommitteeColdKey) bs = + maybeToRight (SerialiseAsRawBytesError "Unable to deserialise Hash Constitional Committee Cold Key") $ + CommitteeColdKeyHash . Shelley.KeyHash <$> Crypto.hashFromBytes bs + +instance HasTextEnvelope (VerificationKey CommitteeColdKey) where + textEnvelopeType _ = "ConstitionalCommitteeColdVerificationKey_" + <> fromString (Crypto.algorithmNameDSIGN proxy) + where + proxy :: Proxy (Shelley.DSIGN StandardCrypto) + proxy = Proxy + +instance HasTextEnvelope (SigningKey CommitteeColdKey) where + textEnvelopeType _ = "ConstitionalCommitteeColdSigningKey_" + <> fromString (Crypto.algorithmNameDSIGN proxy) + where + proxy :: Proxy (Shelley.DSIGN StandardCrypto) + proxy = Proxy + +instance CastVerificationKeyRole CommitteeColdKey PaymentKey where + castVerificationKey (CommitteeColdVerificationKey (Shelley.VKey vk)) = + PaymentVerificationKey (Shelley.VKey vk) + -- -- Shelley genesis extended ed25519 keys -- diff --git a/cardano-api/src/Cardano/Api.hs b/cardano-api/src/Cardano/Api.hs index c26106dbad..02905dfefb 100644 --- a/cardano-api/src/Cardano/Api.hs +++ b/cardano-api/src/Cardano/Api.hs @@ -758,6 +758,10 @@ module Cardano.Api ( getOpCertCount, issueOperationalCertificate, + -- * Constitutional Committee keys + CommitteeColdKey, + CommitteeHotKey, + -- * Genesis file -- | Types and functions needed to inspect or create a genesis file. GenesisKey, @@ -877,6 +881,12 @@ module Cardano.Api ( querySystemStart, queryUtxo, determineEraExpr, + -- * Governance + + -- ** Governance Committee + makeCommitteeDelegationCertificate, + makeCommitteeHotKeyUnregistrationCertificate, + ) where import Cardano.Api.Address From 7534c82870c974430bdf163f290cebcf95617ece Mon Sep 17 00:00:00 2001 From: John Ky Date: Tue, 6 Jun 2023 23:26:16 +1000 Subject: [PATCH 02/11] New modules, types and functions for dreps: * `Cardano.Api.DRepMetadata` * `DRepMetadata` * `DRepMetadataReference` * `DRepMetadataValidationError` * `DRepKey` * `validateAndHashDRepMetadata` --- cardano-api/cardano-api.cabal | 1 + .../internal/Cardano/Api/Certificate.hs | 17 +- .../internal/Cardano/Api/DRepMetadata.hs | 167 ++++++++++++++++++ .../internal/Cardano/Api/Keys/Shelley.hs | 119 +++++++++++++ cardano-api/src/Cardano/Api.hs | 9 +- cardano-api/src/Cardano/Api/Shelley.hs | 6 +- 6 files changed, 315 insertions(+), 4 deletions(-) create mode 100644 cardano-api/internal/Cardano/Api/DRepMetadata.hs diff --git a/cardano-api/cardano-api.cabal b/cardano-api/cardano-api.cabal index c78d5d538a..ff07dcec10 100644 --- a/cardano-api/cardano-api.cabal +++ b/cardano-api/cardano-api.cabal @@ -54,6 +54,7 @@ library internal Cardano.Api.Convenience.Construction Cardano.Api.Convenience.Query Cardano.Api.DeserialiseAnyOf + Cardano.Api.DRepMetadata Cardano.Api.EraCast Cardano.Api.Eras Cardano.Api.Error diff --git a/cardano-api/internal/Cardano/Api/Certificate.hs b/cardano-api/internal/Cardano/Api/Certificate.hs index ca50d0ac75..d60d387cc3 100644 --- a/cardano-api/internal/Cardano/Api/Certificate.hs +++ b/cardano-api/internal/Cardano/Api/Certificate.hs @@ -25,6 +25,9 @@ module Cardano.Api.Certificate ( makeCommitteeDelegationCertificate, makeCommitteeHotKeyUnregistrationCertificate, + -- * Registering DReps + DRepMetadataReference(..), + -- * Special certificates makeMIRCertificate, makeGenesisKeyDelegationCertificate, @@ -41,9 +44,8 @@ module Cardano.Api.Certificate ( ) where import Cardano.Api.Address -import Cardano.Api.Hash +import Cardano.Api.DRepMetadata import Cardano.Api.HasTypeProxy -import Cardano.Api.Keys.Byron import Cardano.Api.Keys.Praos import Cardano.Api.Keys.Shelley import Cardano.Api.SerialiseCBOR @@ -191,6 +193,17 @@ data StakePoolMetadataReference = } deriving (Eq, Show) +-- ---------------------------------------------------------------------------- +-- DRep parameters +-- + +data DRepMetadataReference = + DRepMetadataReference + { drepMetadataURL :: Text + , drepMetadataHash :: Hash DRepMetadata + } + deriving (Eq, Show) + -- ---------------------------------------------------------------------------- -- Constructor functions diff --git a/cardano-api/internal/Cardano/Api/DRepMetadata.hs b/cardano-api/internal/Cardano/Api/DRepMetadata.hs new file mode 100644 index 0000000000..201bfa11d0 --- /dev/null +++ b/cardano-api/internal/Cardano/Api/DRepMetadata.hs @@ -0,0 +1,167 @@ +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE TypeFamilies #-} + +-- | DRep off-chain metadata +-- +module Cardano.Api.DRepMetadata ( + -- * DRep off-chain metadata + DRepMetadata(..), + validateAndHashDRepMetadata, + DRepMetadataValidationError(..), + + -- * Data family instances + AsType(..), + Hash(..), + ) where + +import Cardano.Api.Eras +import Cardano.Api.Error +import Cardano.Api.Hash +import Cardano.Api.HasTypeProxy +import Cardano.Api.Keys.Byron +import Cardano.Api.Keys.Praos +import Cardano.Api.Script +import Cardano.Api.SerialiseJSON +import Cardano.Api.SerialiseRaw + +import qualified Cardano.Crypto.Hash.Class as Crypto +import Cardano.Ledger.Crypto (StandardCrypto) +import qualified Cardano.Ledger.Keys as Shelley + +import Data.Aeson ((.:)) +import qualified Data.Aeson as Aeson +import qualified Data.Aeson.Types as Aeson +import Data.Bifunctor (first) +import Data.ByteString (ByteString) +import qualified Data.ByteString as BS +import Data.Either.Combinators (maybeToRight) +import Data.Text (Text) +import qualified Data.Text as Text + +-- ---------------------------------------------------------------------------- +-- DRep metadata +-- + +-- | A representation of the required fields for off-chain drep metadata. +-- +data DRepMetadata = + DRepMetadata + { drepName :: !Text + -- ^ A name of up to 50 characters. + , drepDescription :: !Text + -- ^ A description of up to 255 characters. + , drepTicker :: !Text + -- ^ A ticker of 3-5 characters, for a compact display of dreps in + -- a wallet. + , drepHomepage :: !Text + -- ^ A URL to a homepage with additional information about the drep. + -- n.b. the spec does not specify a character limit for this field. + } deriving (Eq, Show) + +newtype instance Hash DRepMetadata = DRepMetadataHash (Shelley.Hash StandardCrypto ByteString) + deriving (Eq, Show) + +instance HasTypeProxy DRepMetadata where + data AsType DRepMetadata = AsDRepMetadata + proxyToAsType _ = AsDRepMetadata + +instance SerialiseAsRawBytes (Hash DRepMetadata) where + serialiseToRawBytes (DRepMetadataHash h) = Crypto.hashToBytes h + + deserialiseFromRawBytes (AsHash AsDRepMetadata) bs = + maybeToRight (SerialiseAsRawBytesError "Unable to deserialise Hash DRepMetadata") $ + DRepMetadataHash <$> Crypto.hashFromBytes bs + +--TODO: instance ToJSON DRepMetadata where + +instance FromJSON DRepMetadata where + parseJSON = + Aeson.withObject "DRepMetadata" $ \obj -> + DRepMetadata + <$> parseName obj + <*> parseDescription obj + <*> parseTicker obj + <*> obj .: "homepage" + + where + -- Parse and validate the drep metadata name from a JSON object. + -- The name must be 50 characters or fewer. + parseName :: Aeson.Object -> Aeson.Parser Text + parseName obj = do + name <- obj .: "name" + if Text.length name <= 50 + then pure name + else + fail $ mconcat + [ "\"name\" must have at most 50 characters, but it has " + , show (Text.length name) + , " characters." + ] + + -- Parse and validate the drep metadata description + -- The description must be 255 characters or fewer. + parseDescription :: Aeson.Object -> Aeson.Parser Text + parseDescription obj = do + description <- obj .: "description" + if Text.length description <= 255 + then pure description + else + fail $ mconcat + [ "\"description\" must have at most 255 characters, but it has " + , show (Text.length description) + , " characters." + ] + + -- | Parse and validate the drep ticker description + -- The ticker must be 3 to 5 characters long. + parseTicker :: Aeson.Object -> Aeson.Parser Text + parseTicker obj = do + ticker <- obj .: "ticker" + let tickerLen = Text.length ticker + if tickerLen >= 3 && tickerLen <= 5 + then pure ticker + else + fail $ mconcat + [ "\"ticker\" must have at least 3 and at most 5 " + , "characters, but it has " + , show (Text.length ticker) + , " characters." + ] + +-- | A drep metadata validation error. +data DRepMetadataValidationError + = DRepMetadataJsonDecodeError !String + | DRepMetadataInvalidLengthError + -- ^ The length of the JSON-encoded drep metadata exceeds the + -- maximum. + !Int + -- ^ Maximum byte length. + !Int + -- ^ Actual byte length. + deriving Show + +instance Error DRepMetadataValidationError where + displayError = \case + DRepMetadataJsonDecodeError errStr -> errStr + DRepMetadataInvalidLengthError maxLen actualLen -> + mconcat + [ "DRep metadata must consist of at most " + , show maxLen + , " bytes, but it consists of " + , show actualLen + , " bytes." + ] + +-- | Decode and validate the provided JSON-encoded bytes as 'DRepMetadata'. +-- Return the decoded metadata and the hash of the original bytes. +validateAndHashDRepMetadata + :: ByteString + -> Either DRepMetadataValidationError (DRepMetadata, Hash DRepMetadata) +validateAndHashDRepMetadata bs + | BS.length bs <= 512 = do + md <- first DRepMetadataJsonDecodeError + (Aeson.eitherDecodeStrict' bs) + let mdh = DRepMetadataHash (Crypto.hashWith id bs) + return (md, mdh) + | otherwise = Left $ DRepMetadataInvalidLengthError 512 (BS.length bs) diff --git a/cardano-api/internal/Cardano/Api/Keys/Shelley.hs b/cardano-api/internal/Cardano/Api/Keys/Shelley.hs index 9fe3544ba1..dbb4799cd6 100644 --- a/cardano-api/internal/Cardano/Api/Keys/Shelley.hs +++ b/cardano-api/internal/Cardano/Api/Keys/Shelley.hs @@ -19,6 +19,7 @@ module Cardano.Api.Keys.Shelley ( -- * Key types CommitteeColdKey, CommitteeHotKey, + DRepKey, PaymentKey, PaymentExtendedKey, StakeKey, @@ -1462,3 +1463,121 @@ instance HasTextEnvelope (SigningKey StakePoolKey) where proxy :: Proxy (Shelley.DSIGN StandardCrypto) proxy = Proxy +-- +-- DRep keys +-- + +data DRepKey + +instance HasTypeProxy DRepKey where + data AsType DRepKey = AsDRepKey + proxyToAsType _ = AsDRepKey + +instance Key DRepKey where + + newtype VerificationKey DRepKey = + DRepVerificationKey (Shelley.VKey {- TODO cip-1694: replace with Shelley.DRep -} Shelley.StakePool StandardCrypto) + deriving stock (Eq) + deriving (Show, IsString) via UsingRawBytesHex (VerificationKey DRepKey) + deriving newtype (ToCBOR, FromCBOR) + deriving anyclass SerialiseAsCBOR + + newtype SigningKey DRepKey = + DRepSigningKey (Shelley.SignKeyDSIGN StandardCrypto) + deriving (Show, IsString) via UsingRawBytesHex (SigningKey DRepKey) + deriving newtype (ToCBOR, FromCBOR) + deriving anyclass SerialiseAsCBOR + + deterministicSigningKey :: AsType DRepKey -> Crypto.Seed -> SigningKey DRepKey + deterministicSigningKey AsDRepKey seed = + DRepSigningKey (Crypto.genKeyDSIGN seed) + + deterministicSigningKeySeedSize :: AsType DRepKey -> Word + deterministicSigningKeySeedSize AsDRepKey = + Crypto.seedSizeDSIGN proxy + where + proxy :: Proxy (Shelley.DSIGN StandardCrypto) + proxy = Proxy + + getVerificationKey :: SigningKey DRepKey -> VerificationKey DRepKey + getVerificationKey (DRepSigningKey sk) = + DRepVerificationKey (Shelley.VKey (Crypto.deriveVerKeyDSIGN sk)) + + verificationKeyHash :: VerificationKey DRepKey -> Hash DRepKey + verificationKeyHash (DRepVerificationKey vkey) = + DRepKeyHash (Shelley.hashKey vkey) + +instance SerialiseAsRawBytes (VerificationKey DRepKey) where + serialiseToRawBytes (DRepVerificationKey (Shelley.VKey vk)) = + Crypto.rawSerialiseVerKeyDSIGN vk + + deserialiseFromRawBytes (AsVerificationKey AsDRepKey) bs = + maybeToRight (SerialiseAsRawBytesError "Unable to deserialise VerificationKey DRepKey") $ + DRepVerificationKey . Shelley.VKey <$> + Crypto.rawDeserialiseVerKeyDSIGN bs + +instance SerialiseAsRawBytes (SigningKey DRepKey) where + serialiseToRawBytes (DRepSigningKey sk) = + Crypto.rawSerialiseSignKeyDSIGN sk + + deserialiseFromRawBytes (AsSigningKey AsDRepKey) bs = + maybe + (Left (SerialiseAsRawBytesError "Unable to deserialise SigningKey DRepKey")) + (Right . DRepSigningKey) + (Crypto.rawDeserialiseSignKeyDSIGN bs) + +instance SerialiseAsBech32 (VerificationKey DRepKey) where + bech32PrefixFor _ = "drep_vk" + bech32PrefixesPermitted _ = ["drep_vk"] + +instance SerialiseAsBech32 (SigningKey DRepKey) where + bech32PrefixFor _ = "drep_sk" + bech32PrefixesPermitted _ = ["drep_sk"] + +newtype instance Hash DRepKey = + DRepKeyHash { unDRepKeyHash :: Shelley.KeyHash {- TODO cip-1694: replace with Shelley.DRep -} Shelley.StakePool StandardCrypto } + deriving stock (Eq, Ord) + deriving (Show, IsString) via UsingRawBytesHex (Hash DRepKey) + deriving (ToCBOR, FromCBOR) via UsingRawBytes (Hash DRepKey) + deriving anyclass SerialiseAsCBOR + +instance SerialiseAsRawBytes (Hash DRepKey) where + serialiseToRawBytes (DRepKeyHash (Shelley.KeyHash vkh)) = + Crypto.hashToBytes vkh + + deserialiseFromRawBytes (AsHash AsDRepKey) bs = + maybeToRight + (SerialiseAsRawBytesError "Unable to deserialise Hash DRepKey") + (DRepKeyHash . Shelley.KeyHash <$> Crypto.hashFromBytes bs) + +instance SerialiseAsBech32 (Hash DRepKey) where + bech32PrefixFor _ = "drep" + bech32PrefixesPermitted _ = ["drep"] + +instance ToJSON (Hash DRepKey) where + toJSON = toJSON . serialiseToBech32 + +instance ToJSONKey (Hash DRepKey) where + toJSONKey = toJSONKeyText serialiseToBech32 + +instance FromJSON (Hash DRepKey) where + parseJSON = withText "DRepId" $ \str -> + case deserialiseFromBech32 (AsHash AsDRepKey) str of + Left err -> + fail $ "Error deserialising Hash DRepKey: " <> Text.unpack str <> + " Error: " <> displayError err + Right h -> pure h + +instance HasTextEnvelope (VerificationKey DRepKey) where + textEnvelopeType _ = "DRepVerificationKey_" + <> fromString (Crypto.algorithmNameDSIGN proxy) + where + proxy :: Proxy (Shelley.DSIGN StandardCrypto) + proxy = Proxy + +instance HasTextEnvelope (SigningKey DRepKey) where + textEnvelopeType _ = "DRepSigningKey_" + <> fromString (Crypto.algorithmNameDSIGN proxy) + where + proxy :: Proxy (Shelley.DSIGN StandardCrypto) + proxy = Proxy diff --git a/cardano-api/src/Cardano/Api.hs b/cardano-api/src/Cardano/Api.hs index 02905dfefb..2c0dfe6319 100644 --- a/cardano-api/src/Cardano/Api.hs +++ b/cardano-api/src/Cardano/Api.hs @@ -883,10 +883,16 @@ module Cardano.Api ( determineEraExpr, -- * Governance + -- ** DReps + DRepKey, + DRepMetadata, + DRepMetadataReference, + DRepMetadataValidationError, + validateAndHashDRepMetadata, + -- ** Governance Committee makeCommitteeDelegationCertificate, makeCommitteeHotKeyUnregistrationCertificate, - ) where import Cardano.Api.Address @@ -896,6 +902,7 @@ import Cardano.Api.Convenience.Constraints import Cardano.Api.Convenience.Construction import Cardano.Api.Convenience.Query import Cardano.Api.DeserialiseAnyOf +import Cardano.Api.DRepMetadata import Cardano.Api.EraCast import Cardano.Api.Eras import Cardano.Api.Error diff --git a/cardano-api/src/Cardano/Api/Shelley.hs b/cardano-api/src/Cardano/Api/Shelley.hs index bb4095111b..41a5a526b4 100644 --- a/cardano-api/src/Cardano/Api/Shelley.hs +++ b/cardano-api/src/Cardano/Api/Shelley.hs @@ -182,6 +182,10 @@ module Cardano.Api.Shelley ), EpochNo(..), + -- * DRep + DRepMetadata(DRepMetadata), + DRepMetadataReference(DRepMetadataReference), + -- ** Stake pool operator's keys StakePoolKey, PoolId, @@ -258,12 +262,12 @@ import Cardano.Api import Cardano.Api.Address import Cardano.Api.Block import Cardano.Api.Certificate +import Cardano.Api.DRepMetadata import Cardano.Api.Eras import Cardano.Api.Genesis import Cardano.Api.Governance.Poll import Cardano.Api.InMode import Cardano.Api.IPC -import Cardano.Api.Keys.Byron import Cardano.Api.Keys.Praos import Cardano.Api.Keys.Shelley import Cardano.Api.LedgerState From a9443d51f7733f3a8b22c650748919ee220e4117 Mon Sep 17 00:00:00 2001 From: John Ky Date: Tue, 6 Jun 2023 23:42:54 +1000 Subject: [PATCH 03/11] Unstructured metadata for DReps --- .../internal/Cardano/Api/DRepMetadata.hs | 85 ++----------------- 1 file changed, 5 insertions(+), 80 deletions(-) diff --git a/cardano-api/internal/Cardano/Api/DRepMetadata.hs b/cardano-api/internal/Cardano/Api/DRepMetadata.hs index 201bfa11d0..8624600784 100644 --- a/cardano-api/internal/Cardano/Api/DRepMetadata.hs +++ b/cardano-api/internal/Cardano/Api/DRepMetadata.hs @@ -22,22 +22,15 @@ import Cardano.Api.HasTypeProxy import Cardano.Api.Keys.Byron import Cardano.Api.Keys.Praos import Cardano.Api.Script -import Cardano.Api.SerialiseJSON import Cardano.Api.SerialiseRaw import qualified Cardano.Crypto.Hash.Class as Crypto import Cardano.Ledger.Crypto (StandardCrypto) import qualified Cardano.Ledger.Keys as Shelley -import Data.Aeson ((.:)) -import qualified Data.Aeson as Aeson -import qualified Data.Aeson.Types as Aeson -import Data.Bifunctor (first) import Data.ByteString (ByteString) import qualified Data.ByteString as BS import Data.Either.Combinators (maybeToRight) -import Data.Text (Text) -import qualified Data.Text as Text -- ---------------------------------------------------------------------------- -- DRep metadata @@ -45,18 +38,8 @@ import qualified Data.Text as Text -- | A representation of the required fields for off-chain drep metadata. -- -data DRepMetadata = - DRepMetadata - { drepName :: !Text - -- ^ A name of up to 50 characters. - , drepDescription :: !Text - -- ^ A description of up to 255 characters. - , drepTicker :: !Text - -- ^ A ticker of 3-5 characters, for a compact display of dreps in - -- a wallet. - , drepHomepage :: !Text - -- ^ A URL to a homepage with additional information about the drep. - -- n.b. the spec does not specify a character limit for this field. +newtype DRepMetadata = DRepMetadata + { unDRepMetadata :: ByteString } deriving (Eq, Show) newtype instance Hash DRepMetadata = DRepMetadataHash (Shelley.Hash StandardCrypto ByteString) @@ -73,66 +56,9 @@ instance SerialiseAsRawBytes (Hash DRepMetadata) where maybeToRight (SerialiseAsRawBytesError "Unable to deserialise Hash DRepMetadata") $ DRepMetadataHash <$> Crypto.hashFromBytes bs ---TODO: instance ToJSON DRepMetadata where - -instance FromJSON DRepMetadata where - parseJSON = - Aeson.withObject "DRepMetadata" $ \obj -> - DRepMetadata - <$> parseName obj - <*> parseDescription obj - <*> parseTicker obj - <*> obj .: "homepage" - - where - -- Parse and validate the drep metadata name from a JSON object. - -- The name must be 50 characters or fewer. - parseName :: Aeson.Object -> Aeson.Parser Text - parseName obj = do - name <- obj .: "name" - if Text.length name <= 50 - then pure name - else - fail $ mconcat - [ "\"name\" must have at most 50 characters, but it has " - , show (Text.length name) - , " characters." - ] - - -- Parse and validate the drep metadata description - -- The description must be 255 characters or fewer. - parseDescription :: Aeson.Object -> Aeson.Parser Text - parseDescription obj = do - description <- obj .: "description" - if Text.length description <= 255 - then pure description - else - fail $ mconcat - [ "\"description\" must have at most 255 characters, but it has " - , show (Text.length description) - , " characters." - ] - - -- | Parse and validate the drep ticker description - -- The ticker must be 3 to 5 characters long. - parseTicker :: Aeson.Object -> Aeson.Parser Text - parseTicker obj = do - ticker <- obj .: "ticker" - let tickerLen = Text.length ticker - if tickerLen >= 3 && tickerLen <= 5 - then pure ticker - else - fail $ mconcat - [ "\"ticker\" must have at least 3 and at most 5 " - , "characters, but it has " - , show (Text.length ticker) - , " characters." - ] - -- | A drep metadata validation error. data DRepMetadataValidationError - = DRepMetadataJsonDecodeError !String - | DRepMetadataInvalidLengthError + = DRepMetadataInvalidLengthError -- ^ The length of the JSON-encoded drep metadata exceeds the -- maximum. !Int @@ -143,7 +69,6 @@ data DRepMetadataValidationError instance Error DRepMetadataValidationError where displayError = \case - DRepMetadataJsonDecodeError errStr -> errStr DRepMetadataInvalidLengthError maxLen actualLen -> mconcat [ "DRep metadata must consist of at most " @@ -159,9 +84,9 @@ validateAndHashDRepMetadata :: ByteString -> Either DRepMetadataValidationError (DRepMetadata, Hash DRepMetadata) validateAndHashDRepMetadata bs + -- TODO confirm if there are size limits to the DRep metadata | BS.length bs <= 512 = do - md <- first DRepMetadataJsonDecodeError - (Aeson.eitherDecodeStrict' bs) + let md = DRepMetadata bs let mdh = DRepMetadataHash (Crypto.hashWith id bs) return (md, mdh) | otherwise = Left $ DRepMetadataInvalidLengthError 512 (BS.length bs) From 1a2a667383171570aa7217bc90acfa9c079be816 Mon Sep 17 00:00:00 2001 From: Jordan Millar Date: Tue, 20 Jun 2023 13:30:55 -0400 Subject: [PATCH 04/11] Use deregistration for consistency --- cardano-api/internal/Cardano/Api/Certificate.hs | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/cardano-api/internal/Cardano/Api/Certificate.hs b/cardano-api/internal/Cardano/Api/Certificate.hs index d60d387cc3..4abac79fdb 100644 --- a/cardano-api/internal/Cardano/Api/Certificate.hs +++ b/cardano-api/internal/Cardano/Api/Certificate.hs @@ -101,7 +101,7 @@ data Certificate = (Hash CommitteeColdKey) (Hash CommitteeHotKey) - | CommitteeHotKeyUnregistrationCertificate + | CommitteeHotKeyDeregistrationCertificate (Hash CommitteeColdKey) | MIRCertificate MIRPot MIRTarget @@ -123,13 +123,13 @@ instance HasTextEnvelope Certificate where textEnvelopeType _ = "CertificateShelley" textEnvelopeDefaultDescr cert = case cert of StakeAddressRegistrationCertificate{} -> "Stake address registration" - StakeAddressDeregistrationCertificate{} -> "Stake address de-registration" + StakeAddressDeregistrationCertificate{} -> "Stake address deregistration" StakeAddressPoolDelegationCertificate{} -> "Stake address stake pool delegation" StakePoolRegistrationCertificate{} -> "Pool registration" StakePoolRetirementCertificate{} -> "Pool retirement" GenesisKeyDelegationCertificate{} -> "Genesis key delegation" - CommitteeDelegationCertificate{} -> "Constitution Committee key delegation" - CommitteeHotKeyUnregistrationCertificate{} -> "Constitution Committee hot key unregistration" + CommitteeDelegationCertificate{} -> "Constitution committee member key delegation" + CommitteeHotKeyDeregistrationCertificate{} -> "Constitution committee member hot key deregistration" MIRCertificate{} -> "MIR" -- | The 'MIRTarget' determines the target of a 'MIRCertificate'. @@ -239,7 +239,7 @@ makeCommitteeDelegationCertificate = CommitteeDelegationCertificate makeCommitteeHotKeyUnregistrationCertificate :: () => Hash CommitteeColdKey -> Certificate -makeCommitteeHotKeyUnregistrationCertificate = CommitteeHotKeyUnregistrationCertificate +makeCommitteeHotKeyUnregistrationCertificate = CommitteeHotKeyDeregistrationCertificate makeMIRCertificate :: MIRPot -> MIRTarget -> Certificate makeMIRCertificate = MIRCertificate @@ -297,9 +297,9 @@ toShelleyCertificate ) = error "TODO CIP-1694 Need ledger types for CommitteeDelegationCertificate" toShelleyCertificate - ( CommitteeHotKeyUnregistrationCertificate + ( CommitteeHotKeyDeregistrationCertificate (CommitteeColdKeyHash _ckh) - ) = error "TODO CIP-1694 Need ledger types for CommitteeHotKeyUnregistrationCertificate" + ) = error "TODO CIP-1694 Need ledger types for CommitteeHotKeyDeregistrationCertificate" toShelleyCertificate (MIRCertificate mirpot (StakeAddressesMIR amounts)) = Shelley.DCertMir $ From 61c831f2b5f9fff77c70abf6087d2afc280a3fc8 Mon Sep 17 00:00:00 2001 From: Jordan Millar Date: Thu, 22 Jun 2023 09:41:48 -0400 Subject: [PATCH 05/11] Add ProposalProcedure and VotingProcedure modules --- cardano-api/cardano-api.cabal | 2 + .../Governance/Actions/ProposalProcedure.hs | 83 ++++++++ .../Api/Governance/Actions/VotingProcedure.hs | 190 ++++++++++++++++++ cardano-api/internal/Cardano/Api/TxBody.hs | 25 ++- cardano-api/internal/Cardano/Api/Utils.hs | 26 +++ cardano-api/src/Cardano/Api/Shelley.hs | 4 + 6 files changed, 329 insertions(+), 1 deletion(-) create mode 100644 cardano-api/internal/Cardano/Api/Governance/Actions/ProposalProcedure.hs create mode 100644 cardano-api/internal/Cardano/Api/Governance/Actions/VotingProcedure.hs diff --git a/cardano-api/cardano-api.cabal b/cardano-api/cardano-api.cabal index ff07dcec10..681f13d18b 100644 --- a/cardano-api/cardano-api.cabal +++ b/cardano-api/cardano-api.cabal @@ -62,6 +62,8 @@ library internal Cardano.Api.Fees Cardano.Api.Genesis Cardano.Api.GenesisParameters + Cardano.Api.Governance.Actions.ProposalProcedure + Cardano.Api.Governance.Actions.VotingProcedure Cardano.Api.Governance.Poll Cardano.Api.Hash Cardano.Api.HasTypeProxy diff --git a/cardano-api/internal/Cardano/Api/Governance/Actions/ProposalProcedure.hs b/cardano-api/internal/Cardano/Api/Governance/Actions/ProposalProcedure.hs new file mode 100644 index 0000000000..bc962ae742 --- /dev/null +++ b/cardano-api/internal/Cardano/Api/Governance/Actions/ProposalProcedure.hs @@ -0,0 +1,83 @@ +{-# LANGUAGE ExistentialQuantification #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE StandaloneDeriving #-} + +module Cardano.Api.Governance.Actions.ProposalProcedure where + +import Cardano.Api.Eras +import Cardano.Api.Keys.Shelley +import Cardano.Api.Utils +import Cardano.Api.Value + +import qualified Cardano.Ledger.Conway.Governance as Gov +import Cardano.Ledger.Core (EraCrypto) +import Cardano.Ledger.Crypto (StandardCrypto) +import Cardano.Ledger.SafeHash + +import Data.ByteString (ByteString) +import Data.Maybe.Strict +import Data.Proxy + +-- | A representation of whether the era supports tx governance actions. +-- +-- The Conway and subsequent eras support governance actions. +-- +data TxGovernanceActions era where + TxGovernanceActionsNone :: TxGovernanceActions era + + TxGovernanceActions + :: TxGovernanceActionSupportedInEra era + -- (deposit, return address, governance action) + -> [(Lovelace, Hash StakeKey, GovernanceAction)] + -> TxGovernanceActions era + +deriving instance Show (TxGovernanceActions era) +deriving instance Eq (TxGovernanceActions era) + + +-- | A representation of whether the era supports transactions with governance +-- actions. +-- +-- The Conway and subsequent eras support governance actions. +-- +data TxGovernanceActionSupportedInEra era where + + GovernanceActionsSupportedInConwayEra :: TxGovernanceActionSupportedInEra ConwayEra + +deriving instance Show (TxGovernanceActionSupportedInEra era) +deriving instance Eq (TxGovernanceActionSupportedInEra era) + + +data AnyGovernanceAction = forall era. AnyGovernanceAction (Gov.GovernanceAction era) + +-- TODO: Conway - fill in remaining actions +data GovernanceAction + = MotionOfNoConfidence + | ProposeNewConstitution ByteString + deriving (Eq, Show) + +toSafeHash :: ByteString -> SafeHash StandardCrypto ByteString +toSafeHash = makeHashWithExplicitProxys (Proxy :: Proxy StandardCrypto) (Proxy :: Proxy ByteString) + +toGovernanceAction + :: EraCrypto ledgerera ~ StandardCrypto + => GovernanceAction + -> Gov.GovernanceAction ledgerera +toGovernanceAction MotionOfNoConfidence = Gov.NoConfidence +toGovernanceAction (ProposeNewConstitution bs) = + Gov.NewConstitution $ toSafeHash bs + +createProposalProcedure + :: ShelleyBasedEra era + -> Lovelace -- ^ Deposit + -> Hash StakeKey -- ^ Return address + -> GovernanceAction + -> Gov.ProposalProcedure (ShelleyLedgerEra era) +createProposalProcedure sbe dep (StakeKeyHash retAddrh) govAct = + obtainEraCryptoConstraints sbe $ + Gov.ProposalProcedure + { Gov.pProcDeposit = toShelleyLovelace dep + , Gov.pProcReturnAddr = retAddrh + , Gov.pProcGovernanceAction = toGovernanceAction govAct + , Gov.pProcAnchor = SNothing -- TODO: Conway + } diff --git a/cardano-api/internal/Cardano/Api/Governance/Actions/VotingProcedure.hs b/cardano-api/internal/Cardano/Api/Governance/Actions/VotingProcedure.hs new file mode 100644 index 0000000000..f3eea601c7 --- /dev/null +++ b/cardano-api/internal/Cardano/Api/Governance/Actions/VotingProcedure.hs @@ -0,0 +1,190 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE TypeFamilies #-} + +module Cardano.Api.Governance.Actions.VotingProcedure where + +import Cardano.Api.Address +import Cardano.Api.Eras +import Cardano.Api.HasTypeProxy +import Cardano.Api.Script +import Cardano.Api.SerialiseCBOR +import Cardano.Api.SerialiseTextEnvelope +import Cardano.Api.TxIn +import Cardano.Api.Utils + +import qualified Cardano.Ledger.BaseTypes as Ledger +import qualified Cardano.Ledger.Binary.Plain as Plain +import qualified Cardano.Ledger.Conway.Governance as Gov +import Cardano.Ledger.Core (EraCrypto) +import qualified Cardano.Ledger.Credential as Ledger +import Cardano.Ledger.Keys +import qualified Cardano.Ledger.TxIn as Ledger + +import Data.ByteString.Lazy (ByteString) +import Data.Maybe.Strict + + +-- | A representation of whether the era supports tx voting on governance actions. +-- +-- The Conway and subsequent eras support tx voting on governance actions. +-- +data TxVotes era where + TxVotesNone :: TxVotes era + + TxVotes + :: TxVotesSupportedInEra era + -> [(VoteChoice, VoterType, GovernanceActionIdentifier (ShelleyLedgerEra era), VotingCredential (ShelleyLedgerEra era))] + -> TxVotes era + +deriving instance Show (TxVotes era) +deriving instance Eq (TxVotes era) + + +-- | A representation of whether the era supports transactions with votes. +-- +-- The Conway and subsequent eras support governance actions. +-- +data TxVotesSupportedInEra era where + + VotesSupportedInConwayEra :: TxVotesSupportedInEra ConwayEra + +deriving instance Show (TxVotesSupportedInEra era) +deriving instance Eq (TxVotesSupportedInEra era) + + +votesSupportedInEra :: ShelleyBasedEra era -> Maybe (TxVotesSupportedInEra era) +votesSupportedInEra ShelleyBasedEraShelley = Nothing +votesSupportedInEra ShelleyBasedEraAllegra = Nothing +votesSupportedInEra ShelleyBasedEraMary = Nothing +votesSupportedInEra ShelleyBasedEraAlonzo = Nothing +votesSupportedInEra ShelleyBasedEraBabbage = Nothing +votesSupportedInEra ShelleyBasedEraConway = Just VotesSupportedInConwayEra + + +newtype GovernanceActionIdentifier ledgerera + = GovernanceActionIdentifier (Gov.GovernanceActionId (EraCrypto ledgerera)) + deriving (Show, Eq) + +makeGoveranceActionIdentifier + :: ShelleyBasedEra era -> TxIn -> GovernanceActionIdentifier (ShelleyLedgerEra era) +makeGoveranceActionIdentifier sbe txin = + let Ledger.TxIn txid (Ledger.TxIx txix) = toShelleyTxIn txin + in obtainEraCryptoConstraints sbe + $ GovernanceActionIdentifier $ + Gov.GovernanceActionId + { Gov.gaidTxId = txid + , Gov.gaidGovActionIx = Gov.GovernanceActionIx txix + } + +-- toVotingCredential :: _ -> Ledger.Credential 'Voting (EraCrypto ledgerera) +-- toVotingCredential = undefined + +data VoterType + = CC -- ^ Constitutional committee + | DR -- ^ Delegated representative + | SP -- ^ Stake pool operator + deriving (Show, Eq) + +data VoteChoice + = No + | Yes + | Abst -- ^ Abstain + deriving (Show, Eq) + +toVoterRole :: VoterType -> Gov.VoterRole +toVoterRole CC = Gov.ConstitutionalCommittee +toVoterRole DR = Gov.DRep +toVoterRole SP = Gov.SPO + +toVote :: VoteChoice -> Gov.Vote +toVote No = Gov.VoteNo +toVote Yes = Gov.VoteYes +toVote Abst = Gov.Abstain + +--toVotingCredential' +-- :: ShelleyBasedEra era +-- -> StakeCredential +-- -> Either CBOR.DecoderError (Ledger.Credential 'Voting (ShelleyLedgerEra era)) +--toVotingCredential' sbe (StakeCredentialByKey (StakeKeyHash kh)) = do +-- let cbor = CBOR.serialize kh +-- obtainEraCryptoConstraints sbe $ eraDecodeVotingCredential sbe $ BS.toStrict cbor +-- +--toVotingCredential' sbe (StakeCredentialByScript (ScriptHash sh)) = do +-- let cbor = CBOR.serialize sh +-- obtainEraCryptoConstraints sbe $ eraDecodeVotingCredential sbe $ BS.toStrict cbor + + +toVotingCredential + :: ShelleyBasedEra era + -> StakeCredential + -> Either Plain.DecoderError (VotingCredential (ShelleyLedgerEra era)) +toVotingCredential sbe (StakeCredentialByKey (StakeKeyHash kh)) = do + let cbor = Plain.serialize kh + eraDecodeVotingCredential sbe cbor + +toVotingCredential sbe (StakeCredentialByScript (ScriptHash sh)) = do + let cbor = Plain.serialize sh + eraDecodeVotingCredential sbe cbor + +-- TODO: Conway era +-- This is a hack. data StakeCredential in cardano-api is not parameterized by era, it defaults to StandardCrypto. +-- However VotingProcedure is parameterized on era so we need to figure out a way to reconcile this. +eraDecodeVotingCredential + :: ShelleyBasedEra era + -> ByteString + -> Either Plain.DecoderError (VotingCredential (ShelleyLedgerEra era)) +eraDecodeVotingCredential sbe bs = obtainCryptoConstraints sbe $ + case Plain.decodeFull bs of + Left e -> Left e + Right x -> Right $ VotingCredential x + + +newtype VotingCredential ledgerera + = VotingCredential (Ledger.Credential 'Voting (EraCrypto ledgerera)) + +deriving instance Show (VotingCredential crypto) +deriving instance Eq (VotingCredential crypto) + +createVotingProcedure + :: ShelleyBasedEra era + -> VoteChoice + -> VoterType + -> GovernanceActionIdentifier (ShelleyLedgerEra era) + -> VotingCredential (ShelleyLedgerEra era) -- ^ Governance witness credential (ledger checks that you are allowed to vote) + -> Vote era +createVotingProcedure sbe vChoice vt (GovernanceActionIdentifier govActId) (VotingCredential govWitnessCredential) = + obtainEraCryptoConstraints sbe + $ Vote $ Gov.VotingProcedure + { Gov.vProcGovActionId = govActId + , Gov.vProcRole = toVoterRole vt + , Gov.vProcRoleKeyHash = govWitnessCredential + , Gov.vProcVote = toVote vChoice + , Gov.vProcAnchor = SNothing -- TODO: Conway + } + +newtype Vote era = Vote { unVote :: Gov.VotingProcedure (ShelleyLedgerEra era) } + deriving (Show, Eq) + +instance IsShelleyBasedEra era => ToCBOR (Vote era) where + toCBOR (Vote _vp) = undefined + +instance IsShelleyBasedEra era => FromCBOR (Vote era) where + fromCBOR = undefined +instance IsShelleyBasedEra era => SerialiseAsCBOR (Vote era) where + + serialiseToCBOR = undefined + deserialiseFromCBOR = undefined + + +instance IsShelleyBasedEra era => HasTextEnvelope (Vote era) where + textEnvelopeType _ = "Governance vote" + +instance HasTypeProxy era => HasTypeProxy (Vote era) where + data AsType (Vote era) = AsVote + proxyToAsType _ = AsVote diff --git a/cardano-api/internal/Cardano/Api/TxBody.hs b/cardano-api/internal/Cardano/Api/TxBody.hs index 5df59c69cb..f891a18908 100644 --- a/cardano-api/internal/Cardano/Api/TxBody.hs +++ b/cardano-api/internal/Cardano/Api/TxBody.hs @@ -188,6 +188,7 @@ import Cardano.Api.Convenience.Constraints import Cardano.Api.EraCast import Cardano.Api.Eras import Cardano.Api.Error +import Cardano.Api.Governance.Actions.ProposalProcedure import Cardano.Api.Hash import Cardano.Api.HasTypeProxy import Cardano.Api.Keys.Byron @@ -222,6 +223,7 @@ import qualified Cardano.Ledger.Binary as CBOR import qualified Cardano.Ledger.Block as Ledger import qualified Cardano.Ledger.Conway.Core as L import qualified Cardano.Ledger.Conway.Delegation.Certificates as Conway +import qualified Cardano.Ledger.Conway.Governance as Conway import qualified Cardano.Ledger.Core as Core import qualified Cardano.Ledger.Core as Ledger import qualified Cardano.Ledger.Credential as Shelley @@ -1751,7 +1753,8 @@ data TxBodyContent build era = txCertificates :: TxCertificates build era, txUpdateProposal :: TxUpdateProposal era, txMintValue :: TxMintValue build era, - txScriptValidity :: TxScriptValidity era + txScriptValidity :: TxScriptValidity era, + txGovernanceActions :: TxGovernanceAction era } deriving (Eq, Show) @@ -1774,6 +1777,7 @@ defaultTxBodyContent = TxBodyContent , txUpdateProposal = TxUpdateProposalNone , txMintValue = TxMintNone , txScriptValidity = TxScriptValidityNone + , txGovernanceActions = TxGovernanceActionsNone } setTxIns :: TxIns build era -> TxBodyContent build era -> TxBodyContent build era @@ -2722,10 +2726,28 @@ fromLedgerTxBody era scriptValidity body scriptdata mAux = , txMetadata , txAuxScripts , txScriptValidity = scriptValidity + , txGovernanceActions = fromLedgerProposalProcedure era body } where (txMetadata, txAuxScripts) = fromLedgerTxAuxiliaryData era mAux +-- TODO: Conway +fromLedgerProposalProcedure + :: ShelleyBasedEra era + -> Ledger.TxBody (ShelleyLedgerEra era) + -> TxGovernanceAction era +fromLedgerProposalProcedure _ _bdy = TxGovernanceActionsNone + where + _proposalProcedures + :: ShelleyBasedEra era + -> Ledger.TxBody (ShelleyLedgerEra era) + -> Seq.StrictSeq (Conway.ProposalProcedure era) + _proposalProcedures ShelleyBasedEraShelley _bdy = mempty + _proposalProcedures ShelleyBasedEraAllegra _bdy = mempty + _proposalProcedures ShelleyBasedEraMary _bdy = mempty + _proposalProcedures ShelleyBasedEraAlonzo _bdy = mempty + _proposalProcedures ShelleyBasedEraBabbage _bdy = mempty + _proposalProcedures ShelleyBasedEraConway _bdy = mempty fromLedgerTxIns :: forall era. @@ -3394,6 +3416,7 @@ getByronTxBodyContent (Annotated Byron.UnsafeTx{txInputs, txOutputs} _) = , txUpdateProposal = TxUpdateProposalNone , txMintValue = TxMintNone , txScriptValidity = TxScriptValidityNone + , txGovernanceActions = TxGovernanceActionsNone } convTxIns :: TxIns BuildTx era -> Set (L.TxIn StandardCrypto) diff --git a/cardano-api/internal/Cardano/Api/Utils.hs b/cardano-api/internal/Cardano/Api/Utils.hs index 0f776eda63..c25fa5d745 100644 --- a/cardano-api/internal/Cardano/Api/Utils.hs +++ b/cardano-api/internal/Cardano/Api/Utils.hs @@ -1,4 +1,5 @@ {-# LANGUAGE CPP #-} +{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE RankNTypes #-} @@ -128,3 +129,28 @@ bounded t = eitherReader $ \s -> do when (i < fromIntegral (minBound @a)) $ Left $ t <> " must not be less than " <> show (minBound @a) when (i > fromIntegral (maxBound @a)) $ Left $ t <> " must not greater than " <> show (maxBound @a) pure (fromIntegral i) + +obtainEraCryptoConstraints + :: ShelleyBasedEra era + -> (EraCrypto (ShelleyLedgerEra era) ~ StandardCrypto => a) + -> a +obtainEraCryptoConstraints ShelleyBasedEraShelley f = f +obtainEraCryptoConstraints ShelleyBasedEraAllegra f = f +obtainEraCryptoConstraints ShelleyBasedEraMary f = f +obtainEraCryptoConstraints ShelleyBasedEraAlonzo f = f +obtainEraCryptoConstraints ShelleyBasedEraBabbage f = f +obtainEraCryptoConstraints ShelleyBasedEraConway f = f + +--obtainCryptoConstraints +-- :: ShelleyBasedEra era +-- -> (( ShelleyLedgerEra era ~ StandardShelley +-- , Crypto (ShelleyLedgerEra era) +-- ) => a +-- ) +-- -> a +--obtainCryptoConstraints ShelleyBasedEraShelley f = f +--obtainCryptoConstraints ShelleyBasedEraAllegra f = f +--obtainCryptoConstraints ShelleyBasedEraMary f = f +--obtainCryptoConstraints ShelleyBasedEraAlonzo f = f +--obtainCryptoConstraints ShelleyBasedEraBabbage f = f +--obtainCryptoConstraints ShelleyBasedEraConway f = f diff --git a/cardano-api/src/Cardano/Api/Shelley.hs b/cardano-api/src/Cardano/Api/Shelley.hs index 41a5a526b4..2d92842f9b 100644 --- a/cardano-api/src/Cardano/Api/Shelley.hs +++ b/cardano-api/src/Cardano/Api/Shelley.hs @@ -237,10 +237,14 @@ module Cardano.Api.Shelley SystemStart(..), -- ** Governance + GovernanceActionIdentifier(..), + TxGovernanceActions(..), + TxVotes(..), GovernancePoll (..), GovernancePollAnswer (..), GovernancePollError (..), renderGovernancePollError, + toVotingCredential, hashGovernancePoll, verifyPollAnswer, From 095f4bc894b6e1fb5f0ddeffd674f348b32c86e2 Mon Sep 17 00:00:00 2001 From: Jordan Millar Date: Thu, 22 Jun 2023 10:50:25 -0400 Subject: [PATCH 06/11] Propagate TxGovernanceAction throughout the rest of cardano-api --- cardano-api/gen/Test/Gen/Cardano/Api/Typed.hs | 5 +++-- cardano-api/src/Cardano/Api/Shelley.hs | 1 + 2 files changed, 4 insertions(+), 2 deletions(-) diff --git a/cardano-api/gen/Test/Gen/Cardano/Api/Typed.hs b/cardano-api/gen/Test/Gen/Cardano/Api/Typed.hs index b50fcff0e1..bdbfce992d 100644 --- a/cardano-api/gen/Test/Gen/Cardano/Api/Typed.hs +++ b/cardano-api/gen/Test/Gen/Cardano/Api/Typed.hs @@ -128,7 +128,7 @@ import Cardano.Api.Shelley (GovernancePoll (..), GovernancePollAnswer OperationalCertificateIssueCounter (OperationalCertificateIssueCounter), PlutusScript (PlutusScriptSerialised), ProtocolParameters (..), ReferenceScript (..), ReferenceTxInsScriptsInlineDatumsSupportedInEra (..), - StakeCredential (StakeCredentialByKey), StakePoolKey, + StakeCredential (StakeCredentialByKey), StakePoolKey, TxGovernanceAction (..), refInsScriptsAndInlineDatsSupportedInEra) import qualified Cardano.Binary as CBOR @@ -644,7 +644,7 @@ genTxBodyContent era = do txUpdateProposal <- genTxUpdateProposal era txMintValue <- genTxMintValue era txScriptValidity <- genTxScriptValidity era - + txGovernanceActions <- return TxGovernanceActionsNone -- TODO: Conway era pure $ TxBodyContent { Api.txIns , Api.txInsCollateral @@ -663,6 +663,7 @@ genTxBodyContent era = do , Api.txUpdateProposal , Api.txMintValue , Api.txScriptValidity + , Api.txGovernanceActions } genTxInsCollateral :: CardanoEra era -> Gen (TxInsCollateral era) diff --git a/cardano-api/src/Cardano/Api/Shelley.hs b/cardano-api/src/Cardano/Api/Shelley.hs index 2d92842f9b..2ef693fd10 100644 --- a/cardano-api/src/Cardano/Api/Shelley.hs +++ b/cardano-api/src/Cardano/Api/Shelley.hs @@ -269,6 +269,7 @@ import Cardano.Api.Certificate import Cardano.Api.DRepMetadata import Cardano.Api.Eras import Cardano.Api.Genesis +import Cardano.Api.Governance.Actions.ProposalProcedure import Cardano.Api.Governance.Poll import Cardano.Api.InMode import Cardano.Api.IPC From 350e12bd7219a3e3a500a95a851d7fbfe6277977 Mon Sep 17 00:00:00 2001 From: Jordan Millar Date: Thu, 22 Jun 2023 14:18:56 -0400 Subject: [PATCH 07/11] Add txVotes and txGovernanceActions fields to TxBodyContent --- cardano-api/internal/Cardano/Api/TxBody.hs | 77 ++++++++++++---------- 1 file changed, 41 insertions(+), 36 deletions(-) diff --git a/cardano-api/internal/Cardano/Api/TxBody.hs b/cardano-api/internal/Cardano/Api/TxBody.hs index f891a18908..254701b38b 100644 --- a/cardano-api/internal/Cardano/Api/TxBody.hs +++ b/cardano-api/internal/Cardano/Api/TxBody.hs @@ -189,6 +189,7 @@ import Cardano.Api.EraCast import Cardano.Api.Eras import Cardano.Api.Error import Cardano.Api.Governance.Actions.ProposalProcedure +import Cardano.Api.Governance.Actions.VotingProcedure import Cardano.Api.Hash import Cardano.Api.HasTypeProxy import Cardano.Api.Keys.Byron @@ -1736,25 +1737,26 @@ deriving instance Show (TxMintValue build era) data TxBodyContent build era = TxBodyContent { - txIns :: TxIns build era, - txInsCollateral :: TxInsCollateral era, - txInsReference :: TxInsReference build era, - txOuts :: [TxOut CtxTx era], - txTotalCollateral :: TxTotalCollateral era, - txReturnCollateral :: TxReturnCollateral CtxTx era, - txFee :: TxFee era, - txValidityRange :: (TxValidityLowerBound era, + txIns :: TxIns build era, + txInsCollateral :: TxInsCollateral era, + txInsReference :: TxInsReference build era, + txOuts :: [TxOut CtxTx era], + txTotalCollateral :: TxTotalCollateral era, + txReturnCollateral :: TxReturnCollateral CtxTx era, + txFee :: TxFee era, + txValidityRange :: (TxValidityLowerBound era, TxValidityUpperBound era), - txMetadata :: TxMetadataInEra era, - txAuxScripts :: TxAuxScripts era, - txExtraKeyWits :: TxExtraKeyWitnesses era, - txProtocolParams :: BuildTxWith build (Maybe ProtocolParameters), - txWithdrawals :: TxWithdrawals build era, - txCertificates :: TxCertificates build era, - txUpdateProposal :: TxUpdateProposal era, - txMintValue :: TxMintValue build era, - txScriptValidity :: TxScriptValidity era, - txGovernanceActions :: TxGovernanceAction era + txMetadata :: TxMetadataInEra era, + txAuxScripts :: TxAuxScripts era, + txExtraKeyWits :: TxExtraKeyWitnesses era, + txProtocolParams :: BuildTxWith build (Maybe ProtocolParameters), + txWithdrawals :: TxWithdrawals build era, + txCertificates :: TxCertificates build era, + txUpdateProposal :: TxUpdateProposal era, + txMintValue :: TxMintValue build era, + txScriptValidity :: TxScriptValidity era, + txGovernanceActions :: TxGovernanceActions era, + txVotes :: TxVotes era } deriving (Eq, Show) @@ -1778,6 +1780,7 @@ defaultTxBodyContent = TxBodyContent , txMintValue = TxMintNone , txScriptValidity = TxScriptValidityNone , txGovernanceActions = TxGovernanceActionsNone + , txVotes = TxVotesNone } setTxIns :: TxIns build era -> TxBodyContent build era -> TxBodyContent build era @@ -2727,6 +2730,7 @@ fromLedgerTxBody era scriptValidity body scriptdata mAux = , txAuxScripts , txScriptValidity = scriptValidity , txGovernanceActions = fromLedgerProposalProcedure era body + , txVotes = error "fromLedgerTxBody.txVotes: TODO: Conway" } where (txMetadata, txAuxScripts) = fromLedgerTxAuxiliaryData era mAux @@ -2735,7 +2739,7 @@ fromLedgerTxBody era scriptValidity body scriptdata mAux = fromLedgerProposalProcedure :: ShelleyBasedEra era -> Ledger.TxBody (ShelleyLedgerEra era) - -> TxGovernanceAction era + -> TxGovernanceActions era fromLedgerProposalProcedure _ _bdy = TxGovernanceActionsNone where _proposalProcedures @@ -3399,24 +3403,25 @@ getByronTxBodyContent :: Annotated Byron.Tx ByteString -> TxBodyContent ViewTx ByronEra getByronTxBodyContent (Annotated Byron.UnsafeTx{txInputs, txOutputs} _) = TxBodyContent - { txIns = [(fromByronTxIn input, ViewTx) | input <- toList txInputs] - , txInsCollateral = TxInsCollateralNone - , txInsReference = TxInsReferenceNone - , txOuts = fromByronTxOut <$> toList txOutputs - , txReturnCollateral = TxReturnCollateralNone - , txTotalCollateral = TxTotalCollateralNone - , txFee = TxFeeImplicit TxFeesImplicitInByronEra - , txValidityRange = (TxValidityNoLowerBound, TxValidityNoUpperBound ValidityNoUpperBoundInByronEra) - , txMetadata = TxMetadataNone - , txAuxScripts = TxAuxScriptsNone - , txExtraKeyWits = TxExtraKeyWitnessesNone - , txProtocolParams = ViewTx - , txWithdrawals = TxWithdrawalsNone - , txCertificates = TxCertificatesNone - , txUpdateProposal = TxUpdateProposalNone - , txMintValue = TxMintNone - , txScriptValidity = TxScriptValidityNone + { txIns = [(fromByronTxIn input, ViewTx) | input <- toList txInputs] + , txInsCollateral = TxInsCollateralNone + , txInsReference = TxInsReferenceNone + , txOuts = fromByronTxOut <$> toList txOutputs + , txReturnCollateral = TxReturnCollateralNone + , txTotalCollateral = TxTotalCollateralNone + , txFee = TxFeeImplicit TxFeesImplicitInByronEra + , txValidityRange = (TxValidityNoLowerBound, TxValidityNoUpperBound ValidityNoUpperBoundInByronEra) + , txMetadata = TxMetadataNone + , txAuxScripts = TxAuxScriptsNone + , txExtraKeyWits = TxExtraKeyWitnessesNone + , txProtocolParams = ViewTx + , txWithdrawals = TxWithdrawalsNone + , txCertificates = TxCertificatesNone + , txUpdateProposal = TxUpdateProposalNone + , txMintValue = TxMintNone + , txScriptValidity = TxScriptValidityNone , txGovernanceActions = TxGovernanceActionsNone + , txVotes = TxVotesNone } convTxIns :: TxIns BuildTx era -> Set (L.TxIn StandardCrypto) From 8cca4d9a0b7bfec2aa4915aade04ba00705d887a Mon Sep 17 00:00:00 2001 From: Jordan Millar Date: Thu, 22 Jun 2023 14:19:12 -0400 Subject: [PATCH 08/11] Expose TxVotes and TxGovernanceActions via Cardano.Api and Cardano.Api.Shelley --- cardano-api/src/Cardano/Api.hs | 4 ++++ cardano-api/src/Cardano/Api/Shelley.hs | 7 ++++++- 2 files changed, 10 insertions(+), 1 deletion(-) diff --git a/cardano-api/src/Cardano/Api.hs b/cardano-api/src/Cardano/Api.hs index 2c0dfe6319..092d495b9a 100644 --- a/cardano-api/src/Cardano/Api.hs +++ b/cardano-api/src/Cardano/Api.hs @@ -257,6 +257,8 @@ module Cardano.Api ( TxCertificates(..), TxUpdateProposal(..), TxMintValue(..), + TxVotes(..), + TxGovernanceActions(..), -- ** Building vs viewing transactions BuildTxWith(..), @@ -910,6 +912,8 @@ import Cardano.Api.Feature import Cardano.Api.Fees import Cardano.Api.Genesis import Cardano.Api.GenesisParameters +import Cardano.Api.Governance.Actions.ProposalProcedure +import Cardano.Api.Governance.Actions.VotingProcedure import Cardano.Api.Hash import Cardano.Api.HasTypeProxy import Cardano.Api.InMode diff --git a/cardano-api/src/Cardano/Api/Shelley.hs b/cardano-api/src/Cardano/Api/Shelley.hs index 2ef693fd10..3f8856b317 100644 --- a/cardano-api/src/Cardano/Api/Shelley.hs +++ b/cardano-api/src/Cardano/Api/Shelley.hs @@ -243,6 +243,11 @@ module Cardano.Api.Shelley GovernancePoll (..), GovernancePollAnswer (..), GovernancePollError (..), + VoteChoice(..), + VotingCredential(..), + VoterType(..), + createVotingProcedure, + makeGoveranceActionIdentifier, renderGovernancePollError, toVotingCredential, hashGovernancePoll, @@ -269,7 +274,7 @@ import Cardano.Api.Certificate import Cardano.Api.DRepMetadata import Cardano.Api.Eras import Cardano.Api.Genesis -import Cardano.Api.Governance.Actions.ProposalProcedure +import Cardano.Api.Governance.Actions.VotingProcedure import Cardano.Api.Governance.Poll import Cardano.Api.InMode import Cardano.Api.IPC From a135ec791f5f4aaf2b79cf365677b14a2852cc48 Mon Sep 17 00:00:00 2001 From: Jordan Millar Date: Thu, 22 Jun 2023 14:19:44 -0400 Subject: [PATCH 09/11] Propagate votes and governance actions to test generators --- cardano-api/gen/Test/Gen/Cardano/Api/Typed.hs | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/cardano-api/gen/Test/Gen/Cardano/Api/Typed.hs b/cardano-api/gen/Test/Gen/Cardano/Api/Typed.hs index bdbfce992d..b9e0eb1ba5 100644 --- a/cardano-api/gen/Test/Gen/Cardano/Api/Typed.hs +++ b/cardano-api/gen/Test/Gen/Cardano/Api/Typed.hs @@ -128,7 +128,7 @@ import Cardano.Api.Shelley (GovernancePoll (..), GovernancePollAnswer OperationalCertificateIssueCounter (OperationalCertificateIssueCounter), PlutusScript (PlutusScriptSerialised), ProtocolParameters (..), ReferenceScript (..), ReferenceTxInsScriptsInlineDatumsSupportedInEra (..), - StakeCredential (StakeCredentialByKey), StakePoolKey, TxGovernanceAction (..), + StakeCredential (StakeCredentialByKey), StakePoolKey, refInsScriptsAndInlineDatsSupportedInEra) import qualified Cardano.Binary as CBOR @@ -645,6 +645,7 @@ genTxBodyContent era = do txMintValue <- genTxMintValue era txScriptValidity <- genTxScriptValidity era txGovernanceActions <- return TxGovernanceActionsNone -- TODO: Conway era + txVotes <- return TxVotesNone -- TODO: Conway era pure $ TxBodyContent { Api.txIns , Api.txInsCollateral @@ -664,6 +665,7 @@ genTxBodyContent era = do , Api.txMintValue , Api.txScriptValidity , Api.txGovernanceActions + , Api.txVotes } genTxInsCollateral :: CardanoEra era -> Gen (TxInsCollateral era) From 49d51083064ea00e805cda8595ac5c8737387879 Mon Sep 17 00:00:00 2001 From: Jordan Millar Date: Mon, 26 Jun 2023 10:41:36 -0400 Subject: [PATCH 10/11] Moved constraint solving helper to Cardano.Api.Utils --- cardano-api/internal/Cardano/Api/Utils.hs | 34 +++++++++++++---------- 1 file changed, 20 insertions(+), 14 deletions(-) diff --git a/cardano-api/internal/Cardano/Api/Utils.hs b/cardano-api/internal/Cardano/Api/Utils.hs index c25fa5d745..9e351105d2 100644 --- a/cardano-api/internal/Cardano/Api/Utils.hs +++ b/cardano-api/internal/Cardano/Api/Utils.hs @@ -28,10 +28,18 @@ module Cardano.Api.Utils -- ** CLI option parsing , bounded + + -- ** Constraint solvers + , obtainCryptoConstraints + , obtainEraCryptoConstraints ) where import Cardano.Api.Eras +import Cardano.Ledger.Core (EraCrypto) +import Cardano.Ledger.Crypto (Crypto, StandardCrypto) +import Cardano.Ledger.Shelley () + import Control.Exception (bracket) import Control.Monad (when) import qualified Data.Aeson.Types as Aeson @@ -51,6 +59,7 @@ import qualified Text.Parsec.String as Parsec import qualified Text.ParserCombinators.Parsec.Error as Parsec import qualified Text.Read as Read + (?!) :: Maybe a -> e -> Either e a Nothing ?! e = Left e Just x ?! _ = Right x @@ -132,7 +141,7 @@ bounded t = eitherReader $ \s -> do obtainEraCryptoConstraints :: ShelleyBasedEra era - -> (EraCrypto (ShelleyLedgerEra era) ~ StandardCrypto => a) + -> ((EraCrypto (ShelleyLedgerEra era) ~ StandardCrypto) => a) -> a obtainEraCryptoConstraints ShelleyBasedEraShelley f = f obtainEraCryptoConstraints ShelleyBasedEraAllegra f = f @@ -141,16 +150,13 @@ obtainEraCryptoConstraints ShelleyBasedEraAlonzo f = f obtainEraCryptoConstraints ShelleyBasedEraBabbage f = f obtainEraCryptoConstraints ShelleyBasedEraConway f = f ---obtainCryptoConstraints --- :: ShelleyBasedEra era --- -> (( ShelleyLedgerEra era ~ StandardShelley --- , Crypto (ShelleyLedgerEra era) --- ) => a --- ) --- -> a ---obtainCryptoConstraints ShelleyBasedEraShelley f = f ---obtainCryptoConstraints ShelleyBasedEraAllegra f = f ---obtainCryptoConstraints ShelleyBasedEraMary f = f ---obtainCryptoConstraints ShelleyBasedEraAlonzo f = f ---obtainCryptoConstraints ShelleyBasedEraBabbage f = f ---obtainCryptoConstraints ShelleyBasedEraConway f = f +obtainCryptoConstraints + :: ShelleyBasedEra era + -> ((Crypto (EraCrypto (ShelleyLedgerEra era))) => a) + -> a +obtainCryptoConstraints ShelleyBasedEraShelley f = f +obtainCryptoConstraints ShelleyBasedEraAllegra f = f +obtainCryptoConstraints ShelleyBasedEraMary f = f +obtainCryptoConstraints ShelleyBasedEraAlonzo f = f +obtainCryptoConstraints ShelleyBasedEraBabbage f = f +obtainCryptoConstraints ShelleyBasedEraConway f = f From 5ee7bfc6383b2d5b187dfad5a9fdf66650616dbf Mon Sep 17 00:00:00 2001 From: Jordan Millar Date: Mon, 26 Jun 2023 10:42:24 -0400 Subject: [PATCH 11/11] Updated makeShelleyTransactionBody with votes and governance actions --- cardano-api/internal/Cardano/Api/TxBody.hs | 24 +++++++++++++++++++++- 1 file changed, 23 insertions(+), 1 deletion(-) diff --git a/cardano-api/internal/Cardano/Api/TxBody.hs b/cardano-api/internal/Cardano/Api/TxBody.hs index 254701b38b..4c8bf6fc88 100644 --- a/cardano-api/internal/Cardano/Api/TxBody.hs +++ b/cardano-api/internal/Cardano/Api/TxBody.hs @@ -180,6 +180,7 @@ module Cardano.Api.TxBody ( -- * Data family instances AsType(AsTxId, AsTxBody, AsByronTxBody, AsShelleyTxBody, AsMaryTxBody), + ) where import Cardano.Api.Address @@ -225,6 +226,7 @@ import qualified Cardano.Ledger.Block as Ledger import qualified Cardano.Ledger.Conway.Core as L import qualified Cardano.Ledger.Conway.Delegation.Certificates as Conway import qualified Cardano.Ledger.Conway.Governance as Conway +import qualified Cardano.Ledger.Conway.Governance as Gov import qualified Cardano.Ledger.Core as Core import qualified Cardano.Ledger.Core as Ledger import qualified Cardano.Ledger.Credential as Shelley @@ -3617,6 +3619,22 @@ convReferenceInputs txInsReference = TxInsReferenceNone -> mempty TxInsReference _ refTxins -> Set.fromList $ map toShelleyTxIn refTxins +convGovActions :: ShelleyBasedEra era -> TxGovernanceActions era -> Seq.StrictSeq (Gov.ProposalProcedure (ShelleyLedgerEra era)) +convGovActions _ TxGovernanceActionsNone = Seq.empty +convGovActions sbe (TxGovernanceActions _ govActions) = + Seq.fromList + [ createProposalProcedure sbe deposit stakeCred action + | (deposit, stakeCred, action) <- govActions + ] + +convVotes :: ShelleyBasedEra era -> TxVotes era -> Seq.StrictSeq (Gov.VotingProcedure (ShelleyLedgerEra era)) +convVotes _ TxVotesNone = Seq.empty +convVotes sbe (TxVotes _ votes) = + Seq.fromList + [ unVote $ createVotingProcedure sbe voteChoice voterType govActionIdentifier votingCred + | (voteChoice, voterType, govActionIdentifier, votingCred) <- votes + ] + guardShelleyTxInsOverflow :: [TxIn] -> Either TxBodyError () guardShelleyTxInsOverflow txIns = do for_ txIns $ \txin@(TxIn _ (TxIx txix)) -> @@ -3963,7 +3981,9 @@ makeShelleyTransactionBody era@ShelleyBasedEraConway txWithdrawals, txCertificates, txMintValue, - txScriptValidity + txScriptValidity, + txVotes, + txGovernanceActions } = do validateTxBodyContent era txbodycontent @@ -3983,6 +4003,8 @@ makeShelleyTransactionBody era@ShelleyBasedEraConway & L.reqSignerHashesTxBodyL .~ convExtraKeyWitnesses txExtraKeyWits & L.mintTxBodyL .~ convMintValue txMintValue & L.scriptIntegrityHashTxBodyL .~ scriptIntegrityHash + & L.votingProceduresTxBodyL .~ convVotes era txVotes + & L.proposalProceduresTxBodyL .~ convGovActions era txGovernanceActions -- TODO Conway: support optional network id in TxBodyContent -- & L.networkIdTxBodyL .~ SNothing )