{-# OPTIONS_HADDOCK prune #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE LambdaCase #-}

-- |
-- Module: Lightning.Protocol.BOLT1.Codec
-- Copyright: (c) 2025 Jared Tobin
-- License: MIT
-- Maintainer: Jared Tobin <jared@ppad.tech>
--
-- Message encoding and decoding for BOLT #1.

module Lightning.Protocol.BOLT1.Codec (
  -- * Encoding errors
    EncodeError(..)

  -- * Message encoding
  , encodeInit
  , encodeError
  , encodeWarning
  , encodePing
  , encodePong
  , encodePeerStorage
  , encodePeerStorageRetrieval
  , encodeMessage
  , encodeEnvelope

  -- * Decoding errors
  , DecodeError(..)

  -- * Message decoding
  , decodeInit
  , decodeError
  , decodeWarning
  , decodePing
  , decodePong
  , decodePeerStorage
  , decodePeerStorageRetrieval
  , decodeMessage
  , decodeEnvelope
  , decodeEnvelopeWith
  ) where

import Control.DeepSeq (NFData)
import Control.Monad (when, unless)
import qualified Data.ByteString as BS
import Data.Word (Word16, Word64)
import GHC.Generics (Generic)
import Lightning.Protocol.BOLT1.Prim
import Lightning.Protocol.BOLT1.TLV
import Lightning.Protocol.BOLT1.Message

-- Encoding errors -------------------------------------------------------------

-- | Encoding errors.
data EncodeError
  = EncodeLengthOverflow   -- ^ Field length exceeds u16 max (65535 bytes)
  | EncodeMessageTooLarge  -- ^ Total message size exceeds 65535 bytes
  deriving stock (EncodeError -> EncodeError -> Bool
(EncodeError -> EncodeError -> Bool)
-> (EncodeError -> EncodeError -> Bool) -> Eq EncodeError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: EncodeError -> EncodeError -> Bool
== :: EncodeError -> EncodeError -> Bool
$c/= :: EncodeError -> EncodeError -> Bool
/= :: EncodeError -> EncodeError -> Bool
Eq, Int -> EncodeError -> ShowS
[EncodeError] -> ShowS
EncodeError -> String
(Int -> EncodeError -> ShowS)
-> (EncodeError -> String)
-> ([EncodeError] -> ShowS)
-> Show EncodeError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> EncodeError -> ShowS
showsPrec :: Int -> EncodeError -> ShowS
$cshow :: EncodeError -> String
show :: EncodeError -> String
$cshowList :: [EncodeError] -> ShowS
showList :: [EncodeError] -> ShowS
Show, (forall x. EncodeError -> Rep EncodeError x)
-> (forall x. Rep EncodeError x -> EncodeError)
-> Generic EncodeError
forall x. Rep EncodeError x -> EncodeError
forall x. EncodeError -> Rep EncodeError x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. EncodeError -> Rep EncodeError x
from :: forall x. EncodeError -> Rep EncodeError x
$cto :: forall x. Rep EncodeError x -> EncodeError
to :: forall x. Rep EncodeError x -> EncodeError
Generic)

instance NFData EncodeError

-- Message encoding ------------------------------------------------------------

-- | Encode an Init message payload.
encodeInit :: Init -> Either EncodeError BS.ByteString
encodeInit :: Init -> Either EncodeError ByteString
encodeInit (Init ByteString
gf ByteString
feat [InitTlv]
tlvs) = do
  gfLen <- Either EncodeError ByteString
-> (ByteString -> Either EncodeError ByteString)
-> Maybe ByteString
-> Either EncodeError ByteString
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (EncodeError -> Either EncodeError ByteString
forall a b. a -> Either a b
Left EncodeError
EncodeLengthOverflow) ByteString -> Either EncodeError ByteString
forall a b. b -> Either a b
Right (ByteString -> Maybe ByteString
encodeLength ByteString
gf)
  featLen <- maybe (Left EncodeLengthOverflow) Right (encodeLength feat)
  Right $ mconcat
    [ gfLen
    , gf
    , featLen
    , feat
    , encodeTlvStream (encodeInitTlvs tlvs)
    ]

-- | Encode an Error message payload.
encodeError :: Error -> Either EncodeError BS.ByteString
encodeError :: Error -> Either EncodeError ByteString
encodeError (Error ChannelId
cid ByteString
dat) = do
  datLen <- Either EncodeError ByteString
-> (ByteString -> Either EncodeError ByteString)
-> Maybe ByteString
-> Either EncodeError ByteString
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (EncodeError -> Either EncodeError ByteString
forall a b. a -> Either a b
Left EncodeError
EncodeLengthOverflow) ByteString -> Either EncodeError ByteString
forall a b. b -> Either a b
Right (ByteString -> Maybe ByteString
encodeLength ByteString
dat)
  Right $ mconcat [unChannelId cid, datLen, dat]

-- | Encode a Warning message payload.
encodeWarning :: Warning -> Either EncodeError BS.ByteString
encodeWarning :: Warning -> Either EncodeError ByteString
encodeWarning (Warning ChannelId
cid ByteString
dat) = do
  datLen <- Either EncodeError ByteString
-> (ByteString -> Either EncodeError ByteString)
-> Maybe ByteString
-> Either EncodeError ByteString
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (EncodeError -> Either EncodeError ByteString
forall a b. a -> Either a b
Left EncodeError
EncodeLengthOverflow) ByteString -> Either EncodeError ByteString
forall a b. b -> Either a b
Right (ByteString -> Maybe ByteString
encodeLength ByteString
dat)
  Right $ mconcat [unChannelId cid, datLen, dat]

-- | Encode a Ping message payload.
encodePing :: Ping -> Either EncodeError BS.ByteString
encodePing :: Ping -> Either EncodeError ByteString
encodePing (Ping Word16
numPong ByteString
ignored) = do
  ignoredLen <- Either EncodeError ByteString
-> (ByteString -> Either EncodeError ByteString)
-> Maybe ByteString
-> Either EncodeError ByteString
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (EncodeError -> Either EncodeError ByteString
forall a b. a -> Either a b
Left EncodeError
EncodeLengthOverflow) ByteString -> Either EncodeError ByteString
forall a b. b -> Either a b
Right (ByteString -> Maybe ByteString
encodeLength ByteString
ignored)
  Right $ mconcat [encodeU16 numPong, ignoredLen, ignored]

-- | Encode a Pong message payload.
encodePong :: Pong -> Either EncodeError BS.ByteString
encodePong :: Pong -> Either EncodeError ByteString
encodePong (Pong ByteString
ignored) = do
  ignoredLen <- Either EncodeError ByteString
-> (ByteString -> Either EncodeError ByteString)
-> Maybe ByteString
-> Either EncodeError ByteString
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (EncodeError -> Either EncodeError ByteString
forall a b. a -> Either a b
Left EncodeError
EncodeLengthOverflow) ByteString -> Either EncodeError ByteString
forall a b. b -> Either a b
Right (ByteString -> Maybe ByteString
encodeLength ByteString
ignored)
  Right $ mconcat [ignoredLen, ignored]

-- | Encode a PeerStorage message payload.
encodePeerStorage :: PeerStorage -> Either EncodeError BS.ByteString
encodePeerStorage :: PeerStorage -> Either EncodeError ByteString
encodePeerStorage (PeerStorage ByteString
blob) = do
  blobLen <- Either EncodeError ByteString
-> (ByteString -> Either EncodeError ByteString)
-> Maybe ByteString
-> Either EncodeError ByteString
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (EncodeError -> Either EncodeError ByteString
forall a b. a -> Either a b
Left EncodeError
EncodeLengthOverflow) ByteString -> Either EncodeError ByteString
forall a b. b -> Either a b
Right (ByteString -> Maybe ByteString
encodeLength ByteString
blob)
  Right $ mconcat [blobLen, blob]

-- | Encode a PeerStorageRetrieval message payload.
encodePeerStorageRetrieval
  :: PeerStorageRetrieval -> Either EncodeError BS.ByteString
encodePeerStorageRetrieval :: PeerStorageRetrieval -> Either EncodeError ByteString
encodePeerStorageRetrieval (PeerStorageRetrieval ByteString
blob) = do
  blobLen <- Either EncodeError ByteString
-> (ByteString -> Either EncodeError ByteString)
-> Maybe ByteString
-> Either EncodeError ByteString
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (EncodeError -> Either EncodeError ByteString
forall a b. a -> Either a b
Left EncodeError
EncodeLengthOverflow) ByteString -> Either EncodeError ByteString
forall a b. b -> Either a b
Right (ByteString -> Maybe ByteString
encodeLength ByteString
blob)
  Right $ mconcat [blobLen, blob]

-- | Encode a message to its payload bytes.
--
-- Checks that the payload does not exceed 65533 bytes (the maximum
-- possible given the 2-byte type field and 65535-byte message limit).
encodeMessage :: Message -> Either EncodeError BS.ByteString
encodeMessage :: Message -> Either EncodeError ByteString
encodeMessage Message
msg = do
  payload <- case Message
msg of
    MsgInitVal Init
m                 -> Init -> Either EncodeError ByteString
encodeInit Init
m
    MsgErrorVal Error
m                -> Error -> Either EncodeError ByteString
encodeError Error
m
    MsgWarningVal Warning
m              -> Warning -> Either EncodeError ByteString
encodeWarning Warning
m
    MsgPingVal Ping
m                 -> Ping -> Either EncodeError ByteString
encodePing Ping
m
    MsgPongVal Pong
m                 -> Pong -> Either EncodeError ByteString
encodePong Pong
m
    MsgPeerStorageVal PeerStorage
m          -> PeerStorage -> Either EncodeError ByteString
encodePeerStorage PeerStorage
m
    MsgPeerStorageRetrievalVal PeerStorageRetrieval
m -> PeerStorageRetrieval -> Either EncodeError ByteString
encodePeerStorageRetrieval PeerStorageRetrieval
m
  -- Payload must leave room for 2-byte type (max 65533 bytes)
  when (BS.length payload > 65533) $
    Left EncodeMessageTooLarge
  Right payload

-- | Encode a message as a complete envelope (type + payload + extension).
--
-- Per BOLT #1, the total message size must not exceed 65535 bytes.
encodeEnvelope :: Message -> Maybe TlvStream -> Either EncodeError BS.ByteString
encodeEnvelope :: Message -> Maybe TlvStream -> Either EncodeError ByteString
encodeEnvelope Message
msg Maybe TlvStream
mext = do
  payload <- Message -> Either EncodeError ByteString
encodeMessage Message
msg
  let !typeBytes = Word16 -> ByteString
encodeU16 (MsgType -> Word16
msgTypeWord (Message -> MsgType
messageType Message
msg))
      !extBytes = ByteString
-> (TlvStream -> ByteString) -> Maybe TlvStream -> ByteString
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ByteString
BS.empty TlvStream -> ByteString
encodeTlvStream Maybe TlvStream
mext
      !result = [ByteString] -> ByteString
forall a. Monoid a => [a] -> a
mconcat [ByteString
typeBytes, ByteString
payload, ByteString
extBytes]
  -- Per BOLT #1: message size must fit in 2 bytes (max 65535)
  when (BS.length result > 65535) $
    Left EncodeMessageTooLarge
  Right result

-- Decoding errors -------------------------------------------------------------

-- | Decoding errors.
data DecodeError
  = DecodeInsufficientBytes
  | DecodeInvalidLength
  | DecodeUnknownEvenType !Word16
  | DecodeUnknownOddType !Word16
  | DecodeTlvError !TlvError
  | DecodeInvalidChannelId
  | DecodeInvalidExtension !TlvError
  deriving stock (DecodeError -> DecodeError -> Bool
(DecodeError -> DecodeError -> Bool)
-> (DecodeError -> DecodeError -> Bool) -> Eq DecodeError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DecodeError -> DecodeError -> Bool
== :: DecodeError -> DecodeError -> Bool
$c/= :: DecodeError -> DecodeError -> Bool
/= :: DecodeError -> DecodeError -> Bool
Eq, Int -> DecodeError -> ShowS
[DecodeError] -> ShowS
DecodeError -> String
(Int -> DecodeError -> ShowS)
-> (DecodeError -> String)
-> ([DecodeError] -> ShowS)
-> Show DecodeError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DecodeError -> ShowS
showsPrec :: Int -> DecodeError -> ShowS
$cshow :: DecodeError -> String
show :: DecodeError -> String
$cshowList :: [DecodeError] -> ShowS
showList :: [DecodeError] -> ShowS
Show, (forall x. DecodeError -> Rep DecodeError x)
-> (forall x. Rep DecodeError x -> DecodeError)
-> Generic DecodeError
forall x. Rep DecodeError x -> DecodeError
forall x. DecodeError -> Rep DecodeError x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. DecodeError -> Rep DecodeError x
from :: forall x. DecodeError -> Rep DecodeError x
$cto :: forall x. Rep DecodeError x -> DecodeError
to :: forall x. Rep DecodeError x -> DecodeError
Generic)

instance NFData DecodeError

-- Message decoding ------------------------------------------------------------

-- | Decode an Init message from payload bytes.
--
-- Returns the decoded message and any remaining bytes.
decodeInit :: BS.ByteString -> Either DecodeError (Init, BS.ByteString)
decodeInit :: ByteString -> Either DecodeError (Init, ByteString)
decodeInit !ByteString
bs = do
  (gfLen, rest1) <- Either DecodeError (Word16, ByteString)
-> ((Word16, ByteString)
    -> Either DecodeError (Word16, ByteString))
-> Maybe (Word16, ByteString)
-> Either DecodeError (Word16, ByteString)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (DecodeError -> Either DecodeError (Word16, ByteString)
forall a b. a -> Either a b
Left DecodeError
DecodeInsufficientBytes) (Word16, ByteString) -> Either DecodeError (Word16, ByteString)
forall a b. b -> Either a b
Right
                      (ByteString -> Maybe (Word16, ByteString)
decodeU16 ByteString
bs)
  unless (BS.length rest1 >= fromIntegral gfLen) $
    Left DecodeInsufficientBytes
  let !gf = Int -> ByteString -> ByteString
BS.take (Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
gfLen) ByteString
rest1
      !rest2 = Int -> ByteString -> ByteString
BS.drop (Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
gfLen) ByteString
rest1
  (fLen, rest3) <- maybe (Left DecodeInsufficientBytes) Right
                     (decodeU16 rest2)
  unless (BS.length rest3 >= fromIntegral fLen) $
    Left DecodeInsufficientBytes
  let !feat = Int -> ByteString -> ByteString
BS.take (Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
fLen) ByteString
rest3
      !rest4 = Int -> ByteString -> ByteString
BS.drop (Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
fLen) ByteString
rest3
  -- Parse optional TLV stream (consumes all remaining bytes for init)
  tlvs <- if BS.null rest4
    then Right (unsafeTlvStream [])
    else either (Left . DecodeTlvError) Right (decodeTlvStream rest4)
  initTlvList <- either (Left . DecodeTlvError) Right
                   (parseInitTlvs tlvs)
  -- Init consumes all bytes (TLVs are part of init, not extensions)
  Right (Init gf feat initTlvList, BS.empty)

-- | Decode an Error message from payload bytes.
decodeError :: BS.ByteString -> Either DecodeError (Error, BS.ByteString)
decodeError :: ByteString -> Either DecodeError (Error, ByteString)
decodeError !ByteString
bs = do
  Bool -> Either DecodeError () -> Either DecodeError ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (ByteString -> Int
BS.length ByteString
bs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
32) (Either DecodeError () -> Either DecodeError ())
-> Either DecodeError () -> Either DecodeError ()
forall a b. (a -> b) -> a -> b
$ DecodeError -> Either DecodeError ()
forall a b. a -> Either a b
Left DecodeError
DecodeInsufficientBytes
  let !cidBytes :: ByteString
cidBytes = Int -> ByteString -> ByteString
BS.take Int
32 ByteString
bs
      !rest1 :: ByteString
rest1 = Int -> ByteString -> ByteString
BS.drop Int
32 ByteString
bs
  cid <- Either DecodeError ChannelId
-> (ChannelId -> Either DecodeError ChannelId)
-> Maybe ChannelId
-> Either DecodeError ChannelId
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (DecodeError -> Either DecodeError ChannelId
forall a b. a -> Either a b
Left DecodeError
DecodeInvalidChannelId) ChannelId -> Either DecodeError ChannelId
forall a b. b -> Either a b
Right (ByteString -> Maybe ChannelId
channelId ByteString
cidBytes)
  (dLen, rest2) <- maybe (Left DecodeInsufficientBytes) Right
                     (decodeU16 rest1)
  unless (BS.length rest2 >= fromIntegral dLen) $
    Left DecodeInsufficientBytes
  let !dat = Int -> ByteString -> ByteString
BS.take (Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
dLen) ByteString
rest2
      !rest3 = Int -> ByteString -> ByteString
BS.drop (Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
dLen) ByteString
rest2
  Right (Error cid dat, rest3)

-- | Decode a Warning message from payload bytes.
decodeWarning :: BS.ByteString -> Either DecodeError (Warning, BS.ByteString)
decodeWarning :: ByteString -> Either DecodeError (Warning, ByteString)
decodeWarning !ByteString
bs = do
  Bool -> Either DecodeError () -> Either DecodeError ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (ByteString -> Int
BS.length ByteString
bs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
32) (Either DecodeError () -> Either DecodeError ())
-> Either DecodeError () -> Either DecodeError ()
forall a b. (a -> b) -> a -> b
$ DecodeError -> Either DecodeError ()
forall a b. a -> Either a b
Left DecodeError
DecodeInsufficientBytes
  let !cidBytes :: ByteString
cidBytes = Int -> ByteString -> ByteString
BS.take Int
32 ByteString
bs
      !rest1 :: ByteString
rest1 = Int -> ByteString -> ByteString
BS.drop Int
32 ByteString
bs
  cid <- Either DecodeError ChannelId
-> (ChannelId -> Either DecodeError ChannelId)
-> Maybe ChannelId
-> Either DecodeError ChannelId
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (DecodeError -> Either DecodeError ChannelId
forall a b. a -> Either a b
Left DecodeError
DecodeInvalidChannelId) ChannelId -> Either DecodeError ChannelId
forall a b. b -> Either a b
Right (ByteString -> Maybe ChannelId
channelId ByteString
cidBytes)
  (dLen, rest2) <- maybe (Left DecodeInsufficientBytes) Right
                     (decodeU16 rest1)
  unless (BS.length rest2 >= fromIntegral dLen) $
    Left DecodeInsufficientBytes
  let !dat = Int -> ByteString -> ByteString
BS.take (Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
dLen) ByteString
rest2
      !rest3 = Int -> ByteString -> ByteString
BS.drop (Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
dLen) ByteString
rest2
  Right (Warning cid dat, rest3)

-- | Decode a Ping message from payload bytes.
decodePing :: BS.ByteString -> Either DecodeError (Ping, BS.ByteString)
decodePing :: ByteString -> Either DecodeError (Ping, ByteString)
decodePing !ByteString
bs = do
  (numPong, rest1) <- Either DecodeError (Word16, ByteString)
-> ((Word16, ByteString)
    -> Either DecodeError (Word16, ByteString))
-> Maybe (Word16, ByteString)
-> Either DecodeError (Word16, ByteString)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (DecodeError -> Either DecodeError (Word16, ByteString)
forall a b. a -> Either a b
Left DecodeError
DecodeInsufficientBytes) (Word16, ByteString) -> Either DecodeError (Word16, ByteString)
forall a b. b -> Either a b
Right
                        (ByteString -> Maybe (Word16, ByteString)
decodeU16 ByteString
bs)
  (bLen, rest2) <- maybe (Left DecodeInsufficientBytes) Right
                     (decodeU16 rest1)
  unless (BS.length rest2 >= fromIntegral bLen) $
    Left DecodeInsufficientBytes
  let !ignored = Int -> ByteString -> ByteString
BS.take (Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
bLen) ByteString
rest2
      !rest3 = Int -> ByteString -> ByteString
BS.drop (Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
bLen) ByteString
rest2
  Right (Ping numPong ignored, rest3)

-- | Decode a Pong message from payload bytes.
decodePong :: BS.ByteString -> Either DecodeError (Pong, BS.ByteString)
decodePong :: ByteString -> Either DecodeError (Pong, ByteString)
decodePong !ByteString
bs = do
  (bLen, rest1) <- Either DecodeError (Word16, ByteString)
-> ((Word16, ByteString)
    -> Either DecodeError (Word16, ByteString))
-> Maybe (Word16, ByteString)
-> Either DecodeError (Word16, ByteString)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (DecodeError -> Either DecodeError (Word16, ByteString)
forall a b. a -> Either a b
Left DecodeError
DecodeInsufficientBytes) (Word16, ByteString) -> Either DecodeError (Word16, ByteString)
forall a b. b -> Either a b
Right
                     (ByteString -> Maybe (Word16, ByteString)
decodeU16 ByteString
bs)
  unless (BS.length rest1 >= fromIntegral bLen) $
    Left DecodeInsufficientBytes
  let !ignored = Int -> ByteString -> ByteString
BS.take (Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
bLen) ByteString
rest1
      !rest2 = Int -> ByteString -> ByteString
BS.drop (Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
bLen) ByteString
rest1
  Right (Pong ignored, rest2)

-- | Decode a PeerStorage message from payload bytes.
decodePeerStorage
  :: BS.ByteString -> Either DecodeError (PeerStorage, BS.ByteString)
decodePeerStorage :: ByteString -> Either DecodeError (PeerStorage, ByteString)
decodePeerStorage !ByteString
bs = do
  (bLen, rest1) <- Either DecodeError (Word16, ByteString)
-> ((Word16, ByteString)
    -> Either DecodeError (Word16, ByteString))
-> Maybe (Word16, ByteString)
-> Either DecodeError (Word16, ByteString)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (DecodeError -> Either DecodeError (Word16, ByteString)
forall a b. a -> Either a b
Left DecodeError
DecodeInsufficientBytes) (Word16, ByteString) -> Either DecodeError (Word16, ByteString)
forall a b. b -> Either a b
Right
                     (ByteString -> Maybe (Word16, ByteString)
decodeU16 ByteString
bs)
  unless (BS.length rest1 >= fromIntegral bLen) $
    Left DecodeInsufficientBytes
  let !blob = Int -> ByteString -> ByteString
BS.take (Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
bLen) ByteString
rest1
      !rest2 = Int -> ByteString -> ByteString
BS.drop (Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
bLen) ByteString
rest1
  Right (PeerStorage blob, rest2)

-- | Decode a PeerStorageRetrieval message from payload bytes.
decodePeerStorageRetrieval
  :: BS.ByteString
  -> Either DecodeError (PeerStorageRetrieval, BS.ByteString)
decodePeerStorageRetrieval :: ByteString -> Either DecodeError (PeerStorageRetrieval, ByteString)
decodePeerStorageRetrieval !ByteString
bs = do
  (bLen, rest1) <- Either DecodeError (Word16, ByteString)
-> ((Word16, ByteString)
    -> Either DecodeError (Word16, ByteString))
-> Maybe (Word16, ByteString)
-> Either DecodeError (Word16, ByteString)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (DecodeError -> Either DecodeError (Word16, ByteString)
forall a b. a -> Either a b
Left DecodeError
DecodeInsufficientBytes) (Word16, ByteString) -> Either DecodeError (Word16, ByteString)
forall a b. b -> Either a b
Right
                     (ByteString -> Maybe (Word16, ByteString)
decodeU16 ByteString
bs)
  unless (BS.length rest1 >= fromIntegral bLen) $
    Left DecodeInsufficientBytes
  let !blob = Int -> ByteString -> ByteString
BS.take (Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
bLen) ByteString
rest1
      !rest2 = Int -> ByteString -> ByteString
BS.drop (Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
bLen) ByteString
rest1
  Right (PeerStorageRetrieval blob, rest2)

-- | Decode a message from its type and payload.
--
-- Returns the decoded message and any remaining bytes (for extensions).
-- For unknown types, returns an appropriate error.
decodeMessage
  :: MsgType -> BS.ByteString -> Either DecodeError (Message, BS.ByteString)
decodeMessage :: MsgType -> ByteString -> Either DecodeError (Message, ByteString)
decodeMessage MsgType
MsgInit ByteString
bs = do
  (m, rest) <- ByteString -> Either DecodeError (Init, ByteString)
decodeInit ByteString
bs
  Right (MsgInitVal m, rest)
decodeMessage MsgType
MsgError ByteString
bs = do
  (m, rest) <- ByteString -> Either DecodeError (Error, ByteString)
decodeError ByteString
bs
  Right (MsgErrorVal m, rest)
decodeMessage MsgType
MsgWarning ByteString
bs = do
  (m, rest) <- ByteString -> Either DecodeError (Warning, ByteString)
decodeWarning ByteString
bs
  Right (MsgWarningVal m, rest)
decodeMessage MsgType
MsgPing ByteString
bs = do
  (m, rest) <- ByteString -> Either DecodeError (Ping, ByteString)
decodePing ByteString
bs
  Right (MsgPingVal m, rest)
decodeMessage MsgType
MsgPong ByteString
bs = do
  (m, rest) <- ByteString -> Either DecodeError (Pong, ByteString)
decodePong ByteString
bs
  Right (MsgPongVal m, rest)
decodeMessage MsgType
MsgPeerStorage ByteString
bs = do
  (m, rest) <- ByteString -> Either DecodeError (PeerStorage, ByteString)
decodePeerStorage ByteString
bs
  Right (MsgPeerStorageVal m, rest)
decodeMessage MsgType
MsgPeerStorageRet ByteString
bs = do
  (m, rest) <- ByteString -> Either DecodeError (PeerStorageRetrieval, ByteString)
decodePeerStorageRetrieval ByteString
bs
  Right (MsgPeerStorageRetrievalVal m, rest)
decodeMessage (MsgUnknown Word16
w) ByteString
_
  | Word16 -> Bool
forall a. Integral a => a -> Bool
even Word16
w    = DecodeError -> Either DecodeError (Message, ByteString)
forall a b. a -> Either a b
Left (Word16 -> DecodeError
DecodeUnknownEvenType Word16
w)
  | Bool
otherwise = DecodeError -> Either DecodeError (Message, ByteString)
forall a b. a -> Either a b
Left (Word16 -> DecodeError
DecodeUnknownOddType Word16
w)

-- | Decode a complete envelope (type + payload + optional extension).
--
-- Per BOLT #1:
-- - Unknown odd message types are ignored (returns Nothing for message)
-- - Unknown even message types cause connection close (returns error)
-- - Invalid extension TLV causes connection close (returns error)
--
-- This uses the default policy of treating all extension TLV types as
-- unknown. Use 'decodeEnvelopeWith' for configurable extension handling.
--
-- Returns the decoded message (if known) and any extension TLVs.
decodeEnvelope
  :: BS.ByteString
  -> Either DecodeError (Maybe Message, Maybe TlvStream)
decodeEnvelope :: ByteString -> Either DecodeError (Maybe Message, Maybe TlvStream)
decodeEnvelope = (Word64 -> Bool)
-> ByteString
-> Either DecodeError (Maybe Message, Maybe TlvStream)
decodeEnvelopeWith (Bool -> Word64 -> Bool
forall a b. a -> b -> a
const Bool
False)

-- | Decode a complete envelope with configurable extension TLV handling.
--
-- The predicate determines which extension TLV types are "known" and
-- should be preserved. Unknown even types cause failure; unknown odd
-- types are skipped.
--
-- Use @decodeEnvelopeWith (const False)@ to reject all even extension
-- types (the default behavior of 'decodeEnvelope').
--
-- Use @decodeEnvelopeWith (const True)@ to accept all extension types.
decodeEnvelopeWith
  :: (Word64 -> Bool)  -- ^ Predicate: is this extension TLV type known?
  -> BS.ByteString
  -> Either DecodeError (Maybe Message, Maybe TlvStream)
decodeEnvelopeWith :: (Word64 -> Bool)
-> ByteString
-> Either DecodeError (Maybe Message, Maybe TlvStream)
decodeEnvelopeWith Word64 -> Bool
isKnownExt !ByteString
bs = do
  (typeWord, rest1) <- Either DecodeError (Word16, ByteString)
-> ((Word16, ByteString)
    -> Either DecodeError (Word16, ByteString))
-> Maybe (Word16, ByteString)
-> Either DecodeError (Word16, ByteString)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (DecodeError -> Either DecodeError (Word16, ByteString)
forall a b. a -> Either a b
Left DecodeError
DecodeInsufficientBytes) (Word16, ByteString) -> Either DecodeError (Word16, ByteString)
forall a b. b -> Either a b
Right
                         (ByteString -> Maybe (Word16, ByteString)
decodeU16 ByteString
bs)
  let !msgType = Word16 -> MsgType
parseMsgType Word16
typeWord
  case msgType of
    MsgUnknown Word16
w
      | Word16 -> Bool
forall a. Integral a => a -> Bool
even Word16
w    -> DecodeError -> Either DecodeError (Maybe Message, Maybe TlvStream)
forall a b. a -> Either a b
Left (Word16 -> DecodeError
DecodeUnknownEvenType Word16
w)
      | Bool
otherwise -> (Maybe Message, Maybe TlvStream)
-> Either DecodeError (Maybe Message, Maybe TlvStream)
forall a b. b -> Either a b
Right (Maybe Message
forall a. Maybe a
Nothing, Maybe TlvStream
forall a. Maybe a
Nothing)  -- Ignore unknown odd types
    MsgType
_ -> do
      (msg, rest2) <- MsgType -> ByteString -> Either DecodeError (Message, ByteString)
decodeMessage MsgType
msgType ByteString
rest1
      -- Parse any remaining bytes as extension TLV
      ext <- if BS.null rest2
        then Right Nothing
        else case decodeTlvStreamWith isKnownExt rest2 of
          Left TlvError
e  -> DecodeError -> Either DecodeError (Maybe TlvStream)
forall a b. a -> Either a b
Left (TlvError -> DecodeError
DecodeInvalidExtension TlvError
e)
          Right TlvStream
s -> Maybe TlvStream -> Either DecodeError (Maybe TlvStream)
forall a b. b -> Either a b
Right (TlvStream -> Maybe TlvStream
forall a. a -> Maybe a
Just TlvStream
s)
      Right (Just msg, ext)