Skip to content

Commit 5c3cc1a

Browse files
agustinmistaamesgengeo2atbagrel1nbacquey
committed
Wrap validated Peras certificates with arrival time
This commit wraps the existing ValidatedPerasCerts stored in the PerasCertDB with their corresponding arrival time. In addition, it adapts tests to use either a randomly generated arrival time, or (when appropriate) one generated by a monotonically increasing SystemTime. Co-authored-by: Agustin Mista <agustin.mista@moduscreate.com> Co-authored-by: Alexander Esgen <alexander.esgen@iohk.io> Co-authored-by: Georgy Lukyanov <georgy.lukyanov@iohk.io> Co-authored-by: Thomas BAGREL <thomas.bagrel@tweag.io> Co-authored-by: Nicolas BACQUEY <nicolas.bacquey@tweag.io>
1 parent 982d7f4 commit 5c3cc1a

File tree

17 files changed

+171
-61
lines changed

17 files changed

+171
-61
lines changed

ouroboros-consensus-diffusion/src/ouroboros-consensus-diffusion/Ouroboros/Consensus/Network/NodeToNode.hs

Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -263,6 +263,7 @@ mkHandlers
263263
, keepAliveRng
264264
, miniProtocolParameters
265265
, getDiffusionPipeliningSupport
266+
, systemTime
266267
}
267268
NodeKernel
268269
{ getChainDB
@@ -322,7 +323,7 @@ mkHandlers
322323
, 10 -- TODO: see https://github.com/tweag/cardano-peras/issues/97
323324
, 10 -- TODO: see https://github.com/tweag/cardano-peras/issues/97
324325
)
325-
(makePerasCertPoolWriterFromChainDB $ getChainDB)
326+
(makePerasCertPoolWriterFromChainDB systemTime getChainDB)
326327
version
327328
controlMessageSTM
328329
, hPerasCertDiffusionServer = \version peer ->

ouroboros-consensus-diffusion/src/ouroboros-consensus-diffusion/Ouroboros/Consensus/Node.hs

Lines changed: 4 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -578,6 +578,7 @@ runWith RunNodeArgs{..} encAddrNtN decAddrNtN LowLevelRunNodeArgs{..} =
578578
cfg
579579
rnTraceConsensus
580580
btime
581+
systemTime
581582
(InFutureCheck.realHeaderInFutureCheck llrnMaxClockSkew systemTime)
582583
historicityCheck
583584
chainDB
@@ -855,6 +856,7 @@ mkNodeKernelArgs ::
855856
TopLevelConfig blk ->
856857
Tracers m (ConnectionId addrNTN) (ConnectionId addrNTC) blk ->
857858
BlockchainTime m ->
859+
SystemTime m ->
858860
InFutureCheck.SomeHeaderInFutureCheck m blk ->
859861
(m GSM.GsmState -> HistoricityCheck m blk) ->
860862
ChainDB m blk ->
@@ -874,6 +876,7 @@ mkNodeKernelArgs
874876
cfg
875877
tracers
876878
btime
879+
systemTime
877880
chainSyncFutureCheck
878881
chainSyncHistoricityCheck
879882
chainDB
@@ -892,6 +895,7 @@ mkNodeKernelArgs
892895
, registry
893896
, cfg
894897
, btime
898+
, systemTime
895899
, chainDB
896900
, initChainDB = nodeInitChainDB
897901
, chainSyncFutureCheck

ouroboros-consensus-diffusion/src/ouroboros-consensus-diffusion/Ouroboros/Consensus/NodeKernel.hs

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -196,6 +196,7 @@ data NodeKernelArgs m addrNTN addrNTC blk = NodeKernelArgs
196196
, registry :: ResourceRegistry m
197197
, cfg :: TopLevelConfig blk
198198
, btime :: BlockchainTime m
199+
, systemTime :: SystemTime m
199200
, chainDB :: ChainDB m blk
200201
, initChainDB :: StorageConfig blk -> InitChainDB m blk -> m ()
201202
, chainSyncFutureCheck :: SomeHeaderInFutureCheck m blk

ouroboros-consensus-diffusion/src/unstable-diffusion-testlib/Test/ThreadNet/Network.hs

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -1046,6 +1046,7 @@ runThreadNetwork
10461046
, registry
10471047
, cfg = pInfoConfig
10481048
, btime
1049+
, systemTime
10491050
, chainDB
10501051
, initChainDB = nodeInitChainDB
10511052
, chainSyncFutureCheck =

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

Lines changed: 41 additions & 11 deletions
Original file line numberDiff line numberDiff line change
@@ -11,10 +11,17 @@ module Ouroboros.Consensus.MiniProtocol.ObjectDiffusion.ObjectPool.PerasCert
1111
, makePerasCertPoolWriterFromChainDB
1212
) where
1313

14+
import Control.Monad ((>=>))
1415
import Data.Map (Map)
1516
import qualified Data.Map as Map
1617
import GHC.Exception (throw)
1718
import Ouroboros.Consensus.Block
19+
import Ouroboros.Consensus.BlockchainTime (WithArrivalTime)
20+
import Ouroboros.Consensus.BlockchainTime.WallClock.Types
21+
( SystemTime (..)
22+
, WithArrivalTime (..)
23+
, addArrivalTime
24+
)
1825
import Ouroboros.Consensus.MiniProtocol.ObjectDiffusion.ObjectPool.API
1926
import Ouroboros.Consensus.Storage.ChainDB.API (ChainDB)
2027
import qualified Ouroboros.Consensus.Storage.ChainDB.API as ChainDB
@@ -43,7 +50,10 @@ makePerasCertPoolReaderFromSnapshot getCertSnapshot =
4350
let certsAfterLastKnown =
4451
PerasCertDB.getCertsAfter certSnapshot lastKnown
4552
let loadCertsAfterLastKnown =
46-
pure (vpcCert <$> takeAscMap (fromIntegral limit) certsAfterLastKnown)
53+
pure $
54+
fmap
55+
(vpcCert . forgetArrivalTime)
56+
(takeAscMap (fromIntegral limit) certsAfterLastKnown)
4757
pure $
4858
if Map.null certsAfterLastKnown
4959
then Nothing
@@ -58,13 +68,13 @@ makePerasCertPoolReaderFromCertDB perasCertDB =
5868

5969
makePerasCertPoolWriterFromCertDB ::
6070
(StandardHash blk, IOLike m) =>
61-
PerasCertDB m blk -> ObjectPoolWriter PerasRoundNo (PerasCert blk) m
62-
makePerasCertPoolWriterFromCertDB perasCertDB =
71+
SystemTime m ->
72+
PerasCertDB m blk ->
73+
ObjectPoolWriter PerasRoundNo (PerasCert blk) m
74+
makePerasCertPoolWriterFromCertDB systemTime perasCertDB =
6375
ObjectPoolWriter
6476
{ opwObjectId = getPerasCertRound
65-
, opwAddObjects = \certs -> do
66-
validatePerasCerts certs
67-
>>= mapM_ (PerasCertDB.addCert perasCertDB)
77+
, opwAddObjects = addPerasCerts systemTime (PerasCertDB.addCert perasCertDB)
6878
, opwHasObject = do
6979
certSnapshot <- PerasCertDB.getCertSnapshot perasCertDB
7080
pure $ PerasCertDB.containsCert certSnapshot
@@ -78,13 +88,13 @@ makePerasCertPoolReaderFromChainDB chainDB =
7888

7989
makePerasCertPoolWriterFromChainDB ::
8090
(StandardHash blk, IOLike m) =>
81-
ChainDB m blk -> ObjectPoolWriter PerasRoundNo (PerasCert blk) m
82-
makePerasCertPoolWriterFromChainDB chainDB =
91+
SystemTime m ->
92+
ChainDB m blk ->
93+
ObjectPoolWriter PerasRoundNo (PerasCert blk) m
94+
makePerasCertPoolWriterFromChainDB systemTime chainDB =
8395
ObjectPoolWriter
8496
{ opwObjectId = getPerasCertRound
85-
, opwAddObjects = \certs -> do
86-
validatePerasCerts certs
87-
>>= mapM_ (ChainDB.addPerasCertAsync chainDB)
97+
, opwAddObjects = addPerasCerts systemTime (ChainDB.addPerasCertAsync chainDB)
8898
, opwHasObject = do
8999
certSnapshot <- ChainDB.getPerasCertSnapshot chainDB
90100
pure $ PerasCertDB.containsCert certSnapshot
@@ -112,3 +122,23 @@ validatePerasCerts certs = do
112122
case traverse (validatePerasCert perasCfg) certs of
113123
Left validationErr -> throw (PerasCertValidationError validationErr)
114124
Right validatedCerts -> return validatedCerts
125+
126+
-- | Add a list of 'PerasCert's into an object pool.
127+
--
128+
-- NOTE: we first validate the certificates, throwing an exception if any of
129+
-- them are invalid. We then wrap them with their arrival time, and finally add
130+
-- them to the pool using the provided adder function.
131+
--
132+
-- The order of the first two operations (i.e., validation and timestamping) are
133+
-- rather arbitrary, and the abstract Peras protocol just assumes it can happen
134+
-- "within" a slot.
135+
addPerasCerts ::
136+
(StandardHash blk, MonadThrow m) =>
137+
SystemTime m ->
138+
(WithArrivalTime (ValidatedPerasCert blk) -> m a) ->
139+
[PerasCert blk] ->
140+
m ()
141+
addPerasCerts systemTime adder = do
142+
validatePerasCerts
143+
>=> mapM (addArrivalTime systemTime)
144+
>=> mapM_ adder

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

Lines changed: 3 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -81,6 +81,7 @@ import Control.ResourceRegistry
8181
import Data.Typeable (Typeable)
8282
import GHC.Generics (Generic)
8383
import Ouroboros.Consensus.Block
84+
import Ouroboros.Consensus.BlockchainTime.WallClock.Types (WithArrivalTime)
8485
import Ouroboros.Consensus.HeaderStateHistory
8586
( HeaderStateHistory (..)
8687
)
@@ -396,7 +397,7 @@ data ChainDB m blk = ChainDB
396397
, getStatistics :: m (Maybe Statistics)
397398
-- ^ Get statistics from the LedgerDB, in particular the number of entries
398399
-- in the tables.
399-
, addPerasCertAsync :: ValidatedPerasCert blk -> m (AddPerasCertPromise m)
400+
, addPerasCertAsync :: WithArrivalTime (ValidatedPerasCert blk) -> m (AddPerasCertPromise m)
400401
-- ^ Asynchronously insert a certificate to the DB. If this leads to a fork to
401402
-- be weightier than our current selection, this will trigger a fork switch.
402403
, getPerasWeightSnapshot :: STM m (WithFingerprint (PerasWeightSnapshot blk))
@@ -537,7 +538,7 @@ newtype AddPerasCertPromise m = AddPerasCertPromise
537538
-- impossible).
538539
}
539540

540-
addPerasCertSync :: IOLike m => ChainDB m blk -> ValidatedPerasCert blk -> m ()
541+
addPerasCertSync :: IOLike m => ChainDB m blk -> WithArrivalTime (ValidatedPerasCert blk) -> m ()
541542
addPerasCertSync chainDB cert =
542543
waitPerasCertProcessed =<< addPerasCertAsync chainDB cert
543544

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

Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -45,6 +45,7 @@ import qualified Data.Set as Set
4545
import Data.Traversable (for)
4646
import GHC.Stack (HasCallStack)
4747
import Ouroboros.Consensus.Block
48+
import Ouroboros.Consensus.BlockchainTime.WallClock.Types (WithArrivalTime)
4849
import Ouroboros.Consensus.Config
4950
import Ouroboros.Consensus.Fragment.Diff (ChainDiff (..))
5051
import qualified Ouroboros.Consensus.Fragment.Diff as Diff
@@ -328,7 +329,7 @@ addPerasCertAsync ::
328329
forall m blk.
329330
IOLike m =>
330331
ChainDbEnv m blk ->
331-
ValidatedPerasCert blk ->
332+
WithArrivalTime (ValidatedPerasCert blk) ->
332333
m (AddPerasCertPromise m)
333334
addPerasCertAsync CDB{cdbTracer, cdbChainSelQueue} =
334335
addPerasCertToQueue (TraceAddPerasCertEvent >$< cdbTracer) cdbChainSelQueue

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

Lines changed: 3 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -94,6 +94,7 @@ import Data.Word (Word64)
9494
import GHC.Generics (Generic)
9595
import NoThunks.Class (OnlyCheckWhnfNamed (..))
9696
import Ouroboros.Consensus.Block
97+
import Ouroboros.Consensus.BlockchainTime.WallClock.Types (WithArrivalTime)
9798
import Ouroboros.Consensus.Config
9899
import Ouroboros.Consensus.Fragment.Diff (ChainDiff)
99100
import Ouroboros.Consensus.HeaderValidation (HeaderWithTime (..))
@@ -553,7 +554,7 @@ data ChainSelMessage m blk
553554
ChainSelAddBlock !(BlockToAdd m blk)
554555
| -- | Add a Peras certificate
555556
ChainSelAddPerasCert
556-
!(ValidatedPerasCert blk)
557+
!(WithArrivalTime (ValidatedPerasCert blk))
557558
-- | Used for 'AddPerasCertPromise'.
558559
!(StrictTMVar m ())
559560
| -- | Reprocess blocks that have been postponed by the LoE.
@@ -609,7 +610,7 @@ addPerasCertToQueue ::
609610
IOLike m =>
610611
Tracer m (TraceAddPerasCertEvent blk) ->
611612
ChainSelQueue m blk ->
612-
ValidatedPerasCert blk ->
613+
WithArrivalTime (ValidatedPerasCert blk) ->
613614
m (AddPerasCertPromise m)
614615
addPerasCertToQueue tracer ChainSelQueue{varChainSelQueue} cert = do
615616
varProcessed <- newEmptyTMVarIO

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

Lines changed: 5 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -17,12 +17,13 @@ import Data.Map (Map)
1717
import Data.Word (Word64)
1818
import NoThunks.Class
1919
import Ouroboros.Consensus.Block
20+
import Ouroboros.Consensus.BlockchainTime.WallClock.Types (WithArrivalTime)
2021
import Ouroboros.Consensus.Peras.Weight
2122
import Ouroboros.Consensus.Util.IOLike
2223
import Ouroboros.Consensus.Util.STM (WithFingerprint (..))
2324

2425
data PerasCertDB m blk = PerasCertDB
25-
{ addCert :: ValidatedPerasCert blk -> m AddPerasCertResult
26+
{ addCert :: WithArrivalTime (ValidatedPerasCert blk) -> m AddPerasCertResult
2627
-- ^ Add a Peras certificate to the database. The result indicates whether
2728
-- the certificate was actually added, or if it was already present.
2829
, getWeightSnapshot :: STM m (WithFingerprint (PerasWeightSnapshot blk))
@@ -46,7 +47,9 @@ data AddPerasCertResult = AddedPerasCertToDB | PerasCertAlreadyInDB
4647
data PerasCertSnapshot blk = PerasCertSnapshot
4748
{ containsCert :: PerasRoundNo -> Bool
4849
-- ^ Do we have the certificate for this round?
49-
, getCertsAfter :: PerasCertTicketNo -> Map PerasCertTicketNo (ValidatedPerasCert blk)
50+
, getCertsAfter ::
51+
PerasCertTicketNo ->
52+
Map PerasCertTicketNo (WithArrivalTime (ValidatedPerasCert blk))
5053
-- ^ Get certificates after the given ticket number (excluded).
5154
-- The result is a map of ticket numbers to validated certificates.
5255
}

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

Lines changed: 6 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -32,6 +32,7 @@ import qualified Data.Set as Set
3232
import GHC.Generics (Generic)
3333
import NoThunks.Class
3434
import Ouroboros.Consensus.Block
35+
import Ouroboros.Consensus.BlockchainTime.WallClock.Types (WithArrivalTime)
3536
import Ouroboros.Consensus.Peras.Weight
3637
import Ouroboros.Consensus.Storage.PerasCertDB.API
3738
import Ouroboros.Consensus.Util.Args
@@ -152,7 +153,7 @@ implAddCert ::
152153
, StandardHash blk
153154
) =>
154155
PerasCertDbEnv m blk ->
155-
ValidatedPerasCert blk ->
156+
WithArrivalTime (ValidatedPerasCert blk) ->
156157
m AddPerasCertResult
157158
implAddCert env cert = do
158159
traceWith pcdbTracer $ AddingPerasCert roundNo boostedPt
@@ -255,11 +256,13 @@ implGarbageCollect PerasCertDbEnv{pcdbVolatileState} slot =
255256
--
256257
-- INVARIANT: See 'invariantForPerasVolatileCertState'.
257258
data PerasVolatileCertState blk = PerasVolatileCertState
258-
{ pvcsCerts :: !(Map PerasRoundNo (ValidatedPerasCert blk))
259+
{ pvcsCerts :: !(Map PerasRoundNo (WithArrivalTime (ValidatedPerasCert blk)))
259260
-- ^ The boosted blocks by 'RoundNo' of all certificates currently in the db.
260261
, pvcsWeightByPoint :: !(PerasWeightSnapshot blk)
261262
-- ^ The weight of boosted blocks w.r.t. the certificates currently in the db.
262-
, pvcsCertsByTicket :: !(Map PerasCertTicketNo (ValidatedPerasCert blk))
263+
--
264+
-- INVARIANT: In sync with 'pvcsCerts'.
265+
, pvcsCertsByTicket :: !(Map PerasCertTicketNo (WithArrivalTime (ValidatedPerasCert blk)))
263266
-- ^ The certificates by 'PerasCertTicketNo'.
264267
, pvcsLastTicketNo :: !PerasCertTicketNo
265268
-- ^ The most recent 'PerasCertTicketNo' (or 'zeroPerasCertTicketNo'

0 commit comments

Comments
 (0)