-- | GossipSub RPC message encoding/decoding (protobuf).
--
-- Wire format from docs/11-pubsub.md:
--   Message framing: [uvarint length][protobuf RPC]
--   RPC fields: subscriptions(1), publish(2), control(3)
--   SubOpts: subscribe(1), topicid(2)
--   Message: from(1), data(2), seqno(3), topic(4), signature(5), key(6)
--   ControlMessage: ihave(1), iwant(2), graft(3), prune(4)
--   ControlIHave: topicID(1), messageIDs(2)
--   ControlIWant: messageIDs(1)
--   ControlGraft: topicID(1)
--   ControlPrune: topicID(1), peers(2), backoff(3)
--   PeerInfo: peerID(1), signedPeerRecord(2)
--
-- Uses proto3-wire, same pattern as DHT/Message.hs and Relay/Message.hs.
module Network.LibP2P.Protocol.GossipSub.Message
  ( -- * Protobuf encode/decode (no framing)
    encodeRPC
  , decodeRPC
    -- * Sub-message encode/decode (exported for testing)
  , encodePubSubMessage
  , decodePubSubMessage
  , encodeControlMessage
  , decodeControlMessage
    -- * Wire framing (uvarint length prefix)
  , encodeFramed
  , decodeFramed
    -- * Serialization helpers
  , encodePubSubMessageBS
    -- * Stream I/O helpers
  , writeRPCMessage
  , readRPCMessage
  ) where

import Data.ByteString (ByteString)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as BL
import Data.Text (Text)
import qualified Data.Text.Lazy as TL
import Data.Word (Word64)
import Proto3.Wire.Decode (Parser, RawMessage, ParseError, at, one, optional, repeated, embedded, embedded', parse)
import qualified Proto3.Wire.Decode as Decode
import Proto3.Wire.Encode (MessageBuilder)
import qualified Proto3.Wire.Encode as Encode
import Proto3.Wire.Types (FieldNumber (..))
import Network.LibP2P.Core.Varint (encodeUvarint, decodeUvarint)
import Network.LibP2P.MultistreamSelect.Negotiation (StreamIO (..))
import Network.LibP2P.Protocol.GossipSub.Types

-- Encoding helpers

optBytes :: Word -> Maybe ByteString -> MessageBuilder
optBytes :: Word -> Maybe ByteString -> MessageBuilder
optBytes Word
_ Maybe ByteString
Nothing  = MessageBuilder
forall a. Monoid a => a
mempty
optBytes Word
n (Just ByteString
v) = FieldNumber -> ByteString -> MessageBuilder
Encode.byteString (Word64 -> FieldNumber
FieldNumber (Word -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
n)) ByteString
v

optText :: Word -> Maybe Text -> MessageBuilder
optText :: Word -> Maybe Topic -> MessageBuilder
optText Word
_ Maybe Topic
Nothing  = MessageBuilder
forall a. Monoid a => a
mempty
optText Word
n (Just Topic
v) = FieldNumber -> Text -> MessageBuilder
Encode.text (Word64 -> FieldNumber
FieldNumber (Word -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
n)) (Topic -> Text
TL.fromStrict Topic
v)

optUint64 :: Word -> Maybe Word64 -> MessageBuilder
optUint64 :: Word -> Maybe Word64 -> MessageBuilder
optUint64 Word
_ Maybe Word64
Nothing  = MessageBuilder
forall a. Monoid a => a
mempty
optUint64 Word
n (Just Word64
v) = FieldNumber -> Word64 -> MessageBuilder
Encode.uint64 (Word64 -> FieldNumber
FieldNumber (Word -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
n)) Word64
v

optEmbedded :: Word -> (a -> MessageBuilder) -> Maybe a -> MessageBuilder
optEmbedded :: forall a.
Word -> (a -> MessageBuilder) -> Maybe a -> MessageBuilder
optEmbedded Word
_ a -> MessageBuilder
_ Maybe a
Nothing  = MessageBuilder
forall a. Monoid a => a
mempty
optEmbedded Word
n a -> MessageBuilder
f (Just a
v) = FieldNumber -> MessageBuilder -> MessageBuilder
Encode.embedded (Word64 -> FieldNumber
FieldNumber (Word -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
n)) (a -> MessageBuilder
f a
v)

repEmbedded :: Word -> (a -> MessageBuilder) -> [a] -> MessageBuilder
repEmbedded :: forall a. Word -> (a -> MessageBuilder) -> [a] -> MessageBuilder
repEmbedded Word
n a -> MessageBuilder
enc = (a -> MessageBuilder) -> [a] -> MessageBuilder
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (\a
x -> FieldNumber -> MessageBuilder -> MessageBuilder
Encode.embedded (Word64 -> FieldNumber
FieldNumber (Word -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
n)) (a -> MessageBuilder
enc a
x))

nonEmpty :: ByteString -> Maybe ByteString
nonEmpty :: ByteString -> Maybe ByteString
nonEmpty ByteString
bs
  | ByteString -> Bool
BS.null ByteString
bs = Maybe ByteString
forall a. Maybe a
Nothing
  | Bool
otherwise  = ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
bs

nonEmptyText :: Text -> Maybe Text
nonEmptyText :: Topic -> Maybe Topic
nonEmptyText Topic
t
  | Topic
t Topic -> Topic -> Bool
forall a. Eq a => a -> a -> Bool
== Topic
""   = Maybe Topic
forall a. Maybe a
Nothing
  | Bool
otherwise = Topic -> Maybe Topic
forall a. a -> Maybe a
Just Topic
t

-- Encoding

-- | Encode a PubSubMessage sub-message.
encodePubSubMessage :: PubSubMessage -> MessageBuilder
encodePubSubMessage :: PubSubMessage -> MessageBuilder
encodePubSubMessage PubSubMessage
msg =
     Word -> Maybe ByteString -> MessageBuilder
optBytes Word
1 (PubSubMessage -> Maybe ByteString
msgFrom PubSubMessage
msg)
  MessageBuilder -> MessageBuilder -> MessageBuilder
forall a. Semigroup a => a -> a -> a
<> Word -> Maybe ByteString -> MessageBuilder
optBytes Word
2 (ByteString -> Maybe ByteString
nonEmpty (PubSubMessage -> ByteString
msgData PubSubMessage
msg))
  MessageBuilder -> MessageBuilder -> MessageBuilder
forall a. Semigroup a => a -> a -> a
<> Word -> Maybe ByteString -> MessageBuilder
optBytes Word
3 (PubSubMessage -> Maybe ByteString
msgSeqNo PubSubMessage
msg)
  MessageBuilder -> MessageBuilder -> MessageBuilder
forall a. Semigroup a => a -> a -> a
<> FieldNumber -> Text -> MessageBuilder
Encode.text (Word64 -> FieldNumber
FieldNumber Word64
4) (Topic -> Text
TL.fromStrict (PubSubMessage -> Topic
msgTopic PubSubMessage
msg))
  MessageBuilder -> MessageBuilder -> MessageBuilder
forall a. Semigroup a => a -> a -> a
<> Word -> Maybe ByteString -> MessageBuilder
optBytes Word
5 (PubSubMessage -> Maybe ByteString
msgSignature PubSubMessage
msg)
  MessageBuilder -> MessageBuilder -> MessageBuilder
forall a. Semigroup a => a -> a -> a
<> Word -> Maybe ByteString -> MessageBuilder
optBytes Word
6 (PubSubMessage -> Maybe ByteString
msgKey PubSubMessage
msg)

-- | Encode a SubOpts sub-message.
encodeSubOpts :: SubOpts -> MessageBuilder
encodeSubOpts :: SubOpts -> MessageBuilder
encodeSubOpts SubOpts
sub =
     FieldNumber -> Bool -> MessageBuilder
Encode.bool (Word64 -> FieldNumber
FieldNumber Word64
1) (SubOpts -> Bool
subSubscribe SubOpts
sub)
  MessageBuilder -> MessageBuilder -> MessageBuilder
forall a. Semigroup a => a -> a -> a
<> FieldNumber -> Text -> MessageBuilder
Encode.text (Word64 -> FieldNumber
FieldNumber Word64
2) (Topic -> Text
TL.fromStrict (SubOpts -> Topic
subTopicId SubOpts
sub))

-- | Encode an IHave sub-message.
encodeIHave :: IHave -> MessageBuilder
encodeIHave :: IHave -> MessageBuilder
encodeIHave (IHave Topic
topic [ByteString]
mids) =
     Word -> Maybe Topic -> MessageBuilder
optText Word
1 (Topic -> Maybe Topic
nonEmptyText Topic
topic)
  MessageBuilder -> MessageBuilder -> MessageBuilder
forall a. Semigroup a => a -> a -> a
<> (ByteString -> MessageBuilder) -> [ByteString] -> MessageBuilder
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (\ByteString
mid -> FieldNumber -> ByteString -> MessageBuilder
Encode.byteString (Word64 -> FieldNumber
FieldNumber Word64
2) ByteString
mid) [ByteString]
mids

-- | Encode an IWant sub-message.
encodeIWant :: IWant -> MessageBuilder
encodeIWant :: IWant -> MessageBuilder
encodeIWant (IWant [ByteString]
mids) =
  (ByteString -> MessageBuilder) -> [ByteString] -> MessageBuilder
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (\ByteString
mid -> FieldNumber -> ByteString -> MessageBuilder
Encode.byteString (Word64 -> FieldNumber
FieldNumber Word64
1) ByteString
mid) [ByteString]
mids

-- | Encode a Graft sub-message.
encodeGraft :: Graft -> MessageBuilder
encodeGraft :: Graft -> MessageBuilder
encodeGraft (Graft Topic
topic) =
  Word -> Maybe Topic -> MessageBuilder
optText Word
1 (Topic -> Maybe Topic
nonEmptyText Topic
topic)

-- | Encode a PeerExchangeInfo sub-message.
encodePeerExchangeInfo :: PeerExchangeInfo -> MessageBuilder
encodePeerExchangeInfo :: PeerExchangeInfo -> MessageBuilder
encodePeerExchangeInfo PeerExchangeInfo
px =
     Word -> Maybe ByteString -> MessageBuilder
optBytes Word
1 (ByteString -> Maybe ByteString
nonEmpty (PeerExchangeInfo -> ByteString
pxPeerId PeerExchangeInfo
px))
  MessageBuilder -> MessageBuilder -> MessageBuilder
forall a. Semigroup a => a -> a -> a
<> Word -> Maybe ByteString -> MessageBuilder
optBytes Word
2 (PeerExchangeInfo -> Maybe ByteString
pxSignedPeerRecord PeerExchangeInfo
px)

-- | Encode a Prune sub-message.
encodePrune :: Prune -> MessageBuilder
encodePrune :: Prune -> MessageBuilder
encodePrune Prune
prn =
     Word -> Maybe Topic -> MessageBuilder
optText Word
1 (Topic -> Maybe Topic
nonEmptyText (Prune -> Topic
pruneTopic Prune
prn))
  MessageBuilder -> MessageBuilder -> MessageBuilder
forall a. Semigroup a => a -> a -> a
<> Word
-> (PeerExchangeInfo -> MessageBuilder)
-> [PeerExchangeInfo]
-> MessageBuilder
forall a. Word -> (a -> MessageBuilder) -> [a] -> MessageBuilder
repEmbedded Word
2 PeerExchangeInfo -> MessageBuilder
encodePeerExchangeInfo (Prune -> [PeerExchangeInfo]
prunePeers Prune
prn)
  MessageBuilder -> MessageBuilder -> MessageBuilder
forall a. Semigroup a => a -> a -> a
<> Word -> Maybe Word64 -> MessageBuilder
optUint64 Word
3 (Prune -> Maybe Word64
pruneBackoff Prune
prn)

-- | Encode a ControlMessage sub-message.
encodeControlMessage :: ControlMessage -> MessageBuilder
encodeControlMessage :: ControlMessage -> MessageBuilder
encodeControlMessage ControlMessage
ctrl =
     Word -> (IHave -> MessageBuilder) -> [IHave] -> MessageBuilder
forall a. Word -> (a -> MessageBuilder) -> [a] -> MessageBuilder
repEmbedded Word
1 IHave -> MessageBuilder
encodeIHave (ControlMessage -> [IHave]
ctrlIHave ControlMessage
ctrl)
  MessageBuilder -> MessageBuilder -> MessageBuilder
forall a. Semigroup a => a -> a -> a
<> Word -> (IWant -> MessageBuilder) -> [IWant] -> MessageBuilder
forall a. Word -> (a -> MessageBuilder) -> [a] -> MessageBuilder
repEmbedded Word
2 IWant -> MessageBuilder
encodeIWant (ControlMessage -> [IWant]
ctrlIWant ControlMessage
ctrl)
  MessageBuilder -> MessageBuilder -> MessageBuilder
forall a. Semigroup a => a -> a -> a
<> Word -> (Graft -> MessageBuilder) -> [Graft] -> MessageBuilder
forall a. Word -> (a -> MessageBuilder) -> [a] -> MessageBuilder
repEmbedded Word
3 Graft -> MessageBuilder
encodeGraft (ControlMessage -> [Graft]
ctrlGraft ControlMessage
ctrl)
  MessageBuilder -> MessageBuilder -> MessageBuilder
forall a. Semigroup a => a -> a -> a
<> Word -> (Prune -> MessageBuilder) -> [Prune] -> MessageBuilder
forall a. Word -> (a -> MessageBuilder) -> [a] -> MessageBuilder
repEmbedded Word
4 Prune -> MessageBuilder
encodePrune (ControlMessage -> [Prune]
ctrlPrune ControlMessage
ctrl)

-- | Encode an RPC message to protobuf (no framing).
encodeRPC :: RPC -> ByteString
encodeRPC :: RPC -> ByteString
encodeRPC RPC
rpc = LazyByteString -> ByteString
BL.toStrict (LazyByteString -> ByteString) -> LazyByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ MessageBuilder -> LazyByteString
Encode.toLazyByteString (MessageBuilder -> LazyByteString)
-> MessageBuilder -> LazyByteString
forall a b. (a -> b) -> a -> b
$
     Word -> (SubOpts -> MessageBuilder) -> [SubOpts] -> MessageBuilder
forall a. Word -> (a -> MessageBuilder) -> [a] -> MessageBuilder
repEmbedded Word
1 SubOpts -> MessageBuilder
encodeSubOpts (RPC -> [SubOpts]
rpcSubscriptions RPC
rpc)
  MessageBuilder -> MessageBuilder -> MessageBuilder
forall a. Semigroup a => a -> a -> a
<> Word
-> (PubSubMessage -> MessageBuilder)
-> [PubSubMessage]
-> MessageBuilder
forall a. Word -> (a -> MessageBuilder) -> [a] -> MessageBuilder
repEmbedded Word
2 PubSubMessage -> MessageBuilder
encodePubSubMessage (RPC -> [PubSubMessage]
rpcPublish RPC
rpc)
  MessageBuilder -> MessageBuilder -> MessageBuilder
forall a. Semigroup a => a -> a -> a
<> Word
-> (ControlMessage -> MessageBuilder)
-> Maybe ControlMessage
-> MessageBuilder
forall a.
Word -> (a -> MessageBuilder) -> Maybe a -> MessageBuilder
optEmbedded Word
3 ControlMessage -> MessageBuilder
encodeControlMessage (RPC -> Maybe ControlMessage
rpcControl RPC
rpc)

-- Decoding

-- | Decode PubSubMessage from protobuf.
pubSubMessageParser :: Parser RawMessage PubSubMessage
pubSubMessageParser :: Parser RawMessage PubSubMessage
pubSubMessageParser = Maybe ByteString
-> ByteString
-> Maybe ByteString
-> Topic
-> Maybe ByteString
-> Maybe ByteString
-> PubSubMessage
PubSubMessage
  (Maybe ByteString
 -> ByteString
 -> Maybe ByteString
 -> Topic
 -> Maybe ByteString
 -> Maybe ByteString
 -> PubSubMessage)
-> Parser RawMessage (Maybe ByteString)
-> Parser
     RawMessage
     (ByteString
      -> Maybe ByteString
      -> Topic
      -> Maybe ByteString
      -> Maybe ByteString
      -> PubSubMessage)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser RawField (Maybe ByteString)
-> FieldNumber -> Parser RawMessage (Maybe ByteString)
forall a. Parser RawField a -> FieldNumber -> Parser RawMessage a
at (Parser RawPrimitive ByteString
-> Parser RawField (Maybe ByteString)
forall a. Parser RawPrimitive a -> Parser RawField (Maybe a)
optional Parser RawPrimitive ByteString
Decode.byteString) (Word64 -> FieldNumber
FieldNumber Word64
1)
  Parser
  RawMessage
  (ByteString
   -> Maybe ByteString
   -> Topic
   -> Maybe ByteString
   -> Maybe ByteString
   -> PubSubMessage)
-> Parser RawMessage ByteString
-> Parser
     RawMessage
     (Maybe ByteString
      -> Topic -> Maybe ByteString -> Maybe ByteString -> PubSubMessage)
forall a b.
Parser RawMessage (a -> b)
-> Parser RawMessage a -> Parser RawMessage b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser RawField ByteString
-> FieldNumber -> Parser RawMessage ByteString
forall a. Parser RawField a -> FieldNumber -> Parser RawMessage a
at (Parser RawPrimitive ByteString
-> ByteString -> Parser RawField ByteString
forall a. Parser RawPrimitive a -> a -> Parser RawField a
one Parser RawPrimitive ByteString
Decode.byteString ByteString
BS.empty) (Word64 -> FieldNumber
FieldNumber Word64
2)
  Parser
  RawMessage
  (Maybe ByteString
   -> Topic -> Maybe ByteString -> Maybe ByteString -> PubSubMessage)
-> Parser RawMessage (Maybe ByteString)
-> Parser
     RawMessage
     (Topic -> Maybe ByteString -> Maybe ByteString -> PubSubMessage)
forall a b.
Parser RawMessage (a -> b)
-> Parser RawMessage a -> Parser RawMessage b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser RawField (Maybe ByteString)
-> FieldNumber -> Parser RawMessage (Maybe ByteString)
forall a. Parser RawField a -> FieldNumber -> Parser RawMessage a
at (Parser RawPrimitive ByteString
-> Parser RawField (Maybe ByteString)
forall a. Parser RawPrimitive a -> Parser RawField (Maybe a)
optional Parser RawPrimitive ByteString
Decode.byteString) (Word64 -> FieldNumber
FieldNumber Word64
3)
  Parser
  RawMessage
  (Topic -> Maybe ByteString -> Maybe ByteString -> PubSubMessage)
-> Parser RawMessage Topic
-> Parser
     RawMessage (Maybe ByteString -> Maybe ByteString -> PubSubMessage)
forall a b.
Parser RawMessage (a -> b)
-> Parser RawMessage a -> Parser RawMessage b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser RawField Topic -> FieldNumber -> Parser RawMessage Topic
forall a. Parser RawField a -> FieldNumber -> Parser RawMessage a
at (Parser RawPrimitive Topic -> Topic -> Parser RawField Topic
forall a. Parser RawPrimitive a -> a -> Parser RawField a
one (Text -> Topic
TL.toStrict (Text -> Topic)
-> Parser RawPrimitive Text -> Parser RawPrimitive Topic
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser RawPrimitive Text
Decode.text) Topic
"") (Word64 -> FieldNumber
FieldNumber Word64
4)
  Parser
  RawMessage (Maybe ByteString -> Maybe ByteString -> PubSubMessage)
-> Parser RawMessage (Maybe ByteString)
-> Parser RawMessage (Maybe ByteString -> PubSubMessage)
forall a b.
Parser RawMessage (a -> b)
-> Parser RawMessage a -> Parser RawMessage b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser RawField (Maybe ByteString)
-> FieldNumber -> Parser RawMessage (Maybe ByteString)
forall a. Parser RawField a -> FieldNumber -> Parser RawMessage a
at (Parser RawPrimitive ByteString
-> Parser RawField (Maybe ByteString)
forall a. Parser RawPrimitive a -> Parser RawField (Maybe a)
optional Parser RawPrimitive ByteString
Decode.byteString) (Word64 -> FieldNumber
FieldNumber Word64
5)
  Parser RawMessage (Maybe ByteString -> PubSubMessage)
-> Parser RawMessage (Maybe ByteString)
-> Parser RawMessage PubSubMessage
forall a b.
Parser RawMessage (a -> b)
-> Parser RawMessage a -> Parser RawMessage b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser RawField (Maybe ByteString)
-> FieldNumber -> Parser RawMessage (Maybe ByteString)
forall a. Parser RawField a -> FieldNumber -> Parser RawMessage a
at (Parser RawPrimitive ByteString
-> Parser RawField (Maybe ByteString)
forall a. Parser RawPrimitive a -> Parser RawField (Maybe a)
optional Parser RawPrimitive ByteString
Decode.byteString) (Word64 -> FieldNumber
FieldNumber Word64
6)

-- | Decode a PubSubMessage from raw bytes.
decodePubSubMessage :: ByteString -> Either ParseError PubSubMessage
decodePubSubMessage :: ByteString -> Either ParseError PubSubMessage
decodePubSubMessage = Parser RawMessage PubSubMessage
-> ByteString -> Either ParseError PubSubMessage
forall a. Parser RawMessage a -> ByteString -> Either ParseError a
parse Parser RawMessage PubSubMessage
pubSubMessageParser

-- | Encode a PubSubMessage to ByteString (used for signature computation).
encodePubSubMessageBS :: PubSubMessage -> ByteString
encodePubSubMessageBS :: PubSubMessage -> ByteString
encodePubSubMessageBS PubSubMessage
msg = LazyByteString -> ByteString
BL.toStrict (LazyByteString -> ByteString) -> LazyByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ MessageBuilder -> LazyByteString
Encode.toLazyByteString (MessageBuilder -> LazyByteString)
-> MessageBuilder -> LazyByteString
forall a b. (a -> b) -> a -> b
$ PubSubMessage -> MessageBuilder
encodePubSubMessage PubSubMessage
msg

-- | Decode SubOpts from protobuf.
subOptsParser :: Parser RawMessage SubOpts
subOptsParser :: Parser RawMessage SubOpts
subOptsParser = Bool -> Topic -> SubOpts
SubOpts
  (Bool -> Topic -> SubOpts)
-> Parser RawMessage Bool -> Parser RawMessage (Topic -> SubOpts)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser RawField Bool -> FieldNumber -> Parser RawMessage Bool
forall a. Parser RawField a -> FieldNumber -> Parser RawMessage a
at (Parser RawPrimitive Bool -> Bool -> Parser RawField Bool
forall a. Parser RawPrimitive a -> a -> Parser RawField a
one Parser RawPrimitive Bool
Decode.bool Bool
False) (Word64 -> FieldNumber
FieldNumber Word64
1)
  Parser RawMessage (Topic -> SubOpts)
-> Parser RawMessage Topic -> Parser RawMessage SubOpts
forall a b.
Parser RawMessage (a -> b)
-> Parser RawMessage a -> Parser RawMessage b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser RawField Topic -> FieldNumber -> Parser RawMessage Topic
forall a. Parser RawField a -> FieldNumber -> Parser RawMessage a
at (Parser RawPrimitive Topic -> Topic -> Parser RawField Topic
forall a. Parser RawPrimitive a -> a -> Parser RawField a
one (Text -> Topic
TL.toStrict (Text -> Topic)
-> Parser RawPrimitive Text -> Parser RawPrimitive Topic
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser RawPrimitive Text
Decode.text) Topic
"") (Word64 -> FieldNumber
FieldNumber Word64
2)

-- | Decode IHave from protobuf.
ihaveParser :: Parser RawMessage IHave
ihaveParser :: Parser RawMessage IHave
ihaveParser = Topic -> [ByteString] -> IHave
IHave
  (Topic -> [ByteString] -> IHave)
-> Parser RawMessage Topic
-> Parser RawMessage ([ByteString] -> IHave)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser RawField Topic -> FieldNumber -> Parser RawMessage Topic
forall a. Parser RawField a -> FieldNumber -> Parser RawMessage a
at (Parser RawPrimitive Topic -> Topic -> Parser RawField Topic
forall a. Parser RawPrimitive a -> a -> Parser RawField a
one (Text -> Topic
TL.toStrict (Text -> Topic)
-> Parser RawPrimitive Text -> Parser RawPrimitive Topic
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser RawPrimitive Text
Decode.text) Topic
"") (Word64 -> FieldNumber
FieldNumber Word64
1)
  Parser RawMessage ([ByteString] -> IHave)
-> Parser RawMessage [ByteString] -> Parser RawMessage IHave
forall a b.
Parser RawMessage (a -> b)
-> Parser RawMessage a -> Parser RawMessage b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser RawField [ByteString]
-> FieldNumber -> Parser RawMessage [ByteString]
forall a. Parser RawField a -> FieldNumber -> Parser RawMessage a
at (Parser RawPrimitive ByteString -> Parser RawField [ByteString]
forall a. Parser RawPrimitive a -> Parser RawField [a]
repeated Parser RawPrimitive ByteString
Decode.byteString) (Word64 -> FieldNumber
FieldNumber Word64
2)

-- | Decode IWant from protobuf.
iwantParser :: Parser RawMessage IWant
iwantParser :: Parser RawMessage IWant
iwantParser = [ByteString] -> IWant
IWant
  ([ByteString] -> IWant)
-> Parser RawMessage [ByteString] -> Parser RawMessage IWant
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser RawField [ByteString]
-> FieldNumber -> Parser RawMessage [ByteString]
forall a. Parser RawField a -> FieldNumber -> Parser RawMessage a
at (Parser RawPrimitive ByteString -> Parser RawField [ByteString]
forall a. Parser RawPrimitive a -> Parser RawField [a]
repeated Parser RawPrimitive ByteString
Decode.byteString) (Word64 -> FieldNumber
FieldNumber Word64
1)

-- | Decode Graft from protobuf.
graftParser :: Parser RawMessage Graft
graftParser :: Parser RawMessage Graft
graftParser = Topic -> Graft
Graft
  (Topic -> Graft)
-> Parser RawMessage Topic -> Parser RawMessage Graft
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser RawField Topic -> FieldNumber -> Parser RawMessage Topic
forall a. Parser RawField a -> FieldNumber -> Parser RawMessage a
at (Parser RawPrimitive Topic -> Topic -> Parser RawField Topic
forall a. Parser RawPrimitive a -> a -> Parser RawField a
one (Text -> Topic
TL.toStrict (Text -> Topic)
-> Parser RawPrimitive Text -> Parser RawPrimitive Topic
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser RawPrimitive Text
Decode.text) Topic
"") (Word64 -> FieldNumber
FieldNumber Word64
1)

-- | Decode PeerExchangeInfo from protobuf.
peerExchangeInfoParser :: Parser RawMessage PeerExchangeInfo
peerExchangeInfoParser :: Parser RawMessage PeerExchangeInfo
peerExchangeInfoParser = ByteString -> Maybe ByteString -> PeerExchangeInfo
PeerExchangeInfo
  (ByteString -> Maybe ByteString -> PeerExchangeInfo)
-> Parser RawMessage ByteString
-> Parser RawMessage (Maybe ByteString -> PeerExchangeInfo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser RawField ByteString
-> FieldNumber -> Parser RawMessage ByteString
forall a. Parser RawField a -> FieldNumber -> Parser RawMessage a
at (Parser RawPrimitive ByteString
-> ByteString -> Parser RawField ByteString
forall a. Parser RawPrimitive a -> a -> Parser RawField a
one Parser RawPrimitive ByteString
Decode.byteString ByteString
BS.empty) (Word64 -> FieldNumber
FieldNumber Word64
1)
  Parser RawMessage (Maybe ByteString -> PeerExchangeInfo)
-> Parser RawMessage (Maybe ByteString)
-> Parser RawMessage PeerExchangeInfo
forall a b.
Parser RawMessage (a -> b)
-> Parser RawMessage a -> Parser RawMessage b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser RawField (Maybe ByteString)
-> FieldNumber -> Parser RawMessage (Maybe ByteString)
forall a. Parser RawField a -> FieldNumber -> Parser RawMessage a
at (Parser RawPrimitive ByteString
-> Parser RawField (Maybe ByteString)
forall a. Parser RawPrimitive a -> Parser RawField (Maybe a)
optional Parser RawPrimitive ByteString
Decode.byteString) (Word64 -> FieldNumber
FieldNumber Word64
2)

-- | Decode Prune from protobuf.
pruneParser :: Parser RawMessage Prune
pruneParser :: Parser RawMessage Prune
pruneParser = Topic -> [PeerExchangeInfo] -> Maybe Word64 -> Prune
Prune
  (Topic -> [PeerExchangeInfo] -> Maybe Word64 -> Prune)
-> Parser RawMessage Topic
-> Parser RawMessage ([PeerExchangeInfo] -> Maybe Word64 -> Prune)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser RawField Topic -> FieldNumber -> Parser RawMessage Topic
forall a. Parser RawField a -> FieldNumber -> Parser RawMessage a
at (Parser RawPrimitive Topic -> Topic -> Parser RawField Topic
forall a. Parser RawPrimitive a -> a -> Parser RawField a
one (Text -> Topic
TL.toStrict (Text -> Topic)
-> Parser RawPrimitive Text -> Parser RawPrimitive Topic
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser RawPrimitive Text
Decode.text) Topic
"") (Word64 -> FieldNumber
FieldNumber Word64
1)
  Parser RawMessage ([PeerExchangeInfo] -> Maybe Word64 -> Prune)
-> Parser RawMessage [PeerExchangeInfo]
-> Parser RawMessage (Maybe Word64 -> Prune)
forall a b.
Parser RawMessage (a -> b)
-> Parser RawMessage a -> Parser RawMessage b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser RawField [PeerExchangeInfo]
-> FieldNumber -> Parser RawMessage [PeerExchangeInfo]
forall a. Parser RawField a -> FieldNumber -> Parser RawMessage a
at (Parser RawPrimitive PeerExchangeInfo
-> Parser RawField [PeerExchangeInfo]
forall a. Parser RawPrimitive a -> Parser RawField [a]
repeated (Parser RawMessage PeerExchangeInfo
-> Parser RawPrimitive PeerExchangeInfo
forall a. Parser RawMessage a -> Parser RawPrimitive a
embedded' Parser RawMessage PeerExchangeInfo
peerExchangeInfoParser)) (Word64 -> FieldNumber
FieldNumber Word64
2)
  Parser RawMessage (Maybe Word64 -> Prune)
-> Parser RawMessage (Maybe Word64) -> Parser RawMessage Prune
forall a b.
Parser RawMessage (a -> b)
-> Parser RawMessage a -> Parser RawMessage b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser RawField (Maybe Word64)
-> FieldNumber -> Parser RawMessage (Maybe Word64)
forall a. Parser RawField a -> FieldNumber -> Parser RawMessage a
at (Parser RawPrimitive Word64 -> Parser RawField (Maybe Word64)
forall a. Parser RawPrimitive a -> Parser RawField (Maybe a)
optional Parser RawPrimitive Word64
Decode.uint64) (Word64 -> FieldNumber
FieldNumber Word64
3)

-- | Decode ControlMessage from protobuf.
controlMessageParser :: Parser RawMessage ControlMessage
controlMessageParser :: Parser RawMessage ControlMessage
controlMessageParser = [IHave] -> [IWant] -> [Graft] -> [Prune] -> ControlMessage
ControlMessage
  ([IHave] -> [IWant] -> [Graft] -> [Prune] -> ControlMessage)
-> Parser RawMessage [IHave]
-> Parser
     RawMessage ([IWant] -> [Graft] -> [Prune] -> ControlMessage)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser RawField [IHave] -> FieldNumber -> Parser RawMessage [IHave]
forall a. Parser RawField a -> FieldNumber -> Parser RawMessage a
at (Parser RawPrimitive IHave -> Parser RawField [IHave]
forall a. Parser RawPrimitive a -> Parser RawField [a]
repeated (Parser RawMessage IHave -> Parser RawPrimitive IHave
forall a. Parser RawMessage a -> Parser RawPrimitive a
embedded' Parser RawMessage IHave
ihaveParser)) (Word64 -> FieldNumber
FieldNumber Word64
1)
  Parser RawMessage ([IWant] -> [Graft] -> [Prune] -> ControlMessage)
-> Parser RawMessage [IWant]
-> Parser RawMessage ([Graft] -> [Prune] -> ControlMessage)
forall a b.
Parser RawMessage (a -> b)
-> Parser RawMessage a -> Parser RawMessage b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser RawField [IWant] -> FieldNumber -> Parser RawMessage [IWant]
forall a. Parser RawField a -> FieldNumber -> Parser RawMessage a
at (Parser RawPrimitive IWant -> Parser RawField [IWant]
forall a. Parser RawPrimitive a -> Parser RawField [a]
repeated (Parser RawMessage IWant -> Parser RawPrimitive IWant
forall a. Parser RawMessage a -> Parser RawPrimitive a
embedded' Parser RawMessage IWant
iwantParser)) (Word64 -> FieldNumber
FieldNumber Word64
2)
  Parser RawMessage ([Graft] -> [Prune] -> ControlMessage)
-> Parser RawMessage [Graft]
-> Parser RawMessage ([Prune] -> ControlMessage)
forall a b.
Parser RawMessage (a -> b)
-> Parser RawMessage a -> Parser RawMessage b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser RawField [Graft] -> FieldNumber -> Parser RawMessage [Graft]
forall a. Parser RawField a -> FieldNumber -> Parser RawMessage a
at (Parser RawPrimitive Graft -> Parser RawField [Graft]
forall a. Parser RawPrimitive a -> Parser RawField [a]
repeated (Parser RawMessage Graft -> Parser RawPrimitive Graft
forall a. Parser RawMessage a -> Parser RawPrimitive a
embedded' Parser RawMessage Graft
graftParser)) (Word64 -> FieldNumber
FieldNumber Word64
3)
  Parser RawMessage ([Prune] -> ControlMessage)
-> Parser RawMessage [Prune] -> Parser RawMessage ControlMessage
forall a b.
Parser RawMessage (a -> b)
-> Parser RawMessage a -> Parser RawMessage b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser RawField [Prune] -> FieldNumber -> Parser RawMessage [Prune]
forall a. Parser RawField a -> FieldNumber -> Parser RawMessage a
at (Parser RawPrimitive Prune -> Parser RawField [Prune]
forall a. Parser RawPrimitive a -> Parser RawField [a]
repeated (Parser RawMessage Prune -> Parser RawPrimitive Prune
forall a. Parser RawMessage a -> Parser RawPrimitive a
embedded' Parser RawMessage Prune
pruneParser)) (Word64 -> FieldNumber
FieldNumber Word64
4)

-- | Decode a ControlMessage from raw bytes.
decodeControlMessage :: ByteString -> Either ParseError ControlMessage
decodeControlMessage :: ByteString -> Either ParseError ControlMessage
decodeControlMessage = Parser RawMessage ControlMessage
-> ByteString -> Either ParseError ControlMessage
forall a. Parser RawMessage a -> ByteString -> Either ParseError a
parse Parser RawMessage ControlMessage
controlMessageParser

-- | Decode RPC from protobuf.
rpcParser :: Parser RawMessage RPC
rpcParser :: Parser RawMessage RPC
rpcParser = [SubOpts] -> [PubSubMessage] -> Maybe ControlMessage -> RPC
RPC
  ([SubOpts] -> [PubSubMessage] -> Maybe ControlMessage -> RPC)
-> Parser RawMessage [SubOpts]
-> Parser
     RawMessage ([PubSubMessage] -> Maybe ControlMessage -> RPC)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser RawField [SubOpts]
-> FieldNumber -> Parser RawMessage [SubOpts]
forall a. Parser RawField a -> FieldNumber -> Parser RawMessage a
at (Parser RawPrimitive SubOpts -> Parser RawField [SubOpts]
forall a. Parser RawPrimitive a -> Parser RawField [a]
repeated (Parser RawMessage SubOpts -> Parser RawPrimitive SubOpts
forall a. Parser RawMessage a -> Parser RawPrimitive a
embedded' Parser RawMessage SubOpts
subOptsParser)) (Word64 -> FieldNumber
FieldNumber Word64
1)
  Parser RawMessage ([PubSubMessage] -> Maybe ControlMessage -> RPC)
-> Parser RawMessage [PubSubMessage]
-> Parser RawMessage (Maybe ControlMessage -> RPC)
forall a b.
Parser RawMessage (a -> b)
-> Parser RawMessage a -> Parser RawMessage b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser RawField [PubSubMessage]
-> FieldNumber -> Parser RawMessage [PubSubMessage]
forall a. Parser RawField a -> FieldNumber -> Parser RawMessage a
at (Parser RawPrimitive PubSubMessage
-> Parser RawField [PubSubMessage]
forall a. Parser RawPrimitive a -> Parser RawField [a]
repeated (Parser RawMessage PubSubMessage
-> Parser RawPrimitive PubSubMessage
forall a. Parser RawMessage a -> Parser RawPrimitive a
embedded' Parser RawMessage PubSubMessage
pubSubMessageParser)) (Word64 -> FieldNumber
FieldNumber Word64
2)
  Parser RawMessage (Maybe ControlMessage -> RPC)
-> Parser RawMessage (Maybe ControlMessage)
-> Parser RawMessage RPC
forall a b.
Parser RawMessage (a -> b)
-> Parser RawMessage a -> Parser RawMessage b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser RawField (Maybe ControlMessage)
-> FieldNumber -> Parser RawMessage (Maybe ControlMessage)
forall a. Parser RawField a -> FieldNumber -> Parser RawMessage a
at (Parser RawMessage ControlMessage
-> Parser RawField (Maybe ControlMessage)
forall a. Parser RawMessage a -> Parser RawField (Maybe a)
embedded Parser RawMessage ControlMessage
controlMessageParser) (Word64 -> FieldNumber
FieldNumber Word64
3)

-- | Decode an RPC from raw bytes.
decodeRPC :: ByteString -> Either ParseError RPC
decodeRPC :: ByteString -> Either ParseError RPC
decodeRPC = Parser RawMessage RPC -> ByteString -> Either ParseError RPC
forall a. Parser RawMessage a -> ByteString -> Either ParseError a
parse Parser RawMessage RPC
rpcParser

-- Wire framing

-- | Encode an RPC with uvarint length prefix.
encodeFramed :: RPC -> ByteString
encodeFramed :: RPC -> ByteString
encodeFramed RPC
rpc =
  let payload :: ByteString
payload = RPC -> ByteString
encodeRPC RPC
rpc
      lenPrefix :: ByteString
lenPrefix = Word64 -> ByteString
encodeUvarint (Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int
BS.length ByteString
payload))
  in ByteString
lenPrefix ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
payload

-- | Decode an RPC from uvarint-length-prefixed bytes.
decodeFramed :: Int -> ByteString -> Either String RPC
decodeFramed :: Int -> ByteString -> Either String RPC
decodeFramed Int
maxSize ByteString
bs = do
  (len, rest) <- ByteString -> Either String (Word64, ByteString)
decodeUvarint ByteString
bs
  let msgLen = Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
len :: Int
  if msgLen > maxSize
    then Left $ "GossipSub RPC too large: " ++ show msgLen ++ " > " ++ show maxSize
    else if BS.length rest < msgLen
      then Left "GossipSub RPC truncated"
      else case decodeRPC (BS.take msgLen rest) of
        Left ParseError
err -> String -> Either String RPC
forall a b. a -> Either a b
Left (String -> Either String RPC) -> String -> Either String RPC
forall a b. (a -> b) -> a -> b
$ String
"GossipSub protobuf decode error: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ ParseError -> String
forall a. Show a => a -> String
show ParseError
err
        Right RPC
rpc -> RPC -> Either String RPC
forall a b. b -> Either a b
Right RPC
rpc

-- Stream I/O helpers

-- | Write a framed RPC to a stream.
writeRPCMessage :: StreamIO -> RPC -> IO ()
writeRPCMessage :: StreamIO -> RPC -> IO ()
writeRPCMessage StreamIO
stream RPC
rpc = StreamIO -> ByteString -> IO ()
streamWrite StreamIO
stream (RPC -> ByteString
encodeFramed RPC
rpc)

-- | Read a framed RPC from a stream.
readRPCMessage :: StreamIO -> Int -> IO (Either String RPC)
readRPCMessage :: StreamIO -> Int -> IO (Either String RPC)
readRPCMessage StreamIO
stream Int
maxSize = do
  varintBytes <- StreamIO -> IO ByteString
readVarintBytes StreamIO
stream
  case decodeUvarint varintBytes of
    Left String
err -> Either String RPC -> IO (Either String RPC)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> Either String RPC
forall a b. a -> Either a b
Left (String -> Either String RPC) -> String -> Either String RPC
forall a b. (a -> b) -> a -> b
$ String
"GossipSub varint decode error: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
err)
    Right (Word64
len, ByteString
_) -> do
      let msgLen :: Int
msgLen = Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
len :: Int
      if Int
msgLen Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
maxSize
        then Either String RPC -> IO (Either String RPC)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> Either String RPC
forall a b. a -> Either a b
Left (String -> Either String RPC) -> String -> Either String RPC
forall a b. (a -> b) -> a -> b
$ String
"GossipSub RPC too large: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
msgLen String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" > " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
maxSize)
        else do
          payload <- StreamIO -> Int -> IO ByteString
readExact StreamIO
stream Int
msgLen
          case decodeRPC payload of
            Left ParseError
err -> Either String RPC -> IO (Either String RPC)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> Either String RPC
forall a b. a -> Either a b
Left (String -> Either String RPC) -> String -> Either String RPC
forall a b. (a -> b) -> a -> b
$ String
"GossipSub protobuf decode error: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ ParseError -> String
forall a. Show a => a -> String
show ParseError
err)
            Right RPC
rpc -> Either String RPC -> IO (Either String RPC)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RPC -> Either String RPC
forall a b. b -> Either a b
Right RPC
rpc)

-- | Read exactly n bytes from a stream.
readExact :: StreamIO -> Int -> IO ByteString
readExact :: StreamIO -> Int -> IO ByteString
readExact StreamIO
stream Int
n = [Word8] -> ByteString
BS.pack ([Word8] -> ByteString) -> IO [Word8] -> IO ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int -> IO Word8) -> [Int] -> IO [Word8]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (IO Word8 -> Int -> IO Word8
forall a b. a -> b -> a
const (StreamIO -> IO Word8
streamReadByte StreamIO
stream)) [Int
1 .. Int
n]

-- | Read unsigned varint bytes (up to 10).
readVarintBytes :: StreamIO -> IO ByteString
readVarintBytes :: StreamIO -> IO ByteString
readVarintBytes StreamIO
stream = [Word8] -> Int -> IO ByteString
forall {t}. (Ord t, Num t) => [Word8] -> t -> IO ByteString
go [] (Int
0 :: Int)
  where
    go :: [Word8] -> t -> IO ByteString
go [Word8]
acc t
n
      | t
n t -> t -> Bool
forall a. Ord a => a -> a -> Bool
>= t
10 = ByteString -> IO ByteString
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Word8] -> ByteString
BS.pack ([Word8] -> [Word8]
forall a. [a] -> [a]
reverse [Word8]
acc))
      | Bool
otherwise = do
          b <- StreamIO -> IO Word8
streamReadByte StreamIO
stream
          if b < 0x80
            then pure (BS.pack (reverse (b : acc)))
            else go (b : acc) (n + 1)