Trying to cheat

cardano-api/internal/Cardano/Api/Governance/Actions/VotingProcedure.hs

@@ -1,29 +1,32 @@
 {-# 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.Binary as CBOR
 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.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.ByteString.Lazy (ByteString)
 import           Data.Maybe.Strict
 
 
@@ -104,35 +107,42 @@ 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
-  :: Crypto (ShelleyLedgerEra era)
-  => ShelleyBasedEra era
+  :: ShelleyBasedEra era
   -> StakeCredential
-  -> Either CBOR.DecoderError (Ledger.Credential 'Voting (ShelleyLedgerEra era))
+  -> Either Plain.DecoderError (VotingCredential (ShelleyLedgerEra era))
 toVotingCredential sbe (StakeCredentialByKey (StakeKeyHash kh)) = do
-    let cbor = CBOR.serialize kh
-    eraDecodeVotingCredential sbe $ BS.toStrict cbor
+    let cbor = Plain.serialize kh
+    eraDecodeVotingCredential sbe cbor
 
-        -- coerceKeyRole $ Ledger.KeyHashObj kh
 toVotingCredential sbe (StakeCredentialByScript (ScriptHash sh)) = do
-    let cbor = CBOR.serialize sh
-    eraDecodeVotingCredential sbe $ BS.toStrict cbor
+    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
-  :: Crypto (ShelleyLedgerEra era)
-  => ShelleyBasedEra era
+  :: ShelleyBasedEra era
   -> ByteString
-  -> Either CBOR.DecoderError (Ledger.Credential 'Voting (ShelleyLedgerEra era))
-eraDecodeVotingCredential _ bs =
-  case CBOR.decodeFull' bs of
+  -> Either Plain.DecoderError (VotingCredential (ShelleyLedgerEra era))
+eraDecodeVotingCredential sbe bs = obtainCryptoConstraints sbe $
+  case Plain.decodeFull bs of
     Left e -> Left e
-    Right x -> Right x
-    -- coerceKeyRole $ Ledger.ScriptHashObj (toShelleyScriptHash sh)
+    Right x -> Right $ VotingCredential x
 
 
 newtype VotingCredential ledgerera
@@ -147,13 +157,35 @@ createVotingProcedure
   -> VoterType
   -> GovernanceActionIdentifier (ShelleyLedgerEra era)
   -> VotingCredential (ShelleyLedgerEra era) -- ^ Governance witness credential (ledger checks that you are allowed to vote)
-  -> Gov.VotingProcedure (ShelleyLedgerEra era)
+  -> Vote era
 createVotingProcedure sbe vChoice vt (GovernanceActionIdentifier govActId) (VotingCredential govWitnessCredential) =
   obtainEraCryptoConstraints sbe
-    Gov.VotingProcedure
+    $ 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

cardano-api/internal/Cardano/Api/TxBody.hs

@@ -3634,7 +3634,7 @@ convVotes :: ShelleyBasedEra era -> TxVotes era -> Seq.StrictSeq (Gov.VotingProc
 convVotes _ TxVotesNone = Seq.empty
 convVotes sbe (TxVotes _ votes) =
   Seq.fromList
-    [ createVotingProcedure sbe voteChoice voterType govActionIdentifier votingCred
+    [ unVote $ createVotingProcedure sbe voteChoice voterType govActionIdentifier votingCred
     | (voteChoice, voterType, govActionIdentifier, votingCred) <- votes
     ]
 

cardano-api/internal/Cardano/Api/Utils.hs

@@ -30,13 +30,15 @@ module Cardano.Api.Utils
   , bounded
 
     -- ** Constraint solvers
+  , obtainCryptoConstraints
   , obtainEraCryptoConstraints
   ) where
 
 import           Cardano.Api.Eras
 
 import           Cardano.Ledger.Core (EraCrypto)
-import           Cardano.Ledger.Crypto (StandardCrypto)
+import           Cardano.Ledger.Crypto (Crypto, StandardCrypto)
+import           Cardano.Ledger.Shelley ()
 
 import           Control.Exception (bracket)
 import           Control.Monad (when)
@@ -139,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
@@ -148,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