Skip to content

Commit 346d9cd

Browse files
committed
Wrap validated Peras certificates with arrival time
1 parent 94b6036 commit 346d9cd

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)