From 6228361395815e6806fdcb0b809cb8badb40137c Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Cl=C3=A9ment=20Hurlin?= <clement.hurlin@moduscreate.com>
Date: Tue, 26 Mar 2024 16:21:01 +0100
Subject: [PATCH] Remove unsafeMergeVotingProcedures, add mergeVotingProcedures

---
 .../Api/Governance/Actions/VotingProcedure.hs | 44 +++++++++++++------
 cardano-api/src/Cardano/Api/Shelley.hs        |  2 +-
 2 files changed, 32 insertions(+), 14 deletions(-)

diff --git a/cardano-api/internal/Cardano/Api/Governance/Actions/VotingProcedure.hs b/cardano-api/internal/Cardano/Api/Governance/Actions/VotingProcedure.hs
index 1a772bc3b9..4d0a6387cc 100644
--- a/cardano-api/internal/Cardano/Api/Governance/Actions/VotingProcedure.hs
+++ b/cardano-api/internal/Cardano/Api/Governance/Actions/VotingProcedure.hs
@@ -30,7 +30,9 @@ import qualified Cardano.Ledger.Api as L
 import           Cardano.Ledger.Core (EraCrypto)
 import qualified Cardano.Ledger.Core as L
 
+import           Control.Monad (foldM)
 import qualified Data.Map as Map
+import qualified Data.Set as Set
 import           Data.Text (Text)
 import qualified Data.Text.Encoding as Text
 import           GHC.Generics
@@ -154,16 +156,32 @@ singletonVotingProcedures _ voter govActionId votingProcedure =
     $ Map.singleton voter
     $ Map.singleton govActionId votingProcedure
 
--- | Right biased merge of Voting procedures.
--- TODO Conway we need an alternative version of this function that can report conflicts as it is
--- not safe to just throw away votes.
-unsafeMergeVotingProcedures :: ()
-  => VotingProcedures era
-  -> VotingProcedures era
-  -> VotingProcedures era
-unsafeMergeVotingProcedures vpsa vpsb =
-  VotingProcedures
-    $ L.VotingProcedures
-    $ Map.unionWith (Map.unionWith const)
-        (L.unVotingProcedures (unVotingProcedures vpsa))
-        (L.unVotingProcedures (unVotingProcedures vpsb))
+-- | A voter, and the conflicting votes of this voter (i.e. votes with the same governance action identifier)
+newtype VotesMergingConflict era =
+  VotesMergingConflict
+    ( L.Voter (L.EraCrypto (ShelleyLedgerEra era))
+    , [L.GovActionId (L.EraCrypto (ShelleyLedgerEra era))])
+
+-- | @mergeVotingProcedures vote1 vote2@ merges @vote1@ and @vote2@ into a single vote,
+-- or fails if the votes are incompatible.
+mergeVotingProcedures :: ()
+  => VotingProcedures era -- ^ Votes to merge
+  -> VotingProcedures era -- ^ Votes to merge
+  -> Either (VotesMergingConflict era) (VotingProcedures era) -- ^ Either the conflict found, or the merged votes
+mergeVotingProcedures vpsa vpsb =
+  VotingProcedures . L.VotingProcedures <$> foldM mergeVotesOfOneVoter Map.empty allVoters
+  where
+    mapa = L.unVotingProcedures (unVotingProcedures vpsa)
+    mapb = L.unVotingProcedures (unVotingProcedures vpsb)
+    allVoters = Set.union (Map.keysSet mapa) (Map.keysSet mapb)
+    mergeVotesOfOneVoter acc voter =
+      Map.union acc <$> case (Map.lookup voter mapa, Map.lookup voter mapb) of
+        (Just v, Nothing) -> Right $ Map.singleton voter v -- Take only available value
+        (Nothing, Just v) -> Right $ Map.singleton voter v -- Take only available value
+        (Nothing, Nothing) -> Right Map.empty -- No value
+        (Just va, Just vb) -> -- Here's the case where we're unioning different votes for the same voter
+          if null intersection -- No conflict: sets of keys from left and right is disjoint
+          then Right $ Map.singleton voter (Map.union va vb)
+          else Left $ VotesMergingConflict (voter, intersection) -- Ooops, a conflict! Let's report it!
+          where
+            intersection = Map.keys $ Map.intersection va vb
diff --git a/cardano-api/src/Cardano/Api/Shelley.hs b/cardano-api/src/Cardano/Api/Shelley.hs
index dccf1d10a6..be2fa7d6fe 100644
--- a/cardano-api/src/Cardano/Api/Shelley.hs
+++ b/cardano-api/src/Cardano/Api/Shelley.hs
@@ -284,8 +284,8 @@ module Cardano.Api.Shelley
     fromLedgerPParamsUpdate,
 
     emptyVotingProcedures,
+    mergeVotingProcedures,
     singletonVotingProcedures,
-    unsafeMergeVotingProcedures,
   ) where
 
 import           Cardano.Api