{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE UndecidableInstances #-}

-- | Concrete Peras vote types using BLS signatures.
--
-- NOTE: this module is meant to be imported qualified.
module Ouroboros.Consensus.Peras.Vote.V1
  ( PerasVote (..)
  , PerasVoteEligibilityProof (..)
  ) where

import Cardano.Binary
  ( FromCBOR (..)
  , ToCBOR (..)
  , decodeListLen
  , decodeListLenOf
  , encodeListLen
  )
import Data.Word (Word8)
import Ouroboros.Consensus.Block.SupportsPeras
  ( PerasBoostedBlock
  , PerasRoundNo
  , PerasSeatIndex
  )
import Ouroboros.Consensus.Committee.Crypto (CryptoSupportsVoteSigning (..))
import Ouroboros.Consensus.Peras.Crypto.BLS
  ( PerasBLSCrypto
  , VRFOutput
  )

-- | Concrete Peras votes using BLS signatures
data PerasVote
  = PerasVote
  { PerasVote -> PerasRoundNo
pvRoundNo :: !PerasRoundNo
  -- ^ Election identifier
  , PerasVote -> PerasBoostedBlock
pvBoostedBlock :: !PerasBoostedBlock
  -- ^ Vote message, i.e., the hash of the block being voted for
  , PerasVote -> PerasSeatIndex
pvSeatIndex :: !PerasSeatIndex
  -- ^ Seat index assigned to the committee member (identifies the voter)
  , PerasVote -> PerasVoteEligibilityProof
pvEligibilityProof :: !PerasVoteEligibilityProof
  -- ^ Proof of eligibility for voting, depending on the type of membership to
  -- the committee (persistent vs non-persistent)
  , PerasVote -> VoteSignature PerasBLSCrypto
pvSignature :: !(VoteSignature PerasBLSCrypto)
  -- ^ BLS signature on the hash of the election identifier and vote message
  }
  deriving (Int -> PerasVote -> ShowS
[PerasVote] -> ShowS
PerasVote -> String
(Int -> PerasVote -> ShowS)
-> (PerasVote -> String)
-> ([PerasVote] -> ShowS)
-> Show PerasVote
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PerasVote -> ShowS
showsPrec :: Int -> PerasVote -> ShowS
$cshow :: PerasVote -> String
show :: PerasVote -> String
$cshowList :: [PerasVote] -> ShowS
showList :: [PerasVote] -> ShowS
Show, PerasVote -> PerasVote -> Bool
(PerasVote -> PerasVote -> Bool)
-> (PerasVote -> PerasVote -> Bool) -> Eq PerasVote
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PerasVote -> PerasVote -> Bool
== :: PerasVote -> PerasVote -> Bool
$c/= :: PerasVote -> PerasVote -> Bool
/= :: PerasVote -> PerasVote -> Bool
Eq)

instance FromCBOR PerasVote where
  fromCBOR :: forall s. Decoder s PerasVote
fromCBOR = do
    Int -> Decoder s ()
forall s. Int -> Decoder s ()
decodeListLenOf Int
5
    pvRoundNo <- Decoder s PerasRoundNo
forall s. Decoder s PerasRoundNo
forall a s. FromCBOR a => Decoder s a
fromCBOR
    pvBoostedBlock <- fromCBOR
    pvSeatIndex <- fromCBOR
    pvEligibilityProof <- fromCBOR
    pvSignature <- fromCBOR
    pure
      PerasVote
        { pvRoundNo
        , pvBoostedBlock
        , pvSeatIndex
        , pvEligibilityProof
        , pvSignature
        }

instance ToCBOR PerasVote where
  toCBOR :: PerasVote -> Encoding
toCBOR PerasVote
vote =
    Word -> Encoding
encodeListLen Word
5
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> PerasRoundNo -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR (PerasVote -> PerasRoundNo
pvRoundNo PerasVote
vote)
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> PerasBoostedBlock -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR (PerasVote -> PerasBoostedBlock
pvBoostedBlock PerasVote
vote)
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> PerasSeatIndex -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR (PerasVote -> PerasSeatIndex
pvSeatIndex PerasVote
vote)
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> PerasVoteEligibilityProof -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR (PerasVote -> PerasVoteEligibilityProof
pvEligibilityProof PerasVote
vote)
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> VoteSignature PerasBLSCrypto -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR (PerasVote -> VoteSignature PerasBLSCrypto
pvSignature PerasVote
vote)

-- | Proof of eligibility for voting for committee members
data PerasVoteEligibilityProof
  = -- | Persistent committee members require no additional proof of eligibility
    PersistentPerasVoteEligibilityProof
  | -- | Non-persistent committee members provide a VRF proof of eligibility
    NonPersistentPerasVoteEligibilityProof !(VRFOutput PerasBLSCrypto)
  deriving stock (PerasVoteEligibilityProof -> PerasVoteEligibilityProof -> Bool
(PerasVoteEligibilityProof -> PerasVoteEligibilityProof -> Bool)
-> (PerasVoteEligibilityProof -> PerasVoteEligibilityProof -> Bool)
-> Eq PerasVoteEligibilityProof
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PerasVoteEligibilityProof -> PerasVoteEligibilityProof -> Bool
== :: PerasVoteEligibilityProof -> PerasVoteEligibilityProof -> Bool
$c/= :: PerasVoteEligibilityProof -> PerasVoteEligibilityProof -> Bool
/= :: PerasVoteEligibilityProof -> PerasVoteEligibilityProof -> Bool
Eq, Int -> PerasVoteEligibilityProof -> ShowS
[PerasVoteEligibilityProof] -> ShowS
PerasVoteEligibilityProof -> String
(Int -> PerasVoteEligibilityProof -> ShowS)
-> (PerasVoteEligibilityProof -> String)
-> ([PerasVoteEligibilityProof] -> ShowS)
-> Show PerasVoteEligibilityProof
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PerasVoteEligibilityProof -> ShowS
showsPrec :: Int -> PerasVoteEligibilityProof -> ShowS
$cshow :: PerasVoteEligibilityProof -> String
show :: PerasVoteEligibilityProof -> String
$cshowList :: [PerasVoteEligibilityProof] -> ShowS
showList :: [PerasVoteEligibilityProof] -> ShowS
Show)

instance FromCBOR PerasVoteEligibilityProof where
  fromCBOR :: forall s. Decoder s PerasVoteEligibilityProof
fromCBOR = do
    len <- Decoder s Int
forall s. Decoder s Int
decodeListLen
    tag <- fromCBOR @Word8
    case (len, tag) of
      (Int
1, Word8
0) -> PerasVoteEligibilityProof -> Decoder s PerasVoteEligibilityProof
forall a. a -> Decoder s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure PerasVoteEligibilityProof
PersistentPerasVoteEligibilityProof
      (Int
2, Word8
1) -> VRFOutput PerasBLSCrypto -> PerasVoteEligibilityProof
NonPersistentPerasVoteEligibilityProof (VRFOutput PerasBLSCrypto -> PerasVoteEligibilityProof)
-> Decoder s (VRFOutput PerasBLSCrypto)
-> Decoder s PerasVoteEligibilityProof
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s (VRFOutput PerasBLSCrypto)
forall s. Decoder s (VRFOutput PerasBLSCrypto)
forall a s. FromCBOR a => Decoder s a
fromCBOR
      (Int, Word8)
_ ->
        String -> Decoder s PerasVoteEligibilityProof
forall a. String -> Decoder s a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Decoder s PerasVoteEligibilityProof)
-> String -> Decoder s PerasVoteEligibilityProof
forall a b. (a -> b) -> a -> b
$
          String
"Invalid PerasVoteEligibilityProof length/tag: "
            String -> ShowS
forall a. Semigroup a => a -> a -> a
<> (Int, Word8) -> String
forall a. Show a => a -> String
show (Int
len, Word8
tag)

instance ToCBOR PerasVoteEligibilityProof where
  toCBOR :: PerasVoteEligibilityProof -> Encoding
toCBOR = \case
    PerasVoteEligibilityProof
PersistentPerasVoteEligibilityProof ->
      Word -> Encoding
encodeListLen Word
1
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word8 -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR (Word8
0 :: Word8)
    NonPersistentPerasVoteEligibilityProof VRFOutput PerasBLSCrypto
vrfOutput ->
      Word -> Encoding
encodeListLen Word
2
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word8 -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR (Word8
1 :: Word8)
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> VRFOutput PerasBLSCrypto -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR VRFOutput PerasBLSCrypto
vrfOutput