Skip to content

Commit c5beff6

Browse files
agustinmistaagustinmista
committed
Propagate changes from PerasCert to ValidatedPerasCert
1 parent 3425d67 commit c5beff6

File tree

15 files changed

+108
-63
lines changed

15 files changed

+108
-63
lines changed

‎ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Block/SupportsPeras.hs

Lines changed: 10 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -14,6 +14,8 @@ module Ouroboros.Consensus.Block.SupportsPeras
1414
, boostPerCert
1515
, BlockSupportsPeras (..)
1616
, PerasCert (..)
17+
, ValidatedPerasCert (..)
18+
, defaultPerasCfg
1719
) where
1820

1921
import Data.Monoid (Sum (..))
@@ -50,7 +52,8 @@ data ValidatedPerasCert blk = ValidatedPerasCert
5052
{ validatedPerasCert :: !(PerasCert blk)
5153
, validatedPerasCertBoost :: !PerasWeight
5254
}
53-
deriving stock (Show, Eq)
55+
deriving stock (Show, Eq, Ord, Generic)
56+
deriving anyclass NoThunks
5457

5558
class
5659
( Show (PerasCfg blk)
@@ -97,16 +100,20 @@ instance StandardHash blk => BlockSupportsPeras blk where
97100
PerasRoundNo
98101
-- round of cert
99102
PerasRoundNo
103+
deriving stock (Show, Eq)
100104

101105
perasCertRound = pcCertRound
102106
perasCertBoostedBlock = pcCertBoostedBlock
103107

104108
validatePerasCert cfg curRound cert
105-
| perasCertRound cert > curRound =
106-
Left $ PerasInFuture curRound (perasCertRound cert)
109+
| pcCertRound cert > curRound =
110+
Left $ PerasInFuture curRound (pcCertRound cert)
107111
| otherwise =
108112
Right
109113
ValidatedPerasCert
110114
{ validatedPerasCert = cert
111115
, validatedPerasCertBoost = perasCfgWeightBoost cfg
112116
}
117+
118+
defaultPerasCfg :: PerasCfg blk
119+
defaultPerasCfg = PerasCfg {perasCfgWeightBoost = boostPerCert}

‎ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/MiniProtocol/ObjectDiffusion/ObjectPool/PerasCert.hs

Lines changed: 16 additions & 10 deletions
Original file line numberDiff line numberDiff line change
@@ -19,36 +19,37 @@ import Ouroboros.Consensus.Storage.PerasCertDB.API
1919
)
2020
import qualified Ouroboros.Consensus.Storage.PerasCertDB.API as PerasCertDB
2121
import Ouroboros.Consensus.Util.IOLike
22+
import GHC.Exception (throw)
2223

2324
makePerasCertPoolReaderFromSnapshot ::
2425
(IOLike m, StandardHash blk) =>
2526
STM m (PerasCertSnapshot blk) ->
26-
ObjectPoolReader PerasRoundNo (PerasCert blk) PerasCertTicketNo m
27+
ObjectPoolReader PerasRoundNo (ValidatedPerasCert blk) PerasCertTicketNo m
2728
makePerasCertPoolReaderFromSnapshot getCertSnapshot =
2829
ObjectPoolReader
29-
{ oprObjectId = perasCertRound
30+
{ oprObjectId = perasCertRound . validatedPerasCert
3031
, oprZeroTicketNo = PerasCertDB.zeroPerasCertTicketNo
3132
, oprObjectsAfter = \lastKnown limit -> do
3233
certSnapshot <- getCertSnapshot
3334
pure $
3435
take (fromIntegral limit) $
35-
[ (ticketNo, perasCertRound cert, pure cert)
36+
[ (ticketNo, perasCertRound (validatedPerasCert cert), pure cert)
3637
| (cert, ticketNo) <- PerasCertDB.getCertsAfter certSnapshot lastKnown
3738
]
3839
}
3940

4041
makePerasCertPoolReaderFromCertDB ::
4142
(IOLike m, StandardHash blk) =>
42-
PerasCertDB m blk -> ObjectPoolReader PerasRoundNo (PerasCert blk) PerasCertTicketNo m
43+
PerasCertDB m blk -> ObjectPoolReader PerasRoundNo (ValidatedPerasCert blk) PerasCertTicketNo m
4344
makePerasCertPoolReaderFromCertDB perasCertDB =
4445
makePerasCertPoolReaderFromSnapshot (PerasCertDB.getCertSnapshot perasCertDB)
4546

4647
makePerasCertPoolWriterFromCertDB ::
4748
(StandardHash blk, MonadSTM m) =>
48-
PerasCertDB m blk -> ObjectPoolWriter PerasRoundNo (PerasCert blk) m
49+
PerasCertDB m blk -> ObjectPoolWriter PerasRoundNo (ValidatedPerasCert blk) m
4950
makePerasCertPoolWriterFromCertDB perasCertDB =
5051
ObjectPoolWriter
51-
{ opwObjectId = perasCertRound
52+
{ opwObjectId = perasCertRound . validatedPerasCert
5253
, opwAddObjects =
5354
mapM_ $ PerasCertDB.addCert perasCertDB
5455
, opwHasObject = do
@@ -58,7 +59,7 @@ makePerasCertPoolWriterFromCertDB perasCertDB =
5859

5960
makePerasCertPoolReaderFromChainDB ::
6061
(IOLike m, StandardHash blk) =>
61-
ChainDB m blk -> ObjectPoolReader PerasRoundNo (PerasCert blk) PerasCertTicketNo m
62+
ChainDB m blk -> ObjectPoolReader PerasRoundNo (ValidatedPerasCert blk) PerasCertTicketNo m
6263
makePerasCertPoolReaderFromChainDB chainDB =
6364
makePerasCertPoolReaderFromSnapshot (ChainDB.getPerasCertSnapshot chainDB)
6465

@@ -69,9 +70,14 @@ makePerasCertPoolWriterFromChainDB chainDB =
6970
ObjectPoolWriter
7071
{ opwObjectId = perasCertRound
7172
, opwAddObjects = \certs -> do
72-
-- TODO validate certificates, throwing an exception if it fails,
73-
-- disconnecting from the peer
74-
mapM_ (ChainDB.addPerasCertAsync chainDB) certs
73+
let perasRoundNo = PerasRoundNo 999
74+
-- TODO ^ not the value we want, but the value we have
75+
case sequence (validatePerasCert defaultPerasCfg perasRoundNo <$> certs) of
76+
Left validationError ->
77+
throw (userError (show validationError))
78+
-- TODO ^ refine this exception
79+
Right validatedCerts ->
80+
mapM_ (ChainDB.addPerasCertAsync chainDB) validatedCerts
7581
, opwHasObject = do
7682
certSnapshot <- atomically $ ChainDB.getPerasCertSnapshot chainDB
7783
pure $ PerasCertDB.containsCert certSnapshot

‎ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/MiniProtocol/ObjectDiffusion/PerasCert.hs

Lines changed: 3 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -21,10 +21,10 @@ type TracePerasCertDiffusionInbound blk =
2121
TraceObjectDiffusionInbound PerasRoundNo (PerasCert blk)
2222

2323
type TracePerasCertDiffusionOutbound blk =
24-
TraceObjectDiffusionOutbound PerasRoundNo (PerasCert blk)
24+
TraceObjectDiffusionOutbound PerasRoundNo (ValidatedPerasCert blk)
2525

2626
type PerasCertPoolReader blk m =
27-
ObjectPoolReader PerasRoundNo (PerasCert blk) PerasCertTicketNo m
27+
ObjectPoolReader PerasRoundNo (ValidatedPerasCert blk) PerasCertTicketNo m
2828

2929
type PerasCertPoolWriter blk m =
3030
ObjectPoolWriter PerasRoundNo (PerasCert blk) m
@@ -33,4 +33,4 @@ type PerasCertDiffusionInboundPipelined blk m a =
3333
ObjectDiffusionInboundPipelined PerasRoundNo (PerasCert blk) m a
3434

3535
type PerasCertDiffusionOutbound blk m a =
36-
ObjectDiffusionOutbound PerasRoundNo (PerasCert blk) m a
36+
ObjectDiffusionOutbound PerasRoundNo (ValidatedPerasCert blk) m a

‎ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/ChainDB/API.hs

Lines changed: 2 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -392,9 +392,8 @@ data ChainDB m blk = ChainDB
392392
, getStatistics :: m (Maybe Statistics)
393393
-- ^ Get statistics from the LedgerDB, in particular the number of entries
394394
-- in the tables.
395-
, addPerasCertAsync :: PerasCert blk -> m (AddPerasCertPromise m)
395+
, addPerasCertAsync :: ValidatedPerasCert blk -> m (AddPerasCertPromise m)
396396
-- ^ TODO docs
397-
-- TODO take a 'ValidatedPerasCert'
398397
, getPerasWeightSnapshot :: STM m (WithFingerprint (PerasWeightSnapshot blk))
399398
-- ^ TODO
400399
, getPerasCertSnapshot :: STM m (PerasCertSnapshot blk)
@@ -531,7 +530,7 @@ newtype AddPerasCertPromise m = AddPerasCertPromise
531530
-- impossible).
532531
}
533532

534-
addPerasCertSync :: IOLike m => ChainDB m blk -> PerasCert blk -> m ()
533+
addPerasCertSync :: IOLike m => ChainDB m blk -> ValidatedPerasCert blk -> m ()
535534
addPerasCertSync chainDB cert =
536535
waitPerasCertProcessed =<< addPerasCertAsync chainDB cert
537536

‎ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/ChainDB/Impl/Background.hs

Lines changed: 3 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -647,7 +647,9 @@ addBlockRunner fuse cdb@CDB{..} = forever $ do
647647
ChainSelAddPerasCert cert _varProcessed ->
648648
traceWith cdbTracer $
649649
TraceAddPerasCertEvent $
650-
PoppedPerasCertFromQueue (perasCertRound cert) (perasCertBoostedBlock cert)
650+
PoppedPerasCertFromQueue
651+
(perasCertRound (validatedPerasCert cert))
652+
(perasCertBoostedBlock (validatedPerasCert cert))
651653
chainSelSync cdb message
652654
lift $ atomically $ processedChainSelMessage cdbChainSelQueue message
653655
)

‎ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/ChainDB/Impl/ChainSel.hs

Lines changed: 3 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -331,7 +331,7 @@ addPerasCertAsync ::
331331
forall m blk.
332332
(IOLike m, HasHeader blk) =>
333333
ChainDbEnv m blk ->
334-
PerasCert blk ->
334+
ValidatedPerasCert blk ->
335335
m (AddPerasCertPromise m)
336336
addPerasCertAsync CDB{cdbTracer, cdbChainSelQueue} =
337337
addPerasCertToQueue (TraceAddPerasCertEvent >$< cdbTracer) cdbChainSelQueue
@@ -529,10 +529,10 @@ chainSelSync cdb@CDB{..} (ChainSelAddPerasCert cert varProcessed) = do
529529
tracer = TraceAddPerasCertEvent >$< cdbTracer
530530

531531
certRound :: PerasRoundNo
532-
certRound = perasCertRound cert
532+
certRound = perasCertRound (validatedPerasCert cert)
533533

534534
boostedBlock :: Point blk
535-
boostedBlock = perasCertBoostedBlock cert
535+
boostedBlock = perasCertBoostedBlock (validatedPerasCert cert)
536536

537537
-- | Return 'True' when the given header should be ignored when adding it
538538
-- because it is too old, i.e., we wouldn't be able to switch to a chain

‎ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/ChainDB/Impl/Types.hs

Lines changed: 5 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -553,7 +553,7 @@ data ChainSelMessage m blk
553553
ChainSelAddBlock !(BlockToAdd m blk)
554554
| -- | Add a Peras certificate
555555
ChainSelAddPerasCert
556-
!(PerasCert blk)
556+
!(ValidatedPerasCert blk)
557557
-- | Used for 'AddPerasCertPromise'.
558558
!(StrictTMVar m ())
559559
| -- | Reprocess blocks that have been postponed by the LoE.
@@ -609,7 +609,7 @@ addPerasCertToQueue ::
609609
(IOLike m, StandardHash blk) =>
610610
Tracer m (TraceAddPerasCertEvent blk) ->
611611
ChainSelQueue m blk ->
612-
PerasCert blk ->
612+
ValidatedPerasCert blk ->
613613
m (AddPerasCertPromise m)
614614
addPerasCertToQueue tracer ChainSelQueue{varChainSelQueue} cert = do
615615
varProcessed <- newEmptyTMVarIO
@@ -624,7 +624,9 @@ addPerasCertToQueue tracer ChainSelQueue{varChainSelQueue} cert = do
624624
}
625625
where
626626
addedToQueue =
627-
AddedPerasCertToQueue (perasCertRound cert) (perasCertBoostedBlock cert)
627+
AddedPerasCertToQueue
628+
(perasCertRound (validatedPerasCert cert))
629+
(perasCertBoostedBlock (validatedPerasCert cert))
628630

629631
-- | Try to add blocks again that were postponed due to the LoE.
630632
addReprocessLoEBlocks ::

‎ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/PerasCertDB/API.hs

Lines changed: 2 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -21,9 +21,8 @@ import Ouroboros.Consensus.Util.IOLike
2121
import Ouroboros.Consensus.Util.STM (WithFingerprint (..))
2222

2323
data PerasCertDB m blk = PerasCertDB
24-
{ addCert :: PerasCert blk -> m AddPerasCertResult
24+
{ addCert :: ValidatedPerasCert blk -> m AddPerasCertResult
2525
-- ^ TODO docs
26-
-- TODO use 'ValidatedPerasCert'.
2726
, getWeightSnapshot :: STM m (WithFingerprint (PerasWeightSnapshot blk))
2827
-- ^ Return the Peras weights in order compare the current selection against
2928
-- potential candidate chains, namely the weights for blocks not older than
@@ -46,7 +45,7 @@ data AddPerasCertResult = AddedPerasCertToDB | PerasCertAlreadyInDB
4645
data PerasCertSnapshot blk = PerasCertSnapshot
4746
{ containsCert :: PerasRoundNo -> Bool
4847
-- ^ Do we have the certificate for this round?
49-
, getCertsAfter :: PerasCertTicketNo -> [(PerasCert blk, PerasCertTicketNo)]
48+
, getCertsAfter :: PerasCertTicketNo -> [(ValidatedPerasCert blk, PerasCertTicketNo)]
5049
}
5150

5251
-- TODO: Once we store historical certificates on disk, this should (also) track

‎ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/PerasCertDB/Impl.hs

Lines changed: 16 additions & 12 deletions
Original file line numberDiff line numberDiff line change
@@ -144,7 +144,7 @@ implAddCert ::
144144
, StandardHash blk
145145
) =>
146146
PerasCertDbEnv m blk ->
147-
PerasCert blk ->
147+
ValidatedPerasCert blk ->
148148
m AddPerasCertResult
149149
implAddCert env cert = do
150150
traceWith pcdbTracer $ AddingPerasCert roundNo boostedPt
@@ -186,25 +186,27 @@ implAddCert env cert = do
186186
, pcdbVolatileState
187187
} = env
188188

189-
roundNo = perasCertRound cert
190-
boostedPt = perasCertBoostedBlock cert
189+
boostedPt = perasCertBoostedBlock (validatedPerasCert cert)
190+
roundNo = perasCertRound (validatedPerasCert cert)
191191

192192
implGetWeightSnapshot ::
193193
IOLike m =>
194-
PerasCertDbEnv m blk -> STM m (WithFingerprint (PerasWeightSnapshot blk))
194+
PerasCertDbEnv m blk ->
195+
STM m (WithFingerprint (PerasWeightSnapshot blk))
195196
implGetWeightSnapshot PerasCertDbEnv{pcdbVolatileState} =
196197
fmap pvcsWeightByPoint <$> readTVar pcdbVolatileState
197198

198199
implGetCertSnapshot ::
199200
IOLike m =>
200-
PerasCertDbEnv m blk -> STM m (PerasCertSnapshot blk)
201+
PerasCertDbEnv m blk ->
202+
STM m (PerasCertSnapshot blk)
201203
implGetCertSnapshot PerasCertDbEnv{pcdbVolatileState} =
202204
readTVar pcdbVolatileState
203205
<&> forgetFingerprint
204206
<&> \PerasVolatileCertState
205-
{ pvcsCerts
206-
, pvcsCertsByTicket
207-
} ->
207+
{ pvcsCerts
208+
, pvcsCertsByTicket
209+
} ->
208210
PerasCertSnapshot
209211
{ containsCert = \r -> Map.member r pvcsCerts
210212
, getCertsAfter = \ticketNo ->
@@ -215,7 +217,9 @@ implGetCertSnapshot PerasCertDbEnv{pcdbVolatileState} =
215217
implGarbageCollect ::
216218
forall m blk.
217219
(IOLike m, StandardHash blk) =>
218-
PerasCertDbEnv m blk -> SlotNo -> m ()
220+
PerasCertDbEnv m blk ->
221+
SlotNo ->
222+
m ()
219223
implGarbageCollect PerasCertDbEnv{pcdbVolatileState} slot =
220224
-- No need to update the 'Fingerprint' as we only remove certificates that do
221225
-- not matter for comparing interesting chains.
@@ -237,7 +241,7 @@ implGarbageCollect PerasCertDbEnv{pcdbVolatileState} slot =
237241
}
238242
where
239243
keepCert cert =
240-
pointSlot (perasCertBoostedBlock cert) >= NotOrigin slot
244+
pointSlot (perasCertBoostedBlock (validatedPerasCert cert)) >= NotOrigin slot
241245

242246
{-------------------------------------------------------------------------------
243247
Implementation-internal types
@@ -246,13 +250,13 @@ implGarbageCollect PerasCertDbEnv{pcdbVolatileState} slot =
246250
-- | Volatile Peras certificate state, i.e. certificates that could influence
247251
-- chain selection by boosting a volatile block.
248252
data PerasVolatileCertState blk = PerasVolatileCertState
249-
{ pvcsCerts :: !(Map PerasRoundNo (PerasCert blk))
253+
{ pvcsCerts :: !(Map PerasRoundNo (ValidatedPerasCert blk))
250254
-- ^ The boosted blocks by 'RoundNo' of all certificates currently in the db.
251255
, pvcsWeightByPoint :: !(PerasWeightSnapshot blk)
252256
-- ^ The weight of boosted blocks w.r.t. the certificates currently in the db.
253257
--
254258
-- INVARIANT: In sync with 'pvcsCerts'.
255-
, pvcsCertsByTicket :: !(Map PerasCertTicketNo (PerasCert blk))
259+
, pvcsCertsByTicket :: !(Map PerasCertTicketNo (ValidatedPerasCert blk))
256260
-- ^ The certificates by 'PerasCertTicketNo'.
257261
--
258262
-- INVARIANT: In sync with 'pvcsCerts'.

‎ouroboros-consensus/src/unstable-consensus-testlib/Test/Util/Orphans/ToExpr.hs

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -125,6 +125,8 @@ deriving anyclass instance ToExpr PerasWeight
125125

126126
deriving anyclass instance ToExpr (HeaderHash blk) => ToExpr (PerasCert blk)
127127

128+
deriving anyclass instance ToExpr (HeaderHash blk) => ToExpr (ValidatedPerasCert blk)
129+
128130
{-------------------------------------------------------------------------------
129131
si-timers
130132
--------------------------------------------------------------------------------}

0 commit comments

Comments
 (0)