{-# LANGUAGE DataKinds #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}

-- | Common utilities for writing tests for Peras types.
module Test.Consensus.Peras.Util
  ( -- * Predicates
    perasVoteIsPersistent
  , perasCertContainsOnlyPersistentVotes

    -- * Generators
  , genPerasVote
  , genPerasCert

    -- * Tabulators
  , mkBucket
  , tabulatePerasCert
  , tabulatePerasVote
  ) where

import Cardano.Crypto.Hash (ByteString)
import Cardano.Ledger.BaseTypes (SlotNo (..))
import Control.Monad (forM)
import qualified Data.ByteString as ByteString
import Data.ByteString.Short (ShortByteString)
import qualified Data.ByteString.Short as ShortByteString
import qualified Data.ByteString.Short as ShortBytesString
import qualified Data.List.NonEmpty as NonEmpty
import qualified Data.Map.NonEmpty as NEMap
import Data.Maybe (catMaybes, fromMaybe)
import Data.Proxy (Proxy (..))
import Data.String (IsString (..))
import Data.Traversable (mapAccumM)
import Data.Word (Word8)
import GHC.Word (Word16)
import Ouroboros.Consensus.Block (ConvertRawHash, HeaderHash)
import Ouroboros.Consensus.Block.Abstract (ConvertRawHash (..))
import Ouroboros.Consensus.Block.RealPoint (RealPoint (..), toBytes32RealPoint)
import Ouroboros.Consensus.Block.SupportsPeras
  ( PerasBoostedBlock (..)
  , PerasRoundNo (..)
  , PerasSeatIndex (..)
  )
import qualified Ouroboros.Consensus.Committee.Crypto.BLS as BLS
import qualified Ouroboros.Consensus.Peras.Cert.V1 as V1
import Ouroboros.Consensus.Peras.Crypto.BLS
  ( PerasBLSCryptoAggregateVoteSignature (..)
  , VRFOutput (..)
  , VoteSignature (..)
  )
import qualified Ouroboros.Consensus.Peras.Vote.V1 as V1
import Test.QuickCheck
  ( Arbitrary (..)
  , Gen
  , Property
  , choose
  , frequency
  , sized
  , tabulate
  , vectorOf
  )

-- * Predicates

-- | Whether a Peras vote is a persistent one
perasVoteIsPersistent :: V1.PerasVote -> Bool
perasVoteIsPersistent :: PerasVote -> Bool
perasVoteIsPersistent PerasVote
vote
  | V1.PersistentPerasVoteEligibilityProof{} <- PerasVote -> PerasVoteEligibilityProof
V1.pvEligibilityProof PerasVote
vote = Bool
True
  | Bool
otherwise = Bool
False

-- | Whether a Peras certifcate only contains persistent votes
perasCertContainsOnlyPersistentVotes :: V1.PerasCert -> Bool
perasCertContainsOnlyPersistentVotes :: PerasCert -> Bool
perasCertContainsOnlyPersistentVotes PerasCert
cert =
  (PerasVoteEligibilityProof -> Bool)
-> NonEmpty PerasVoteEligibilityProof -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all
    ( \case
        PerasVoteEligibilityProof
V1.PersistentPerasVoteEligibilityProof -> Bool
True
        V1.NonPersistentPerasVoteEligibilityProof{} -> Bool
False
    )
    ( NEMap PerasSeatIndex PerasVoteEligibilityProof
-> NonEmpty PerasVoteEligibilityProof
forall k a. NEMap k a -> NonEmpty a
NEMap.elems
        (NEMap PerasSeatIndex PerasVoteEligibilityProof
 -> NonEmpty PerasVoteEligibilityProof)
-> (PerasCert -> NEMap PerasSeatIndex PerasVoteEligibilityProof)
-> PerasCert
-> NonEmpty PerasVoteEligibilityProof
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PerasCertVoters -> NEMap PerasSeatIndex PerasVoteEligibilityProof
PerasCertVoters
-> NE (Map PerasSeatIndex PerasVoteEligibilityProof)
V1.unPerasCertVoters
        (PerasCertVoters -> NEMap PerasSeatIndex PerasVoteEligibilityProof)
-> (PerasCert -> PerasCertVoters)
-> PerasCert
-> NEMap PerasSeatIndex PerasVoteEligibilityProof
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PerasCert -> PerasCertVoters
V1.pcVoters
        (PerasCert -> NonEmpty PerasVoteEligibilityProof)
-> PerasCert -> NonEmpty PerasVoteEligibilityProof
forall a b. (a -> b) -> a -> b
$ PerasCert
cert
    )

-- * Generators

genRoundNo :: Gen PerasRoundNo
genRoundNo :: Gen PerasRoundNo
genRoundNo = Word64 -> PerasRoundNo
PerasRoundNo (Word64 -> PerasRoundNo) -> Gen Word64 -> Gen PerasRoundNo
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Word64
forall a. Arbitrary a => Gen a
arbitrary

data BlockWith32BytesHeaderHash
type instance HeaderHash BlockWith32BytesHeaderHash = ShortByteString

instance ConvertRawHash BlockWith32BytesHeaderHash where
  type HashSize BlockWith32BytesHeaderHash = 32
  toRawHash :: forall (proxy :: * -> *).
proxy BlockWith32BytesHeaderHash
-> HeaderHash BlockWith32BytesHeaderHash -> ByteString
toRawHash proxy BlockWith32BytesHeaderHash
_ = ShortByteString -> ByteString
HeaderHash BlockWith32BytesHeaderHash -> ByteString
ShortBytesString.fromShort
  unsafeFromRawHash :: forall (proxy :: * -> *).
proxy BlockWith32BytesHeaderHash
-> ByteString -> HeaderHash BlockWith32BytesHeaderHash
unsafeFromRawHash proxy BlockWith32BytesHeaderHash
_ = ByteString -> ShortByteString
ByteString -> HeaderHash BlockWith32BytesHeaderHash
ShortBytesString.toShort

genBoostedBlock :: Gen PerasBoostedBlock
genBoostedBlock :: Gen PerasBoostedBlock
genBoostedBlock = do
  slotNo <- Word64 -> SlotNo
SlotNo (Word64 -> SlotNo) -> Gen Word64 -> Gen SlotNo
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Word64
forall a. Arbitrary a => Gen a
arbitrary
  hash <- ShortByteString.pack <$> vectorOf 32 arbitrary
  let bytes32realPoint =
        forall blk.
(ConvertRawHash blk, HashSize blk ~ 32) =>
RealPoint blk -> Bytes32RealPoint
toBytes32RealPoint @BlockWith32BytesHeaderHash (RealPoint BlockWith32BytesHeaderHash -> Bytes32RealPoint)
-> RealPoint BlockWith32BytesHeaderHash -> Bytes32RealPoint
forall a b. (a -> b) -> a -> b
$
          SlotNo
-> HeaderHash BlockWith32BytesHeaderHash
-> RealPoint BlockWith32BytesHeaderHash
forall blk. SlotNo -> HeaderHash blk -> RealPoint blk
RealPoint SlotNo
slotNo ShortByteString
HeaderHash BlockWith32BytesHeaderHash
hash
  pure (PerasBoostedBlock bytes32realPoint)

genSeatIndex :: Gen PerasSeatIndex
genSeatIndex :: Gen PerasSeatIndex
genSeatIndex = Word16 -> PerasSeatIndex
PerasSeatIndex (Word16 -> PerasSeatIndex) -> Gen Word16 -> Gen PerasSeatIndex
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Word16
forall a. Arbitrary a => Gen a
arbitrary

genPrivateKey :: Proxy r -> Gen (BLS.PrivateKey r)
genPrivateKey :: forall (r :: KeyRole). Proxy r -> Gen (PrivateKey r)
genPrivateKey Proxy r
_ =
  PrivateKey r -> Maybe (PrivateKey r) -> PrivateKey r
forall a. a -> Maybe a -> a
fromMaybe (String -> PrivateKey r
forall a. HasCallStack => String -> a
error String
"genPrivateKey: invalid key bytes")
    (Maybe (PrivateKey r) -> PrivateKey r)
-> ([Word8] -> Maybe (PrivateKey r)) -> [Word8] -> PrivateKey r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString -> Maybe (PrivateKey r)
forall (r :: KeyRole).
ByteString -> ByteString -> Maybe (PrivateKey r)
BLS.rawDeserialisePrivateKey ByteString
"ROUNDTRIP"
    (ByteString -> Maybe (PrivateKey r))
-> ([Word8] -> ByteString) -> [Word8] -> Maybe (PrivateKey r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Word8] -> ByteString
ByteString.pack
    ([Word8] -> PrivateKey r) -> Gen [Word8] -> Gen (PrivateKey r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Gen Word8 -> Gen [Word8]
forall a. Int -> Gen a -> Gen [a]
vectorOf Int
32 (forall a. Arbitrary a => Gen a
arbitrary @Word8)

genSignature ::
  forall r.
  BLS.HasBLSContext r =>
  Proxy r ->
  Gen (BLS.Signature r)
genSignature :: forall (r :: KeyRole).
HasBLSContext r =>
Proxy r -> Gen (Signature r)
genSignature Proxy r
_ = do
  key <- Proxy r -> Gen (PrivateKey r)
forall (r :: KeyRole). Proxy r -> Gen (PrivateKey r)
genPrivateKey (forall {k} (t :: k). Proxy t
forall (t :: KeyRole). Proxy t
Proxy @r)
  msg <- fromString @ByteString <$> arbitrary
  pure $ BLS.signWithRole key msg

genVoteEligibilityProof :: Bool -> Gen V1.PerasVoteEligibilityProof
genVoteEligibilityProof :: Bool -> Gen PerasVoteEligibilityProof
genVoteEligibilityProof Bool
shouldGenNonPersistent = do
  [(Int, Gen PerasVoteEligibilityProof)]
-> Gen PerasVoteEligibilityProof
forall a. HasCallStack => [(Int, Gen a)] -> Gen a
frequency
    [
      ( Int
4
      , PerasVoteEligibilityProof -> Gen PerasVoteEligibilityProof
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure PerasVoteEligibilityProof
V1.PersistentPerasVoteEligibilityProof
      )
    ,
      ( if Bool
shouldGenNonPersistent then Int
1 else Int
0
      , VRFOutput PerasBLSCrypto -> PerasVoteEligibilityProof
V1.NonPersistentPerasVoteEligibilityProof
          (VRFOutput PerasBLSCrypto -> PerasVoteEligibilityProof)
-> (Signature VRF -> VRFOutput PerasBLSCrypto)
-> Signature VRF
-> PerasVoteEligibilityProof
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Signature VRF -> VRFOutput PerasBLSCrypto
PerasBLSCryptoVRFOutput
          (Signature VRF -> PerasVoteEligibilityProof)
-> Gen (Signature VRF) -> Gen PerasVoteEligibilityProof
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy VRF -> Gen (Signature VRF)
forall (r :: KeyRole).
HasBLSContext r =>
Proxy r -> Gen (Signature r)
genSignature (forall {k} (t :: k). Proxy t
forall (t :: KeyRole). Proxy t
Proxy @BLS.VRF)
      )
    ]

genVoters :: Bool -> Gen V1.PerasCertVoters
genVoters :: Bool -> Gen PerasCertVoters
genVoters Bool
shouldGenNonPersistent = do
  numVoters <-
    (Int -> Gen Word16) -> Gen Word16
forall a. (Int -> Gen a) -> Gen a
sized ((Int -> Gen Word16) -> Gen Word16)
-> (Int -> Gen Word16) -> Gen Word16
forall a b. (a -> b) -> a -> b
$ \Int
size ->
      (Word16 -> Word16) -> Gen Word16 -> Gen Word16
forall a b. (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Word16 -> Word16 -> Word16
forall a. Num a => a -> a -> a
+ Word16
1) (Gen Word16 -> Gen Word16) -> Gen Word16 -> Gen Word16
forall a b. (a -> b) -> a -> b
$
        forall a. Random a => (a, a) -> Gen a
choose @Word16 (Word16
0, Int -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
size Word16 -> Word16 -> Word16
forall a. Num a => a -> a -> a
* Word16
10)
  numPersistentVoters <-
    case shouldGenNonPersistent of
      Bool
True -> (Word16, Word16) -> Gen Word16
forall a. Random a => (a, a) -> Gen a
choose (Word16
0, Word16
numVoters)
      Bool
False -> Word16 -> Gen Word16
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Word16
numVoters
  persistentVoters <-
    if numPersistentVoters == 0
      then pure []
      else forM [0 .. numPersistentVoters - 1] $ \Word16
i -> do
        let proof :: PerasVoteEligibilityProof
proof = PerasVoteEligibilityProof
V1.PersistentPerasVoteEligibilityProof
        (PerasSeatIndex, PerasVoteEligibilityProof)
-> Gen (PerasSeatIndex, PerasVoteEligibilityProof)
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Word16 -> PerasSeatIndex
PerasSeatIndex Word16
i, PerasVoteEligibilityProof
proof)
  nonPersistentVoters <-
    if numPersistentVoters == numVoters
      then pure []
      else forM [numPersistentVoters .. numVoters - 1] $ \Word16
i -> do
        proof <-
          VRFOutput PerasBLSCrypto -> PerasVoteEligibilityProof
V1.NonPersistentPerasVoteEligibilityProof
            (VRFOutput PerasBLSCrypto -> PerasVoteEligibilityProof)
-> (Signature VRF -> VRFOutput PerasBLSCrypto)
-> Signature VRF
-> PerasVoteEligibilityProof
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Signature VRF -> VRFOutput PerasBLSCrypto
PerasBLSCryptoVRFOutput
            (Signature VRF -> PerasVoteEligibilityProof)
-> Gen (Signature VRF) -> Gen PerasVoteEligibilityProof
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy VRF -> Gen (Signature VRF)
forall (r :: KeyRole).
HasBLSContext r =>
Proxy r -> Gen (Signature r)
genSignature (forall {k} (t :: k). Proxy t
forall (t :: KeyRole). Proxy t
Proxy @BLS.VRF)
        pure (PerasSeatIndex i, proof)
  voters <-
    fmap (snd . fmap catMaybes)
      . mapAccumM
        ( \Bool
canDrop (PerasSeatIndex
i, PerasVoteEligibilityProof
proof) -> do
            voter <-
              [(Int, Gen (Maybe (PerasSeatIndex, PerasVoteEligibilityProof)))]
-> Gen (Maybe (PerasSeatIndex, PerasVoteEligibilityProof))
forall a. HasCallStack => [(Int, Gen a)] -> Gen a
frequency
                [ (Int
75, Maybe (PerasSeatIndex, PerasVoteEligibilityProof)
-> Gen (Maybe (PerasSeatIndex, PerasVoteEligibilityProof))
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((PerasSeatIndex, PerasVoteEligibilityProof)
-> Maybe (PerasSeatIndex, PerasVoteEligibilityProof)
forall a. a -> Maybe a
Just (PerasSeatIndex
i, PerasVoteEligibilityProof
proof)))
                , (if Bool
canDrop then Int
25 else Int
0, Maybe (PerasSeatIndex, PerasVoteEligibilityProof)
-> Gen (Maybe (PerasSeatIndex, PerasVoteEligibilityProof))
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (PerasSeatIndex, PerasVoteEligibilityProof)
forall a. Maybe a
Nothing)
                ]
            pure
              ( canDrop || voter == Nothing
              , voter
              )
        )
        False
      $ persistentVoters <> nonPersistentVoters
  pure $
    V1.PerasCertVoters (NEMap.fromList (NonEmpty.fromList voters))

genPerasVote :: Bool -> Gen V1.PerasVote
genPerasVote :: Bool -> Gen PerasVote
genPerasVote Bool
shouldGenNonPersistent = do
  pvRoundNo <- Gen PerasRoundNo
genRoundNo
  pvBoostedBlock <- genBoostedBlock
  pvSeatIndex <- genSeatIndex
  pvEligibilityProof <- genVoteEligibilityProof shouldGenNonPersistent
  pvSignature <-
    PerasBLSCryptoVoteSignature
      <$> genSignature (Proxy @BLS.SIGN)
  pure
    V1.PerasVote
      { V1.pvRoundNo
      , V1.pvBoostedBlock
      , V1.pvSeatIndex
      , V1.pvEligibilityProof
      , V1.pvSignature
      }

genPerasCert :: Bool -> Gen V1.PerasCert
genPerasCert :: Bool -> Gen PerasCert
genPerasCert Bool
shouldGenNonPersistent = do
  pcRoundNo <- Gen PerasRoundNo
genRoundNo
  pcBoostedBlock <- genBoostedBlock
  pcVoters <- genVoters shouldGenNonPersistent
  pcSignature <-
    PerasBLSCryptoAggregateVoteSignature
      <$> genSignature (Proxy @BLS.SIGN)
  pure
    V1.PerasCert
      { V1.pcRoundNo
      , V1.pcBoostedBlock
      , V1.pcVoters
      , V1.pcSignature
      }

-- * Tabulators

mkBucket :: Int -> Int -> String -> String
mkBucket :: Int -> Int -> String -> String
mkBucket Int
bucketSize Int
x String
suffix
  | Int
lower Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
upper = Int -> String
forall a. Show a => a -> String
show Int
lower String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
suffix
  | Bool
otherwise = Int -> String
forall a. Show a => a -> String
show Int
lower String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"-" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
upper String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
suffix
 where
  lower :: Int
lower = (Int
x Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
bucketSize) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
bucketSize
  upper :: Int
upper = Int
lower Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
bucketSize

tabulatePerasCert :: V1.PerasCert -> Property -> Property
tabulatePerasCert :: PerasCert -> Property -> Property
tabulatePerasCert PerasCert
cert =
  ((Property -> Property)
 -> (Property -> Property) -> Property -> Property)
-> (Property -> Property)
-> [Property -> Property]
-> Property
-> Property
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (((Property -> Property)
 -> (Property -> Property) -> Property -> Property)
-> (Property -> Property)
-> (Property -> Property)
-> Property
-> Property
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Property -> Property)
-> (Property -> Property) -> Property -> Property
forall b c a. (b -> c) -> (a -> b) -> a -> c
(.)) Property -> Property
forall a. a -> a
id ([Property -> Property] -> Property -> Property)
-> [Property -> Property] -> Property -> Property
forall a b. (a -> b) -> a -> b
$
    [ String -> [String] -> Property -> Property
forall prop.
Testable prop =>
String -> [String] -> prop -> Property
tabulate
        String
"Number of voters"
        [Int -> Int -> String -> String
mkBucket Int
100 Int
numVoters String
" voters"]
    , String -> [String] -> Property -> Property
forall prop.
Testable prop =>
String -> [String] -> prop -> Property
tabulate
        String
"Proportion of persistent voters"
        [Int -> Int -> String -> String
mkBucket Int
10 Int
persistentVotersRatio String
"%"]
    ]
 where
  numVoters :: Int
numVoters =
    NEMap PerasSeatIndex PerasVoteEligibilityProof -> Int
forall a. NEMap PerasSeatIndex a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length
      (NEMap PerasSeatIndex PerasVoteEligibilityProof -> Int)
-> (PerasCert -> NEMap PerasSeatIndex PerasVoteEligibilityProof)
-> PerasCert
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PerasCertVoters -> NEMap PerasSeatIndex PerasVoteEligibilityProof
PerasCertVoters
-> NE (Map PerasSeatIndex PerasVoteEligibilityProof)
V1.unPerasCertVoters
      (PerasCertVoters -> NEMap PerasSeatIndex PerasVoteEligibilityProof)
-> (PerasCert -> PerasCertVoters)
-> PerasCert
-> NEMap PerasSeatIndex PerasVoteEligibilityProof
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PerasCert -> PerasCertVoters
V1.pcVoters
      (PerasCert -> Int) -> PerasCert -> Int
forall a b. (a -> b) -> a -> b
$ PerasCert
cert
  numPersistentVoters :: Int
numPersistentVoters =
    [PerasVoteEligibilityProof] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length
      ([PerasVoteEligibilityProof] -> Int)
-> (PerasCert -> [PerasVoteEligibilityProof]) -> PerasCert -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PerasVoteEligibilityProof -> Bool)
-> [PerasVoteEligibilityProof] -> [PerasVoteEligibilityProof]
forall a. (a -> Bool) -> [a] -> [a]
filter (PerasVoteEligibilityProof -> PerasVoteEligibilityProof -> Bool
forall a. Eq a => a -> a -> Bool
== PerasVoteEligibilityProof
V1.PersistentPerasVoteEligibilityProof)
      ([PerasVoteEligibilityProof] -> [PerasVoteEligibilityProof])
-> (PerasCert -> [PerasVoteEligibilityProof])
-> PerasCert
-> [PerasVoteEligibilityProof]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty PerasVoteEligibilityProof -> [PerasVoteEligibilityProof]
forall a. NonEmpty a -> [a]
NonEmpty.toList
      (NonEmpty PerasVoteEligibilityProof -> [PerasVoteEligibilityProof])
-> (PerasCert -> NonEmpty PerasVoteEligibilityProof)
-> PerasCert
-> [PerasVoteEligibilityProof]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NEMap PerasSeatIndex PerasVoteEligibilityProof
-> NonEmpty PerasVoteEligibilityProof
forall k a. NEMap k a -> NonEmpty a
NEMap.elems
      (NEMap PerasSeatIndex PerasVoteEligibilityProof
 -> NonEmpty PerasVoteEligibilityProof)
-> (PerasCert -> NEMap PerasSeatIndex PerasVoteEligibilityProof)
-> PerasCert
-> NonEmpty PerasVoteEligibilityProof
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PerasCertVoters -> NEMap PerasSeatIndex PerasVoteEligibilityProof
PerasCertVoters
-> NE (Map PerasSeatIndex PerasVoteEligibilityProof)
V1.unPerasCertVoters
      (PerasCertVoters -> NEMap PerasSeatIndex PerasVoteEligibilityProof)
-> (PerasCert -> PerasCertVoters)
-> PerasCert
-> NEMap PerasSeatIndex PerasVoteEligibilityProof
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PerasCert -> PerasCertVoters
V1.pcVoters
      (PerasCert -> Int) -> PerasCert -> Int
forall a b. (a -> b) -> a -> b
$ PerasCert
cert

  persistentVotersRatio :: Int
persistentVotersRatio
    | Int
numVoters Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = Int
0
    | Bool
otherwise = Int
numPersistentVoters Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
100 Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
numVoters

tabulatePerasVote :: V1.PerasVote -> Property -> Property
tabulatePerasVote :: PerasVote -> Property -> Property
tabulatePerasVote PerasVote
vote =
  ((Property -> Property)
 -> (Property -> Property) -> Property -> Property)
-> (Property -> Property)
-> [Property -> Property]
-> Property
-> Property
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (((Property -> Property)
 -> (Property -> Property) -> Property -> Property)
-> (Property -> Property)
-> (Property -> Property)
-> Property
-> Property
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Property -> Property)
-> (Property -> Property) -> Property -> Property
forall b c a. (b -> c) -> (a -> b) -> a -> c
(.)) Property -> Property
forall a. a -> a
id ([Property -> Property] -> Property -> Property)
-> [Property -> Property] -> Property -> Property
forall a b. (a -> b) -> a -> b
$
    [ String -> [String] -> Property -> Property
forall prop.
Testable prop =>
String -> [String] -> prop -> Property
tabulate
        String
"Voter type"
        [String
voterType]
    ]
 where
  voterType :: String
voterType =
    case PerasVote -> PerasVoteEligibilityProof
V1.pvEligibilityProof PerasVote
vote of
      PerasVoteEligibilityProof
V1.PersistentPerasVoteEligibilityProof -> String
"persistent"
      V1.NonPersistentPerasVoteEligibilityProof VRFOutput PerasBLSCrypto
_ -> String
"non-persistent"