Vote procedure some work

IntersectMBO · Jul 7, 2023 · 67a089a · 67a089a
1 parent 58065eb
commit 67a089a
Show file tree

Hide file tree

Showing 2 changed files with 151 additions and 18 deletions.
diff --git 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
@@ -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