-- | Identify protocol message encoding/decoding (protobuf).
--
-- Wire format from docs/07-protocols.md and specs/identify/README.md:
--   Field 1: publicKey       (bytes, optional)
--   Field 2: listenAddrs     (repeated bytes)
--   Field 3: protocols       (repeated string)
--   Field 4: observedAddr    (bytes, optional)
--   Field 5: protocolVersion (string, optional)
--   Field 6: agentVersion    (string, optional)
--
-- Uses proto3-wire for protobuf encoding/decoding. No length prefix;
-- the message boundary is determined by stream closure.
module Network.LibP2P.Protocol.Identify.Message
  ( IdentifyInfo (..)
  , encodeIdentify
  , decodeIdentify
  , maxIdentifySize
  ) where

import Data.ByteString (ByteString)
import qualified Data.ByteString.Lazy as BL
import Data.Text (Text)
import qualified Data.Text.Lazy as TL
import Proto3.Wire.Decode (Parser, RawMessage, ParseError, at, optional, repeated, 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 (..))

-- | Identify message payload.
data IdentifyInfo = IdentifyInfo
  { IdentifyInfo -> Maybe Text
idProtocolVersion :: !(Maybe Text)       -- ^ e.g. "ipfs/0.1.0"
  , IdentifyInfo -> Maybe Text
idAgentVersion    :: !(Maybe Text)       -- ^ e.g. "libp2p-hs/0.1.0"
  , IdentifyInfo -> Maybe ByteString
idPublicKey       :: !(Maybe ByteString) -- ^ Serialized PublicKey protobuf
  , IdentifyInfo -> [ByteString]
idListenAddrs     :: ![ByteString]       -- ^ Binary-encoded multiaddrs
  , IdentifyInfo -> Maybe ByteString
idObservedAddr    :: !(Maybe ByteString) -- ^ Binary-encoded observed multiaddr
  , IdentifyInfo -> [Text]
idProtocols       :: ![Text]             -- ^ Supported protocol IDs
  } deriving (Int -> IdentifyInfo -> ShowS
[IdentifyInfo] -> ShowS
IdentifyInfo -> String
(Int -> IdentifyInfo -> ShowS)
-> (IdentifyInfo -> String)
-> ([IdentifyInfo] -> ShowS)
-> Show IdentifyInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> IdentifyInfo -> ShowS
showsPrec :: Int -> IdentifyInfo -> ShowS
$cshow :: IdentifyInfo -> String
show :: IdentifyInfo -> String
$cshowList :: [IdentifyInfo] -> ShowS
showList :: [IdentifyInfo] -> ShowS
Show, IdentifyInfo -> IdentifyInfo -> Bool
(IdentifyInfo -> IdentifyInfo -> Bool)
-> (IdentifyInfo -> IdentifyInfo -> Bool) -> Eq IdentifyInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: IdentifyInfo -> IdentifyInfo -> Bool
== :: IdentifyInfo -> IdentifyInfo -> Bool
$c/= :: IdentifyInfo -> IdentifyInfo -> Bool
/= :: IdentifyInfo -> IdentifyInfo -> Bool
Eq)

-- | Maximum Identify message size: 64 KiB.
maxIdentifySize :: Int
maxIdentifySize :: Int
maxIdentifySize = Int
64 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
1024

-- | Encode an Identify message to protobuf wire format.
encodeIdentify :: IdentifyInfo -> ByteString
encodeIdentify :: IdentifyInfo -> ByteString
encodeIdentify IdentifyInfo
info = 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 -> Maybe ByteString -> MessageBuilder
optBytes Word
1 (IdentifyInfo -> Maybe ByteString
idPublicKey IdentifyInfo
info)
  MessageBuilder -> MessageBuilder -> MessageBuilder
forall a. Semigroup a => a -> a -> a
<> Word -> [ByteString] -> MessageBuilder
repBytes Word
2 (IdentifyInfo -> [ByteString]
idListenAddrs IdentifyInfo
info)
  MessageBuilder -> MessageBuilder -> MessageBuilder
forall a. Semigroup a => a -> a -> a
<> Word -> [Text] -> MessageBuilder
repText Word
3 (IdentifyInfo -> [Text]
idProtocols IdentifyInfo
info)
  MessageBuilder -> MessageBuilder -> MessageBuilder
forall a. Semigroup a => a -> a -> a
<> Word -> Maybe ByteString -> MessageBuilder
optBytes Word
4 (IdentifyInfo -> Maybe ByteString
idObservedAddr IdentifyInfo
info)
  MessageBuilder -> MessageBuilder -> MessageBuilder
forall a. Semigroup a => a -> a -> a
<> Word -> Maybe Text -> MessageBuilder
optText Word
5 (IdentifyInfo -> Maybe Text
idProtocolVersion IdentifyInfo
info)
  MessageBuilder -> MessageBuilder -> MessageBuilder
forall a. Semigroup a => a -> a -> a
<> Word -> Maybe Text -> MessageBuilder
optText Word
6 (IdentifyInfo -> Maybe Text
idAgentVersion IdentifyInfo
info)
  where
    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 Text -> MessageBuilder
optText Word
_ Maybe Text
Nothing  = MessageBuilder
forall a. Monoid a => a
mempty
    optText Word
n (Just Text
v) = FieldNumber -> Text -> MessageBuilder
Encode.text (Word64 -> FieldNumber
FieldNumber (Word -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
n)) (Text -> Text
TL.fromStrict Text
v)

    repBytes :: Word -> [ByteString] -> MessageBuilder
    repBytes :: Word -> [ByteString] -> MessageBuilder
repBytes Word
n = (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 (FieldNumber -> ByteString -> MessageBuilder
Encode.byteString (Word64 -> FieldNumber
FieldNumber (Word -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
n)))

    repText :: Word -> [Text] -> MessageBuilder
    repText :: Word -> [Text] -> MessageBuilder
repText Word
n = (Text -> MessageBuilder) -> [Text] -> MessageBuilder
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (FieldNumber -> Text -> MessageBuilder
Encode.text (Word64 -> FieldNumber
FieldNumber (Word -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
n)) (Text -> MessageBuilder)
-> (Text -> Text) -> Text -> MessageBuilder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
TL.fromStrict)

-- | Decode an Identify message from protobuf wire format.
decodeIdentify :: ByteString -> Either ParseError IdentifyInfo
decodeIdentify :: ByteString -> Either ParseError IdentifyInfo
decodeIdentify = Parser RawMessage IdentifyInfo
-> ByteString -> Either ParseError IdentifyInfo
forall a. Parser RawMessage a -> ByteString -> Either ParseError a
parse Parser RawMessage IdentifyInfo
identifyParser

identifyParser :: Parser RawMessage IdentifyInfo
identifyParser :: Parser RawMessage IdentifyInfo
identifyParser = Maybe Text
-> Maybe Text
-> Maybe ByteString
-> [ByteString]
-> Maybe ByteString
-> [Text]
-> IdentifyInfo
IdentifyInfo
  (Maybe Text
 -> Maybe Text
 -> Maybe ByteString
 -> [ByteString]
 -> Maybe ByteString
 -> [Text]
 -> IdentifyInfo)
-> Parser RawMessage (Maybe Text)
-> Parser
     RawMessage
     (Maybe Text
      -> Maybe ByteString
      -> [ByteString]
      -> Maybe ByteString
      -> [Text]
      -> IdentifyInfo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser RawField (Maybe Text)
-> FieldNumber -> Parser RawMessage (Maybe Text)
forall a. Parser RawField a -> FieldNumber -> Parser RawMessage a
at (Parser RawPrimitive Text -> Parser RawField (Maybe Text)
forall a. Parser RawPrimitive a -> Parser RawField (Maybe a)
optional (Text -> Text
TL.toStrict (Text -> Text)
-> Parser RawPrimitive Text -> Parser RawPrimitive Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser RawPrimitive Text
Decode.text)) (Word64 -> FieldNumber
FieldNumber Word64
5)  -- protocolVersion
  Parser
  RawMessage
  (Maybe Text
   -> Maybe ByteString
   -> [ByteString]
   -> Maybe ByteString
   -> [Text]
   -> IdentifyInfo)
-> Parser RawMessage (Maybe Text)
-> Parser
     RawMessage
     (Maybe ByteString
      -> [ByteString] -> Maybe ByteString -> [Text] -> IdentifyInfo)
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 Text)
-> FieldNumber -> Parser RawMessage (Maybe Text)
forall a. Parser RawField a -> FieldNumber -> Parser RawMessage a
at (Parser RawPrimitive Text -> Parser RawField (Maybe Text)
forall a. Parser RawPrimitive a -> Parser RawField (Maybe a)
optional (Text -> Text
TL.toStrict (Text -> Text)
-> Parser RawPrimitive Text -> Parser RawPrimitive Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser RawPrimitive Text
Decode.text)) (Word64 -> FieldNumber
FieldNumber Word64
6)  -- agentVersion
  Parser
  RawMessage
  (Maybe ByteString
   -> [ByteString] -> Maybe ByteString -> [Text] -> IdentifyInfo)
-> Parser RawMessage (Maybe ByteString)
-> Parser
     RawMessage
     ([ByteString] -> Maybe ByteString -> [Text] -> IdentifyInfo)
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
1)  -- publicKey
  Parser
  RawMessage
  ([ByteString] -> Maybe ByteString -> [Text] -> IdentifyInfo)
-> Parser RawMessage [ByteString]
-> Parser RawMessage (Maybe ByteString -> [Text] -> IdentifyInfo)
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)  -- listenAddrs
  Parser RawMessage (Maybe ByteString -> [Text] -> IdentifyInfo)
-> Parser RawMessage (Maybe ByteString)
-> Parser RawMessage ([Text] -> IdentifyInfo)
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
4)  -- observedAddr
  Parser RawMessage ([Text] -> IdentifyInfo)
-> Parser RawMessage [Text] -> Parser RawMessage IdentifyInfo
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 [Text] -> FieldNumber -> Parser RawMessage [Text]
forall a. Parser RawField a -> FieldNumber -> Parser RawMessage a
at (Parser RawPrimitive Text -> Parser RawField [Text]
forall a. Parser RawPrimitive a -> Parser RawField [a]
repeated (Text -> Text
TL.toStrict (Text -> Text)
-> Parser RawPrimitive Text -> Parser RawPrimitive Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser RawPrimitive Text
Decode.text))  (Word64 -> FieldNumber
FieldNumber Word64
3)  -- protocols