WIP: Update cardano-api to handle script witnesses for proposing and …

…voting

Plutus scripts

cardano-api/gen/Test/Gen/Cardano/Api/Typed.hs

@@ -1095,11 +1095,12 @@ genTxProposalsOSet w =
   conwayEraOnwardsConstraints w
     $ OSet.fromFoldable <$> Gen.list (Range.constant 1 10) (genProposal w)
 
-genProposal :: ConwayEraOnwards era -> Gen (Proposal era)
+genProposal :: ConwayEraOnwards era -> Gen (L.ProposalProcedure (ShelleyLedgerEra era))
 genProposal w =
-  conwayEraOnwardsTestConstraints w $ fmap Proposal Q.arbitrary
+  conwayEraOnwardsTestConstraints w Q.arbitrary
 
-genVotingProcedures :: ConwayEraOnwards era -> Gen (ShelleyApi.VotingProcedures era)
+-- TODO: Generate map of script witnesses
+genVotingProcedures :: ConwayEraOnwards era -> Gen (Api.TxVotingProcedures BuildTx era)
 genVotingProcedures w =
   conwayEraOnwardsConstraints w
     $ Api.TxVotingProcedures <$> Q.arbitrary <*> return (BuildTxWith mempty)

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

@@ -47,12 +47,12 @@ data AnyGovernanceAction = forall era. AnyGovernanceAction (Gov.GovAction era)
 -- TODO: Conway - Transitiion to Ledger.GovAction
 data GovernanceAction era
   = MotionOfNoConfidence
-      (StrictMaybe (Ledger.PrevGovActionId Ledger.CommitteePurpose StandardCrypto))
+      (StrictMaybe (Ledger.GovPurposeId Ledger.CommitteePurpose (ShelleyLedgerEra era)))
   | ProposeNewConstitution
-      (StrictMaybe (Ledger.PrevGovActionId Ledger.ConstitutionPurpose StandardCrypto))
+      (StrictMaybe (Ledger.GovPurposeId Ledger.ConstitutionPurpose (ShelleyLedgerEra era)))
       (Ledger.Anchor StandardCrypto)
   | ProposeNewCommittee
-      (StrictMaybe (Ledger.PrevGovActionId Ledger.CommitteePurpose StandardCrypto))
+      (StrictMaybe (Ledger.GovPurposeId Ledger.CommitteePurpose (ShelleyLedgerEra era)))
       [Hash CommitteeColdKey] -- ^ Old constitutional committee
       (Map (Hash CommitteeColdKey) EpochNo) -- ^ New committee members with epoch number when each of them expires
       Rational -- ^ Quorum of the committee that is necessary for a successful vote
@@ -61,10 +61,10 @@ data GovernanceAction era
       [(Network, StakeCredential, Lovelace)]
       !(StrictMaybe (Shelley.ScriptHash StandardCrypto)) -- ^ Governance policy
   | InitiateHardfork
-      (StrictMaybe (Ledger.PrevGovActionId Ledger.HardForkPurpose StandardCrypto))
+      (StrictMaybe (Ledger.GovPurposeId Ledger.HardForkPurpose (ShelleyLedgerEra era)))
       ProtVer
   | UpdatePParams
-      (StrictMaybe (Ledger.PrevGovActionId Ledger.PParamUpdatePurpose StandardCrypto))
+      (StrictMaybe (Ledger.GovPurposeId Ledger.PParamUpdatePurpose (ShelleyLedgerEra era)))
       (Ledger.PParamsUpdate (ShelleyLedgerEra era))
       !(StrictMaybe (Shelley.ScriptHash StandardCrypto)) -- ^ Governance policy
 
@@ -189,11 +189,12 @@ fromProposalProcedure sbe (Proposal pp) =
 
 
 createPreviousGovernanceActionId
-  :: TxId
+  :: EraCrypto (ShelleyLedgerEra era) ~ StandardCrypto
+  => TxId
   -> Word32 -- ^ Governance action transation index
-  -> Ledger.PrevGovActionId  (r :: Ledger.GovActionPurpose) StandardCrypto
+  -> Ledger.GovPurposeId (r :: Ledger.GovActionPurpose) (ShelleyLedgerEra era)
 createPreviousGovernanceActionId  txid index =
-   Ledger.PrevGovActionId $ createGovernanceActionId txid index
+   Ledger.GovPurposeId $ createGovernanceActionId txid index
 
 
 createGovernanceActionId :: TxId -> Word32 -> Gov.GovActionId StandardCrypto

cardano-api/internal/Cardano/Api/Tx/Body.hs

@@ -112,6 +112,8 @@ module Cardano.Api.Tx.Body (
     TxCertificates(..),
     TxUpdateProposal(..),
     TxMintValue(..),
+    TxVotingProcedures(..),
+    TxProposalProcedures(..),
 
     -- ** Building vs viewing transactions
     BuildTxWith(..),
@@ -173,9 +175,8 @@ import           Cardano.Api.Eon.ShelleyToAllegraEra
 import           Cardano.Api.Eon.ShelleyToBabbageEra
 import           Cardano.Api.Eras.Case
 import           Cardano.Api.Eras.Core
-import           Cardano.Api.Error
+import           Cardano.Api.Error (Error (..), displayError)
 import           Cardano.Api.Feature
-import           Cardano.Api.Governance.Actions.ProposalProcedure
 import           Cardano.Api.Hash
 import           Cardano.Api.Keys.Byron
 import           Cardano.Api.Keys.Shelley
@@ -258,7 +259,6 @@ import           Data.Text (Text)
 import qualified Data.Text as Text
 import           Data.Type.Equality (TestEquality (..), (:~:) (Refl))
 import           Data.Word (Word16, Word32, Word64)
-import           GHC.TypeLits
 import           Lens.Micro hiding (ix)
 import           Lens.Micro.Extras (view)
 import qualified Text.Parsec as Parsec
@@ -1174,13 +1174,13 @@ deriving instance Show (TxVotingProcedures build era)
 
 
 -- ----------------------------------------------------------------------------
--- Votes within transactions (era-dependent)
+-- Proposals within transactions (era-dependent)
 --
 
 data TxProposalProcedures build era where
   TxProposalProceduresNone :: TxProposalProcedures build era
   TxProposalProcedures
-    :: Ledger.Era (ShelleyLedgerEra era)
+    :: Ledger.EraPParams (ShelleyLedgerEra era)
     => OSet (L.ProposalProcedure (ShelleyLedgerEra era))
     -> BuildTxWith build (Map (L.ProposalProcedure (ShelleyLedgerEra era)) (ScriptWitness WitCtxStake era))
     -> TxProposalProcedures build era
@@ -1677,14 +1677,14 @@ fromLedgerTxBody sbe scriptValidity body scriptdata mAux =
 fromLedgerProposalProcedures
   :: ShelleyBasedEra era
   -> Ledger.TxBody (ShelleyLedgerEra era)
-  -> Maybe (Featured ConwayEraOnwards era [Proposal era])
+  -> Maybe (Featured ConwayEraOnwards era (TxProposalProcedures ViewTx era))
 fromLedgerProposalProcedures sbe body =
   forShelleyBasedEraInEonMaybe sbe $ \w ->
     conwayEraOnwardsConstraints w
       $ Featured w
-      $ fmap Proposal
-      $ toList
-      $ body ^. L.proposalProceduresTxBodyL
+      $ TxProposalProcedures
+         (body ^. L.proposalProceduresTxBodyL)
+         ViewTx
 
 fromLedgerVotingProcedures :: ()
   => ShelleyBasedEra era
@@ -2217,6 +2217,10 @@ convReferenceInputs txInsReference =
     TxInsReferenceNone -> mempty
     TxInsReference _ refTxins -> Set.fromList $ map toShelleyTxIn refTxins
 
+convProposalProcedures :: TxProposalProcedures build era -> OSet (L.ProposalProcedure (ShelleyLedgerEra era))
+convProposalProcedures TxProposalProceduresNone = OSet.empty
+convProposalProcedures (TxProposalProcedures procedures _) = procedures
+
 convVotingProcedures :: TxVotingProcedures build era -> L.VotingProcedures (ShelleyLedgerEra era)
 convVotingProcedures txVotingProcedures =
   case txVotingProcedures of
@@ -2627,7 +2631,7 @@ makeShelleyTransactionBody sbe@ShelleyBasedEraConway
             & A.mintTxBodyL mOn                 .~ convMintValue txMintValue
             & A.scriptIntegrityHashTxBodyL azOn .~ scriptIntegrityHash
             & A.votingProceduresTxBodyL cOn     .~ convVotingProcedures (maybe TxVotingProceduresNone unFeatured txVotingProcedures)
-            & A.proposalProceduresTxBodyL cOn   .~ OSet.fromSet (Set.fromList (fmap unProposal (maybe [] unFeatured txProposalProcedures)))
+            & A.proposalProceduresTxBodyL cOn   .~ convProposalProcedures (maybe TxProposalProceduresNone unFeatured txProposalProcedures)
             -- TODO Conway: support optional network id in TxBodyContent
             -- & L.networkIdTxBodyL .~ SNothing
           ) ^. A.txBodyL
@@ -2894,14 +2898,16 @@ collectTxBodyScriptWitnesses _ TxBodyContent {
                                txWithdrawals,
                                txCertificates,
                                txMintValue,
-                               txVotingProcedures
+                               txVotingProcedures,
+                               txProposalProcedures
                              } =
     concat
       [ scriptWitnessesTxIns        txIns
       , scriptWitnessesWithdrawals  txWithdrawals
       , scriptWitnessesCertificates txCertificates
       , scriptWitnessesMinting      txMintValue
       , scriptWitnessesVoting       (maybe TxVotingProceduresNone unFeatured txVotingProcedures)
+      , scriptWitnessesProposing    (maybe TxProposalProceduresNone unFeatured txProposalProcedures)
       ]
   where
     scriptWitnessesTxIns
@@ -2961,6 +2967,20 @@ collectTxBodyScriptWitnesses _ TxBodyContent {
       , witness <- maybeToList (Map.lookup voter witnesses)
       ]
 
+    scriptWitnessesProposing
+      :: TxProposalProcedures BuildTx era
+      -> [(ScriptWitnessIndex, AnyScriptWitness era)]
+    scriptWitnessesProposing TxProposalProceduresNone = []
+    scriptWitnessesProposing (TxProposalProcedures proposalProcedures (BuildTxWith mScriptWitnesses))
+      | Map.null mScriptWitnesses = []
+      | otherwise =
+        [ (ScriptWitnessIndexProposing ix, AnyScriptWitness witness)
+        | let proposalsList = Set.toList $ OSet.toSet proposalProcedures
+        , (ix, proposal) <- zip [0..] proposalsList
+        , witness <- maybeToList (Map.lookup proposal mScriptWitnesses)
+        ]
+
+
 
 -- This relies on the TxId Ord instance being consistent with the
 -- Ledger.TxId Ord instance via the toShelleyTxId conversion

cardano-api/src/Cardano/Api.hs

@@ -373,6 +373,8 @@ module Cardano.Api (
     TxCertificates(..),
     TxUpdateProposal(..),
     TxMintValue(..),
+    TxVotingProcedures(..),
+    TxProposalProcedures(..),
 
     -- ** Building vs viewing transactions
     BuildTxWith(..),