{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}

-- | Generic interface used by implementations of voting committees.
module Ouroboros.Consensus.Committee.Class
  ( -- * Voting committee interface
    CryptoSupportsVotingCommittee (..)

    -- * Votes with same target
  , UniqueVotesWithSameTarget
  , getElectionIdFromVotes
  , getVoteCandidateFromVotes
  , getRawVotes
  , UniqueVotesWithSameTargetError (..)
  , ensureUniqueVotesWithSameTarget
  , unsafeUniqueVotesWithSameTarget
  , checkUniqueVotesWithSameTarget -- for testing purposes only
  ) where

import Control.Exception (assert)
import Data.Containers.NonEmpty (HasNonEmpty (..))
import Data.Either (isRight)
import Data.Kind (Type)
import Data.List.NonEmpty (NonEmpty (..))
import qualified Data.List.NonEmpty as NonEmpty
import Data.Proxy (Proxy (..))
import Ouroboros.Consensus.Committee.Crypto
  ( CryptoSupportsVoteSigning
  , ElectionId
  , PrivateKey
  , VoteCandidate
  )
import Ouroboros.Consensus.Committee.Types (PoolId, VoteWeight)

-- * Voting committee interface

-- | Interface for voting committee schemes.
--
-- This class is parametrized by the crypto primitives and the committee
-- selection data structure. Instances define how to check whether a party
-- should vote and how to compute the voting weight of a committee member.
class
  CryptoSupportsVoteSigning crypto =>
  CryptoSupportsVotingCommittee crypto committee
  where
  -- | Structure storing the voting committee context
  data VotingCommittee crypto committee :: Type

  -- | Input information needed to construct a voting committee
  data VotingCommitteeInput crypto committee :: Type

  -- | Errors that can occur when operating on a voting committee
  data VotingCommitteeError crypto committee :: Type

  -- | Witness attesting that a party is eligible to vote in a given election
  --
  -- NOTE: this is not necessarily the same as the cryptographic proof of
  -- eligibility used in concrete votes and certificates sent over the wire.
  data EligibilityWitness crypto committee :: Type

  -- | Abstract vote cast by a committee member in a given election
  data Vote crypto committee :: Type

  -- | Abstract certificate attesting the winner of a given election
  data Cert crypto committee :: Type

  -- | Construct a voting committee
  mkVotingCommittee ::
    VotingCommitteeInput crypto committee ->
    Either
      (VotingCommitteeError crypto committee)
      (VotingCommittee crypto committee)

  -- | Check whether we should vote in a given election
  checkShouldVote ::
    VotingCommittee crypto committee ->
    PoolId ->
    PrivateKey crypto ->
    ElectionId crypto ->
    Either
      (VotingCommitteeError crypto committee)
      (Maybe (EligibilityWitness crypto committee))

  -- | Forge a vote for a given election and candidate
  forgeVote ::
    EligibilityWitness crypto committee ->
    PrivateKey crypto ->
    ElectionId crypto ->
    VoteCandidate crypto ->
    Vote crypto committee

  -- | Verify a vote cast by a committee member in a given election
  verifyVote ::
    VotingCommittee crypto committee ->
    Vote crypto committee ->
    Either
      (VotingCommitteeError crypto committee)
      (EligibilityWitness crypto committee)

  -- | Compute the voting weight of a eligibile party
  eligiblePartyVoteWeight ::
    VotingCommittee crypto committee ->
    EligibilityWitness crypto committee ->
    VoteWeight

  -- | Forge a certificate attesting the winner of a given election
  forgeCert ::
    UniqueVotesWithSameTarget crypto committee ->
    Either
      (VotingCommitteeError crypto committee)
      (Cert crypto committee)

  -- | Verify a certificate attesting the winner of a given election
  verifyCert ::
    VotingCommittee crypto committee ->
    Cert crypto committee ->
    Either
      (VotingCommitteeError crypto committee)
      (NE [EligibilityWitness crypto committee])

-- * Votes with same target

-- | Collection of unique votes all targeting the same election and candidate
data UniqueVotesWithSameTarget crypto committee
  = UniqueVotesWithSameTarget
      (ElectionId crypto)
      (VoteCandidate crypto)
      (NE [Vote crypto committee])

-- | Get the election identifier targeted by a collection of votes
getElectionIdFromVotes ::
  UniqueVotesWithSameTarget crypto committee ->
  ElectionId crypto
getElectionIdFromVotes :: forall crypto committee.
UniqueVotesWithSameTarget crypto committee -> ElectionId crypto
getElectionIdFromVotes (UniqueVotesWithSameTarget ElectionId crypto
electionId VoteCandidate crypto
_ NE [Vote crypto committee]
_) =
  ElectionId crypto
electionId

-- | Get the vote candidate targeted by a collection of votes
getVoteCandidateFromVotes ::
  UniqueVotesWithSameTarget crypto committee ->
  VoteCandidate crypto
getVoteCandidateFromVotes :: forall crypto committee.
UniqueVotesWithSameTarget crypto committee -> VoteCandidate crypto
getVoteCandidateFromVotes (UniqueVotesWithSameTarget ElectionId crypto
_ VoteCandidate crypto
candidate NE [Vote crypto committee]
_) =
  VoteCandidate crypto
candidate

-- | Get the raw votes from a collection of votes with the same target.
--
-- NOTE: this returns votes in ascending seat index order.
getRawVotes ::
  UniqueVotesWithSameTarget crypto committee ->
  NE [Vote crypto committee]
getRawVotes :: forall crypto committee.
UniqueVotesWithSameTarget crypto committee
-> NE [Vote crypto committee]
getRawVotes (UniqueVotesWithSameTarget ElectionId crypto
_ VoteCandidate crypto
_ NE [Vote crypto committee]
votes) =
  NE [Vote crypto committee]
votes

-- | Errors when votes do not all target the same election and candidate
data UniqueVotesWithSameTargetError vote
  = DuplicateVotes
      -- A cluster of votes equal under the supplied ordering, i.e.,
      -- either true duplicates or equivocating votes (same id, different
      -- target).
      (NE [vote])
  | TargetMismatch
      -- First vote (under the supplied ordering) whose target is treated
      -- as the canonical target for the comparison
      vote
      -- Votes that do not match the target of the first vote
      (NE [vote])

-- | Check that a non-empty list of votes all target the same election and
-- candidate and there are no duplicates.
--
-- NOTE: duplicates are reported in preference to target mismatches.
ensureUniqueVotesWithSameTarget ::
  forall crypto committee.
  ( Eq (ElectionId crypto)
  , Eq (VoteCandidate crypto)
  ) =>
  -- | How to project the target from an abstract vote
  (Vote crypto committee -> (ElectionId crypto, VoteCandidate crypto)) ->
  -- | How to compare votes by ID, where EQ means that two votes have the same
  -- ID and are either total duplicates, or are equivocating (i.e., they have
  -- the same ID but a different target)
  (Vote crypto committee -> Vote crypto committee -> Ordering) ->
  -- | Collection of votes to check
  NE [Vote crypto committee] ->
  Either
    (UniqueVotesWithSameTargetError (Vote crypto committee))
    (UniqueVotesWithSameTarget crypto committee)
ensureUniqueVotesWithSameTarget :: forall crypto committee.
(Eq (ElectionId crypto), Eq (VoteCandidate crypto)) =>
(Vote crypto committee
 -> (ElectionId crypto, VoteCandidate crypto))
-> (Vote crypto committee -> Vote crypto committee -> Ordering)
-> NE [Vote crypto committee]
-> Either
     (UniqueVotesWithSameTargetError (Vote crypto committee))
     (UniqueVotesWithSameTarget crypto committee)
ensureUniqueVotesWithSameTarget Vote crypto committee -> (ElectionId crypto, VoteCandidate crypto)
getTarget Vote crypto committee -> Vote crypto committee -> Ordering
cmpVotes NE [Vote crypto committee]
votes =
  (() -> UniqueVotesWithSameTarget crypto committee)
-> Either
     (UniqueVotesWithSameTargetError (Vote crypto committee)) ()
-> Either
     (UniqueVotesWithSameTargetError (Vote crypto committee))
     (UniqueVotesWithSameTarget crypto committee)
forall a b.
(a -> b)
-> Either
     (UniqueVotesWithSameTargetError (Vote crypto committee)) a
-> Either
     (UniqueVotesWithSameTargetError (Vote crypto committee)) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
    ( UniqueVotesWithSameTarget crypto committee
-> () -> UniqueVotesWithSameTarget crypto committee
forall a b. a -> b -> a
const
        ( ElectionId crypto
-> VoteCandidate crypto
-> NE [Vote crypto committee]
-> UniqueVotesWithSameTarget crypto committee
forall crypto committee.
ElectionId crypto
-> VoteCandidate crypto
-> NE [Vote crypto committee]
-> UniqueVotesWithSameTarget crypto committee
UniqueVotesWithSameTarget
            ElectionId crypto
electionId
            VoteCandidate crypto
candidate
            (Vote crypto committee
firstVote Vote crypto committee
-> [Vote crypto committee] -> NonEmpty (Vote crypto committee)
forall a. a -> [a] -> NonEmpty a
:| [Vote crypto committee]
nextVotes)
        )
    )
    (Either (UniqueVotesWithSameTargetError (Vote crypto committee)) ()
 -> Either
      (UniqueVotesWithSameTargetError (Vote crypto committee))
      (UniqueVotesWithSameTarget crypto committee))
-> Either
     (UniqueVotesWithSameTargetError (Vote crypto committee)) ()
-> Either
     (UniqueVotesWithSameTargetError (Vote crypto committee))
     (UniqueVotesWithSameTarget crypto committee)
forall a b. (a -> b) -> a -> b
$ Proxy crypto
-> (Vote crypto committee
    -> (ElectionId crypto, VoteCandidate crypto))
-> (Vote crypto committee -> Vote crypto committee -> Ordering)
-> NE [Vote crypto committee]
-> Either
     (UniqueVotesWithSameTargetError (Vote crypto committee)) ()
forall crypto vote.
(Eq (ElectionId crypto), Eq (VoteCandidate crypto)) =>
Proxy crypto
-> (vote -> (ElectionId crypto, VoteCandidate crypto))
-> (vote -> vote -> Ordering)
-> NE [vote]
-> Either (UniqueVotesWithSameTargetError vote) ()
checkUniqueVotesWithSameTarget
      (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @crypto)
      Vote crypto committee -> (ElectionId crypto, VoteCandidate crypto)
getTarget
      Vote crypto committee -> Vote crypto committee -> Ordering
cmpVotes
      NE [Vote crypto committee]
votes
 where
  Vote crypto committee
firstVote :| [Vote crypto committee]
nextVotes = NE [Vote crypto committee]
votes
  (ElectionId crypto
electionId, VoteCandidate crypto
candidate) = Vote crypto committee -> (ElectionId crypto, VoteCandidate crypto)
getTarget Vote crypto committee
firstVote

-- | Same as 'ensureUniqueVotesWithSameTarget' but turns the invariant
-- checks into assertions.
--
-- WARNING: asserts become a no-op if the code is compiled with optimizations,
-- thus this function should only be used in production when the caller can
-- guarantee that the input votes satisfy the contract.
unsafeUniqueVotesWithSameTarget ::
  forall crypto committee.
  ( Eq (ElectionId crypto)
  , Eq (VoteCandidate crypto)
  ) =>
  -- | How to project the target from an abstract vote
  (Vote crypto committee -> (ElectionId crypto, VoteCandidate crypto)) ->
  -- | How to compare votes by ID, where EQ means that two votes have the same
  -- ID and are either total duplicates, or are equivocating (i.e., they have
  -- the same ID but a different target)
  (Vote crypto committee -> Vote crypto committee -> Ordering) ->
  -- | Collection of votes to check
  NE [Vote crypto committee] ->
  UniqueVotesWithSameTarget crypto committee
unsafeUniqueVotesWithSameTarget :: forall crypto committee.
(Eq (ElectionId crypto), Eq (VoteCandidate crypto)) =>
(Vote crypto committee
 -> (ElectionId crypto, VoteCandidate crypto))
-> (Vote crypto committee -> Vote crypto committee -> Ordering)
-> NE [Vote crypto committee]
-> UniqueVotesWithSameTarget crypto committee
unsafeUniqueVotesWithSameTarget Vote crypto committee -> (ElectionId crypto, VoteCandidate crypto)
getTarget Vote crypto committee -> Vote crypto committee -> Ordering
cmpVotes NE [Vote crypto committee]
votes =
  Bool
-> UniqueVotesWithSameTarget crypto committee
-> UniqueVotesWithSameTarget crypto committee
forall a. (?callStack::CallStack) => Bool -> a -> a
assert
    ( Either (UniqueVotesWithSameTargetError (Vote crypto committee)) ()
-> Bool
forall a b. Either a b -> Bool
isRight
        ( Proxy crypto
-> (Vote crypto committee
    -> (ElectionId crypto, VoteCandidate crypto))
-> (Vote crypto committee -> Vote crypto committee -> Ordering)
-> NE [Vote crypto committee]
-> Either
     (UniqueVotesWithSameTargetError (Vote crypto committee)) ()
forall crypto vote.
(Eq (ElectionId crypto), Eq (VoteCandidate crypto)) =>
Proxy crypto
-> (vote -> (ElectionId crypto, VoteCandidate crypto))
-> (vote -> vote -> Ordering)
-> NE [vote]
-> Either (UniqueVotesWithSameTargetError vote) ()
checkUniqueVotesWithSameTarget
            (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @crypto)
            Vote crypto committee -> (ElectionId crypto, VoteCandidate crypto)
getTarget
            Vote crypto committee -> Vote crypto committee -> Ordering
cmpVotes
            NE [Vote crypto committee]
votes
        )
    )
    (UniqueVotesWithSameTarget crypto committee
 -> UniqueVotesWithSameTarget crypto committee)
-> UniqueVotesWithSameTarget crypto committee
-> UniqueVotesWithSameTarget crypto committee
forall a b. (a -> b) -> a -> b
$ ElectionId crypto
-> VoteCandidate crypto
-> NE [Vote crypto committee]
-> UniqueVotesWithSameTarget crypto committee
forall crypto committee.
ElectionId crypto
-> VoteCandidate crypto
-> NE [Vote crypto committee]
-> UniqueVotesWithSameTarget crypto committee
UniqueVotesWithSameTarget
      ElectionId crypto
electionId
      VoteCandidate crypto
candidate
      (Vote crypto committee
firstVote Vote crypto committee
-> [Vote crypto committee] -> NonEmpty (Vote crypto committee)
forall a. a -> [a] -> NonEmpty a
:| [Vote crypto committee]
nextVotes)
 where
  Vote crypto committee
firstVote :| [Vote crypto committee]
nextVotes = NE [Vote crypto committee]
votes
  (ElectionId crypto
electionId, VoteCandidate crypto
candidate) = Vote crypto committee -> (ElectionId crypto, VoteCandidate crypto)
getTarget Vote crypto committee
firstVote

-- | Validate that a non-empty collection of votes is well-formed for
-- certificate forging: all votes target the same election and candidate
-- (per @getTarget@), and no two votes are equal under @cmpVotes@.
--
-- Equality (@EQ@) is treated as evidence of a duplicate or equivocating vote
-- and is reported via 'DuplicateVotes' in preference to any 'TargetMismatch'.
--
-- NOTE: this is exposed for testing; production code should use
-- 'ensureUniqueVotesWithSameTarget' or 'unsafeUniqueVotesWithSameTarget'.
checkUniqueVotesWithSameTarget ::
  ( Eq (ElectionId crypto)
  , Eq (VoteCandidate crypto)
  ) =>
  Proxy crypto ->
  -- | How to project the target an abstract vote
  (vote -> (ElectionId crypto, VoteCandidate crypto)) ->
  -- | How to compare votes by ID, where EQ means that two votes have the same
  -- ID and are either total duplicates, or are equivocating (i.e., they have
  -- the same ID but a different target)
  (vote -> vote -> Ordering) ->
  -- | Collection of votes to check
  NE [vote] ->
  Either (UniqueVotesWithSameTargetError vote) ()
checkUniqueVotesWithSameTarget :: forall crypto vote.
(Eq (ElectionId crypto), Eq (VoteCandidate crypto)) =>
Proxy crypto
-> (vote -> (ElectionId crypto, VoteCandidate crypto))
-> (vote -> vote -> Ordering)
-> NE [vote]
-> Either (UniqueVotesWithSameTargetError vote) ()
checkUniqueVotesWithSameTarget Proxy crypto
_ vote -> (ElectionId crypto, VoteCandidate crypto)
getTarget vote -> vote -> Ordering
cmpVotes NE [vote]
votes =
  vote -> [vote] -> Either (UniqueVotesWithSameTargetError vote) ()
go vote
firstVote [vote]
nextVotes
 where
  -- Sort the votes so checking for duplicates can be done in the same pass as
  -- checking for target mismatches
  vote
firstVote :| [vote]
nextVotes =
    (vote -> vote -> Ordering) -> NonEmpty vote -> NonEmpty vote
forall a. (a -> a -> Ordering) -> NonEmpty a -> NonEmpty a
NonEmpty.sortBy vote -> vote -> Ordering
cmpVotes NonEmpty vote
NE [vote]
votes

  -- Check that all votes have the same target and there are no duplicates. The
  -- first argument is the last vote we have checked, passed sequentially to the
  -- next step to check against duplicates (the input must be sorted for this).
  go :: vote -> [vote] -> Either (UniqueVotesWithSameTargetError vote) ()
go vote
_ [] =
    () -> Either (UniqueVotesWithSameTargetError vote) ()
forall a b. b -> Either a b
Right ()
  go vote
v (vote
v' : [vote]
vs)
    | vote -> vote -> Bool
isDuplicateOf vote
v vote
v' = do
        -- NOTE: duplicates are contiguous because the input is sorted by
        -- @cmpVotes@, thus we can stop at the first non-duplicate vote.
        let duplicateVotes :: NonEmpty vote
duplicateVotes = vote
v vote -> [vote] -> NonEmpty vote
forall a. a -> [a] -> NonEmpty a
:| (vote
v' vote -> [vote] -> [vote]
forall a. a -> [a] -> [a]
: (vote -> Bool) -> [vote] -> [vote]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (vote -> vote -> Bool
isDuplicateOf vote
v) [vote]
vs)
        UniqueVotesWithSameTargetError vote
-> Either (UniqueVotesWithSameTargetError vote) ()
forall a b. a -> Either a b
Left (NE [vote] -> UniqueVotesWithSameTargetError vote
forall vote. NE [vote] -> UniqueVotesWithSameTargetError vote
DuplicateVotes NonEmpty vote
NE [vote]
duplicateVotes)
    | vote -> Bool
doesNotMatchFirstVoteTarget vote
v' = do
        -- NOTE: mismatches are /not/ necessarily contiguous, thus we cannot
        -- stop at the first matching vote.
        let mismatchingVotes :: NonEmpty vote
mismatchingVotes = vote
v' vote -> [vote] -> NonEmpty vote
forall a. a -> [a] -> NonEmpty a
:| (vote -> Bool) -> [vote] -> [vote]
forall a. (a -> Bool) -> [a] -> [a]
filter vote -> Bool
doesNotMatchFirstVoteTarget [vote]
vs
        UniqueVotesWithSameTargetError vote
-> Either (UniqueVotesWithSameTargetError vote) ()
forall a b. a -> Either a b
Left (vote -> NE [vote] -> UniqueVotesWithSameTargetError vote
forall vote.
vote -> NE [vote] -> UniqueVotesWithSameTargetError vote
TargetMismatch vote
firstVote NonEmpty vote
NE [vote]
mismatchingVotes)
    | Bool
otherwise =
        vote -> [vote] -> Either (UniqueVotesWithSameTargetError vote) ()
go vote
v' [vote]
vs

  -- Check if a vote does not match the target of the first vote
  doesNotMatchFirstVoteTarget :: vote -> Bool
doesNotMatchFirstVoteTarget vote
v =
    vote -> (ElectionId crypto, VoteCandidate crypto)
getTarget vote
v (ElectionId crypto, VoteCandidate crypto)
-> (ElectionId crypto, VoteCandidate crypto) -> Bool
forall a. Eq a => a -> a -> Bool
/= vote -> (ElectionId crypto, VoteCandidate crypto)
getTarget vote
firstVote

  -- Check if two votes are duplicates of each other acording to @cmpVotes@
  isDuplicateOf :: vote -> vote -> Bool
isDuplicateOf vote
v vote
v' =
    vote -> vote -> Ordering
cmpVotes vote
v vote
v' Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
EQ