Prim.hs (24508B)
1 {-# OPTIONS_HADDOCK prune #-} 2 {-# LANGUAGE BangPatterns #-} 3 {-# LANGUAGE DeriveGeneric #-} 4 {-# LANGUAGE DerivingStrategies #-} 5 {-# LANGUAGE GeneralizedNewtypeDeriving #-} 6 7 -- | 8 -- Module: Lightning.Protocol.BOLT1.Prim 9 -- Copyright: (c) 2025 Jared Tobin 10 -- License: MIT 11 -- Maintainer: Jared Tobin <jared@ppad.tech> 12 -- 13 -- Primitive type encoding and decoding for BOLT #1. 14 15 module Lightning.Protocol.BOLT1.Prim ( 16 -- * Chain hash 17 ChainHash(..) 18 , chainHash 19 , unChainHash 20 21 -- * Channel identifier 22 , ChannelId(..) 23 , channelId 24 , unChannelId 25 , allChannels 26 27 -- * Signatures and keys 28 , Signature(..) 29 , signature 30 , unSignature 31 , Point(..) 32 , point 33 , unPoint 34 35 -- * Payment types 36 , PaymentHash(..) 37 , paymentHash 38 , unPaymentHash 39 , PaymentPreimage(..) 40 , paymentPreimage 41 , unPaymentPreimage 42 43 -- * Per-commitment secret 44 , PerCommitmentSecret(..) 45 , perCommitmentSecret 46 , unPerCommitmentSecret 47 48 -- * Short channel identifier 49 , ShortChannelId(..) 50 , shortChannelId 51 , scidWord64 52 , scidBlockHeight 53 , scidTxIndex 54 , scidOutputIndex 55 56 -- * Amounts 57 , Satoshi(..) 58 , MilliSatoshi(..) 59 , satToMsat 60 , msatToSat 61 62 -- * Unsigned integer encoding 63 , encodeU16 64 , encodeU32 65 , encodeU64 66 67 -- * Signed integer encoding 68 , encodeS8 69 , encodeS16 70 , encodeS32 71 , encodeS64 72 73 -- * Truncated unsigned integer encoding 74 , encodeTu16 75 , encodeTu32 76 , encodeTu64 77 78 -- * Minimal signed integer encoding 79 , encodeMinSigned 80 81 -- * BigSize encoding 82 , encodeBigSize 83 84 -- * Unsigned integer decoding 85 , decodeU16 86 , decodeU32 87 , decodeU64 88 89 -- * Signed integer decoding 90 , decodeS8 91 , decodeS16 92 , decodeS32 93 , decodeS64 94 95 -- * Truncated unsigned integer decoding 96 , decodeTu16 97 , decodeTu32 98 , decodeTu64 99 100 -- * Minimal signed integer decoding 101 , decodeMinSigned 102 103 -- * BigSize decoding 104 , decodeBigSize 105 106 -- * Internal helpers 107 , encodeLength 108 ) where 109 110 import Control.DeepSeq (NFData) 111 import Data.Bits (unsafeShiftL, unsafeShiftR, (.&.), (.|.)) 112 import qualified Data.ByteString as BS 113 import qualified Data.ByteString.Builder as BSB 114 import qualified Data.ByteString.Lazy as BSL 115 import Data.Int (Int8, Int16, Int32, Int64) 116 import Data.Word (Word16, Word32, Word64) 117 import GHC.Generics (Generic) 118 119 -- Chain hash ------------------------------------------------------------------ 120 121 -- | A chain hash (32-byte hash identifying a blockchain). 122 newtype ChainHash = ChainHash BS.ByteString 123 deriving stock (Eq, Ord, Show, Generic) 124 125 instance NFData ChainHash 126 127 -- | Construct a chain hash from a 32-byte bytestring. 128 -- 129 -- Returns 'Nothing' if the input is not exactly 32 bytes. 130 chainHash :: BS.ByteString -> Maybe ChainHash 131 chainHash bs 132 | BS.length bs == 32 = Just (ChainHash bs) 133 | otherwise = Nothing 134 {-# INLINE chainHash #-} 135 136 -- | Extract the raw bytes from a chain hash. 137 unChainHash :: ChainHash -> BS.ByteString 138 unChainHash (ChainHash bs) = bs 139 {-# INLINE unChainHash #-} 140 141 -- Channel identifier --------------------------------------------------------- 142 143 -- | A 32-byte channel identifier. 144 newtype ChannelId = ChannelId BS.ByteString 145 deriving stock (Eq, Ord, Show, Generic) 146 147 instance NFData ChannelId 148 149 -- | Construct a 'ChannelId' from a 32-byte 'BS.ByteString'. 150 -- 151 -- Returns 'Nothing' if the input is not exactly 32 bytes. 152 channelId :: BS.ByteString -> Maybe ChannelId 153 channelId bs 154 | BS.length bs == 32 = Just (ChannelId bs) 155 | otherwise = Nothing 156 {-# INLINE channelId #-} 157 158 -- | Extract the raw bytes from a 'ChannelId'. 159 unChannelId :: ChannelId -> BS.ByteString 160 unChannelId (ChannelId bs) = bs 161 {-# INLINE unChannelId #-} 162 163 -- | The all-zeros channel ID (connection-level errors). 164 allChannels :: ChannelId 165 allChannels = ChannelId (BS.replicate 32 0x00) 166 167 -- Signatures and keys -------------------------------------------------------- 168 169 -- | A 64-byte compact ECDSA signature. 170 newtype Signature = Signature BS.ByteString 171 deriving stock (Eq, Ord, Show, Generic) 172 173 instance NFData Signature 174 175 -- | Construct a 'Signature' from a 64-byte 'BS.ByteString'. 176 -- 177 -- Returns 'Nothing' if the input is not exactly 64 bytes. 178 signature :: BS.ByteString -> Maybe Signature 179 signature !bs 180 | BS.length bs == 64 = Just (Signature bs) 181 | otherwise = Nothing 182 {-# INLINE signature #-} 183 184 -- | Extract the raw bytes from a 'Signature'. 185 unSignature :: Signature -> BS.ByteString 186 unSignature (Signature bs) = bs 187 {-# INLINE unSignature #-} 188 189 -- | A 33-byte compressed secp256k1 public key. 190 newtype Point = Point BS.ByteString 191 deriving stock (Eq, Ord, Show, Generic) 192 193 instance NFData Point 194 195 -- | Construct a 'Point' from a 33-byte 'BS.ByteString'. 196 -- 197 -- Returns 'Nothing' if the input is not exactly 33 bytes. 198 point :: BS.ByteString -> Maybe Point 199 point !bs 200 | BS.length bs == 33 = Just (Point bs) 201 | otherwise = Nothing 202 {-# INLINE point #-} 203 204 -- | Extract the raw bytes from a 'Point'. 205 unPoint :: Point -> BS.ByteString 206 unPoint (Point bs) = bs 207 {-# INLINE unPoint #-} 208 209 -- Payment types -------------------------------------------------------------- 210 211 -- | A 32-byte SHA256 payment hash. 212 newtype PaymentHash = PaymentHash BS.ByteString 213 deriving stock (Eq, Ord, Show, Generic) 214 215 instance NFData PaymentHash 216 217 -- | Construct a 'PaymentHash' from a 32-byte 'BS.ByteString'. 218 -- 219 -- Returns 'Nothing' if the input is not exactly 32 bytes. 220 paymentHash :: BS.ByteString -> Maybe PaymentHash 221 paymentHash !bs 222 | BS.length bs == 32 = Just (PaymentHash bs) 223 | otherwise = Nothing 224 {-# INLINE paymentHash #-} 225 226 -- | Extract the raw bytes from a 'PaymentHash'. 227 unPaymentHash :: PaymentHash -> BS.ByteString 228 unPaymentHash (PaymentHash bs) = bs 229 {-# INLINE unPaymentHash #-} 230 231 -- | A 32-byte payment preimage. 232 newtype PaymentPreimage = PaymentPreimage BS.ByteString 233 deriving stock (Eq, Ord, Generic) 234 235 instance NFData PaymentPreimage 236 237 instance Show PaymentPreimage where 238 show _ = "PaymentPreimage <redacted>" 239 240 -- | Construct a 'PaymentPreimage' from a 32-byte 'BS.ByteString'. 241 -- 242 -- Returns 'Nothing' if the input is not exactly 32 bytes. 243 paymentPreimage :: BS.ByteString -> Maybe PaymentPreimage 244 paymentPreimage !bs 245 | BS.length bs == 32 = Just (PaymentPreimage bs) 246 | otherwise = Nothing 247 {-# INLINE paymentPreimage #-} 248 249 -- | Extract the raw bytes from a 'PaymentPreimage'. 250 unPaymentPreimage :: PaymentPreimage -> BS.ByteString 251 unPaymentPreimage (PaymentPreimage bs) = bs 252 {-# INLINE unPaymentPreimage #-} 253 254 -- Per-commitment secret ------------------------------------------------------ 255 256 -- | A 32-byte per-commitment secret. 257 newtype PerCommitmentSecret = PerCommitmentSecret BS.ByteString 258 deriving stock (Eq, Ord, Generic) 259 260 instance NFData PerCommitmentSecret 261 262 instance Show PerCommitmentSecret where 263 show _ = "PerCommitmentSecret <redacted>" 264 265 -- | Construct a 'PerCommitmentSecret' from a 32-byte 266 -- 'BS.ByteString'. 267 -- 268 -- Returns 'Nothing' if the input is not exactly 32 bytes. 269 perCommitmentSecret :: BS.ByteString -> Maybe PerCommitmentSecret 270 perCommitmentSecret !bs 271 | BS.length bs == 32 = Just (PerCommitmentSecret bs) 272 | otherwise = Nothing 273 {-# INLINE perCommitmentSecret #-} 274 275 -- | Extract the raw bytes from a 'PerCommitmentSecret'. 276 unPerCommitmentSecret :: PerCommitmentSecret -> BS.ByteString 277 unPerCommitmentSecret (PerCommitmentSecret bs) = bs 278 {-# INLINE unPerCommitmentSecret #-} 279 280 -- Short channel identifier --------------------------------------------------- 281 282 -- | A short channel identifier (8 bytes packed as 'Word64'). 283 -- 284 -- Encodes block height (3 bytes), transaction index (3 bytes), 285 -- and output index (2 bytes). 286 newtype ShortChannelId = ShortChannelId Word64 287 deriving stock (Eq, Ord, Show, Generic) 288 289 instance NFData ShortChannelId 290 291 -- | Construct a 'ShortChannelId' from components. 292 -- 293 -- Returns 'Nothing' if block height or tx index exceed 24 bits. 294 shortChannelId 295 :: Word32 -- ^ Block height (24 bits max) 296 -> Word32 -- ^ Transaction index (24 bits max) 297 -> Word16 -- ^ Output index 298 -> Maybe ShortChannelId 299 shortChannelId !blockHeight !txIndex !outputIndex 300 | blockHeight > 0xFFFFFF = Nothing 301 | txIndex > 0xFFFFFF = Nothing 302 | otherwise = Just $! ShortChannelId w 303 where 304 !w = (fromIntegral blockHeight `unsafeShiftL` 40) 305 .|. (fromIntegral txIndex `unsafeShiftL` 16) 306 .|. fromIntegral outputIndex 307 {-# INLINE shortChannelId #-} 308 309 -- | Extract the packed 'Word64' from a 'ShortChannelId'. 310 scidWord64 :: ShortChannelId -> Word64 311 scidWord64 (ShortChannelId w) = w 312 {-# INLINE scidWord64 #-} 313 314 -- | Extract the block height from a 'ShortChannelId'. 315 scidBlockHeight :: ShortChannelId -> Word32 316 scidBlockHeight (ShortChannelId !w) = 317 fromIntegral $! (w `unsafeShiftR` 40) .&. 0xFFFFFF 318 {-# INLINE scidBlockHeight #-} 319 320 -- | Extract the transaction index from a 'ShortChannelId'. 321 scidTxIndex :: ShortChannelId -> Word32 322 scidTxIndex (ShortChannelId !w) = 323 fromIntegral $! (w `unsafeShiftR` 16) .&. 0xFFFFFF 324 {-# INLINE scidTxIndex #-} 325 326 -- | Extract the output index from a 'ShortChannelId'. 327 scidOutputIndex :: ShortChannelId -> Word16 328 scidOutputIndex (ShortChannelId !w) = 329 fromIntegral $! w .&. 0xFFFF 330 {-# INLINE scidOutputIndex #-} 331 332 -- Amounts -------------------------------------------------------------------- 333 334 -- | Amount in satoshis. 335 newtype Satoshi = Satoshi { unSatoshi :: Word64 } 336 deriving stock (Eq, Ord, Show, Generic) 337 deriving newtype (NFData, Num, Enum, Real, Integral) 338 339 -- | Amount in millisatoshis. 340 newtype MilliSatoshi = MilliSatoshi 341 { unMilliSatoshi :: Word64 } 342 deriving stock (Eq, Ord, Show, Generic) 343 deriving newtype (NFData, Num, Enum, Real, Integral) 344 345 -- | Convert 'Satoshi' to 'MilliSatoshi'. 346 satToMsat :: Satoshi -> MilliSatoshi 347 satToMsat (Satoshi !s) = MilliSatoshi $! s * 1000 348 {-# INLINE satToMsat #-} 349 350 -- | Convert 'MilliSatoshi' to 'Satoshi' (rounds down). 351 msatToSat :: MilliSatoshi -> Satoshi 352 msatToSat (MilliSatoshi !m) = Satoshi $! m `div` 1000 353 {-# INLINE msatToSat #-} 354 355 -- Unsigned integer encoding --------------------------------------------------- 356 357 -- | Encode a 16-bit unsigned integer (big-endian). 358 -- 359 -- >>> encodeU16 0x0102 360 -- "\SOH\STX" 361 encodeU16 :: Word16 -> BS.ByteString 362 encodeU16 = BSL.toStrict . BSB.toLazyByteString . BSB.word16BE 363 {-# INLINE encodeU16 #-} 364 365 -- | Encode a 32-bit unsigned integer (big-endian). 366 -- 367 -- >>> encodeU32 0x01020304 368 -- "\SOH\STX\ETX\EOT" 369 encodeU32 :: Word32 -> BS.ByteString 370 encodeU32 = BSL.toStrict . BSB.toLazyByteString . BSB.word32BE 371 {-# INLINE encodeU32 #-} 372 373 -- | Encode a 64-bit unsigned integer (big-endian). 374 -- 375 -- >>> encodeU64 0x0102030405060708 376 -- "\SOH\STX\ETX\EOT\ENQ\ACK\a\b" 377 encodeU64 :: Word64 -> BS.ByteString 378 encodeU64 = BSL.toStrict . BSB.toLazyByteString . BSB.word64BE 379 {-# INLINE encodeU64 #-} 380 381 -- Signed integer encoding ----------------------------------------------------- 382 383 -- | Encode an 8-bit signed integer. 384 -- 385 -- >>> encodeS8 42 386 -- "*" 387 -- >>> encodeS8 (-42) 388 -- "\214" 389 encodeS8 :: Int8 -> BS.ByteString 390 encodeS8 = BS.singleton . fromIntegral 391 {-# INLINE encodeS8 #-} 392 393 -- | Encode a 16-bit signed integer (big-endian two's complement). 394 -- 395 -- >>> encodeS16 0x0102 396 -- "\SOH\STX" 397 -- >>> encodeS16 (-1) 398 -- "\255\255" 399 encodeS16 :: Int16 -> BS.ByteString 400 encodeS16 = BSL.toStrict . BSB.toLazyByteString . BSB.int16BE 401 {-# INLINE encodeS16 #-} 402 403 -- | Encode a 32-bit signed integer (big-endian two's complement). 404 -- 405 -- >>> encodeS32 0x01020304 406 -- "\SOH\STX\ETX\EOT" 407 -- >>> encodeS32 (-1) 408 -- "\255\255\255\255" 409 encodeS32 :: Int32 -> BS.ByteString 410 encodeS32 = BSL.toStrict . BSB.toLazyByteString . BSB.int32BE 411 {-# INLINE encodeS32 #-} 412 413 -- | Encode a 64-bit signed integer (big-endian two's complement). 414 -- 415 -- >>> encodeS64 0x0102030405060708 416 -- "\SOH\STX\ETX\EOT\ENQ\ACK\a\b" 417 -- >>> encodeS64 (-1) 418 -- "\255\255\255\255\255\255\255\255" 419 encodeS64 :: Int64 -> BS.ByteString 420 encodeS64 = BSL.toStrict . BSB.toLazyByteString . BSB.int64BE 421 {-# INLINE encodeS64 #-} 422 423 -- Truncated unsigned integer encoding ----------------------------------------- 424 425 -- | Encode a truncated 16-bit unsigned integer (0-2 bytes). 426 -- 427 -- Leading zeros are omitted per BOLT #1. Zero encodes to empty. 428 -- 429 -- >>> encodeTu16 0 430 -- "" 431 -- >>> encodeTu16 1 432 -- "\SOH" 433 -- >>> encodeTu16 256 434 -- "\SOH\NUL" 435 encodeTu16 :: Word16 -> BS.ByteString 436 encodeTu16 0 = BS.empty 437 encodeTu16 !x 438 | x < 0x100 = BS.singleton (fromIntegral x) 439 | otherwise = encodeU16 x 440 {-# INLINE encodeTu16 #-} 441 442 -- | Encode a truncated 32-bit unsigned integer (0-4 bytes). 443 -- 444 -- Leading zeros are omitted per BOLT #1. Zero encodes to empty. 445 -- 446 -- >>> encodeTu32 0 447 -- "" 448 -- >>> encodeTu32 1 449 -- "\SOH" 450 -- >>> encodeTu32 0x010000 451 -- "\SOH\NUL\NUL" 452 encodeTu32 :: Word32 -> BS.ByteString 453 encodeTu32 0 = BS.empty 454 encodeTu32 !x 455 | x < 0x100 = BS.singleton (fromIntegral x) 456 | x < 0x10000 = encodeU16 (fromIntegral x) 457 | x < 0x1000000 = BS.pack [ fromIntegral (x `unsafeShiftR` 16) 458 , fromIntegral (x `unsafeShiftR` 8) 459 , fromIntegral x 460 ] 461 | otherwise = encodeU32 x 462 {-# INLINE encodeTu32 #-} 463 464 -- | Encode a truncated 64-bit unsigned integer (0-8 bytes). 465 -- 466 -- Leading zeros are omitted per BOLT #1. Zero encodes to empty. 467 -- 468 -- >>> encodeTu64 0 469 -- "" 470 -- >>> encodeTu64 1 471 -- "\SOH" 472 -- >>> encodeTu64 0x0100000000 473 -- "\SOH\NUL\NUL\NUL\NUL" 474 encodeTu64 :: Word64 -> BS.ByteString 475 encodeTu64 0 = BS.empty 476 encodeTu64 !x 477 | x < 0x100 = BS.singleton (fromIntegral x) 478 | x < 0x10000 = encodeU16 (fromIntegral x) 479 | x < 0x1000000 = BS.pack [ fromIntegral (x `unsafeShiftR` 16) 480 , fromIntegral (x `unsafeShiftR` 8) 481 , fromIntegral x 482 ] 483 | x < 0x100000000 = encodeU32 (fromIntegral x) 484 | x < 0x10000000000 = BS.pack [ fromIntegral (x `unsafeShiftR` 32) 485 , fromIntegral (x `unsafeShiftR` 24) 486 , fromIntegral (x `unsafeShiftR` 16) 487 , fromIntegral (x `unsafeShiftR` 8) 488 , fromIntegral x 489 ] 490 | x < 0x1000000000000 = BS.pack [ fromIntegral (x `unsafeShiftR` 40) 491 , fromIntegral (x `unsafeShiftR` 32) 492 , fromIntegral (x `unsafeShiftR` 24) 493 , fromIntegral (x `unsafeShiftR` 16) 494 , fromIntegral (x `unsafeShiftR` 8) 495 , fromIntegral x 496 ] 497 | x < 0x100000000000000 = BS.pack [ fromIntegral (x `unsafeShiftR` 48) 498 , fromIntegral (x `unsafeShiftR` 40) 499 , fromIntegral (x `unsafeShiftR` 32) 500 , fromIntegral (x `unsafeShiftR` 24) 501 , fromIntegral (x `unsafeShiftR` 16) 502 , fromIntegral (x `unsafeShiftR` 8) 503 , fromIntegral x 504 ] 505 | otherwise = encodeU64 x 506 {-# INLINE encodeTu64 #-} 507 508 -- Minimal signed integer encoding --------------------------------------------- 509 510 -- | Encode a signed 64-bit integer using minimal bytes. 511 -- 512 -- Uses the smallest number of bytes that can represent the value 513 -- in two's complement. Per BOLT #1 Appendix D test vectors. 514 -- 515 -- >>> encodeMinSigned 0 516 -- "\NUL" 517 -- >>> encodeMinSigned 127 518 -- "\DEL" 519 -- >>> encodeMinSigned 128 520 -- "\NUL\128" 521 -- >>> encodeMinSigned (-1) 522 -- "\255" 523 -- >>> encodeMinSigned (-128) 524 -- "\128" 525 -- >>> encodeMinSigned (-129) 526 -- "\255\DEL" 527 encodeMinSigned :: Int64 -> BS.ByteString 528 encodeMinSigned !x 529 | x >= -128 && x <= 127 = 530 -- Fits in 1 byte 531 BS.singleton (fromIntegral x) 532 | x >= -32768 && x <= 32767 = 533 -- Fits in 2 bytes 534 encodeS16 (fromIntegral x) 535 | x >= -2147483648 && x <= 2147483647 = 536 -- Fits in 4 bytes 537 encodeS32 (fromIntegral x) 538 | otherwise = 539 -- Need 8 bytes 540 encodeS64 x 541 {-# INLINE encodeMinSigned #-} 542 543 -- BigSize encoding ------------------------------------------------------------ 544 545 -- | Encode a BigSize value (variable-length unsigned integer). 546 -- 547 -- >>> encodeBigSize 0 548 -- "\NUL" 549 -- >>> encodeBigSize 252 550 -- "\252" 551 -- >>> encodeBigSize 253 552 -- "\253\NUL\253" 553 -- >>> encodeBigSize 65536 554 -- "\254\NUL\SOH\NUL\NUL" 555 encodeBigSize :: Word64 -> BS.ByteString 556 encodeBigSize !x 557 | x < 0xfd = BS.singleton (fromIntegral x) 558 | x < 0x10000 = BS.cons 0xfd (encodeU16 (fromIntegral x)) 559 | x < 0x100000000 = BS.cons 0xfe (encodeU32 (fromIntegral x)) 560 | otherwise = BS.cons 0xff (encodeU64 x) 561 {-# INLINE encodeBigSize #-} 562 563 -- Length encoding ------------------------------------------------------------- 564 565 -- | Encode a length as u16, checking bounds. 566 -- 567 -- Returns Nothing if the length exceeds 65535. 568 encodeLength :: BS.ByteString -> Maybe BS.ByteString 569 encodeLength !bs 570 | BS.length bs > 65535 = Nothing 571 | otherwise = Just (encodeU16 (fromIntegral (BS.length bs))) 572 {-# INLINE encodeLength #-} 573 574 -- Unsigned integer decoding --------------------------------------------------- 575 576 -- | Decode a 16-bit unsigned integer (big-endian). 577 decodeU16 :: BS.ByteString -> Maybe (Word16, BS.ByteString) 578 decodeU16 !bs 579 | BS.length bs < 2 = Nothing 580 | otherwise = 581 let !b0 = fromIntegral (BS.index bs 0) 582 !b1 = fromIntegral (BS.index bs 1) 583 !val = (b0 `unsafeShiftL` 8) .|. b1 584 in Just (val, BS.drop 2 bs) 585 {-# INLINE decodeU16 #-} 586 587 -- | Decode a 32-bit unsigned integer (big-endian). 588 decodeU32 :: BS.ByteString -> Maybe (Word32, BS.ByteString) 589 decodeU32 !bs 590 | BS.length bs < 4 = Nothing 591 | otherwise = 592 let !b0 = fromIntegral (BS.index bs 0) 593 !b1 = fromIntegral (BS.index bs 1) 594 !b2 = fromIntegral (BS.index bs 2) 595 !b3 = fromIntegral (BS.index bs 3) 596 !val = (b0 `unsafeShiftL` 24) .|. (b1 `unsafeShiftL` 16) 597 .|. (b2 `unsafeShiftL` 8) .|. b3 598 in Just (val, BS.drop 4 bs) 599 {-# INLINE decodeU32 #-} 600 601 -- | Decode a 64-bit unsigned integer (big-endian). 602 decodeU64 :: BS.ByteString -> Maybe (Word64, BS.ByteString) 603 decodeU64 !bs 604 | BS.length bs < 8 = Nothing 605 | otherwise = 606 let !b0 = fromIntegral (BS.index bs 0) 607 !b1 = fromIntegral (BS.index bs 1) 608 !b2 = fromIntegral (BS.index bs 2) 609 !b3 = fromIntegral (BS.index bs 3) 610 !b4 = fromIntegral (BS.index bs 4) 611 !b5 = fromIntegral (BS.index bs 5) 612 !b6 = fromIntegral (BS.index bs 6) 613 !b7 = fromIntegral (BS.index bs 7) 614 !val = (b0 `unsafeShiftL` 56) .|. (b1 `unsafeShiftL` 48) 615 .|. (b2 `unsafeShiftL` 40) .|. (b3 `unsafeShiftL` 32) 616 .|. (b4 `unsafeShiftL` 24) .|. (b5 `unsafeShiftL` 16) 617 .|. (b6 `unsafeShiftL` 8) .|. b7 618 in Just (val, BS.drop 8 bs) 619 {-# INLINE decodeU64 #-} 620 621 -- Signed integer decoding ----------------------------------------------------- 622 623 -- | Decode an 8-bit signed integer. 624 decodeS8 :: BS.ByteString -> Maybe (Int8, BS.ByteString) 625 decodeS8 !bs 626 | BS.null bs = Nothing 627 | otherwise = Just (fromIntegral (BS.index bs 0), BS.drop 1 bs) 628 {-# INLINE decodeS8 #-} 629 630 -- | Decode a 16-bit signed integer (big-endian two's complement). 631 decodeS16 :: BS.ByteString -> Maybe (Int16, BS.ByteString) 632 decodeS16 !bs = do 633 (w, rest) <- decodeU16 bs 634 Just (fromIntegral w, rest) 635 {-# INLINE decodeS16 #-} 636 637 -- | Decode a 32-bit signed integer (big-endian two's complement). 638 decodeS32 :: BS.ByteString -> Maybe (Int32, BS.ByteString) 639 decodeS32 !bs = do 640 (w, rest) <- decodeU32 bs 641 Just (fromIntegral w, rest) 642 {-# INLINE decodeS32 #-} 643 644 -- | Decode a 64-bit signed integer (big-endian two's complement). 645 decodeS64 :: BS.ByteString -> Maybe (Int64, BS.ByteString) 646 decodeS64 !bs = do 647 (w, rest) <- decodeU64 bs 648 Just (fromIntegral w, rest) 649 {-# INLINE decodeS64 #-} 650 651 -- Truncated unsigned integer decoding ----------------------------------------- 652 653 -- | Decode a truncated 16-bit unsigned integer (0-2 bytes). 654 -- 655 -- Returns Nothing if the encoding is non-minimal (has leading zeros). 656 decodeTu16 :: Int -> BS.ByteString -> Maybe (Word16, BS.ByteString) 657 decodeTu16 !len !bs 658 | len < 0 || len > 2 = Nothing 659 | BS.length bs < len = Nothing 660 | len == 0 = Just (0, bs) 661 | otherwise = 662 let !bytes = BS.take len bs 663 !rest = BS.drop len bs 664 in if BS.index bytes 0 == 0 665 then Nothing -- non-minimal: leading zero 666 else Just (decodeBeWord16 bytes, rest) 667 where 668 decodeBeWord16 :: BS.ByteString -> Word16 669 decodeBeWord16 b = case BS.length b of 670 1 -> fromIntegral (BS.index b 0) 671 2 -> (fromIntegral (BS.index b 0) `unsafeShiftL` 8) 672 .|. fromIntegral (BS.index b 1) 673 _ -> 0 674 {-# INLINE decodeTu16 #-} 675 676 -- | Decode a truncated 32-bit unsigned integer (0-4 bytes). 677 -- 678 -- Returns Nothing if the encoding is non-minimal (has leading zeros). 679 decodeTu32 :: Int -> BS.ByteString -> Maybe (Word32, BS.ByteString) 680 decodeTu32 !len !bs 681 | len < 0 || len > 4 = Nothing 682 | BS.length bs < len = Nothing 683 | len == 0 = Just (0, bs) 684 | otherwise = 685 let !bytes = BS.take len bs 686 !rest = BS.drop len bs 687 in if BS.index bytes 0 == 0 688 then Nothing -- non-minimal: leading zero 689 else Just (decodeBeWord32 len bytes, rest) 690 where 691 decodeBeWord32 :: Int -> BS.ByteString -> Word32 692 decodeBeWord32 n b = go 0 0 693 where 694 go !acc !i 695 | i >= n = acc 696 | otherwise = go ((acc `unsafeShiftL` 8) 697 .|. fromIntegral (BS.index b i)) (i + 1) 698 {-# INLINE decodeTu32 #-} 699 700 -- | Decode a truncated 64-bit unsigned integer (0-8 bytes). 701 -- 702 -- Returns Nothing if the encoding is non-minimal (has leading zeros). 703 decodeTu64 :: Int -> BS.ByteString -> Maybe (Word64, BS.ByteString) 704 decodeTu64 !len !bs 705 | len < 0 || len > 8 = Nothing 706 | BS.length bs < len = Nothing 707 | len == 0 = Just (0, bs) 708 | otherwise = 709 let !bytes = BS.take len bs 710 !rest = BS.drop len bs 711 in if BS.index bytes 0 == 0 712 then Nothing -- non-minimal: leading zero 713 else Just (decodeBeWord64 len bytes, rest) 714 where 715 decodeBeWord64 :: Int -> BS.ByteString -> Word64 716 decodeBeWord64 n b = go 0 0 717 where 718 go !acc !i 719 | i >= n = acc 720 | otherwise = go ((acc `unsafeShiftL` 8) 721 .|. fromIntegral (BS.index b i)) (i + 1) 722 {-# INLINE decodeTu64 #-} 723 724 -- Minimal signed integer decoding --------------------------------------------- 725 726 -- | Decode a minimal signed integer (1, 2, 4, or 8 bytes). 727 -- 728 -- Validates that the encoding is minimal: the value could not be 729 -- represented in fewer bytes. Per BOLT #1 Appendix D test vectors. 730 decodeMinSigned :: Int -> BS.ByteString -> Maybe (Int64, BS.ByteString) 731 decodeMinSigned !len !bs 732 | BS.length bs < len = Nothing 733 | otherwise = case len of 734 1 -> do 735 (v, rest) <- decodeS8 bs 736 Just (fromIntegral v, rest) 737 2 -> do 738 (v, rest) <- decodeS16 bs 739 -- Must not fit in 1 byte 740 if v >= -128 && v <= 127 741 then Nothing 742 else Just (fromIntegral v, rest) 743 4 -> do 744 (v, rest) <- decodeS32 bs 745 -- Must not fit in 2 bytes 746 if v >= -32768 && v <= 32767 747 then Nothing 748 else Just (fromIntegral v, rest) 749 8 -> do 750 (v, rest) <- decodeS64 bs 751 -- Must not fit in 4 bytes 752 if v >= -2147483648 && v <= 2147483647 753 then Nothing 754 else Just (v, rest) 755 _ -> Nothing 756 {-# INLINE decodeMinSigned #-} 757 758 -- BigSize decoding ------------------------------------------------------------ 759 760 -- | Decode a BigSize value with minimality check. 761 decodeBigSize :: BS.ByteString -> Maybe (Word64, BS.ByteString) 762 decodeBigSize !bs 763 | BS.null bs = Nothing 764 | otherwise = case BS.index bs 0 of 765 0xff -> do 766 (val, rest) <- decodeU64 (BS.drop 1 bs) 767 -- Must be >= 0x100000000 for minimal encoding 768 if val >= 0x100000000 769 then Just (val, rest) 770 else Nothing 771 0xfe -> do 772 (val, rest) <- decodeU32 (BS.drop 1 bs) 773 -- Must be >= 0x10000 for minimal encoding 774 if val >= 0x10000 775 then Just (fromIntegral val, rest) 776 else Nothing 777 0xfd -> do 778 (val, rest) <- decodeU16 (BS.drop 1 bs) 779 -- Must be >= 0xfd for minimal encoding 780 if val >= 0xfd 781 then Just (fromIntegral val, rest) 782 else Nothing 783 b -> Just (fromIntegral b, BS.drop 1 bs)