Prim.hs (24357B)
1 {-# OPTIONS_HADDOCK hide #-} 2 {-# LANGUAGE BangPatterns #-} 3 {-# LANGUAGE DeriveGeneric #-} 4 5 -- | 6 -- Module: Lightning.Protocol.BOLT1.Prim 7 -- Copyright: (c) 2025 Jared Tobin 8 -- License: MIT 9 -- Maintainer: Jared Tobin <jared@ppad.tech> 10 -- 11 -- Fundamental types and primitive encodings for BOLT #1. 12 13 module Lightning.Protocol.BOLT1.Prim ( 14 -- * Fixed-size byte types 15 ChainHash 16 , chain_hash 17 , un_chain_hash 18 , ChannelId 19 , channel_id 20 , un_channel_id 21 , all_channels 22 , Signature 23 , signature 24 , un_signature 25 , Point 26 , point 27 , un_point 28 , PaymentHash 29 , payment_hash 30 , un_payment_hash 31 , PaymentPreimage 32 , payment_preimage 33 , un_payment_preimage 34 , PerCommitmentSecret 35 , per_commitment_secret 36 , un_per_commitment_secret 37 38 -- * Short channel identifiers 39 , ShortChannelId(..) 40 , short_channel_id 41 , scid_block_height 42 , scid_tx_index 43 , scid_output_index 44 45 -- * Amounts 46 , Satoshi 47 , satoshi 48 , un_satoshi 49 , max_satoshi 50 , MilliSatoshi 51 , milli_satoshi 52 , un_milli_satoshi 53 , max_milli_satoshi 54 , sat_to_msat 55 , msat_to_sat 56 , add_sat 57 , sub_sat 58 , add_msat 59 , sub_msat 60 61 -- * Unsigned integers 62 , encode_u16 63 , encode_u32 64 , encode_u64 65 , decode_u16 66 , decode_u32 67 , decode_u64 68 69 -- * Signed integers 70 , encode_s8 71 , encode_s16 72 , encode_s32 73 , encode_s64 74 , decode_s8 75 , decode_s16 76 , decode_s32 77 , decode_s64 78 79 -- * Truncated unsigned integers 80 , encode_tu16 81 , encode_tu32 82 , encode_tu64 83 , decode_tu16 84 , decode_tu32 85 , decode_tu64 86 87 -- * BigSize 88 , encode_bigsize 89 , decode_bigsize 90 , BigSizeError(..) 91 , decode_bigsize_detailed 92 93 -- * Length-prefixed bytes 94 , encode_u16_prefixed 95 , decode_u16_prefixed 96 97 -- * Fixed-size field codecs 98 , decode_chain_hash 99 , decode_channel_id 100 , decode_signature 101 , decode_point 102 , decode_payment_hash 103 , decode_payment_preimage 104 , decode_per_commitment_secret 105 , encode_short_channel_id 106 , decode_short_channel_id 107 , encode_satoshi 108 , decode_satoshi 109 , encode_milli_satoshi 110 , decode_milli_satoshi 111 ) where 112 113 import Control.DeepSeq (NFData(..)) 114 import Data.Bits ((.&.), (.|.), unsafeShiftL, unsafeShiftR, xor) 115 import qualified Data.ByteString as BS 116 import qualified Data.ByteString.Internal as BI 117 import qualified Data.ByteString.Unsafe as BU 118 import Data.Int (Int8, Int16, Int32, Int64) 119 import Data.Word (Word8, Word16, Word32, Word64) 120 import Foreign.Ptr (Ptr) 121 import Foreign.Storable (pokeByteOff) 122 import GHC.Generics (Generic) 123 124 fi :: (Integral a, Num b) => a -> b 125 fi = fromIntegral 126 {-# INLINE fi #-} 127 128 -- constant-time equality on equal-length bytestrings 129 ct_eq :: BS.ByteString -> BS.ByteString -> Bool 130 ct_eq a b 131 | BS.length a /= BS.length b = False 132 | otherwise = go 0 0 133 where 134 !n = BS.length a 135 go :: Word8 -> Int -> Bool 136 go !acc !i 137 | i == n = acc == 0 138 | otherwise = 139 go (acc .|. (BU.unsafeIndex a i `xor` BU.unsafeIndex b i)) 140 (i + 1) 141 142 -- take exactly n bytes from the front of the input 143 take_n :: Int -> BS.ByteString -> Maybe (BS.ByteString, BS.ByteString) 144 take_n !n !bs 145 | BS.length bs < n = Nothing 146 | otherwise = Just (BU.unsafeTake n bs, BU.unsafeDrop n bs) 147 {-# INLINE take_n #-} 148 149 -- fixed-size byte types ------------------------------------------------------ 150 151 -- | A 32-byte chain hash, identifying the chain a channel or message 152 -- belongs to. 153 newtype ChainHash = ChainHash BS.ByteString 154 deriving (Eq, Ord, Show, Generic) 155 156 instance NFData ChainHash 157 158 -- | Construct a 'ChainHash' from exactly 32 bytes. 159 -- 160 -- >>> fmap (BS.length . un_chain_hash) (chain_hash (BS.replicate 32 0)) 161 -- Just 32 162 -- >>> chain_hash "too short" 163 -- Nothing 164 chain_hash :: BS.ByteString -> Maybe ChainHash 165 chain_hash bs 166 | BS.length bs == 32 = Just (ChainHash bs) 167 | otherwise = Nothing 168 {-# INLINE chain_hash #-} 169 170 -- | The bytes of a 'ChainHash'. 171 un_chain_hash :: ChainHash -> BS.ByteString 172 un_chain_hash (ChainHash bs) = bs 173 {-# INLINE un_chain_hash #-} 174 175 -- | A 32-byte channel identifier. 176 newtype ChannelId = ChannelId BS.ByteString 177 deriving (Eq, Ord, Show, Generic) 178 179 instance NFData ChannelId 180 181 -- | Construct a 'ChannelId' from exactly 32 bytes. 182 -- 183 -- >>> fmap (BS.length . un_channel_id) (channel_id (BS.replicate 32 1)) 184 -- Just 32 185 channel_id :: BS.ByteString -> Maybe ChannelId 186 channel_id bs 187 | BS.length bs == 32 = Just (ChannelId bs) 188 | otherwise = Nothing 189 {-# INLINE channel_id #-} 190 191 -- | The bytes of a 'ChannelId'. 192 un_channel_id :: ChannelId -> BS.ByteString 193 un_channel_id (ChannelId bs) = bs 194 {-# INLINE un_channel_id #-} 195 196 -- | The all-zero channel identifier, which refers to all channels 197 -- (e.g. in connection-level @error@ and @warning@ messages). 198 all_channels :: ChannelId 199 all_channels = ChannelId (BS.replicate 32 0x00) 200 201 -- | A 64-byte compact ECDSA signature. 202 newtype Signature = Signature BS.ByteString 203 deriving (Eq, Ord, Show, Generic) 204 205 instance NFData Signature 206 207 -- | Construct a 'Signature' from exactly 64 bytes. 208 -- 209 -- >>> signature (BS.replicate 63 0x00) 210 -- Nothing 211 signature :: BS.ByteString -> Maybe Signature 212 signature bs 213 | BS.length bs == 64 = Just (Signature bs) 214 | otherwise = Nothing 215 {-# INLINE signature #-} 216 217 -- | The bytes of a 'Signature'. 218 un_signature :: Signature -> BS.ByteString 219 un_signature (Signature bs) = bs 220 {-# INLINE un_signature #-} 221 222 -- | A 33-byte compressed secp256k1 point. 223 newtype Point = Point BS.ByteString 224 deriving (Eq, Ord, Show, Generic) 225 226 instance NFData Point 227 228 -- | Construct a 'Point' from 33 bytes with a compressed-encoding 229 -- prefix (0x02 or 0x03). The curve equation is not checked; use 230 -- ppad-secp256k1 to parse the point if it must be on the curve. 231 -- 232 -- >>> point (BS.cons 0x04 (BS.replicate 32 0x01)) 233 -- Nothing 234 point :: BS.ByteString -> Maybe Point 235 point bs 236 | BS.length bs == 33 237 , let !h = BU.unsafeIndex bs 0 238 , h == 0x02 || h == 0x03 = Just (Point bs) 239 | otherwise = Nothing 240 {-# INLINE point #-} 241 242 -- | The bytes of a 'Point'. 243 un_point :: Point -> BS.ByteString 244 un_point (Point bs) = bs 245 {-# INLINE un_point #-} 246 247 -- | A 32-byte SHA256 payment hash. 248 newtype PaymentHash = PaymentHash BS.ByteString 249 deriving (Eq, Ord, Show, Generic) 250 251 instance NFData PaymentHash 252 253 -- | Construct a 'PaymentHash' from exactly 32 bytes. 254 payment_hash :: BS.ByteString -> Maybe PaymentHash 255 payment_hash bs 256 | BS.length bs == 32 = Just (PaymentHash bs) 257 | otherwise = Nothing 258 {-# INLINE payment_hash #-} 259 260 -- | The bytes of a 'PaymentHash'. 261 un_payment_hash :: PaymentHash -> BS.ByteString 262 un_payment_hash (PaymentHash bs) = bs 263 {-# INLINE un_payment_hash #-} 264 265 -- | A 32-byte payment preimage. 266 -- 267 -- This is secret material: its 'Show' instance is redacted and its 268 -- 'Eq' instance runs in constant time. 269 newtype PaymentPreimage = PaymentPreimage BS.ByteString 270 271 instance Eq PaymentPreimage where 272 PaymentPreimage a == PaymentPreimage b = ct_eq a b 273 274 instance Show PaymentPreimage where 275 showsPrec d _ = showParen (d > 10) $ 276 showString "PaymentPreimage <redacted>" 277 278 instance NFData PaymentPreimage where 279 rnf (PaymentPreimage bs) = rnf bs 280 281 -- | Construct a 'PaymentPreimage' from exactly 32 bytes. 282 payment_preimage :: BS.ByteString -> Maybe PaymentPreimage 283 payment_preimage bs 284 | BS.length bs == 32 = Just (PaymentPreimage bs) 285 | otherwise = Nothing 286 {-# INLINE payment_preimage #-} 287 288 -- | The bytes of a 'PaymentPreimage'. 289 un_payment_preimage :: PaymentPreimage -> BS.ByteString 290 un_payment_preimage (PaymentPreimage bs) = bs 291 {-# INLINE un_payment_preimage #-} 292 293 -- | A 32-byte per-commitment secret. 294 -- 295 -- This is secret material: its 'Show' instance is redacted and its 296 -- 'Eq' instance runs in constant time. 297 newtype PerCommitmentSecret = PerCommitmentSecret BS.ByteString 298 299 instance Eq PerCommitmentSecret where 300 PerCommitmentSecret a == PerCommitmentSecret b = ct_eq a b 301 302 instance Show PerCommitmentSecret where 303 showsPrec d _ = showParen (d > 10) $ 304 showString "PerCommitmentSecret <redacted>" 305 306 instance NFData PerCommitmentSecret where 307 rnf (PerCommitmentSecret bs) = rnf bs 308 309 -- | Construct a 'PerCommitmentSecret' from exactly 32 bytes. 310 per_commitment_secret :: BS.ByteString -> Maybe PerCommitmentSecret 311 per_commitment_secret bs 312 | BS.length bs == 32 = Just (PerCommitmentSecret bs) 313 | otherwise = Nothing 314 {-# INLINE per_commitment_secret #-} 315 316 -- | The bytes of a 'PerCommitmentSecret'. 317 un_per_commitment_secret :: PerCommitmentSecret -> BS.ByteString 318 un_per_commitment_secret (PerCommitmentSecret bs) = bs 319 {-# INLINE un_per_commitment_secret #-} 320 321 -- short channel identifiers -------------------------------------------------- 322 323 -- | A short channel identifier: block height (3 bytes), transaction 324 -- index (3 bytes) and output index (2 bytes), packed big-endian into 325 -- a 'Word64'. Every 'Word64' is a valid packing. 326 newtype ShortChannelId = ShortChannelId Word64 327 deriving (Eq, Ord, Show, Generic) 328 329 instance NFData ShortChannelId 330 331 -- | Construct a 'ShortChannelId' from its components. Fails if the 332 -- block height or transaction index exceed 24 bits. 333 -- 334 -- >>> short_channel_id 539268 845 1 335 -- Just (ShortChannelId 592931436542885889) 336 short_channel_id 337 :: Word32 -- ^ block height 338 -> Word32 -- ^ transaction index 339 -> Word16 -- ^ output index 340 -> Maybe ShortChannelId 341 short_channel_id h t o 342 | h > 0xFFFFFF = Nothing 343 | t > 0xFFFFFF = Nothing 344 | otherwise = Just $! ShortChannelId $! 345 (fi h `unsafeShiftL` 40) 346 .|. (fi t `unsafeShiftL` 16) 347 .|. fi o 348 {-# INLINE short_channel_id #-} 349 350 -- | The block height of a 'ShortChannelId'. 351 scid_block_height :: ShortChannelId -> Word32 352 scid_block_height (ShortChannelId w) = fi (w `unsafeShiftR` 40) 353 {-# INLINE scid_block_height #-} 354 355 -- | The transaction index of a 'ShortChannelId'. 356 scid_tx_index :: ShortChannelId -> Word32 357 scid_tx_index (ShortChannelId w) = fi ((w `unsafeShiftR` 16) .&. 0xFFFFFF) 358 {-# INLINE scid_tx_index #-} 359 360 -- | The output index of a 'ShortChannelId'. 361 scid_output_index :: ShortChannelId -> Word16 362 scid_output_index (ShortChannelId w) = fi (w .&. 0xFFFF) 363 {-# INLINE scid_output_index #-} 364 365 -- amounts -------------------------------------------------------------------- 366 367 -- | An amount in satoshis, at most 21 million BTC ('max_satoshi'). 368 newtype Satoshi = Satoshi Word64 369 deriving (Eq, Ord, Show, Generic) 370 371 instance NFData Satoshi 372 373 -- | An amount in millisatoshis, at most 21 million BTC 374 -- ('max_milli_satoshi'). 375 newtype MilliSatoshi = MilliSatoshi Word64 376 deriving (Eq, Ord, Show, Generic) 377 378 instance NFData MilliSatoshi 379 380 -- | 21 million BTC, in satoshis (0x000775f05a074000). 381 max_satoshi :: Satoshi 382 max_satoshi = Satoshi 0x000775f05a074000 383 384 -- | 21 million BTC, in millisatoshis (0x1d24b2dfac520000). 385 max_milli_satoshi :: MilliSatoshi 386 max_milli_satoshi = MilliSatoshi 0x1d24b2dfac520000 387 388 -- | Construct a 'Satoshi' amount, failing above 21 million BTC. 389 -- 390 -- >>> satoshi 1000 391 -- Just (Satoshi 1000) 392 -- >>> satoshi 0xffffffffffffffff 393 -- Nothing 394 satoshi :: Word64 -> Maybe Satoshi 395 satoshi w 396 | w <= 0x000775f05a074000 = Just (Satoshi w) 397 | otherwise = Nothing 398 {-# INLINE satoshi #-} 399 400 -- | The number of satoshis. 401 un_satoshi :: Satoshi -> Word64 402 un_satoshi (Satoshi w) = w 403 {-# INLINE un_satoshi #-} 404 405 -- | Construct a 'MilliSatoshi' amount, failing above 21 million BTC. 406 milli_satoshi :: Word64 -> Maybe MilliSatoshi 407 milli_satoshi w 408 | w <= 0x1d24b2dfac520000 = Just (MilliSatoshi w) 409 | otherwise = Nothing 410 {-# INLINE milli_satoshi #-} 411 412 -- | The number of millisatoshis. 413 un_milli_satoshi :: MilliSatoshi -> Word64 414 un_milli_satoshi (MilliSatoshi w) = w 415 {-# INLINE un_milli_satoshi #-} 416 417 -- | Convert satoshis to millisatoshis. Total, since the bounds 418 -- correspond. 419 -- 420 -- >>> fmap sat_to_msat (satoshi 5) 421 -- Just (MilliSatoshi 5000) 422 sat_to_msat :: Satoshi -> MilliSatoshi 423 sat_to_msat (Satoshi s) = MilliSatoshi (s * 1000) 424 {-# INLINE sat_to_msat #-} 425 426 -- | Convert millisatoshis to satoshis, rounding down. 427 msat_to_sat :: MilliSatoshi -> Satoshi 428 msat_to_sat (MilliSatoshi m) = Satoshi (m `quot` 1000) 429 {-# INLINE msat_to_sat #-} 430 431 -- | Add two amounts, failing above 21 million BTC. (Amounts are 432 -- bounded well below 2^63, so the sum can't wrap.) 433 add_sat :: Satoshi -> Satoshi -> Maybe Satoshi 434 add_sat (Satoshi a) (Satoshi b) = satoshi (a + b) 435 {-# INLINE add_sat #-} 436 437 -- | Subtract the second amount from the first, failing if the result 438 -- would be negative. 439 sub_sat :: Satoshi -> Satoshi -> Maybe Satoshi 440 sub_sat (Satoshi a) (Satoshi b) 441 | b > a = Nothing 442 | otherwise = Just (Satoshi (a - b)) 443 {-# INLINE sub_sat #-} 444 445 -- | Add two amounts, failing above 21 million BTC. 446 add_msat :: MilliSatoshi -> MilliSatoshi -> Maybe MilliSatoshi 447 add_msat (MilliSatoshi a) (MilliSatoshi b) = milli_satoshi (a + b) 448 {-# INLINE add_msat #-} 449 450 -- | Subtract the second amount from the first, failing if the result 451 -- would be negative. 452 sub_msat :: MilliSatoshi -> MilliSatoshi -> Maybe MilliSatoshi 453 sub_msat (MilliSatoshi a) (MilliSatoshi b) 454 | b > a = Nothing 455 | otherwise = Just (MilliSatoshi (a - b)) 456 {-# INLINE sub_msat #-} 457 458 -- unsigned integers ---------------------------------------------------------- 459 460 poke8 :: Ptr Word8 -> Int -> Word8 -> IO () 461 poke8 = pokeByteOff 462 {-# INLINE poke8 #-} 463 464 -- | Encode a 'Word16' as 2 big-endian bytes. 465 -- 466 -- >>> encode_u16 0x0102 467 -- "\SOH\STX" 468 encode_u16 :: Word16 -> BS.ByteString 469 encode_u16 w = BI.unsafeCreate 2 $ \p -> do 470 poke8 p 0 (fi (w `unsafeShiftR` 8)) 471 poke8 p 1 (fi w) 472 {-# INLINE encode_u16 #-} 473 474 -- | Encode a 'Word32' as 4 big-endian bytes. 475 encode_u32 :: Word32 -> BS.ByteString 476 encode_u32 w = BI.unsafeCreate 4 $ \p -> do 477 poke8 p 0 (fi (w `unsafeShiftR` 24)) 478 poke8 p 1 (fi (w `unsafeShiftR` 16)) 479 poke8 p 2 (fi (w `unsafeShiftR` 8)) 480 poke8 p 3 (fi w) 481 {-# INLINE encode_u32 #-} 482 483 -- | Encode a 'Word64' as 8 big-endian bytes. 484 encode_u64 :: Word64 -> BS.ByteString 485 encode_u64 w = BI.unsafeCreate 8 $ \p -> do 486 poke8 p 0 (fi (w `unsafeShiftR` 56)) 487 poke8 p 1 (fi (w `unsafeShiftR` 48)) 488 poke8 p 2 (fi (w `unsafeShiftR` 40)) 489 poke8 p 3 (fi (w `unsafeShiftR` 32)) 490 poke8 p 4 (fi (w `unsafeShiftR` 24)) 491 poke8 p 5 (fi (w `unsafeShiftR` 16)) 492 poke8 p 6 (fi (w `unsafeShiftR` 8)) 493 poke8 p 7 (fi w) 494 {-# INLINE encode_u64 #-} 495 496 -- big-endian word from the first n bytes (n <= 8, length checked) 497 be :: Int -> BS.ByteString -> Word64 498 be n bs = go 0 0 499 where 500 go !acc !i 501 | i == n = acc 502 | otherwise = 503 go ((acc `unsafeShiftL` 8) .|. fi (BU.unsafeIndex bs i)) (i + 1) 504 {-# INLINE be #-} 505 506 -- | Decode 2 big-endian bytes, returning the remaining input. 507 -- 508 -- >>> decode_u16 "\SOH\STXrest" 509 -- Just (258,"rest") 510 decode_u16 :: BS.ByteString -> Maybe (Word16, BS.ByteString) 511 decode_u16 bs 512 | BS.length bs < 2 = Nothing 513 | otherwise = Just (fi (be 2 bs), BU.unsafeDrop 2 bs) 514 {-# INLINE decode_u16 #-} 515 516 -- | Decode 4 big-endian bytes, returning the remaining input. 517 decode_u32 :: BS.ByteString -> Maybe (Word32, BS.ByteString) 518 decode_u32 bs 519 | BS.length bs < 4 = Nothing 520 | otherwise = Just (fi (be 4 bs), BU.unsafeDrop 4 bs) 521 {-# INLINE decode_u32 #-} 522 523 -- | Decode 8 big-endian bytes, returning the remaining input. 524 decode_u64 :: BS.ByteString -> Maybe (Word64, BS.ByteString) 525 decode_u64 bs 526 | BS.length bs < 8 = Nothing 527 | otherwise = Just (be 8 bs, BU.unsafeDrop 8 bs) 528 {-# INLINE decode_u64 #-} 529 530 -- signed integers ------------------------------------------------------------ 531 532 -- | Encode an 'Int8' as 1 byte (two's complement). 533 -- 534 -- >>> encode_s8 (-42) 535 -- "\214" 536 encode_s8 :: Int8 -> BS.ByteString 537 encode_s8 = BS.singleton . fi 538 {-# INLINE encode_s8 #-} 539 540 -- | Encode an 'Int16' as 2 big-endian bytes (two's complement). 541 encode_s16 :: Int16 -> BS.ByteString 542 encode_s16 = encode_u16 . fi 543 {-# INLINE encode_s16 #-} 544 545 -- | Encode an 'Int32' as 4 big-endian bytes (two's complement). 546 encode_s32 :: Int32 -> BS.ByteString 547 encode_s32 = encode_u32 . fi 548 {-# INLINE encode_s32 #-} 549 550 -- | Encode an 'Int64' as 8 big-endian bytes (two's complement). 551 encode_s64 :: Int64 -> BS.ByteString 552 encode_s64 = encode_u64 . fi 553 {-# INLINE encode_s64 #-} 554 555 -- | Decode 1 byte (two's complement), returning the remaining input. 556 decode_s8 :: BS.ByteString -> Maybe (Int8, BS.ByteString) 557 decode_s8 bs = case BS.uncons bs of 558 Just (h, t) -> Just (fi h, t) 559 Nothing -> Nothing 560 {-# INLINE decode_s8 #-} 561 562 -- | Decode 2 big-endian bytes (two's complement). 563 decode_s16 :: BS.ByteString -> Maybe (Int16, BS.ByteString) 564 decode_s16 bs = case decode_u16 bs of 565 Just (w, t) -> Just (fi w, t) 566 Nothing -> Nothing 567 {-# INLINE decode_s16 #-} 568 569 -- | Decode 4 big-endian bytes (two's complement). 570 decode_s32 :: BS.ByteString -> Maybe (Int32, BS.ByteString) 571 decode_s32 bs = case decode_u32 bs of 572 Just (w, t) -> Just (fi w, t) 573 Nothing -> Nothing 574 {-# INLINE decode_s32 #-} 575 576 -- | Decode 8 big-endian bytes (two's complement). 577 decode_s64 :: BS.ByteString -> Maybe (Int64, BS.ByteString) 578 decode_s64 bs = case decode_u64 bs of 579 Just (w, t) -> Just (fi w, t) 580 Nothing -> Nothing 581 {-# INLINE decode_s64 #-} 582 583 -- truncated unsigned integers ------------------------------------------------ 584 585 -- minimal big-endian encoding: no leading zero bytes (zero is empty) 586 encode_tu :: Word64 -> BS.ByteString 587 encode_tu w = BS.drop (lz 0) (encode_u64 w) 588 where 589 lz :: Int -> Int 590 lz !i 591 | i < 8 && (w `unsafeShiftR` (56 - 8 * i)) .&. 0xff == 0 = lz (i + 1) 592 | otherwise = i 593 594 decode_tu :: Int -> BS.ByteString -> Maybe Word64 595 decode_tu maxlen bs 596 | n > maxlen = Nothing 597 | n > 0 && BU.unsafeIndex bs 0 == 0 = Nothing 598 | otherwise = Just (be n bs) 599 where 600 !n = BS.length bs 601 602 -- | Encode a 'Word16' as a truncated integer (no leading zero bytes). 603 -- 604 -- >>> encode_tu16 0 605 -- "" 606 -- >>> encode_tu16 0x0100 607 -- "\SOH\NUL" 608 encode_tu16 :: Word16 -> BS.ByteString 609 encode_tu16 = encode_tu . fi 610 611 -- | Encode a 'Word32' as a truncated integer (no leading zero bytes). 612 encode_tu32 :: Word32 -> BS.ByteString 613 encode_tu32 = encode_tu . fi 614 615 -- | Encode a 'Word64' as a truncated integer (no leading zero bytes). 616 encode_tu64 :: Word64 -> BS.ByteString 617 encode_tu64 = encode_tu 618 619 -- | Decode a truncated 16-bit integer occupying the whole input. Fails 620 -- on more than 2 bytes or a non-minimal encoding. 621 -- 622 -- >>> decode_tu16 "\SOH\NUL" 623 -- Just 256 624 -- >>> decode_tu16 "\NUL\SOH" 625 -- Nothing 626 decode_tu16 :: BS.ByteString -> Maybe Word16 627 decode_tu16 = fmap fi . decode_tu 2 628 629 -- | Decode a truncated 32-bit integer occupying the whole input. Fails 630 -- on more than 4 bytes or a non-minimal encoding. 631 decode_tu32 :: BS.ByteString -> Maybe Word32 632 decode_tu32 = fmap fi . decode_tu 4 633 634 -- | Decode a truncated 64-bit integer occupying the whole input. Fails 635 -- on more than 8 bytes or a non-minimal encoding. 636 decode_tu64 :: BS.ByteString -> Maybe Word64 637 decode_tu64 = decode_tu 8 638 639 -- bigsize -------------------------------------------------------------------- 640 641 -- | Encode a 'Word64' in the minimal BigSize format. 642 -- 643 -- >>> encode_bigsize 252 644 -- "\252" 645 -- >>> encode_bigsize 253 646 -- "\253\NUL\253" 647 encode_bigsize :: Word64 -> BS.ByteString 648 encode_bigsize w 649 | w < 0xfd = BS.singleton (fi w) 650 | w <= 0xffff = BS.cons 0xfd (encode_u16 (fi w)) 651 | w <= 0xffffffff = BS.cons 0xfe (encode_u32 (fi w)) 652 | otherwise = BS.cons 0xff (encode_u64 w) 653 654 -- | Why a BigSize failed to decode. 655 data BigSizeError 656 = BigSizeTruncated -- ^ input ended early 657 | BigSizeNonMinimal -- ^ a shorter encoding exists 658 deriving (Eq, Show, Generic) 659 660 instance NFData BigSizeError 661 662 -- | Decode a BigSize, distinguishing truncation from non-minimal 663 -- encodings. 664 decode_bigsize_detailed 665 :: BS.ByteString -> Either BigSizeError (Word64, BS.ByteString) 666 decode_bigsize_detailed bs = case BS.uncons bs of 667 Nothing -> Left BigSizeTruncated 668 Just (h, t) -> case h of 669 0xfd -> wide 2 0xfd t 670 0xfe -> wide 4 0x10000 t 671 0xff -> wide 8 0x100000000 t 672 _ -> Right (fi h, t) 673 where 674 wide n lo t = case take_n n t of 675 Nothing -> Left BigSizeTruncated 676 Just (v, r) 677 | w < lo -> Left BigSizeNonMinimal 678 | otherwise -> Right (w, r) 679 where 680 !w = be n v 681 682 -- | Decode a minimally-encoded BigSize, returning the remaining input. 683 -- 684 -- >>> decode_bigsize "\253\NUL\253rest" 685 -- Just (253,"rest") 686 -- >>> decode_bigsize "\253\NUL\252" 687 -- Nothing 688 decode_bigsize :: BS.ByteString -> Maybe (Word64, BS.ByteString) 689 decode_bigsize bs = case decode_bigsize_detailed bs of 690 Right r -> Just r 691 Left _ -> Nothing 692 693 -- length-prefixed bytes ------------------------------------------------------ 694 695 -- | Prefix bytes with their length as a u16. Fails if the input 696 -- exceeds 65535 bytes. 697 -- 698 -- >>> encode_u16_prefixed "abc" 699 -- Just "\NUL\ETXabc" 700 encode_u16_prefixed :: BS.ByteString -> Maybe BS.ByteString 701 encode_u16_prefixed bs 702 | BS.length bs > 0xffff = Nothing 703 | otherwise = Just (encode_u16 (fi (BS.length bs)) <> bs) 704 705 -- | Decode u16-length-prefixed bytes, returning the remaining input. 706 -- 707 -- >>> decode_u16_prefixed "\NUL\ETXabcrest" 708 -- Just ("abc","rest") 709 decode_u16_prefixed 710 :: BS.ByteString -> Maybe (BS.ByteString, BS.ByteString) 711 decode_u16_prefixed bs = do 712 (n, rest) <- decode_u16 bs 713 take_n (fi n) rest 714 715 -- fixed-size field codecs ---------------------------------------------------- 716 717 -- | Decode a 32-byte 'ChainHash', returning the remaining input. 718 decode_chain_hash :: BS.ByteString -> Maybe (ChainHash, BS.ByteString) 719 decode_chain_hash bs = do 720 (h, r) <- take_n 32 bs 721 pure (ChainHash h, r) 722 723 -- | Decode a 32-byte 'ChannelId', returning the remaining input. 724 decode_channel_id :: BS.ByteString -> Maybe (ChannelId, BS.ByteString) 725 decode_channel_id bs = do 726 (h, r) <- take_n 32 bs 727 pure (ChannelId h, r) 728 729 -- | Decode a 64-byte 'Signature', returning the remaining input. 730 decode_signature :: BS.ByteString -> Maybe (Signature, BS.ByteString) 731 decode_signature bs = do 732 (h, r) <- take_n 64 bs 733 pure (Signature h, r) 734 735 -- | Decode a 33-byte 'Point', returning the remaining input. Fails if 736 -- the prefix byte is not 0x02 or 0x03. 737 decode_point :: BS.ByteString -> Maybe (Point, BS.ByteString) 738 decode_point bs = do 739 (h, r) <- take_n 33 bs 740 p <- point h 741 pure (p, r) 742 743 -- | Decode a 32-byte 'PaymentHash', returning the remaining input. 744 decode_payment_hash :: BS.ByteString -> Maybe (PaymentHash, BS.ByteString) 745 decode_payment_hash bs = do 746 (h, r) <- take_n 32 bs 747 pure (PaymentHash h, r) 748 749 -- | Decode a 32-byte 'PaymentPreimage', returning the remaining input. 750 decode_payment_preimage 751 :: BS.ByteString -> Maybe (PaymentPreimage, BS.ByteString) 752 decode_payment_preimage bs = do 753 (h, r) <- take_n 32 bs 754 pure (PaymentPreimage h, r) 755 756 -- | Decode a 32-byte 'PerCommitmentSecret', returning the remaining 757 -- input. 758 decode_per_commitment_secret 759 :: BS.ByteString -> Maybe (PerCommitmentSecret, BS.ByteString) 760 decode_per_commitment_secret bs = do 761 (h, r) <- take_n 32 bs 762 pure (PerCommitmentSecret h, r) 763 764 -- | Encode a 'ShortChannelId' as 8 big-endian bytes. 765 encode_short_channel_id :: ShortChannelId -> BS.ByteString 766 encode_short_channel_id (ShortChannelId w) = encode_u64 w 767 {-# INLINE encode_short_channel_id #-} 768 769 -- | Decode an 8-byte 'ShortChannelId', returning the remaining input. 770 decode_short_channel_id 771 :: BS.ByteString -> Maybe (ShortChannelId, BS.ByteString) 772 decode_short_channel_id bs = do 773 (w, r) <- decode_u64 bs 774 pure (ShortChannelId w, r) 775 {-# INLINE decode_short_channel_id #-} 776 777 -- | Encode a 'Satoshi' amount as a u64. 778 encode_satoshi :: Satoshi -> BS.ByteString 779 encode_satoshi (Satoshi w) = encode_u64 w 780 {-# INLINE encode_satoshi #-} 781 782 -- | Decode a u64 'Satoshi' amount, returning the remaining input. Fails 783 -- above 21 million BTC. 784 decode_satoshi :: BS.ByteString -> Maybe (Satoshi, BS.ByteString) 785 decode_satoshi bs = do 786 (w, r) <- decode_u64 bs 787 s <- satoshi w 788 pure (s, r) 789 {-# INLINE decode_satoshi #-} 790 791 -- | Encode a 'MilliSatoshi' amount as a u64. 792 encode_milli_satoshi :: MilliSatoshi -> BS.ByteString 793 encode_milli_satoshi (MilliSatoshi w) = encode_u64 w 794 {-# INLINE encode_milli_satoshi #-} 795 796 -- | Decode a u64 'MilliSatoshi' amount, returning the remaining input. 797 -- Fails above 21 million BTC. 798 decode_milli_satoshi 799 :: BS.ByteString -> Maybe (MilliSatoshi, BS.ByteString) 800 decode_milli_satoshi bs = do 801 (w, r) <- decode_u64 bs 802 m <- milli_satoshi w 803 pure (m, r) 804 {-# INLINE decode_milli_satoshi #-}