Codec.hs (49445B)
1 {-# OPTIONS_HADDOCK prune #-} 2 {-# LANGUAGE BangPatterns #-} 3 {-# LANGUAGE DeriveGeneric #-} 4 {-# LANGUAGE DerivingStrategies #-} 5 6 -- | 7 -- Module: Lightning.Protocol.BOLT2.Codec 8 -- Copyright: (c) 2025 Jared Tobin 9 -- License: MIT 10 -- Maintainer: Jared Tobin <jared@ppad.tech> 11 -- 12 -- Encode/decode functions for BOLT #2 messages. 13 14 module Lightning.Protocol.BOLT2.Codec ( 15 -- * Error types 16 EncodeError(..) 17 , DecodeError(..) 18 19 -- * Channel establishment v1 20 , encodeOpenChannel 21 , decodeOpenChannel 22 , encodeAcceptChannel 23 , decodeAcceptChannel 24 , encodeFundingCreated 25 , decodeFundingCreated 26 , encodeFundingSigned 27 , decodeFundingSigned 28 , encodeChannelReady 29 , decodeChannelReady 30 31 -- * Channel establishment v2 (interactive-tx) 32 , encodeOpenChannel2 33 , decodeOpenChannel2 34 , encodeAcceptChannel2 35 , decodeAcceptChannel2 36 , encodeTxAddInput 37 , decodeTxAddInput 38 , encodeTxAddOutput 39 , decodeTxAddOutput 40 , encodeTxRemoveInput 41 , decodeTxRemoveInput 42 , encodeTxRemoveOutput 43 , decodeTxRemoveOutput 44 , encodeTxComplete 45 , decodeTxComplete 46 , encodeTxSignatures 47 , decodeTxSignatures 48 , encodeTxInitRbf 49 , decodeTxInitRbf 50 , encodeTxAckRbf 51 , decodeTxAckRbf 52 , encodeTxAbort 53 , decodeTxAbort 54 55 -- * Channel close 56 , encodeStfu 57 , decodeStfu 58 , encodeShutdown 59 , decodeShutdown 60 , encodeClosingSigned 61 , decodeClosingSigned 62 , encodeClosingComplete 63 , decodeClosingComplete 64 , encodeClosingSig 65 , decodeClosingSig 66 67 -- * Normal operation 68 , encodeUpdateAddHtlc 69 , decodeUpdateAddHtlc 70 , encodeUpdateFulfillHtlc 71 , decodeUpdateFulfillHtlc 72 , encodeUpdateFailHtlc 73 , decodeUpdateFailHtlc 74 , encodeUpdateFailMalformedHtlc 75 , decodeUpdateFailMalformedHtlc 76 , encodeCommitmentSigned 77 , decodeCommitmentSigned 78 , encodeRevokeAndAck 79 , decodeRevokeAndAck 80 , encodeUpdateFee 81 , decodeUpdateFee 82 83 -- * Channel reestablishment 84 , encodeChannelReestablish 85 , decodeChannelReestablish 86 ) where 87 88 import Control.DeepSeq (NFData) 89 import Control.Monad (unless) 90 import qualified Data.ByteString as BS 91 import Data.Word (Word8, Word16, Word32) 92 import GHC.Generics (Generic) 93 import Lightning.Protocol.BOLT1 94 ( TlvStream 95 , unsafeTlvStream 96 , TlvError 97 , encodeU16 98 , encodeU32 99 , encodeU64 100 , decodeU16 101 , decodeU32 102 , decodeU64 103 , encodeTlvStream 104 , decodeTlvStreamRaw 105 ) 106 import Lightning.Protocol.BOLT2.Types 107 import Lightning.Protocol.BOLT2.Messages 108 109 -- Error types ----------------------------------------------------------------- 110 111 -- | Encoding errors. 112 data EncodeError 113 = EncodeLengthOverflow -- ^ Payload exceeds u16 max (65535 bytes) 114 deriving stock (Eq, Show, Generic) 115 116 instance NFData EncodeError 117 118 -- | Decoding errors. 119 data DecodeError 120 = DecodeInsufficientBytes 121 | DecodeInvalidLength 122 | DecodeInvalidChannelId 123 | DecodeInvalidChainHash 124 | DecodeInvalidSignature 125 | DecodeInvalidPoint 126 | DecodeInvalidTxId 127 | DecodeInvalidPaymentHash 128 | DecodeInvalidPaymentPreimage 129 | DecodeInvalidOnionPacket 130 | DecodeInvalidSecret 131 | DecodeTlvError !TlvError 132 deriving stock (Eq, Show, Generic) 133 134 instance NFData DecodeError 135 136 -- Helpers --------------------------------------------------------------------- 137 138 -- | Decode a single byte. 139 decodeU8 :: BS.ByteString -> Maybe (Word8, BS.ByteString) 140 decodeU8 !bs 141 | BS.null bs = Nothing 142 | otherwise = Just (BS.index bs 0, BS.drop 1 bs) 143 {-# INLINE decodeU8 #-} 144 145 -- | Decode fixed-size bytes. 146 decodeBytes :: Int -> BS.ByteString -> Maybe (BS.ByteString, BS.ByteString) 147 decodeBytes !n !bs 148 | BS.length bs < n = Nothing 149 | otherwise = Just (BS.take n bs, BS.drop n bs) 150 {-# INLINE decodeBytes #-} 151 152 -- | Decode a ChannelId (32 bytes). 153 decodeChannelIdBytes 154 :: BS.ByteString -> Either DecodeError (ChannelId, BS.ByteString) 155 decodeChannelIdBytes !bs = do 156 (raw, rest) <- maybe (Left DecodeInsufficientBytes) Right 157 (decodeBytes channelIdLen bs) 158 cid <- maybe (Left DecodeInvalidChannelId) Right (channelId raw) 159 Right (cid, rest) 160 {-# INLINE decodeChannelIdBytes #-} 161 162 -- | Decode a ChainHash (32 bytes). 163 decodeChainHashBytes 164 :: BS.ByteString -> Either DecodeError (ChainHash, BS.ByteString) 165 decodeChainHashBytes !bs = do 166 (raw, rest) <- maybe (Left DecodeInsufficientBytes) Right 167 (decodeBytes chainHashLen bs) 168 ch <- maybe (Left DecodeInvalidChainHash) Right (chainHash raw) 169 Right (ch, rest) 170 {-# INLINE decodeChainHashBytes #-} 171 172 -- | Decode a Signature (64 bytes). 173 decodeSignatureBytes 174 :: BS.ByteString -> Either DecodeError (Signature, BS.ByteString) 175 decodeSignatureBytes !bs = do 176 (raw, rest) <- maybe (Left DecodeInsufficientBytes) Right 177 (decodeBytes signatureLen bs) 178 sig <- maybe (Left DecodeInvalidSignature) Right (signature raw) 179 Right (sig, rest) 180 {-# INLINE decodeSignatureBytes #-} 181 182 -- | Decode a Point (33 bytes). 183 decodePointBytes 184 :: BS.ByteString -> Either DecodeError (Point, BS.ByteString) 185 decodePointBytes !bs = do 186 (raw, rest) <- maybe (Left DecodeInsufficientBytes) Right 187 (decodeBytes pointLen bs) 188 pt <- maybe (Left DecodeInvalidPoint) Right (point raw) 189 Right (pt, rest) 190 {-# INLINE decodePointBytes #-} 191 192 -- | Decode a TxId (32 bytes). 193 decodeTxIdBytes 194 :: BS.ByteString -> Either DecodeError (TxId, BS.ByteString) 195 decodeTxIdBytes !bs = do 196 (raw, rest) <- maybe (Left DecodeInsufficientBytes) Right 197 (decodeBytes 32 bs) 198 tid <- maybe (Left DecodeInvalidTxId) Right (mkTxId raw) 199 Right (tid, rest) 200 {-# INLINE decodeTxIdBytes #-} 201 202 -- | Decode a u16 with error handling. 203 decodeU16E :: BS.ByteString -> Either DecodeError (Word16, BS.ByteString) 204 decodeU16E !bs = maybe (Left DecodeInsufficientBytes) Right (decodeU16 bs) 205 {-# INLINE decodeU16E #-} 206 207 -- | Decode a u32 with error handling. 208 decodeU32E :: BS.ByteString -> Either DecodeError (Word32, BS.ByteString) 209 decodeU32E !bs = maybe (Left DecodeInsufficientBytes) Right (decodeU32 bs) 210 {-# INLINE decodeU32E #-} 211 212 -- | Decode a u64 as Satoshis. 213 decodeSatoshis 214 :: BS.ByteString -> Either DecodeError (Satoshis, BS.ByteString) 215 decodeSatoshis !bs = do 216 (val, rest) <- maybe (Left DecodeInsufficientBytes) Right (decodeU64 bs) 217 Right (Satoshis val, rest) 218 {-# INLINE decodeSatoshis #-} 219 220 -- | Decode a u64 as MilliSatoshis. 221 decodeMilliSatoshis 222 :: BS.ByteString -> Either DecodeError (MilliSatoshis, BS.ByteString) 223 decodeMilliSatoshis !bs = do 224 (val, rest) <- maybe (Left DecodeInsufficientBytes) Right (decodeU64 bs) 225 Right (MilliSatoshis val, rest) 226 {-# INLINE decodeMilliSatoshis #-} 227 228 -- | Decode optional TLV stream from remaining bytes. 229 decodeTlvs :: BS.ByteString -> Either DecodeError TlvStream 230 decodeTlvs !bs 231 | BS.null bs = Right (unsafeTlvStream []) 232 | otherwise = either (Left . DecodeTlvError) Right (decodeTlvStreamRaw bs) 233 {-# INLINE decodeTlvs #-} 234 235 -- | Decode a length-prefixed script (u16 length prefix). 236 decodeScriptPubKey 237 :: BS.ByteString -> Either DecodeError (ScriptPubKey, BS.ByteString) 238 decodeScriptPubKey !bs = do 239 (len, rest1) <- decodeU16E bs 240 let !scriptLen = fromIntegral len 241 unless (BS.length rest1 >= scriptLen) $ Left DecodeInsufficientBytes 242 let !script = BS.take scriptLen rest1 243 !rest2 = BS.drop scriptLen rest1 244 Right (scriptPubKey script, rest2) 245 {-# INLINE decodeScriptPubKey #-} 246 247 -- | Decode a PaymentHash (32 bytes). 248 decodePaymentHashBytes 249 :: BS.ByteString -> Either DecodeError (PaymentHash, BS.ByteString) 250 decodePaymentHashBytes !bs = do 251 (raw, rest) <- maybe (Left DecodeInsufficientBytes) Right 252 (decodeBytes paymentHashLen bs) 253 ph <- maybe (Left DecodeInvalidPaymentHash) Right (paymentHash raw) 254 Right (ph, rest) 255 {-# INLINE decodePaymentHashBytes #-} 256 257 -- | Decode a PaymentPreimage (32 bytes). 258 decodePaymentPreimageBytes 259 :: BS.ByteString -> Either DecodeError (PaymentPreimage, BS.ByteString) 260 decodePaymentPreimageBytes !bs = do 261 (raw, rest) <- maybe (Left DecodeInsufficientBytes) Right 262 (decodeBytes paymentPreimageLen bs) 263 pp <- maybe (Left DecodeInvalidPaymentPreimage) Right (paymentPreimage raw) 264 Right (pp, rest) 265 {-# INLINE decodePaymentPreimageBytes #-} 266 267 -- | Decode an OnionPacket (1366 bytes). 268 decodeOnionPacketBytes 269 :: BS.ByteString -> Either DecodeError (OnionPacket, BS.ByteString) 270 decodeOnionPacketBytes !bs = do 271 (raw, rest) <- maybe (Left DecodeInsufficientBytes) Right 272 (decodeBytes onionPacketLen bs) 273 op <- maybe (Left DecodeInvalidOnionPacket) Right (onionPacket raw) 274 Right (op, rest) 275 {-# INLINE decodeOnionPacketBytes #-} 276 277 -- | Decode a Secret (32 bytes). 278 decodeSecretBytes 279 :: BS.ByteString -> Either DecodeError (Secret, BS.ByteString) 280 decodeSecretBytes !bs = do 281 (raw, rest) <- maybe (Left DecodeInsufficientBytes) Right 282 (decodeBytes secretLen bs) 283 sec <- maybe (Left DecodeInvalidSecret) Right (secret raw) 284 Right (sec, rest) 285 {-# INLINE decodeSecretBytes #-} 286 287 -- | Encode a u16-prefixed byte string with bounds checking. 288 encodeU16BytesE :: BS.ByteString -> Either EncodeError BS.ByteString 289 encodeU16BytesE !bs 290 | BS.length bs > 65535 = Left EncodeLengthOverflow 291 | otherwise = Right $! encodeU16 (fromIntegral (BS.length bs)) <> bs 292 {-# INLINE encodeU16BytesE #-} 293 294 -- | Check that a list count fits in u16. 295 checkListCountU16 :: Int -> Either EncodeError Word16 296 checkListCountU16 !n 297 | n > 65535 = Left EncodeLengthOverflow 298 | otherwise = Right $! fromIntegral n 299 {-# INLINE checkListCountU16 #-} 300 301 -- | Decode a u16-prefixed byte string. 302 decodeU16Bytes 303 :: BS.ByteString -> Either DecodeError (BS.ByteString, BS.ByteString) 304 decodeU16Bytes !bs = do 305 (len, rest1) <- decodeU16E bs 306 let !n = fromIntegral len 307 unless (BS.length rest1 >= n) $ Left DecodeInsufficientBytes 308 Right (BS.take n rest1, BS.drop n rest1) 309 {-# INLINE decodeU16Bytes #-} 310 311 -- | Decode optional trailing TLV stream. 312 decodeOptionalTlvs 313 :: BS.ByteString -> Either DecodeError (TlvStream, BS.ByteString) 314 decodeOptionalTlvs !bs 315 | BS.null bs = Right (unsafeTlvStream [], BS.empty) 316 | otherwise = case decodeTlvStreamRaw bs of 317 Left e -> Left (DecodeTlvError e) 318 Right t -> Right (t, BS.empty) 319 {-# INLINE decodeOptionalTlvs #-} 320 321 -- Channel establishment v1 ---------------------------------------------------- 322 323 -- | Encode an OpenChannel message (type 32). 324 -- 325 -- Wire format: 326 -- - chain_hash: 32 bytes 327 -- - temporary_channel_id: 32 bytes 328 -- - funding_satoshis: u64 329 -- - push_msat: u64 330 -- - dust_limit_satoshis: u64 331 -- - max_htlc_value_in_flight_msat: u64 332 -- - channel_reserve_satoshis: u64 333 -- - htlc_minimum_msat: u64 334 -- - feerate_per_kw: u32 335 -- - to_self_delay: u16 336 -- - max_accepted_htlcs: u16 337 -- - funding_pubkey: 33 bytes 338 -- - revocation_basepoint: 33 bytes 339 -- - payment_basepoint: 33 bytes 340 -- - delayed_payment_basepoint: 33 bytes 341 -- - htlc_basepoint: 33 bytes 342 -- - first_per_commitment_point: 33 bytes 343 -- - channel_flags: 1 byte 344 -- - tlvs: TLV stream 345 encodeOpenChannel :: OpenChannel -> BS.ByteString 346 encodeOpenChannel !msg = mconcat 347 [ unChainHash (openChannelChainHash msg) 348 , unChannelId (openChannelTempChannelId msg) 349 , encodeU64 (unSatoshis (openChannelFundingSatoshis msg)) 350 , encodeU64 (unMilliSatoshis (openChannelPushMsat msg)) 351 , encodeU64 (unSatoshis (openChannelDustLimitSatoshis msg)) 352 , encodeU64 (unMilliSatoshis (openChannelMaxHtlcValueInFlight msg)) 353 , encodeU64 (unSatoshis (openChannelChannelReserveSat msg)) 354 , encodeU64 (unMilliSatoshis (openChannelHtlcMinimumMsat msg)) 355 , encodeU32 (openChannelFeeratePerKw msg) 356 , encodeU16 (openChannelToSelfDelay msg) 357 , encodeU16 (openChannelMaxAcceptedHtlcs msg) 358 , unPoint (openChannelFundingPubkey msg) 359 , unPoint (openChannelRevocationBasepoint msg) 360 , unPoint (openChannelPaymentBasepoint msg) 361 , unPoint (openChannelDelayedPaymentBase msg) 362 , unPoint (openChannelHtlcBasepoint msg) 363 , unPoint (openChannelFirstPerCommitPoint msg) 364 , BS.singleton (openChannelChannelFlags msg) 365 , encodeTlvStream (openChannelTlvs msg) 366 ] 367 368 -- | Decode an OpenChannel message (type 32). 369 decodeOpenChannel 370 :: BS.ByteString -> Either DecodeError (OpenChannel, BS.ByteString) 371 decodeOpenChannel !bs = do 372 (chainHash', rest1) <- decodeChainHashBytes bs 373 (tempChanId, rest2) <- decodeChannelIdBytes rest1 374 (fundingSats, rest3) <- decodeSatoshis rest2 375 (pushMsat, rest4) <- decodeMilliSatoshis rest3 376 (dustLimit, rest5) <- decodeSatoshis rest4 377 (maxHtlcVal, rest6) <- decodeMilliSatoshis rest5 378 (chanReserve, rest7) <- decodeSatoshis rest6 379 (htlcMin, rest8) <- decodeMilliSatoshis rest7 380 (feerate, rest9) <- decodeU32E rest8 381 (toSelfDelay, rest10) <- decodeU16E rest9 382 (maxHtlcs, rest11) <- decodeU16E rest10 383 (fundingPk, rest12) <- decodePointBytes rest11 384 (revocBase, rest13) <- decodePointBytes rest12 385 (paymentBase, rest14) <- decodePointBytes rest13 386 (delayedBase, rest15) <- decodePointBytes rest14 387 (htlcBase, rest16) <- decodePointBytes rest15 388 (firstCommit, rest17) <- decodePointBytes rest16 389 (flags, rest18) <- maybe (Left DecodeInsufficientBytes) Right 390 (decodeU8 rest17) 391 tlvs <- decodeTlvs rest18 392 let !msg = OpenChannel 393 { openChannelChainHash = chainHash' 394 , openChannelTempChannelId = tempChanId 395 , openChannelFundingSatoshis = fundingSats 396 , openChannelPushMsat = pushMsat 397 , openChannelDustLimitSatoshis = dustLimit 398 , openChannelMaxHtlcValueInFlight = maxHtlcVal 399 , openChannelChannelReserveSat = chanReserve 400 , openChannelHtlcMinimumMsat = htlcMin 401 , openChannelFeeratePerKw = feerate 402 , openChannelToSelfDelay = toSelfDelay 403 , openChannelMaxAcceptedHtlcs = maxHtlcs 404 , openChannelFundingPubkey = fundingPk 405 , openChannelRevocationBasepoint = revocBase 406 , openChannelPaymentBasepoint = paymentBase 407 , openChannelDelayedPaymentBase = delayedBase 408 , openChannelHtlcBasepoint = htlcBase 409 , openChannelFirstPerCommitPoint = firstCommit 410 , openChannelChannelFlags = flags 411 , openChannelTlvs = tlvs 412 } 413 Right (msg, BS.empty) 414 415 -- | Encode an AcceptChannel message (type 33). 416 -- 417 -- Wire format: 418 -- - temporary_channel_id: 32 bytes 419 -- - dust_limit_satoshis: u64 420 -- - max_htlc_value_in_flight_msat: u64 421 -- - channel_reserve_satoshis: u64 422 -- - htlc_minimum_msat: u64 423 -- - minimum_depth: u32 424 -- - to_self_delay: u16 425 -- - max_accepted_htlcs: u16 426 -- - funding_pubkey: 33 bytes 427 -- - revocation_basepoint: 33 bytes 428 -- - payment_basepoint: 33 bytes 429 -- - delayed_payment_basepoint: 33 bytes 430 -- - htlc_basepoint: 33 bytes 431 -- - first_per_commitment_point: 33 bytes 432 -- - tlvs: TLV stream 433 encodeAcceptChannel :: AcceptChannel -> BS.ByteString 434 encodeAcceptChannel !msg = mconcat 435 [ unChannelId (acceptChannelTempChannelId msg) 436 , encodeU64 (unSatoshis (acceptChannelDustLimitSatoshis msg)) 437 , encodeU64 (unMilliSatoshis (acceptChannelMaxHtlcValueInFlight msg)) 438 , encodeU64 (unSatoshis (acceptChannelChannelReserveSat msg)) 439 , encodeU64 (unMilliSatoshis (acceptChannelHtlcMinimumMsat msg)) 440 , encodeU32 (acceptChannelMinimumDepth msg) 441 , encodeU16 (acceptChannelToSelfDelay msg) 442 , encodeU16 (acceptChannelMaxAcceptedHtlcs msg) 443 , unPoint (acceptChannelFundingPubkey msg) 444 , unPoint (acceptChannelRevocationBasepoint msg) 445 , unPoint (acceptChannelPaymentBasepoint msg) 446 , unPoint (acceptChannelDelayedPaymentBase msg) 447 , unPoint (acceptChannelHtlcBasepoint msg) 448 , unPoint (acceptChannelFirstPerCommitPoint msg) 449 , encodeTlvStream (acceptChannelTlvs msg) 450 ] 451 452 -- | Decode an AcceptChannel message (type 33). 453 decodeAcceptChannel 454 :: BS.ByteString -> Either DecodeError (AcceptChannel, BS.ByteString) 455 decodeAcceptChannel !bs = do 456 (tempChanId, rest1) <- decodeChannelIdBytes bs 457 (dustLimit, rest2) <- decodeSatoshis rest1 458 (maxHtlcVal, rest3) <- decodeMilliSatoshis rest2 459 (chanReserve, rest4) <- decodeSatoshis rest3 460 (htlcMin, rest5) <- decodeMilliSatoshis rest4 461 (minDepth, rest6) <- decodeU32E rest5 462 (toSelfDelay, rest7) <- decodeU16E rest6 463 (maxHtlcs, rest8) <- decodeU16E rest7 464 (fundingPk, rest9) <- decodePointBytes rest8 465 (revocBase, rest10) <- decodePointBytes rest9 466 (paymentBase, rest11) <- decodePointBytes rest10 467 (delayedBase, rest12) <- decodePointBytes rest11 468 (htlcBase, rest13) <- decodePointBytes rest12 469 (firstCommit, rest14) <- decodePointBytes rest13 470 tlvs <- decodeTlvs rest14 471 let !msg = AcceptChannel 472 { acceptChannelTempChannelId = tempChanId 473 , acceptChannelDustLimitSatoshis = dustLimit 474 , acceptChannelMaxHtlcValueInFlight = maxHtlcVal 475 , acceptChannelChannelReserveSat = chanReserve 476 , acceptChannelHtlcMinimumMsat = htlcMin 477 , acceptChannelMinimumDepth = minDepth 478 , acceptChannelToSelfDelay = toSelfDelay 479 , acceptChannelMaxAcceptedHtlcs = maxHtlcs 480 , acceptChannelFundingPubkey = fundingPk 481 , acceptChannelRevocationBasepoint = revocBase 482 , acceptChannelPaymentBasepoint = paymentBase 483 , acceptChannelDelayedPaymentBase = delayedBase 484 , acceptChannelHtlcBasepoint = htlcBase 485 , acceptChannelFirstPerCommitPoint = firstCommit 486 , acceptChannelTlvs = tlvs 487 } 488 Right (msg, BS.empty) 489 490 -- | Encode a FundingCreated message (type 34). 491 -- 492 -- Wire format: 493 -- - temporary_channel_id: 32 bytes 494 -- - funding_txid: 32 bytes 495 -- - funding_output_index: u16 496 -- - signature: 64 bytes 497 encodeFundingCreated :: FundingCreated -> BS.ByteString 498 encodeFundingCreated !msg = mconcat 499 [ unChannelId (fundingCreatedTempChannelId msg) 500 , let (TxId bs) = fundingCreatedFundingTxid msg in bs 501 , encodeU16 (fundingCreatedFundingOutIdx msg) 502 , unSignature (fundingCreatedSignature msg) 503 ] 504 505 -- | Decode a FundingCreated message (type 34). 506 decodeFundingCreated 507 :: BS.ByteString -> Either DecodeError (FundingCreated, BS.ByteString) 508 decodeFundingCreated !bs = do 509 (tempChanId, rest1) <- decodeChannelIdBytes bs 510 (fundingTxid, rest2) <- decodeTxIdBytes rest1 511 (outIdx, rest3) <- decodeU16E rest2 512 (sig, rest4) <- decodeSignatureBytes rest3 513 let !msg = FundingCreated 514 { fundingCreatedTempChannelId = tempChanId 515 , fundingCreatedFundingTxid = fundingTxid 516 , fundingCreatedFundingOutIdx = outIdx 517 , fundingCreatedSignature = sig 518 } 519 Right (msg, rest4) 520 521 -- | Encode a FundingSigned message (type 35). 522 -- 523 -- Wire format: 524 -- - channel_id: 32 bytes 525 -- - signature: 64 bytes 526 encodeFundingSigned :: FundingSigned -> BS.ByteString 527 encodeFundingSigned !msg = mconcat 528 [ unChannelId (fundingSignedChannelId msg) 529 , unSignature (fundingSignedSignature msg) 530 ] 531 532 -- | Decode a FundingSigned message (type 35). 533 decodeFundingSigned 534 :: BS.ByteString -> Either DecodeError (FundingSigned, BS.ByteString) 535 decodeFundingSigned !bs = do 536 (chanId, rest1) <- decodeChannelIdBytes bs 537 (sig, rest2) <- decodeSignatureBytes rest1 538 let !msg = FundingSigned 539 { fundingSignedChannelId = chanId 540 , fundingSignedSignature = sig 541 } 542 Right (msg, rest2) 543 544 -- | Encode a ChannelReady message (type 36). 545 -- 546 -- Wire format: 547 -- - channel_id: 32 bytes 548 -- - second_per_commitment_point: 33 bytes 549 -- - tlvs: TLV stream 550 encodeChannelReady :: ChannelReady -> BS.ByteString 551 encodeChannelReady !msg = mconcat 552 [ unChannelId (channelReadyChannelId msg) 553 , unPoint (channelReadySecondPerCommitPoint msg) 554 , encodeTlvStream (channelReadyTlvs msg) 555 ] 556 557 -- | Decode a ChannelReady message (type 36). 558 decodeChannelReady 559 :: BS.ByteString -> Either DecodeError (ChannelReady, BS.ByteString) 560 decodeChannelReady !bs = do 561 (chanId, rest1) <- decodeChannelIdBytes bs 562 (secondCommit, rest2) <- decodePointBytes rest1 563 tlvs <- decodeTlvs rest2 564 let !msg = ChannelReady 565 { channelReadyChannelId = chanId 566 , channelReadySecondPerCommitPoint = secondCommit 567 , channelReadyTlvs = tlvs 568 } 569 Right (msg, BS.empty) 570 571 -- Channel close --------------------------------------------------------------- 572 573 -- | Encode a Stfu message (type 2). 574 -- 575 -- Wire format: 576 -- - channel_id: 32 bytes 577 -- - initiator: 1 byte 578 encodeStfu :: Stfu -> BS.ByteString 579 encodeStfu !msg = mconcat 580 [ unChannelId (stfuChannelId msg) 581 , BS.singleton (stfuInitiator msg) 582 ] 583 584 -- | Decode a Stfu message (type 2). 585 decodeStfu :: BS.ByteString -> Either DecodeError (Stfu, BS.ByteString) 586 decodeStfu !bs = do 587 (chanId, rest1) <- decodeChannelIdBytes bs 588 (initiator, rest2) <- maybe (Left DecodeInsufficientBytes) Right 589 (decodeU8 rest1) 590 let !msg = Stfu 591 { stfuChannelId = chanId 592 , stfuInitiator = initiator 593 } 594 Right (msg, rest2) 595 596 -- | Encode a Shutdown message (type 38). 597 -- 598 -- Wire format: 599 -- - channel_id: 32 bytes 600 -- - len: u16 601 -- - scriptpubkey: len bytes 602 encodeShutdown :: Shutdown -> Either EncodeError BS.ByteString 603 encodeShutdown !msg = do 604 let !script = unScriptPubKey (shutdownScriptPubkey msg) 605 !scriptLen = BS.length script 606 if scriptLen > 65535 607 then Left EncodeLengthOverflow 608 else Right $ mconcat 609 [ unChannelId (shutdownChannelId msg) 610 , encodeU16 (fromIntegral scriptLen) 611 , script 612 ] 613 614 -- | Decode a Shutdown message (type 38). 615 decodeShutdown 616 :: BS.ByteString -> Either DecodeError (Shutdown, BS.ByteString) 617 decodeShutdown !bs = do 618 (chanId, rest1) <- decodeChannelIdBytes bs 619 (script, rest2) <- decodeScriptPubKey rest1 620 let !msg = Shutdown 621 { shutdownChannelId = chanId 622 , shutdownScriptPubkey = script 623 } 624 Right (msg, rest2) 625 626 -- | Encode a ClosingSigned message (type 39). 627 -- 628 -- Wire format: 629 -- - channel_id: 32 bytes 630 -- - fee_satoshis: u64 631 -- - signature: 64 bytes 632 -- - tlvs: TLV stream 633 encodeClosingSigned :: ClosingSigned -> BS.ByteString 634 encodeClosingSigned !msg = mconcat 635 [ unChannelId (closingSignedChannelId msg) 636 , encodeU64 (unSatoshis (closingSignedFeeSatoshis msg)) 637 , unSignature (closingSignedSignature msg) 638 , encodeTlvStream (closingSignedTlvs msg) 639 ] 640 641 -- | Decode a ClosingSigned message (type 39). 642 decodeClosingSigned 643 :: BS.ByteString -> Either DecodeError (ClosingSigned, BS.ByteString) 644 decodeClosingSigned !bs = do 645 (chanId, rest1) <- decodeChannelIdBytes bs 646 (feeSats, rest2) <- decodeSatoshis rest1 647 (sig, rest3) <- decodeSignatureBytes rest2 648 tlvs <- decodeTlvs rest3 649 let !msg = ClosingSigned 650 { closingSignedChannelId = chanId 651 , closingSignedFeeSatoshis = feeSats 652 , closingSignedSignature = sig 653 , closingSignedTlvs = tlvs 654 } 655 Right (msg, BS.empty) 656 657 -- | Encode a ClosingComplete message (type 40). 658 -- 659 -- Wire format: 660 -- - channel_id: 32 bytes 661 -- - len: u16 (closer script length) 662 -- - closer_script: len bytes 663 -- - len: u16 (closee script length) 664 -- - closee_script: len bytes 665 -- - fee_satoshis: u64 666 -- - locktime: u32 667 -- - tlvs: TLV stream 668 encodeClosingComplete :: ClosingComplete -> Either EncodeError BS.ByteString 669 encodeClosingComplete !msg = do 670 let !closerScript = unScriptPubKey (closingCompleteCloserScript msg) 671 !closeeScript = unScriptPubKey (closingCompleteCloseeScript msg) 672 !closerLen = BS.length closerScript 673 !closeeLen = BS.length closeeScript 674 if closerLen > 65535 || closeeLen > 65535 675 then Left EncodeLengthOverflow 676 else Right $ mconcat 677 [ unChannelId (closingCompleteChannelId msg) 678 , encodeU16 (fromIntegral closerLen) 679 , closerScript 680 , encodeU16 (fromIntegral closeeLen) 681 , closeeScript 682 , encodeU64 (unSatoshis (closingCompleteFeeSatoshis msg)) 683 , encodeU32 (closingCompleteLocktime msg) 684 , encodeTlvStream (closingCompleteTlvs msg) 685 ] 686 687 -- | Decode a ClosingComplete message (type 40). 688 decodeClosingComplete 689 :: BS.ByteString -> Either DecodeError (ClosingComplete, BS.ByteString) 690 decodeClosingComplete !bs = do 691 (chanId, rest1) <- decodeChannelIdBytes bs 692 (closerScript, rest2) <- decodeScriptPubKey rest1 693 (closeeScript, rest3) <- decodeScriptPubKey rest2 694 (feeSats, rest4) <- decodeSatoshis rest3 695 (locktime, rest5) <- decodeU32E rest4 696 tlvs <- decodeTlvs rest5 697 let !msg = ClosingComplete 698 { closingCompleteChannelId = chanId 699 , closingCompleteCloserScript = closerScript 700 , closingCompleteCloseeScript = closeeScript 701 , closingCompleteFeeSatoshis = feeSats 702 , closingCompleteLocktime = locktime 703 , closingCompleteTlvs = tlvs 704 } 705 Right (msg, BS.empty) 706 707 -- | Encode a ClosingSig message (type 41). 708 -- 709 -- Wire format: 710 -- - channel_id: 32 bytes 711 -- - len: u16 (closer script length) 712 -- - closer_script: len bytes 713 -- - len: u16 (closee script length) 714 -- - closee_script: len bytes 715 -- - fee_satoshis: u64 716 -- - locktime: u32 717 -- - tlvs: TLV stream 718 encodeClosingSig :: ClosingSig -> Either EncodeError BS.ByteString 719 encodeClosingSig !msg = do 720 let !closerScript = unScriptPubKey (closingSigCloserScript msg) 721 !closeeScript = unScriptPubKey (closingSigCloseeScript msg) 722 !closerLen = BS.length closerScript 723 !closeeLen = BS.length closeeScript 724 if closerLen > 65535 || closeeLen > 65535 725 then Left EncodeLengthOverflow 726 else Right $ mconcat 727 [ unChannelId (closingSigChannelId msg) 728 , encodeU16 (fromIntegral closerLen) 729 , closerScript 730 , encodeU16 (fromIntegral closeeLen) 731 , closeeScript 732 , encodeU64 (unSatoshis (closingSigFeeSatoshis msg)) 733 , encodeU32 (closingSigLocktime msg) 734 , encodeTlvStream (closingSigTlvs msg) 735 ] 736 737 -- | Decode a ClosingSig message (type 41). 738 decodeClosingSig 739 :: BS.ByteString -> Either DecodeError (ClosingSig, BS.ByteString) 740 decodeClosingSig !bs = do 741 (chanId, rest1) <- decodeChannelIdBytes bs 742 (closerScript, rest2) <- decodeScriptPubKey rest1 743 (closeeScript, rest3) <- decodeScriptPubKey rest2 744 (feeSats, rest4) <- decodeSatoshis rest3 745 (locktime, rest5) <- decodeU32E rest4 746 tlvs <- decodeTlvs rest5 747 let !msg = ClosingSig 748 { closingSigChannelId = chanId 749 , closingSigCloserScript = closerScript 750 , closingSigCloseeScript = closeeScript 751 , closingSigFeeSatoshis = feeSats 752 , closingSigLocktime = locktime 753 , closingSigTlvs = tlvs 754 } 755 Right (msg, BS.empty) 756 757 -- Channel establishment v2 (interactive-tx) ----------------------------------- 758 759 -- | Encode an OpenChannel2 message (type 64). 760 encodeOpenChannel2 :: OpenChannel2 -> BS.ByteString 761 encodeOpenChannel2 !msg = mconcat 762 [ unChainHash (openChannel2ChainHash msg) 763 , unChannelId (openChannel2TempChannelId msg) 764 , encodeU32 (openChannel2FundingFeeratePerkw msg) 765 , encodeU32 (openChannel2CommitFeeratePerkw msg) 766 , encodeU64 (unSatoshis (openChannel2FundingSatoshis msg)) 767 , encodeU64 (unSatoshis (openChannel2DustLimitSatoshis msg)) 768 , encodeU64 (unMilliSatoshis (openChannel2MaxHtlcValueInFlight msg)) 769 , encodeU64 (unMilliSatoshis (openChannel2HtlcMinimumMsat msg)) 770 , encodeU16 (openChannel2ToSelfDelay msg) 771 , encodeU16 (openChannel2MaxAcceptedHtlcs msg) 772 , encodeU32 (openChannel2Locktime msg) 773 , unPoint (openChannel2FundingPubkey msg) 774 , unPoint (openChannel2RevocationBasepoint msg) 775 , unPoint (openChannel2PaymentBasepoint msg) 776 , unPoint (openChannel2DelayedPaymentBase msg) 777 , unPoint (openChannel2HtlcBasepoint msg) 778 , unPoint (openChannel2FirstPerCommitPoint msg) 779 , unPoint (openChannel2SecondPerCommitPoint msg) 780 , BS.singleton (openChannel2ChannelFlags msg) 781 , encodeTlvStream (openChannel2Tlvs msg) 782 ] 783 784 -- | Decode an OpenChannel2 message (type 64). 785 decodeOpenChannel2 786 :: BS.ByteString -> Either DecodeError (OpenChannel2, BS.ByteString) 787 decodeOpenChannel2 !bs = do 788 (ch, rest1) <- decodeChainHashBytes bs 789 (tempCid, rest2) <- decodeChannelIdBytes rest1 790 (fundingFeerate, rest3) <- decodeU32E rest2 791 (commitFeerate, rest4) <- decodeU32E rest3 792 (fundingSats, rest5) <- decodeSatoshis rest4 793 (dustLimit, rest6) <- decodeSatoshis rest5 794 (maxHtlcVal, rest7) <- decodeMilliSatoshis rest6 795 (htlcMin, rest8) <- decodeMilliSatoshis rest7 796 (toSelfDelay, rest9) <- decodeU16E rest8 797 (maxHtlcs, rest10) <- decodeU16E rest9 798 (locktime, rest11) <- decodeU32E rest10 799 (fundingPk, rest12) <- decodePointBytes rest11 800 (revBase, rest13) <- decodePointBytes rest12 801 (payBase, rest14) <- decodePointBytes rest13 802 (delayBase, rest15) <- decodePointBytes rest14 803 (htlcBase, rest16) <- decodePointBytes rest15 804 (firstPt, rest17) <- decodePointBytes rest16 805 (secondPt, rest18) <- decodePointBytes rest17 806 (flags, rest19) <- maybe (Left DecodeInsufficientBytes) Right (decodeU8 rest18) 807 tlvs <- decodeTlvs rest19 808 let !msg = OpenChannel2 809 { openChannel2ChainHash = ch 810 , openChannel2TempChannelId = tempCid 811 , openChannel2FundingFeeratePerkw = fundingFeerate 812 , openChannel2CommitFeeratePerkw = commitFeerate 813 , openChannel2FundingSatoshis = fundingSats 814 , openChannel2DustLimitSatoshis = dustLimit 815 , openChannel2MaxHtlcValueInFlight = maxHtlcVal 816 , openChannel2HtlcMinimumMsat = htlcMin 817 , openChannel2ToSelfDelay = toSelfDelay 818 , openChannel2MaxAcceptedHtlcs = maxHtlcs 819 , openChannel2Locktime = locktime 820 , openChannel2FundingPubkey = fundingPk 821 , openChannel2RevocationBasepoint = revBase 822 , openChannel2PaymentBasepoint = payBase 823 , openChannel2DelayedPaymentBase = delayBase 824 , openChannel2HtlcBasepoint = htlcBase 825 , openChannel2FirstPerCommitPoint = firstPt 826 , openChannel2SecondPerCommitPoint = secondPt 827 , openChannel2ChannelFlags = flags 828 , openChannel2Tlvs = tlvs 829 } 830 Right (msg, BS.empty) 831 832 -- | Encode an AcceptChannel2 message (type 65). 833 encodeAcceptChannel2 :: AcceptChannel2 -> BS.ByteString 834 encodeAcceptChannel2 !msg = mconcat 835 [ unChannelId (acceptChannel2TempChannelId msg) 836 , encodeU64 (unSatoshis (acceptChannel2FundingSatoshis msg)) 837 , encodeU64 (unSatoshis (acceptChannel2DustLimitSatoshis msg)) 838 , encodeU64 (unMilliSatoshis (acceptChannel2MaxHtlcValueInFlight msg)) 839 , encodeU64 (unMilliSatoshis (acceptChannel2HtlcMinimumMsat msg)) 840 , encodeU32 (acceptChannel2MinimumDepth msg) 841 , encodeU16 (acceptChannel2ToSelfDelay msg) 842 , encodeU16 (acceptChannel2MaxAcceptedHtlcs msg) 843 , unPoint (acceptChannel2FundingPubkey msg) 844 , unPoint (acceptChannel2RevocationBasepoint msg) 845 , unPoint (acceptChannel2PaymentBasepoint msg) 846 , unPoint (acceptChannel2DelayedPaymentBase msg) 847 , unPoint (acceptChannel2HtlcBasepoint msg) 848 , unPoint (acceptChannel2FirstPerCommitPoint msg) 849 , unPoint (acceptChannel2SecondPerCommitPoint msg) 850 , encodeTlvStream (acceptChannel2Tlvs msg) 851 ] 852 853 -- | Decode an AcceptChannel2 message (type 65). 854 decodeAcceptChannel2 855 :: BS.ByteString -> Either DecodeError (AcceptChannel2, BS.ByteString) 856 decodeAcceptChannel2 !bs = do 857 (tempCid, rest1) <- decodeChannelIdBytes bs 858 (fundingSats, rest2) <- decodeSatoshis rest1 859 (dustLimit, rest3) <- decodeSatoshis rest2 860 (maxHtlcVal, rest4) <- decodeMilliSatoshis rest3 861 (htlcMin, rest5) <- decodeMilliSatoshis rest4 862 (minDepth, rest6) <- decodeU32E rest5 863 (toSelfDelay, rest7) <- decodeU16E rest6 864 (maxHtlcs, rest8) <- decodeU16E rest7 865 (fundingPk, rest9) <- decodePointBytes rest8 866 (revBase, rest10) <- decodePointBytes rest9 867 (payBase, rest11) <- decodePointBytes rest10 868 (delayBase, rest12) <- decodePointBytes rest11 869 (htlcBase, rest13) <- decodePointBytes rest12 870 (firstPt, rest14) <- decodePointBytes rest13 871 (secondPt, rest15) <- decodePointBytes rest14 872 tlvs <- decodeTlvs rest15 873 let !msg = AcceptChannel2 874 { acceptChannel2TempChannelId = tempCid 875 , acceptChannel2FundingSatoshis = fundingSats 876 , acceptChannel2DustLimitSatoshis = dustLimit 877 , acceptChannel2MaxHtlcValueInFlight = maxHtlcVal 878 , acceptChannel2HtlcMinimumMsat = htlcMin 879 , acceptChannel2MinimumDepth = minDepth 880 , acceptChannel2ToSelfDelay = toSelfDelay 881 , acceptChannel2MaxAcceptedHtlcs = maxHtlcs 882 , acceptChannel2FundingPubkey = fundingPk 883 , acceptChannel2RevocationBasepoint = revBase 884 , acceptChannel2PaymentBasepoint = payBase 885 , acceptChannel2DelayedPaymentBase = delayBase 886 , acceptChannel2HtlcBasepoint = htlcBase 887 , acceptChannel2FirstPerCommitPoint = firstPt 888 , acceptChannel2SecondPerCommitPoint = secondPt 889 , acceptChannel2Tlvs = tlvs 890 } 891 Right (msg, BS.empty) 892 893 -- | Encode a TxAddInput message (type 66). 894 encodeTxAddInput :: TxAddInput -> Either EncodeError BS.ByteString 895 encodeTxAddInput !msg = do 896 prevTxEnc <- encodeU16BytesE (txAddInputPrevTx msg) 897 Right $! mconcat 898 [ unChannelId (txAddInputChannelId msg) 899 , encodeU64 (txAddInputSerialId msg) 900 , prevTxEnc 901 , encodeU32 (txAddInputPrevVout msg) 902 , encodeU32 (txAddInputSequence msg) 903 ] 904 905 -- | Decode a TxAddInput message (type 66). 906 decodeTxAddInput 907 :: BS.ByteString -> Either DecodeError (TxAddInput, BS.ByteString) 908 decodeTxAddInput !bs = do 909 (cid, rest1) <- decodeChannelIdBytes bs 910 (serialId, rest2) <- maybe (Left DecodeInsufficientBytes) Right 911 (decodeU64 rest1) 912 (prevTx, rest3) <- decodeU16Bytes rest2 913 (prevVout, rest4) <- decodeU32E rest3 914 (seqNum, rest5) <- decodeU32E rest4 915 let !msg = TxAddInput 916 { txAddInputChannelId = cid 917 , txAddInputSerialId = serialId 918 , txAddInputPrevTx = prevTx 919 , txAddInputPrevVout = prevVout 920 , txAddInputSequence = seqNum 921 } 922 Right (msg, rest5) 923 924 -- | Encode a TxAddOutput message (type 67). 925 encodeTxAddOutput :: TxAddOutput -> Either EncodeError BS.ByteString 926 encodeTxAddOutput !msg = do 927 scriptEnc <- encodeU16BytesE (unScriptPubKey (txAddOutputScript msg)) 928 Right $! mconcat 929 [ unChannelId (txAddOutputChannelId msg) 930 , encodeU64 (txAddOutputSerialId msg) 931 , encodeU64 (unSatoshis (txAddOutputSats msg)) 932 , scriptEnc 933 ] 934 935 -- | Decode a TxAddOutput message (type 67). 936 decodeTxAddOutput 937 :: BS.ByteString -> Either DecodeError (TxAddOutput, BS.ByteString) 938 decodeTxAddOutput !bs = do 939 (cid, rest1) <- decodeChannelIdBytes bs 940 (serialId, rest2) <- maybe (Left DecodeInsufficientBytes) Right 941 (decodeU64 rest1) 942 (sats, rest3) <- decodeSatoshis rest2 943 (scriptBs, rest4) <- decodeU16Bytes rest3 944 let !msg = TxAddOutput 945 { txAddOutputChannelId = cid 946 , txAddOutputSerialId = serialId 947 , txAddOutputSats = sats 948 , txAddOutputScript = scriptPubKey scriptBs 949 } 950 Right (msg, rest4) 951 952 -- | Encode a TxRemoveInput message (type 68). 953 encodeTxRemoveInput :: TxRemoveInput -> BS.ByteString 954 encodeTxRemoveInput !msg = mconcat 955 [ unChannelId (txRemoveInputChannelId msg) 956 , encodeU64 (txRemoveInputSerialId msg) 957 ] 958 959 -- | Decode a TxRemoveInput message (type 68). 960 decodeTxRemoveInput 961 :: BS.ByteString -> Either DecodeError (TxRemoveInput, BS.ByteString) 962 decodeTxRemoveInput !bs = do 963 (cid, rest1) <- decodeChannelIdBytes bs 964 (serialId, rest2) <- maybe (Left DecodeInsufficientBytes) Right 965 (decodeU64 rest1) 966 let !msg = TxRemoveInput 967 { txRemoveInputChannelId = cid 968 , txRemoveInputSerialId = serialId 969 } 970 Right (msg, rest2) 971 972 -- | Encode a TxRemoveOutput message (type 69). 973 encodeTxRemoveOutput :: TxRemoveOutput -> BS.ByteString 974 encodeTxRemoveOutput !msg = mconcat 975 [ unChannelId (txRemoveOutputChannelId msg) 976 , encodeU64 (txRemoveOutputSerialId msg) 977 ] 978 979 -- | Decode a TxRemoveOutput message (type 69). 980 decodeTxRemoveOutput 981 :: BS.ByteString -> Either DecodeError (TxRemoveOutput, BS.ByteString) 982 decodeTxRemoveOutput !bs = do 983 (cid, rest1) <- decodeChannelIdBytes bs 984 (serialId, rest2) <- maybe (Left DecodeInsufficientBytes) Right 985 (decodeU64 rest1) 986 let !msg = TxRemoveOutput 987 { txRemoveOutputChannelId = cid 988 , txRemoveOutputSerialId = serialId 989 } 990 Right (msg, rest2) 991 992 -- | Encode a TxComplete message (type 70). 993 encodeTxComplete :: TxComplete -> BS.ByteString 994 encodeTxComplete !msg = unChannelId (txCompleteChannelId msg) 995 996 -- | Decode a TxComplete message (type 70). 997 decodeTxComplete 998 :: BS.ByteString -> Either DecodeError (TxComplete, BS.ByteString) 999 decodeTxComplete !bs = do 1000 (cid, rest) <- decodeChannelIdBytes bs 1001 let !msg = TxComplete { txCompleteChannelId = cid } 1002 Right (msg, rest) 1003 1004 -- | Encode a single witness with bounds checking. 1005 encodeWitnessE :: Witness -> Either EncodeError BS.ByteString 1006 encodeWitnessE (Witness !wdata) = encodeU16BytesE wdata 1007 1008 -- | Decode a single witness. 1009 decodeWitness :: BS.ByteString -> Either DecodeError (Witness, BS.ByteString) 1010 decodeWitness !bs = do 1011 (wdata, rest) <- decodeU16Bytes bs 1012 Right (Witness wdata, rest) 1013 1014 -- | Encode a TxSignatures message (type 71). 1015 encodeTxSignatures :: TxSignatures -> Either EncodeError BS.ByteString 1016 encodeTxSignatures !msg = do 1017 let !witnesses = txSignaturesWitnesses msg 1018 numWit <- checkListCountU16 (length witnesses) 1019 encodedWits <- traverse encodeWitnessE witnesses 1020 Right $! mconcat $ 1021 [ unChannelId (txSignaturesChannelId msg) 1022 , let (TxId bs) = txSignaturesTxid msg in bs 1023 , encodeU16 numWit 1024 ] ++ encodedWits 1025 1026 -- | Decode a TxSignatures message (type 71). 1027 decodeTxSignatures 1028 :: BS.ByteString -> Either DecodeError (TxSignatures, BS.ByteString) 1029 decodeTxSignatures !bs = do 1030 (cid, rest1) <- decodeChannelIdBytes bs 1031 (tid, rest2) <- decodeTxIdBytes rest1 1032 (numWit, rest3) <- decodeU16E rest2 1033 (witnesses, rest4) <- decodeWitnesses (fromIntegral numWit) rest3 1034 let !msg = TxSignatures 1035 { txSignaturesChannelId = cid 1036 , txSignaturesTxid = tid 1037 , txSignaturesWitnesses = witnesses 1038 } 1039 Right (msg, rest4) 1040 where 1041 decodeWitnesses :: Int -> BS.ByteString 1042 -> Either DecodeError ([Witness], BS.ByteString) 1043 decodeWitnesses 0 !rest = Right ([], rest) 1044 decodeWitnesses !n !rest = do 1045 (w, rest') <- decodeWitness rest 1046 (ws, rest'') <- decodeWitnesses (n - 1) rest' 1047 Right (w : ws, rest'') 1048 1049 -- | Encode a TxInitRbf message (type 72). 1050 encodeTxInitRbf :: TxInitRbf -> BS.ByteString 1051 encodeTxInitRbf !msg = mconcat 1052 [ unChannelId (txInitRbfChannelId msg) 1053 , encodeU32 (txInitRbfLocktime msg) 1054 , encodeU32 (txInitRbfFeerate msg) 1055 , encodeTlvStream (txInitRbfTlvs msg) 1056 ] 1057 1058 -- | Decode a TxInitRbf message (type 72). 1059 decodeTxInitRbf 1060 :: BS.ByteString -> Either DecodeError (TxInitRbf, BS.ByteString) 1061 decodeTxInitRbf !bs = do 1062 (cid, rest1) <- decodeChannelIdBytes bs 1063 (locktime, rest2) <- decodeU32E rest1 1064 (feerate, rest3) <- decodeU32E rest2 1065 tlvs <- decodeTlvs rest3 1066 let !msg = TxInitRbf 1067 { txInitRbfChannelId = cid 1068 , txInitRbfLocktime = locktime 1069 , txInitRbfFeerate = feerate 1070 , txInitRbfTlvs = tlvs 1071 } 1072 Right (msg, BS.empty) 1073 1074 -- | Encode a TxAckRbf message (type 73). 1075 encodeTxAckRbf :: TxAckRbf -> BS.ByteString 1076 encodeTxAckRbf !msg = mconcat 1077 [ unChannelId (txAckRbfChannelId msg) 1078 , encodeTlvStream (txAckRbfTlvs msg) 1079 ] 1080 1081 -- | Decode a TxAckRbf message (type 73). 1082 decodeTxAckRbf 1083 :: BS.ByteString -> Either DecodeError (TxAckRbf, BS.ByteString) 1084 decodeTxAckRbf !bs = do 1085 (cid, rest1) <- decodeChannelIdBytes bs 1086 tlvs <- decodeTlvs rest1 1087 let !msg = TxAckRbf 1088 { txAckRbfChannelId = cid 1089 , txAckRbfTlvs = tlvs 1090 } 1091 Right (msg, BS.empty) 1092 1093 -- | Encode a TxAbort message (type 74). 1094 encodeTxAbort :: TxAbort -> Either EncodeError BS.ByteString 1095 encodeTxAbort !msg = do 1096 dataEnc <- encodeU16BytesE (txAbortData msg) 1097 Right $! mconcat 1098 [ unChannelId (txAbortChannelId msg) 1099 , dataEnc 1100 ] 1101 1102 -- | Decode a TxAbort message (type 74). 1103 decodeTxAbort 1104 :: BS.ByteString -> Either DecodeError (TxAbort, BS.ByteString) 1105 decodeTxAbort !bs = do 1106 (cid, rest1) <- decodeChannelIdBytes bs 1107 (dat, rest2) <- decodeU16Bytes rest1 1108 let !msg = TxAbort 1109 { txAbortChannelId = cid 1110 , txAbortData = dat 1111 } 1112 Right (msg, rest2) 1113 1114 -- Normal operation ------------------------------------------------------------ 1115 1116 -- | Encode an UpdateAddHtlc message (type 128). 1117 encodeUpdateAddHtlc :: UpdateAddHtlc -> BS.ByteString 1118 encodeUpdateAddHtlc !m = mconcat 1119 [ unChannelId (updateAddHtlcChannelId m) 1120 , encodeU64 (updateAddHtlcId m) 1121 , encodeU64 (unMilliSatoshis (updateAddHtlcAmountMsat m)) 1122 , unPaymentHash (updateAddHtlcPaymentHash m) 1123 , encodeU32 (updateAddHtlcCltvExpiry m) 1124 , unOnionPacket (updateAddHtlcOnionPacket m) 1125 , encodeTlvStream (updateAddHtlcTlvs m) 1126 ] 1127 {-# INLINABLE encodeUpdateAddHtlc #-} 1128 1129 -- | Decode an UpdateAddHtlc message (type 128). 1130 decodeUpdateAddHtlc 1131 :: BS.ByteString -> Either DecodeError (UpdateAddHtlc, BS.ByteString) 1132 decodeUpdateAddHtlc !bs = do 1133 (cid, rest1) <- decodeChannelIdBytes bs 1134 (htlcId, rest2) <- maybe (Left DecodeInsufficientBytes) Right 1135 (decodeU64 rest1) 1136 (amtMsat, rest3) <- maybe (Left DecodeInsufficientBytes) Right 1137 (decodeU64 rest2) 1138 (pHash, rest4) <- decodePaymentHashBytes rest3 1139 (cltvExp, rest5) <- decodeU32E rest4 1140 (onion, rest6) <- decodeOnionPacketBytes rest5 1141 (tlvs, rest7) <- decodeOptionalTlvs rest6 1142 let !msg = UpdateAddHtlc 1143 { updateAddHtlcChannelId = cid 1144 , updateAddHtlcId = htlcId 1145 , updateAddHtlcAmountMsat = MilliSatoshis amtMsat 1146 , updateAddHtlcPaymentHash = pHash 1147 , updateAddHtlcCltvExpiry = cltvExp 1148 , updateAddHtlcOnionPacket = onion 1149 , updateAddHtlcTlvs = tlvs 1150 } 1151 Right (msg, rest7) 1152 {-# INLINABLE decodeUpdateAddHtlc #-} 1153 1154 -- | Encode an UpdateFulfillHtlc message (type 130). 1155 encodeUpdateFulfillHtlc :: UpdateFulfillHtlc -> BS.ByteString 1156 encodeUpdateFulfillHtlc !m = mconcat 1157 [ unChannelId (updateFulfillHtlcChannelId m) 1158 , encodeU64 (updateFulfillHtlcId m) 1159 , unPaymentPreimage (updateFulfillHtlcPaymentPreimage m) 1160 , encodeTlvStream (updateFulfillHtlcTlvs m) 1161 ] 1162 1163 -- | Decode an UpdateFulfillHtlc message (type 130). 1164 decodeUpdateFulfillHtlc 1165 :: BS.ByteString -> Either DecodeError (UpdateFulfillHtlc, BS.ByteString) 1166 decodeUpdateFulfillHtlc !bs = do 1167 (cid, rest1) <- decodeChannelIdBytes bs 1168 (htlcId, rest2) <- maybe (Left DecodeInsufficientBytes) Right 1169 (decodeU64 rest1) 1170 (preimage, rest3) <- decodePaymentPreimageBytes rest2 1171 (tlvs, rest4) <- decodeOptionalTlvs rest3 1172 let !msg = UpdateFulfillHtlc 1173 { updateFulfillHtlcChannelId = cid 1174 , updateFulfillHtlcId = htlcId 1175 , updateFulfillHtlcPaymentPreimage = preimage 1176 , updateFulfillHtlcTlvs = tlvs 1177 } 1178 Right (msg, rest4) 1179 1180 -- | Encode an UpdateFailHtlc message (type 131). 1181 encodeUpdateFailHtlc :: UpdateFailHtlc -> Either EncodeError BS.ByteString 1182 encodeUpdateFailHtlc !m = do 1183 reasonEnc <- encodeU16BytesE (updateFailHtlcReason m) 1184 Right $! mconcat 1185 [ unChannelId (updateFailHtlcChannelId m) 1186 , encodeU64 (updateFailHtlcId m) 1187 , reasonEnc 1188 , encodeTlvStream (updateFailHtlcTlvs m) 1189 ] 1190 1191 -- | Decode an UpdateFailHtlc message (type 131). 1192 decodeUpdateFailHtlc 1193 :: BS.ByteString -> Either DecodeError (UpdateFailHtlc, BS.ByteString) 1194 decodeUpdateFailHtlc !bs = do 1195 (cid, rest1) <- decodeChannelIdBytes bs 1196 (htlcId, rest2) <- maybe (Left DecodeInsufficientBytes) Right 1197 (decodeU64 rest1) 1198 (reason, rest3) <- decodeU16Bytes rest2 1199 (tlvs, rest4) <- decodeOptionalTlvs rest3 1200 let !msg = UpdateFailHtlc 1201 { updateFailHtlcChannelId = cid 1202 , updateFailHtlcId = htlcId 1203 , updateFailHtlcReason = reason 1204 , updateFailHtlcTlvs = tlvs 1205 } 1206 Right (msg, rest4) 1207 1208 -- | Encode an UpdateFailMalformedHtlc message (type 135). 1209 encodeUpdateFailMalformedHtlc :: UpdateFailMalformedHtlc -> BS.ByteString 1210 encodeUpdateFailMalformedHtlc !m = mconcat 1211 [ unChannelId (updateFailMalformedHtlcChannelId m) 1212 , encodeU64 (updateFailMalformedHtlcId m) 1213 , unPaymentHash (updateFailMalformedHtlcSha256Onion m) 1214 , encodeU16 (updateFailMalformedHtlcFailureCode m) 1215 ] 1216 1217 -- | Decode an UpdateFailMalformedHtlc message (type 135). 1218 decodeUpdateFailMalformedHtlc 1219 :: BS.ByteString -> Either DecodeError (UpdateFailMalformedHtlc, BS.ByteString) 1220 decodeUpdateFailMalformedHtlc !bs = do 1221 (cid, rest1) <- decodeChannelIdBytes bs 1222 (htlcId, rest2) <- maybe (Left DecodeInsufficientBytes) Right 1223 (decodeU64 rest1) 1224 (sha256Onion, rest3) <- decodePaymentHashBytes rest2 1225 (failCode, rest4) <- decodeU16E rest3 1226 let !msg = UpdateFailMalformedHtlc 1227 { updateFailMalformedHtlcChannelId = cid 1228 , updateFailMalformedHtlcId = htlcId 1229 , updateFailMalformedHtlcSha256Onion = sha256Onion 1230 , updateFailMalformedHtlcFailureCode = failCode 1231 } 1232 Right (msg, rest4) 1233 1234 -- | Encode a CommitmentSigned message (type 132). 1235 encodeCommitmentSigned :: CommitmentSigned -> Either EncodeError BS.ByteString 1236 encodeCommitmentSigned !m = do 1237 let !sigs = commitmentSignedHtlcSignatures m 1238 numHtlcs <- checkListCountU16 (length sigs) 1239 Right $! mconcat $ 1240 [ unChannelId (commitmentSignedChannelId m) 1241 , unSignature (commitmentSignedSignature m) 1242 , encodeU16 numHtlcs 1243 ] ++ map unSignature sigs 1244 {-# INLINABLE encodeCommitmentSigned #-} 1245 1246 -- | Decode a CommitmentSigned message (type 132). 1247 decodeCommitmentSigned 1248 :: BS.ByteString -> Either DecodeError (CommitmentSigned, BS.ByteString) 1249 decodeCommitmentSigned !bs = do 1250 (cid, rest1) <- decodeChannelIdBytes bs 1251 (sig, rest2) <- decodeSignatureBytes rest1 1252 (numHtlcs, rest3) <- decodeU16E rest2 1253 (htlcSigs, rest4) <- decodeSignatures (fromIntegral numHtlcs) rest3 1254 let !msg = CommitmentSigned 1255 { commitmentSignedChannelId = cid 1256 , commitmentSignedSignature = sig 1257 , commitmentSignedHtlcSignatures = htlcSigs 1258 } 1259 Right (msg, rest4) 1260 where 1261 decodeSignatures :: Int -> BS.ByteString 1262 -> Either DecodeError ([Signature], BS.ByteString) 1263 decodeSignatures !n !input = go n input [] 1264 where 1265 go :: Int -> BS.ByteString -> [Signature] 1266 -> Either DecodeError ([Signature], BS.ByteString) 1267 go 0 !remaining !acc = Right (reverse acc, remaining) 1268 go !count !remaining !acc = do 1269 (s, rest) <- decodeSignatureBytes remaining 1270 go (count - 1) rest (s : acc) 1271 {-# INLINABLE decodeCommitmentSigned #-} 1272 1273 -- | Encode a RevokeAndAck message (type 133). 1274 encodeRevokeAndAck :: RevokeAndAck -> BS.ByteString 1275 encodeRevokeAndAck !m = mconcat 1276 [ unChannelId (revokeAndAckChannelId m) 1277 , unSecret (revokeAndAckPerCommitmentSecret m) 1278 , unPoint (revokeAndAckNextPerCommitPoint m) 1279 ] 1280 1281 -- | Decode a RevokeAndAck message (type 133). 1282 decodeRevokeAndAck 1283 :: BS.ByteString -> Either DecodeError (RevokeAndAck, BS.ByteString) 1284 decodeRevokeAndAck !bs = do 1285 (cid, rest1) <- decodeChannelIdBytes bs 1286 (sec, rest2) <- decodeSecretBytes rest1 1287 (nextPoint, rest3) <- decodePointBytes rest2 1288 let !msg = RevokeAndAck 1289 { revokeAndAckChannelId = cid 1290 , revokeAndAckPerCommitmentSecret = sec 1291 , revokeAndAckNextPerCommitPoint = nextPoint 1292 } 1293 Right (msg, rest3) 1294 1295 -- | Encode an UpdateFee message (type 134). 1296 encodeUpdateFee :: UpdateFee -> BS.ByteString 1297 encodeUpdateFee !m = mconcat 1298 [ unChannelId (updateFeeChannelId m) 1299 , encodeU32 (updateFeeFeeratePerKw m) 1300 ] 1301 1302 -- | Decode an UpdateFee message (type 134). 1303 decodeUpdateFee 1304 :: BS.ByteString -> Either DecodeError (UpdateFee, BS.ByteString) 1305 decodeUpdateFee !bs = do 1306 (cid, rest1) <- decodeChannelIdBytes bs 1307 (feerate, rest2) <- decodeU32E rest1 1308 let !msg = UpdateFee 1309 { updateFeeChannelId = cid 1310 , updateFeeFeeratePerKw = feerate 1311 } 1312 Right (msg, rest2) 1313 1314 -- Channel reestablishment ----------------------------------------------------- 1315 1316 -- | Encode a ChannelReestablish message (type 136). 1317 encodeChannelReestablish :: ChannelReestablish -> BS.ByteString 1318 encodeChannelReestablish !m = mconcat 1319 [ unChannelId (channelReestablishChannelId m) 1320 , encodeU64 (channelReestablishNextCommitNum m) 1321 , encodeU64 (channelReestablishNextRevocationNum m) 1322 , unSecret (channelReestablishYourLastCommitSecret m) 1323 , unPoint (channelReestablishMyCurrentCommitPoint m) 1324 , encodeTlvStream (channelReestablishTlvs m) 1325 ] 1326 1327 -- | Decode a ChannelReestablish message (type 136). 1328 decodeChannelReestablish 1329 :: BS.ByteString -> Either DecodeError (ChannelReestablish, BS.ByteString) 1330 decodeChannelReestablish !bs = do 1331 (cid, rest1) <- decodeChannelIdBytes bs 1332 (nextCommit, rest2) <- maybe (Left DecodeInsufficientBytes) Right 1333 (decodeU64 rest1) 1334 (nextRevoke, rest3) <- maybe (Left DecodeInsufficientBytes) Right 1335 (decodeU64 rest2) 1336 (sec, rest4) <- decodeSecretBytes rest3 1337 (myPoint, rest5) <- decodePointBytes rest4 1338 (tlvs, rest6) <- decodeOptionalTlvs rest5 1339 let !msg = ChannelReestablish 1340 { channelReestablishChannelId = cid 1341 , channelReestablishNextCommitNum = nextCommit 1342 , channelReestablishNextRevocationNum = nextRevoke 1343 , channelReestablishYourLastCommitSecret = sec 1344 , channelReestablishMyCurrentCommitPoint = myPoint 1345 , channelReestablishTlvs = tlvs 1346 } 1347 Right (msg, rest6)