{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE QuantifiedConstraints #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}

module Cardano.Api.Internal.Governance.Actions.VotingProcedure where

import Cardano.Api.Internal.Address
import Cardano.Api.Internal.Eon.ConwayEraOnwards
import Cardano.Api.Internal.Eon.ShelleyBasedEra
import Cardano.Api.Internal.Governance.Actions.ProposalProcedure
import Cardano.Api.Internal.HasTypeProxy
import Cardano.Api.Internal.ReexposeLedger qualified as Ledger
import Cardano.Api.Internal.Serialise.Cbor
import Cardano.Api.Internal.SerialiseTextEnvelope

import Cardano.Binary qualified as CBOR
import Cardano.Ledger.Api qualified as L
import Cardano.Ledger.Core qualified as L

import Control.Monad (foldM)
import Data.Map qualified as Map
import Data.Set qualified as Set
import Data.Text (Text)
import Data.Text.Encoding qualified as Text
import GHC.Generics

data Vote
  = No
  | Yes
  | Abstain
  deriving (Int -> Vote -> ShowS
[Vote] -> ShowS
Vote -> String
(Int -> Vote -> ShowS)
-> (Vote -> String) -> ([Vote] -> ShowS) -> Show Vote
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Vote -> ShowS
showsPrec :: Int -> Vote -> ShowS
$cshow :: Vote -> String
show :: Vote -> String
$cshowList :: [Vote] -> ShowS
showList :: [Vote] -> ShowS
Show, Vote -> Vote -> Bool
(Vote -> Vote -> Bool) -> (Vote -> Vote -> Bool) -> Eq Vote
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Vote -> Vote -> Bool
== :: Vote -> Vote -> Bool
$c/= :: Vote -> Vote -> Bool
/= :: Vote -> Vote -> Bool
Eq)

toVote :: Vote -> Ledger.Vote
toVote :: Vote -> Vote
toVote = \case
  Vote
No -> Vote
Ledger.VoteNo
  Vote
Yes -> Vote
Ledger.VoteYes
  Vote
Abstain -> Vote
Ledger.Abstain

createVotingProcedure
  :: ()
  => ConwayEraOnwards era
  -> Vote
  -> Maybe (Ledger.Url, Text)
  -- ^ Anchor
  -> VotingProcedure era
createVotingProcedure :: forall era.
ConwayEraOnwards era
-> Vote -> Maybe (Url, Text) -> VotingProcedure era
createVotingProcedure ConwayEraOnwards era
eon Vote
vChoice Maybe (Url, Text)
mProposalAnchor =
  let proposalAnchor :: Maybe (Url, ByteString)
proposalAnchor = (Text -> ByteString) -> (Url, Text) -> (Url, ByteString)
forall a b. (a -> b) -> (Url, a) -> (Url, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> ByteString
Text.encodeUtf8 ((Url, Text) -> (Url, ByteString))
-> Maybe (Url, Text) -> Maybe (Url, ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Url, Text)
mProposalAnchor
   in ConwayEraOnwards era
-> (ConwayEraOnwardsConstraints era => VotingProcedure era)
-> VotingProcedure era
forall era a.
ConwayEraOnwards era -> (ConwayEraOnwardsConstraints era => a) -> a
conwayEraOnwardsConstraints ConwayEraOnwards era
eon ((ConwayEraOnwardsConstraints era => VotingProcedure era)
 -> VotingProcedure era)
-> (ConwayEraOnwardsConstraints era => VotingProcedure era)
-> VotingProcedure era
forall a b. (a -> b) -> a -> b
$
        VotingProcedure (ShelleyLedgerEra era) -> VotingProcedure era
forall era.
VotingProcedure (ShelleyLedgerEra era) -> VotingProcedure era
VotingProcedure (VotingProcedure (ShelleyLedgerEra era) -> VotingProcedure era)
-> VotingProcedure (ShelleyLedgerEra era) -> VotingProcedure era
forall a b. (a -> b) -> a -> b
$
          Ledger.VotingProcedure
            { vProcVote :: Vote
Ledger.vProcVote = Vote -> Vote
toVote Vote
vChoice
            , vProcAnchor :: StrictMaybe Anchor
Ledger.vProcAnchor = Maybe Anchor -> StrictMaybe Anchor
forall a. Maybe a -> StrictMaybe a
Ledger.maybeToStrictMaybe (Maybe Anchor -> StrictMaybe Anchor)
-> Maybe Anchor -> StrictMaybe Anchor
forall a b. (a -> b) -> a -> b
$ (Url -> ByteString -> Anchor) -> (Url, ByteString) -> Anchor
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Url -> ByteString -> Anchor
createAnchor ((Url, ByteString) -> Anchor)
-> Maybe (Url, ByteString) -> Maybe Anchor
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Url, ByteString)
proposalAnchor
            }

newtype VotingProcedure era = VotingProcedure
  { forall era.
VotingProcedure era -> VotingProcedure (ShelleyLedgerEra era)
unVotingProcedure :: Ledger.VotingProcedure (ShelleyLedgerEra era)
  }
  deriving (Int -> VotingProcedure era -> ShowS
[VotingProcedure era] -> ShowS
VotingProcedure era -> String
(Int -> VotingProcedure era -> ShowS)
-> (VotingProcedure era -> String)
-> ([VotingProcedure era] -> ShowS)
-> Show (VotingProcedure era)
forall era. Int -> VotingProcedure era -> ShowS
forall era. [VotingProcedure era] -> ShowS
forall era. VotingProcedure era -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall era. Int -> VotingProcedure era -> ShowS
showsPrec :: Int -> VotingProcedure era -> ShowS
$cshow :: forall era. VotingProcedure era -> String
show :: VotingProcedure era -> String
$cshowList :: forall era. [VotingProcedure era] -> ShowS
showList :: [VotingProcedure era] -> ShowS
Show, VotingProcedure era -> VotingProcedure era -> Bool
(VotingProcedure era -> VotingProcedure era -> Bool)
-> (VotingProcedure era -> VotingProcedure era -> Bool)
-> Eq (VotingProcedure era)
forall era. VotingProcedure era -> VotingProcedure era -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall era. VotingProcedure era -> VotingProcedure era -> Bool
== :: VotingProcedure era -> VotingProcedure era -> Bool
$c/= :: forall era. VotingProcedure era -> VotingProcedure era -> Bool
/= :: VotingProcedure era -> VotingProcedure era -> Bool
Eq)

instance IsShelleyBasedEra era => ToCBOR (VotingProcedure era) where
  toCBOR :: VotingProcedure era -> Encoding
toCBOR (VotingProcedure VotingProcedure (ShelleyLedgerEra era)
vp) = ShelleyBasedEra era
-> (ShelleyBasedEraConstraints era => Encoding) -> Encoding
forall era a.
ShelleyBasedEra era -> (ShelleyBasedEraConstraints era => a) -> a
shelleyBasedEraConstraints ShelleyBasedEra era
sbe ((ShelleyBasedEraConstraints era => Encoding) -> Encoding)
-> (ShelleyBasedEraConstraints era => Encoding) -> Encoding
forall a b. (a -> b) -> a -> b
$ forall era t. (Era era, EncCBOR t) => t -> Encoding
L.toEraCBOR @(ShelleyLedgerEra era) VotingProcedure (ShelleyLedgerEra era)
vp
   where
    sbe :: ShelleyBasedEra era
sbe = forall era. IsShelleyBasedEra era => ShelleyBasedEra era
shelleyBasedEra @era

instance IsShelleyBasedEra era => FromCBOR (VotingProcedure era) where
  fromCBOR :: forall s. Decoder s (VotingProcedure era)
fromCBOR =
    ShelleyBasedEra era
-> (ShelleyBasedEraConstraints era =>
    Decoder s (VotingProcedure era))
-> Decoder s (VotingProcedure era)
forall era a.
ShelleyBasedEra era -> (ShelleyBasedEraConstraints era => a) -> a
shelleyBasedEraConstraints (forall era. IsShelleyBasedEra era => ShelleyBasedEra era
shelleyBasedEra @era) ((ShelleyBasedEraConstraints era =>
  Decoder s (VotingProcedure era))
 -> Decoder s (VotingProcedure era))
-> (ShelleyBasedEraConstraints era =>
    Decoder s (VotingProcedure era))
-> Decoder s (VotingProcedure era)
forall a b. (a -> b) -> a -> b
$
      VotingProcedure (ShelleyLedgerEra era) -> VotingProcedure era
forall era.
VotingProcedure (ShelleyLedgerEra era) -> VotingProcedure era
VotingProcedure (VotingProcedure (ShelleyLedgerEra era) -> VotingProcedure era)
-> Decoder s (VotingProcedure (ShelleyLedgerEra era))
-> Decoder s (VotingProcedure era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall era t s. (Era era, DecCBOR t) => Decoder s t
L.fromEraCBOR @(ShelleyLedgerEra era)

instance IsShelleyBasedEra era => SerialiseAsCBOR (VotingProcedure era) where
  serialiseToCBOR :: VotingProcedure era -> ByteString
serialiseToCBOR = ShelleyBasedEra era
-> (ShelleyBasedEraConstraints era =>
    VotingProcedure era -> ByteString)
-> VotingProcedure era
-> ByteString
forall era a.
ShelleyBasedEra era -> (ShelleyBasedEraConstraints era => a) -> a
shelleyBasedEraConstraints (forall era. IsShelleyBasedEra era => ShelleyBasedEra era
shelleyBasedEra @era) ShelleyBasedEraConstraints era => VotingProcedure era -> ByteString
VotingProcedure era -> ByteString
forall a. ToCBOR a => a -> ByteString
CBOR.serialize'
  deserialiseFromCBOR :: AsType (VotingProcedure era)
-> ByteString -> Either DecoderError (VotingProcedure era)
deserialiseFromCBOR AsType (VotingProcedure era)
_proxy = ShelleyBasedEra era
-> (ShelleyBasedEraConstraints era =>
    ByteString -> Either DecoderError (VotingProcedure era))
-> ByteString
-> Either DecoderError (VotingProcedure era)
forall era a.
ShelleyBasedEra era -> (ShelleyBasedEraConstraints era => a) -> a
shelleyBasedEraConstraints (forall era. IsShelleyBasedEra era => ShelleyBasedEra era
shelleyBasedEra @era) ShelleyBasedEraConstraints era =>
ByteString -> Either DecoderError (VotingProcedure era)
ByteString -> Either DecoderError (VotingProcedure era)
forall a. FromCBOR a => ByteString -> Either DecoderError a
CBOR.decodeFull'

instance IsShelleyBasedEra era => HasTextEnvelope (VotingProcedure era) where
  textEnvelopeType :: AsType (VotingProcedure era) -> TextEnvelopeType
textEnvelopeType AsType (VotingProcedure era)
_ = TextEnvelopeType
"Governance vote"

instance HasTypeProxy era => HasTypeProxy (VotingProcedure era) where
  data AsType (VotingProcedure era) = AsVote
  proxyToAsType :: Proxy (VotingProcedure era) -> AsType (VotingProcedure era)
proxyToAsType Proxy (VotingProcedure era)
_ = AsType (VotingProcedure era)
forall era. AsType (VotingProcedure era)
AsVote

newtype VotingProcedures era = VotingProcedures
  { forall era.
VotingProcedures era -> VotingProcedures (ShelleyLedgerEra era)
unVotingProcedures :: L.VotingProcedures (ShelleyLedgerEra era)
  }

deriving instance Eq (VotingProcedures era)

deriving instance Generic (VotingProcedures era)

deriving instance Show (VotingProcedures era)

instance IsShelleyBasedEra era => ToCBOR (VotingProcedures era) where
  toCBOR :: VotingProcedures era -> Encoding
toCBOR = \case
    VotingProcedures VotingProcedures (ShelleyLedgerEra era)
vp ->
      ShelleyBasedEra era
-> (ShelleyBasedEraConstraints era => Encoding) -> Encoding
forall era a.
ShelleyBasedEra era -> (ShelleyBasedEraConstraints era => a) -> a
shelleyBasedEraConstraints (forall era. IsShelleyBasedEra era => ShelleyBasedEra era
shelleyBasedEra @era) ((ShelleyBasedEraConstraints era => Encoding) -> Encoding)
-> (ShelleyBasedEraConstraints era => Encoding) -> Encoding
forall a b. (a -> b) -> a -> b
$
        forall era t. (Era era, EncCBOR t) => t -> Encoding
L.toEraCBOR @(ShelleyLedgerEra era) VotingProcedures (ShelleyLedgerEra era)
vp

instance IsShelleyBasedEra era => FromCBOR (VotingProcedures era) where
  fromCBOR :: forall s. Decoder s (VotingProcedures era)
fromCBOR =
    ShelleyBasedEra era
-> (ShelleyBasedEraConstraints era =>
    Decoder s (VotingProcedures era))
-> Decoder s (VotingProcedures era)
forall era a.
ShelleyBasedEra era -> (ShelleyBasedEraConstraints era => a) -> a
shelleyBasedEraConstraints (forall era. IsShelleyBasedEra era => ShelleyBasedEra era
shelleyBasedEra @era) ((ShelleyBasedEraConstraints era =>
  Decoder s (VotingProcedures era))
 -> Decoder s (VotingProcedures era))
-> (ShelleyBasedEraConstraints era =>
    Decoder s (VotingProcedures era))
-> Decoder s (VotingProcedures era)
forall a b. (a -> b) -> a -> b
$
      VotingProcedures (ShelleyLedgerEra era) -> VotingProcedures era
forall era.
VotingProcedures (ShelleyLedgerEra era) -> VotingProcedures era
VotingProcedures (VotingProcedures (ShelleyLedgerEra era) -> VotingProcedures era)
-> Decoder s (VotingProcedures (ShelleyLedgerEra era))
-> Decoder s (VotingProcedures era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall era t s. (Era era, DecCBOR t) => Decoder s t
L.fromEraCBOR @(ShelleyLedgerEra era)

instance IsShelleyBasedEra era => SerialiseAsCBOR (VotingProcedures era) where
  serialiseToCBOR :: VotingProcedures era -> ByteString
serialiseToCBOR = ShelleyBasedEra era
-> (ShelleyBasedEraConstraints era =>
    VotingProcedures era -> ByteString)
-> VotingProcedures era
-> ByteString
forall era a.
ShelleyBasedEra era -> (ShelleyBasedEraConstraints era => a) -> a
shelleyBasedEraConstraints (forall era. IsShelleyBasedEra era => ShelleyBasedEra era
shelleyBasedEra @era) ShelleyBasedEraConstraints era =>
VotingProcedures era -> ByteString
VotingProcedures era -> ByteString
forall a. ToCBOR a => a -> ByteString
CBOR.serialize'
  deserialiseFromCBOR :: AsType (VotingProcedures era)
-> ByteString -> Either DecoderError (VotingProcedures era)
deserialiseFromCBOR AsType (VotingProcedures era)
_proxy = ShelleyBasedEra era
-> (ShelleyBasedEraConstraints era =>
    ByteString -> Either DecoderError (VotingProcedures era))
-> ByteString
-> Either DecoderError (VotingProcedures era)
forall era a.
ShelleyBasedEra era -> (ShelleyBasedEraConstraints era => a) -> a
shelleyBasedEraConstraints (forall era. IsShelleyBasedEra era => ShelleyBasedEra era
shelleyBasedEra @era) ShelleyBasedEraConstraints era =>
ByteString -> Either DecoderError (VotingProcedures era)
ByteString -> Either DecoderError (VotingProcedures era)
forall a. FromCBOR a => ByteString -> Either DecoderError a
CBOR.decodeFull'

instance IsShelleyBasedEra era => HasTextEnvelope (VotingProcedures era) where
  textEnvelopeType :: AsType (VotingProcedures era) -> TextEnvelopeType
textEnvelopeType AsType (VotingProcedures era)
_ = TextEnvelopeType
"Governance voting procedures"

instance HasTypeProxy era => HasTypeProxy (VotingProcedures era) where
  data AsType (VotingProcedures era) = AsVotingProcedures
  proxyToAsType :: Proxy (VotingProcedures era) -> AsType (VotingProcedures era)
proxyToAsType Proxy (VotingProcedures era)
_ = AsType (VotingProcedures era)
forall era. AsType (VotingProcedures era)
AsVotingProcedures

emptyVotingProcedures :: VotingProcedures era
emptyVotingProcedures :: forall era. VotingProcedures era
emptyVotingProcedures = VotingProcedures (ShelleyLedgerEra era) -> VotingProcedures era
forall era.
VotingProcedures (ShelleyLedgerEra era) -> VotingProcedures era
VotingProcedures (VotingProcedures (ShelleyLedgerEra era) -> VotingProcedures era)
-> VotingProcedures (ShelleyLedgerEra era) -> VotingProcedures era
forall a b. (a -> b) -> a -> b
$ Map
  Voter (Map GovActionId (VotingProcedure (ShelleyLedgerEra era)))
-> VotingProcedures (ShelleyLedgerEra era)
forall era.
Map Voter (Map GovActionId (VotingProcedure era))
-> VotingProcedures era
L.VotingProcedures Map
  Voter (Map GovActionId (VotingProcedure (ShelleyLedgerEra era)))
forall k a. Map k a
Map.empty

singletonVotingProcedures
  :: ()
  => ConwayEraOnwards era
  -> L.Voter
  -> L.GovActionId
  -> L.VotingProcedure (ShelleyLedgerEra era)
  -> VotingProcedures era
singletonVotingProcedures :: forall era.
ConwayEraOnwards era
-> Voter
-> GovActionId
-> VotingProcedure (ShelleyLedgerEra era)
-> VotingProcedures era
singletonVotingProcedures ConwayEraOnwards era
_ Voter
voter GovActionId
govActionId VotingProcedure (ShelleyLedgerEra era)
votingProcedure =
  VotingProcedures (ShelleyLedgerEra era) -> VotingProcedures era
forall era.
VotingProcedures (ShelleyLedgerEra era) -> VotingProcedures era
VotingProcedures (VotingProcedures (ShelleyLedgerEra era) -> VotingProcedures era)
-> VotingProcedures (ShelleyLedgerEra era) -> VotingProcedures era
forall a b. (a -> b) -> a -> b
$
    Map
  Voter (Map GovActionId (VotingProcedure (ShelleyLedgerEra era)))
-> VotingProcedures (ShelleyLedgerEra era)
forall era.
Map Voter (Map GovActionId (VotingProcedure era))
-> VotingProcedures era
L.VotingProcedures (Map
   Voter (Map GovActionId (VotingProcedure (ShelleyLedgerEra era)))
 -> VotingProcedures (ShelleyLedgerEra era))
-> Map
     Voter (Map GovActionId (VotingProcedure (ShelleyLedgerEra era)))
-> VotingProcedures (ShelleyLedgerEra era)
forall a b. (a -> b) -> a -> b
$
      Voter
-> Map GovActionId (VotingProcedure (ShelleyLedgerEra era))
-> Map
     Voter (Map GovActionId (VotingProcedure (ShelleyLedgerEra era)))
forall k a. k -> a -> Map k a
Map.singleton Voter
voter (Map GovActionId (VotingProcedure (ShelleyLedgerEra era))
 -> Map
      Voter (Map GovActionId (VotingProcedure (ShelleyLedgerEra era))))
-> Map GovActionId (VotingProcedure (ShelleyLedgerEra era))
-> Map
     Voter (Map GovActionId (VotingProcedure (ShelleyLedgerEra era)))
forall a b. (a -> b) -> a -> b
$
        GovActionId
-> VotingProcedure (ShelleyLedgerEra era)
-> Map GovActionId (VotingProcedure (ShelleyLedgerEra era))
forall k a. k -> a -> Map k a
Map.singleton GovActionId
govActionId VotingProcedure (ShelleyLedgerEra era)
votingProcedure

-- | 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.GovActionId]
      )
  deriving Int -> VotesMergingConflict era -> ShowS
[VotesMergingConflict era] -> ShowS
VotesMergingConflict era -> String
(Int -> VotesMergingConflict era -> ShowS)
-> (VotesMergingConflict era -> String)
-> ([VotesMergingConflict era] -> ShowS)
-> Show (VotesMergingConflict era)
forall era. Int -> VotesMergingConflict era -> ShowS
forall era. [VotesMergingConflict era] -> ShowS
forall era. VotesMergingConflict era -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall era. Int -> VotesMergingConflict era -> ShowS
showsPrec :: Int -> VotesMergingConflict era -> ShowS
$cshow :: forall era. VotesMergingConflict era -> String
show :: VotesMergingConflict era -> String
$cshowList :: forall era. [VotesMergingConflict era] -> ShowS
showList :: [VotesMergingConflict era] -> ShowS
Show

-- | @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 :: forall era.
VotingProcedures era
-> VotingProcedures era
-> Either (VotesMergingConflict era) (VotingProcedures era)
mergeVotingProcedures VotingProcedures era
vpsa VotingProcedures era
vpsb =
  VotingProcedures (ShelleyLedgerEra era) -> VotingProcedures era
forall era.
VotingProcedures (ShelleyLedgerEra era) -> VotingProcedures era
VotingProcedures (VotingProcedures (ShelleyLedgerEra era) -> VotingProcedures era)
-> (Map
      Voter (Map GovActionId (VotingProcedure (ShelleyLedgerEra era)))
    -> VotingProcedures (ShelleyLedgerEra era))
-> Map
     Voter (Map GovActionId (VotingProcedure (ShelleyLedgerEra era)))
-> VotingProcedures era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map
  Voter (Map GovActionId (VotingProcedure (ShelleyLedgerEra era)))
-> VotingProcedures (ShelleyLedgerEra era)
forall era.
Map Voter (Map GovActionId (VotingProcedure era))
-> VotingProcedures era
L.VotingProcedures (Map
   Voter (Map GovActionId (VotingProcedure (ShelleyLedgerEra era)))
 -> VotingProcedures era)
-> Either
     (VotesMergingConflict era)
     (Map
        Voter (Map GovActionId (VotingProcedure (ShelleyLedgerEra era))))
-> Either (VotesMergingConflict era) (VotingProcedures era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Map
   Voter (Map GovActionId (VotingProcedure (ShelleyLedgerEra era)))
 -> Voter
 -> Either
      (VotesMergingConflict era)
      (Map
         Voter (Map GovActionId (VotingProcedure (ShelleyLedgerEra era)))))
-> Map
     Voter (Map GovActionId (VotingProcedure (ShelleyLedgerEra era)))
-> Set Voter
-> Either
     (VotesMergingConflict era)
     (Map
        Voter (Map GovActionId (VotingProcedure (ShelleyLedgerEra era))))
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM Map
  Voter (Map GovActionId (VotingProcedure (ShelleyLedgerEra era)))
-> Voter
-> Either
     (VotesMergingConflict era)
     (Map
        Voter (Map GovActionId (VotingProcedure (ShelleyLedgerEra era))))
mergeVotesOfOneVoter Map
  Voter (Map GovActionId (VotingProcedure (ShelleyLedgerEra era)))
forall k a. Map k a
Map.empty Set Voter
allVoters
 where
  mapa :: Map
  Voter (Map GovActionId (VotingProcedure (ShelleyLedgerEra era)))
mapa = VotingProcedures (ShelleyLedgerEra era)
-> Map
     Voter (Map GovActionId (VotingProcedure (ShelleyLedgerEra era)))
forall era.
VotingProcedures era
-> Map Voter (Map GovActionId (VotingProcedure era))
L.unVotingProcedures (VotingProcedures era -> VotingProcedures (ShelleyLedgerEra era)
forall era.
VotingProcedures era -> VotingProcedures (ShelleyLedgerEra era)
unVotingProcedures VotingProcedures era
vpsa)
  mapb :: Map
  Voter (Map GovActionId (VotingProcedure (ShelleyLedgerEra era)))
mapb = VotingProcedures (ShelleyLedgerEra era)
-> Map
     Voter (Map GovActionId (VotingProcedure (ShelleyLedgerEra era)))
forall era.
VotingProcedures era
-> Map Voter (Map GovActionId (VotingProcedure era))
L.unVotingProcedures (VotingProcedures era -> VotingProcedures (ShelleyLedgerEra era)
forall era.
VotingProcedures era -> VotingProcedures (ShelleyLedgerEra era)
unVotingProcedures VotingProcedures era
vpsb)
  allVoters :: Set Voter
allVoters = Set Voter -> Set Voter -> Set Voter
forall a. Ord a => Set a -> Set a -> Set a
Set.union (Map
  Voter (Map GovActionId (VotingProcedure (ShelleyLedgerEra era)))
-> Set Voter
forall k a. Map k a -> Set k
Map.keysSet Map
  Voter (Map GovActionId (VotingProcedure (ShelleyLedgerEra era)))
mapa) (Map
  Voter (Map GovActionId (VotingProcedure (ShelleyLedgerEra era)))
-> Set Voter
forall k a. Map k a -> Set k
Map.keysSet Map
  Voter (Map GovActionId (VotingProcedure (ShelleyLedgerEra era)))
mapb)
  mergeVotesOfOneVoter :: Map
  Voter (Map GovActionId (VotingProcedure (ShelleyLedgerEra era)))
-> Voter
-> Either
     (VotesMergingConflict era)
     (Map
        Voter (Map GovActionId (VotingProcedure (ShelleyLedgerEra era))))
mergeVotesOfOneVoter Map
  Voter (Map GovActionId (VotingProcedure (ShelleyLedgerEra era)))
acc Voter
voter =
    Map
  Voter (Map GovActionId (VotingProcedure (ShelleyLedgerEra era)))
-> Map
     Voter (Map GovActionId (VotingProcedure (ShelleyLedgerEra era)))
-> Map
     Voter (Map GovActionId (VotingProcedure (ShelleyLedgerEra era)))
forall k a. Ord k => Map k a -> Map k a -> Map k a
Map.union Map
  Voter (Map GovActionId (VotingProcedure (ShelleyLedgerEra era)))
acc (Map
   Voter (Map GovActionId (VotingProcedure (ShelleyLedgerEra era)))
 -> Map
      Voter (Map GovActionId (VotingProcedure (ShelleyLedgerEra era))))
-> Either
     (VotesMergingConflict era)
     (Map
        Voter (Map GovActionId (VotingProcedure (ShelleyLedgerEra era))))
-> Either
     (VotesMergingConflict era)
     (Map
        Voter (Map GovActionId (VotingProcedure (ShelleyLedgerEra era))))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> case (Voter
-> Map
     Voter (Map GovActionId (VotingProcedure (ShelleyLedgerEra era)))
-> Maybe (Map GovActionId (VotingProcedure (ShelleyLedgerEra era)))
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Voter
voter Map
  Voter (Map GovActionId (VotingProcedure (ShelleyLedgerEra era)))
mapa, Voter
-> Map
     Voter (Map GovActionId (VotingProcedure (ShelleyLedgerEra era)))
-> Maybe (Map GovActionId (VotingProcedure (ShelleyLedgerEra era)))
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Voter
voter Map
  Voter (Map GovActionId (VotingProcedure (ShelleyLedgerEra era)))
mapb) of
      (Just Map GovActionId (VotingProcedure (ShelleyLedgerEra era))
v, Maybe (Map GovActionId (VotingProcedure (ShelleyLedgerEra era)))
Nothing) -> Map
  Voter (Map GovActionId (VotingProcedure (ShelleyLedgerEra era)))
-> Either
     (VotesMergingConflict era)
     (Map
        Voter (Map GovActionId (VotingProcedure (ShelleyLedgerEra era))))
forall a b. b -> Either a b
Right (Map
   Voter (Map GovActionId (VotingProcedure (ShelleyLedgerEra era)))
 -> Either
      (VotesMergingConflict era)
      (Map
         Voter (Map GovActionId (VotingProcedure (ShelleyLedgerEra era)))))
-> Map
     Voter (Map GovActionId (VotingProcedure (ShelleyLedgerEra era)))
-> Either
     (VotesMergingConflict era)
     (Map
        Voter (Map GovActionId (VotingProcedure (ShelleyLedgerEra era))))
forall a b. (a -> b) -> a -> b
$ Voter
-> Map GovActionId (VotingProcedure (ShelleyLedgerEra era))
-> Map
     Voter (Map GovActionId (VotingProcedure (ShelleyLedgerEra era)))
forall k a. k -> a -> Map k a
Map.singleton Voter
voter Map GovActionId (VotingProcedure (ShelleyLedgerEra era))
v -- Take only available value
      (Maybe (Map GovActionId (VotingProcedure (ShelleyLedgerEra era)))
Nothing, Just Map GovActionId (VotingProcedure (ShelleyLedgerEra era))
v) -> Map
  Voter (Map GovActionId (VotingProcedure (ShelleyLedgerEra era)))
-> Either
     (VotesMergingConflict era)
     (Map
        Voter (Map GovActionId (VotingProcedure (ShelleyLedgerEra era))))
forall a b. b -> Either a b
Right (Map
   Voter (Map GovActionId (VotingProcedure (ShelleyLedgerEra era)))
 -> Either
      (VotesMergingConflict era)
      (Map
         Voter (Map GovActionId (VotingProcedure (ShelleyLedgerEra era)))))
-> Map
     Voter (Map GovActionId (VotingProcedure (ShelleyLedgerEra era)))
-> Either
     (VotesMergingConflict era)
     (Map
        Voter (Map GovActionId (VotingProcedure (ShelleyLedgerEra era))))
forall a b. (a -> b) -> a -> b
$ Voter
-> Map GovActionId (VotingProcedure (ShelleyLedgerEra era))
-> Map
     Voter (Map GovActionId (VotingProcedure (ShelleyLedgerEra era)))
forall k a. k -> a -> Map k a
Map.singleton Voter
voter Map GovActionId (VotingProcedure (ShelleyLedgerEra era))
v -- Take only available value
      (Maybe (Map GovActionId (VotingProcedure (ShelleyLedgerEra era)))
Nothing, Maybe (Map GovActionId (VotingProcedure (ShelleyLedgerEra era)))
Nothing) -> Map
  Voter (Map GovActionId (VotingProcedure (ShelleyLedgerEra era)))
-> Either
     (VotesMergingConflict era)
     (Map
        Voter (Map GovActionId (VotingProcedure (ShelleyLedgerEra era))))
forall a b. b -> Either a b
Right Map
  Voter (Map GovActionId (VotingProcedure (ShelleyLedgerEra era)))
forall k a. Map k a
Map.empty -- No value
      (Just Map GovActionId (VotingProcedure (ShelleyLedgerEra era))
va, Just Map GovActionId (VotingProcedure (ShelleyLedgerEra era))
vb) ->
        -- Here's the case where we're unioning different votes for the same voter
        if [GovActionId] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [GovActionId]
intersection -- No conflict: sets of keys from left and right is disjoint
          then Map
  Voter (Map GovActionId (VotingProcedure (ShelleyLedgerEra era)))
-> Either
     (VotesMergingConflict era)
     (Map
        Voter (Map GovActionId (VotingProcedure (ShelleyLedgerEra era))))
forall a b. b -> Either a b
Right (Map
   Voter (Map GovActionId (VotingProcedure (ShelleyLedgerEra era)))
 -> Either
      (VotesMergingConflict era)
      (Map
         Voter (Map GovActionId (VotingProcedure (ShelleyLedgerEra era)))))
-> Map
     Voter (Map GovActionId (VotingProcedure (ShelleyLedgerEra era)))
-> Either
     (VotesMergingConflict era)
     (Map
        Voter (Map GovActionId (VotingProcedure (ShelleyLedgerEra era))))
forall a b. (a -> b) -> a -> b
$ Voter
-> Map GovActionId (VotingProcedure (ShelleyLedgerEra era))
-> Map
     Voter (Map GovActionId (VotingProcedure (ShelleyLedgerEra era)))
forall k a. k -> a -> Map k a
Map.singleton Voter
voter (Map GovActionId (VotingProcedure (ShelleyLedgerEra era))
-> Map GovActionId (VotingProcedure (ShelleyLedgerEra era))
-> Map GovActionId (VotingProcedure (ShelleyLedgerEra era))
forall k a. Ord k => Map k a -> Map k a -> Map k a
Map.union Map GovActionId (VotingProcedure (ShelleyLedgerEra era))
va Map GovActionId (VotingProcedure (ShelleyLedgerEra era))
vb)
          else VotesMergingConflict era
-> Either
     (VotesMergingConflict era)
     (Map
        Voter (Map GovActionId (VotingProcedure (ShelleyLedgerEra era))))
forall a b. a -> Either a b
Left (VotesMergingConflict era
 -> Either
      (VotesMergingConflict era)
      (Map
         Voter (Map GovActionId (VotingProcedure (ShelleyLedgerEra era)))))
-> VotesMergingConflict era
-> Either
     (VotesMergingConflict era)
     (Map
        Voter (Map GovActionId (VotingProcedure (ShelleyLedgerEra era))))
forall a b. (a -> b) -> a -> b
$ (Voter, [GovActionId]) -> VotesMergingConflict era
forall era. (Voter, [GovActionId]) -> VotesMergingConflict era
VotesMergingConflict (Voter
voter, [GovActionId]
intersection) -- Ooops, a conflict! Let's report it!
       where
        intersection :: [GovActionId]
intersection = Map GovActionId (VotingProcedure (ShelleyLedgerEra era))
-> [GovActionId]
forall k a. Map k a -> [k]
Map.keys (Map GovActionId (VotingProcedure (ShelleyLedgerEra era))
 -> [GovActionId])
-> Map GovActionId (VotingProcedure (ShelleyLedgerEra era))
-> [GovActionId]
forall a b. (a -> b) -> a -> b
$ Map GovActionId (VotingProcedure (ShelleyLedgerEra era))
-> Map GovActionId (VotingProcedure (ShelleyLedgerEra era))
-> Map GovActionId (VotingProcedure (ShelleyLedgerEra era))
forall k a b. Ord k => Map k a -> Map k b -> Map k a
Map.intersection Map GovActionId (VotingProcedure (ShelleyLedgerEra era))
va Map GovActionId (VotingProcedure (ShelleyLedgerEra era))
vb