Merge pull request #595 from IntersectMBO/jordan/allow-multiple-witne…

…ssses Modify TxCertificates allow multiple script witnesses for a single stake credential
IntersectMBO · Jul 26, 2024 · aee2131 · aee2131
2 parents 65cbae3 + ed927b3
commit aee2131
Show file tree

Hide file tree

Showing 2 changed files with 6 additions and 5 deletions.
diff --git a/cardano-api/internal/Cardano/Api/Fees.hs b/cardano-api/internal/Cardano/Api/Fees.hs
@@ -477,7 +477,7 @@ estimateTransactionKeyWitnessCount
           _ -> 0
         + case txCertificates of
           TxCertificates _ _ (BuildTxWith witnesses) ->
-            length [() | KeyWitness{} <- Map.elems witnesses]
+            length [() | (_, KeyWitness{}) <- witnesses]
           _ -> 0
         + case txUpdateProposal of
           TxUpdateProposal _ (UpdateProposal updatePerGenesisKey _) ->
@@ -1517,10 +1517,10 @@ substituteExecutionUnits
               (ix, cert) <- zip [0 ..] certs
               , stakecred <- maybeToList (selectStakeCredentialWitness cert)
               , ScriptWitness ctx witness <-
-                  maybeToList (Map.lookup stakecred witnesses)
+                  maybeToList (List.lookup stakecred witnesses)
               , let witness' = substituteExecUnits (ScriptWitnessIndexCertificate ix) witness
               ]
-         in TxCertificates supported certs . BuildTxWith . Map.fromList
+         in TxCertificates supported certs . BuildTxWith
               <$> traverse
                 ( \(sCred, eScriptWitness) ->
                     case eScriptWitness of

diff --git a/cardano-api/internal/Cardano/Api/Tx/Body.hs b/cardano-api/internal/Cardano/Api/Tx/Body.hs
@@ -1156,7 +1156,8 @@ data TxCertificates build era where
   TxCertificates
     :: ShelleyBasedEra era
     -> [Certificate era]
-    -> BuildTxWith build (Map StakeCredential (Witness WitCtxStake era))
+    -> BuildTxWith build [(StakeCredential, Witness WitCtxStake era)]
+    -- ^ There can be more than one script witness per stake credential
     -> TxCertificates build era
 
 deriving instance Eq (TxCertificates build era)
@@ -3157,7 +3158,7 @@ collectTxBodyScriptWitnesses
       (ix, cert) <- zip [0 ..] certs
       , ScriptWitness _ witness <- maybeToList $ do
           stakecred <- selectStakeCredentialWitness cert
-          Map.lookup stakecred witnesses
+          List.lookup stakecred witnesses
       ]
 
     scriptWitnessesMinting