-- | Circuit Relay v2 message encoding/decoding (protobuf).
--
-- Two message types:
--   HopMessage: client ↔ relay (RESERVE, CONNECT, STATUS)
--   StopMessage: relay ↔ target (CONNECT, STATUS)
--
-- Wire format: [uvarint length][protobuf message]
--
-- HopMessage fields: type(1), peer(2), reservation(3), limit(4), status(5)
-- StopMessage fields: type(1), peer(2), limit(3), status(4)
-- Peer fields: id(1), addrs(2)
-- Reservation fields: expire(1), addrs(2), voucher(3)
-- Limit fields: duration(1), data(2)
module Network.LibP2P.NAT.Relay.Message
  ( -- * Types
    HopMessageType (..)
  , StopMessageType (..)
  , RelayStatus (..)
  , RelayPeer (..)
  , Reservation (..)
  , RelayLimit (..)
  , HopMessage (..)
  , StopMessage (..)
    -- * Status conversion
  , relayStatusToWord
  , wordToRelayStatus
    -- * HopMessage encode/decode
  , encodeHopMessage
  , decodeHopMessage
  , encodeHopFramed
  , decodeHopFramed
  , writeHopMessage
  , readHopMessage
    -- * StopMessage encode/decode
  , encodeStopMessage
  , decodeStopMessage
  , encodeStopFramed
  , decodeStopFramed
  , writeStopMessage
  , readStopMessage
    -- * Constants
  , maxRelayMessageSize
  , hopProtocolId
  , stopProtocolId
  ) where

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

-- | Hop protocol identifier.
hopProtocolId :: Text
hopProtocolId :: Text
hopProtocolId = Text
"/libp2p/circuit/relay/0.2.0/hop"

-- | Stop protocol identifier.
stopProtocolId :: Text
stopProtocolId :: Text
stopProtocolId = Text
"/libp2p/circuit/relay/0.2.0/stop"

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

-- Types

-- | HopMessage type enum.
data HopMessageType = HopReserve | HopConnect | HopStatus
  deriving (Int -> HopMessageType -> ShowS
[HopMessageType] -> ShowS
HopMessageType -> String
(Int -> HopMessageType -> ShowS)
-> (HopMessageType -> String)
-> ([HopMessageType] -> ShowS)
-> Show HopMessageType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> HopMessageType -> ShowS
showsPrec :: Int -> HopMessageType -> ShowS
$cshow :: HopMessageType -> String
show :: HopMessageType -> String
$cshowList :: [HopMessageType] -> ShowS
showList :: [HopMessageType] -> ShowS
Show, HopMessageType -> HopMessageType -> Bool
(HopMessageType -> HopMessageType -> Bool)
-> (HopMessageType -> HopMessageType -> Bool) -> Eq HopMessageType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: HopMessageType -> HopMessageType -> Bool
== :: HopMessageType -> HopMessageType -> Bool
$c/= :: HopMessageType -> HopMessageType -> Bool
/= :: HopMessageType -> HopMessageType -> Bool
Eq)

-- | StopMessage type enum.
data StopMessageType = StopConnect | StopStatus
  deriving (Int -> StopMessageType -> ShowS
[StopMessageType] -> ShowS
StopMessageType -> String
(Int -> StopMessageType -> ShowS)
-> (StopMessageType -> String)
-> ([StopMessageType] -> ShowS)
-> Show StopMessageType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> StopMessageType -> ShowS
showsPrec :: Int -> StopMessageType -> ShowS
$cshow :: StopMessageType -> String
show :: StopMessageType -> String
$cshowList :: [StopMessageType] -> ShowS
showList :: [StopMessageType] -> ShowS
Show, StopMessageType -> StopMessageType -> Bool
(StopMessageType -> StopMessageType -> Bool)
-> (StopMessageType -> StopMessageType -> Bool)
-> Eq StopMessageType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: StopMessageType -> StopMessageType -> Bool
== :: StopMessageType -> StopMessageType -> Bool
$c/= :: StopMessageType -> StopMessageType -> Bool
/= :: StopMessageType -> StopMessageType -> Bool
Eq)

-- | Relay status codes (shared between Hop and Stop).
data RelayStatus
  = RelayOK                   -- ^ 100
  | ReservationRefused        -- ^ 200
  | ResourceLimitExceeded     -- ^ 201
  | PermissionDenied          -- ^ 202
  | ConnectionFailed          -- ^ 203
  | NoReservation             -- ^ 204
  | MalformedMessage          -- ^ 400
  | UnexpectedMessage         -- ^ 401
  deriving (Int -> RelayStatus -> ShowS
[RelayStatus] -> ShowS
RelayStatus -> String
(Int -> RelayStatus -> ShowS)
-> (RelayStatus -> String)
-> ([RelayStatus] -> ShowS)
-> Show RelayStatus
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RelayStatus -> ShowS
showsPrec :: Int -> RelayStatus -> ShowS
$cshow :: RelayStatus -> String
show :: RelayStatus -> String
$cshowList :: [RelayStatus] -> ShowS
showList :: [RelayStatus] -> ShowS
Show, RelayStatus -> RelayStatus -> Bool
(RelayStatus -> RelayStatus -> Bool)
-> (RelayStatus -> RelayStatus -> Bool) -> Eq RelayStatus
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RelayStatus -> RelayStatus -> Bool
== :: RelayStatus -> RelayStatus -> Bool
$c/= :: RelayStatus -> RelayStatus -> Bool
/= :: RelayStatus -> RelayStatus -> Bool
Eq)

-- | Convert RelayStatus to wire value.
relayStatusToWord :: RelayStatus -> Word32
relayStatusToWord :: RelayStatus -> Word32
relayStatusToWord RelayStatus
RelayOK               = Word32
100
relayStatusToWord RelayStatus
ReservationRefused     = Word32
200
relayStatusToWord RelayStatus
ResourceLimitExceeded  = Word32
201
relayStatusToWord RelayStatus
PermissionDenied       = Word32
202
relayStatusToWord RelayStatus
ConnectionFailed       = Word32
203
relayStatusToWord RelayStatus
NoReservation          = Word32
204
relayStatusToWord RelayStatus
MalformedMessage       = Word32
400
relayStatusToWord RelayStatus
UnexpectedMessage      = Word32
401

-- | Convert wire value to RelayStatus.
wordToRelayStatus :: Word32 -> Maybe RelayStatus
wordToRelayStatus :: Word32 -> Maybe RelayStatus
wordToRelayStatus Word32
100 = RelayStatus -> Maybe RelayStatus
forall a. a -> Maybe a
Just RelayStatus
RelayOK
wordToRelayStatus Word32
200 = RelayStatus -> Maybe RelayStatus
forall a. a -> Maybe a
Just RelayStatus
ReservationRefused
wordToRelayStatus Word32
201 = RelayStatus -> Maybe RelayStatus
forall a. a -> Maybe a
Just RelayStatus
ResourceLimitExceeded
wordToRelayStatus Word32
202 = RelayStatus -> Maybe RelayStatus
forall a. a -> Maybe a
Just RelayStatus
PermissionDenied
wordToRelayStatus Word32
203 = RelayStatus -> Maybe RelayStatus
forall a. a -> Maybe a
Just RelayStatus
ConnectionFailed
wordToRelayStatus Word32
204 = RelayStatus -> Maybe RelayStatus
forall a. a -> Maybe a
Just RelayStatus
NoReservation
wordToRelayStatus Word32
400 = RelayStatus -> Maybe RelayStatus
forall a. a -> Maybe a
Just RelayStatus
MalformedMessage
wordToRelayStatus Word32
401 = RelayStatus -> Maybe RelayStatus
forall a. a -> Maybe a
Just RelayStatus
UnexpectedMessage
wordToRelayStatus Word32
_   = Maybe RelayStatus
forall a. Maybe a
Nothing

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

-- | Reservation info (nested in HopMessage).
data Reservation = Reservation
  { Reservation -> Maybe Word64
rsvExpire  :: !(Maybe Word64)      -- ^ field 1: expiration (Unix UTC)
  , Reservation -> [ByteString]
rsvAddrs   :: ![ByteString]        -- ^ field 2: relay addresses
  , Reservation -> Maybe ByteString
rsvVoucher :: !(Maybe ByteString)  -- ^ field 3: signed envelope bytes
  } deriving (Int -> Reservation -> ShowS
[Reservation] -> ShowS
Reservation -> String
(Int -> Reservation -> ShowS)
-> (Reservation -> String)
-> ([Reservation] -> ShowS)
-> Show Reservation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Reservation -> ShowS
showsPrec :: Int -> Reservation -> ShowS
$cshow :: Reservation -> String
show :: Reservation -> String
$cshowList :: [Reservation] -> ShowS
showList :: [Reservation] -> ShowS
Show, Reservation -> Reservation -> Bool
(Reservation -> Reservation -> Bool)
-> (Reservation -> Reservation -> Bool) -> Eq Reservation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Reservation -> Reservation -> Bool
== :: Reservation -> Reservation -> Bool
$c/= :: Reservation -> Reservation -> Bool
/= :: Reservation -> Reservation -> Bool
Eq)

-- | Relay limit (nested in both Hop and Stop).
data RelayLimit = RelayLimit
  { RelayLimit -> Maybe Word32
rlDuration :: !(Maybe Word32)  -- ^ field 1: max seconds (0=unlimited)
  , RelayLimit -> Maybe Word64
rlData     :: !(Maybe Word64)  -- ^ field 2: max bytes per direction
  } deriving (Int -> RelayLimit -> ShowS
[RelayLimit] -> ShowS
RelayLimit -> String
(Int -> RelayLimit -> ShowS)
-> (RelayLimit -> String)
-> ([RelayLimit] -> ShowS)
-> Show RelayLimit
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RelayLimit -> ShowS
showsPrec :: Int -> RelayLimit -> ShowS
$cshow :: RelayLimit -> String
show :: RelayLimit -> String
$cshowList :: [RelayLimit] -> ShowS
showList :: [RelayLimit] -> ShowS
Show, RelayLimit -> RelayLimit -> Bool
(RelayLimit -> RelayLimit -> Bool)
-> (RelayLimit -> RelayLimit -> Bool) -> Eq RelayLimit
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RelayLimit -> RelayLimit -> Bool
== :: RelayLimit -> RelayLimit -> Bool
$c/= :: RelayLimit -> RelayLimit -> Bool
/= :: RelayLimit -> RelayLimit -> Bool
Eq)

-- | HopMessage: client ↔ relay.
data HopMessage = HopMessage
  { HopMessage -> Maybe HopMessageType
hopType        :: !(Maybe HopMessageType)   -- ^ field 1
  , HopMessage -> Maybe RelayPeer
hopPeer        :: !(Maybe RelayPeer)         -- ^ field 2
  , HopMessage -> Maybe Reservation
hopReservation :: !(Maybe Reservation)       -- ^ field 3
  , HopMessage -> Maybe RelayLimit
hopLimit       :: !(Maybe RelayLimit)        -- ^ field 4
  , HopMessage -> Maybe RelayStatus
hopStatus      :: !(Maybe RelayStatus)       -- ^ field 5
  } deriving (Int -> HopMessage -> ShowS
[HopMessage] -> ShowS
HopMessage -> String
(Int -> HopMessage -> ShowS)
-> (HopMessage -> String)
-> ([HopMessage] -> ShowS)
-> Show HopMessage
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> HopMessage -> ShowS
showsPrec :: Int -> HopMessage -> ShowS
$cshow :: HopMessage -> String
show :: HopMessage -> String
$cshowList :: [HopMessage] -> ShowS
showList :: [HopMessage] -> ShowS
Show, HopMessage -> HopMessage -> Bool
(HopMessage -> HopMessage -> Bool)
-> (HopMessage -> HopMessage -> Bool) -> Eq HopMessage
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: HopMessage -> HopMessage -> Bool
== :: HopMessage -> HopMessage -> Bool
$c/= :: HopMessage -> HopMessage -> Bool
/= :: HopMessage -> HopMessage -> Bool
Eq)

-- | StopMessage: relay ↔ target.
data StopMessage = StopMessage
  { StopMessage -> Maybe StopMessageType
stopType   :: !(Maybe StopMessageType)  -- ^ field 1
  , StopMessage -> Maybe RelayPeer
stopPeer   :: !(Maybe RelayPeer)        -- ^ field 2
  , StopMessage -> Maybe RelayLimit
stopLimit  :: !(Maybe RelayLimit)       -- ^ field 3
  , StopMessage -> Maybe RelayStatus
stopStatus :: !(Maybe RelayStatus)      -- ^ field 4
  } deriving (Int -> StopMessage -> ShowS
[StopMessage] -> ShowS
StopMessage -> String
(Int -> StopMessage -> ShowS)
-> (StopMessage -> String)
-> ([StopMessage] -> ShowS)
-> Show StopMessage
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> StopMessage -> ShowS
showsPrec :: Int -> StopMessage -> ShowS
$cshow :: StopMessage -> String
show :: StopMessage -> String
$cshowList :: [StopMessage] -> ShowS
showList :: [StopMessage] -> ShowS
Show, StopMessage -> StopMessage -> Bool
(StopMessage -> StopMessage -> Bool)
-> (StopMessage -> StopMessage -> Bool) -> Eq StopMessage
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: StopMessage -> StopMessage -> Bool
== :: StopMessage -> StopMessage -> Bool
$c/= :: StopMessage -> StopMessage -> Bool
/= :: StopMessage -> StopMessage -> Bool
Eq)

-- Encoding helpers

optEnum :: Word -> Maybe Word32 -> MessageBuilder
optEnum :: Word -> Maybe Word32 -> MessageBuilder
optEnum Word
_ Maybe Word32
Nothing  = MessageBuilder
forall a. Monoid a => a
mempty
optEnum Word
n (Just Word32
v) = FieldNumber -> Word32 -> MessageBuilder
Encode.uint32 (Word64 -> FieldNumber
FieldNumber (Word -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
n)) Word32
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)

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

optUint32 :: Word -> Maybe Word32 -> MessageBuilder
optUint32 :: Word -> Maybe Word32 -> MessageBuilder
optUint32 Word
_ Maybe Word32
Nothing  = MessageBuilder
forall a. Monoid a => a
mempty
optUint32 Word
n (Just Word32
v) = FieldNumber -> Word32 -> MessageBuilder
Encode.uint32 (Word64 -> FieldNumber
FieldNumber (Word -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
n)) Word32
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

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

-- Encoding

hopTypeToWord :: HopMessageType -> Word32
hopTypeToWord :: HopMessageType -> Word32
hopTypeToWord HopMessageType
HopReserve = Word32
0
hopTypeToWord HopMessageType
HopConnect = Word32
1
hopTypeToWord HopMessageType
HopStatus  = Word32
2

stopTypeToWord :: StopMessageType -> Word32
stopTypeToWord :: StopMessageType -> Word32
stopTypeToWord StopMessageType
StopConnect = Word32
0
stopTypeToWord StopMessageType
StopStatus  = Word32
1

encodeRelayPeer :: RelayPeer -> MessageBuilder
encodeRelayPeer :: RelayPeer -> MessageBuilder
encodeRelayPeer RelayPeer
peer =
     Word -> Maybe ByteString -> MessageBuilder
optBytes Word
1 (ByteString -> Maybe ByteString
nonEmpty (RelayPeer -> ByteString
rpId RelayPeer
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) (RelayPeer -> [ByteString]
rpAddrs RelayPeer
peer)

encodeReservation :: Reservation -> MessageBuilder
encodeReservation :: Reservation -> MessageBuilder
encodeReservation Reservation
rsv =
     Word -> Maybe Word64 -> MessageBuilder
optUint64 Word
1 (Reservation -> Maybe Word64
rsvExpire Reservation
rsv)
  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) (Reservation -> [ByteString]
rsvAddrs Reservation
rsv)
  MessageBuilder -> MessageBuilder -> MessageBuilder
forall a. Semigroup a => a -> a -> a
<> Word -> Maybe ByteString -> MessageBuilder
optBytes Word
3 (Reservation -> Maybe ByteString
rsvVoucher Reservation
rsv)

encodeRelayLimit :: RelayLimit -> MessageBuilder
encodeRelayLimit :: RelayLimit -> MessageBuilder
encodeRelayLimit RelayLimit
lim =
     Word -> Maybe Word32 -> MessageBuilder
optUint32 Word
1 (RelayLimit -> Maybe Word32
rlDuration RelayLimit
lim)
  MessageBuilder -> MessageBuilder -> MessageBuilder
forall a. Semigroup a => a -> a -> a
<> Word -> Maybe Word64 -> MessageBuilder
optUint64 Word
2 (RelayLimit -> Maybe Word64
rlData RelayLimit
lim)

-- | Encode HopMessage to protobuf (no framing).
encodeHopMessage :: HopMessage -> ByteString
encodeHopMessage :: HopMessage -> ByteString
encodeHopMessage HopMessage
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 Word32 -> MessageBuilder
optEnum Word
1 ((HopMessageType -> Word32) -> Maybe HopMessageType -> Maybe Word32
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap HopMessageType -> Word32
hopTypeToWord (HopMessage -> Maybe HopMessageType
hopType HopMessage
msg))
  MessageBuilder -> MessageBuilder -> MessageBuilder
forall a. Semigroup a => a -> a -> a
<> Word
-> (RelayPeer -> MessageBuilder)
-> Maybe RelayPeer
-> MessageBuilder
forall a.
Word -> (a -> MessageBuilder) -> Maybe a -> MessageBuilder
optEmbedded Word
2 RelayPeer -> MessageBuilder
encodeRelayPeer (HopMessage -> Maybe RelayPeer
hopPeer HopMessage
msg)
  MessageBuilder -> MessageBuilder -> MessageBuilder
forall a. Semigroup a => a -> a -> a
<> Word
-> (Reservation -> MessageBuilder)
-> Maybe Reservation
-> MessageBuilder
forall a.
Word -> (a -> MessageBuilder) -> Maybe a -> MessageBuilder
optEmbedded Word
3 Reservation -> MessageBuilder
encodeReservation (HopMessage -> Maybe Reservation
hopReservation HopMessage
msg)
  MessageBuilder -> MessageBuilder -> MessageBuilder
forall a. Semigroup a => a -> a -> a
<> Word
-> (RelayLimit -> MessageBuilder)
-> Maybe RelayLimit
-> MessageBuilder
forall a.
Word -> (a -> MessageBuilder) -> Maybe a -> MessageBuilder
optEmbedded Word
4 RelayLimit -> MessageBuilder
encodeRelayLimit (HopMessage -> Maybe RelayLimit
hopLimit HopMessage
msg)
  MessageBuilder -> MessageBuilder -> MessageBuilder
forall a. Semigroup a => a -> a -> a
<> Word -> Maybe Word32 -> MessageBuilder
optEnum Word
5 ((RelayStatus -> Word32) -> Maybe RelayStatus -> Maybe Word32
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap RelayStatus -> Word32
relayStatusToWord (HopMessage -> Maybe RelayStatus
hopStatus HopMessage
msg))

-- | Encode StopMessage to protobuf (no framing).
encodeStopMessage :: StopMessage -> ByteString
encodeStopMessage :: StopMessage -> ByteString
encodeStopMessage StopMessage
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 Word32 -> MessageBuilder
optEnum Word
1 ((StopMessageType -> Word32)
-> Maybe StopMessageType -> Maybe Word32
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap StopMessageType -> Word32
stopTypeToWord (StopMessage -> Maybe StopMessageType
stopType StopMessage
msg))
  MessageBuilder -> MessageBuilder -> MessageBuilder
forall a. Semigroup a => a -> a -> a
<> Word
-> (RelayPeer -> MessageBuilder)
-> Maybe RelayPeer
-> MessageBuilder
forall a.
Word -> (a -> MessageBuilder) -> Maybe a -> MessageBuilder
optEmbedded Word
2 RelayPeer -> MessageBuilder
encodeRelayPeer (StopMessage -> Maybe RelayPeer
stopPeer StopMessage
msg)
  MessageBuilder -> MessageBuilder -> MessageBuilder
forall a. Semigroup a => a -> a -> a
<> Word
-> (RelayLimit -> MessageBuilder)
-> Maybe RelayLimit
-> MessageBuilder
forall a.
Word -> (a -> MessageBuilder) -> Maybe a -> MessageBuilder
optEmbedded Word
3 RelayLimit -> MessageBuilder
encodeRelayLimit (StopMessage -> Maybe RelayLimit
stopLimit StopMessage
msg)
  MessageBuilder -> MessageBuilder -> MessageBuilder
forall a. Semigroup a => a -> a -> a
<> Word -> Maybe Word32 -> MessageBuilder
optEnum Word
4 ((RelayStatus -> Word32) -> Maybe RelayStatus -> Maybe Word32
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap RelayStatus -> Word32
relayStatusToWord (StopMessage -> Maybe RelayStatus
stopStatus StopMessage
msg))

-- Decoding

-- | Decode HopMessage from protobuf.
decodeHopMessage :: ByteString -> Either ParseError HopMessage
decodeHopMessage :: ByteString -> Either ParseError HopMessage
decodeHopMessage = Parser RawMessage HopMessage
-> ByteString -> Either ParseError HopMessage
forall a. Parser RawMessage a -> ByteString -> Either ParseError a
parse Parser RawMessage HopMessage
hopMessageParser

hopMessageParser :: Parser RawMessage HopMessage
hopMessageParser :: Parser RawMessage HopMessage
hopMessageParser = Maybe HopMessageType
-> Maybe RelayPeer
-> Maybe Reservation
-> Maybe RelayLimit
-> Maybe RelayStatus
-> HopMessage
HopMessage
  (Maybe HopMessageType
 -> Maybe RelayPeer
 -> Maybe Reservation
 -> Maybe RelayLimit
 -> Maybe RelayStatus
 -> HopMessage)
-> Parser RawMessage (Maybe HopMessageType)
-> Parser
     RawMessage
     (Maybe RelayPeer
      -> Maybe Reservation
      -> Maybe RelayLimit
      -> Maybe RelayStatus
      -> HopMessage)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser RawField (Maybe HopMessageType)
-> FieldNumber -> Parser RawMessage (Maybe HopMessageType)
forall a. Parser RawField a -> FieldNumber -> Parser RawMessage a
at ((Maybe Word32 -> Maybe HopMessageType)
-> Parser RawField (Maybe Word32)
-> Parser RawField (Maybe HopMessageType)
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 HopMessageType
wordToHopType (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 RelayPeer
   -> Maybe Reservation
   -> Maybe RelayLimit
   -> Maybe RelayStatus
   -> HopMessage)
-> Parser RawMessage (Maybe RelayPeer)
-> Parser
     RawMessage
     (Maybe Reservation
      -> Maybe RelayLimit -> Maybe RelayStatus -> HopMessage)
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 RelayPeer)
-> FieldNumber -> Parser RawMessage (Maybe RelayPeer)
forall a. Parser RawField a -> FieldNumber -> Parser RawMessage a
at (Parser RawMessage RelayPeer -> Parser RawField (Maybe RelayPeer)
forall a. Parser RawMessage a -> Parser RawField (Maybe a)
embedded Parser RawMessage RelayPeer
relayPeerParser) (Word64 -> FieldNumber
FieldNumber Word64
2)
  Parser
  RawMessage
  (Maybe Reservation
   -> Maybe RelayLimit -> Maybe RelayStatus -> HopMessage)
-> Parser RawMessage (Maybe Reservation)
-> Parser
     RawMessage (Maybe RelayLimit -> Maybe RelayStatus -> HopMessage)
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 Reservation)
-> FieldNumber -> Parser RawMessage (Maybe Reservation)
forall a. Parser RawField a -> FieldNumber -> Parser RawMessage a
at (Parser RawMessage Reservation
-> Parser RawField (Maybe Reservation)
forall a. Parser RawMessage a -> Parser RawField (Maybe a)
embedded Parser RawMessage Reservation
reservationParser) (Word64 -> FieldNumber
FieldNumber Word64
3)
  Parser
  RawMessage (Maybe RelayLimit -> Maybe RelayStatus -> HopMessage)
-> Parser RawMessage (Maybe RelayLimit)
-> Parser RawMessage (Maybe RelayStatus -> HopMessage)
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 RelayLimit)
-> FieldNumber -> Parser RawMessage (Maybe RelayLimit)
forall a. Parser RawField a -> FieldNumber -> Parser RawMessage a
at (Parser RawMessage RelayLimit -> Parser RawField (Maybe RelayLimit)
forall a. Parser RawMessage a -> Parser RawField (Maybe a)
embedded Parser RawMessage RelayLimit
relayLimitParser) (Word64 -> FieldNumber
FieldNumber Word64
4)
  Parser RawMessage (Maybe RelayStatus -> HopMessage)
-> Parser RawMessage (Maybe RelayStatus)
-> Parser RawMessage HopMessage
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 RelayStatus)
-> FieldNumber -> Parser RawMessage (Maybe RelayStatus)
forall a. Parser RawField a -> FieldNumber -> Parser RawMessage a
at ((Maybe Word32 -> Maybe RelayStatus)
-> Parser RawField (Maybe Word32)
-> Parser RawField (Maybe RelayStatus)
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 -> (Word32 -> Maybe RelayStatus) -> Maybe RelayStatus
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Word32 -> Maybe RelayStatus
wordToRelayStatus) (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
5)

wordToHopType :: Maybe Word32 -> Maybe HopMessageType
wordToHopType :: Maybe Word32 -> Maybe HopMessageType
wordToHopType (Just Word32
0) = HopMessageType -> Maybe HopMessageType
forall a. a -> Maybe a
Just HopMessageType
HopReserve
wordToHopType (Just Word32
1) = HopMessageType -> Maybe HopMessageType
forall a. a -> Maybe a
Just HopMessageType
HopConnect
wordToHopType (Just Word32
2) = HopMessageType -> Maybe HopMessageType
forall a. a -> Maybe a
Just HopMessageType
HopStatus
wordToHopType Maybe Word32
_        = Maybe HopMessageType
forall a. Maybe a
Nothing

-- | Decode StopMessage from protobuf.
decodeStopMessage :: ByteString -> Either ParseError StopMessage
decodeStopMessage :: ByteString -> Either ParseError StopMessage
decodeStopMessage = Parser RawMessage StopMessage
-> ByteString -> Either ParseError StopMessage
forall a. Parser RawMessage a -> ByteString -> Either ParseError a
parse Parser RawMessage StopMessage
stopMessageParser

stopMessageParser :: Parser RawMessage StopMessage
stopMessageParser :: Parser RawMessage StopMessage
stopMessageParser = Maybe StopMessageType
-> Maybe RelayPeer
-> Maybe RelayLimit
-> Maybe RelayStatus
-> StopMessage
StopMessage
  (Maybe StopMessageType
 -> Maybe RelayPeer
 -> Maybe RelayLimit
 -> Maybe RelayStatus
 -> StopMessage)
-> Parser RawMessage (Maybe StopMessageType)
-> Parser
     RawMessage
     (Maybe RelayPeer
      -> Maybe RelayLimit -> Maybe RelayStatus -> StopMessage)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser RawField (Maybe StopMessageType)
-> FieldNumber -> Parser RawMessage (Maybe StopMessageType)
forall a. Parser RawField a -> FieldNumber -> Parser RawMessage a
at ((Maybe Word32 -> Maybe StopMessageType)
-> Parser RawField (Maybe Word32)
-> Parser RawField (Maybe StopMessageType)
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 StopMessageType
wordToStopType (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 RelayPeer
   -> Maybe RelayLimit -> Maybe RelayStatus -> StopMessage)
-> Parser RawMessage (Maybe RelayPeer)
-> Parser
     RawMessage (Maybe RelayLimit -> Maybe RelayStatus -> StopMessage)
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 RelayPeer)
-> FieldNumber -> Parser RawMessage (Maybe RelayPeer)
forall a. Parser RawField a -> FieldNumber -> Parser RawMessage a
at (Parser RawMessage RelayPeer -> Parser RawField (Maybe RelayPeer)
forall a. Parser RawMessage a -> Parser RawField (Maybe a)
embedded Parser RawMessage RelayPeer
relayPeerParser) (Word64 -> FieldNumber
FieldNumber Word64
2)
  Parser
  RawMessage (Maybe RelayLimit -> Maybe RelayStatus -> StopMessage)
-> Parser RawMessage (Maybe RelayLimit)
-> Parser RawMessage (Maybe RelayStatus -> StopMessage)
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 RelayLimit)
-> FieldNumber -> Parser RawMessage (Maybe RelayLimit)
forall a. Parser RawField a -> FieldNumber -> Parser RawMessage a
at (Parser RawMessage RelayLimit -> Parser RawField (Maybe RelayLimit)
forall a. Parser RawMessage a -> Parser RawField (Maybe a)
embedded Parser RawMessage RelayLimit
relayLimitParser) (Word64 -> FieldNumber
FieldNumber Word64
3)
  Parser RawMessage (Maybe RelayStatus -> StopMessage)
-> Parser RawMessage (Maybe RelayStatus)
-> Parser RawMessage StopMessage
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 RelayStatus)
-> FieldNumber -> Parser RawMessage (Maybe RelayStatus)
forall a. Parser RawField a -> FieldNumber -> Parser RawMessage a
at ((Maybe Word32 -> Maybe RelayStatus)
-> Parser RawField (Maybe Word32)
-> Parser RawField (Maybe RelayStatus)
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 -> (Word32 -> Maybe RelayStatus) -> Maybe RelayStatus
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Word32 -> Maybe RelayStatus
wordToRelayStatus) (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
4)

wordToStopType :: Maybe Word32 -> Maybe StopMessageType
wordToStopType :: Maybe Word32 -> Maybe StopMessageType
wordToStopType (Just Word32
0) = StopMessageType -> Maybe StopMessageType
forall a. a -> Maybe a
Just StopMessageType
StopConnect
wordToStopType (Just Word32
1) = StopMessageType -> Maybe StopMessageType
forall a. a -> Maybe a
Just StopMessageType
StopStatus
wordToStopType Maybe Word32
_        = Maybe StopMessageType
forall a. Maybe a
Nothing

relayPeerParser :: Parser RawMessage RelayPeer
relayPeerParser :: Parser RawMessage RelayPeer
relayPeerParser = ByteString -> [ByteString] -> RelayPeer
RelayPeer
  (ByteString -> [ByteString] -> RelayPeer)
-> Parser RawMessage ByteString
-> Parser RawMessage ([ByteString] -> RelayPeer)
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] -> RelayPeer)
-> Parser RawMessage [ByteString] -> Parser RawMessage RelayPeer
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)

reservationParser :: Parser RawMessage Reservation
reservationParser :: Parser RawMessage Reservation
reservationParser = Maybe Word64 -> [ByteString] -> Maybe ByteString -> Reservation
Reservation
  (Maybe Word64 -> [ByteString] -> Maybe ByteString -> Reservation)
-> Parser RawMessage (Maybe Word64)
-> Parser
     RawMessage ([ByteString] -> Maybe ByteString -> Reservation)
forall (f :: * -> *) a b. Functor 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
1)
  Parser RawMessage ([ByteString] -> Maybe ByteString -> Reservation)
-> Parser RawMessage [ByteString]
-> Parser RawMessage (Maybe ByteString -> Reservation)
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)
  Parser RawMessage (Maybe ByteString -> Reservation)
-> Parser RawMessage (Maybe ByteString)
-> Parser RawMessage Reservation
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)

relayLimitParser :: Parser RawMessage RelayLimit
relayLimitParser :: Parser RawMessage RelayLimit
relayLimitParser = Maybe Word32 -> Maybe Word64 -> RelayLimit
RelayLimit
  (Maybe Word32 -> Maybe Word64 -> RelayLimit)
-> Parser RawMessage (Maybe Word32)
-> Parser RawMessage (Maybe Word64 -> RelayLimit)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser RawField (Maybe Word32)
-> FieldNumber -> Parser RawMessage (Maybe Word32)
forall a. Parser RawField a -> FieldNumber -> Parser RawMessage a
at (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 Word64 -> RelayLimit)
-> Parser RawMessage (Maybe Word64) -> Parser RawMessage RelayLimit
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
2)

-- Wire framing (same pattern as DHT/AutoNAT)

-- | Encode HopMessage with uvarint length prefix.
encodeHopFramed :: HopMessage -> ByteString
encodeHopFramed :: HopMessage -> ByteString
encodeHopFramed HopMessage
msg = ByteString -> ByteString
frameMessage (HopMessage -> ByteString
encodeHopMessage HopMessage
msg)

-- | Decode HopMessage from framed bytes.
decodeHopFramed :: Int -> ByteString -> Either String HopMessage
decodeHopFramed :: Int -> ByteString -> Either String HopMessage
decodeHopFramed = (ByteString -> Either ParseError HopMessage)
-> String -> Int -> ByteString -> Either String HopMessage
forall a.
(ByteString -> Either ParseError a)
-> String -> Int -> ByteString -> Either String a
decodeFramedWith ByteString -> Either ParseError HopMessage
decodeHopMessage String
"Hop"

-- | Encode StopMessage with uvarint length prefix.
encodeStopFramed :: StopMessage -> ByteString
encodeStopFramed :: StopMessage -> ByteString
encodeStopFramed StopMessage
msg = ByteString -> ByteString
frameMessage (StopMessage -> ByteString
encodeStopMessage StopMessage
msg)

-- | Decode StopMessage from framed bytes.
decodeStopFramed :: Int -> ByteString -> Either String StopMessage
decodeStopFramed :: Int -> ByteString -> Either String StopMessage
decodeStopFramed = (ByteString -> Either ParseError StopMessage)
-> String -> Int -> ByteString -> Either String StopMessage
forall a.
(ByteString -> Either ParseError a)
-> String -> Int -> ByteString -> Either String a
decodeFramedWith ByteString -> Either ParseError StopMessage
decodeStopMessage String
"Stop"

-- | Write a framed HopMessage to a stream.
writeHopMessage :: StreamIO -> HopMessage -> IO ()
writeHopMessage :: StreamIO -> HopMessage -> IO ()
writeHopMessage StreamIO
stream HopMessage
msg = StreamIO -> ByteString -> IO ()
streamWrite StreamIO
stream (HopMessage -> ByteString
encodeHopFramed HopMessage
msg)

-- | Read a framed HopMessage from a stream.
readHopMessage :: StreamIO -> Int -> IO (Either String HopMessage)
readHopMessage :: StreamIO -> Int -> IO (Either String HopMessage)
readHopMessage = (ByteString -> Either ParseError HopMessage)
-> String -> StreamIO -> Int -> IO (Either String HopMessage)
forall a.
(ByteString -> Either ParseError a)
-> String -> StreamIO -> Int -> IO (Either String a)
readFramedWith ByteString -> Either ParseError HopMessage
decodeHopMessage String
"Hop"

-- | Write a framed StopMessage to a stream.
writeStopMessage :: StreamIO -> StopMessage -> IO ()
writeStopMessage :: StreamIO -> StopMessage -> IO ()
writeStopMessage StreamIO
stream StopMessage
msg = StreamIO -> ByteString -> IO ()
streamWrite StreamIO
stream (StopMessage -> ByteString
encodeStopFramed StopMessage
msg)

-- | Read a framed StopMessage from a stream.
readStopMessage :: StreamIO -> Int -> IO (Either String StopMessage)
readStopMessage :: StreamIO -> Int -> IO (Either String StopMessage)
readStopMessage = (ByteString -> Either ParseError StopMessage)
-> String -> StreamIO -> Int -> IO (Either String StopMessage)
forall a.
(ByteString -> Either ParseError a)
-> String -> StreamIO -> Int -> IO (Either String a)
readFramedWith ByteString -> Either ParseError StopMessage
decodeStopMessage String
"Stop"

-- Shared framing helpers

frameMessage :: ByteString -> ByteString
frameMessage :: ByteString -> ByteString
frameMessage ByteString
payload =
  let 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

decodeFramedWith :: (ByteString -> Either ParseError a) -> String -> Int -> ByteString -> Either String a
decodeFramedWith :: forall a.
(ByteString -> Either ParseError a)
-> String -> Int -> ByteString -> Either String a
decodeFramedWith ByteString -> Either ParseError a
decoder String
label 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 $ label ++ " message too large: " ++ show msgLen ++ " > " ++ show maxSize
    else if BS.length rest < msgLen
      then Left $ label ++ " message truncated"
      else case decoder (BS.take msgLen rest) of
        Left ParseError
err -> String -> Either String a
forall a b. a -> Either a b
Left (String -> Either String a) -> String -> Either String a
forall a b. (a -> b) -> a -> b
$ String
label String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" protobuf decode error: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ParseError -> String
forall a. Show a => a -> String
show ParseError
err
        Right a
msg -> a -> Either String a
forall a b. b -> Either a b
Right a
msg

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

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]

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)