Skip to content

Commit 4a549dd

Browse files
tbagrel1agustinmistaamesgengeo2anbacquey
committed
Add definitions and codec for PerasCert diffusion through ObjectDiffusion
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> Co-authored-by: Nicolas "Niols" Jeannerod <nicolas.jeannerod@moduscreate.com>
1 parent cd189cf commit 4a549dd

File tree

4 files changed

+188
-3
lines changed

4 files changed

+188
-3
lines changed

‎ouroboros-consensus/ouroboros-consensus.cabal‎

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -193,7 +193,9 @@ library
193193
Ouroboros.Consensus.MiniProtocol.LocalTxSubmission.Server
194194
Ouroboros.Consensus.MiniProtocol.ObjectDiffusion.Inbound
195195
Ouroboros.Consensus.MiniProtocol.ObjectDiffusion.ObjectPool.API
196+
Ouroboros.Consensus.MiniProtocol.ObjectDiffusion.ObjectPool.PerasCert
196197
Ouroboros.Consensus.MiniProtocol.ObjectDiffusion.Outbound
198+
Ouroboros.Consensus.MiniProtocol.ObjectDiffusion.PerasCert
197199
Ouroboros.Consensus.Node.GsmState
198200
Ouroboros.Consensus.Node.InitStorage
199201
Ouroboros.Consensus.Node.NetworkProtocolVersion

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

Lines changed: 108 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,108 @@
1+
{-# LANGUAGE GADTs #-}
2+
{-# LANGUAGE StandaloneDeriving #-}
3+
4+
-- | Instantiate 'ObjectPoolReader' and 'ObjectPoolWriter' using Peras
5+
-- certificates from the 'PerasCertDB' (or the 'ChainDB' which is wrapping the
6+
-- 'PerasCertDB').
7+
module Ouroboros.Consensus.MiniProtocol.ObjectDiffusion.ObjectPool.PerasCert
8+
( makePerasCertPoolReaderFromCertDB
9+
, makePerasCertPoolWriterFromCertDB
10+
, makePerasCertPoolReaderFromChainDB
11+
, makePerasCertPoolWriterFromChainDB
12+
) where
13+
14+
import qualified Data.Map as Map
15+
import GHC.Exception (throw)
16+
import Ouroboros.Consensus.Block
17+
import Ouroboros.Consensus.MiniProtocol.ObjectDiffusion.ObjectPool.API
18+
import Ouroboros.Consensus.Storage.ChainDB.API (ChainDB)
19+
import qualified Ouroboros.Consensus.Storage.ChainDB.API as ChainDB
20+
import Ouroboros.Consensus.Storage.PerasCertDB.API
21+
( PerasCertDB
22+
, PerasCertSnapshot
23+
, PerasCertTicketNo
24+
)
25+
import qualified Ouroboros.Consensus.Storage.PerasCertDB.API as PerasCertDB
26+
import Ouroboros.Consensus.Util.IOLike
27+
28+
makePerasCertPoolReaderFromSnapshot ::
29+
(IOLike m, StandardHash blk) =>
30+
STM m (PerasCertSnapshot blk) ->
31+
ObjectPoolReader PerasRoundNo (PerasCert blk) PerasCertTicketNo m
32+
makePerasCertPoolReaderFromSnapshot getCertSnapshot =
33+
ObjectPoolReader
34+
{ oprObjectId = getPerasCertRound
35+
, oprZeroTicketNo = PerasCertDB.zeroPerasCertTicketNo
36+
, oprObjectsAfter = \lastKnown limit -> do
37+
certSnapshot <- getCertSnapshot
38+
pure $
39+
take (fromIntegral limit) $
40+
[ (ticketNo, getPerasCertRound cert, pure (getPerasCert cert))
41+
| (ticketNo, cert) <-
42+
Map.toAscList $
43+
PerasCertDB.getCertsAfter certSnapshot lastKnown
44+
]
45+
}
46+
47+
makePerasCertPoolReaderFromCertDB ::
48+
(IOLike m, StandardHash blk) =>
49+
PerasCertDB m blk -> ObjectPoolReader PerasRoundNo (PerasCert blk) PerasCertTicketNo m
50+
makePerasCertPoolReaderFromCertDB perasCertDB =
51+
makePerasCertPoolReaderFromSnapshot (PerasCertDB.getCertSnapshot perasCertDB)
52+
53+
makePerasCertPoolWriterFromCertDB ::
54+
(StandardHash blk, IOLike m) =>
55+
PerasCertDB m blk -> ObjectPoolWriter PerasRoundNo (PerasCert blk) m
56+
makePerasCertPoolWriterFromCertDB perasCertDB =
57+
ObjectPoolWriter
58+
{ opwObjectId = getPerasCertRound
59+
, opwAddObjects = \certs -> do
60+
validatePerasCerts certs
61+
>>= mapM_ (PerasCertDB.addCert perasCertDB)
62+
, opwHasObject = do
63+
certSnapshot <- PerasCertDB.getCertSnapshot perasCertDB
64+
pure $ PerasCertDB.containsCert certSnapshot
65+
}
66+
67+
makePerasCertPoolReaderFromChainDB ::
68+
(IOLike m, StandardHash blk) =>
69+
ChainDB m blk -> ObjectPoolReader PerasRoundNo (PerasCert blk) PerasCertTicketNo m
70+
makePerasCertPoolReaderFromChainDB chainDB =
71+
makePerasCertPoolReaderFromSnapshot (ChainDB.getPerasCertSnapshot chainDB)
72+
73+
makePerasCertPoolWriterFromChainDB ::
74+
(StandardHash blk, IOLike m) =>
75+
ChainDB m blk -> ObjectPoolWriter PerasRoundNo (PerasCert blk) m
76+
makePerasCertPoolWriterFromChainDB chainDB =
77+
ObjectPoolWriter
78+
{ opwObjectId = getPerasCertRound
79+
, opwAddObjects = \certs -> do
80+
validatePerasCerts certs
81+
>>= mapM_ (ChainDB.addPerasCertAsync chainDB)
82+
, opwHasObject = do
83+
certSnapshot <- ChainDB.getPerasCertSnapshot chainDB
84+
pure $ PerasCertDB.containsCert certSnapshot
85+
}
86+
87+
data PerasCertInboundException
88+
= forall blk. PerasCertValidationError (PerasValidationErr blk)
89+
90+
deriving instance Show PerasCertInboundException
91+
92+
instance Exception PerasCertInboundException
93+
94+
-- | Validate a list of 'PerasCert's, throwing a 'PerasCertInboundException' if
95+
-- any of them are invalid.
96+
validatePerasCerts ::
97+
(StandardHash blk, MonadThrow m) =>
98+
[PerasCert blk] ->
99+
m [ValidatedPerasCert blk]
100+
validatePerasCerts certs = do
101+
let perasCfg = makePerasCfg Nothing
102+
-- TODO replace the mocked-up Nothing with a real
103+
-- 'BlockConfig' when all the plumbing is in place
104+
-- see https://github.com/tweag/cardano-peras/issues/73
105+
-- see https://github.com/tweag/cardano-peras/issues/120
106+
case traverse (validatePerasCert perasCfg) certs of
107+
Left validationErr -> throw (PerasCertValidationError validationErr)
108+
Right validatedCerts -> return validatedCerts

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

Lines changed: 41 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,41 @@
1+
-- | This module defines type aliases for the ObjectDiffusion protocol applied
2+
-- to PerasCert diffusion.
3+
module Ouroboros.Consensus.MiniProtocol.ObjectDiffusion.PerasCert
4+
( TracePerasCertDiffusionInbound
5+
, TracePerasCertDiffusionOutbound
6+
, PerasCertPoolReader
7+
, PerasCertPoolWriter
8+
, PerasCertDiffusionInboundPipelined
9+
, PerasCertDiffusionOutbound
10+
, PerasCertDiffusion
11+
) where
12+
13+
import Ouroboros.Consensus.Block
14+
import Ouroboros.Consensus.MiniProtocol.ObjectDiffusion.Inbound
15+
import Ouroboros.Consensus.MiniProtocol.ObjectDiffusion.ObjectPool.API
16+
import Ouroboros.Consensus.MiniProtocol.ObjectDiffusion.Outbound
17+
import Ouroboros.Consensus.Storage.PerasCertDB.API
18+
import Ouroboros.Network.Protocol.ObjectDiffusion.Inbound (ObjectDiffusionInboundPipelined)
19+
import Ouroboros.Network.Protocol.ObjectDiffusion.Outbound (ObjectDiffusionOutbound)
20+
import Ouroboros.Network.Protocol.ObjectDiffusion.Type (ObjectDiffusion)
21+
22+
type TracePerasCertDiffusionInbound blk =
23+
TraceObjectDiffusionInbound PerasRoundNo (PerasCert blk)
24+
25+
type TracePerasCertDiffusionOutbound blk =
26+
TraceObjectDiffusionOutbound PerasRoundNo (PerasCert blk)
27+
28+
type PerasCertPoolReader blk m =
29+
ObjectPoolReader PerasRoundNo (PerasCert blk) PerasCertTicketNo m
30+
31+
type PerasCertPoolWriter blk m =
32+
ObjectPoolWriter PerasRoundNo (PerasCert blk) m
33+
34+
type PerasCertDiffusionInboundPipelined blk m a =
35+
ObjectDiffusionInboundPipelined PerasRoundNo (PerasCert blk) m a
36+
37+
type PerasCertDiffusionOutbound blk m a =
38+
ObjectDiffusionOutbound PerasRoundNo (PerasCert blk) m a
39+
40+
type PerasCertDiffusion blk =
41+
ObjectDiffusion PerasRoundNo (PerasCert blk)

‎ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Node/Serialisation.hs‎

Lines changed: 37 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -6,8 +6,11 @@
66
{-# LANGUAGE MultiParamTypeClasses #-}
77
{-# LANGUAGE PolyKinds #-}
88
{-# LANGUAGE RankNTypes #-}
9+
{-# LANGUAGE RecordWildCards #-}
10+
{-# LANGUAGE ScopedTypeVariables #-}
911
{-# LANGUAGE StandaloneDeriving #-}
1012
{-# LANGUAGE StandaloneKindSignatures #-}
13+
{-# LANGUAGE TypeApplications #-}
1114
{-# LANGUAGE UndecidableInstances #-}
1215

1316
-- | Serialisation for sending things across the network.
@@ -33,8 +36,8 @@ module Ouroboros.Consensus.Node.Serialisation
3336
, Some (..)
3437
) where
3538

36-
import Codec.CBOR.Decoding (Decoder)
37-
import Codec.CBOR.Encoding (Encoding)
39+
import Codec.CBOR.Decoding (Decoder, decodeListLenOf)
40+
import Codec.CBOR.Encoding (Encoding, encodeListLen)
3841
import Codec.Serialise (Serialise (decode, encode))
3942
import Data.Kind
4043
import Data.SOP.BasicFunctors
@@ -47,7 +50,15 @@ import Ouroboros.Consensus.Ledger.SupportsMempool
4750
import Ouroboros.Consensus.Node.NetworkProtocolVersion
4851
import Ouroboros.Consensus.TypeFamilyWrappers
4952
import Ouroboros.Consensus.Util (Some (..))
50-
import Ouroboros.Network.Block (unwrapCBORinCBOR, wrapCBORinCBOR)
53+
import Ouroboros.Network.Block
54+
( Tip
55+
, decodePoint
56+
, decodeTip
57+
, encodePoint
58+
, encodeTip
59+
, unwrapCBORinCBOR
60+
, wrapCBORinCBOR
61+
)
5162

5263
{-------------------------------------------------------------------------------
5364
NodeToNode
@@ -173,6 +184,29 @@ deriving newtype instance
173184
SerialiseNodeToNode blk (GenTxId blk) =>
174185
SerialiseNodeToNode blk (WrapGenTxId blk)
175186

187+
instance ConvertRawHash blk => SerialiseNodeToNode blk (Point blk) where
188+
encodeNodeToNode _ccfg _version = encodePoint $ encodeRawHash (Proxy @blk)
189+
decodeNodeToNode _ccfg _version = decodePoint $ decodeRawHash (Proxy @blk)
190+
191+
instance ConvertRawHash blk => SerialiseNodeToNode blk (Tip blk) where
192+
encodeNodeToNode _ccfg _version = encodeTip $ encodeRawHash (Proxy @blk)
193+
decodeNodeToNode _ccfg _version = decodeTip $ decodeRawHash (Proxy @blk)
194+
195+
instance SerialiseNodeToNode blk PerasRoundNo where
196+
encodeNodeToNode _ccfg _version = encode
197+
decodeNodeToNode _ccfg _version = decode
198+
instance ConvertRawHash blk => SerialiseNodeToNode blk (PerasCert blk) where
199+
-- Consistent with the 'Serialise' instance for 'PerasCert' defined in Ouroboros.Consensus.Block.SupportsPeras
200+
encodeNodeToNode ccfg version PerasCert{..} =
201+
encodeListLen 2
202+
<> encodeNodeToNode ccfg version pcCertRound
203+
<> encodeNodeToNode ccfg version pcCertBoostedBlock
204+
decodeNodeToNode ccfg version = do
205+
decodeListLenOf 2
206+
pcCertRound <- decodeNodeToNode ccfg version
207+
pcCertBoostedBlock <- decodeNodeToNode ccfg version
208+
pure $ PerasCert pcCertRound pcCertBoostedBlock
209+
176210
deriving newtype instance
177211
SerialiseNodeToClient blk (GenTxId blk) =>
178212
SerialiseNodeToClient blk (WrapGenTxId blk)

0 commit comments

Comments
 (0)