Skip to content
This repository was archived by the owner on Jun 26, 2023. It is now read-only.

Commit 736947e

Browse files
nkaragDamian Nadales
andauthored
Tally microbenchmarking (#114)
* update cabal file and set up file/modules structure * small correction * run a tally - without benchmarking * run fisrt benchmark * nix * run for more participants * execute set up for benchmark outside the tally function - Heap size error * strange memory usage results * Criterion benchmark has returned sensible results due to full evaluation * Optimizations to reduce execution time * Make worst case analysis and tally micro benchmarks independent from each other. [skip ci] * Ignore stack work directory used for profiling. [skip ci] * Use strict maps in the proposals state. [skip ci] * WIP: benchmarks without stake percentage optimization. [skip ci] * Cache the total stake, and compute the approval threshold without needing to compute a stake percentage. [skip ci] * Add benchmarks for 1e7 participants and use longer hashes. * Use StakeDistribution.fromList in test code. [skip ci] * Minor changes before submitting for review. [skip ci] * Use the same hash as in Byron. [skip ci] * Optimize tallying by passing a map of keys and taking its intersection, instead of a list of keys. [skip ci] * Use short bytestring for hashes. [skip ci] * remove warnings * remove comments and nix artifacts * minor problem with tests fixed Co-authored-by: Damian Nadales <damian.nadales@gmail.com>
1 parent 158f26b commit 736947e

12 files changed

Lines changed: 494 additions & 62 deletions

File tree

.gitignore

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -54,3 +54,4 @@ specs/**/.ghc.environment.x86_64-linux-*
5454
*.prof
5555
*.prof.*
5656
*.profiterole.*
57+
.stack-profile
Lines changed: 245 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,245 @@
1+
{-# LANGUAGE AllowAmbiguousTypes #-}
2+
{-# LANGUAGE BangPatterns #-}
3+
{-# LANGUAGE DeriveAnyClass #-}
4+
{-# LANGUAGE DeriveGeneric #-}
5+
{-# LANGUAGE DerivingStrategies #-}
6+
{-# LANGUAGE FlexibleContexts #-}
7+
{-# LANGUAGE GADTs #-}
8+
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
9+
{-# LANGUAGE MultiParamTypeClasses #-}
10+
{-# LANGUAGE NamedFieldPuns #-}
11+
{-# LANGUAGE StandaloneDeriving #-}
12+
{-# LANGUAGE TypeApplications #-}
13+
{-# LANGUAGE TypeFamilies #-}
14+
{-# LANGUAGE UndecidableInstances #-}
15+
16+
module Cardano.Ledger.Benchmarks.Update.Tally where
17+
18+
import qualified Control.DeepSeq as Deep
19+
import Data.Either (isRight)
20+
import Data.List (repeat, zip)
21+
import Data.List (foldl')
22+
import GHC.Generics (Generic)
23+
24+
import qualified Codec.CBOR.Write as CBOR.Write
25+
import qualified Crypto.Hash as Crypto
26+
import qualified Data.ByteArray as ByteArray
27+
import qualified Data.ByteString.Builder as Builder
28+
import qualified Data.ByteString.Lazy as BSL
29+
import Data.ByteString.Short (ShortByteString)
30+
import qualified Data.ByteString.Short as Short
31+
32+
import Cardano.Binary (ToCBOR, toCBOR)
33+
import Cardano.Crypto.DSIGN.Class (SignedDSIGN)
34+
import qualified Cardano.Crypto.DSIGN.Class as Crypto.DSIGN
35+
import Cardano.Crypto.DSIGN.Mock (MockDSIGN)
36+
import Cardano.Crypto.DSIGN.Mock (VerKeyDSIGN (VerKeyMockDSIGN))
37+
import qualified Cardano.Crypto.DSIGN.Mock as Crypto.Mock
38+
import Cardano.Ledger.Spec.Classes.HasSigningScheme (HasSigningScheme,
39+
SKey, Signable, Signature, VKey, sign, verify)
40+
import Ledger.Core (BlockCount, Slot, SlotCount, (*.), (+.))
41+
42+
import Cardano.Ledger.Spec.Classes.Hashable (HasHash, Hash, Hashable,
43+
hash)
44+
import Cardano.Ledger.Spec.State.ProposalsState (ProposalsState,
45+
decision, revealProposal, tally, updateBallot)
46+
import Cardano.Ledger.Spec.State.ProposalState (Decision,
47+
HasVotingPeriod, IsVote, VotingPeriod (VotingPeriod),
48+
getConfidence, getVoter, getVotingPeriodDuration)
49+
import Cardano.Ledger.Spec.State.StakeDistribution (StakeDistribution,
50+
fromList)
51+
import Cardano.Ledger.Spec.STS.Update.Data
52+
(Confidence (For), Stake (Stake))
53+
54+
55+
data BenchmarkConstants =
56+
BenchmarkConstants
57+
{ k :: !BlockCount
58+
-- ^ Chain stability parameter.
59+
, r_a :: !Float
60+
-- ^ Adversarial stake ratio.
61+
, revelationSlot :: !Slot
62+
-- ^ Slot at which __all__ proposals were registered.
63+
}
64+
deriving (Show, Eq)
65+
66+
-- | Data required for performing tallying the votes.
67+
data TallyData p d =
68+
TallyData
69+
{ stakeDist :: !(StakeDistribution p)
70+
, proposals :: ![Proposal]
71+
-- ^ Update proposals that are active at the same time. We assume their voting
72+
-- period overlaps exactly, which is the worst case.
73+
, proposalHashes :: ![Hash BenchCrypto Proposal]
74+
-- ^ Proposal hashes. These must correspond to 'proposals'. We use this to
75+
-- avoid computing hashes when getting the results of the tally.
76+
, participants :: ![VKey BenchCrypto]
77+
}
78+
deriving (Show, Generic)
79+
80+
-- | Type of proposals we're voting on in the benchmarks
81+
newtype Proposal = Proposal Word
82+
deriving stock (Show, Eq, Generic)
83+
deriving newtype (ToCBOR, Deep.NFData)
84+
85+
mkProposal :: Word -> Proposal
86+
mkProposal = Proposal
87+
88+
instance HasVotingPeriod Proposal where
89+
-- We assume all proposals to last for 1 slot.
90+
getVotingPeriodDuration = const benchmarksVotingPeriodDuration
91+
92+
-- | Voting period duration that is used throughout the module.
93+
benchmarksVotingPeriodDuration :: SlotCount
94+
benchmarksVotingPeriodDuration = 1
95+
96+
data Vote =
97+
Vote
98+
{ issuer :: VKey BenchCrypto
99+
, confidence :: Confidence
100+
} deriving (Eq, Show)
101+
102+
instance IsVote BenchCrypto Vote where
103+
getVoter = issuer
104+
105+
getConfidence = confidence
106+
107+
deriving instance ( Eq (StakeDistribution p)
108+
, Hashable p
109+
)
110+
=> Eq (TallyData p d)
111+
112+
-- | Simulate the revelation of the number of proposals given be the benchmark
113+
-- parameters.
114+
revealProposals
115+
:: BenchmarkConstants
116+
-> TallyData BenchCrypto Proposal
117+
-> ProposalsState BenchCrypto Proposal
118+
revealProposals BenchmarkConstants { revelationSlot } TallyData { proposals } =
119+
foldl' reveal mempty proposals
120+
where
121+
-- For the purposes of benchmarking the tally process we only need a single
122+
-- voting period.
123+
reveal st i = revealProposal revelationSlot (VotingPeriod 1) i st
124+
125+
-- | Vote on all the proposals in the state.
126+
voteOnProposals
127+
:: TallyData BenchCrypto Proposal
128+
-> ProposalsState BenchCrypto Proposal
129+
-> ProposalsState BenchCrypto Proposal
130+
voteOnProposals TallyData {participants, proposals} st =
131+
foldl' voteOnProposal st proposalsHashes
132+
where
133+
voteOnProposal st' hp =
134+
foldl' vote st' participants
135+
where
136+
vote st'' who = updateBallot hp (Vote who For) st''
137+
proposalsHashes = fmap hash proposals
138+
139+
-- | Get number of participants and run the tally
140+
runTally
141+
:: BenchmarkConstants
142+
-> (TallyData BenchCrypto Proposal, ProposalsState BenchCrypto Proposal)
143+
-> [Decision]
144+
runTally
145+
BenchmarkConstants { k, r_a, revelationSlot }
146+
(TallyData { stakeDist, proposalHashes }, proposalsState)
147+
= fmap (`decision` proposalsStateAfterTally) proposalHashes
148+
where
149+
proposalsStateAfterTally = tally k stableAt stakeDist r_a proposalsState
150+
where
151+
-- Here we're assuming a vote period duration of 1, as defined in the
152+
-- 'HasVotingPeriod' instance of 'Vote'.
153+
stableAt = revelationSlot
154+
+. 2 *. k -- Revelation is stable
155+
+. benchmarksVotingPeriodDuration -- Voting period ended
156+
+. 2 *. k -- End of the voting period
157+
-- is stable: tally can take
158+
-- place.
159+
160+
newtype NumberOfParticipants = NumberOfParticipants Word
161+
162+
newtype NumberOfConcurrentUPs = NumberOfConcurrentUPs Word
163+
164+
createTallyData
165+
:: BenchmarkConstants
166+
-> NumberOfParticipants
167+
-> NumberOfConcurrentUPs
168+
-> (TallyData BenchCrypto Proposal, ProposalsState BenchCrypto Proposal)
169+
createTallyData
170+
constants
171+
(NumberOfParticipants numOfParticipants)
172+
(NumberOfConcurrentUPs numOfConcurrentUPs)
173+
=
174+
(tallyData, proposalsState)
175+
where
176+
tallyData =
177+
TallyData
178+
{ stakeDist = mkStakeDist participantsHashes
179+
, proposals = proposals'
180+
, proposalHashes = hash <$> proposals'
181+
, participants = participants'
182+
}
183+
proposals' = mkProposal <$> [1.. numOfConcurrentUPs]
184+
proposalsState = voteOnProposals tallyData
185+
$ revealProposals constants tallyData
186+
participants' = VerKeyMockDSIGN <$> [1 .. fromIntegral numOfParticipants]
187+
!participantsHashes = hash <$> participants'
188+
189+
190+
-- | Uniform stake distribution with a stake of 1 for each stakeholder.
191+
mkStakeDist :: [Hash BenchCrypto (VKey BenchCrypto)] -> StakeDistribution BenchCrypto
192+
mkStakeDist participants
193+
= fromList
194+
$ zip participants
195+
(repeat (Stake 1))
196+
197+
--------------------------------------------------------------------------------
198+
-- Hashing, signing, and verification algorithms to be used in the benchmarks
199+
--------------------------------------------------------------------------------
200+
201+
data BenchCrypto
202+
203+
instance Hashable BenchCrypto where
204+
205+
newtype Hash BenchCrypto a = BenchHash ShortByteString
206+
deriving (Eq, Ord, Show)
207+
208+
type HasHash BenchCrypto = ToCBOR
209+
210+
-- Calculate the hash as it is done in Byron. See @module
211+
-- Cardano.Chain.Common.AddressHash@ in @cardano-ledger@.
212+
--
213+
hash
214+
= BenchHash
215+
. Short.toShort
216+
. ByteArray.convert
217+
. secondHash
218+
. firstHash
219+
where
220+
firstHash :: ToCBOR a => a -> Crypto.Digest Crypto.SHA3_256
221+
firstHash
222+
= Crypto.hash
223+
. BSL.toStrict
224+
. Builder.toLazyByteString
225+
. CBOR.Write.toBuilder
226+
. toCBOR
227+
secondHash :: Crypto.Digest Crypto.SHA3_256 -> Crypto.Digest Crypto.Blake2b_224
228+
secondHash = Crypto.hash
229+
230+
231+
instance HasSigningScheme BenchCrypto where
232+
233+
newtype Signature BenchCrypto a = BenchCryptoSignature (SignedDSIGN MockDSIGN a)
234+
deriving (Eq, Show)
235+
236+
type VKey BenchCrypto = Crypto.Mock.VerKeyDSIGN MockDSIGN
237+
238+
type SKey BenchCrypto = Crypto.Mock.SignKeyDSIGN MockDSIGN
239+
240+
type Signable BenchCrypto = Crypto.DSIGN.Signable MockDSIGN
241+
242+
sign a skey = BenchCryptoSignature $ Crypto.Mock.mockSigned a skey
243+
244+
verify vkey a (BenchCryptoSignature sig) =
245+
isRight $ Crypto.DSIGN.verifySignedDSIGN @MockDSIGN () vkey a sig
Lines changed: 47 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,47 @@
1+
{-# LANGUAGE BangPatterns #-}
2+
3+
module Main where
4+
5+
import Ledger.Core (Slot (Slot))
6+
7+
import Cardano.Ledger.Benchmarks.Update.Tally
8+
import Cardano.Ledger.Spec.State.ProposalState (Decision (Accepted))
9+
10+
import qualified Criterion.Main as Cr
11+
12+
main :: IO ()
13+
main = do
14+
let
15+
!tallyData2 =
16+
createTallyData constants (NumberOfParticipants 10) (NumberOfConcurrentUPs 10)
17+
!tallyData3 =
18+
createTallyData constants (NumberOfParticipants 100) (NumberOfConcurrentUPs 10)
19+
!tallyData4 =
20+
createTallyData constants (NumberOfParticipants 1000) (NumberOfConcurrentUPs 10)
21+
!tallyData5 =
22+
createTallyData constants (NumberOfParticipants 10000) (NumberOfConcurrentUPs 10)
23+
!tallyData6 =
24+
createTallyData constants (NumberOfParticipants 100000) (NumberOfConcurrentUPs 10)
25+
!tallyData7 =
26+
createTallyData constants (NumberOfParticipants 1000000) (NumberOfConcurrentUPs 10)
27+
print $ runTally constants tallyData3
28+
Cr.defaultMain
29+
[ Cr.bgroup "tally" [ Cr.bench "1e2" $ Cr.whnf allApproved tallyData2
30+
, Cr.bench "1e3" $ Cr.whnf allApproved tallyData3
31+
, Cr.bench "1e4" $ Cr.whnf allApproved tallyData4
32+
, Cr.bench "1e5" $ Cr.whnf allApproved tallyData5
33+
, Cr.bench "1e6" $ Cr.whnf allApproved tallyData6
34+
, Cr.bench "1e7" $ Cr.whnf allApproved tallyData7
35+
]
36+
]
37+
where
38+
!constants =
39+
BenchmarkConstants
40+
{ k = 1
41+
, r_a = 0.49
42+
, revelationSlot = Slot 0
43+
}
44+
allApproved tallyData
45+
= if all (== Accepted) $ runTally constants tallyData
46+
then True
47+
else error "All proposals should be accepted!"

executable-spec/decentralized-updates.cabal

Lines changed: 35 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -69,6 +69,7 @@ library
6969
, cardano-crypto-class
7070
, small-steps
7171
, cs-ledger
72+
, deepseq
7273
default-language: Haskell2010
7374
ghc-options: -Wall
7475
-Wcompat
@@ -104,6 +105,7 @@ test-suite ledger-rules-test
104105
, decentralized-updates
105106
, cs-ledger
106107
, small-steps
108+
, deepseq
107109
-- Internal libraries
108110
, datil
109111
ghc-options: -Wall
@@ -140,3 +142,36 @@ benchmark worst-case-analysis
140142
, Cardano.Ledger.Benchmarks.Update.WorstCaseAnalysis.Arithmetic
141143
, Cardano.Ledger.Benchmarks.Update.WorstCaseAnalysis.Units.TBPS
142144
, Cardano.Ledger.Benchmarks.Update.WorstCaseAnalysis.Report.LaTeX
145+
146+
147+
benchmark update-benchmarking
148+
hs-source-dirs: bench/micro-benchmarking
149+
main-is: Main.hs
150+
type: exitcode-stdio-1.0
151+
default-language: Haskell2010
152+
build-depends: base
153+
, cereal
154+
, containers
155+
, criterion
156+
, cryptonite
157+
, deepseq
158+
-- Dependencies needed for defining the bench hashing
159+
, cborg
160+
, bytestring
161+
, memory
162+
-- Cardano deps
163+
, cs-ledger
164+
, cardano-binary
165+
, cardano-crypto-class
166+
, decentralized-updates
167+
ghc-options: -Wall
168+
-Wcompat
169+
-Wincomplete-record-updates
170+
-Wincomplete-uni-patterns
171+
-Wredundant-constraints
172+
-- We have a map with up to 10M 32 bytes hashes, so we
173+
-- need a lot of heap.
174+
"-with-rtsopts=-K1m -M1500m"
175+
-threaded
176+
-rtsopts
177+
other-modules: Cardano.Ledger.Benchmarks.Update.Tally

executable-spec/src/Cardano/Ledger/Generators/QuickCheck.hs

Lines changed: 3 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -16,7 +16,6 @@ where
1616
import GHC.Exts (fromList)
1717

1818
import Control.Arrow ((&&&))
19-
import qualified Data.Map as Map
2019
import Data.Word (Word8)
2120
import System.Random (Random)
2221

@@ -30,8 +29,8 @@ import qualified Ledger.Core as Core
3029

3130
import Cardano.Ledger.Spec.State.Participants
3231
(Participants (Participants), vkeyHashes)
33-
import Cardano.Ledger.Spec.State.StakeDistribution
34-
(StakeDistribution (StakeDistribution))
32+
import Cardano.Ledger.Spec.State.StakeDistribution (StakeDistribution)
33+
import qualified Cardano.Ledger.Spec.State.StakeDistribution as StakeDistribution
3534
import qualified Cardano.Ledger.Spec.STS.Update.Data as Data
3635

3736
import Cardano.Ledger.Test.Mock (Mock)
@@ -99,7 +98,7 @@ stakeDist someParticipants = do
9998
stks <- Gen.oneof [ stakeDistUniform (length hashes)
10099
, stakeDistSkewed (length hashes)
101100
]
102-
pure $ StakeDistribution $ Map.fromList $ zip hashes stks
101+
pure $ StakeDistribution.fromList $ zip hashes stks
103102
where
104103
stakeDistUniform :: Int -> Gen [Data.Stake]
105104
stakeDistUniform n = Gen.vectorOf n (Gen.choose (1, 20))

0 commit comments

Comments
 (0)