Prim.hs (16846B)
1 {-# OPTIONS_HADDOCK prune #-} 2 {-# LANGUAGE BangPatterns #-} 3 {-# LANGUAGE DeriveGeneric #-} 4 {-# LANGUAGE DerivingStrategies #-} 5 6 -- | 7 -- Module: Lightning.Protocol.BOLT1.Prim 8 -- Copyright: (c) 2025 Jared Tobin 9 -- License: MIT 10 -- Maintainer: Jared Tobin <jared@ppad.tech> 11 -- 12 -- Primitive type encoding and decoding for BOLT #1. 13 14 module Lightning.Protocol.BOLT1.Prim ( 15 -- * Chain hash 16 ChainHash 17 , chainHash 18 , unChainHash 19 20 -- * Unsigned integer encoding 21 , encodeU16 22 , encodeU32 23 , encodeU64 24 25 -- * Signed integer encoding 26 , encodeS8 27 , encodeS16 28 , encodeS32 29 , encodeS64 30 31 -- * Truncated unsigned integer encoding 32 , encodeTu16 33 , encodeTu32 34 , encodeTu64 35 36 -- * Minimal signed integer encoding 37 , encodeMinSigned 38 39 -- * BigSize encoding 40 , encodeBigSize 41 42 -- * Unsigned integer decoding 43 , decodeU16 44 , decodeU32 45 , decodeU64 46 47 -- * Signed integer decoding 48 , decodeS8 49 , decodeS16 50 , decodeS32 51 , decodeS64 52 53 -- * Truncated unsigned integer decoding 54 , decodeTu16 55 , decodeTu32 56 , decodeTu64 57 58 -- * Minimal signed integer decoding 59 , decodeMinSigned 60 61 -- * BigSize decoding 62 , decodeBigSize 63 64 -- * Internal helpers 65 , encodeLength 66 ) where 67 68 import Control.DeepSeq (NFData) 69 import Data.Bits (unsafeShiftL, unsafeShiftR, (.|.)) 70 import qualified Data.ByteString as BS 71 import qualified Data.ByteString.Builder as BSB 72 import qualified Data.ByteString.Lazy as BSL 73 import Data.Int (Int8, Int16, Int32, Int64) 74 import Data.Word (Word16, Word32, Word64) 75 import GHC.Generics (Generic) 76 77 -- Chain hash ------------------------------------------------------------------ 78 79 -- | A chain hash (32-byte hash identifying a blockchain). 80 newtype ChainHash = ChainHash BS.ByteString 81 deriving stock (Eq, Show, Generic) 82 83 instance NFData ChainHash 84 85 -- | Construct a chain hash from a 32-byte bytestring. 86 -- 87 -- Returns 'Nothing' if the input is not exactly 32 bytes. 88 chainHash :: BS.ByteString -> Maybe ChainHash 89 chainHash bs 90 | BS.length bs == 32 = Just (ChainHash bs) 91 | otherwise = Nothing 92 {-# INLINE chainHash #-} 93 94 -- | Extract the raw bytes from a chain hash. 95 unChainHash :: ChainHash -> BS.ByteString 96 unChainHash (ChainHash bs) = bs 97 {-# INLINE unChainHash #-} 98 99 -- Unsigned integer encoding --------------------------------------------------- 100 101 -- | Encode a 16-bit unsigned integer (big-endian). 102 -- 103 -- >>> encodeU16 0x0102 104 -- "\SOH\STX" 105 encodeU16 :: Word16 -> BS.ByteString 106 encodeU16 = BSL.toStrict . BSB.toLazyByteString . BSB.word16BE 107 {-# INLINE encodeU16 #-} 108 109 -- | Encode a 32-bit unsigned integer (big-endian). 110 -- 111 -- >>> encodeU32 0x01020304 112 -- "\SOH\STX\ETX\EOT" 113 encodeU32 :: Word32 -> BS.ByteString 114 encodeU32 = BSL.toStrict . BSB.toLazyByteString . BSB.word32BE 115 {-# INLINE encodeU32 #-} 116 117 -- | Encode a 64-bit unsigned integer (big-endian). 118 -- 119 -- >>> encodeU64 0x0102030405060708 120 -- "\SOH\STX\ETX\EOT\ENQ\ACK\a\b" 121 encodeU64 :: Word64 -> BS.ByteString 122 encodeU64 = BSL.toStrict . BSB.toLazyByteString . BSB.word64BE 123 {-# INLINE encodeU64 #-} 124 125 -- Signed integer encoding ----------------------------------------------------- 126 127 -- | Encode an 8-bit signed integer. 128 -- 129 -- >>> encodeS8 42 130 -- "*" 131 -- >>> encodeS8 (-42) 132 -- "\214" 133 encodeS8 :: Int8 -> BS.ByteString 134 encodeS8 = BS.singleton . fromIntegral 135 {-# INLINE encodeS8 #-} 136 137 -- | Encode a 16-bit signed integer (big-endian two's complement). 138 -- 139 -- >>> encodeS16 0x0102 140 -- "\SOH\STX" 141 -- >>> encodeS16 (-1) 142 -- "\255\255" 143 encodeS16 :: Int16 -> BS.ByteString 144 encodeS16 = BSL.toStrict . BSB.toLazyByteString . BSB.int16BE 145 {-# INLINE encodeS16 #-} 146 147 -- | Encode a 32-bit signed integer (big-endian two's complement). 148 -- 149 -- >>> encodeS32 0x01020304 150 -- "\SOH\STX\ETX\EOT" 151 -- >>> encodeS32 (-1) 152 -- "\255\255\255\255" 153 encodeS32 :: Int32 -> BS.ByteString 154 encodeS32 = BSL.toStrict . BSB.toLazyByteString . BSB.int32BE 155 {-# INLINE encodeS32 #-} 156 157 -- | Encode a 64-bit signed integer (big-endian two's complement). 158 -- 159 -- >>> encodeS64 0x0102030405060708 160 -- "\SOH\STX\ETX\EOT\ENQ\ACK\a\b" 161 -- >>> encodeS64 (-1) 162 -- "\255\255\255\255\255\255\255\255" 163 encodeS64 :: Int64 -> BS.ByteString 164 encodeS64 = BSL.toStrict . BSB.toLazyByteString . BSB.int64BE 165 {-# INLINE encodeS64 #-} 166 167 -- Truncated unsigned integer encoding ----------------------------------------- 168 169 -- | Encode a truncated 16-bit unsigned integer (0-2 bytes). 170 -- 171 -- Leading zeros are omitted per BOLT #1. Zero encodes to empty. 172 -- 173 -- >>> encodeTu16 0 174 -- "" 175 -- >>> encodeTu16 1 176 -- "\SOH" 177 -- >>> encodeTu16 256 178 -- "\SOH\NUL" 179 encodeTu16 :: Word16 -> BS.ByteString 180 encodeTu16 0 = BS.empty 181 encodeTu16 !x 182 | x < 0x100 = BS.singleton (fromIntegral x) 183 | otherwise = encodeU16 x 184 {-# INLINE encodeTu16 #-} 185 186 -- | Encode a truncated 32-bit unsigned integer (0-4 bytes). 187 -- 188 -- Leading zeros are omitted per BOLT #1. Zero encodes to empty. 189 -- 190 -- >>> encodeTu32 0 191 -- "" 192 -- >>> encodeTu32 1 193 -- "\SOH" 194 -- >>> encodeTu32 0x010000 195 -- "\SOH\NUL\NUL" 196 encodeTu32 :: Word32 -> BS.ByteString 197 encodeTu32 0 = BS.empty 198 encodeTu32 !x 199 | x < 0x100 = BS.singleton (fromIntegral x) 200 | x < 0x10000 = encodeU16 (fromIntegral x) 201 | x < 0x1000000 = BS.pack [ fromIntegral (x `unsafeShiftR` 16) 202 , fromIntegral (x `unsafeShiftR` 8) 203 , fromIntegral x 204 ] 205 | otherwise = encodeU32 x 206 {-# INLINE encodeTu32 #-} 207 208 -- | Encode a truncated 64-bit unsigned integer (0-8 bytes). 209 -- 210 -- Leading zeros are omitted per BOLT #1. Zero encodes to empty. 211 -- 212 -- >>> encodeTu64 0 213 -- "" 214 -- >>> encodeTu64 1 215 -- "\SOH" 216 -- >>> encodeTu64 0x0100000000 217 -- "\SOH\NUL\NUL\NUL\NUL" 218 encodeTu64 :: Word64 -> BS.ByteString 219 encodeTu64 0 = BS.empty 220 encodeTu64 !x 221 | x < 0x100 = BS.singleton (fromIntegral x) 222 | x < 0x10000 = encodeU16 (fromIntegral x) 223 | x < 0x1000000 = BS.pack [ fromIntegral (x `unsafeShiftR` 16) 224 , fromIntegral (x `unsafeShiftR` 8) 225 , fromIntegral x 226 ] 227 | x < 0x100000000 = encodeU32 (fromIntegral x) 228 | x < 0x10000000000 = BS.pack [ fromIntegral (x `unsafeShiftR` 32) 229 , fromIntegral (x `unsafeShiftR` 24) 230 , fromIntegral (x `unsafeShiftR` 16) 231 , fromIntegral (x `unsafeShiftR` 8) 232 , fromIntegral x 233 ] 234 | x < 0x1000000000000 = BS.pack [ fromIntegral (x `unsafeShiftR` 40) 235 , fromIntegral (x `unsafeShiftR` 32) 236 , fromIntegral (x `unsafeShiftR` 24) 237 , fromIntegral (x `unsafeShiftR` 16) 238 , fromIntegral (x `unsafeShiftR` 8) 239 , fromIntegral x 240 ] 241 | x < 0x100000000000000 = BS.pack [ fromIntegral (x `unsafeShiftR` 48) 242 , fromIntegral (x `unsafeShiftR` 40) 243 , fromIntegral (x `unsafeShiftR` 32) 244 , fromIntegral (x `unsafeShiftR` 24) 245 , fromIntegral (x `unsafeShiftR` 16) 246 , fromIntegral (x `unsafeShiftR` 8) 247 , fromIntegral x 248 ] 249 | otherwise = encodeU64 x 250 {-# INLINE encodeTu64 #-} 251 252 -- Minimal signed integer encoding --------------------------------------------- 253 254 -- | Encode a signed 64-bit integer using minimal bytes. 255 -- 256 -- Uses the smallest number of bytes that can represent the value 257 -- in two's complement. Per BOLT #1 Appendix D test vectors. 258 -- 259 -- >>> encodeMinSigned 0 260 -- "\NUL" 261 -- >>> encodeMinSigned 127 262 -- "\DEL" 263 -- >>> encodeMinSigned 128 264 -- "\NUL\128" 265 -- >>> encodeMinSigned (-1) 266 -- "\255" 267 -- >>> encodeMinSigned (-128) 268 -- "\128" 269 -- >>> encodeMinSigned (-129) 270 -- "\255\DEL" 271 encodeMinSigned :: Int64 -> BS.ByteString 272 encodeMinSigned !x 273 | x >= -128 && x <= 127 = 274 -- Fits in 1 byte 275 BS.singleton (fromIntegral x) 276 | x >= -32768 && x <= 32767 = 277 -- Fits in 2 bytes 278 encodeS16 (fromIntegral x) 279 | x >= -2147483648 && x <= 2147483647 = 280 -- Fits in 4 bytes 281 encodeS32 (fromIntegral x) 282 | otherwise = 283 -- Need 8 bytes 284 encodeS64 x 285 {-# INLINE encodeMinSigned #-} 286 287 -- BigSize encoding ------------------------------------------------------------ 288 289 -- | Encode a BigSize value (variable-length unsigned integer). 290 -- 291 -- >>> encodeBigSize 0 292 -- "\NUL" 293 -- >>> encodeBigSize 252 294 -- "\252" 295 -- >>> encodeBigSize 253 296 -- "\253\NUL\253" 297 -- >>> encodeBigSize 65536 298 -- "\254\NUL\SOH\NUL\NUL" 299 encodeBigSize :: Word64 -> BS.ByteString 300 encodeBigSize !x 301 | x < 0xfd = BS.singleton (fromIntegral x) 302 | x < 0x10000 = BS.cons 0xfd (encodeU16 (fromIntegral x)) 303 | x < 0x100000000 = BS.cons 0xfe (encodeU32 (fromIntegral x)) 304 | otherwise = BS.cons 0xff (encodeU64 x) 305 {-# INLINE encodeBigSize #-} 306 307 -- Length encoding ------------------------------------------------------------- 308 309 -- | Encode a length as u16, checking bounds. 310 -- 311 -- Returns Nothing if the length exceeds 65535. 312 encodeLength :: BS.ByteString -> Maybe BS.ByteString 313 encodeLength !bs 314 | BS.length bs > 65535 = Nothing 315 | otherwise = Just (encodeU16 (fromIntegral (BS.length bs))) 316 {-# INLINE encodeLength #-} 317 318 -- Unsigned integer decoding --------------------------------------------------- 319 320 -- | Decode a 16-bit unsigned integer (big-endian). 321 decodeU16 :: BS.ByteString -> Maybe (Word16, BS.ByteString) 322 decodeU16 !bs 323 | BS.length bs < 2 = Nothing 324 | otherwise = 325 let !b0 = fromIntegral (BS.index bs 0) 326 !b1 = fromIntegral (BS.index bs 1) 327 !val = (b0 `unsafeShiftL` 8) .|. b1 328 in Just (val, BS.drop 2 bs) 329 {-# INLINE decodeU16 #-} 330 331 -- | Decode a 32-bit unsigned integer (big-endian). 332 decodeU32 :: BS.ByteString -> Maybe (Word32, BS.ByteString) 333 decodeU32 !bs 334 | BS.length bs < 4 = Nothing 335 | otherwise = 336 let !b0 = fromIntegral (BS.index bs 0) 337 !b1 = fromIntegral (BS.index bs 1) 338 !b2 = fromIntegral (BS.index bs 2) 339 !b3 = fromIntegral (BS.index bs 3) 340 !val = (b0 `unsafeShiftL` 24) .|. (b1 `unsafeShiftL` 16) 341 .|. (b2 `unsafeShiftL` 8) .|. b3 342 in Just (val, BS.drop 4 bs) 343 {-# INLINE decodeU32 #-} 344 345 -- | Decode a 64-bit unsigned integer (big-endian). 346 decodeU64 :: BS.ByteString -> Maybe (Word64, BS.ByteString) 347 decodeU64 !bs 348 | BS.length bs < 8 = Nothing 349 | otherwise = 350 let !b0 = fromIntegral (BS.index bs 0) 351 !b1 = fromIntegral (BS.index bs 1) 352 !b2 = fromIntegral (BS.index bs 2) 353 !b3 = fromIntegral (BS.index bs 3) 354 !b4 = fromIntegral (BS.index bs 4) 355 !b5 = fromIntegral (BS.index bs 5) 356 !b6 = fromIntegral (BS.index bs 6) 357 !b7 = fromIntegral (BS.index bs 7) 358 !val = (b0 `unsafeShiftL` 56) .|. (b1 `unsafeShiftL` 48) 359 .|. (b2 `unsafeShiftL` 40) .|. (b3 `unsafeShiftL` 32) 360 .|. (b4 `unsafeShiftL` 24) .|. (b5 `unsafeShiftL` 16) 361 .|. (b6 `unsafeShiftL` 8) .|. b7 362 in Just (val, BS.drop 8 bs) 363 {-# INLINE decodeU64 #-} 364 365 -- Signed integer decoding ----------------------------------------------------- 366 367 -- | Decode an 8-bit signed integer. 368 decodeS8 :: BS.ByteString -> Maybe (Int8, BS.ByteString) 369 decodeS8 !bs 370 | BS.null bs = Nothing 371 | otherwise = Just (fromIntegral (BS.index bs 0), BS.drop 1 bs) 372 {-# INLINE decodeS8 #-} 373 374 -- | Decode a 16-bit signed integer (big-endian two's complement). 375 decodeS16 :: BS.ByteString -> Maybe (Int16, BS.ByteString) 376 decodeS16 !bs = do 377 (w, rest) <- decodeU16 bs 378 Just (fromIntegral w, rest) 379 {-# INLINE decodeS16 #-} 380 381 -- | Decode a 32-bit signed integer (big-endian two's complement). 382 decodeS32 :: BS.ByteString -> Maybe (Int32, BS.ByteString) 383 decodeS32 !bs = do 384 (w, rest) <- decodeU32 bs 385 Just (fromIntegral w, rest) 386 {-# INLINE decodeS32 #-} 387 388 -- | Decode a 64-bit signed integer (big-endian two's complement). 389 decodeS64 :: BS.ByteString -> Maybe (Int64, BS.ByteString) 390 decodeS64 !bs = do 391 (w, rest) <- decodeU64 bs 392 Just (fromIntegral w, rest) 393 {-# INLINE decodeS64 #-} 394 395 -- Truncated unsigned integer decoding ----------------------------------------- 396 397 -- | Decode a truncated 16-bit unsigned integer (0-2 bytes). 398 -- 399 -- Returns Nothing if the encoding is non-minimal (has leading zeros). 400 decodeTu16 :: Int -> BS.ByteString -> Maybe (Word16, BS.ByteString) 401 decodeTu16 !len !bs 402 | len < 0 || len > 2 = Nothing 403 | BS.length bs < len = Nothing 404 | len == 0 = Just (0, bs) 405 | otherwise = 406 let !bytes = BS.take len bs 407 !rest = BS.drop len bs 408 in if BS.index bytes 0 == 0 409 then Nothing -- non-minimal: leading zero 410 else Just (decodeBeWord16 bytes, rest) 411 where 412 decodeBeWord16 :: BS.ByteString -> Word16 413 decodeBeWord16 b = case BS.length b of 414 1 -> fromIntegral (BS.index b 0) 415 2 -> (fromIntegral (BS.index b 0) `unsafeShiftL` 8) 416 .|. fromIntegral (BS.index b 1) 417 _ -> 0 418 {-# INLINE decodeTu16 #-} 419 420 -- | Decode a truncated 32-bit unsigned integer (0-4 bytes). 421 -- 422 -- Returns Nothing if the encoding is non-minimal (has leading zeros). 423 decodeTu32 :: Int -> BS.ByteString -> Maybe (Word32, BS.ByteString) 424 decodeTu32 !len !bs 425 | len < 0 || len > 4 = Nothing 426 | BS.length bs < len = Nothing 427 | len == 0 = Just (0, bs) 428 | otherwise = 429 let !bytes = BS.take len bs 430 !rest = BS.drop len bs 431 in if BS.index bytes 0 == 0 432 then Nothing -- non-minimal: leading zero 433 else Just (decodeBeWord32 len bytes, rest) 434 where 435 decodeBeWord32 :: Int -> BS.ByteString -> Word32 436 decodeBeWord32 n b = go 0 0 437 where 438 go !acc !i 439 | i >= n = acc 440 | otherwise = go ((acc `unsafeShiftL` 8) 441 .|. fromIntegral (BS.index b i)) (i + 1) 442 {-# INLINE decodeTu32 #-} 443 444 -- | Decode a truncated 64-bit unsigned integer (0-8 bytes). 445 -- 446 -- Returns Nothing if the encoding is non-minimal (has leading zeros). 447 decodeTu64 :: Int -> BS.ByteString -> Maybe (Word64, BS.ByteString) 448 decodeTu64 !len !bs 449 | len < 0 || len > 8 = Nothing 450 | BS.length bs < len = Nothing 451 | len == 0 = Just (0, bs) 452 | otherwise = 453 let !bytes = BS.take len bs 454 !rest = BS.drop len bs 455 in if BS.index bytes 0 == 0 456 then Nothing -- non-minimal: leading zero 457 else Just (decodeBeWord64 len bytes, rest) 458 where 459 decodeBeWord64 :: Int -> BS.ByteString -> Word64 460 decodeBeWord64 n b = go 0 0 461 where 462 go !acc !i 463 | i >= n = acc 464 | otherwise = go ((acc `unsafeShiftL` 8) 465 .|. fromIntegral (BS.index b i)) (i + 1) 466 {-# INLINE decodeTu64 #-} 467 468 -- Minimal signed integer decoding --------------------------------------------- 469 470 -- | Decode a minimal signed integer (1, 2, 4, or 8 bytes). 471 -- 472 -- Validates that the encoding is minimal: the value could not be 473 -- represented in fewer bytes. Per BOLT #1 Appendix D test vectors. 474 decodeMinSigned :: Int -> BS.ByteString -> Maybe (Int64, BS.ByteString) 475 decodeMinSigned !len !bs 476 | BS.length bs < len = Nothing 477 | otherwise = case len of 478 1 -> do 479 (v, rest) <- decodeS8 bs 480 Just (fromIntegral v, rest) 481 2 -> do 482 (v, rest) <- decodeS16 bs 483 -- Must not fit in 1 byte 484 if v >= -128 && v <= 127 485 then Nothing 486 else Just (fromIntegral v, rest) 487 4 -> do 488 (v, rest) <- decodeS32 bs 489 -- Must not fit in 2 bytes 490 if v >= -32768 && v <= 32767 491 then Nothing 492 else Just (fromIntegral v, rest) 493 8 -> do 494 (v, rest) <- decodeS64 bs 495 -- Must not fit in 4 bytes 496 if v >= -2147483648 && v <= 2147483647 497 then Nothing 498 else Just (v, rest) 499 _ -> Nothing 500 {-# INLINE decodeMinSigned #-} 501 502 -- BigSize decoding ------------------------------------------------------------ 503 504 -- | Decode a BigSize value with minimality check. 505 decodeBigSize :: BS.ByteString -> Maybe (Word64, BS.ByteString) 506 decodeBigSize !bs 507 | BS.null bs = Nothing 508 | otherwise = case BS.index bs 0 of 509 0xff -> do 510 (val, rest) <- decodeU64 (BS.drop 1 bs) 511 -- Must be >= 0x100000000 for minimal encoding 512 if val >= 0x100000000 513 then Just (val, rest) 514 else Nothing 515 0xfe -> do 516 (val, rest) <- decodeU32 (BS.drop 1 bs) 517 -- Must be >= 0x10000 for minimal encoding 518 if val >= 0x10000 519 then Just (fromIntegral val, rest) 520 else Nothing 521 0xfd -> do 522 (val, rest) <- decodeU16 (BS.drop 1 bs) 523 -- Must be >= 0xfd for minimal encoding 524 if val >= 0xfd 525 then Just (fromIntegral val, rest) 526 else Nothing 527 b -> Just (fromIntegral b, BS.drop 1 bs)