Voting procedure changes

IntersectMBO · Jun 27, 2023 · 8ac8c78 · 8ac8c78
1 parent 274112b
commit 8ac8c78
Show file tree

Hide file tree

Showing 3 changed files with 55 additions and 2 deletions.
diff --git a/cardano-api/internal/Cardano/Api/Governance/Actions/VotingProcedure.hs b/cardano-api/internal/Cardano/Api/Governance/Actions/VotingProcedure.hs
@@ -1,22 +1,29 @@
 {-# LANGUAGE DataKinds #-}
+{-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE StandaloneDeriving #-}
 
 module Cardano.Api.Governance.Actions.VotingProcedure where
 
-import           Cardano.Api.Eras (ConwayEra, ShelleyBasedEra (..), ShelleyLedgerEra)
+import           Cardano.Api.Address
+import           Cardano.Api.Eras
+import           Cardano.Api.Script
 import           Cardano.Api.TxIn
 import           Cardano.Api.Utils
 
+import qualified Cardano.Binary as CBOR
 import qualified Cardano.Ledger.BaseTypes as Ledger
 import qualified Cardano.Ledger.Conway.Governance as Gov
 import           Cardano.Ledger.Core (EraCrypto)
 import qualified Cardano.Ledger.Credential as Ledger
+import           Cardano.Ledger.Crypto (Crypto)
 import           Cardano.Ledger.Keys
 import qualified Cardano.Ledger.TxIn as Ledger
 
+import           Data.ByteString (ByteString)
+import qualified Data.ByteString as BS
 import           Data.Maybe.Strict
 
 
@@ -97,7 +104,37 @@ toVote No = Gov.VoteNo
 toVote Yes = Gov.VoteYes
 toVote Abst = Gov.Abstain
 
--- (EraCrypto StandardCrypto)
+
+
+toVotingCredential
+  :: Crypto (ShelleyLedgerEra era)
+  => ShelleyBasedEra era
+  -> StakeCredential
+  -> Either CBOR.DecoderError (Ledger.Credential 'Voting (ShelleyLedgerEra era))
+toVotingCredential sbe (StakeCredentialByKey (StakeKeyHash kh)) = do
+    let cbor = CBOR.serialize kh
+    eraDecodeVotingCredential sbe $ BS.toStrict cbor
+
+        -- coerceKeyRole $ Ledger.KeyHashObj kh
+toVotingCredential sbe (StakeCredentialByScript (ScriptHash sh)) = do
+    let cbor = CBOR.serialize sh
+    eraDecodeVotingCredential sbe $ BS.toStrict 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
+  :: Crypto (ShelleyLedgerEra era)
+  => ShelleyBasedEra era
+  -> ByteString
+  -> Either CBOR.DecoderError (Ledger.Credential 'Voting (ShelleyLedgerEra era))
+eraDecodeVotingCredential _ bs =
+  case CBOR.decodeFull' bs of
+    Left e -> Left e
+    Right x -> Right x
+    -- coerceKeyRole $ Ledger.ScriptHashObj (toShelleyScriptHash sh)
+
+
 newtype VotingCredential ledgerera
   = VotingCredential (Ledger.Credential 'Voting (EraCrypto ledgerera))
 

diff --git 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 #-}
@@ -146,3 +147,17 @@ 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
@@ -249,6 +249,7 @@ module Cardano.Api.Shelley
     createVotingProcedure,
     makeGoveranceActionIdentifier,
     renderGovernancePollError,
+    toVotingCredential,
     hashGovernancePoll,
     verifyPollAnswer,