diff --git a/cardano-api/internal/Cardano/Api/Error.hs b/cardano-api/internal/Cardano/Api/Error.hs index a139fa4626..c153a675df 100644 --- a/cardano-api/internal/Cardano/Api/Error.hs +++ b/cardano-api/internal/Cardano/Api/Error.hs @@ -19,11 +19,6 @@ import Control.Monad.Trans.Except (ExceptT) import Control.Monad.Trans.Except.Extra (handleIOExceptT) import System.Directory (doesFileExist) import System.IO (Handle) -import Control.Monad.Trans.Except (ExceptT) -import Control.Monad.Trans.Except.Extra (handleIOExceptT) -import Control.Monad.IO.Class (MonadIO) -import System.Directory (doesFileExist) -import Control.Monad.Except (throwError) class Show e => Error e where diff --git a/cardano-api/internal/Cardano/Api/Governance/Actions/VotingProcedure.hs b/cardano-api/internal/Cardano/Api/Governance/Actions/VotingProcedure.hs index 35e4503948..5db9068068 100644 --- a/cardano-api/internal/Cardano/Api/Governance/Actions/VotingProcedure.hs +++ b/cardano-api/internal/Cardano/Api/Governance/Actions/VotingProcedure.hs @@ -15,6 +15,7 @@ module Cardano.Api.Governance.Actions.VotingProcedure where import Cardano.Api.Address import Cardano.Api.Eras import Cardano.Api.HasTypeProxy +import Cardano.Api.Keys.Shelley import Cardano.Api.Script import Cardano.Api.SerialiseCBOR (FromCBOR (fromCBOR), SerialiseAsCBOR (..), ToCBOR (toCBOR)) @@ -30,7 +31,8 @@ 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.Crypto (StandardCrypto) +import Cardano.Ledger.Keys (HasKeyRole (..), KeyRole (Voting)) import qualified Cardano.Ledger.TxIn as Ledger import Data.ByteString.Lazy (ByteString) @@ -88,13 +90,13 @@ makeGoveranceActionIdentifier sbe txin = , 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 +-- TODO: Conway era - These should be the different keys corresponding to the CC and DRs. +-- We can then derive the StakeCredentials from them. +data VoterType era + = CC (VotingCredential era) -- ^ Constitutional committee + | DR (VotingCredential era)-- ^ Delegated representative + | SP (Hash StakePoolKey) -- ^ Stake pool operator deriving (Show, Eq) data VoteChoice @@ -103,10 +105,14 @@ data VoteChoice | Abst -- ^ Abstain deriving (Show, Eq) -toVoterRole :: VoterType -> Gov.Voter -toVoterRole CC = Gov.CommitteeVoter -toVoterRole DR = Gov.DRepVoter -toVoterRole SP = Gov.StakePoolVoter +toVoterRole + :: EraCrypto (ShelleyLedgerEra era) ~ StandardCrypto + => ShelleyBasedEra era + -> VoterType era + -> Gov.Voter (Shelley.EraCrypto (ShelleyLedgerEra era)) +toVoterRole _ (CC (VotingCredential cred)) = Gov.CommitteeVoter $ coerceKeyRole cred -- TODO: Conway era - Alexey realllllyyy doesn't like this. We need to fix it. +toVoterRole _ (DR (VotingCredential cred)) = Gov.DRepVoter cred +toVoterRole _ (SP (StakePoolKeyHash kh)) = Gov.StakePoolVoter kh toVote :: VoteChoice -> Gov.Vote toVote No = Gov.VoteNo @@ -149,15 +155,14 @@ deriving instance Eq (VotingCredential crypto) createVotingProcedure :: ShelleyBasedEra era -> VoteChoice - -> VoterType + -> VoterType era -> GovernanceActionIdentifier (ShelleyLedgerEra era) - -> VotingCredential era -- ^ Governance witness credential (ledger checks that you are allowed to vote) -> Vote era -createVotingProcedure sbe vChoice vt (GovernanceActionIdentifier govActId) (VotingCredential govWitnessCredential) = +createVotingProcedure sbe vChoice vt (GovernanceActionIdentifier govActId) = obtainEraCryptoConstraints sbe $ Vote $ Gov.VotingProcedure { Gov.vProcGovActionId = govActId - , Gov.vProcVoter = toVoterRole vt + , Gov.vProcVoter = toVoterRole sbe vt , 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 diff --git a/cardano-api/internal/Cardano/Api/SerialiseJSON.hs b/cardano-api/internal/Cardano/Api/SerialiseJSON.hs index f47f895a5f..08e9a0394e 100644 --- a/cardano-api/internal/Cardano/Api/SerialiseJSON.hs +++ b/cardano-api/internal/Cardano/Api/SerialiseJSON.hs @@ -19,7 +19,7 @@ import Cardano.Api.Error import Cardano.Api.HasTypeProxy import Control.Monad.Trans.Except (runExceptT) -import Control.Monad.Trans.Except.Extra (handleIOExceptT, firstExceptT, hoistEither) +import Control.Monad.Trans.Except.Extra (firstExceptT, handleIOExceptT, hoistEither) import Data.Aeson (FromJSON (..), FromJSONKey, ToJSON (..), ToJSONKey) import qualified Data.Aeson as Aeson import Data.Aeson.Encode.Pretty (encodePretty)