-- | AutoNAT v1 message encoding/decoding (protobuf).
--
-- Wire format from docs/10-nat-traversal.md:
--   Message framing: [uvarint length][protobuf message]
--   AutoNAT Message fields: type(1), dial(2), dialResponse(3)
--   PeerInfo fields: id(1), addrs(2)
--   Dial fields: peer(1)
--   DialResponse fields: status(1), statusText(2), addr(3)
--
-- Uses proto3-wire for protobuf encoding/decoding, same pattern as DHT.Message.
module Network.LibP2P.NAT.AutoNAT.Message
  ( -- * Types
    AutoNATMessageType (..)
  , ResponseStatus (..)
  , AutoNATPeerInfo (..)
  , AutoNATDial (..)
  , AutoNATDialResponse (..)
  , AutoNATMessage (..)
    -- * Protobuf encode/decode (no framing)
  , encodeAutoNATMessage
  , decodeAutoNATMessage
    -- * Wire framing (uvarint length prefix)
  , encodeAutoNATFramed
  , decodeAutoNATFramed
    -- * Stream I/O helpers
  , writeAutoNATMessage
  , readAutoNATMessage
    -- * Status conversion helpers
  , responseStatusToWord
  , wordToResponseStatus
    -- * Constants
  , maxAutoNATMessageSize
  , autoNATProtocolId
  ) 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 (Word32)
import Proto3.Wire.Decode (Parser, RawMessage, ParseError, at, one, optional, repeated, 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 (..))

-- | AutoNAT protocol identifier.
autoNATProtocolId :: Text
autoNATProtocolId :: Text
autoNATProtocolId = Text
"/libp2p/autonat/1.0.0"

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

-- | AutoNAT message type.
data AutoNATMessageType = DIAL | DIAL_RESPONSE
  deriving (Int -> AutoNATMessageType -> ShowS
[AutoNATMessageType] -> ShowS
AutoNATMessageType -> String
(Int -> AutoNATMessageType -> ShowS)
-> (AutoNATMessageType -> String)
-> ([AutoNATMessageType] -> ShowS)
-> Show AutoNATMessageType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AutoNATMessageType -> ShowS
showsPrec :: Int -> AutoNATMessageType -> ShowS
$cshow :: AutoNATMessageType -> String
show :: AutoNATMessageType -> String
$cshowList :: [AutoNATMessageType] -> ShowS
showList :: [AutoNATMessageType] -> ShowS
Show, AutoNATMessageType -> AutoNATMessageType -> Bool
(AutoNATMessageType -> AutoNATMessageType -> Bool)
-> (AutoNATMessageType -> AutoNATMessageType -> Bool)
-> Eq AutoNATMessageType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AutoNATMessageType -> AutoNATMessageType -> Bool
== :: AutoNATMessageType -> AutoNATMessageType -> Bool
$c/= :: AutoNATMessageType -> AutoNATMessageType -> Bool
/= :: AutoNATMessageType -> AutoNATMessageType -> Bool
Eq)

-- | AutoNAT response status.
-- Wire values are non-contiguous: OK=0, E_DIAL_ERROR=100, E_DIAL_REFUSED=101,
-- E_BAD_REQUEST=200, E_INTERNAL_ERROR=300.
data ResponseStatus
  = StatusOK         -- ^ 0
  | EDialError       -- ^ 100
  | EDialRefused     -- ^ 101
  | EBadRequest      -- ^ 200
  | EInternalError   -- ^ 300
  deriving (Int -> ResponseStatus -> ShowS
[ResponseStatus] -> ShowS
ResponseStatus -> String
(Int -> ResponseStatus -> ShowS)
-> (ResponseStatus -> String)
-> ([ResponseStatus] -> ShowS)
-> Show ResponseStatus
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ResponseStatus -> ShowS
showsPrec :: Int -> ResponseStatus -> ShowS
$cshow :: ResponseStatus -> String
show :: ResponseStatus -> String
$cshowList :: [ResponseStatus] -> ShowS
showList :: [ResponseStatus] -> ShowS
Show, ResponseStatus -> ResponseStatus -> Bool
(ResponseStatus -> ResponseStatus -> Bool)
-> (ResponseStatus -> ResponseStatus -> Bool) -> Eq ResponseStatus
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ResponseStatus -> ResponseStatus -> Bool
== :: ResponseStatus -> ResponseStatus -> Bool
$c/= :: ResponseStatus -> ResponseStatus -> Bool
/= :: ResponseStatus -> ResponseStatus -> Bool
Eq)

-- | Convert ResponseStatus to wire value.
responseStatusToWord :: ResponseStatus -> Word32
responseStatusToWord :: ResponseStatus -> Word32
responseStatusToWord ResponseStatus
StatusOK       = Word32
0
responseStatusToWord ResponseStatus
EDialError     = Word32
100
responseStatusToWord ResponseStatus
EDialRefused   = Word32
101
responseStatusToWord ResponseStatus
EBadRequest    = Word32
200
responseStatusToWord ResponseStatus
EInternalError = Word32
300

-- | Convert wire value to ResponseStatus.
wordToResponseStatus :: Word32 -> Maybe ResponseStatus
wordToResponseStatus :: Word32 -> Maybe ResponseStatus
wordToResponseStatus Word32
0   = ResponseStatus -> Maybe ResponseStatus
forall a. a -> Maybe a
Just ResponseStatus
StatusOK
wordToResponseStatus Word32
100 = ResponseStatus -> Maybe ResponseStatus
forall a. a -> Maybe a
Just ResponseStatus
EDialError
wordToResponseStatus Word32
101 = ResponseStatus -> Maybe ResponseStatus
forall a. a -> Maybe a
Just ResponseStatus
EDialRefused
wordToResponseStatus Word32
200 = ResponseStatus -> Maybe ResponseStatus
forall a. a -> Maybe a
Just ResponseStatus
EBadRequest
wordToResponseStatus Word32
300 = ResponseStatus -> Maybe ResponseStatus
forall a. a -> Maybe a
Just ResponseStatus
EInternalError
wordToResponseStatus Word32
_   = Maybe ResponseStatus
forall a. Maybe a
Nothing

-- | AutoNAT peer info (nested message).
data AutoNATPeerInfo = AutoNATPeerInfo
  { AutoNATPeerInfo -> ByteString
anPeerId :: !ByteString     -- ^ field 1: peer ID bytes
  , AutoNATPeerInfo -> [ByteString]
anAddrs  :: ![ByteString]   -- ^ field 2: multiaddr bytes (repeated)
  } deriving (Int -> AutoNATPeerInfo -> ShowS
[AutoNATPeerInfo] -> ShowS
AutoNATPeerInfo -> String
(Int -> AutoNATPeerInfo -> ShowS)
-> (AutoNATPeerInfo -> String)
-> ([AutoNATPeerInfo] -> ShowS)
-> Show AutoNATPeerInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AutoNATPeerInfo -> ShowS
showsPrec :: Int -> AutoNATPeerInfo -> ShowS
$cshow :: AutoNATPeerInfo -> String
show :: AutoNATPeerInfo -> String
$cshowList :: [AutoNATPeerInfo] -> ShowS
showList :: [AutoNATPeerInfo] -> ShowS
Show, AutoNATPeerInfo -> AutoNATPeerInfo -> Bool
(AutoNATPeerInfo -> AutoNATPeerInfo -> Bool)
-> (AutoNATPeerInfo -> AutoNATPeerInfo -> Bool)
-> Eq AutoNATPeerInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AutoNATPeerInfo -> AutoNATPeerInfo -> Bool
== :: AutoNATPeerInfo -> AutoNATPeerInfo -> Bool
$c/= :: AutoNATPeerInfo -> AutoNATPeerInfo -> Bool
/= :: AutoNATPeerInfo -> AutoNATPeerInfo -> Bool
Eq)

-- | AutoNAT Dial sub-message.
data AutoNATDial = AutoNATDial
  { AutoNATDial -> Maybe AutoNATPeerInfo
anDialPeer :: !(Maybe AutoNATPeerInfo)  -- ^ field 1: peer info
  } deriving (Int -> AutoNATDial -> ShowS
[AutoNATDial] -> ShowS
AutoNATDial -> String
(Int -> AutoNATDial -> ShowS)
-> (AutoNATDial -> String)
-> ([AutoNATDial] -> ShowS)
-> Show AutoNATDial
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AutoNATDial -> ShowS
showsPrec :: Int -> AutoNATDial -> ShowS
$cshow :: AutoNATDial -> String
show :: AutoNATDial -> String
$cshowList :: [AutoNATDial] -> ShowS
showList :: [AutoNATDial] -> ShowS
Show, AutoNATDial -> AutoNATDial -> Bool
(AutoNATDial -> AutoNATDial -> Bool)
-> (AutoNATDial -> AutoNATDial -> Bool) -> Eq AutoNATDial
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AutoNATDial -> AutoNATDial -> Bool
== :: AutoNATDial -> AutoNATDial -> Bool
$c/= :: AutoNATDial -> AutoNATDial -> Bool
/= :: AutoNATDial -> AutoNATDial -> Bool
Eq)

-- | AutoNAT DialResponse sub-message.
data AutoNATDialResponse = AutoNATDialResponse
  { AutoNATDialResponse -> Maybe ResponseStatus
anRespStatus     :: !(Maybe ResponseStatus)  -- ^ field 1: status enum
  , AutoNATDialResponse -> Maybe Text
anRespStatusText :: !(Maybe Text)             -- ^ field 2: human-readable text
  , AutoNATDialResponse -> Maybe ByteString
anRespAddr       :: !(Maybe ByteString)       -- ^ field 3: successful dial-back addr
  } deriving (Int -> AutoNATDialResponse -> ShowS
[AutoNATDialResponse] -> ShowS
AutoNATDialResponse -> String
(Int -> AutoNATDialResponse -> ShowS)
-> (AutoNATDialResponse -> String)
-> ([AutoNATDialResponse] -> ShowS)
-> Show AutoNATDialResponse
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AutoNATDialResponse -> ShowS
showsPrec :: Int -> AutoNATDialResponse -> ShowS
$cshow :: AutoNATDialResponse -> String
show :: AutoNATDialResponse -> String
$cshowList :: [AutoNATDialResponse] -> ShowS
showList :: [AutoNATDialResponse] -> ShowS
Show, AutoNATDialResponse -> AutoNATDialResponse -> Bool
(AutoNATDialResponse -> AutoNATDialResponse -> Bool)
-> (AutoNATDialResponse -> AutoNATDialResponse -> Bool)
-> Eq AutoNATDialResponse
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AutoNATDialResponse -> AutoNATDialResponse -> Bool
== :: AutoNATDialResponse -> AutoNATDialResponse -> Bool
$c/= :: AutoNATDialResponse -> AutoNATDialResponse -> Bool
/= :: AutoNATDialResponse -> AutoNATDialResponse -> Bool
Eq)

-- | AutoNAT top-level message.
data AutoNATMessage = AutoNATMessage
  { AutoNATMessage -> Maybe AutoNATMessageType
anMsgType         :: !(Maybe AutoNATMessageType)      -- ^ field 1
  , AutoNATMessage -> Maybe AutoNATDial
anMsgDial         :: !(Maybe AutoNATDial)             -- ^ field 2
  , AutoNATMessage -> Maybe AutoNATDialResponse
anMsgDialResponse :: !(Maybe AutoNATDialResponse)     -- ^ field 3
  } deriving (Int -> AutoNATMessage -> ShowS
[AutoNATMessage] -> ShowS
AutoNATMessage -> String
(Int -> AutoNATMessage -> ShowS)
-> (AutoNATMessage -> String)
-> ([AutoNATMessage] -> ShowS)
-> Show AutoNATMessage
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AutoNATMessage -> ShowS
showsPrec :: Int -> AutoNATMessage -> ShowS
$cshow :: AutoNATMessage -> String
show :: AutoNATMessage -> String
$cshowList :: [AutoNATMessage] -> ShowS
showList :: [AutoNATMessage] -> ShowS
Show, AutoNATMessage -> AutoNATMessage -> Bool
(AutoNATMessage -> AutoNATMessage -> Bool)
-> (AutoNATMessage -> AutoNATMessage -> Bool) -> Eq AutoNATMessage
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AutoNATMessage -> AutoNATMessage -> Bool
== :: AutoNATMessage -> AutoNATMessage -> Bool
$c/= :: AutoNATMessage -> AutoNATMessage -> Bool
/= :: AutoNATMessage -> AutoNATMessage -> Bool
Eq)

-- Encoding

-- | Encode message type to wire value.
msgTypeToWord :: AutoNATMessageType -> Word32
msgTypeToWord :: AutoNATMessageType -> Word32
msgTypeToWord AutoNATMessageType
DIAL          = Word32
0
msgTypeToWord AutoNATMessageType
DIAL_RESPONSE = Word32
1

-- | Encode an AutoNATMessage to protobuf wire format (no length prefix).
encodeAutoNATMessage :: AutoNATMessage -> ByteString
encodeAutoNATMessage :: AutoNATMessage -> ByteString
encodeAutoNATMessage AutoNATMessage
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
$
     Word -> Maybe AutoNATMessageType -> MessageBuilder
optEnum Word
1 (AutoNATMessage -> Maybe AutoNATMessageType
anMsgType AutoNATMessage
msg)
  MessageBuilder -> MessageBuilder -> MessageBuilder
forall a. Semigroup a => a -> a -> a
<> Word
-> (AutoNATDial -> MessageBuilder)
-> Maybe AutoNATDial
-> MessageBuilder
forall a.
Word -> (a -> MessageBuilder) -> Maybe a -> MessageBuilder
optEmbedded Word
2 AutoNATDial -> MessageBuilder
encodeAutoNATDial (AutoNATMessage -> Maybe AutoNATDial
anMsgDial AutoNATMessage
msg)
  MessageBuilder -> MessageBuilder -> MessageBuilder
forall a. Semigroup a => a -> a -> a
<> Word
-> (AutoNATDialResponse -> MessageBuilder)
-> Maybe AutoNATDialResponse
-> MessageBuilder
forall a.
Word -> (a -> MessageBuilder) -> Maybe a -> MessageBuilder
optEmbedded Word
3 AutoNATDialResponse -> MessageBuilder
encodeAutoNATDialResponse (AutoNATMessage -> Maybe AutoNATDialResponse
anMsgDialResponse AutoNATMessage
msg)
  where
    optEnum :: Word -> Maybe AutoNATMessageType -> MessageBuilder
    optEnum :: Word -> Maybe AutoNATMessageType -> MessageBuilder
optEnum Word
_ Maybe AutoNATMessageType
Nothing  = MessageBuilder
forall a. Monoid a => a
mempty
    optEnum Word
n (Just AutoNATMessageType
t) = FieldNumber -> Word32 -> MessageBuilder
Encode.uint32 (Word64 -> FieldNumber
FieldNumber (Word -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
n)) (AutoNATMessageType -> Word32
msgTypeToWord AutoNATMessageType
t)

    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)

-- | Encode AutoNATDial sub-message.
encodeAutoNATDial :: AutoNATDial -> MessageBuilder
encodeAutoNATDial :: AutoNATDial -> MessageBuilder
encodeAutoNATDial AutoNATDial
dial =
  case AutoNATDial -> Maybe AutoNATPeerInfo
anDialPeer AutoNATDial
dial of
    Maybe AutoNATPeerInfo
Nothing   -> MessageBuilder
forall a. Monoid a => a
mempty
    Just AutoNATPeerInfo
peer -> FieldNumber -> MessageBuilder -> MessageBuilder
Encode.embedded (Word64 -> FieldNumber
FieldNumber Word64
1) (AutoNATPeerInfo -> MessageBuilder
encodeAutoNATPeerInfo AutoNATPeerInfo
peer)

-- | Encode AutoNATDialResponse sub-message.
encodeAutoNATDialResponse :: AutoNATDialResponse -> MessageBuilder
encodeAutoNATDialResponse :: AutoNATDialResponse -> MessageBuilder
encodeAutoNATDialResponse AutoNATDialResponse
resp =
     Word -> Maybe ResponseStatus -> MessageBuilder
optStatus Word
1 (AutoNATDialResponse -> Maybe ResponseStatus
anRespStatus AutoNATDialResponse
resp)
  MessageBuilder -> MessageBuilder -> MessageBuilder
forall a. Semigroup a => a -> a -> a
<> Word -> Maybe Text -> MessageBuilder
optText Word
2 (AutoNATDialResponse -> Maybe Text
anRespStatusText AutoNATDialResponse
resp)
  MessageBuilder -> MessageBuilder -> MessageBuilder
forall a. Semigroup a => a -> a -> a
<> Word -> Maybe ByteString -> MessageBuilder
optBytes Word
3 (AutoNATDialResponse -> Maybe ByteString
anRespAddr AutoNATDialResponse
resp)
  where
    optStatus :: Word -> Maybe ResponseStatus -> MessageBuilder
    optStatus :: Word -> Maybe ResponseStatus -> MessageBuilder
optStatus Word
_ Maybe ResponseStatus
Nothing  = MessageBuilder
forall a. Monoid a => a
mempty
    optStatus Word
n (Just ResponseStatus
s) = FieldNumber -> Word32 -> MessageBuilder
Encode.uint32 (Word64 -> FieldNumber
FieldNumber (Word -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
n)) (ResponseStatus -> Word32
responseStatusToWord ResponseStatus
s)

    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
t) = 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
t)

    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

-- | Encode AutoNATPeerInfo sub-message.
encodeAutoNATPeerInfo :: AutoNATPeerInfo -> MessageBuilder
encodeAutoNATPeerInfo :: AutoNATPeerInfo -> MessageBuilder
encodeAutoNATPeerInfo AutoNATPeerInfo
peer =
     Word -> Maybe ByteString -> MessageBuilder
optBytes Word
1 (ByteString -> Maybe ByteString
nonEmpty (AutoNATPeerInfo -> ByteString
anPeerId AutoNATPeerInfo
peer))
  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
a -> FieldNumber -> ByteString -> MessageBuilder
Encode.byteString (Word64 -> FieldNumber
FieldNumber Word64
2) ByteString
a) (AutoNATPeerInfo -> [ByteString]
anAddrs AutoNATPeerInfo
peer)
  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

    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

-- Decoding

-- | Decode an AutoNATMessage from protobuf wire format.
decodeAutoNATMessage :: ByteString -> Either ParseError AutoNATMessage
decodeAutoNATMessage :: ByteString -> Either ParseError AutoNATMessage
decodeAutoNATMessage = Parser RawMessage AutoNATMessage
-> ByteString -> Either ParseError AutoNATMessage
forall a. Parser RawMessage a -> ByteString -> Either ParseError a
parse Parser RawMessage AutoNATMessage
autoNATMessageParser

autoNATMessageParser :: Parser RawMessage AutoNATMessage
autoNATMessageParser :: Parser RawMessage AutoNATMessage
autoNATMessageParser = Maybe AutoNATMessageType
-> Maybe AutoNATDial -> Maybe AutoNATDialResponse -> AutoNATMessage
AutoNATMessage
  (Maybe AutoNATMessageType
 -> Maybe AutoNATDial
 -> Maybe AutoNATDialResponse
 -> AutoNATMessage)
-> Parser RawMessage (Maybe AutoNATMessageType)
-> Parser
     RawMessage
     (Maybe AutoNATDial -> Maybe AutoNATDialResponse -> AutoNATMessage)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser RawField (Maybe AutoNATMessageType)
-> FieldNumber -> Parser RawMessage (Maybe AutoNATMessageType)
forall a. Parser RawField a -> FieldNumber -> Parser RawMessage a
at ((Maybe Word32 -> Maybe AutoNATMessageType)
-> Parser RawField (Maybe Word32)
-> Parser RawField (Maybe AutoNATMessageType)
forall a b. (a -> b) -> Parser RawField a -> Parser RawField b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Maybe Word32 -> Maybe AutoNATMessageType
wordToMsgType (Parser RawPrimitive Word32 -> Parser RawField (Maybe Word32)
forall a. Parser RawPrimitive a -> Parser RawField (Maybe a)
optional Parser RawPrimitive Word32
Decode.uint32)) (Word64 -> FieldNumber
FieldNumber Word64
1)
  Parser
  RawMessage
  (Maybe AutoNATDial -> Maybe AutoNATDialResponse -> AutoNATMessage)
-> Parser RawMessage (Maybe AutoNATDial)
-> Parser RawMessage (Maybe AutoNATDialResponse -> AutoNATMessage)
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 AutoNATDial)
-> FieldNumber -> Parser RawMessage (Maybe AutoNATDial)
forall a. Parser RawField a -> FieldNumber -> Parser RawMessage a
at (Parser RawMessage AutoNATDial
-> Parser RawField (Maybe AutoNATDial)
forall a. Parser RawMessage a -> Parser RawField (Maybe a)
embedded Parser RawMessage AutoNATDial
autoNATDialParser) (Word64 -> FieldNumber
FieldNumber Word64
2)
  Parser RawMessage (Maybe AutoNATDialResponse -> AutoNATMessage)
-> Parser RawMessage (Maybe AutoNATDialResponse)
-> Parser RawMessage AutoNATMessage
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 AutoNATDialResponse)
-> FieldNumber -> Parser RawMessage (Maybe AutoNATDialResponse)
forall a. Parser RawField a -> FieldNumber -> Parser RawMessage a
at (Parser RawMessage AutoNATDialResponse
-> Parser RawField (Maybe AutoNATDialResponse)
forall a. Parser RawMessage a -> Parser RawField (Maybe a)
embedded Parser RawMessage AutoNATDialResponse
autoNATDialResponseParser) (Word64 -> FieldNumber
FieldNumber Word64
3)
  where
    wordToMsgType :: Maybe Word32 -> Maybe AutoNATMessageType
    wordToMsgType :: Maybe Word32 -> Maybe AutoNATMessageType
wordToMsgType (Just Word32
0) = AutoNATMessageType -> Maybe AutoNATMessageType
forall a. a -> Maybe a
Just AutoNATMessageType
DIAL
    wordToMsgType (Just Word32
1) = AutoNATMessageType -> Maybe AutoNATMessageType
forall a. a -> Maybe a
Just AutoNATMessageType
DIAL_RESPONSE
    wordToMsgType Maybe Word32
_        = Maybe AutoNATMessageType
forall a. Maybe a
Nothing

-- | Parse AutoNATDial sub-message.
autoNATDialParser :: Parser RawMessage AutoNATDial
autoNATDialParser :: Parser RawMessage AutoNATDial
autoNATDialParser = Maybe AutoNATPeerInfo -> AutoNATDial
AutoNATDial
  (Maybe AutoNATPeerInfo -> AutoNATDial)
-> Parser RawMessage (Maybe AutoNATPeerInfo)
-> Parser RawMessage AutoNATDial
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser RawField (Maybe AutoNATPeerInfo)
-> FieldNumber -> Parser RawMessage (Maybe AutoNATPeerInfo)
forall a. Parser RawField a -> FieldNumber -> Parser RawMessage a
at (Parser RawMessage AutoNATPeerInfo
-> Parser RawField (Maybe AutoNATPeerInfo)
forall a. Parser RawMessage a -> Parser RawField (Maybe a)
embedded Parser RawMessage AutoNATPeerInfo
autoNATPeerInfoParser) (Word64 -> FieldNumber
FieldNumber Word64
1)

-- | Parse AutoNATDialResponse sub-message.
autoNATDialResponseParser :: Parser RawMessage AutoNATDialResponse
autoNATDialResponseParser :: Parser RawMessage AutoNATDialResponse
autoNATDialResponseParser = Maybe ResponseStatus
-> Maybe Text -> Maybe ByteString -> AutoNATDialResponse
AutoNATDialResponse
  (Maybe ResponseStatus
 -> Maybe Text -> Maybe ByteString -> AutoNATDialResponse)
-> Parser RawMessage (Maybe ResponseStatus)
-> Parser
     RawMessage (Maybe Text -> Maybe ByteString -> AutoNATDialResponse)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser RawField (Maybe ResponseStatus)
-> FieldNumber -> Parser RawMessage (Maybe ResponseStatus)
forall a. Parser RawField a -> FieldNumber -> Parser RawMessage a
at ((Maybe Word32 -> Maybe ResponseStatus)
-> Parser RawField (Maybe Word32)
-> Parser RawField (Maybe ResponseStatus)
forall a b. (a -> b) -> Parser RawField a -> Parser RawField b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Maybe Word32 -> Maybe ResponseStatus
wordToStatus (Parser RawPrimitive Word32 -> Parser RawField (Maybe Word32)
forall a. Parser RawPrimitive a -> Parser RawField (Maybe a)
optional Parser RawPrimitive Word32
Decode.uint32)) (Word64 -> FieldNumber
FieldNumber Word64
1)
  Parser
  RawMessage (Maybe Text -> Maybe ByteString -> AutoNATDialResponse)
-> Parser RawMessage (Maybe Text)
-> Parser RawMessage (Maybe ByteString -> AutoNATDialResponse)
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 ((Maybe Text -> Maybe Text)
-> Parser RawField (Maybe Text) -> Parser RawField (Maybe Text)
forall a b. (a -> b) -> Parser RawField a -> Parser RawField b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Text -> Text) -> Maybe Text -> Maybe Text
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Text
TL.toStrict) (Parser RawPrimitive Text -> Parser RawField (Maybe Text)
forall a. Parser RawPrimitive a -> Parser RawField (Maybe a)
optional Parser RawPrimitive Text
Decode.text)) (Word64 -> FieldNumber
FieldNumber Word64
2)
  Parser RawMessage (Maybe ByteString -> AutoNATDialResponse)
-> Parser RawMessage (Maybe ByteString)
-> Parser RawMessage AutoNATDialResponse
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)
  where
    wordToStatus :: Maybe Word32 -> Maybe ResponseStatus
    wordToStatus :: Maybe Word32 -> Maybe ResponseStatus
wordToStatus (Just Word32
w) = Word32 -> Maybe ResponseStatus
wordToResponseStatus Word32
w
    wordToStatus Maybe Word32
Nothing  = Maybe ResponseStatus
forall a. Maybe a
Nothing

-- | Parse AutoNATPeerInfo sub-message.
autoNATPeerInfoParser :: Parser RawMessage AutoNATPeerInfo
autoNATPeerInfoParser :: Parser RawMessage AutoNATPeerInfo
autoNATPeerInfoParser = ByteString -> [ByteString] -> AutoNATPeerInfo
AutoNATPeerInfo
  (ByteString -> [ByteString] -> AutoNATPeerInfo)
-> Parser RawMessage ByteString
-> Parser RawMessage ([ByteString] -> AutoNATPeerInfo)
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 ([ByteString] -> AutoNATPeerInfo)
-> Parser RawMessage [ByteString]
-> Parser RawMessage AutoNATPeerInfo
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)

-- Wire framing

-- | Encode an AutoNATMessage with uvarint length prefix.
encodeAutoNATFramed :: AutoNATMessage -> ByteString
encodeAutoNATFramed :: AutoNATMessage -> ByteString
encodeAutoNATFramed AutoNATMessage
msg =
  let payload :: ByteString
payload = AutoNATMessage -> ByteString
encodeAutoNATMessage AutoNATMessage
msg
      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 AutoNATMessage from uvarint-length-prefixed bytes.
decodeAutoNATFramed :: Int -> ByteString -> Either String AutoNATMessage
decodeAutoNATFramed :: Int -> ByteString -> Either String AutoNATMessage
decodeAutoNATFramed 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 $ "AutoNAT message too large: " ++ show msgLen ++ " > " ++ show maxSize
    else if BS.length rest < msgLen
      then Left $ "AutoNAT message truncated: expected " ++ show msgLen ++ " bytes, got " ++ show (BS.length rest)
      else case decodeAutoNATMessage (BS.take msgLen rest) of
        Left ParseError
err -> String -> Either String AutoNATMessage
forall a b. a -> Either a b
Left (String -> Either String AutoNATMessage)
-> String -> Either String AutoNATMessage
forall a b. (a -> b) -> a -> b
$ String
"AutoNAT protobuf decode error: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ParseError -> String
forall a. Show a => a -> String
show ParseError
err
        Right AutoNATMessage
msg -> AutoNATMessage -> Either String AutoNATMessage
forall a b. b -> Either a b
Right AutoNATMessage
msg

-- Stream I/O helpers

-- | Write a framed AutoNAT message to a stream.
writeAutoNATMessage :: StreamIO -> AutoNATMessage -> IO ()
writeAutoNATMessage :: StreamIO -> AutoNATMessage -> IO ()
writeAutoNATMessage StreamIO
stream AutoNATMessage
msg = StreamIO -> ByteString -> IO ()
streamWrite StreamIO
stream (AutoNATMessage -> ByteString
encodeAutoNATFramed AutoNATMessage
msg)

-- | Read a framed AutoNAT message from a stream.
readAutoNATMessage :: StreamIO -> Int -> IO (Either String AutoNATMessage)
readAutoNATMessage :: StreamIO -> Int -> IO (Either String AutoNATMessage)
readAutoNATMessage StreamIO
stream Int
maxSize = do
  varintBytes <- StreamIO -> IO ByteString
readVarintBytes StreamIO
stream
  case decodeUvarint varintBytes of
    Left String
err -> Either String AutoNATMessage -> IO (Either String AutoNATMessage)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> Either String AutoNATMessage
forall a b. a -> Either a b
Left (String -> Either String AutoNATMessage)
-> String -> Either String AutoNATMessage
forall a b. (a -> b) -> a -> b
$ String
"AutoNAT varint decode error: " String -> ShowS
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 AutoNATMessage -> IO (Either String AutoNATMessage)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> Either String AutoNATMessage
forall a b. a -> Either a b
Left (String -> Either String AutoNATMessage)
-> String -> Either String AutoNATMessage
forall a b. (a -> b) -> a -> b
$ String
"AutoNAT message too large: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
msgLen String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" > " String -> ShowS
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 decodeAutoNATMessage payload of
            Left ParseError
err -> Either String AutoNATMessage -> IO (Either String AutoNATMessage)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> Either String AutoNATMessage
forall a b. a -> Either a b
Left (String -> Either String AutoNATMessage)
-> String -> Either String AutoNATMessage
forall a b. (a -> b) -> a -> b
$ String
"AutoNAT protobuf decode error: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ParseError -> String
forall a. Show a => a -> String
show ParseError
err)
            Right AutoNATMessage
msg -> Either String AutoNATMessage -> IO (Either String AutoNATMessage)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AutoNATMessage -> Either String AutoNATMessage
forall a b. b -> Either a b
Right AutoNATMessage
msg)

-- | 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 from a stream (up to 10 bytes).
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)