Merge pull request #85 from input-output-hk/jordan/voting-procedure-g…

…overnance-procedure-updates

Voting procedure and proposal procedure updates

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

@@ -1,22 +1,32 @@
+{-# LANGUAGE DerivingStrategies #-}
 {-# LANGUAGE ExistentialQuantification #-}
+{-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE UndecidableInstances #-}
 
 module Cardano.Api.Governance.Actions.ProposalProcedure where
 
 import           Cardano.Api.Eras
+import           Cardano.Api.HasTypeProxy
 import           Cardano.Api.Keys.Shelley
+import           Cardano.Api.SerialiseCBOR
+import           Cardano.Api.SerialiseTextEnvelope
 import           Cardano.Api.Utils
 import           Cardano.Api.Value
 
+import qualified Cardano.Binary as CBOR
+import qualified Cardano.Ledger.Conway as Conway
 import qualified Cardano.Ledger.Conway.Governance as Gov
 import           Cardano.Ledger.Core (EraCrypto)
+import qualified Cardano.Ledger.Core as Shelley
 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.
 --
@@ -67,14 +77,42 @@ toGovernanceAction MotionOfNoConfidence = Gov.NoConfidence
 toGovernanceAction (ProposeNewConstitution bs) =
   Gov.NewConstitution $ toSafeHash bs
 
+newtype Proposal era = Proposal { unProposal :: Gov.ProposalProcedure (ShelleyLedgerEra era) }
+
+instance (IsShelleyBasedEra era, Shelley.EraPParams (ShelleyLedgerEra era)) => ToCBOR (Proposal era) where
+  toCBOR (Proposal vp) = Shelley.toEraCBOR @Conway.Conway vp
+
+instance ( IsShelleyBasedEra era
+         , Shelley.EraPParams (ShelleyLedgerEra era)
+         ) => FromCBOR (Proposal era) where
+  fromCBOR = Proposal <$> Shelley.fromEraCBOR @Conway.Conway
+
+instance ( IsShelleyBasedEra era
+         , Shelley.EraPParams (ShelleyLedgerEra era)
+         ) => SerialiseAsCBOR (Proposal era) where
+
+  serialiseToCBOR = CBOR.serialize'
+  deserialiseFromCBOR _proxy = CBOR.decodeFull'
+
+
+instance ( IsShelleyBasedEra era
+         , Shelley.EraPParams (ShelleyLedgerEra era)
+         ) => HasTextEnvelope (Proposal era) where
+  textEnvelopeType _ = "Governance proposal"
+
+instance HasTypeProxy era => HasTypeProxy (Proposal era) where
+    data AsType (Proposal era) = AsProposal
+    proxyToAsType _ = AsProposal
+
+
 createProposalProcedure
   :: ShelleyBasedEra era
   -> Lovelace -- ^ Deposit
   -> Hash StakeKey -- ^ Return address
   -> GovernanceAction
-  -> Gov.ProposalProcedure (ShelleyLedgerEra era)
+  -> Proposal era
 createProposalProcedure sbe dep (StakeKeyHash retAddrh) govAct =
-  obtainEraCryptoConstraints sbe $
+  Proposal $ obtainEraCryptoConstraints sbe $
     Gov.ProposalProcedure
       { Gov.pProcDeposit = toShelleyLovelace dep
       , Gov.pProcReturnAddr = retAddrh

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

@@ -3,33 +3,39 @@
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE GADTs #-}
+{-# LANGUAGE QuantifiedConstraints #-}
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE UndecidableInstances #-}
 
 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.SerialiseCBOR (FromCBOR (fromCBOR), SerialiseAsCBOR (..),
+                   ToCBOR (toCBOR))
 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 as Conway
 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 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.
@@ -39,7 +45,7 @@ data TxVotes era where
 
   TxVotes
     :: TxVotesSupportedInEra era
-    -> [(VoteChoice, VoterType, GovernanceActionIdentifier (ShelleyLedgerEra era), VotingCredential (ShelleyLedgerEra era))]
+    -> [(VoteChoice, VoterType, GovernanceActionIdentifier (ShelleyLedgerEra era), VotingCredential era)]
     -> TxVotes era
 
 deriving instance Show (TxVotes era)
@@ -107,46 +113,35 @@ 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))
+  -> Either Plain.DecoderError (VotingCredential era)
 toVotingCredential sbe (StakeCredentialByKey (StakeKeyHash kh)) = do
-    let cbor = Plain.serialize kh
+    let cbor = Plain.serialize $ Ledger.KeyHashObj kh
     eraDecodeVotingCredential sbe cbor
 
-toVotingCredential sbe (StakeCredentialByScript (ScriptHash sh)) = do
-    let cbor = Plain.serialize sh
-    eraDecodeVotingCredential sbe cbor
+toVotingCredential _sbe (StakeCredentialByScript (ScriptHash _sh)) =
+    error "toVotingCredential: script stake credentials not implemented yet"
+    -- TODO: Conway era
+    -- let cbor = Plain.serialize $ Ledger.ScriptHashObj 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.
+-- However VotingProcedure is parameterized on era. We need to also parameterize StakeCredential on era.
 eraDecodeVotingCredential
   :: ShelleyBasedEra era
   -> ByteString
-  -> Either Plain.DecoderError (VotingCredential (ShelleyLedgerEra era))
+  -> Either Plain.DecoderError (VotingCredential 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))
+newtype VotingCredential era
+  = VotingCredential (Ledger.Credential 'Voting (EraCrypto (ShelleyLedgerEra era)))
 
 deriving instance Show (VotingCredential crypto)
 deriving instance Eq (VotingCredential crypto)
@@ -156,7 +151,7 @@ createVotingProcedure
   -> VoteChoice
   -> VoterType
   -> GovernanceActionIdentifier (ShelleyLedgerEra era)
-  -> VotingCredential (ShelleyLedgerEra era) -- ^ Governance witness credential (ledger checks that you are allowed to vote)
+  -> VotingCredential era -- ^ Governance witness credential (ledger checks that you are allowed to vote)
   -> Vote era
 createVotingProcedure sbe vChoice vt (GovernanceActionIdentifier govActId) (VotingCredential govWitnessCredential) =
   obtainEraCryptoConstraints sbe
@@ -168,21 +163,32 @@ createVotingProcedure sbe vChoice vt (GovernanceActionIdentifier govActId) (Voti
       , 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
+-- TODO: Conway - convert newtype Vote to a GADT with a ShelleyBasedEra era value
+instance (Shelley.Era (ShelleyLedgerEra era)
+         , IsShelleyBasedEra era
+         ) => ToCBOR (Vote era) where
+  toCBOR (Vote vp) = Shelley.toEraCBOR @Conway.Conway vp
+
+instance ( IsShelleyBasedEra era
+         , Shelley.Era (ShelleyLedgerEra era)
+         ) => FromCBOR (Vote era) where
+  fromCBOR = Vote <$> Shelley.fromEraCBOR @Conway.Conway
 
-instance IsShelleyBasedEra era => FromCBOR (Vote era) where
-  fromCBOR = undefined
-instance IsShelleyBasedEra era => SerialiseAsCBOR (Vote era) where
+instance ( IsShelleyBasedEra era
+         , Shelley.Era (ShelleyLedgerEra era)
+         ) => SerialiseAsCBOR (Vote era) where
 
-  serialiseToCBOR = undefined
-  deserialiseFromCBOR = undefined
+  serialiseToCBOR = CBOR.serialize'
+  deserialiseFromCBOR _proxy = CBOR.decodeFull'
 
 
-instance IsShelleyBasedEra era => HasTextEnvelope (Vote era) where
+instance ( IsShelleyBasedEra era
+         , Shelley.Era (ShelleyLedgerEra era)
+         ) => HasTextEnvelope (Vote era) where
   textEnvelopeType _ = "Governance vote"
 
 instance HasTypeProxy era => HasTypeProxy (Vote era) where

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

@@ -3623,7 +3623,7 @@ convGovActions :: ShelleyBasedEra era -> TxGovernanceActions era -> Seq.StrictSe
 convGovActions _ TxGovernanceActionsNone = Seq.empty
 convGovActions sbe (TxGovernanceActions _ govActions) =
   Seq.fromList
-    [ createProposalProcedure sbe deposit stakeCred action
+    [ unProposal $ createProposalProcedure sbe deposit stakeCred action
     | (deposit, stakeCred, action) <- govActions
     ]
 

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

@@ -31,12 +31,14 @@ module Cardano.Api.Utils
 
     -- ** Constraint solvers
   , obtainCryptoConstraints
+  , obtainEraPParamsConstraint
   , obtainEraCryptoConstraints
   ) where
 
 import           Cardano.Api.Eras
 
 import           Cardano.Ledger.Core (EraCrypto)
+import qualified Cardano.Ledger.Core as Ledger
 import           Cardano.Ledger.Crypto (Crypto, StandardCrypto)
 import           Cardano.Ledger.Shelley ()
 
@@ -160,3 +162,16 @@ obtainCryptoConstraints ShelleyBasedEraMary    f = f
 obtainCryptoConstraints ShelleyBasedEraAlonzo  f = f
 obtainCryptoConstraints ShelleyBasedEraBabbage f = f
 obtainCryptoConstraints ShelleyBasedEraConway  f = f
+
+
+obtainEraPParamsConstraint
+  :: ShelleyBasedEra era
+  -> (Ledger.EraPParams (ShelleyLedgerEra era) => a)
+  -> a
+obtainEraPParamsConstraint ShelleyBasedEraShelley f = f
+obtainEraPParamsConstraint ShelleyBasedEraAllegra f = f
+obtainEraPParamsConstraint ShelleyBasedEraMary    f = f
+obtainEraPParamsConstraint ShelleyBasedEraAlonzo  f = f
+obtainEraPParamsConstraint ShelleyBasedEraBabbage f = f
+obtainEraPParamsConstraint ShelleyBasedEraConway  f = f
+

cardano-api/src/Cardano/Api/Shelley.hs

@@ -237,7 +237,9 @@ module Cardano.Api.Shelley
     SystemStart(..),
 
     -- ** Governance
+    GovernanceAction(..),
     GovernanceActionIdentifier(..),
+    Proposal(..),
     TxGovernanceActions(..),
     TxVotes(..),
     GovernancePoll (..),
@@ -246,6 +248,7 @@ module Cardano.Api.Shelley
     VoteChoice(..),
     VotingCredential(..),
     VoterType(..),
+    createProposalProcedure,
     createVotingProcedure,
     makeGoveranceActionIdentifier,
     renderGovernancePollError,
@@ -264,6 +267,7 @@ module Cardano.Api.Shelley
     fromAlonzoCostModels,
     --TODO: arrange not to export these
     toShelleyNetwork,
+    obtainEraPParamsConstraint,
 
   ) where
 
@@ -274,6 +278,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
@@ -291,4 +296,5 @@ import           Cardano.Api.StakePoolMetadata
 import           Cardano.Api.Tx
 import           Cardano.Api.TxBody
 import           Cardano.Api.TxMetadata
+import           Cardano.Api.Utils
 import           Cardano.Api.Value