Tighten era bounds to ConwaryEraOnwards

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

@@ -1,3 +1,4 @@
+{-# LANGUAGE ConstraintKinds #-}
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE GADTs #-}

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

@@ -1,3 +1,4 @@
+{-# LANGUAGE ConstraintKinds #-}
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE KindSignatures #-}
 {-# LANGUAGE ScopedTypeVariables #-}

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

@@ -2,23 +2,36 @@
 {-# LANGUAGE ExistentialQuantification #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE GADTs #-}
+{-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE StandaloneDeriving #-}
 {-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE TypeOperators #-}
 {-# LANGUAGE UndecidableInstances #-}
 
-module Cardano.Api.Governance.Actions.ProposalProcedure where
+module Cardano.Api.Governance.Actions.ProposalProcedure
+  ( TxGovernanceActions(..)
+  , TxGovernanceActionSupportedInEra(..)
+  , governanceActionsSupportedInEra
+  , AnyGovernanceAction(..)
+  , GovernanceAction(..)
+  , toSafeHash
+  , toGovernanceAction
+  , fromGovernanceAction
+  , Proposal(..)
+  , createProposalProcedure
+  , fromProposalProcedure
+  ) where
 
 import           Cardano.Api.Address
 import           Cardano.Api.Eras
+import           Cardano.Api.Feature.ConwayEraOnwards
 import           Cardano.Api.HasTypeProxy
 import           Cardano.Api.Keys.Shelley
 import           Cardano.Api.ProtocolParameters
 import           Cardano.Api.SerialiseCBOR
 import           Cardano.Api.SerialiseTextEnvelope
-import           Cardano.Api.Utils
 import           Cardano.Api.Value
 
 import qualified Cardano.Binary as CBOR
@@ -92,47 +105,54 @@ toSafeHash = makeHashWithExplicitProxys (Proxy :: Proxy  StandardCrypto) (Proxy
 toGovernanceAction
   :: EraCrypto ledgerera ~ StandardCrypto
   => ShelleyLedgerEra era ~ ledgerera
-  => ShelleyBasedEra era
+  => ConwayEraOnwards era
   -> GovernanceAction
   -> Gov.GovernanceAction ledgerera
-toGovernanceAction _ MotionOfNoConfidence = Gov.NoConfidence
-toGovernanceAction _ (ProposeNewConstitution bs) =
-  Gov.NewConstitution $ toSafeHash bs
-toGovernanceAction _ (ProposeNewCommittee stakeKeys quor) =
-  Gov.NewCommittee (Set.fromList $ map (\(StakeKeyHash sk) -> coerceKeyRole sk) stakeKeys) quor
-toGovernanceAction _ InfoAct = Gov.InfoAction
-toGovernanceAction _ (TreasuryWithdrawal withdrawals) =
-  let m = Map.fromList [(toShelleyStakeCredential sc, toShelleyLovelace l) | (sc,l) <- withdrawals]
-  in Gov.TreasuryWithdrawals m
-toGovernanceAction _ (InitiateHardfork pVer) = Gov.HardForkInitiation pVer
-toGovernanceAction sbe (UpdatePParams ppup) =
-  case toLedgerPParamsUpdate sbe ppup of
-    Left e -> error $ "toGovernanceAction: " <> show e
-    -- TODO: Conway era - remove use of error. Ideally we will use the ledger's PParams type
-    -- in place of ProtocolParametersUpdate
-    Right ppup' -> Gov.ParameterChange ppup'
+toGovernanceAction w = \case
+  MotionOfNoConfidence ->
+    Gov.NoConfidence
+  ProposeNewConstitution bs ->
+    Gov.NewConstitution $ toSafeHash bs
+  ProposeNewCommittee stakeKeys quor ->
+    Gov.NewCommittee (Set.fromList $ map (\(StakeKeyHash sk) -> coerceKeyRole sk) stakeKeys) quor
+  InfoAct ->
+    Gov.InfoAction
+  TreasuryWithdrawal withdrawals ->
+    let m = Map.fromList [(toShelleyStakeCredential sc, toShelleyLovelace l) | (sc,l) <- withdrawals]
+    in Gov.TreasuryWithdrawals m
+  InitiateHardfork pVer ->
+    Gov.HardForkInitiation pVer
+  UpdatePParams ppup ->
+    case toLedgerPParamsUpdate (conwayEraOnwardsToShelleyBasedEra w) ppup of
+      Left e -> error $ "toGovernanceAction: " <> show e
+      -- TODO: Conway era - remove use of error. Ideally we will use the ledger's PParams type
+      -- in place of ProtocolParametersUpdate
+      Right ppup' -> Gov.ParameterChange ppup'
 
 fromGovernanceAction
   :: EraCrypto (ShelleyLedgerEra era) ~ StandardCrypto
-  => ShelleyBasedEra era
+  => ConwayEraOnwards era
   -> Gov.GovernanceAction (ShelleyLedgerEra era)
   -> GovernanceAction
-fromGovernanceAction _ Gov.NoConfidence = MotionOfNoConfidence
-fromGovernanceAction sbe (Gov.NewConstitution h) =
-  ProposeNewConstitution $ obtainSafeToHashConstraint sbe $ originalBytes h
-fromGovernanceAction sbe (Gov.ParameterChange pparams) =
-  UpdatePParams $ fromLedgerPParamsUpdate sbe pparams
-fromGovernanceAction _ (Gov.HardForkInitiation pVer) =
-  InitiateHardfork pVer
-fromGovernanceAction _ (Gov.TreasuryWithdrawals withdrawlMap) =
-  let res = [ (fromShelleyStakeCredential lScred , fromShelleyLovelace coin)
-            | (lScred, coin) <- Map.toList withdrawlMap
-            ]
-  in TreasuryWithdrawal res
-fromGovernanceAction _ (Gov.NewCommittee proposedMembers quor) =
-  let stakeCred = map (StakeKeyHash . coerceKeyRole) $ Set.toList proposedMembers
-  in ProposeNewCommittee stakeCred quor
-fromGovernanceAction _ Gov.InfoAction = InfoAct
+fromGovernanceAction w = \case
+  Gov.NoConfidence ->
+    MotionOfNoConfidence
+  Gov.NewConstitution h ->
+    conwayEraOnwardsConstraints w $ ProposeNewConstitution $ originalBytes h
+  Gov.ParameterChange pparams ->
+    UpdatePParams $ fromLedgerPParamsUpdate (conwayEraOnwardsToShelleyBasedEra w) pparams
+  Gov.HardForkInitiation pVer ->
+    InitiateHardfork pVer
+  Gov.TreasuryWithdrawals withdrawlMap ->
+    let res = [ (fromShelleyStakeCredential lScred , fromShelleyLovelace coin)
+              | (lScred, coin) <- Map.toList withdrawlMap
+              ]
+    in TreasuryWithdrawal res
+  Gov.NewCommittee proposedMembers quor ->
+    let stakeCred = map (StakeKeyHash . coerceKeyRole) $ Set.toList proposedMembers
+    in ProposeNewCommittee stakeCred quor
+  Gov.InfoAction ->
+    InfoAct
 
 newtype Proposal era = Proposal { unProposal :: Gov.ProposalProcedure (ShelleyLedgerEra era) }
 
@@ -163,26 +183,26 @@ instance HasTypeProxy era => HasTypeProxy (Proposal era) where
 
 
 createProposalProcedure
-  :: ShelleyBasedEra era
+  :: ConwayEraOnwards era
   -> Lovelace -- ^ Deposit
   -> Hash StakeKey -- ^ Return address
   -> GovernanceAction
   -> Proposal era
-createProposalProcedure sbe dep (StakeKeyHash retAddrh) govAct =
-  Proposal $ obtainEraCryptoConstraints sbe $
+createProposalProcedure w dep (StakeKeyHash retAddrh) govAct =
+  Proposal $ conwayEraOnwardsConstraints w $
     Gov.ProposalProcedure
       { Gov.pProcDeposit = toShelleyLovelace dep
       , Gov.pProcReturnAddr = retAddrh
-      , Gov.pProcGovernanceAction = toGovernanceAction sbe govAct
+      , Gov.pProcGovernanceAction = toGovernanceAction w govAct
       , Gov.pProcAnchor = SNothing -- TODO: Conway
       }
 
 fromProposalProcedure
-  :: ShelleyBasedEra era
+  :: ConwayEraOnwards era
   -> Proposal era
   -> (Lovelace, Hash StakeKey, GovernanceAction)
-fromProposalProcedure sbe (Proposal pp) =
+fromProposalProcedure w (Proposal pp) =
   ( fromShelleyLovelace $ Gov.pProcDeposit pp
-  , StakeKeyHash (obtainEraCryptoConstraints sbe (Gov.pProcReturnAddr pp))
-  , obtainEraCryptoConstraints sbe $ fromGovernanceAction sbe (Gov.pProcGovernanceAction pp)
+  , StakeKeyHash (conwayEraOnwardsConstraints w (Gov.pProcReturnAddr pp))
+  , conwayEraOnwardsConstraints w $ fromGovernanceAction w (Gov.pProcGovernanceAction pp)
   )

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

@@ -12,18 +12,33 @@
 {-# LANGUAGE TypeOperators #-}
 {-# LANGUAGE UndecidableInstances #-}
 
-module Cardano.Api.Governance.Actions.VotingProcedure where
+module Cardano.Api.Governance.Actions.VotingProcedure
+  ( TxVotes(..)
+  , TxVotesSupportedInEra(..)
+  , votesSupportedInEra
+  , GovernanceActionId(..)
+  , makeGoveranceActionId
+  , Voter(..)
+  , Vote(..)
+  , toVoterRole
+  , toVote
+  , toVotingCredential
+  , eraDecodeVotingCredential
+  , VotingCredential(..)
+  , createVotingProcedure
+  , VotingProcedure(..)
+  ) where
 
 import           Cardano.Api.Address
 import           Cardano.Api.Eras
+import           Cardano.Api.Feature.ConwayEraOnwards
 import           Cardano.Api.HasTypeProxy
 import           Cardano.Api.Keys.Shelley
 import           Cardano.Api.Script
 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
@@ -69,26 +84,26 @@ deriving instance Eq (TxVotesSupportedInEra era)
 
 
 votesSupportedInEra :: ShelleyBasedEra  era -> Maybe (TxVotesSupportedInEra era)
-votesSupportedInEra ShelleyBasedEraShelley = Nothing
-votesSupportedInEra ShelleyBasedEraAllegra = Nothing
-votesSupportedInEra ShelleyBasedEraMary    = Nothing
-votesSupportedInEra ShelleyBasedEraAlonzo  = Nothing
-votesSupportedInEra ShelleyBasedEraBabbage = Nothing
-votesSupportedInEra ShelleyBasedEraConway  = Just VotesSupportedInConwayEra
-
+votesSupportedInEra = \case
+  ShelleyBasedEraShelley -> Nothing
+  ShelleyBasedEraAllegra -> Nothing
+  ShelleyBasedEraMary    -> Nothing
+  ShelleyBasedEraAlonzo  -> Nothing
+  ShelleyBasedEraBabbage -> Nothing
+  ShelleyBasedEraConway  -> Just VotesSupportedInConwayEra
 
 newtype GovernanceActionId ledgerera = GovernanceActionId
   { unGovernanceActionId :: Ledger.GovernanceActionId (EraCrypto ledgerera)
   }
   deriving (Show, Eq)
 
 makeGoveranceActionId
-  :: ShelleyBasedEra era
+  :: ConwayEraOnwards era
   -> TxIn
   -> GovernanceActionId (ShelleyLedgerEra era)
-makeGoveranceActionId sbe txin =
+makeGoveranceActionId w txin =
   let Ledger.TxIn txid (Ledger.TxIx txix) = toShelleyTxIn txin
-  in obtainEraCryptoConstraints sbe
+  in conwayEraOnwardsConstraints w
       $ GovernanceActionId
       $ Ledger.GovernanceActionId
           { Ledger.gaidTxId = txid
@@ -113,7 +128,7 @@ data Vote
 
 toVoterRole
   :: EraCrypto (ShelleyLedgerEra era) ~ StandardCrypto
-  => ShelleyBasedEra era
+  => ConwayEraOnwards era
   -> Voter era
   -> Ledger.Voter (Shelley.EraCrypto (ShelleyLedgerEra era))
 toVoterRole _ = \case
@@ -131,7 +146,7 @@ toVote = \case
   Abstain -> Ledger.Abstain
 
 toVotingCredential
-  :: ShelleyBasedEra era
+  :: ConwayEraOnwards era
   -> StakeCredential
   -> Either Plain.DecoderError (VotingCredential era)
 toVotingCredential sbe (StakeCredentialByKey (StakeKeyHash kh)) = do
@@ -148,11 +163,11 @@ toVotingCredential _sbe (StakeCredentialByScript (ScriptHash _sh)) =
 -- This is a hack. data StakeCredential in cardano-api is not parameterized by era, it defaults to StandardCrypto.
 -- However VotingProcedure is parameterized on era. We need to also parameterize StakeCredential on era.
 eraDecodeVotingCredential
-  :: ShelleyBasedEra era
+  :: ConwayEraOnwards era
   -> ByteString
   -> Either Plain.DecoderError (VotingCredential era)
-eraDecodeVotingCredential sbe bs =
-  obtainCryptoConstraints sbe $
+eraDecodeVotingCredential w bs =
+  conwayEraOnwardsConstraints w $
     case Plain.decodeFull bs of
       Left e -> Left e
       Right x -> Right $ VotingCredential x
@@ -165,16 +180,16 @@ deriving instance Show (VotingCredential crypto)
 deriving instance Eq (VotingCredential crypto)
 
 createVotingProcedure
-  :: ShelleyBasedEra era
+  :: ConwayEraOnwards era
   -> Vote
   -> Voter era
   -> GovernanceActionId (ShelleyLedgerEra era)
   -> VotingProcedure era
-createVotingProcedure sbe vChoice vt (GovernanceActionId govActId) =
-  obtainEraCryptoConstraints sbe
+createVotingProcedure w vChoice vt (GovernanceActionId govActId) =
+  conwayEraOnwardsConstraints w
     $ VotingProcedure $ Ledger.VotingProcedure
       { Ledger.vProcGovActionId = govActId
-      , Ledger.vProcVoter = toVoterRole sbe vt
+      , Ledger.vProcVoter = toVoterRole w vt
       , Ledger.vProcVote = toVote vChoice
       , Ledger.vProcAnchor = SNothing -- TODO: Conway
       }