First attempt adding codec for PerasCertDiffusion

Move encode/decode functions for certs to proper file

Author: tbagrel1

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

@@ -128,6 +128,10 @@ import Ouroboros.Network.Protocol.KeepAlive.Client
 import Ouroboros.Network.Protocol.KeepAlive.Codec
 import Ouroboros.Network.Protocol.KeepAlive.Server
 import Ouroboros.Network.Protocol.KeepAlive.Type
+import Ouroboros.Network.Protocol.ObjectDiffusion.Codec
+  ( codecObjectDiffusion
+  , codecObjectDiffusionId
+  )
 import Ouroboros.Network.Protocol.PeerSharing.Client
   ( PeerSharingClient
   , peerSharingClientPeer
@@ -337,14 +341,15 @@ mkHandlers
 -------------------------------------------------------------------------------}
 
 -- | Node-to-node protocol codecs needed to run 'Handlers'.
-data Codecs blk addr e m bCS bSCS bBF bSBF bTX bKA bPS = Codecs
+data Codecs blk addr e m bCS bSCS bBF bSBF bTX bPCD bKA bPS = Codecs
   { cChainSyncCodec :: Codec (ChainSync (Header blk) (Point blk) (Tip blk)) e m bCS
   , cChainSyncCodecSerialised ::
       Codec (ChainSync (SerialisedHeader blk) (Point blk) (Tip blk)) e m bSCS
   , cBlockFetchCodec :: Codec (BlockFetch blk (Point blk)) e m bBF
   , cBlockFetchCodecSerialised ::
       Codec (BlockFetch (Serialised blk) (Point blk)) e m bSBF
   , cTxSubmission2Codec :: Codec (TxSubmission2 (GenTxId blk) (GenTx blk)) e m bTX
+  , cPerasCertDiffusionCodec :: Codec (PerasCertDiffusion blk) e m bPCD
   , cKeepAliveCodec :: Codec KeepAlive e m bKA
   , cPeerSharingCodec :: Codec (PeerSharing addr) e m bPS
   }
@@ -372,6 +377,7 @@ defaultCodecs ::
     ByteString
     ByteString
     ByteString
+    ByteString
 defaultCodecs ccfg version encAddr decAddr nodeToNodeVersion =
   Codecs
     { cChainSyncCodec =
@@ -408,6 +414,12 @@ defaultCodecs ccfg version encAddr decAddr nodeToNodeVersion =
           dec
           enc
           dec
+    , cPerasCertDiffusionCodec =
+        codecObjectDiffusion
+          encodePerasRoundNo
+          decodePerasRoundNo
+          (encodePerasCert p)
+          (decodePerasCert p)
     , cKeepAliveCodec = codecKeepAlive_v2
     , cPeerSharingCodec = codecPeerSharing (encAddr nodeToNodeVersion) (decAddr nodeToNodeVersion)
     }
@@ -434,6 +446,7 @@ identityCodecs ::
     (AnyMessage (BlockFetch blk (Point blk)))
     (AnyMessage (BlockFetch (Serialised blk) (Point blk)))
     (AnyMessage (TxSubmission2 (GenTxId blk) (GenTx blk)))
+    (AnyMessage (PerasCertDiffusion blk))
     (AnyMessage KeepAlive)
     (AnyMessage (PeerSharing addr))
 identityCodecs =
@@ -443,6 +456,7 @@ identityCodecs =
     , cBlockFetchCodec = codecBlockFetchId
     , cBlockFetchCodecSerialised = codecBlockFetchId
     , cTxSubmission2Codec = codecTxSubmission2Id
+    , cPerasCertDiffusionCodec = codecObjectDiffusionId
     , cKeepAliveCodec = codecKeepAliveId
     , cPeerSharingCodec = codecPeerSharingId
     }
@@ -620,7 +634,7 @@ byteLimits =
 
 -- | Construct the 'NetworkApplication' for the node-to-node protocols
 mkApps ::
-  forall m addrNTN addrNTC blk e bCS bBF bTX bKA bPS.
+  forall m addrNTN addrNTC blk e bCS bBF bTX bPCD bKA bPS.
   ( IOLike m
   , MonadTimer m
   , Ord addrNTN
@@ -635,7 +649,7 @@ mkApps ::
   NodeKernel m addrNTN addrNTC blk ->
   StdGen ->
   Tracers m addrNTN blk e ->
-  (NodeToNodeVersion -> Codecs blk addrNTN e m bCS bCS bBF bBF bTX bKA bPS) ->
+  (NodeToNodeVersion -> Codecs blk addrNTN e m bCS bCS bBF bBF bTX bPCD bKA bPS) ->
   ByteLimits bCS bBF bTX bKA ->
   -- Chain-Sync timeouts for chain-sync client (using `Header blk`) as well as
   -- the server (`SerialisedHeader blk`).

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

@@ -83,6 +83,7 @@ import Ouroboros.Consensus.Mempool
 import qualified Ouroboros.Consensus.MiniProtocol.ChainSync.Client as CSClient
 import qualified Ouroboros.Consensus.MiniProtocol.ChainSync.Client.HistoricityCheck as HistoricityCheck
 import qualified Ouroboros.Consensus.MiniProtocol.ChainSync.Client.InFutureCheck as InFutureCheck
+import Ouroboros.Consensus.MiniProtocol.ObjectDiffusion.PerasCert (PerasCertDiffusion)
 import qualified Ouroboros.Consensus.Network.NodeToNode as NTN
 import Ouroboros.Consensus.Node.ExitPolicy
 import qualified Ouroboros.Consensus.Node.GSM as GSM
@@ -1180,6 +1181,7 @@ runThreadNetwork
         Lazy.ByteString
         Lazy.ByteString
         (AnyMessage (TxSubmission2 (GenTxId blk) (GenTx blk)))
+        (AnyMessage (PerasCertDiffusion blk))
         (AnyMessage KeepAlive)
         (AnyMessage (PeerSharing NodeId))
     customNodeToNodeCodecs cfg ntnVersion =
@@ -1199,6 +1201,9 @@ runThreadNetwork
         , cTxSubmission2Codec =
             mapFailureCodec CodecIdFailure $
               NTN.cTxSubmission2Codec NTN.identityCodecs
+        , cPerasCertDiffusionCodec =
+            mapFailureCodec CodecIdFailure $
+              NTN.cPerasCertDiffusionCodec NTN.identityCodecs
         , cKeepAliveCodec =
             mapFailureCodec CodecIdFailure $
               NTN.cKeepAliveCodec NTN.identityCodecs

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

@@ -4,6 +4,7 @@
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE UndecidableInstances #-}
@@ -14,14 +15,22 @@ module Ouroboros.Consensus.Block.SupportsPeras
   , boostPerCert
   , BlockSupportsPeras (..)
   , PerasCert (..)
+  , encodePerasRoundNo
+  , decodePerasRoundNo
+  , encodePerasCert
+  , decodePerasCert
   ) where
 
+import qualified Codec.CBOR.Decoding as CBOR
+import qualified Codec.CBOR.Encoding as CBOR
 import Data.Monoid (Sum (..))
+import Data.Proxy (Proxy)
 import Data.Word (Word64)
 import GHC.Generics (Generic)
 import NoThunks.Class
 import Ouroboros.Consensus.Block.Abstract
 import Ouroboros.Consensus.Util.Condense
+import Ouroboros.Network.Block (decodePoint, encodePoint)
 import Quiet (Quiet (..))
 
 newtype PerasRoundNo = PerasRoundNo {unPerasRoundNo :: Word64}
@@ -66,3 +75,22 @@ instance StandardHash blk => BlockSupportsPeras blk where
 
   perasCertRound = pcCertRound
   perasCertBoostedBlock = pcCertBoostedBlock
+
+encodePerasRoundNo :: PerasRoundNo -> CBOR.Encoding
+encodePerasRoundNo (PerasRoundNo{..}) =
+  CBOR.encodeWord64 unPerasRoundNo
+
+decodePerasRoundNo :: forall s. CBOR.Decoder s PerasRoundNo
+decodePerasRoundNo =
+  PerasRoundNo <$> CBOR.decodeWord64
+
+encodePerasCert :: forall blk. ConvertRawHash blk => Proxy blk -> PerasCert blk -> CBOR.Encoding
+encodePerasCert p (PerasCert{..}) =
+  encodePerasRoundNo pcCertRound
+    <> (encodePoint (encodeRawHash p) pcCertBoostedBlock)
+
+decodePerasCert :: forall s blk. ConvertRawHash blk => Proxy blk -> CBOR.Decoder s (PerasCert blk)
+decodePerasCert p =
+  PerasCert
+    <$> decodePerasRoundNo
+    <*> (decodePoint (decodeRawHash p))

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

@@ -7,6 +7,7 @@ module Ouroboros.Consensus.MiniProtocol.ObjectDiffusion.PerasCert
   , PerasCertPoolWriter
   , PerasCertDiffusionInboundPipelined
   , PerasCertDiffusionOutbound
+  , PerasCertDiffusion
   ) where
 
 import Ouroboros.Consensus.Block
@@ -16,6 +17,7 @@ import Ouroboros.Consensus.MiniProtocol.ObjectDiffusion.Outbound
 import Ouroboros.Consensus.Storage.PerasCertDB.API
 import Ouroboros.Network.Protocol.ObjectDiffusion.Inbound (ObjectDiffusionInboundPipelined)
 import Ouroboros.Network.Protocol.ObjectDiffusion.Outbound (ObjectDiffusionOutbound)
+import Ouroboros.Network.Protocol.ObjectDiffusion.Type (ObjectDiffusion, OutboundAgency)
 
 type TracePerasCertDiffusionInbound blk =
   TraceObjectDiffusionInbound PerasRoundNo (PerasCert blk)
@@ -34,3 +36,6 @@ type PerasCertDiffusionInboundPipelined blk m a =
 
 type PerasCertDiffusionOutbound blk m a =
   ObjectDiffusionOutbound PerasRoundNo (PerasCert blk) m a
+
+type PerasCertDiffusion blk =
+  ObjectDiffusion OutboundAgency PerasRoundNo (PerasCert blk)