{-# OPTIONS_HADDOCK prune #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE OverloadedStrings #-}

-- |
-- Module: Lightning.Protocol.BOLT4.Codec
-- Copyright: (c) 2025 Jared Tobin
-- License: MIT
-- Maintainer: Jared Tobin <jared@ppad.tech>
--
-- Serialization and deserialization for BOLT4 types.

module Lightning.Protocol.BOLT4.Codec (
    -- * BigSize encoding
    encodeBigSize
  , decodeBigSize
  , bigSizeLen

    -- * TLV encoding
  , encodeTlv
  , decodeTlv
  , decodeTlvStream
  , encodeTlvStream

    -- * Packet serialization
  , encodeOnionPacket
  , decodeOnionPacket
  , encodeHopPayload
  , decodeHopPayload

    -- * ShortChannelId
  , encodeShortChannelId
  , decodeShortChannelId

    -- * Failure messages
  , encodeFailureMessage
  , decodeFailureMessage

    -- * Internal helpers (for Blinding)
  , toStrict
  , word16BE
  , word32BE
  , encodeWord64TU
  , decodeWord64TU
  , encodeWord32TU
  , decodeWord32TU
  ) where

import Data.Bits (shiftL, shiftR, (.&.))
import qualified Data.ByteString as BS
import qualified Data.ByteString.Builder as B
import qualified Data.ByteString.Lazy as BL
import Data.Word (Word16, Word32, Word64)
import Lightning.Protocol.BOLT4.Types

-- BigSize encoding ---------------------------------------------------------

-- | Encode integer as BigSize.
--
-- * 0-0xFC: 1 byte
-- * 0xFD-0xFFFF: 0xFD ++ 2 bytes BE
-- * 0x10000-0xFFFFFFFF: 0xFE ++ 4 bytes BE
-- * larger: 0xFF ++ 8 bytes BE
encodeBigSize :: Word64 -> BS.ByteString
encodeBigSize :: Word64 -> ByteString
encodeBigSize !Word64
n
  | Word64
n Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
< Word64
0xFD = Word8 -> ByteString
BS.singleton (Word64 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
n)
  | Word64
n Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word64
0xFFFF = Builder -> ByteString
toStrict (Builder -> ByteString) -> Builder -> ByteString
forall a b. (a -> b) -> a -> b
$
      Word8 -> Builder
B.word8 Word8
0xFD Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Word16 -> Builder
B.word16BE (Word64 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
n)
  | Word64
n Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word64
0xFFFFFFFF = Builder -> ByteString
toStrict (Builder -> ByteString) -> Builder -> ByteString
forall a b. (a -> b) -> a -> b
$
      Word8 -> Builder
B.word8 Word8
0xFE Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Word32 -> Builder
B.word32BE (Word64 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
n)
  | Bool
otherwise = Builder -> ByteString
toStrict (Builder -> ByteString) -> Builder -> ByteString
forall a b. (a -> b) -> a -> b
$
      Word8 -> Builder
B.word8 Word8
0xFF Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Word64 -> Builder
B.word64BE Word64
n
{-# INLINE encodeBigSize #-}

-- | Decode BigSize, returning (value, remaining bytes).
decodeBigSize :: BS.ByteString -> Maybe (Word64, BS.ByteString)
decodeBigSize :: ByteString -> Maybe (Word64, ByteString)
decodeBigSize !ByteString
bs = case ByteString -> Maybe (Word8, ByteString)
BS.uncons ByteString
bs of
  Maybe (Word8, ByteString)
Nothing -> Maybe (Word64, ByteString)
forall a. Maybe a
Nothing
  Just (Word8
b, ByteString
rest)
    | Word8
b Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
< Word8
0xFD -> (Word64, ByteString) -> Maybe (Word64, ByteString)
forall a. a -> Maybe a
Just (Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
b, ByteString
rest)
    | Word8
b Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0xFD -> do
        (hi, r1) <- ByteString -> Maybe (Word8, ByteString)
BS.uncons ByteString
rest
        (lo, r2) <- BS.uncons r1
        let !val = Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
hi Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftL` Int
8 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
lo
        -- Canonical: must be >= 0xFD
        if val < 0xFD then Nothing else Just (val, r2)
    | Word8
b Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0xFE -> do
        if ByteString -> Int
BS.length ByteString
rest Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
4 then Maybe (Word64, ByteString)
forall a. Maybe a
Nothing else do
          let !bytes :: ByteString
bytes = Int -> ByteString -> ByteString
BS.take Int
4 ByteString
rest
              !r :: ByteString
r = Int -> ByteString -> ByteString
BS.drop Int
4 ByteString
rest
              !val :: Word32
val = ByteString -> Word32
word32BE ByteString
bytes
          -- Canonical: must be > 0xFFFF
          if Word32
val Word32 -> Word32 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word32
0xFFFF then Maybe (Word64, ByteString)
forall a. Maybe a
Nothing else (Word64, ByteString) -> Maybe (Word64, ByteString)
forall a. a -> Maybe a
Just (Word32 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
val, ByteString
r)
    | Bool
otherwise -> do  -- b == 0xFF
        if ByteString -> Int
BS.length ByteString
rest Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
8 then Maybe (Word64, ByteString)
forall a. Maybe a
Nothing else do
          let !bytes :: ByteString
bytes = Int -> ByteString -> ByteString
BS.take Int
8 ByteString
rest
              !r :: ByteString
r = Int -> ByteString -> ByteString
BS.drop Int
8 ByteString
rest
              !val :: Word64
val = ByteString -> Word64
word64BE ByteString
bytes
          -- Canonical: must be > 0xFFFFFFFF
          if Word64
val Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word64
0xFFFFFFFF then Maybe (Word64, ByteString)
forall a. Maybe a
Nothing else (Word64, ByteString) -> Maybe (Word64, ByteString)
forall a. a -> Maybe a
Just (Word64
val, ByteString
r)
{-# INLINE decodeBigSize #-}

-- | Get encoded size of a BigSize value without encoding.
bigSizeLen :: Word64 -> Int
bigSizeLen :: Word64 -> Int
bigSizeLen !Word64
n
  | Word64
n Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
< Word64
0xFD       = Int
1
  | Word64
n Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word64
0xFFFF    = Int
3
  | Word64
n Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word64
0xFFFFFFFF = Int
5
  | Bool
otherwise      = Int
9
{-# INLINE bigSizeLen #-}

-- TLV encoding -------------------------------------------------------------

-- | Encode a TLV record.
encodeTlv :: TlvRecord -> BS.ByteString
encodeTlv :: TlvRecord -> ByteString
encodeTlv (TlvRecord !Word64
typ !ByteString
val) = Builder -> ByteString
toStrict (Builder -> ByteString) -> Builder -> ByteString
forall a b. (a -> b) -> a -> b
$
  ByteString -> Builder
B.byteString (Word64 -> ByteString
encodeBigSize Word64
typ) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
  ByteString -> Builder
B.byteString (Word64 -> ByteString
encodeBigSize (Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int
BS.length ByteString
val))) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
  ByteString -> Builder
B.byteString ByteString
val
{-# INLINE encodeTlv #-}

-- | Decode a single TLV record.
decodeTlv :: BS.ByteString -> Maybe (TlvRecord, BS.ByteString)
decodeTlv :: ByteString -> Maybe (TlvRecord, ByteString)
decodeTlv !ByteString
bs = do
  (typ, r1) <- ByteString -> Maybe (Word64, ByteString)
decodeBigSize ByteString
bs
  (len, r2) <- decodeBigSize r1
  let !len' = Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
len
  if BS.length r2 < len'
    then Nothing
    else do
      let !val = Int -> ByteString -> ByteString
BS.take Int
len' ByteString
r2
          !rest = Int -> ByteString -> ByteString
BS.drop Int
len' ByteString
r2
      Just (TlvRecord typ val, rest)
{-# INLINE decodeTlv #-}

-- | Decode a TLV stream (sequence of records).
-- Validates strictly increasing type order.
decodeTlvStream :: BS.ByteString -> Maybe [TlvRecord]
decodeTlvStream :: ByteString -> Maybe [TlvRecord]
decodeTlvStream = Maybe Word64 -> ByteString -> Maybe [TlvRecord]
go Maybe Word64
forall a. Maybe a
Nothing
  where
    go :: Maybe Word64 -> BS.ByteString -> Maybe [TlvRecord]
    go :: Maybe Word64 -> ByteString -> Maybe [TlvRecord]
go Maybe Word64
_ !ByteString
bs | ByteString -> Bool
BS.null ByteString
bs = [TlvRecord] -> Maybe [TlvRecord]
forall a. a -> Maybe a
Just []
    go !Maybe Word64
mPrev !ByteString
bs = do
      (rec@(TlvRecord typ _), rest) <- ByteString -> Maybe (TlvRecord, ByteString)
decodeTlv ByteString
bs
      -- Check strictly increasing order
      case mPrev of
        Just Word64
prev | Word64
typ Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word64
prev -> Maybe [TlvRecord]
forall a. Maybe a
Nothing
        Maybe Word64
_ -> do
          recs <- Maybe Word64 -> ByteString -> Maybe [TlvRecord]
go (Word64 -> Maybe Word64
forall a. a -> Maybe a
Just Word64
typ) ByteString
rest
          Just (rec : recs)

-- | Encode a TLV stream from records.
-- Records must be sorted by type, no duplicates.
encodeTlvStream :: [TlvRecord] -> BS.ByteString
encodeTlvStream :: [TlvRecord] -> ByteString
encodeTlvStream ![TlvRecord]
recs = Builder -> ByteString
toStrict (Builder -> ByteString) -> Builder -> ByteString
forall a b. (a -> b) -> a -> b
$ (TlvRecord -> Builder) -> [TlvRecord] -> Builder
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (ByteString -> Builder
B.byteString (ByteString -> Builder)
-> (TlvRecord -> ByteString) -> TlvRecord -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TlvRecord -> ByteString
encodeTlv) [TlvRecord]
recs
{-# INLINE encodeTlvStream #-}

-- Packet serialization -----------------------------------------------------

-- | Serialize OnionPacket to 1366 bytes.
encodeOnionPacket :: OnionPacket -> BS.ByteString
encodeOnionPacket :: OnionPacket -> ByteString
encodeOnionPacket (OnionPacket !Word8
ver !ByteString
eph !ByteString
payloads !ByteString
mac) = Builder -> ByteString
toStrict (Builder -> ByteString) -> Builder -> ByteString
forall a b. (a -> b) -> a -> b
$
  Word8 -> Builder
B.word8 Word8
ver Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
  ByteString -> Builder
B.byteString ByteString
eph Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
  ByteString -> Builder
B.byteString ByteString
payloads Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
  ByteString -> Builder
B.byteString ByteString
mac
{-# INLINE encodeOnionPacket #-}

-- | Parse OnionPacket from 1366 bytes.
decodeOnionPacket :: BS.ByteString -> Maybe OnionPacket
decodeOnionPacket :: ByteString -> Maybe OnionPacket
decodeOnionPacket !ByteString
bs
  | ByteString -> Int
BS.length ByteString
bs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
onionPacketSize = Maybe OnionPacket
forall a. Maybe a
Nothing
  | Bool
otherwise =
      let !ver :: Word8
ver = HasCallStack => ByteString -> Int -> Word8
ByteString -> Int -> Word8
BS.index ByteString
bs Int
0
          !eph :: ByteString
eph = Int -> ByteString -> ByteString
BS.take Int
pubkeySize (Int -> ByteString -> ByteString
BS.drop Int
1 ByteString
bs)
          !payloads :: ByteString
payloads = Int -> ByteString -> ByteString
BS.take Int
hopPayloadsSize (Int -> ByteString -> ByteString
BS.drop (Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
pubkeySize) ByteString
bs)
          !mac :: ByteString
mac = Int -> ByteString -> ByteString
BS.drop (Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
pubkeySize Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
hopPayloadsSize) ByteString
bs
      in  OnionPacket -> Maybe OnionPacket
forall a. a -> Maybe a
Just (Word8 -> ByteString -> ByteString -> ByteString -> OnionPacket
OnionPacket Word8
ver ByteString
eph ByteString
payloads ByteString
mac)
{-# INLINE decodeOnionPacket #-}

-- | Encode HopPayload to bytes (without length prefix).
encodeHopPayload :: HopPayload -> BS.ByteString
encodeHopPayload :: HopPayload -> ByteString
encodeHopPayload !HopPayload
hp = [TlvRecord] -> ByteString
encodeTlvStream (HopPayload -> [TlvRecord]
buildTlvs HopPayload
hp)
  where
    buildTlvs :: HopPayload -> [TlvRecord]
    buildTlvs :: HopPayload -> [TlvRecord]
buildTlvs (HopPayload Maybe Word64
amt Maybe Word32
cltv Maybe ShortChannelId
sci Maybe PaymentData
pd Maybe ByteString
ed Maybe ByteString
cpk [TlvRecord]
unk) =
      let amt' :: [TlvRecord]
amt' = [TlvRecord]
-> (Word64 -> [TlvRecord]) -> Maybe Word64 -> [TlvRecord]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\Word64
a -> [Word64 -> ByteString -> TlvRecord
TlvRecord Word64
2 (Word64 -> ByteString
encodeWord64TU Word64
a)]) Maybe Word64
amt
          cltv' :: [TlvRecord]
cltv' = [TlvRecord]
-> (Word32 -> [TlvRecord]) -> Maybe Word32 -> [TlvRecord]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\Word32
c -> [Word64 -> ByteString -> TlvRecord
TlvRecord Word64
4 (Word32 -> ByteString
encodeWord32TU Word32
c)]) Maybe Word32
cltv
          sci' :: [TlvRecord]
sci' = [TlvRecord]
-> (ShortChannelId -> [TlvRecord])
-> Maybe ShortChannelId
-> [TlvRecord]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\ShortChannelId
s -> [Word64 -> ByteString -> TlvRecord
TlvRecord Word64
6 (ShortChannelId -> ByteString
encodeShortChannelId ShortChannelId
s)]) Maybe ShortChannelId
sci
          pd' :: [TlvRecord]
pd' = [TlvRecord]
-> (PaymentData -> [TlvRecord]) -> Maybe PaymentData -> [TlvRecord]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\PaymentData
p -> [Word64 -> ByteString -> TlvRecord
TlvRecord Word64
8 (PaymentData -> ByteString
encodePaymentData PaymentData
p)]) Maybe PaymentData
pd
          ed' :: [TlvRecord]
ed' = [TlvRecord]
-> (ByteString -> [TlvRecord]) -> Maybe ByteString -> [TlvRecord]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\ByteString
e -> [Word64 -> ByteString -> TlvRecord
TlvRecord Word64
10 ByteString
e]) Maybe ByteString
ed
          cpk' :: [TlvRecord]
cpk' = [TlvRecord]
-> (ByteString -> [TlvRecord]) -> Maybe ByteString -> [TlvRecord]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\ByteString
k -> [Word64 -> ByteString -> TlvRecord
TlvRecord Word64
12 ByteString
k]) Maybe ByteString
cpk
      in  [TlvRecord]
amt' [TlvRecord] -> [TlvRecord] -> [TlvRecord]
forall a. [a] -> [a] -> [a]
++ [TlvRecord]
cltv' [TlvRecord] -> [TlvRecord] -> [TlvRecord]
forall a. [a] -> [a] -> [a]
++ [TlvRecord]
sci' [TlvRecord] -> [TlvRecord] -> [TlvRecord]
forall a. [a] -> [a] -> [a]
++ [TlvRecord]
pd' [TlvRecord] -> [TlvRecord] -> [TlvRecord]
forall a. [a] -> [a] -> [a]
++ [TlvRecord]
ed' [TlvRecord] -> [TlvRecord] -> [TlvRecord]
forall a. [a] -> [a] -> [a]
++ [TlvRecord]
cpk' [TlvRecord] -> [TlvRecord] -> [TlvRecord]
forall a. [a] -> [a] -> [a]
++ [TlvRecord]
unk

-- | Decode HopPayload from bytes.
decodeHopPayload :: BS.ByteString -> Maybe HopPayload
decodeHopPayload :: ByteString -> Maybe HopPayload
decodeHopPayload !ByteString
bs = do
  tlvs <- ByteString -> Maybe [TlvRecord]
decodeTlvStream ByteString
bs
  parseHopPayload tlvs

parseHopPayload :: [TlvRecord] -> Maybe HopPayload
parseHopPayload :: [TlvRecord] -> Maybe HopPayload
parseHopPayload = HopPayload -> [TlvRecord] -> Maybe HopPayload
go HopPayload
emptyHop
  where
    emptyHop :: HopPayload
    emptyHop :: HopPayload
emptyHop = Maybe Word64
-> Maybe Word32
-> Maybe ShortChannelId
-> Maybe PaymentData
-> Maybe ByteString
-> Maybe ByteString
-> [TlvRecord]
-> HopPayload
HopPayload Maybe Word64
forall a. Maybe a
Nothing Maybe Word32
forall a. Maybe a
Nothing Maybe ShortChannelId
forall a. Maybe a
Nothing Maybe PaymentData
forall a. Maybe a
Nothing Maybe ByteString
forall a. Maybe a
Nothing Maybe ByteString
forall a. Maybe a
Nothing []

    go :: HopPayload -> [TlvRecord] -> Maybe HopPayload
    go :: HopPayload -> [TlvRecord] -> Maybe HopPayload
go !HopPayload
hp [] = HopPayload -> Maybe HopPayload
forall a. a -> Maybe a
Just HopPayload
hp { hpUnknownTlvs = reverse (hpUnknownTlvs hp) }
    go !HopPayload
hp (TlvRecord Word64
typ ByteString
val : [TlvRecord]
rest) = case Word64
typ of
      Word64
2  -> do
        amt <- ByteString -> Maybe Word64
decodeWord64TU ByteString
val
        go hp { hpAmtToForward = Just amt } rest
      Word64
4  -> do
        cltv <- ByteString -> Maybe Word32
decodeWord32TU ByteString
val
        go hp { hpOutgoingCltv = Just cltv } rest
      Word64
6  -> do
        sci <- ByteString -> Maybe ShortChannelId
decodeShortChannelId ByteString
val
        go hp { hpShortChannelId = Just sci } rest
      Word64
8  -> do
        pd <- ByteString -> Maybe PaymentData
decodePaymentData ByteString
val
        go hp { hpPaymentData = Just pd } rest
      Word64
10 -> HopPayload -> [TlvRecord] -> Maybe HopPayload
go HopPayload
hp { hpEncryptedData = Just val } [TlvRecord]
rest
      Word64
12 -> HopPayload -> [TlvRecord] -> Maybe HopPayload
go HopPayload
hp { hpCurrentPathKey = Just val } [TlvRecord]
rest
      Word64
_  -> HopPayload -> [TlvRecord] -> Maybe HopPayload
go HopPayload
hp { hpUnknownTlvs = TlvRecord typ val : hpUnknownTlvs hp } [TlvRecord]
rest

-- ShortChannelId -----------------------------------------------------------

-- | Encode ShortChannelId to 8 bytes.
-- Format: 3 bytes block || 3 bytes tx || 2 bytes output (all BE)
encodeShortChannelId :: ShortChannelId -> BS.ByteString
encodeShortChannelId :: ShortChannelId -> ByteString
encodeShortChannelId (ShortChannelId !Word32
blk !Word32
tx !Word16
out) = Builder -> ByteString
toStrict (Builder -> ByteString) -> Builder -> ByteString
forall a b. (a -> b) -> a -> b
$
  -- Block height: 3 bytes
  Word8 -> Builder
B.word8 (Word32 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32
blk Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftR` Int
16) Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0xFF) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
  Word8 -> Builder
B.word8 (Word32 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32
blk Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftR` Int
8) Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0xFF) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
  Word8 -> Builder
B.word8 (Word32 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
blk Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0xFF) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
  -- Tx index: 3 bytes
  Word8 -> Builder
B.word8 (Word32 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32
tx Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftR` Int
16) Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0xFF) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
  Word8 -> Builder
B.word8 (Word32 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32
tx Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftR` Int
8) Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0xFF) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
  Word8 -> Builder
B.word8 (Word32 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
tx Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0xFF) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
  -- Output index: 2 bytes
  Word16 -> Builder
B.word16BE Word16
out
{-# INLINE encodeShortChannelId #-}

-- | Decode ShortChannelId from 8 bytes.
decodeShortChannelId :: BS.ByteString -> Maybe ShortChannelId
decodeShortChannelId :: ByteString -> Maybe ShortChannelId
decodeShortChannelId !ByteString
bs
  | ByteString -> Int
BS.length ByteString
bs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
8 = Maybe ShortChannelId
forall a. Maybe a
Nothing
  | Bool
otherwise =
      let !b0 :: Word32
b0 = Word8 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (HasCallStack => ByteString -> Int -> Word8
ByteString -> Int -> Word8
BS.index ByteString
bs Int
0) :: Word32
          !b1 :: Word32
b1 = Word8 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (HasCallStack => ByteString -> Int -> Word8
ByteString -> Int -> Word8
BS.index ByteString
bs Int
1) :: Word32
          !b2 :: Word32
b2 = Word8 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (HasCallStack => ByteString -> Int -> Word8
ByteString -> Int -> Word8
BS.index ByteString
bs Int
2) :: Word32
          !blk :: Word32
blk = (Word32
b0 Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftL` Int
16) Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ (Word32
b1 Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftL` Int
8) Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Word32
b2
          !t0 :: Word32
t0 = Word8 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (HasCallStack => ByteString -> Int -> Word8
ByteString -> Int -> Word8
BS.index ByteString
bs Int
3) :: Word32
          !t1 :: Word32
t1 = Word8 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (HasCallStack => ByteString -> Int -> Word8
ByteString -> Int -> Word8
BS.index ByteString
bs Int
4) :: Word32
          !t2 :: Word32
t2 = Word8 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (HasCallStack => ByteString -> Int -> Word8
ByteString -> Int -> Word8
BS.index ByteString
bs Int
5) :: Word32
          !tx :: Word32
tx = (Word32
t0 Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftL` Int
16) Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ (Word32
t1 Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftL` Int
8) Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Word32
t2
          !o0 :: Word16
o0 = Word8 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (HasCallStack => ByteString -> Int -> Word8
ByteString -> Int -> Word8
BS.index ByteString
bs Int
6) :: Word16
          !o1 :: Word16
o1 = Word8 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (HasCallStack => ByteString -> Int -> Word8
ByteString -> Int -> Word8
BS.index ByteString
bs Int
7) :: Word16
          !out :: Word16
out = (Word16
o0 Word16 -> Int -> Word16
forall a. Bits a => a -> Int -> a
`shiftL` Int
8) Word16 -> Word16 -> Word16
forall a. Num a => a -> a -> a
+ Word16
o1
      in  ShortChannelId -> Maybe ShortChannelId
forall a. a -> Maybe a
Just (Word32 -> Word32 -> Word16 -> ShortChannelId
ShortChannelId Word32
blk Word32
tx Word16
out)
{-# INLINE decodeShortChannelId #-}

-- Failure messages ---------------------------------------------------------

-- | Encode failure message.
encodeFailureMessage :: FailureMessage -> BS.ByteString
encodeFailureMessage :: FailureMessage -> ByteString
encodeFailureMessage (FailureMessage (FailureCode !Word16
code) !ByteString
dat ![TlvRecord]
tlvs) =
  Builder -> ByteString
toStrict (Builder -> ByteString) -> Builder -> ByteString
forall a b. (a -> b) -> a -> b
$
    Word16 -> Builder
B.word16BE Word16
code Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
    Word16 -> Builder
B.word16BE (Int -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int
BS.length ByteString
dat)) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
    ByteString -> Builder
B.byteString ByteString
dat Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
    ByteString -> Builder
B.byteString ([TlvRecord] -> ByteString
encodeTlvStream [TlvRecord]
tlvs)
{-# INLINE encodeFailureMessage #-}

-- | Decode failure message.
decodeFailureMessage :: BS.ByteString -> Maybe FailureMessage
decodeFailureMessage :: ByteString -> Maybe FailureMessage
decodeFailureMessage !ByteString
bs = do
  if ByteString -> Int
BS.length ByteString
bs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
4 then Maybe FailureMessage
forall a. Maybe a
Nothing else do
    let !code :: Word16
code = ByteString -> Word16
word16BE (Int -> ByteString -> ByteString
BS.take Int
2 ByteString
bs)
        !dlen :: Int
dlen = Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Word16
word16BE (Int -> ByteString -> ByteString
BS.take Int
2 (Int -> ByteString -> ByteString
BS.drop Int
2 ByteString
bs)))
    if ByteString -> Int
BS.length ByteString
bs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
4 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
dlen then Maybe FailureMessage
forall a. Maybe a
Nothing else do
      let !dat :: ByteString
dat = Int -> ByteString -> ByteString
BS.take Int
dlen (Int -> ByteString -> ByteString
BS.drop Int
4 ByteString
bs)
          !tlvBytes :: ByteString
tlvBytes = Int -> ByteString -> ByteString
BS.drop (Int
4 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
dlen) ByteString
bs
      tlvs <- if ByteString -> Bool
BS.null ByteString
tlvBytes
                then [TlvRecord] -> Maybe [TlvRecord]
forall a. a -> Maybe a
Just []
                else ByteString -> Maybe [TlvRecord]
decodeTlvStream ByteString
tlvBytes
      Just (FailureMessage (FailureCode code) dat tlvs)

-- Helper functions ---------------------------------------------------------

-- | Convert Builder to strict ByteString.
toStrict :: B.Builder -> BS.ByteString
toStrict :: Builder -> ByteString
toStrict = LazyByteString -> ByteString
BL.toStrict (LazyByteString -> ByteString)
-> (Builder -> LazyByteString) -> Builder -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> LazyByteString
B.toLazyByteString
{-# INLINE toStrict #-}

-- | Decode big-endian Word16.
word16BE :: BS.ByteString -> Word16
word16BE :: ByteString -> Word16
word16BE !ByteString
bs =
  let !b0 :: Word16
b0 = Word8 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (HasCallStack => ByteString -> Int -> Word8
ByteString -> Int -> Word8
BS.index ByteString
bs Int
0) :: Word16
      !b1 :: Word16
b1 = Word8 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (HasCallStack => ByteString -> Int -> Word8
ByteString -> Int -> Word8
BS.index ByteString
bs Int
1) :: Word16
  in  (Word16
b0 Word16 -> Int -> Word16
forall a. Bits a => a -> Int -> a
`shiftL` Int
8) Word16 -> Word16 -> Word16
forall a. Num a => a -> a -> a
+ Word16
b1
{-# INLINE word16BE #-}

-- | Decode big-endian Word32.
word32BE :: BS.ByteString -> Word32
word32BE :: ByteString -> Word32
word32BE !ByteString
bs =
  let !b0 :: Word32
b0 = Word8 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (HasCallStack => ByteString -> Int -> Word8
ByteString -> Int -> Word8
BS.index ByteString
bs Int
0) :: Word32
      !b1 :: Word32
b1 = Word8 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (HasCallStack => ByteString -> Int -> Word8
ByteString -> Int -> Word8
BS.index ByteString
bs Int
1) :: Word32
      !b2 :: Word32
b2 = Word8 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (HasCallStack => ByteString -> Int -> Word8
ByteString -> Int -> Word8
BS.index ByteString
bs Int
2) :: Word32
      !b3 :: Word32
b3 = Word8 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (HasCallStack => ByteString -> Int -> Word8
ByteString -> Int -> Word8
BS.index ByteString
bs Int
3) :: Word32
  in  (Word32
b0 Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftL` Int
24) Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ (Word32
b1 Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftL` Int
16) Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ (Word32
b2 Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftL` Int
8) Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Word32
b3
{-# INLINE word32BE #-}

-- | Decode big-endian Word64.
word64BE :: BS.ByteString -> Word64
word64BE :: ByteString -> Word64
word64BE !ByteString
bs =
  let !b0 :: Word64
b0 = Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (HasCallStack => ByteString -> Int -> Word8
ByteString -> Int -> Word8
BS.index ByteString
bs Int
0) :: Word64
      !b1 :: Word64
b1 = Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (HasCallStack => ByteString -> Int -> Word8
ByteString -> Int -> Word8
BS.index ByteString
bs Int
1) :: Word64
      !b2 :: Word64
b2 = Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (HasCallStack => ByteString -> Int -> Word8
ByteString -> Int -> Word8
BS.index ByteString
bs Int
2) :: Word64
      !b3 :: Word64
b3 = Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (HasCallStack => ByteString -> Int -> Word8
ByteString -> Int -> Word8
BS.index ByteString
bs Int
3) :: Word64
      !b4 :: Word64
b4 = Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (HasCallStack => ByteString -> Int -> Word8
ByteString -> Int -> Word8
BS.index ByteString
bs Int
4) :: Word64
      !b5 :: Word64
b5 = Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (HasCallStack => ByteString -> Int -> Word8
ByteString -> Int -> Word8
BS.index ByteString
bs Int
5) :: Word64
      !b6 :: Word64
b6 = Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (HasCallStack => ByteString -> Int -> Word8
ByteString -> Int -> Word8
BS.index ByteString
bs Int
6) :: Word64
      !b7 :: Word64
b7 = Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (HasCallStack => ByteString -> Int -> Word8
ByteString -> Int -> Word8
BS.index ByteString
bs Int
7) :: Word64
  in  (Word64
b0 Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftL` Int
56) Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ (Word64
b1 Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftL` Int
48) Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ (Word64
b2 Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftL` Int
40) Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+
      (Word64
b3 Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftL` Int
32) Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ (Word64
b4 Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftL` Int
24) Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ (Word64
b5 Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftL` Int
16) Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+
      (Word64
b6 Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftL` Int
8) Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
b7
{-# INLINE word64BE #-}

-- | Encode Word64 as truncated unsigned (minimal bytes).
encodeWord64TU :: Word64 -> BS.ByteString
encodeWord64TU :: Word64 -> ByteString
encodeWord64TU !Word64
n
  | Word64
n Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
== Word64
0 = ByteString
BS.empty
  | Bool
otherwise = (Word8 -> Bool) -> ByteString -> ByteString
BS.dropWhile (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0) (Builder -> ByteString
toStrict (Word64 -> Builder
B.word64BE Word64
n))
{-# INLINE encodeWord64TU #-}

-- | Decode truncated unsigned to Word64.
decodeWord64TU :: BS.ByteString -> Maybe Word64
decodeWord64TU :: ByteString -> Maybe Word64
decodeWord64TU !ByteString
bs
  | ByteString -> Bool
BS.null ByteString
bs = Word64 -> Maybe Word64
forall a. a -> Maybe a
Just Word64
0
  | ByteString -> Int
BS.length ByteString
bs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
8 = Maybe Word64
forall a. Maybe a
Nothing
  | Bool -> Bool
not (ByteString -> Bool
BS.null ByteString
bs) Bool -> Bool -> Bool
&& HasCallStack => ByteString -> Int -> Word8
ByteString -> Int -> Word8
BS.index ByteString
bs Int
0 Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0 = Maybe Word64
forall a. Maybe a
Nothing  -- Non-canonical
  | Bool
otherwise = Word64 -> Maybe Word64
forall a. a -> Maybe a
Just (Word64 -> ByteString -> Word64
go Word64
0 ByteString
bs)
  where
    go :: Word64 -> BS.ByteString -> Word64
    go :: Word64 -> ByteString -> Word64
go !Word64
acc !ByteString
b = case ByteString -> Maybe (Word8, ByteString)
BS.uncons ByteString
b of
      Maybe (Word8, ByteString)
Nothing -> Word64
acc
      Just (Word8
x, ByteString
rest) -> Word64 -> ByteString -> Word64
go ((Word64
acc Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftL` Int
8) Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
x) ByteString
rest
{-# INLINE decodeWord64TU #-}

-- | Encode Word32 as truncated unsigned.
encodeWord32TU :: Word32 -> BS.ByteString
encodeWord32TU :: Word32 -> ByteString
encodeWord32TU !Word32
n
  | Word32
n Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
0 = ByteString
BS.empty
  | Bool
otherwise = (Word8 -> Bool) -> ByteString -> ByteString
BS.dropWhile (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0) (Builder -> ByteString
toStrict (Word32 -> Builder
B.word32BE Word32
n))
{-# INLINE encodeWord32TU #-}

-- | Decode truncated unsigned to Word32.
decodeWord32TU :: BS.ByteString -> Maybe Word32
decodeWord32TU :: ByteString -> Maybe Word32
decodeWord32TU !ByteString
bs
  | ByteString -> Bool
BS.null ByteString
bs = Word32 -> Maybe Word32
forall a. a -> Maybe a
Just Word32
0
  | ByteString -> Int
BS.length ByteString
bs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
4 = Maybe Word32
forall a. Maybe a
Nothing
  | Bool -> Bool
not (ByteString -> Bool
BS.null ByteString
bs) Bool -> Bool -> Bool
&& HasCallStack => ByteString -> Int -> Word8
ByteString -> Int -> Word8
BS.index ByteString
bs Int
0 Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0 = Maybe Word32
forall a. Maybe a
Nothing  -- Non-canonical
  | Bool
otherwise = Word32 -> Maybe Word32
forall a. a -> Maybe a
Just (Word32 -> ByteString -> Word32
go Word32
0 ByteString
bs)
  where
    go :: Word32 -> BS.ByteString -> Word32
    go :: Word32 -> ByteString -> Word32
go !Word32
acc !ByteString
b = case ByteString -> Maybe (Word8, ByteString)
BS.uncons ByteString
b of
      Maybe (Word8, ByteString)
Nothing -> Word32
acc
      Just (Word8
x, ByteString
rest) -> Word32 -> ByteString -> Word32
go ((Word32
acc Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftL` Int
8) Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Word8 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
x) ByteString
rest
{-# INLINE decodeWord32TU #-}

-- | Encode PaymentData.
encodePaymentData :: PaymentData -> BS.ByteString
encodePaymentData :: PaymentData -> ByteString
encodePaymentData (PaymentData !ByteString
secret !Word64
total) =
  ByteString
secret ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Word64 -> ByteString
encodeWord64TU Word64
total
{-# INLINE encodePaymentData #-}

-- | Decode PaymentData.
decodePaymentData :: BS.ByteString -> Maybe PaymentData
decodePaymentData :: ByteString -> Maybe PaymentData
decodePaymentData !ByteString
bs
  | ByteString -> Int
BS.length ByteString
bs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
32 = Maybe PaymentData
forall a. Maybe a
Nothing
  | Bool
otherwise = do
      let !secret :: ByteString
secret = Int -> ByteString -> ByteString
BS.take Int
32 ByteString
bs
          !rest :: ByteString
rest = Int -> ByteString -> ByteString
BS.drop Int
32 ByteString
bs
      total <- ByteString -> Maybe Word64
decodeWord64TU ByteString
rest
      Just (PaymentData secret total)
{-# INLINE decodePaymentData #-}