Initial work

IntersectMBO · Jan 14, 2025 · 6eac8f2 · 6eac8f2
1 parent c5cb6b2
commit 6eac8f2
Showing 1 changed file with 7 additions and 4 deletions.
diff --git a/cardano-api/internal/Cardano/Api/Tx/Body.hs b/cardano-api/internal/Cardano/Api/Tx/Body.hs
@@ -146,7 +146,6 @@ module Cardano.Api.Tx.Body
   , TxProposalProcedures (..)
   , mkTxProposalProcedures
   , indexTxProposalProcedures
-  , convProposalProcedures
 
     -- ** Building vs viewing transactions
   , BuildTxWith (..)
@@ -1445,7 +1444,7 @@ data TxProposalProcedures build era where
   TxProposalProceduresNone :: TxProposalProcedures build era
   -- | Create Tx proposal procedures. Prefer 'mkTxProposalProcedures' smart constructor to using this constructor
   -- directly.
-  TxProposalProcedures
+  UnsafeTxProposalProcedures
     :: Ledger.EraPParams (ShelleyLedgerEra era)
     => OSet (L.ProposalProcedure (ShelleyLedgerEra era))
     -- ^ a set of proposals
@@ -1458,6 +1457,10 @@ deriving instance Eq (TxProposalProcedures build era)
 
 deriving instance Show (TxProposalProcedures build era)
 
+pattern TxProposalProcedures
+  :: OSet (L.ProposalProcedure (ShelleyLedgerEra era)) -> TxProposalProcedures build era
+pattern TxProposalProcedures oset <- (convProposalProcedures -> oset)
+
 -- | A smart constructor for 'TxProposalProcedures'. It makes sure that the value produced is consistent - the
 -- witnessed proposals are also present in the first constructor parameter.
 mkTxProposalProcedures
@@ -1471,7 +1474,7 @@ mkTxProposalProcedures proposalsWithWitnessesList = do
         bimap toList toList $
           Foldable.foldl' partitionProposals mempty proposalsWithWitnessesList
   shelleyBasedEraConstraints (shelleyBasedEra @era) $
-    TxProposalProcedures (fromList proposals) (pure $ fromList proposalsWithWitnesses)
+    UnsafeTxProposalProcedures (fromList proposals) (pure $ fromList proposalsWithWitnesses)
  where
   partitionProposals (ps, pws) (p, Nothing) =
     (DList.snoc ps p, pws) -- add a proposal to the list
@@ -2797,7 +2800,7 @@ convReferenceInputs txInsReference =
 convProposalProcedures
   :: TxProposalProcedures build era -> OSet (L.ProposalProcedure (ShelleyLedgerEra era))
 convProposalProcedures TxProposalProceduresNone = OSet.empty
-convProposalProcedures (TxProposalProcedures pp bWits) = do
+convProposalProcedures (UnsafeTxProposalProcedures pp bWits) = do
   let wits = fromMaybe mempty $ buildTxWithToMaybe bWits
   pp |>< fromList (Map.keys wits)