ppad-bolt8 0.0.1 → 0.1.0

raw patch · 7 files changed

+1708/−1505 lines, 7 filesdep −QuickCheckdep ~deepseqdep ~ppad-aeaddep ~ppad-hkdfPVP ok

version bump matches the API change (PVP)

Dependencies removed: QuickCheck

Dependency ranges changed: deepseq, ppad-aead, ppad-hkdf, ppad-secp256k1, ppad-sha256

API changes (from Hackage documentation)

Files

• CHANGELOG +33/−0
• bench/Fixture.hs +79/−0
• bench/Main.hs +37/−72
• bench/Weight.hs +35/−64
• lib/Lightning/Protocol/BOLT8.hs +725/−699
• ppad-bolt8.cabal +25/−13
• test/Main.hs +774/−657

@@ -0,0 +1,33 @@+# Changelog++- 0.1.0 (2026-10-10)+  * Breaking: splits the post-handshake session into separate Sender+    and Receiver states, so one state can't serve both directions and+    a reader thread and a writer thread can each own one. Every+    operation returns the next state; the docs now stress that reusing+    an old state reuses a nonce (or accepts replays).++  * Breaking: the local static key is a Keypair, so its secret and+    public halves can't be mismatched, and the handshake states are+    distinct Initiator and Responder types.++  * Breaking: frames are decrypted whole with 'decrypt', or on a+    stream with 'decrypt_header' (exactly 18 bytes) followed by+    'decrypt_body'. 'decrypt_frame', 'decrypt_frame_partial' and+    FrameResult are removed.++  * Breaking: removes unused API (Key32, SessionNonce, MessagePayload,+    HandshakeState, the public Sec type, the DecryptionFailed error)+    and the exposed Internal module, renames the InvalidKey error to+    InvalidEntropy, and drops the Generic, Show and Eq instances of+    secret-bearing types. All public types have NFData instances.++  * Fixes the key rotation docs (keys rotate every 500 messages in each+    direction), rotates keys whenever a nonce reaches 1000 or more, and+    requires ppad-aead >= 0.3.6 for constant-time MAC comparison.++  * Tests now cover every BOLT #8 Appendix A vector, including all+    handshake failure cases and the final keys on both sides.++- 0.0.1 (2026-04-18)+  * Initial release.

@@ -0,0 +1,79 @@+module Fixture (+    i_s_ent+  , i_e_ent+  , r_s_ent+  , r_e_ent+  , msg_32+  , msg_1k+  , msg_64k+  , Fixture(..)+  , fixture+  ) where++import qualified Data.ByteString as BS+import qualified Lightning.Protocol.BOLT8 as BOLT8++-- key material from BOLT #8 Appendix A+i_s_ent, i_e_ent, r_s_ent, r_e_ent :: BS.ByteString+i_s_ent = BS.replicate 32 0x11+i_e_ent = BS.replicate 32 0x12+r_s_ent = BS.replicate 32 0x21+r_e_ent = BS.replicate 32 0x22++data Fixture = Fixture {+    fx_i       :: !BOLT8.Keypair+  , fx_r       :: !BOLT8.Keypair+  , fx_msg1    :: !BS.ByteString+  , fx_i_hs    :: !BOLT8.Initiator+  , fx_msg2    :: !BS.ByteString+  , fx_r_hs    :: !BOLT8.Responder+  , fx_msg3    :: !BS.ByteString+  , fx_snd     :: !BOLT8.Sender+  , fx_snd_rot :: !BOLT8.Sender   -- its next encrypt rotates the key+  , fx_rcv     :: !BOLT8.Receiver+  , fx_ct_32   :: !BS.ByteString+  , fx_ct_1k   :: !BS.ByteString+  , fx_ct_64k  :: !BS.ByteString+  , fx_pend_1k :: !BOLT8.Pending  -- awaiting the body of fx_ct_1k+  }++fixture :: IO Fixture+fixture = do+  i <- orFail "keypair" (maybe (Left ()) Right (BOLT8.keypair i_s_ent))+  r <- orFail "keypair" (maybe (Left ()) Right (BOLT8.keypair r_s_ent))+  (msg1, i_hs) <- orFail "act1" (BOLT8.act1 i (BOLT8.keypair_pub r) i_e_ent)+  (msg2, r_hs) <- orFail "act2" (BOLT8.act2 r r_e_ent msg1)+  (msg3, i_res) <- orFail "act3" (BOLT8.act3 i_hs msg2)+  r_res <- orFail "finalize" (BOLT8.finalize r_hs msg3)+  let snd0 = BOLT8.handshake_sender i_res+      rcv0 = BOLT8.handshake_receiver r_res+  snd_rot <- advance (499 :: Int) snd0+  (ct_32, _) <- orFail "encrypt" (BOLT8.encrypt snd0 msg_32)+  (ct_1k, _) <- orFail "encrypt" (BOLT8.encrypt snd0 msg_1k)+  (ct_64k, _) <- orFail "encrypt" (BOLT8.encrypt snd0 msg_64k)+  (_, pend_1k) <- orFail "header"+    (BOLT8.decrypt_header rcv0 (BS.take 18 ct_1k))+  -- benchmark the success path, not MAC failure+  mapM_ (orFail "decrypt" . BOLT8.decrypt rcv0) [ct_32, ct_1k, ct_64k]+  pure Fixture {+      fx_i = i, fx_r = r+    , fx_msg1 = msg1, fx_i_hs = i_hs+    , fx_msg2 = msg2, fx_r_hs = r_hs+    , fx_msg3 = msg3+    , fx_snd = snd0, fx_snd_rot = snd_rot+    , fx_rcv = rcv0+    , fx_ct_32 = ct_32, fx_ct_1k = ct_1k, fx_ct_64k = ct_64k+    , fx_pend_1k = pend_1k+    }+  where+    orFail :: Show e => String -> Either e a -> IO a+    orFail msg = either (\e -> fail (msg <> ": " <> show e)) pure+    advance 0 s = pure s+    advance n s = do+      (_, s') <- orFail "encrypt" (BOLT8.encrypt s msg_32)+      advance (n - 1) s'++msg_32, msg_1k, msg_64k :: BS.ByteString+msg_32 = BS.replicate 32 0x00+msg_1k = BS.replicate 1024 0x00+msg_64k = BS.replicate 65535 0x00

@@ -1,85 +1,50 @@-{-# OPTIONS_GHC -fno-warn-incomplete-uni-patterns #-}-{-# LANGUAGE BangPatterns #-}-{-# LANGUAGE OverloadedStrings #-}- module Main where -import Control.DeepSeq import Criterion.Main import qualified Data.ByteString as BS+import Fixture import qualified Lightning.Protocol.BOLT8 as BOLT8 -instance NFData BOLT8.Pub where-  rnf p = rnf (BOLT8.serialize_pub p)--instance NFData BOLT8.Sec-instance NFData BOLT8.Error-instance NFData BOLT8.Session-instance NFData BOLT8.HandshakeState-instance NFData BOLT8.Handshake- main :: IO ()-main = defaultMain [-    keys-  , handshake-  , messages-  ]---- test keys (from BOLT #8 spec)-i_s_ent, i_e_ent, r_s_ent, r_e_ent :: BS.ByteString-i_s_ent = BS.replicate 32 0x11-i_e_ent = BS.replicate 32 0x12-r_s_ent = BS.replicate 32 0x21-r_e_ent = BS.replicate 32 0x22+main = do+  fx <- fixture+  defaultMain [+      keys fx+    , handshake fx+    , transport fx+    ] -keys :: Benchmark-keys = bgroup "keys" [+keys :: Fixture -> Benchmark+keys fx = bgroup "keys" [     bench "keypair" $ nf BOLT8.keypair i_s_ent-  , bench "parse_pub" $ nf BOLT8.parse_pub r_s_pub_bs-  , bench "serialize_pub" $ nf BOLT8.serialize_pub r_s_pub+  , bench "parse_pub" $ nf BOLT8.parse_pub pub_bs+  , bench "serialize_pub" $ nf BOLT8.serialize_pub pub   ]   where-    Just (_, r_s_pub) = BOLT8.keypair r_s_ent-    r_s_pub_bs = BOLT8.serialize_pub r_s_pub+    pub = BOLT8.keypair_pub (fx_r fx)+    pub_bs = BOLT8.serialize_pub pub -handshake :: Benchmark-handshake = env setup $ \ ~(i_s_sec, i_s_pub, r_s_sec, r_s_pub, msg1, i_hs,-                            msg2, r_hs, msg3) ->-    bgroup "handshake" [-      bench "act1" $ nf (BOLT8.act1 i_s_sec i_s_pub r_s_pub) i_e_ent-    , bench "act2" $ nf (BOLT8.act2 r_s_sec r_s_pub r_e_ent) msg1-    , bench "act3" $ nf (BOLT8.act3 i_hs) msg2-    , bench "finalize" $ nf (BOLT8.finalize r_hs) msg3-    ]-  where-    setup = do-      let Just (!i_s_sec, !i_s_pub) = BOLT8.keypair i_s_ent-          Just (!r_s_sec, !r_s_pub) = BOLT8.keypair r_s_ent-          Right (!msg1, !i_hs) = BOLT8.act1 i_s_sec i_s_pub r_s_pub i_e_ent-          Right (!msg2, !r_hs) = BOLT8.act2 r_s_sec r_s_pub r_e_ent msg1-          Right (!msg3, _) = BOLT8.act3 i_hs msg2-      pure (i_s_sec, i_s_pub, r_s_sec, r_s_pub, msg1, i_hs, msg2, r_hs, msg3)+handshake :: Fixture -> Benchmark+handshake fx = bgroup "handshake" [+    bench "act1" $+      nf (BOLT8.act1 (fx_i fx) (BOLT8.keypair_pub (fx_r fx))) i_e_ent+  , bench "act2" $ nf (BOLT8.act2 (fx_r fx) r_e_ent) (fx_msg1 fx)+  , bench "act3" $ nf (BOLT8.act3 (fx_i_hs fx)) (fx_msg2 fx)+  , bench "finalize" $ nf (BOLT8.finalize (fx_r_hs fx)) (fx_msg3 fx)+  ] -messages :: Benchmark-messages = env setup $ \ ~(i_sess, r_sess, ct_small, ct_large) ->-    bgroup "messages" [-      bench "encrypt (32B)" $ nf (BOLT8.encrypt i_sess) small_msg-    , bench "encrypt (1KB)" $ nf (BOLT8.encrypt i_sess) large_msg-    , bench "decrypt (32B)" $ nf (BOLT8.decrypt r_sess) ct_small-    , bench "decrypt (1KB)" $ nf (BOLT8.decrypt r_sess) ct_large-    ]-  where-    small_msg = BS.replicate 32 0x00-    large_msg = BS.replicate 1024 0x00-    setup = do-      let Just (!i_s_sec, !i_s_pub) = BOLT8.keypair i_s_ent-          Just (!r_s_sec, !r_s_pub) = BOLT8.keypair r_s_ent-          Right (msg1, i_hs) = BOLT8.act1 i_s_sec i_s_pub r_s_pub i_e_ent-          Right (msg2, r_hs) = BOLT8.act2 r_s_sec r_s_pub r_e_ent msg1-          Right (msg3, i_result) = BOLT8.act3 i_hs msg2-          Right r_result = BOLT8.finalize r_hs msg3-          !i_sess = BOLT8.session i_result-          !r_sess = BOLT8.session r_result-          Right (!ct_small, _) = BOLT8.encrypt i_sess small_msg-          Right (!ct_large, _) = BOLT8.encrypt i_sess large_msg-      pure (i_sess, r_sess, ct_small, ct_large)+transport :: Fixture -> Benchmark+transport fx = bgroup "transport" [+    bench "encrypt (32B)" $ nf (BOLT8.encrypt (fx_snd fx)) msg_32+  , bench "encrypt (1KB)" $ nf (BOLT8.encrypt (fx_snd fx)) msg_1k+  , bench "encrypt (64KB)" $ nf (BOLT8.encrypt (fx_snd fx)) msg_64k+  , bench "encrypt (32B, rotating)" $+      nf (BOLT8.encrypt (fx_snd_rot fx)) msg_32+  , bench "decrypt (32B)" $ nf (BOLT8.decrypt (fx_rcv fx)) (fx_ct_32 fx)+  , bench "decrypt (1KB)" $ nf (BOLT8.decrypt (fx_rcv fx)) (fx_ct_1k fx)+  , bench "decrypt (64KB)" $ nf (BOLT8.decrypt (fx_rcv fx)) (fx_ct_64k fx)+  , bench "decrypt_header" $+      nf (BOLT8.decrypt_header (fx_rcv fx)) (BS.take 18 (fx_ct_1k fx))+  , bench "decrypt_body (1KB)" $+      nf (BOLT8.decrypt_body (fx_pend_1k fx)) (BS.drop 18 (fx_ct_1k fx))+  ]

@@ -1,75 +1,46 @@-{-# OPTIONS_GHC -fno-warn-incomplete-uni-patterns #-}-{-# LANGUAGE BangPatterns #-}-{-# LANGUAGE OverloadedStrings #-}- module Main where -import Control.DeepSeq import qualified Data.ByteString as BS+import Fixture import qualified Lightning.Protocol.BOLT8 as BOLT8 import Weigh -instance NFData BOLT8.Pub where-  rnf p = rnf (BOLT8.serialize_pub p)--instance NFData BOLT8.Sec-instance NFData BOLT8.Error-instance NFData BOLT8.Session-instance NFData BOLT8.HandshakeState-instance NFData BOLT8.Handshake- -- note that 'weigh' doesn't work properly in a repl main :: IO ()-main = mainWith $ do-  keys-  handshake-  messages---- test keys (from BOLT #8 spec)-i_s_ent, i_e_ent, r_s_ent, r_e_ent :: BS.ByteString-i_s_ent = BS.replicate 32 0x11-i_e_ent = BS.replicate 32 0x12-r_s_ent = BS.replicate 32 0x21-r_e_ent = BS.replicate 32 0x22+main = do+  fx <- fixture+  mainWith $ do+    keys fx+    handshake fx+    transport fx -keys :: Weigh ()-keys =-  let Just (_, !r_s_pub) = BOLT8.keypair r_s_ent-      !r_s_pub_bs = BOLT8.serialize_pub r_s_pub-  in  wgroup "keys" $ do-        func "keypair" BOLT8.keypair i_s_ent-        func "parse_pub" BOLT8.parse_pub r_s_pub_bs-        func "serialize_pub" BOLT8.serialize_pub r_s_pub+keys :: Fixture -> Weigh ()+keys fx = wgroup "keys" $ do+    func "keypair" BOLT8.keypair i_s_ent+    func "parse_pub" BOLT8.parse_pub pub_bs+    func "serialize_pub" BOLT8.serialize_pub pub+  where+    pub = BOLT8.keypair_pub (fx_r fx)+    pub_bs = BOLT8.serialize_pub pub -handshake :: Weigh ()-handshake =-  let Just (!i_s_sec, !i_s_pub) = BOLT8.keypair i_s_ent-      Just (!r_s_sec, !r_s_pub) = BOLT8.keypair r_s_ent-      Right (!msg1, !i_hs) = BOLT8.act1 i_s_sec i_s_pub r_s_pub i_e_ent-      Right (!msg2, !r_hs) = BOLT8.act2 r_s_sec r_s_pub r_e_ent msg1-      Right (!msg3, _) = BOLT8.act3 i_hs msg2-  in  wgroup "handshake" $ do-        func "act1" (BOLT8.act1 i_s_sec i_s_pub r_s_pub) i_e_ent-        func "act2" (BOLT8.act2 r_s_sec r_s_pub r_e_ent) msg1-        func "act3" (BOLT8.act3 i_hs) msg2-        func "finalize" (BOLT8.finalize r_hs) msg3+handshake :: Fixture -> Weigh ()+handshake fx = wgroup "handshake" $ do+  func "act1"+    (BOLT8.act1 (fx_i fx) (BOLT8.keypair_pub (fx_r fx))) i_e_ent+  func "act2" (BOLT8.act2 (fx_r fx) r_e_ent) (fx_msg1 fx)+  func "act3" (BOLT8.act3 (fx_i_hs fx)) (fx_msg2 fx)+  func "finalize" (BOLT8.finalize (fx_r_hs fx)) (fx_msg3 fx) -messages :: Weigh ()-messages =-  let Just (!i_s_sec, !i_s_pub) = BOLT8.keypair i_s_ent-      Just (!r_s_sec, !r_s_pub) = BOLT8.keypair r_s_ent-      Right (msg1, i_hs) = BOLT8.act1 i_s_sec i_s_pub r_s_pub i_e_ent-      Right (msg2, r_hs) = BOLT8.act2 r_s_sec r_s_pub r_e_ent msg1-      Right (msg3, i_result) = BOLT8.act3 i_hs msg2-      Right r_result = BOLT8.finalize r_hs msg3-      !i_sess = BOLT8.session i_result-      !r_sess = BOLT8.session r_result-      !small_msg = BS.replicate 32 0x00-      !large_msg = BS.replicate 1024 0x00-      Right (!ct_small, _) = BOLT8.encrypt i_sess small_msg-      Right (!ct_large, _) = BOLT8.encrypt i_sess large_msg-  in  wgroup "messages" $ do-        func "encrypt (32B)" (BOLT8.encrypt i_sess) small_msg-        func "encrypt (1KB)" (BOLT8.encrypt i_sess) large_msg-        func "decrypt (32B)" (BOLT8.decrypt r_sess) ct_small-        func "decrypt (1KB)" (BOLT8.decrypt r_sess) ct_large+transport :: Fixture -> Weigh ()+transport fx = wgroup "transport" $ do+  func "encrypt (32B)" (BOLT8.encrypt (fx_snd fx)) msg_32+  func "encrypt (1KB)" (BOLT8.encrypt (fx_snd fx)) msg_1k+  func "encrypt (64KB)" (BOLT8.encrypt (fx_snd fx)) msg_64k+  func "encrypt (32B, rotating)" (BOLT8.encrypt (fx_snd_rot fx)) msg_32+  func "decrypt (32B)" (BOLT8.decrypt (fx_rcv fx)) (fx_ct_32 fx)+  func "decrypt (1KB)" (BOLT8.decrypt (fx_rcv fx)) (fx_ct_1k fx)+  func "decrypt (64KB)" (BOLT8.decrypt (fx_rcv fx)) (fx_ct_64k fx)+  func "decrypt_header"+    (BOLT8.decrypt_header (fx_rcv fx)) (BS.take 18 (fx_ct_1k fx))+  func "decrypt_body (1KB)"+    (BOLT8.decrypt_body (fx_pend_1k fx)) (BS.drop 18 (fx_ct_1k fx))

@@ -1,705 +1,731 @@ {-# OPTIONS_HADDOCK prune #-} {-# LANGUAGE BangPatterns #-} {-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE LambdaCase #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE RecordWildCards #-}-{-# LANGUAGE ViewPatterns #-}---- |--- Module: Lightning.Protocol.BOLT8--- Copyright: (c) 2025 Jared Tobin--- License: MIT--- Maintainer: Jared Tobin <jared@ppad.tech>------ Encrypted and authenticated transport for the Lightning Network, per--- [BOLT #8](https://github.com/lightning/bolts/blob/master/08-transport.md).------ This module implements the Noise_XK_secp256k1_ChaChaPoly_SHA256--- handshake and subsequent encrypted message transport.------ = Handshake------ A BOLT #8 handshake consists of three acts. The /initiator/ knows the--- responder's static public key in advance and initiates the connection:------ @--- (msg1, state) <- act1 i_sec i_pub r_pub entropy--- -- send msg1 (50 bytes) to responder--- -- receive msg2 (50 bytes) from responder--- (msg3, result) <- act3 state msg2--- -- send msg3 (66 bytes) to responder--- let session = 'session' result--- @------ The /responder/ receives the connection and authenticates the initiator:------ @--- -- receive msg1 (50 bytes) from initiator--- (msg2, state) <- act2 r_sec r_pub entropy msg1--- -- send msg2 (50 bytes) to initiator--- -- receive msg3 (66 bytes) from initiator--- result <- finalize state msg3--- let session = 'session' result--- @------ = Message Transport------ After a successful handshake, use 'encrypt' and 'decrypt' to exchange--- messages. Each returns an updated 'Session' that must be used for the--- next operation (keys rotate every 1000 messages):------ @--- -- sender--- (ciphertext, session') <- 'encrypt' session plaintext------ -- receiver--- (plaintext, session') <- 'decrypt' session ciphertext--- @------ = Message Framing------ BOLT #8 runs over a byte stream, so callers often need to deal with--- partial buffers. Use 'decrypt_frame' when you have exactly one frame,--- or 'decrypt_frame_partial' to handle incremental reads and return how--- many bytes are still needed.------ Maximum plaintext size is 65535 bytes.--module Lightning.Protocol.BOLT8 (-    -- * Keys-    Sec-  , Pub-  , keypair-  , parse_pub-  , serialize_pub--    -- * Handshake (initiator)-  , act1-  , act3--    -- * Handshake (responder)-  , act2-  , finalize--    -- * Session-  , Session-  , HandshakeState-  , Handshake(..)-  , encrypt-  , decrypt-  , decrypt_frame-  , decrypt_frame_partial-  , FrameResult(..)--    -- * Errors-  , Error(..)-  ) where--import Control.Monad (guard, unless)-import qualified Crypto.AEAD.ChaCha20Poly1305 as AEAD-import qualified Crypto.Curve.Secp256k1 as Secp256k1-import qualified Crypto.Hash.SHA256 as SHA256-import qualified Crypto.KDF.HMAC as HKDF-import Data.Bits (unsafeShiftR, (.&.))-import qualified Data.ByteString as BS-import Data.Word (Word16, Word64)-import GHC.Generics (Generic)---- types ------------------------------------------------------------------------- | Secret key (32 bytes).-newtype Sec = Sec BS.ByteString-  deriving (Eq, Generic)---- | Compressed public key.-newtype Pub = Pub Secp256k1.Projective--instance Eq Pub where-  (Pub a) == (Pub b) =-    Secp256k1.serialize_point a == Secp256k1.serialize_point b--instance Show Pub where-  show (Pub p) = "Pub " ++ show (Secp256k1.serialize_point p)---- | Handshake errors.-data Error =-    InvalidKey-  | InvalidPub-  | InvalidMAC-  | InvalidVersion-  | InvalidLength-  | DecryptionFailed-  deriving (Eq, Show, Generic)---- | Result of attempting to decrypt a frame from a partial buffer.-data FrameResult =-    NeedMore {-# UNPACK #-} !Int-    -- ^ More bytes needed; the 'Int' is the minimum additional bytes required.-  | FrameOk !BS.ByteString !BS.ByteString !Session-    -- ^ Successfully decrypted: plaintext, remainder, updated session.-  | FrameError !Error-    -- ^ Decryption failed with the given error.-  deriving Generic---- | Post-handshake session state.-data Session = Session {-    sess_sk  :: {-# UNPACK #-} !BS.ByteString  -- ^ send key (32 bytes)-  , sess_sn  :: {-# UNPACK #-} !Word64         -- ^ send nonce-  , sess_sck :: {-# UNPACK #-} !BS.ByteString  -- ^ send chaining key-  , sess_rk  :: {-# UNPACK #-} !BS.ByteString  -- ^ receive key (32 bytes)-  , sess_rn  :: {-# UNPACK #-} !Word64         -- ^ receive nonce-  , sess_rck :: {-# UNPACK #-} !BS.ByteString  -- ^ receive chaining key-  }-  deriving Generic---- | Result of a successful handshake.-data Handshake = Handshake {-    session       :: !Session  -- ^ session state-  , remote_static :: !Pub      -- ^ authenticated remote static pubkey-  }-  deriving Generic---- | Internal handshake state (exported for benchmarking).-data HandshakeState = HandshakeState {-    hs_h      :: {-# UNPACK #-} !BS.ByteString  -- handshake hash (32 bytes)-  , hs_ck     :: {-# UNPACK #-} !BS.ByteString  -- chaining key (32 bytes)-  , hs_temp_k :: {-# UNPACK #-} !BS.ByteString  -- temp key (32 bytes)-  , hs_e_sec  :: !Sec                           -- ephemeral secret-  , hs_e_pub  :: !Pub                           -- ephemeral public-  , hs_s_sec  :: !Sec                           -- static secret-  , hs_s_pub  :: !Pub                           -- static public-  , hs_re     :: !(Maybe Pub)                   -- remote ephemeral-  , hs_rs     :: !(Maybe Pub)                   -- remote static-  }-  deriving Generic---- protocol constants ----------------------------------------------------------_PROTOCOL_NAME :: BS.ByteString-_PROTOCOL_NAME = "Noise_XK_secp256k1_ChaChaPoly_SHA256"--_PROLOGUE :: BS.ByteString-_PROLOGUE = "lightning"---- key operations ---------------------------------------------------------------- | Derive a keypair from 32 bytes of entropy.------   Returns Nothing if the entropy is invalid (zero or >= curve order).------   >>> let ent = BS.replicate 32 0x11---   >>> case keypair ent of { Just _ -> "ok"; Nothing -> "fail" }---   "ok"---   >>> keypair (BS.replicate 31 0x11) -- wrong length---   Nothing-keypair :: BS.ByteString -> Maybe (Sec, Pub)-keypair ent = do-  guard (BS.length ent == 32)-  k <- Secp256k1.parse_int256 ent-  p <- Secp256k1.derive_pub k-  pure (Sec ent, Pub p)---- | Parse a 33-byte compressed public key.------   >>> let Just (_, pub) = keypair (BS.replicate 32 0x11)---   >>> let bytes = serialize_pub pub---   >>> case parse_pub bytes of { Just _ -> "ok"; Nothing -> "fail" }---   "ok"---   >>> parse_pub (BS.replicate 32 0x00) -- wrong length---   Nothing-parse_pub :: BS.ByteString -> Maybe Pub-parse_pub bs = do-  guard (BS.length bs == 33)-  p <- Secp256k1.parse_point bs-  pure (Pub p)---- | Serialize a public key to 33-byte compressed form.------   >>> let Just (_, pub) = keypair (BS.replicate 32 0x11)---   >>> BS.length (serialize_pub pub)---   33-serialize_pub :: Pub -> BS.ByteString-serialize_pub (Pub p) = Secp256k1.serialize_point p---- cryptographic primitives ------------------------------------------------------ bolt8-style ECDH-ecdh :: Sec -> Pub -> Maybe BS.ByteString-ecdh (Sec sec) (Pub pub) = do-  k <- Secp256k1.parse_int256 sec-  pt <- Secp256k1.mul pub k-  let compressed = Secp256k1.serialize_point pt-  pure (SHA256.hash compressed)---- h' = SHA256(h || data)-mix_hash :: BS.ByteString -> BS.ByteString -> BS.ByteString-mix_hash h dat = SHA256.hash (h <> dat)---- Mix key: (ck', k) = HKDF(ck, input_key_material)------ NB HKDF limits output to 255 * hashlen bytes. For SHA256 that's 8160,--- well above the 64 bytes requested here, so 'Nothing' is impossible.-mix_key :: BS.ByteString -> BS.ByteString -> (BS.ByteString, BS.ByteString)-mix_key ck ikm = case HKDF.derive hmac ck mempty 64 ikm of-    Nothing -> error "ppad-bolt8: internal error, please report a bug!"-    Just output -> BS.splitAt 32 output-  where-    hmac k b = case SHA256.hmac k b of-      SHA256.MAC mac -> mac---- Encrypt with associated data using ChaCha20-Poly1305-encrypt_with_ad-  :: BS.ByteString       -- ^ key (32 bytes)-  -> Word64              -- ^ nonce-  -> BS.ByteString       -- ^ associated data-  -> BS.ByteString       -- ^ plaintext-  -> Maybe BS.ByteString -- ^ ciphertext || mac (16 bytes)-encrypt_with_ad key n ad pt =-  case AEAD.encrypt ad key (encode_nonce n) pt of-    Left _ -> Nothing-    Right (ct, mac) -> Just (ct <> mac)---- Decrypt with associated data using ChaCha20-Poly1305-decrypt_with_ad-  :: BS.ByteString       -- ^ key (32 bytes)-  -> Word64              -- ^ nonce-  -> BS.ByteString       -- ^ associated data-  -> BS.ByteString       -- ^ ciphertext || mac-  -> Maybe BS.ByteString -- ^ plaintext-decrypt_with_ad key n ad ctmac-  | BS.length ctmac < 16 = Nothing-  | otherwise =-      let (ct, mac) = BS.splitAt (BS.length ctmac - 16) ctmac-      in case AEAD.decrypt ad key (encode_nonce n) (ct, mac) of-           Left _ -> Nothing-           Right pt -> Just pt---- Encode nonce as 96-bit value: 4 zero bytes + 8-byte little-endian-encode_nonce :: Word64 -> BS.ByteString-encode_nonce n = BS.replicate 4 0x00 <> encode_le64 n---- Little-endian 64-bit encoding-encode_le64 :: Word64 -> BS.ByteString-encode_le64 n = BS.pack [-    fi (n .&. 0xff)-  , fi (unsafeShiftR n 8  .&. 0xff)-  , fi (unsafeShiftR n 16 .&. 0xff)-  , fi (unsafeShiftR n 24 .&. 0xff)-  , fi (unsafeShiftR n 32 .&. 0xff)-  , fi (unsafeShiftR n 40 .&. 0xff)-  , fi (unsafeShiftR n 48 .&. 0xff)-  , fi (unsafeShiftR n 56 .&. 0xff)-  ]---- Big-endian 16-bit encoding-encode_be16 :: Word16 -> BS.ByteString-encode_be16 n = BS.pack [fi (unsafeShiftR n 8), fi (n .&. 0xff)]---- Big-endian 16-bit decoding-decode_be16 :: BS.ByteString -> Maybe Word16-decode_be16 bs-  | BS.length bs /= 2 = Nothing-  | otherwise =-      let !b0 = BS.index bs 0-          !b1 = BS.index bs 1-      in Just (fi b0 * 0x100 + fi b1)---- handshake --------------------------------------------------------------------- Initialize handshake state------ h = SHA256(protocol_name)--- ck = h--- h = SHA256(h || prologue)--- h = SHA256(h || responder_static_pubkey)-init_handshake-  :: Sec                -- ^ local static secret-  -> Pub                -- ^ local static public-  -> Sec                -- ^ ephemeral secret-  -> Pub                -- ^ ephemeral public-  -> Maybe Pub          -- ^ remote static (initiator knows, responder doesn't)-  -> Bool               -- ^ True if initiator-  -> HandshakeState-init_handshake s_sec s_pub e_sec e_pub m_rs is_initiator =-  let !h0 = SHA256.hash _PROTOCOL_NAME-      !ck = h0-      !h1 = mix_hash h0 _PROLOGUE-      -- Mix in responder's static pubkey-      !h2 = case (is_initiator, m_rs) of-        (True, Just rs)  -> mix_hash h1 (serialize_pub rs)-        (False, Nothing) -> mix_hash h1 (serialize_pub s_pub)-        _ -> h1  -- shouldn't happen-  in HandshakeState {-       hs_h      = h2-     , hs_ck     = ck-     , hs_temp_k = BS.replicate 32 0x00-     , hs_e_sec  = e_sec-     , hs_e_pub  = e_pub-     , hs_s_sec  = s_sec-     , hs_s_pub  = s_pub-     , hs_re     = Nothing-     , hs_rs     = m_rs-     }---- | Initiator: generate Act 1 message (50 bytes).------   Takes local static key, remote static pubkey, and 32 bytes of---   entropy for ephemeral key generation.------   Returns the 50-byte Act 1 message and handshake state for Act 3.------   >>> let Just (i_sec, i_pub) = keypair (BS.replicate 32 0x11)---   >>> let Just (r_sec, r_pub) = keypair (BS.replicate 32 0x21)---   >>> let eph_ent = BS.replicate 32 0x12---   >>> case act1 i_sec i_pub r_pub eph_ent of { Right (msg, _) -> BS.length msg; Left _ -> 0 }---   50-act1-  :: Sec                -- ^ local static secret-  -> Pub                -- ^ local static public-  -> Pub                -- ^ remote static public (responder's)-  -> BS.ByteString      -- ^ 32 bytes entropy for ephemeral-  -> Either Error (BS.ByteString, HandshakeState)-act1 s_sec s_pub rs ent = do-  (e_sec, e_pub) <- note InvalidKey (keypair ent)-  let !hs0 = init_handshake s_sec s_pub e_sec e_pub (Just rs) True-      !e_pub_bytes = serialize_pub e_pub-      !h1 = mix_hash (hs_h hs0) e_pub_bytes-  es <- note InvalidKey (ecdh e_sec rs)-  let !(ck1, temp_k1) = mix_key (hs_ck hs0) es-  c <- note InvalidMAC (encrypt_with_ad temp_k1 0 h1 BS.empty)-  let !h2 = mix_hash h1 c-      !msg = BS.singleton 0x00 <> e_pub_bytes <> c-      !hs1 = hs0 {-        hs_h      = h2-      , hs_ck     = ck1-      , hs_temp_k = temp_k1-      }-  pure (msg, hs1)---- | Responder: process Act 1 and generate Act 2 message (50 bytes).------   Takes local static key and 32 bytes of entropy for ephemeral key,---   plus the 50-byte Act 1 message from initiator.------   Returns the 50-byte Act 2 message and handshake state for finalize.------   >>> let Just (i_sec, i_pub) = keypair (BS.replicate 32 0x11)---   >>> let Just (r_sec, r_pub) = keypair (BS.replicate 32 0x21)---   >>> let Right (msg1, _) = act1 i_sec i_pub r_pub (BS.replicate 32 0x12)---   >>> case act2 r_sec r_pub (BS.replicate 32 0x22) msg1 of { Right (msg, _) -> BS.length msg; Left _ -> 0 }---   50-act2-  :: Sec                -- ^ local static secret-  -> Pub                -- ^ local static public-  -> BS.ByteString      -- ^ 32 bytes entropy for ephemeral-  -> BS.ByteString      -- ^ Act 1 message (50 bytes)-  -> Either Error (BS.ByteString, HandshakeState)-act2 s_sec s_pub ent msg1 = do-  require (BS.length msg1 == 50) InvalidLength-  let !version = BS.index msg1 0-      !re_bytes = BS.take 33 (BS.drop 1 msg1)-      !c = BS.drop 34 msg1-  require (version == 0x00) InvalidVersion-  re <- note InvalidPub (parse_pub re_bytes)-  (e_sec, e_pub) <- note InvalidKey (keypair ent)-  let !hs0 = init_handshake s_sec s_pub e_sec e_pub Nothing False-      !h1 = mix_hash (hs_h hs0) re_bytes-  es <- note InvalidKey (ecdh s_sec re)-  let !(ck1, temp_k1) = mix_key (hs_ck hs0) es-  _ <- note InvalidMAC (decrypt_with_ad temp_k1 0 h1 c)-  let !h2 = mix_hash h1 c-      !e_pub_bytes = serialize_pub e_pub-      !h3 = mix_hash h2 e_pub_bytes-  ee <- note InvalidKey (ecdh e_sec re)-  let !(ck2, temp_k2) = mix_key ck1 ee-  c2 <- note InvalidMAC (encrypt_with_ad temp_k2 0 h3 BS.empty)-  let !h4 = mix_hash h3 c2-      !msg = BS.singleton 0x00 <> e_pub_bytes <> c2-      !hs1 = hs0 {-        hs_h      = h4-      , hs_ck     = ck2-      , hs_temp_k = temp_k2-      , hs_re     = Just re-      }-  pure (msg, hs1)---- | Initiator: process Act 2 and generate Act 3 (66 bytes), completing---   the handshake.------   Returns the 66-byte Act 3 message and the handshake result.------   >>> let Just (i_sec, i_pub) = keypair (BS.replicate 32 0x11)---   >>> let Just (r_sec, r_pub) = keypair (BS.replicate 32 0x21)---   >>> let Right (msg1, i_hs) = act1 i_sec i_pub r_pub (BS.replicate 32 0x12)---   >>> let Right (msg2, _) = act2 r_sec r_pub (BS.replicate 32 0x22) msg1---   >>> case act3 i_hs msg2 of { Right (msg, _) -> BS.length msg; Left _ -> 0 }---   66-act3-  :: HandshakeState     -- ^ state after Act 1-  -> BS.ByteString      -- ^ Act 2 message (50 bytes)-  -> Either Error (BS.ByteString, Handshake)-act3 hs msg2 = do-  require (BS.length msg2 == 50) InvalidLength-  let !version = BS.index msg2 0-      !re_bytes = BS.take 33 (BS.drop 1 msg2)-      !c = BS.drop 34 msg2-  require (version == 0x00) InvalidVersion-  re <- note InvalidPub (parse_pub re_bytes)-  let !h1 = mix_hash (hs_h hs) re_bytes-  ee <- note InvalidKey (ecdh (hs_e_sec hs) re)-  let !(ck1, temp_k2) = mix_key (hs_ck hs) ee-  _ <- note InvalidMAC (decrypt_with_ad temp_k2 0 h1 c)-  let !h2 = mix_hash h1 c-      !s_pub_bytes = serialize_pub (hs_s_pub hs)-  c3 <- note InvalidMAC (encrypt_with_ad temp_k2 1 h2 s_pub_bytes)-  let !h3 = mix_hash h2 c3-  se <- note InvalidKey (ecdh (hs_s_sec hs) re)-  let !(ck2, temp_k3) = mix_key ck1 se-  t <- note InvalidMAC (encrypt_with_ad temp_k3 0 h3 BS.empty)-  let !(sk, rk) = mix_key ck2 BS.empty-      !msg = BS.singleton 0x00 <> c3 <> t-      !sess = Session {-        sess_sk  = sk-      , sess_sn  = 0-      , sess_sck = ck2-      , sess_rk  = rk-      , sess_rn  = 0-      , sess_rck = ck2-      }-  rs <- note InvalidPub (hs_rs hs)-  let !result = Handshake {-        session       = sess-      , remote_static = rs-      }-  pure (msg, result)---- | Responder: process Act 3 (66 bytes) and complete the handshake.------   Returns the handshake result with authenticated remote static pubkey.------   >>> let Just (i_sec, i_pub) = keypair (BS.replicate 32 0x11)---   >>> let Just (r_sec, r_pub) = keypair (BS.replicate 32 0x21)---   >>> let Right (msg1, i_hs) = act1 i_sec i_pub r_pub (BS.replicate 32 0x12)---   >>> let Right (msg2, r_hs) = act2 r_sec r_pub (BS.replicate 32 0x22) msg1---   >>> let Right (msg3, _) = act3 i_hs msg2---   >>> case finalize r_hs msg3 of { Right _ -> "ok"; Left e -> show e }---   "ok"-finalize-  :: HandshakeState     -- ^ state after Act 2-  -> BS.ByteString      -- ^ Act 3 message (66 bytes)-  -> Either Error Handshake-finalize hs msg3 = do-  require (BS.length msg3 == 66) InvalidLength-  let !version = BS.index msg3 0-      !c = BS.take 49 (BS.drop 1 msg3)-      !t = BS.drop 50 msg3-  require (version == 0x00) InvalidVersion-  rs_bytes <- note InvalidMAC (decrypt_with_ad (hs_temp_k hs) 1 (hs_h hs) c)-  rs <- note InvalidPub (parse_pub rs_bytes)-  let !h1 = mix_hash (hs_h hs) c-  se <- note InvalidKey (ecdh (hs_e_sec hs) rs)-  let !(ck1, temp_k3) = mix_key (hs_ck hs) se-  _ <- note InvalidMAC (decrypt_with_ad temp_k3 0 h1 t)-  -- responder swaps order (receives what initiator sends)-  let !(rk, sk) = mix_key ck1 BS.empty-      !sess = Session {-        sess_sk  = sk-      , sess_sn  = 0-      , sess_sck = ck1-      , sess_rk  = rk-      , sess_rn  = 0-      , sess_rck = ck1-      }-      !result = Handshake {-        session       = sess-      , remote_static = rs-      }-  pure result---- message encryption ------------------------------------------------------------ | Encrypt a message (max 65535 bytes).------   Returns the encrypted packet and updated session. Key rotation---   is handled automatically at nonce 1000.------   Wire format: encrypted_length (2) || MAC (16) || encrypted_body || MAC (16)------   >>> let Just (i_sec, i_pub) = keypair (BS.replicate 32 0x11)---   >>> let Just (r_sec, r_pub) = keypair (BS.replicate 32 0x21)---   >>> let Right (msg1, i_hs) = act1 i_sec i_pub r_pub (BS.replicate 32 0x12)---   >>> let Right (msg2, _) = act2 r_sec r_pub (BS.replicate 32 0x22) msg1---   >>> let Right (_, i_result) = act3 i_hs msg2---   >>> let sess = session i_result---   >>> case encrypt sess "hello" of { Right (ct, _) -> BS.length ct; Left _ -> 0 }---   39-encrypt-  :: Session-  -> BS.ByteString          -- ^ plaintext (max 65535 bytes)-  -> Either Error (BS.ByteString, Session)-encrypt sess pt = do-  let !len = BS.length pt-  require (len <= 65535) InvalidLength-  let !len_bytes = encode_be16 (fi len)-  lc <- note InvalidMAC (encrypt_with_ad (sess_sk sess) (sess_sn sess)-                           BS.empty len_bytes)-  let !(sn1, sck1, sk1) = step_nonce (sess_sn sess) (sess_sck sess) (sess_sk sess)-  bc <- note InvalidMAC (encrypt_with_ad sk1 sn1 BS.empty pt)-  let !(sn2, sck2, sk2) = step_nonce sn1 sck1 sk1-      !packet = lc <> bc-      !sess' = sess {-        sess_sk  = sk2-      , sess_sn  = sn2-      , sess_sck = sck2-      }-  pure (packet, sess')---- | Decrypt a message, requiring an exact packet with no trailing bytes.------   Returns the plaintext and updated session. Key rotation---   is handled automatically at nonce 1000.------   This is a strict variant that rejects any trailing data. For---   streaming use cases where you need to handle multiple frames in a---   buffer, use 'decrypt_frame' instead.------   >>> let Just (i_sec, i_pub) = keypair (BS.replicate 32 0x11)---   >>> let Just (r_sec, r_pub) = keypair (BS.replicate 32 0x21)---   >>> let Right (msg1, i_hs) = act1 i_sec i_pub r_pub (BS.replicate 32 0x12)---   >>> let Right (msg2, r_hs) = act2 r_sec r_pub (BS.replicate 32 0x22) msg1---   >>> let Right (msg3, i_result) = act3 i_hs msg2---   >>> let Right r_result = finalize r_hs msg3---   >>> let Right (ct, _) = encrypt (session i_result) "hello"---   >>> case decrypt (session r_result) ct of { Right (pt, _) -> pt; Left _ -> "fail" }---   "hello"-decrypt-  :: Session-  -> BS.ByteString          -- ^ encrypted packet (exact length required)-  -> Either Error (BS.ByteString, Session)-decrypt sess packet = do-  (pt, remainder, sess') <- decrypt_frame sess packet-  require (BS.null remainder) InvalidLength-  pure (pt, sess')---- | Decrypt a single frame from a buffer, returning the remainder.------   Returns the plaintext, any unconsumed bytes, and the updated session.---   Key rotation is handled automatically every 1000 messages.------   This is useful for streaming scenarios where multiple messages may---   be buffered together. The remainder can be passed to the next call---   to 'decrypt_frame'.------   Wire format consumed: encrypted_length (18) || encrypted_body (len + 16)------   >>> let Just (i_sec, i_pub) = keypair (BS.replicate 32 0x11)---   >>> let Just (r_sec, r_pub) = keypair (BS.replicate 32 0x21)---   >>> let Right (msg1, i_hs) = act1 i_sec i_pub r_pub (BS.replicate 32 0x12)---   >>> let Right (msg2, r_hs) = act2 r_sec r_pub (BS.replicate 32 0x22) msg1---   >>> let Right (msg3, i_result) = act3 i_hs msg2---   >>> let Right r_result = finalize r_hs msg3---   >>> let Right (ct, _) = encrypt (session i_result) "hello"---   >>> case decrypt_frame (session r_result) ct of { Right (pt, rem, _) -> (pt, BS.null rem); Left _ -> ("fail", False) }---   ("hello",True)-decrypt_frame-  :: Session-  -> BS.ByteString          -- ^ buffer containing at least one encrypted frame-  -> Either Error (BS.ByteString, BS.ByteString, Session)-decrypt_frame sess packet = do-  require (BS.length packet >= 34) InvalidLength-  let !lc = BS.take 18 packet-      !rest = BS.drop 18 packet-  len_bytes <- note InvalidMAC (decrypt_with_ad (sess_rk sess) (sess_rn sess)-                                  BS.empty lc)-  len <- note InvalidLength (decode_be16 len_bytes)-  let !(rn1, rck1, rk1) = step_nonce (sess_rn sess) (sess_rck sess) (sess_rk sess)-      !body_len = fi len + 16-  require (BS.length rest >= body_len) InvalidLength-  let !bc = BS.take body_len rest-      !remainder = BS.drop body_len rest-  pt <- note InvalidMAC (decrypt_with_ad rk1 rn1 BS.empty bc)-  let !(rn2, rck2, rk2) = step_nonce rn1 rck1 rk1-      !sess' = sess {-        sess_rk  = rk2-      , sess_rn  = rn2-      , sess_rck = rck2-      }-  pure (pt, remainder, sess')---- | Decrypt a frame from a partial buffer, indicating when more data needed.------   Unlike 'decrypt_frame', this function handles incomplete buffers---   gracefully by returning 'NeedMore' with the number of additional---   bytes required to make progress.------   * If the buffer has fewer than 18 bytes (encrypted length + MAC),---     returns @'NeedMore' n@ where @n@ is the bytes still needed.---   * If the length header is complete but the body is incomplete,---     returns @'NeedMore' n@ with bytes needed for the full frame.---   * MAC or decryption failures return 'FrameError'.---   * A complete, valid frame returns 'FrameOk' with plaintext,---     remainder, and updated session.------   This is useful for non-blocking I/O where data arrives incrementally.-decrypt_frame_partial-  :: Session-  -> BS.ByteString  -- ^ buffer (possibly incomplete)-  -> FrameResult-decrypt_frame_partial sess buf-  | buflen < 18 = NeedMore (18 - buflen)-  | otherwise =-      let !lc = BS.take 18 buf-          !rest = BS.drop 18 buf-      in case decrypt_with_ad (sess_rk sess) (sess_rn sess) BS.empty lc of-           Nothing -> FrameError InvalidMAC-           Just len_bytes -> case decode_be16 len_bytes of-             Nothing -> FrameError InvalidLength-             Just len ->-               let !body_len = fi len + 16-                   !(rn1, rck1, rk1) = step_nonce (sess_rn sess)-                                        (sess_rck sess) (sess_rk sess)-               in if BS.length rest < body_len-                    then NeedMore (body_len - BS.length rest)-                    else-                      let !bc = BS.take body_len rest-                          !remainder = BS.drop body_len rest-                      in case decrypt_with_ad rk1 rn1 BS.empty bc of-                           Nothing -> FrameError InvalidMAC-                           Just pt ->-                             let !(rn2, rck2, rk2) = step_nonce rn1 rck1 rk1-                                 !sess' = sess {-                                   sess_rk  = rk2-                                 , sess_rn  = rn2-                                 , sess_rck = rck2-                                 }-                             in FrameOk pt remainder sess'-  where-    !buflen = BS.length buf---- key rotation ------------------------------------------------------------------ Key rotation occurs after nonce reaches 1000 (i.e., before using 1000)--- (ck', k') = HKDF(ck, k), reset nonce to 0-step_nonce-  :: Word64-  -> BS.ByteString-  -> BS.ByteString-  -> (Word64, BS.ByteString, BS.ByteString)-step_nonce n ck k-  | n + 1 == 1000 =-      let !(ck', k') = mix_key ck k-      in (0, ck', k')-  | otherwise = (n + 1, ck, k)---- utilities --------------------------------------------------------------------- Lift Maybe to Either-note :: e -> Maybe a -> Either e a-note e = maybe (Left e) Right-{-# INLINE note #-}---- Require condition or fail+{-# LANGUAGE OverloadedStrings #-}++-- |+-- Module: Lightning.Protocol.BOLT8+-- Copyright: (c) 2025 Jared Tobin+-- License: MIT+-- Maintainer: Jared Tobin <jared@ppad.tech>+--+-- Encrypted and authenticated transport for the Lightning Network, per+-- [BOLT #8](https://github.com/lightning/bolts/blob/master/08-transport.md):+-- the @Noise_XK_secp256k1_ChaChaPoly_SHA256@ handshake, followed by+-- length-prefixed, authenticated encryption of messages.+--+-- The library is pure; reading from and writing to the network is up+-- to the caller.+--+-- = Handshake+--+-- The /initiator/ knows the responder's static public key in advance.+-- It sends act one ('act1'), receives act two, and replies with act+-- three ('act3'). The /responder/ receives act one, replies with act two+-- ('act2'), and receives act three ('finalize'), which authenticates+-- the initiator's static key. Both sides end up with a t'Handshake'.+--+-- >>> :set -XOverloadedStrings+-- >>> import qualified Data.ByteString as BS+-- >>> let Just i = keypair (BS.replicate 32 0x11)+-- >>> let Just r = keypair (BS.replicate 32 0x21)+-- >>> -- initiator, knowing r's public key; entropy must be random!+-- >>> let Right (msg1, i_hs) = act1 i (keypair_pub r) (BS.replicate 32 0x12)+-- >>> -- responder+-- >>> let Right (msg2, r_hs) = act2 r (BS.replicate 32 0x22) msg1+-- >>> -- initiator+-- >>> let Right (msg3, i_res) = act3 i_hs msg2+-- >>> -- responder+-- >>> let Right r_res = finalize r_hs msg3+-- >>> handshake_remote_static r_res == keypair_pub i+-- True+--+-- = Transport+--+-- A t'Handshake' carries a t'Sender' for outgoing messages and a+-- t'Receiver' for incoming ones. They are independent, so a writer+-- thread can own the t'Sender' and a reader thread the t'Receiver'.+--+-- >>> let Right (ct, i_snd) = encrypt (handshake_sender i_res) "hello"+-- >>> fmap fst (decrypt (handshake_receiver r_res) ct)+-- Right "hello"+--+-- On a byte stream, read exactly 18 bytes and pass them to+-- 'decrypt_header', which returns the number of bytes to read next;+-- then read exactly that many bytes and pass them to 'decrypt_body'.+-- 'decrypt' does both for a buffer holding exactly one frame.+--+-- Keys rotate every 1000 nonces, i.e. every 500 messages in each+-- direction; this is handled internally. Messages are at most 65535+-- bytes.+--+-- = Security+--+-- * __Use each state exactly once.__ Every function that takes an+--   t'Initiator', t'Responder', t'Sender', t'Receiver' or t'Pending'+--   returns the next state, and the caller must continue with that.+--   States are ordinary immutable values, so nothing stops an old one+--   from being used again, and doing so is catastrophic: encrypting+--   twice with the same t'Sender' reuses a nonce, which reveals the XOR+--   of the two plaintexts and allows forgeries, and decrypting with an+--   old t'Receiver' accepts replayed frames.+--+-- * __Ephemeral entropy must be fresh.__ The 32 bytes passed to 'act1'+--   and 'act2' are used directly as the ephemeral secret key. They+--   must come from a cryptographically secure random source, be+--   uniformly random, and never be reused.+--+-- * __Any error is fatal.__ BOLT #8 requires terminating the+--   connection on any handshake or transport failure. Don't retry with+--   the previous state. The one exception is 'encrypt' rejecting an+--   oversized message, which advances nothing.++module Lightning.Protocol.BOLT8 (+    -- * Keys+    Keypair+  , keypair+  , keypair_pub+  , Pub+  , parse_pub+  , serialize_pub++    -- * Handshake+  , Handshake+  , handshake_sender+  , handshake_receiver+  , handshake_remote_static++    -- ** Initiator+  , Initiator+  , act1+  , act3++    -- ** Responder+  , Responder+  , act2+  , finalize++    -- * Transport+  , Sender+  , encrypt+  , Receiver+  , decrypt+  , Pending+  , decrypt_header+  , decrypt_body++    -- * Errors+  , Error(..)+  ) where++import Control.DeepSeq (NFData(..))+import Control.Monad (guard, unless)+import qualified Crypto.AEAD.ChaCha20Poly1305 as AEAD+import qualified Crypto.Curve.Secp256k1 as Secp256k1+import qualified Crypto.Hash.SHA256 as SHA256+import qualified Crypto.KDF.HMAC as HKDF+import Data.Bits (unsafeShiftR, (.&.))+import qualified Data.ByteString as BS+import qualified Data.ByteString.Unsafe as BU+import Data.Word (Word8, Word16, Word64)+import GHC.Generics (Generic)++-- keys -----------------------------------------------------------------------++-- A secret key: 32 bytes encoding a valid secp256k1 scalar.+newtype Sec = Sec BS.ByteString++-- | A secp256k1 public key.+--+--   'Show' renders the 33-byte compressed encoding in hex.+newtype Pub = Pub Secp256k1.Projective++instance Eq Pub where+  Pub a == Pub b =+    Secp256k1.serialize_point a == Secp256k1.serialize_point b++instance Show Pub where+  showsPrec d p = showParen (d > 10) $+    showString "Pub " . shows (hex (serialize_pub p))++instance NFData Pub where+  rnf (Pub p) = p `seq` ()++-- | A secp256k1 keypair: a secret key and its public key.+--+--   Has no 'Show' or 'Eq' instance, as it contains secret material.+data Keypair = Keypair !Sec !Pub++instance NFData Keypair where+  rnf (Keypair (Sec s) p) = s `seq` rnf p++-- | Construct a keypair from a 32-byte secret key.+--+--   The bytes are used directly as the secret key, so they must be+--   uniformly random and kept secret. Returns 'Nothing' if the input+--   is not 32 bytes, or is not a valid secp256k1 secret key (zero, or+--   not less than the curve order).+--+--   >>> import Data.Maybe (isJust)+--   >>> isJust (keypair (BS.replicate 32 0x11))+--   True+--   >>> isJust (keypair (BS.replicate 32 0x00))+--   False+keypair :: BS.ByteString -> Maybe Keypair+keypair sec = do+  guard (BS.length sec == 32)+  k <- Secp256k1.parse_int256 sec+  p <- Secp256k1.derive_pub k+  pure $! Keypair (Sec sec) (Pub p)++-- | The public key of a keypair.+--+--   >>> let Just r = keypair (BS.replicate 32 0x21)+--   >>> keypair_pub r+--   Pub "028d7500dd4c12685d1f568b4c2b5048e8534b873319f3a8daa612b469132ec7f7"+keypair_pub :: Keypair -> Pub+keypair_pub (Keypair _ p) = p++-- | Parse a 33-byte compressed public key.+--+--   >>> let Just r = keypair (BS.replicate 32 0x21)+--   >>> parse_pub (serialize_pub (keypair_pub r)) == Just (keypair_pub r)+--   True+--   >>> parse_pub (BS.replicate 33 0x04)+--   Nothing+parse_pub :: BS.ByteString -> Maybe Pub+parse_pub bs = do+  guard (BS.length bs == 33)+  p <- Secp256k1.parse_point bs+  pure (Pub p)++-- | Serialize a public key in 33-byte compressed form.+--+--   >>> let Just r = keypair (BS.replicate 32 0x21)+--   >>> BS.length (serialize_pub (keypair_pub r))+--   33+serialize_pub :: Pub -> BS.ByteString+serialize_pub (Pub p) = Secp256k1.serialize_point p++-- handshake state ------------------------------------------------------------++-- | The initiator's handshake state between acts one and three.+--+--   Produced by 'act1' and consumed by 'act3'. Contains secret+--   material; use it once.+data Initiator = Initiator+  {-# UNPACK #-} !BS.ByteString -- handshake hash+  {-# UNPACK #-} !BS.ByteString -- chaining key+  !Sec                          -- ephemeral secret+  !Keypair                      -- local static keypair+  !Pub                          -- remote static public key++instance NFData Initiator where+  rnf (Initiator h ck (Sec e) s rs) =+    h `seq` ck `seq` e `seq` rnf s `seq` rnf rs++-- | The responder's handshake state between acts two and three.+--+--   Produced by 'act2' and consumed by 'finalize'. Contains secret+--   material; use it once.+data Responder = Responder+  {-# UNPACK #-} !BS.ByteString -- handshake hash+  {-# UNPACK #-} !BS.ByteString -- chaining key+  {-# UNPACK #-} !BS.ByteString -- temp_k2+  !Sec                          -- ephemeral secret++instance NFData Responder where+  rnf (Responder h ck k (Sec e)) = h `seq` ck `seq` k `seq` e `seq` ()++-- | The result of a successful handshake: the initial transport+--   states and the remote party's authenticated static public key.+--+--   Take the t'Sender' and t'Receiver' out once, right after the+--   handshake, and don't keep the t'Handshake' around: it always yields+--   the /initial/ states, and encrypting with the initial t'Sender'+--   a second time reuses a nonce.+data Handshake = Handshake !Sender !Receiver !Pub++instance NFData Handshake where+  rnf (Handshake s r p) = rnf s `seq` rnf r `seq` rnf p++-- | The initial t'Sender', for encrypting outgoing messages.+--+--   Call this once per handshake. Every call returns the same initial+--   state, so encrypting with the result of a second call reuses a+--   nonce.+handshake_sender :: Handshake -> Sender+handshake_sender (Handshake s _ _) = s++-- | The initial t'Receiver', for decrypting incoming messages.+--+--   Call this once per handshake. Every call returns the same initial+--   state, so decrypting with the result of a second call accepts+--   replayed frames.+handshake_receiver :: Handshake -> Receiver+handshake_receiver (Handshake _ r _) = r++-- | The remote party's static public key, authenticated by the+--   handshake. For the initiator, this is the key passed to 'act1'.+handshake_remote_static :: Handshake -> Pub+handshake_remote_static (Handshake _ _ p) = p++-- transport state ------------------------------------------------------------++-- One direction's cipher state.+data Cipher = Cipher+  {-# UNPACK #-} !BS.ByteString -- key+  {-# UNPACK #-} !Word64        -- nonce, always < 1000+  {-# UNPACK #-} !BS.ByteString -- chaining key++instance NFData Cipher where+  rnf (Cipher k n ck) = k `seq` n `seq` ck `seq` ()++-- | State for encrypting outgoing messages.+--+--   Each 'encrypt' returns the next t'Sender'. Never use a t'Sender'+--   twice: doing so reuses a nonce.+newtype Sender = Sender Cipher++instance NFData Sender where+  rnf (Sender c) = rnf c++-- | State for decrypting incoming messages.+--+--   Each 'decrypt' or 'decrypt_header' consumes the t'Receiver'.+--   Never use a t'Receiver' twice: doing so accepts replayed frames.+newtype Receiver = Receiver Cipher++instance NFData Receiver where+  rnf (Receiver c) = rnf c++-- | A t'Receiver' that has decrypted a frame header and awaits the+--   frame body.+--+--   Produced by 'decrypt_header' and consumed by 'decrypt_body'. Use+--   it once.+data Pending = Pending {-# UNPACK #-} !Int !Cipher++instance NFData Pending where+  rnf (Pending n c) = n `seq` rnf c++-- errors ---------------------------------------------------------------------++-- | Handshake and transport errors.+--+--   Any error is fatal for the connection.+data Error =+    InvalidEntropy+    -- ^ ephemeral entropy is not a valid secret key+  | InvalidLength+    -- ^ input of the wrong length, or a payload over 65535 bytes+  | InvalidVersion+    -- ^ unknown handshake version+  | InvalidPub+    -- ^ invalid public key in a handshake message+  | InvalidMAC+    -- ^ authentication failed+  deriving (Eq, Show, Generic)++instance NFData Error++-- protocol constants ---------------------------------------------------------++_PROTOCOL_NAME :: BS.ByteString+_PROTOCOL_NAME = "Noise_XK_secp256k1_ChaChaPoly_SHA256"++_PROLOGUE :: BS.ByteString+_PROLOGUE = "lightning"++-- cryptographic primitives ---------------------------------------------------++-- ECDH as specified by BOLT #8: SHA256 of the compressed shared point.+--+-- 'Nothing' is unreachable for a valid secret key and a parsed point.+ecdh :: Sec -> Pub -> Maybe BS.ByteString+ecdh (Sec sec) (Pub pub) = do+  k <- Secp256k1.parse_int256 sec+  pt <- Secp256k1.mul pub k+  pure (SHA256.hash (Secp256k1.serialize_point pt))++-- h' = SHA256(h || dat)+mix_hash :: BS.ByteString -> BS.ByteString -> BS.ByteString+mix_hash h dat = SHA256.hash (h <> dat)++-- (ck', k) = HKDF(ck, ikm), with ck as salt and empty info.+--+-- HKDF limits output to 255 * hashlen bytes (8160 for SHA256), so+-- 'Nothing' is impossible for the 64 bytes requested here.+mix_key+  :: BS.ByteString+  -> BS.ByteString+  -> (BS.ByteString, BS.ByteString)+mix_key ck ikm =+  case HKDF.derive hmac ck mempty 64 ikm of+    Nothing ->+      error "ppad-bolt8: internal error, please report a bug!"+    Just output -> BS.splitAt 32 output+  where+    hmac k b = case SHA256.hmac k b of+      SHA256.MAC mac -> mac++-- ChaCha20-Poly1305 encryption, returning ciphertext || MAC.+--+-- Keys are always 32 bytes (halves of HKDF output), nonces always 12+-- bytes, and plaintexts at most 65535 bytes (far below the ChaCha20+-- counter limit), so encryption cannot fail.+encrypt_with_ad+  :: BS.ByteString -- ^ key (32 bytes)+  -> Word64        -- ^ nonce+  -> BS.ByteString -- ^ associated data+  -> BS.ByteString -- ^ plaintext+  -> BS.ByteString+encrypt_with_ad key n ad pt =+  case AEAD.encrypt ad key (encode_nonce n) pt of+    Left _ ->+      error "ppad-bolt8: internal error, please report a bug!"+    Right (ct, mac) -> ct <> mac++-- ChaCha20-Poly1305 decryption of ciphertext || MAC.+decrypt_with_ad+  :: BS.ByteString       -- ^ key (32 bytes)+  -> Word64              -- ^ nonce+  -> BS.ByteString       -- ^ associated data+  -> BS.ByteString       -- ^ ciphertext || mac+  -> Maybe BS.ByteString -- ^ plaintext+decrypt_with_ad key n ad ctmac+  | BS.length ctmac < 16 = Nothing+  | otherwise =+      let (ct, mac) = BS.splitAt (BS.length ctmac - 16) ctmac+      in  case AEAD.decrypt ad key (encode_nonce n) (ct, mac) of+            Left _   -> Nothing+            Right pt -> Just pt++-- 96-bit nonce: 4 zero bytes followed by the 64-bit nonce, little-endian+encode_nonce :: Word64 -> BS.ByteString+encode_nonce n = BS.replicate 4 0x00 <> BS.pack [+    fi n+  , fi (unsafeShiftR n 8)+  , fi (unsafeShiftR n 16)+  , fi (unsafeShiftR n 24)+  , fi (unsafeShiftR n 32)+  , fi (unsafeShiftR n 40)+  , fi (unsafeShiftR n 48)+  , fi (unsafeShiftR n 56)+  ]++-- big-endian 16-bit encoding+encode_be16 :: Word16 -> BS.ByteString+encode_be16 n = BS.pack [fi (unsafeShiftR n 8), fi n]++-- big-endian 16-bit decoding of exactly two bytes+decode_be16 :: BS.ByteString -> Maybe Word16+decode_be16 bs+  | BS.length bs /= 2 = Nothing+  | otherwise =+      let !b0 = BU.unsafeIndex bs 0+          !b1 = BU.unsafeIndex bs 1+      in  Just (fi b0 * 0x100 + fi b1)++-- handshake ------------------------------------------------------------------++-- Initial (h, ck), given the responder's static public key:+--+--   h = SHA256(protocol_name); ck = h+--   h = SHA256(h || prologue)+--   h = SHA256(h || rs.pub)+initial_state :: Pub -> (BS.ByteString, BS.ByteString)+initial_state rs =+  let !h0 = SHA256.hash _PROTOCOL_NAME+      !h1 = mix_hash h0 _PROLOGUE+      !h2 = mix_hash h1 (serialize_pub rs)+  in  (h2, h0)++-- Split a 50-byte act one or act two message into its ephemeral public+-- key and MAC, checking length and version.+parse_act :: BS.ByteString -> Either Error (BS.ByteString, BS.ByteString)+parse_act msg = do+  require (BS.length msg == 50) InvalidLength+  require (BU.unsafeHead msg == 0x00) InvalidVersion+  let !(e, c) = BS.splitAt 33 (BU.unsafeTail msg)+  pure (e, c)++-- | Initiator: produce act one (50 bytes).+--+--   Takes the local static keypair, the responder's static public key,+--   and 32 bytes of entropy for the ephemeral key. Returns act one and+--   the state for 'act3'.+--+--   The entropy is used directly as the ephemeral secret key. It must+--   be fresh, uniformly random output of a cryptographically secure+--   random source, and must never be reused. Fails with+--   'InvalidEntropy' if it is not a valid secret key.+--+--   >>> let Just i = keypair (BS.replicate 32 0x11)+--   >>> let Just r = keypair (BS.replicate 32 0x21)+--   >>> let ent = BS.replicate 32 0x12 -- use random bytes in practice+--   >>> fmap (BS.length . fst) (act1 i (keypair_pub r) ent)+--   Right 50+act1+  :: Keypair       -- ^ local static keypair+  -> Pub           -- ^ responder's static public key+  -> BS.ByteString -- ^ 32 bytes of fresh entropy+  -> Either Error (BS.ByteString, Initiator)+act1 s rs ent = do+  Keypair e_sec e_pub <- note InvalidEntropy (keypair ent)+  let !(h0, ck0) = initial_state rs+      !e_bytes = serialize_pub e_pub+      !h1 = mix_hash h0 e_bytes+  es <- note InvalidPub (ecdh e_sec rs)+  let !(ck1, temp_k1) = mix_key ck0 es+      !c = encrypt_with_ad temp_k1 0 h1 BS.empty+      !h2 = mix_hash h1 c+      !msg = BS.cons 0x00 (e_bytes <> c)+  pure (msg, Initiator h2 ck1 e_sec s rs)++-- | Responder: process act one and produce act two (50 bytes).+--+--   Takes the local static keypair, 32 bytes of entropy for the+--   ephemeral key, and act one. Returns act two and the state for+--   'finalize'.+--+--   The entropy is used directly as the ephemeral secret key. It must+--   be fresh, uniformly random output of a cryptographically secure+--   random source, and must never be reused. Fails with+--   'InvalidEntropy' if it is not a valid secret key.+--+--   Any error means the connection must be terminated.+--+--   >>> let Just i = keypair (BS.replicate 32 0x11)+--   >>> let Just r = keypair (BS.replicate 32 0x21)+--   >>> let Right (msg1, _) = act1 i (keypair_pub r) (BS.replicate 32 0x12)+--   >>> fmap (BS.length . fst) (act2 r (BS.replicate 32 0x22) msg1)+--   Right 50+--   >>> fmap fst (act2 r (BS.replicate 32 0x22) (BS.take 49 msg1))+--   Left InvalidLength+act2+  :: Keypair       -- ^ local static keypair+  -> BS.ByteString -- ^ 32 bytes of fresh entropy+  -> BS.ByteString -- ^ act one+  -> Either Error (BS.ByteString, Responder)+act2 (Keypair s_sec s_pub) ent msg1 = do+  (re_bytes, c) <- parse_act msg1+  re <- note InvalidPub (parse_pub re_bytes)+  Keypair e_sec e_pub <- note InvalidEntropy (keypair ent)+  let !(h0, ck0) = initial_state s_pub+      !h1 = mix_hash h0 re_bytes+  es <- note InvalidPub (ecdh s_sec re)+  let !(ck1, temp_k1) = mix_key ck0 es+  _ <- note InvalidMAC (decrypt_with_ad temp_k1 0 h1 c)+  let !h2 = mix_hash h1 c+      !e_bytes = serialize_pub e_pub+      !h3 = mix_hash h2 e_bytes+  ee <- note InvalidPub (ecdh e_sec re)+  let !(ck2, temp_k2) = mix_key ck1 ee+      !c2 = encrypt_with_ad temp_k2 0 h3 BS.empty+      !h4 = mix_hash h3 c2+      !msg = BS.cons 0x00 (e_bytes <> c2)+  pure (msg, Responder h4 ck2 temp_k2 e_sec)++-- | Initiator: process act two and produce act three (66 bytes),+--   completing the handshake.+--+--   Any error means the connection must be terminated.+--+--   Continuing the module-level example:+--+--   >>> fmap (BS.length . fst) (act3 i_hs msg2)+--   Right 66+act3+  :: Initiator     -- ^ state from 'act1'+  -> BS.ByteString -- ^ act two+  -> Either Error (BS.ByteString, Handshake)+act3 (Initiator h ck e_sec (Keypair s_sec s_pub) rs) msg2 = do+  (re_bytes, c) <- parse_act msg2+  re <- note InvalidPub (parse_pub re_bytes)+  let !h1 = mix_hash h re_bytes+  ee <- note InvalidPub (ecdh e_sec re)+  let !(ck1, temp_k2) = mix_key ck ee+  _ <- note InvalidMAC (decrypt_with_ad temp_k2 0 h1 c)+  let !h2 = mix_hash h1 c+      !c3 = encrypt_with_ad temp_k2 1 h2 (serialize_pub s_pub)+      !h3 = mix_hash h2 c3+  se <- note InvalidPub (ecdh s_sec re)+  let !(ck2, temp_k3) = mix_key ck1 se+      !t = encrypt_with_ad temp_k3 0 h3 BS.empty+      !(sk, rk) = mix_key ck2 BS.empty+      !msg = BS.cons 0x00 (c3 <> t)+      !hs = Handshake (Sender (Cipher sk 0 ck2))+                      (Receiver (Cipher rk 0 ck2)) rs+  pure (msg, hs)++-- | Responder: process act three, completing the handshake and+--   authenticating the initiator's static public key.+--+--   Any error means the connection must be terminated.+--+--   Continuing the module-level example:+--+--   >>> let Right r_res' = finalize r_hs msg3+--   >>> handshake_remote_static r_res' == keypair_pub i+--   True+finalize+  :: Responder     -- ^ state from 'act2'+  -> BS.ByteString -- ^ act three+  -> Either Error Handshake+finalize (Responder h ck temp_k2 e_sec) msg3 = do+  require (BS.length msg3 == 66) InvalidLength+  require (BU.unsafeHead msg3 == 0x00) InvalidVersion+  let !(c, t) = BS.splitAt 49 (BU.unsafeTail msg3)+  rs_bytes <- note InvalidMAC (decrypt_with_ad temp_k2 1 h c)+  rs <- note InvalidPub (parse_pub rs_bytes)+  let !h1 = mix_hash h c+  se <- note InvalidPub (ecdh e_sec rs)+  let !(ck1, temp_k3) = mix_key ck se+  _ <- note InvalidMAC (decrypt_with_ad temp_k3 0 h1 t)+  let !(rk, sk) = mix_key ck1 BS.empty+  pure (Handshake (Sender (Cipher sk 0 ck1)) (Receiver (Cipher rk 0 ck1)) rs)++-- transport ------------------------------------------------------------------++-- Encrypt under the current key and nonce, then advance.+seal :: Cipher -> BS.ByteString -> (BS.ByteString, Cipher)+seal c@(Cipher k n _) pt =+  let !ct = encrypt_with_ad k n BS.empty pt+  in  (ct, step c)++-- Decrypt under the current key and nonce, then advance.+open :: Cipher -> BS.ByteString -> Maybe (BS.ByteString, Cipher)+open c@(Cipher k n _) ct = do+  pt <- decrypt_with_ad k n BS.empty ct+  pure (pt, step c)++-- Increment the nonce, rotating the key once it reaches 1000:+--+--   (ck', k') = HKDF(ck, k), n' = 0+step :: Cipher -> Cipher+step (Cipher k n ck)+  | n' >= 1000 =+      let !(ck', k') = mix_key ck k+      in  Cipher k' 0 ck'+  | otherwise = Cipher k n' ck+  where+    !n' = n + 1++-- | Encrypt a message of at most 65535 bytes.+--+--   Returns the frame to send (the message length plus 34 bytes) and+--   the next t'Sender', which must be used for the following message.+--   Encrypting with the same t'Sender' twice reuses a nonce and breaks+--   confidentiality and authenticity.+--+--   Fails only with 'InvalidLength', for an oversized message. Nothing+--   is encrypted in that case, so the given t'Sender' remains the+--   current one and the connection can continue.+--+--   Continuing the module-level example:+--+--   >>> fmap (BS.length . fst) (encrypt i_snd "hello")+--   Right 39+--   >>> fmap fst (encrypt i_snd (BS.replicate 65536 0x00))+--   Left InvalidLength+encrypt+  :: Sender        -- ^ current state+  -> BS.ByteString -- ^ message+  -> Either Error (BS.ByteString, Sender)+encrypt (Sender c0) m = do+  let !len = BS.length m+  require (len <= 65535) InvalidLength+  let !(lc, c1) = seal c0 (encode_be16 (fi len))+      !(bc, c2) = seal c1 m+  pure (lc <> bc, Sender c2)++-- | Decrypt a buffer holding exactly one frame.+--+--   Returns the message and the next t'Receiver'. Fails with+--   'InvalidLength' if the buffer is not exactly one frame, and with+--   'InvalidMAC' if authentication fails. Any error means the+--   connection must be terminated.+--+--   Continuing the module-level example:+--+--   >>> fmap fst (decrypt (handshake_receiver r_res) ct)+--   Right "hello"+--   >>> fmap fst (decrypt (handshake_receiver r_res) (BS.take 38 ct))+--   Left InvalidLength+decrypt+  :: Receiver      -- ^ current state+  -> BS.ByteString -- ^ one frame+  -> Either Error (BS.ByteString, Receiver)+decrypt r frame = do+  let !(lc, c) = BS.splitAt 18 frame+  (_, p) <- decrypt_header r lc+  decrypt_body p c++-- | Decrypt the 18-byte header (encrypted length and its MAC) at the+--   start of a frame.+--+--   Returns the number of bytes in the rest of the frame (the message+--   length plus a 16-byte MAC), which the caller should read exactly,+--   and the state for 'decrypt_body'. Fails with 'InvalidLength' if+--   the input is not 18 bytes, and with 'InvalidMAC' if+--   authentication fails. Any error means the connection must be+--   terminated.+--+--   Continuing the module-level example:+--+--   >>> fmap fst (decrypt_header (handshake_receiver r_res) (BS.take 18 ct))+--   Right 21+decrypt_header+  :: Receiver      -- ^ current state+  -> BS.ByteString -- ^ 18-byte header+  -> Either Error (Int, Pending)+decrypt_header (Receiver c0) lc = do+  require (BS.length lc == 18) InvalidLength+  (l, c1) <- note InvalidMAC (open c0 lc)+  len <- note InvalidLength (decode_be16 l)+  let !body = fi len + 16+  pure (body, Pending body c1)++-- | Decrypt the rest of a frame, following 'decrypt_header'.+--+--   The input must be exactly as long as 'decrypt_header' reported.+--   Returns the message and the next t'Receiver'. Fails with+--   'InvalidLength' on a length mismatch, and with 'InvalidMAC' if+--   authentication fails. Any error means the connection must be+--   terminated.+--+--   Continuing the module-level example:+--+--   >>> let (hdr, rest) = BS.splitAt 18 ct+--   >>> let Right (n, p) = decrypt_header (handshake_receiver r_res) hdr+--   >>> fmap fst (decrypt_body p (BS.take n rest))+--   Right "hello"+decrypt_body+  :: Pending       -- ^ state from 'decrypt_header'+  -> BS.ByteString -- ^ the rest of the frame+  -> Either Error (BS.ByteString, Receiver)+decrypt_body (Pending body c1) c = do+  require (BS.length c == body) InvalidLength+  (m, c2) <- note InvalidMAC (open c1 c)+  pure (m, Receiver c2)++-- utilities ------------------------------------------------------------------++-- lowercase hex encoding+hex :: BS.ByteString -> String+hex = BS.foldr (\w acc -> nibble (unsafeShiftR w 4) : nibble (w .&. 15) : acc)+  []+  where+    nibble :: Word8 -> Char+    nibble n+      | n < 10    = toEnum (fi n + 0x30)+      | otherwise = toEnum (fi n + 0x57)++note :: e -> Maybe a -> Either e a+note e = maybe (Left e) Right+{-# INLINE note #-}+ require :: Bool -> e -> Either e () require cond e = unless cond (Left e) {-# INLINE require #-}

@@ -1,6 +1,6 @@ cabal-version:      3.0 name:               ppad-bolt8-version:            0.0.1+version:            0.1.0 synopsis:           Encrypted and authenticated transport per BOLT #8 license:            MIT license-file:       LICENSE@@ -8,30 +8,40 @@ maintainer:         jared@ppad.tech category:           Cryptography build-type:         Simple-tested-with:        GHC == 9.10.3+tested-with:        GHC == { 9.10.3 } extra-doc-files:    CHANGELOG description:-  Encrypted and authenticated transport, per-  [BOLT #8](https://github.com/lightning/bolts/blob/master/08-transport.md).+  Encrypted and authenticated transport for the Lightning Network, per+  [BOLT #8](https://github.com/lightning/bolts/blob/master/08-transport.md):+  the Noise_XK_secp256k1_ChaChaPoly_SHA256 handshake and message+  transport with key rotation.  source-repository head   type:     git   location: git.ppad.tech/bolt8.git +flag llvm+  description: Use GHC's LLVM backend.+  default:     False+  manual:      True+ library   default-language: Haskell2010   hs-source-dirs:   lib   ghc-options:       -Wall+  if flag(llvm)+    ghc-options: -fllvm -O2   exposed-modules:       Lightning.Protocol.BOLT8   build-depends:       base >= 4.9 && < 5     , bytestring >= 0.9 && < 0.13-    , ppad-aead >= 0.3 && < 0.4+    , deepseq >= 1.4 && < 1.6+    , ppad-aead >= 0.3.6 && < 0.4     , ppad-hkdf >= 0.3.2 && < 0.4-    , ppad-secp256k1 >= 0.5.3 && < 0.6-    , ppad-sha256 >= 0.3 && < 0.4+    , ppad-secp256k1 >= 0.5.8 && < 0.6+    , ppad-sha256 >= 0.3.2 && < 0.4  test-suite bolt8-tests   type:                exitcode-stdio-1.0@@ -40,14 +50,16 @@   main-is:             Main.hs    ghc-options:-    -rtsopts -Wall -O2+    -rtsopts -Wall    build-depends:       base     , bytestring+    , ppad-aead     , ppad-base16     , ppad-bolt8-    , QuickCheck+    , ppad-hkdf+    , ppad-sha256     , tasty     , tasty-hunit     , tasty-quickcheck@@ -57,15 +69,15 @@   default-language:    Haskell2010   hs-source-dirs:      bench   main-is:             Main.hs+  other-modules:       Fixture    ghc-options:-    -rtsopts -O2 -Wall -fno-warn-orphans+    -rtsopts -O2 -Wall    build-depends:       base     , bytestring     , criterion-    , deepseq     , ppad-bolt8  benchmark bolt8-weigh@@ -73,14 +85,14 @@   default-language:    Haskell2010   hs-source-dirs:      bench   main-is:             Weight.hs+  other-modules:       Fixture    ghc-options:-    -rtsopts -O2 -Wall -fno-warn-orphans+    -rtsopts -O2 -Wall    build-depends:       base     , bytestring-    , deepseq     , ppad-bolt8     , weigh 

@@ -1,657 +1,774 @@-{-# LANGUAGE LambdaCase #-}-{-# LANGUAGE OverloadedStrings #-}--module Main where--import Data.Bits (xor)-import qualified Data.ByteString as BS-import qualified Data.ByteString.Base16 as B16-import qualified Lightning.Protocol.BOLT8 as BOLT8-import Test.Tasty-import Test.Tasty.HUnit-import Test.Tasty.QuickCheck (Gen, Property, choose, forAll, testProperty,-                              vectorOf)---- test helpers -------------------------------------------------------------------- | Extract a Just value or fail the test.-expectJust :: String -> Maybe a -> IO a-expectJust msg = \case-  Nothing -> assertFailure msg >> error "unreachable"-  Just a  -> pure a---- | Extract a Right value or fail the test.-expectRight :: Show e => String -> Either e a -> IO a-expectRight msg = \case-  Left e  -> assertFailure (msg ++ ": " ++ show e) >> error "unreachable"-  Right a -> pure a--main :: IO ()-main = defaultMain $ testGroup "ppad-bolt8" [-    handshake_tests-  , message_tests-  , framing_tests-  , partial_framing_tests-  , negative_tests-  , property_tests-  ]---- test vectors from BOLT #8 specification --------------------------------------- initiator static private key-initiator_s_priv :: BS.ByteString-initiator_s_priv = hex-  "1111111111111111111111111111111111111111111111111111111111111111"---- initiator ephemeral private key-initiator_e_priv :: BS.ByteString-initiator_e_priv = hex-  "1212121212121212121212121212121212121212121212121212121212121212"---- responder static private key-responder_s_priv :: BS.ByteString-responder_s_priv = hex-  "2121212121212121212121212121212121212121212121212121212121212121"---- responder static public key (known to initiator)-responder_s_pub :: BS.ByteString-responder_s_pub = hex-  "028d7500dd4c12685d1f568b4c2b5048e8534b873319f3a8daa612b469132ec7f7"---- responder ephemeral private key-responder_e_priv :: BS.ByteString-responder_e_priv = hex-  "2222222222222222222222222222222222222222222222222222222222222222"---- expected act 1 message-expected_act1 :: BS.ByteString-expected_act1 = hex-  "00036360e856310ce5d294e8be33fc807077dc56ac80d95d9cd4ddbd21325eff73f7\-  \0df6086551151f58b8afe6c195782c6a"---- expected act 2 message-expected_act2 :: BS.ByteString-expected_act2 = hex-  "0002466d7fcae563e5cb09a0d1870bb580344804617879a14949cf22285f1bae3f27\-  \6e2470b93aac583c9ef6eafca3f730ae"---- expected act 3 message-expected_act3 :: BS.ByteString-expected_act3 = hex-  "00b9e3a702e93e3a9948c2ed6e5fd7590a6e1c3a0344cfc9d5b57357049aa22355\-  \361aa02e55a8fc28fef5bd6d71ad0c38228dc68b1c466263b47fdf31e560e139ba"---- handshake tests -------------------------------------------------------------handshake_tests :: TestTree-handshake_tests = testGroup "Handshake" [-    testCase "act1 matches spec vector" test_act1-  , testCase "act2 matches spec vector" test_act2-  , testCase "act3 matches spec vector" test_act3-  , testCase "full handshake round-trip" test_full_handshake-  ]--test_act1 :: Assertion-test_act1 = do-  (i_s_sec, i_s_pub) <- expectJust "initiator keypair"-                          (BOLT8.keypair initiator_s_priv)-  rs <- expectJust "responder pub" (BOLT8.parse_pub responder_s_pub)-  (act1_msg, _) <- expectRight "act1" (BOLT8.act1 i_s_sec i_s_pub rs-                                        initiator_e_priv)-  act1_msg @?= expected_act1--test_act2 :: Assertion-test_act2 = do-  (i_s_sec, i_s_pub) <- expectJust "initiator keypair"-                          (BOLT8.keypair initiator_s_priv)-  (r_s_sec, r_s_pub) <- expectJust "responder keypair"-                          (BOLT8.keypair responder_s_priv)-  rs <- expectJust "responder pub" (BOLT8.parse_pub responder_s_pub)-  (msg1, _) <- expectRight "act1" (BOLT8.act1 i_s_sec i_s_pub rs-                                    initiator_e_priv)-  (msg2, _) <- expectRight "act2" (BOLT8.act2 r_s_sec r_s_pub responder_e_priv-                                    msg1)-  msg2 @?= expected_act2--test_act3 :: Assertion-test_act3 = do-  (i_s_sec, i_s_pub) <- expectJust "initiator keypair"-                          (BOLT8.keypair initiator_s_priv)-  (r_s_sec, r_s_pub) <- expectJust "responder keypair"-                          (BOLT8.keypair responder_s_priv)-  rs <- expectJust "responder pub" (BOLT8.parse_pub responder_s_pub)-  (msg1, i_hs) <- expectRight "act1" (BOLT8.act1 i_s_sec i_s_pub rs-                                       initiator_e_priv)-  (msg2, _) <- expectRight "act2" (BOLT8.act2 r_s_sec r_s_pub responder_e_priv-                                    msg1)-  (msg3, _) <- expectRight "act3" (BOLT8.act3 i_hs msg2)-  msg3 @?= expected_act3--test_full_handshake :: Assertion-test_full_handshake = do-  (i_s_sec, i_s_pub) <- expectJust "initiator keypair"-                          (BOLT8.keypair initiator_s_priv)-  (r_s_sec, r_s_pub) <- expectJust "responder keypair"-                          (BOLT8.keypair responder_s_priv)-  rs <- expectJust "responder pub" (BOLT8.parse_pub responder_s_pub)-  (msg1, i_hs) <- expectRight "act1" (BOLT8.act1 i_s_sec i_s_pub rs-                                       initiator_e_priv)-  (msg2, r_hs) <- expectRight "act2" (BOLT8.act2 r_s_sec r_s_pub responder_e_priv-                                       msg1)-  (msg3, i_result) <- expectRight "act3" (BOLT8.act3 i_hs msg2)-  r_result <- expectRight "finalize" (BOLT8.finalize r_hs msg3)-  BOLT8.remote_static i_result @?= r_s_pub-  BOLT8.remote_static r_result @?= i_s_pub---- message encryption tests ----------------------------------------------------message_tests :: TestTree-message_tests = testGroup "Message Encryption" [-    testCase "message 0 matches spec" test_message_0-  , testCase "message 1 matches spec" test_message_1-  , testCase "message 500 matches spec" test_message_500-  , testCase "message 501 matches spec" test_message_501-  , testCase "message 1000 matches spec" test_message_1000-  , testCase "message 1001 matches spec" test_message_1001-  , testCase "decrypt round-trip" test_decrypt_roundtrip-  ]---- "hello" = 0x68656c6c6f-hello :: BS.ByteString-hello = "hello"---- expected encrypted messages-expected_msg_0 :: BS.ByteString-expected_msg_0 = hex-  "cf2b30ddf0cf3f80e7c35a6e6730b59fe802473180f396d88a8fb0db8cbcf25d\-  \2f214cf9ea1d95"--expected_msg_1 :: BS.ByteString-expected_msg_1 = hex-  "72887022101f0b6753e0c7de21657d35a4cb2a1f5cde2650528bbc8f837d0f0d\-  \7ad833b1a256a1"--expected_msg_500 :: BS.ByteString-expected_msg_500 = hex-  "178cb9d7387190fa34db9c2d50027d21793c9bc2d40b1e14dcf30ebeeeb220f4\-  \8364f7a4c68bf8"--expected_msg_501 :: BS.ByteString-expected_msg_501 = hex-  "1b186c57d44eb6de4c057c49940d79bb838a145cb528d6e8fd26dbe50a60ca2c\-  \104b56b60e45bd"--expected_msg_1000 :: BS.ByteString-expected_msg_1000 = hex-  "4a2f3cc3b5e78ddb83dcb426d9863d9d9a723b0337c89dd0b005d89f8d3c05c5\-  \2b76b29b740f09"--expected_msg_1001 :: BS.ByteString-expected_msg_1001 = hex-  "2ecd8c8a5629d0d02ab457a0fdd0f7b90a192cd46be5ecb6ca570bfc5e268338\-  \b1a16cf4ef2d36"---- helper to get initiator session after handshake-get_initiator_session :: IO BOLT8.Session-get_initiator_session = do-  (i_s_sec, i_s_pub) <- expectJust "initiator keypair"-                          (BOLT8.keypair initiator_s_priv)-  (r_s_sec, r_s_pub) <- expectJust "responder keypair"-                          (BOLT8.keypair responder_s_priv)-  rs <- expectJust "responder pub" (BOLT8.parse_pub responder_s_pub)-  (msg1, i_hs) <- expectRight "act1" (BOLT8.act1 i_s_sec i_s_pub rs-                                       initiator_e_priv)-  (msg2, _) <- expectRight "act2" (BOLT8.act2 r_s_sec r_s_pub responder_e_priv-                                    msg1)-  (_, result) <- expectRight "act3" (BOLT8.act3 i_hs msg2)-  pure (BOLT8.session result)---- encrypt N messages, return Nth ciphertext-encrypt_n :: Int -> BOLT8.Session -> IO BS.ByteString-encrypt_n n sess0 = go 0 sess0-  where-    go i sess-      | i == n = case BOLT8.encrypt sess hello of-          Left err -> fail $ "encrypt failed at " ++ show i ++ ": " ++ show err-          Right (ct, _) -> pure ct-      | otherwise = case BOLT8.encrypt sess hello of-          Left err -> fail $ "encrypt failed at " ++ show i ++ ": " ++ show err-          Right (_, sess') -> go (i + 1) sess'--test_message_0 :: Assertion-test_message_0 = do-  sess <- get_initiator_session-  ct <- encrypt_n 0 sess-  ct @?= expected_msg_0--test_message_1 :: Assertion-test_message_1 = do-  sess <- get_initiator_session-  ct <- encrypt_n 1 sess-  ct @?= expected_msg_1--test_message_500 :: Assertion-test_message_500 = do-  sess <- get_initiator_session-  ct <- encrypt_n 500 sess-  ct @?= expected_msg_500--test_message_501 :: Assertion-test_message_501 = do-  sess <- get_initiator_session-  ct <- encrypt_n 501 sess-  ct @?= expected_msg_501--test_message_1000 :: Assertion-test_message_1000 = do-  sess <- get_initiator_session-  ct <- encrypt_n 1000 sess-  ct @?= expected_msg_1000--test_message_1001 :: Assertion-test_message_1001 = do-  sess <- get_initiator_session-  ct <- encrypt_n 1001 sess-  ct @?= expected_msg_1001--test_decrypt_roundtrip :: Assertion-test_decrypt_roundtrip = do-  (i_s_sec, i_s_pub) <- expectJust "initiator keypair"-                          (BOLT8.keypair initiator_s_priv)-  (r_s_sec, r_s_pub) <- expectJust "responder keypair"-                          (BOLT8.keypair responder_s_priv)-  rs <- expectJust "responder pub" (BOLT8.parse_pub responder_s_pub)-  (msg1, i_hs) <- expectRight "act1" (BOLT8.act1 i_s_sec i_s_pub rs-                                       initiator_e_priv)-  (msg2, r_hs) <- expectRight "act2" (BOLT8.act2 r_s_sec r_s_pub responder_e_priv-                                       msg1)-  (msg3, i_result) <- expectRight "act3" (BOLT8.act3 i_hs msg2)-  r_result <- expectRight "finalize" (BOLT8.finalize r_hs msg3)-  let i_sess = BOLT8.session i_result-      r_sess = BOLT8.session r_result-  (ct, _) <- expectRight "encrypt" (BOLT8.encrypt i_sess hello)-  (pt, _) <- expectRight "decrypt" (BOLT8.decrypt r_sess ct)-  pt @?= hello---- framing tests ---------------------------------------------------------------framing_tests :: TestTree-framing_tests = testGroup "Packet Framing" [-    testCase "decrypt rejects trailing bytes" test_decrypt_trailing-  , testCase "decrypt_frame returns remainder" test_decrypt_frame_remainder-  , testCase "decrypt_frame handles multiple frames" test_decrypt_frame_multi-  ]--test_decrypt_trailing :: Assertion-test_decrypt_trailing = do-  (i_s_sec, i_s_pub) <- expectJust "initiator keypair"-                          (BOLT8.keypair initiator_s_priv)-  (r_s_sec, r_s_pub) <- expectJust "responder keypair"-                          (BOLT8.keypair responder_s_priv)-  rs <- expectJust "responder pub" (BOLT8.parse_pub responder_s_pub)-  (msg1, i_hs) <- expectRight "act1" (BOLT8.act1 i_s_sec i_s_pub rs-                                       initiator_e_priv)-  (msg2, r_hs) <- expectRight "act2" (BOLT8.act2 r_s_sec r_s_pub responder_e_priv-                                       msg1)-  (msg3, i_result) <- expectRight "act3" (BOLT8.act3 i_hs msg2)-  r_result <- expectRight "finalize" (BOLT8.finalize r_hs msg3)-  let i_sess = BOLT8.session i_result-      r_sess = BOLT8.session r_result-  (ct, _) <- expectRight "encrypt" (BOLT8.encrypt i_sess hello)-  -- append trailing bytes-  let ct_with_trailing = ct <> "extra"-  case BOLT8.decrypt r_sess ct_with_trailing of-    Left BOLT8.InvalidLength -> pure ()-    Left err -> assertFailure $ "expected InvalidLength, got: " ++ show err-    Right _ -> assertFailure "decrypt should reject trailing bytes"--test_decrypt_frame_remainder :: Assertion-test_decrypt_frame_remainder = do-  (i_s_sec, i_s_pub) <- expectJust "initiator keypair"-                          (BOLT8.keypair initiator_s_priv)-  (r_s_sec, r_s_pub) <- expectJust "responder keypair"-                          (BOLT8.keypair responder_s_priv)-  rs <- expectJust "responder pub" (BOLT8.parse_pub responder_s_pub)-  (msg1, i_hs) <- expectRight "act1" (BOLT8.act1 i_s_sec i_s_pub rs-                                       initiator_e_priv)-  (msg2, r_hs) <- expectRight "act2" (BOLT8.act2 r_s_sec r_s_pub responder_e_priv-                                       msg1)-  (msg3, i_result) <- expectRight "act3" (BOLT8.act3 i_hs msg2)-  r_result <- expectRight "finalize" (BOLT8.finalize r_hs msg3)-  let i_sess = BOLT8.session i_result-      r_sess = BOLT8.session r_result-  (ct, _) <- expectRight "encrypt" (BOLT8.encrypt i_sess hello)-  let trailing = "remainder"-      ct_with_trailing = ct <> trailing-  (pt, remainder, _) <- expectRight "decrypt_frame"-                          (BOLT8.decrypt_frame r_sess ct_with_trailing)-  pt @?= hello-  remainder @?= trailing--test_decrypt_frame_multi :: Assertion-test_decrypt_frame_multi = do-  (i_s_sec, i_s_pub) <- expectJust "initiator keypair"-                          (BOLT8.keypair initiator_s_priv)-  (r_s_sec, r_s_pub) <- expectJust "responder keypair"-                          (BOLT8.keypair responder_s_priv)-  rs <- expectJust "responder pub" (BOLT8.parse_pub responder_s_pub)-  (msg1, i_hs) <- expectRight "act1" (BOLT8.act1 i_s_sec i_s_pub rs-                                       initiator_e_priv)-  (msg2, r_hs) <- expectRight "act2" (BOLT8.act2 r_s_sec r_s_pub responder_e_priv-                                       msg1)-  (msg3, i_result) <- expectRight "act3" (BOLT8.act3 i_hs msg2)-  r_result <- expectRight "finalize" (BOLT8.finalize r_hs msg3)-  let i_sess = BOLT8.session i_result-      r_sess = BOLT8.session r_result-  -- encrypt two messages-  (ct1, i_sess') <- expectRight "encrypt 1" (BOLT8.encrypt i_sess "first")-  (ct2, _) <- expectRight "encrypt 2" (BOLT8.encrypt i_sess' "second")-  -- concatenate frames-  let buffer = ct1 <> ct2-  -- decrypt first frame-  (pt1, rest, r_sess') <- expectRight "frame 1"-                            (BOLT8.decrypt_frame r_sess buffer)-  pt1 @?= "first"-  -- decrypt second frame from remainder-  (pt2, rest2, _) <- expectRight "frame 2" (BOLT8.decrypt_frame r_sess' rest)-  pt2 @?= "second"-  rest2 @?= BS.empty---- partial framing tests -------------------------------------------------------partial_framing_tests :: TestTree-partial_framing_tests = testGroup "Partial Framing" [-    testCase "short buffer returns NeedMore" test_partial_short_buffer-  , testCase "partial body returns NeedMore" test_partial_body-  , testCase "full frame returns FrameOk" test_partial_full_frame-  ]--test_partial_short_buffer :: Assertion-test_partial_short_buffer = do-  (i_s_sec, i_s_pub) <- expectJust "initiator keypair"-                          (BOLT8.keypair initiator_s_priv)-  (r_s_sec, r_s_pub) <- expectJust "responder keypair"-                          (BOLT8.keypair responder_s_priv)-  rs <- expectJust "responder pub" (BOLT8.parse_pub responder_s_pub)-  (msg1, i_hs) <- expectRight "act1" (BOLT8.act1 i_s_sec i_s_pub rs-                                       initiator_e_priv)-  (msg2, r_hs) <- expectRight "act2" (BOLT8.act2 r_s_sec r_s_pub responder_e_priv-                                       msg1)-  (msg3, _) <- expectRight "act3" (BOLT8.act3 i_hs msg2)-  r_result <- expectRight "finalize" (BOLT8.finalize r_hs msg3)-  let r_sess = BOLT8.session r_result-      short_buf = BS.replicate 10 0x00-  case BOLT8.decrypt_frame_partial r_sess short_buf of-    BOLT8.NeedMore n -> n @?= 8-    BOLT8.FrameOk {} -> assertFailure "expected NeedMore, got FrameOk"-    BOLT8.FrameError err ->-      assertFailure $ "expected NeedMore, got: " ++ show err--test_partial_body :: Assertion-test_partial_body = do-  (i_s_sec, i_s_pub) <- expectJust "initiator keypair"-                          (BOLT8.keypair initiator_s_priv)-  (r_s_sec, r_s_pub) <- expectJust "responder keypair"-                          (BOLT8.keypair responder_s_priv)-  rs <- expectJust "responder pub" (BOLT8.parse_pub responder_s_pub)-  (msg1, i_hs) <- expectRight "act1" (BOLT8.act1 i_s_sec i_s_pub rs-                                       initiator_e_priv)-  (msg2, r_hs) <- expectRight "act2" (BOLT8.act2 r_s_sec r_s_pub responder_e_priv-                                       msg1)-  (msg3, i_result) <- expectRight "act3" (BOLT8.act3 i_hs msg2)-  r_result <- expectRight "finalize" (BOLT8.finalize r_hs msg3)-  let i_sess = BOLT8.session i_result-      r_sess = BOLT8.session r_result-  (ct, _) <- expectRight "encrypt" (BOLT8.encrypt i_sess hello)-  -- take only length header (18 bytes) + 5 bytes of body-  let partial = BS.take 23 ct-  case BOLT8.decrypt_frame_partial r_sess partial of-    BOLT8.NeedMore n -> do-      -- "hello" = 5 bytes, so body = 5 + 16 = 21-      -- we have 5 bytes of body, need 16 more-      n @?= 16-    BOLT8.FrameOk {} -> assertFailure "expected NeedMore, got FrameOk"-    BOLT8.FrameError err ->-      assertFailure $ "expected NeedMore, got: " ++ show err--test_partial_full_frame :: Assertion-test_partial_full_frame = do-  (i_s_sec, i_s_pub) <- expectJust "initiator keypair"-                          (BOLT8.keypair initiator_s_priv)-  (r_s_sec, r_s_pub) <- expectJust "responder keypair"-                          (BOLT8.keypair responder_s_priv)-  rs <- expectJust "responder pub" (BOLT8.parse_pub responder_s_pub)-  (msg1, i_hs) <- expectRight "act1" (BOLT8.act1 i_s_sec i_s_pub rs-                                       initiator_e_priv)-  (msg2, r_hs) <- expectRight "act2" (BOLT8.act2 r_s_sec r_s_pub responder_e_priv-                                       msg1)-  (msg3, i_result) <- expectRight "act3" (BOLT8.act3 i_hs msg2)-  r_result <- expectRight "finalize" (BOLT8.finalize r_hs msg3)-  let i_sess = BOLT8.session i_result-      r_sess = BOLT8.session r_result-  (ct, _) <- expectRight "encrypt" (BOLT8.encrypt i_sess hello)-  let trailing = "extra"-      buf = ct <> trailing-  case BOLT8.decrypt_frame_partial r_sess buf of-    BOLT8.FrameOk pt remainder _ -> do-      pt @?= hello-      remainder @?= trailing-    BOLT8.NeedMore n ->-      assertFailure $ "expected FrameOk, got NeedMore " ++ show n-    BOLT8.FrameError err ->-      assertFailure $ "expected FrameOk, got: " ++ show err---- negative tests --------------------------------------------------------------negative_tests :: TestTree-negative_tests = testGroup "Negative Tests" [-    testCase "act2 rejects wrong version" test_act2_wrong_version-  , testCase "act2 rejects wrong length" test_act2_wrong_length-  , testCase "act3 rejects invalid MAC" test_act3_invalid_mac-  , testCase "finalize rejects invalid MAC" test_finalize_invalid_mac-  , testCase "decrypt rejects short packet" test_decrypt_short_packet-  ]--test_act2_wrong_version :: Assertion-test_act2_wrong_version = do-  (i_s_sec, i_s_pub) <- expectJust "initiator keypair"-                          (BOLT8.keypair initiator_s_priv)-  (r_s_sec, r_s_pub) <- expectJust "responder keypair"-                          (BOLT8.keypair responder_s_priv)-  rs <- expectJust "responder pub" (BOLT8.parse_pub responder_s_pub)-  (msg1, _) <- expectRight "act1" (BOLT8.act1 i_s_sec i_s_pub rs initiator_e_priv)-  let bad_msg1 = BS.cons 0x01 (BS.drop 1 msg1)-  case BOLT8.act2 r_s_sec r_s_pub responder_e_priv bad_msg1 of-    Left BOLT8.InvalidVersion -> pure ()-    Left err -> assertFailure $ "expected InvalidVersion, got: " ++ show err-    Right _ -> assertFailure "expected rejection, got success"--test_act2_wrong_length :: Assertion-test_act2_wrong_length = do-  (r_s_sec, r_s_pub) <- expectJust "responder keypair"-                          (BOLT8.keypair responder_s_priv)-  let short_msg = BS.replicate 49 0x00-  case BOLT8.act2 r_s_sec r_s_pub responder_e_priv short_msg of-    Left BOLT8.InvalidLength -> pure ()-    Left err -> assertFailure $ "expected InvalidLength, got: " ++ show err-    Right _ -> assertFailure "expected rejection, got success"--test_act3_invalid_mac :: Assertion-test_act3_invalid_mac = do-  (i_s_sec, i_s_pub) <- expectJust "initiator keypair"-                          (BOLT8.keypair initiator_s_priv)-  (r_s_sec, r_s_pub) <- expectJust "responder keypair"-                          (BOLT8.keypair responder_s_priv)-  rs <- expectJust "responder pub" (BOLT8.parse_pub responder_s_pub)-  (msg1, i_hs) <- expectRight "act1" (BOLT8.act1 i_s_sec i_s_pub rs-                                       initiator_e_priv)-  (msg2, _) <- expectRight "act2" (BOLT8.act2 r_s_sec r_s_pub responder_e_priv-                                    msg1)-  bad_msg2 <- flip_byte 40 msg2-  case BOLT8.act3 i_hs bad_msg2 of-    Left BOLT8.InvalidMAC -> pure ()-    Left err -> assertFailure $ "expected InvalidMAC, got: " ++ show err-    Right _ -> assertFailure "expected rejection, got success"--test_finalize_invalid_mac :: Assertion-test_finalize_invalid_mac = do-  (i_s_sec, i_s_pub) <- expectJust "initiator keypair"-                          (BOLT8.keypair initiator_s_priv)-  (r_s_sec, r_s_pub) <- expectJust "responder keypair"-                          (BOLT8.keypair responder_s_priv)-  rs <- expectJust "responder pub" (BOLT8.parse_pub responder_s_pub)-  (msg1, i_hs) <- expectRight "act1" (BOLT8.act1 i_s_sec i_s_pub rs-                                       initiator_e_priv)-  (msg2, r_hs) <- expectRight "act2" (BOLT8.act2 r_s_sec r_s_pub responder_e_priv-                                       msg1)-  (msg3, _) <- expectRight "act3" (BOLT8.act3 i_hs msg2)-  bad_msg3 <- flip_byte 20 msg3-  case BOLT8.finalize r_hs bad_msg3 of-    Left BOLT8.InvalidMAC -> pure ()-    Left err -> assertFailure $ "expected InvalidMAC, got: " ++ show err-    Right _ -> assertFailure "expected rejection, got success"--test_decrypt_short_packet :: Assertion-test_decrypt_short_packet = do-  (i_s_sec, i_s_pub) <- expectJust "initiator keypair"-                          (BOLT8.keypair initiator_s_priv)-  (r_s_sec, r_s_pub) <- expectJust "responder keypair"-                          (BOLT8.keypair responder_s_priv)-  rs <- expectJust "responder pub" (BOLT8.parse_pub responder_s_pub)-  (msg1, i_hs) <- expectRight "act1" (BOLT8.act1 i_s_sec i_s_pub rs-                                       initiator_e_priv)-  (msg2, r_hs) <- expectRight "act2" (BOLT8.act2 r_s_sec r_s_pub responder_e_priv-                                       msg1)-  (msg3, _) <- expectRight "act3" (BOLT8.act3 i_hs msg2)-  r_result <- expectRight "finalize" (BOLT8.finalize r_hs msg3)-  let r_sess = BOLT8.session r_result-      short_packet = BS.replicate 17 0x00-  case BOLT8.decrypt r_sess short_packet of-    Left BOLT8.InvalidLength -> pure ()-    Left err -> assertFailure $ "expected InvalidLength, got: " ++ show err-    Right _ -> assertFailure "expected rejection, got success"---- flip one byte in a bytestring at given index-flip_byte :: Int -> BS.ByteString -> IO BS.ByteString-flip_byte i bs-  | i < 0 || i >= BS.length bs =-      assertFailure "flip_byte: index out of bounds" >> pure bs-  | otherwise =-      let (pre, post) = BS.splitAt i bs-          b = BS.index post 0-      in pure (pre <> BS.cons (b `xor` 0xff) (BS.drop 1 post))---- utilities --------------------------------------------------------------------- Safe hex decode for test vectors (only called at top level with known-good--- literals). This uses error since it's for compile-time constants, not runtime--- input; wrapping in IO would break the test vector declarations.-hex :: BS.ByteString -> BS.ByteString-hex bs = case B16.decode bs of-  Nothing -> error "hex: invalid test vector literal"-  Just r  -> r---- property tests ----------------------------------------------------------------property_tests :: TestTree-property_tests = testGroup "Properties" [-    testProperty "handshake round-trip" prop_handshake_roundtrip-  , testProperty "encrypt/decrypt round-trip" prop_encrypt_decrypt_roundtrip-  , testProperty "decrypt_frame consumes one frame" prop_frame_consumes_one-  , testProperty "decrypt_frame_partial NeedMore on short"-      prop_partial_needmore_short-  ]---- generators ---------------------------------------------------------------------- | Generate 32 bytes of entropy that yields a valid keypair.-genValidEntropy :: Gen BS.ByteString-genValidEntropy = do-  bytes <- BS.pack <$> vectorOf 32 (choose (0, 255))-  case BOLT8.keypair bytes of-    Just _  -> pure bytes-    Nothing -> genValidEntropy---- | Generate a payload of 0..256 bytes.-genPayload :: Gen BS.ByteString-genPayload = do-  len <- choose (0, 256)-  BS.pack <$> vectorOf len (choose (0, 255))---- | Perform a full handshake with given static key entropy.--- Uses fixed ephemeral keys for determinism.-doHandshake-  :: BS.ByteString-  -> BS.ByteString-  -> Maybe (BOLT8.Session, BOLT8.Session)-doHandshake i_entropy r_entropy = do-  (i_s_sec, i_s_pub) <- BOLT8.keypair i_entropy-  (r_s_sec, r_s_pub) <- BOLT8.keypair r_entropy-  let i_e = BS.replicate 32 0x12-      r_e = BS.replicate 32 0x22-  (msg1, i_hs) <- either (const Nothing) Just $-    BOLT8.act1 i_s_sec i_s_pub r_s_pub i_e-  (msg2, r_hs) <- either (const Nothing) Just $-    BOLT8.act2 r_s_sec r_s_pub r_e msg1-  (msg3, i_res) <- either (const Nothing) Just $-    BOLT8.act3 i_hs msg2-  r_res <- either (const Nothing) Just $-    BOLT8.finalize r_hs msg3-  pure (BOLT8.session i_res, BOLT8.session r_res)---- properties ---------------------------------------------------------------------- | Handshake succeeds for valid keys and sessions are consistent.-prop_handshake_roundtrip :: Property-prop_handshake_roundtrip = forAll genValidEntropy $ \i_ent ->-  forAll genValidEntropy $ \r_ent ->-    case doHandshake i_ent r_ent of-      Nothing -> False-      Just _  -> True---- | Encrypt then decrypt yields original payload.-prop_encrypt_decrypt_roundtrip :: Property-prop_encrypt_decrypt_roundtrip = forAll genPayload $ \payload ->-  case doHandshake initiator_s_priv responder_s_priv of-    Nothing -> False-    Just (i_sess, r_sess) ->-      case BOLT8.encrypt i_sess payload of-        Left _ -> False-        Right (ct, _) ->-          case BOLT8.decrypt r_sess ct of-            Left _ -> False-            Right (pt, _) -> pt == payload---- | decrypt_frame consumes exactly one frame and returns remainder.-prop_frame_consumes_one :: Property-prop_frame_consumes_one = forAll genPayload $ \p1 ->-  forAll genPayload $ \p2 ->-    case doHandshake initiator_s_priv responder_s_priv of-      Nothing -> False-      Just (i_sess, r_sess) ->-        case BOLT8.encrypt i_sess p1 of-          Left _ -> False-          Right (ct1, i_sess') ->-            case BOLT8.encrypt i_sess' p2 of-              Left _ -> False-              Right (ct2, _) ->-                let buf = ct1 <> ct2-                in case BOLT8.decrypt_frame r_sess buf of-                  Left _ -> False-                  Right (pt1, rest, r_sess') ->-                    pt1 == p1 &&-                    case BOLT8.decrypt_frame r_sess' rest of-                      Left _ -> False-                      Right (pt2, rest2, _) ->-                        pt2 == p2 && BS.null rest2---- | decrypt_frame_partial returns NeedMore when buffer < 18 bytes.-prop_partial_needmore_short :: Property-prop_partial_needmore_short = forAll (choose (0, 17)) $ \len ->-  case doHandshake initiator_s_priv responder_s_priv of-    Nothing -> False-    Just (_, r_sess) ->-      let buf = BS.replicate len 0x00-      in case BOLT8.decrypt_frame_partial r_sess buf of-        BOLT8.NeedMore n -> n == 18 - len-        _                -> False+{-# LANGUAGE OverloadedStrings #-}++module Main where++import qualified Crypto.AEAD.ChaCha20Poly1305 as AEAD+import qualified Crypto.Hash.SHA256 as SHA256+import qualified Crypto.KDF.HMAC as HKDF+import Data.Bits (shiftR, xor)+import qualified Data.ByteString as BS+import qualified Data.ByteString.Base16 as B16+import Data.Maybe (isJust, isNothing)+import Data.Word (Word64)+import qualified Lightning.Protocol.BOLT8 as BOLT8+import Test.Tasty+import Test.Tasty.HUnit+import qualified Test.Tasty.QuickCheck as Q++main :: IO ()+main = defaultMain $ testGroup "ppad-bolt8" [+    key_tests+  , handshake_tests+  , handshake_failure_tests+  , message_tests+  , transport_tests+  , transport_failure_tests+  , property_tests+  ]++-- helpers --------------------------------------------------------------------++expect_just :: String -> Maybe a -> IO a+expect_just msg = maybe (assertFailure msg) pure++expect_right :: Show e => String -> Either e a -> IO a+expect_right msg = either (\e -> assertFailure (msg <> ": " <> show e)) pure++-- assert failure with a specific error+expect_error :: String -> BOLT8.Error -> Either BOLT8.Error a -> Assertion+expect_error msg want r = case r of+  Left got -> assertEqual msg want got+  Right _  -> assertFailure (msg <> ": expected " <> show want)++-- decode a hex literal, failing the test if it is malformed+unhex :: BS.ByteString -> IO BS.ByteString+unhex h = expect_just ("invalid hex: " <> show h) (B16.decode h)++-- total lookup+at :: Int -> [a] -> Maybe a+at i xs = case drop i xs of+  (x : _) | i >= 0 -> Just x+  _                -> Nothing++-- flip all bits of the byte at the given index+flip_byte :: Int -> BS.ByteString -> IO BS.ByteString+flip_byte i bs+  | i < 0 || i >= BS.length bs =+      assertFailure ("flip_byte: index out of bounds: " <> show i)+  | otherwise =+      let (pre, post) = BS.splitAt i bs+      in  pure (pre <> BS.map (xor 0xff) (BS.take 1 post) <> BS.drop 1 post)++-- payload for the m'th message of a test stream+payload :: Int -> BS.ByteString+payload m = BS.replicate (m `mod` 7) (fromIntegral m)++-- Appendix A key material ----------------------------------------------------++ls_i_sec, e_i_sec, ls_r_sec, e_r_sec :: BS.ByteString+ls_i_sec = BS.replicate 32 0x11+e_i_sec  = BS.replicate 32 0x12+ls_r_sec = BS.replicate 32 0x21+e_r_sec  = BS.replicate 32 0x22++ls_i_pub, ls_r_pub, e_i_pub, e_r_pub :: BS.ByteString+ls_i_pub =+  "034f355bdcb7cc0af728ef3cceb9615d90684bb5b2ca5f859ab0f0b704075871aa"+ls_r_pub =+  "028d7500dd4c12685d1f568b4c2b5048e8534b873319f3a8daa612b469132ec7f7"+e_i_pub =+  "036360e856310ce5d294e8be33fc807077dc56ac80d95d9cd4ddbd21325eff73f7"+e_r_pub =+  "02466d7fcae563e5cb09a0d1870bb580344804617879a14949cf22285f1bae3f27"++act1_msg, act2_msg, act3_msg :: BS.ByteString+act1_msg =+  "00036360e856310ce5d294e8be33fc807077dc56ac80d95d9cd4ddbd21325eff73f7\+  \0df6086551151f58b8afe6c195782c6a"+act2_msg =+  "0002466d7fcae563e5cb09a0d1870bb580344804617879a14949cf22285f1bae3f27\+  \6e2470b93aac583c9ef6eafca3f730ae"+act3_msg =+  "00b9e3a702e93e3a9948c2ed6e5fd7590a6e1c3a0344cfc9d5b57357049aa22355\+  \361aa02e55a8fc28fef5bd6d71ad0c38228dc68b1c466263b47fdf31e560e139ba"++-- final chaining key, and the initiator's sending and receiving keys+-- (the responder's are swapped)+final_ck, final_sk, final_rk :: BS.ByteString+final_ck =+  "919219dbb2920afa8db80f9a51787a840bcf111ed8d588caf9ab4be716e42b01"+final_sk =+  "969ab31b4d288cedf6218839b27a3e2140827047f2c0f01bf5c04435d43511a9"+final_rk =+  "bb9020b8965f4df047e07f955f3c4b88418984aadc5cdb35096b9ea8fa5c3442"++spec_keypairs :: IO (BOLT8.Keypair, BOLT8.Keypair)+spec_keypairs = do+  i <- expect_just "initiator keypair" (BOLT8.keypair ls_i_sec)+  r <- expect_just "responder keypair" (BOLT8.keypair ls_r_sec)+  pure (i, r)++-- the Appendix A handshake, as (initiator, responder) results+spec_handshake :: Either BOLT8.Error (BOLT8.Handshake, BOLT8.Handshake)+spec_handshake = do+  i <- maybe (Left BOLT8.InvalidEntropy) Right (BOLT8.keypair ls_i_sec)+  r <- maybe (Left BOLT8.InvalidEntropy) Right (BOLT8.keypair ls_r_sec)+  handshake i r e_i_sec e_r_sec++spec_results :: IO (BOLT8.Handshake, BOLT8.Handshake)+spec_results = expect_right "spec handshake" spec_handshake++handshake+  :: BOLT8.Keypair+  -> BOLT8.Keypair+  -> BS.ByteString+  -> BS.ByteString+  -> Either BOLT8.Error (BOLT8.Handshake, BOLT8.Handshake)+handshake i r i_e r_e = do+  (msg1, i_hs) <- BOLT8.act1 i (BOLT8.keypair_pub r) i_e+  (msg2, r_hs) <- BOLT8.act2 r r_e msg1+  (msg3, i_res) <- BOLT8.act3 i_hs msg2+  r_res <- BOLT8.finalize r_hs msg3+  pure (i_res, r_res)++-- reference transport --------------------------------------------------------++-- BOLT #8 framing and rotation built directly on ppad-aead and+-- ppad-hkdf, as an independent check of the library's key schedule.++ref_nonce :: Word64 -> BS.ByteString+ref_nonce n = BS.replicate 4 0 <>+  BS.pack [fromIntegral (n `shiftR` (8 * j)) | j <- [0 .. 7]]++ref_frame :: BS.ByteString -> Word64 -> BS.ByteString -> IO BS.ByteString+ref_frame k n m = do+  let len = BS.length m+      l = BS.pack [fromIntegral (len `shiftR` 8), fromIntegral len]+  (lc, lt) <- expect_right "aead" (AEAD.encrypt mempty k (ref_nonce n) l)+  (c, t) <- expect_right "aead" (AEAD.encrypt mempty k (ref_nonce (n + 1)) m)+  pure (lc <> lt <> c <> t)++-- (ck', k') = HKDF(ck, k)+ref_rotate+  :: BS.ByteString -> BS.ByteString -> IO (BS.ByteString, BS.ByteString)+ref_rotate ck k = do+  out <- expect_just "hkdf" (HKDF.derive hmac ck mempty 64 k)+  pure (BS.splitAt 32 out)+  where+    hmac a b = case SHA256.hmac a b of SHA256.MAC mac -> mac++-- frames carrying 'payload' 0 .. count - 1, sent under key k and+-- chaining key ck+ref_stream :: BS.ByteString -> BS.ByteString -> Int -> IO [BS.ByteString]+ref_stream = go 0 0+  where+    go m n ck k count+      | m == count = pure []+      | n >= 1000 = do+          (ck', k') <- ref_rotate ck k+          go m 0 ck' k' count+      | otherwise = do+          f <- ref_frame k n (payload m)+          fs <- go (m + 1) (n + 2) ck k count+          pure (f : fs)++-- assert that a Sender encrypts under key k with chaining key ck,+-- across two rotations+check_sender :: BS.ByteString -> BS.ByteString -> BOLT8.Sender -> Assertion+check_sender ck k s0 = do+  ref <- ref_stream ck k 1002+  let go _ _ [] = pure ()+      go m s (f : fs) = do+        (ct, s') <- expect_right "encrypt" (BOLT8.encrypt s (payload m))+        assertEqual ("frame " <> show m) f ct+        go (m + 1) s' fs+  go (0 :: Int) s0 ref++-- assert that a Receiver decrypts under key k with chaining key ck,+-- across two rotations+check_receiver+  :: BS.ByteString -> BS.ByteString -> BOLT8.Receiver -> Assertion+check_receiver ck k r0 = do+  ref <- ref_stream ck k 1002+  let go _ _ [] = pure ()+      go m r (f : fs) = do+        (pt, r') <- expect_right ("decrypt " <> show m) (BOLT8.decrypt r f)+        assertEqual ("message " <> show m) (payload m) pt+        go (m + 1) r' fs+  go (0 :: Int) r0 ref++-- send 'payload' 0 .. count - 1 from a Sender to a Receiver+round_trip :: Int -> BOLT8.Sender -> BOLT8.Receiver -> Assertion+round_trip count = go 0+  where+    go m s r+      | m == count = pure ()+      | otherwise = do+          (ct, s') <- expect_right "encrypt" (BOLT8.encrypt s (payload m))+          (pt, r') <- expect_right ("decrypt " <> show m) (BOLT8.decrypt r ct)+          assertEqual ("message " <> show m) (payload m) pt+          go (m + 1) s' r'++-- keys -----------------------------------------------------------------------++-- 32-byte strings (and one short one) that are not valid secret keys+invalid_secrets :: IO [(String, BS.ByteString)]+invalid_secrets = do+  n <- unhex+    "fffffffffffffffffffffffffffffffebaaedce6af48a03bbfd25e8cd0364141"+  pure [+      ("zero", BS.replicate 32 0)+    , ("order", n)+    , ("2^256 - 1", BS.replicate 32 0xff)+    , ("31 bytes", BS.replicate 31 0x12)+    ]++-- 33-byte compressed encodings that are not curve points+invalid_points :: IO [(String, BS.ByteString)]+invalid_points = do+  -- x = p + 1 is congruent to 1, which is on the curve, but not < p+  p_1 <- unhex+    "fffffffffffffffffffffffffffffffffffffffffffffffffffffffefffffc30"+  pure [+      ("x = 0, no square root", BS.cons 0x02 (BS.replicate 32 0))+    , ("x = 5, no square root", BS.cons 0x03 (BS.replicate 31 0 <> "\x05"))+    , ("x = p + 1", BS.cons 0x02 p_1)+    ]++-- replace the 33-byte key in a 50-byte act one or act two message+with_key :: BS.ByteString -> BS.ByteString -> BS.ByteString+with_key pt msg = BS.take 1 msg <> pt <> BS.drop 34 msg++key_tests :: TestTree+key_tests = testGroup "keys" [+    testCase "keypair derives the spec static keys" $ do+      (i, r) <- spec_keypairs+      want_i <- unhex ls_i_pub+      want_r <- unhex ls_r_pub+      BOLT8.serialize_pub (BOLT8.keypair_pub i) @?= want_i+      BOLT8.serialize_pub (BOLT8.keypair_pub r) @?= want_r+  , testCase "keypair rejects invalid secrets" $ do+      n <- unhex+        "fffffffffffffffffffffffffffffffebaaedce6af48a03bbfd25e8cd0364141"+      n_1 <- unhex+        "fffffffffffffffffffffffffffffffebaaedce6af48a03bbfd25e8cd0364140"+      assertBool "31 bytes" (isNothing (BOLT8.keypair (BS.replicate 31 1)))+      assertBool "33 bytes" (isNothing (BOLT8.keypair (BS.replicate 33 1)))+      assertBool "zero" (isNothing (BOLT8.keypair (BS.replicate 32 0)))+      assertBool "order" (isNothing (BOLT8.keypair n))+      assertBool "2^256 - 1" (isNothing (BOLT8.keypair (BS.replicate 32 0xff)))+      assertBool "order - 1" (isJust (BOLT8.keypair n_1))+  , testCase "parse_pub round-trips compressed keys" $ do+      bs <- unhex ls_r_pub+      pub <- expect_just "parse_pub" (BOLT8.parse_pub bs)+      BOLT8.serialize_pub pub @?= bs+  , testCase "parse_pub rejects points off the curve" $ do+      bad <- invalid_points+      mapM_ (\(name, pt) ->+               assertBool name (isNothing (BOLT8.parse_pub pt))) bad+  , testCase "parse_pub rejects other encodings" $ do+      -- the generator, uncompressed and x-only+      g_full <- unhex+        "0479be667ef9dcbbac55a06295ce870b07029bfcdb2dce28d959f2815b16f81798\+        \483ada7726a3c4655da4fbfc0e1108a8fd17b448a68554199c47d08ffb10d4b8"+      g_x <- unhex+        "79be667ef9dcbbac55a06295ce870b07029bfcdb2dce28d959f2815b16f81798"+      bs <- unhex ls_r_pub+      assertBool "uncompressed" (isNothing (BOLT8.parse_pub g_full))+      assertBool "x-only" (isNothing (BOLT8.parse_pub g_x))+      assertBool "0x04 prefix"+        (isNothing (BOLT8.parse_pub (BS.cons 0x04 (BS.drop 1 bs))))+      assertBool "34 bytes" (isNothing (BOLT8.parse_pub (bs <> "\x00")))+  ]++-- handshake ------------------------------------------------------------------++handshake_tests :: TestTree+handshake_tests = testGroup "handshake" [+    testCase "act one matches spec" $ do+      (i, _) <- spec_keypairs+      rs <- unhex ls_r_pub >>= expect_just "rs" . BOLT8.parse_pub+      (msg1, _) <- expect_right "act1" (BOLT8.act1 i rs e_i_sec)+      want <- unhex act1_msg+      e <- unhex e_i_pub+      msg1 @?= want+      BS.take 33 (BS.drop 1 msg1) @?= e+  , testCase "act two matches spec" $ do+      (_, r) <- spec_keypairs+      msg1 <- unhex act1_msg+      (msg2, _) <- expect_right "act2" (BOLT8.act2 r e_r_sec msg1)+      want <- unhex act2_msg+      e <- unhex e_r_pub+      msg2 @?= want+      BS.take 33 (BS.drop 1 msg2) @?= e+  , testCase "act three matches spec" $ do+      (i, r) <- spec_keypairs+      (_, i_hs) <- expect_right "act1"+        (BOLT8.act1 i (BOLT8.keypair_pub r) e_i_sec)+      msg2 <- unhex act2_msg+      (msg3, _) <- expect_right "act3" (BOLT8.act3 i_hs msg2)+      want <- unhex act3_msg+      msg3 @?= want+  , testCase "finalize accepts spec act three" $ do+      (_, r) <- spec_keypairs+      msg1 <- unhex act1_msg+      msg3 <- unhex act3_msg+      (_, r_hs) <- expect_right "act2" (BOLT8.act2 r e_r_sec msg1)+      r_res <- expect_right "finalize" (BOLT8.finalize r_hs msg3)+      want <- unhex ls_i_pub+      BOLT8.serialize_pub (BOLT8.handshake_remote_static r_res) @?= want+  , testCase "act1 rejects invalid entropy" $ do+      (i, r) <- spec_keypairs+      let rs = BOLT8.keypair_pub r+      bad <- invalid_secrets+      mapM_ (\(name, e) -> expect_error name BOLT8.InvalidEntropy+                             (BOLT8.act1 i rs e)) bad+  , testCase "act2 rejects invalid entropy" $ do+      (_, r) <- spec_keypairs+      msg1 <- unhex act1_msg+      bad <- invalid_secrets+      mapM_ (\(name, e) -> expect_error name BOLT8.InvalidEntropy+                             (BOLT8.act2 r e msg1)) bad+  , testCase "act2 rejects an ephemeral key off the curve" $ do+      (_, r) <- spec_keypairs+      msg1 <- unhex act1_msg+      bad <- invalid_points+      mapM_ (\(name, pt) -> expect_error name BOLT8.InvalidPub+                              (BOLT8.act2 r e_r_sec (with_key pt msg1))) bad+  , testCase "act3 rejects an ephemeral key off the curve" $ do+      (i, r) <- spec_keypairs+      (_, i_hs) <- expect_right "act1"+        (BOLT8.act1 i (BOLT8.keypair_pub r) e_i_sec)+      msg2 <- unhex act2_msg+      bad <- invalid_points+      mapM_ (\(name, pt) -> expect_error name BOLT8.InvalidPub+                              (BOLT8.act3 i_hs (with_key pt msg2))) bad+  , testCase "acts reject oversized input" $ do+      (i, r) <- spec_keypairs+      msg1 <- unhex act1_msg+      msg2 <- unhex act2_msg+      msg3 <- unhex act3_msg+      (_, i_hs) <- expect_right "act1"+        (BOLT8.act1 i (BOLT8.keypair_pub r) e_i_sec)+      (_, r_hs) <- expect_right "act2" (BOLT8.act2 r e_r_sec msg1)+      expect_error "act2" BOLT8.InvalidLength+        (BOLT8.act2 r e_r_sec (msg1 <> "\x00"))+      expect_error "act3" BOLT8.InvalidLength+        (BOLT8.act3 i_hs (msg2 <> "\x00"))+      expect_error "finalize" BOLT8.InvalidLength+        (BOLT8.finalize r_hs (msg3 <> "\x00"))+  ]++-- Appendix A failure vectors -------------------------------------------------++data Failure = Failure String BS.ByteString BOLT8.Error++handshake_failure_tests :: TestTree+handshake_failure_tests = testGroup "Appendix A failure vectors" [+    testGroup "initiator, act two" (fmap initiator_failure act2_failures)+  , testGroup "responder, act one" (fmap act1_failure act1_failures)+  , testGroup "responder, act three" (fmap act3_failure act3_failures)+  ]++initiator_failure :: Failure -> TestTree+initiator_failure (Failure name input want) = testCase name $ do+  (i, _) <- spec_keypairs+  rs <- unhex ls_r_pub >>= expect_just "rs" . BOLT8.parse_pub+  (msg1, i_hs) <- expect_right "act1" (BOLT8.act1 i rs e_i_sec)+  unhex act1_msg >>= (msg1 @?=)+  msg2 <- unhex input+  expect_error name want (BOLT8.act3 i_hs msg2)++act1_failure :: Failure -> TestTree+act1_failure (Failure name input want) = testCase name $ do+  (_, r) <- spec_keypairs+  msg1 <- unhex input+  expect_error name want (BOLT8.act2 r e_r_sec msg1)++act3_failure :: Failure -> TestTree+act3_failure (Failure name input want) = testCase name $ do+  (_, r) <- spec_keypairs+  msg1 <- unhex act1_msg+  (msg2, r_hs) <- expect_right "act2" (BOLT8.act2 r e_r_sec msg1)+  unhex act2_msg >>= (msg2 @?=)+  msg3 <- unhex input+  expect_error name want (BOLT8.finalize r_hs msg3)++act2_failures :: [Failure]+act2_failures = [+    Failure "short read"+      "0002466d7fcae563e5cb09a0d1870bb580344804617879a14949cf22285f1bae3f27\+      \6e2470b93aac583c9ef6eafca3f730"+      BOLT8.InvalidLength+  , Failure "bad version"+      "0102466d7fcae563e5cb09a0d1870bb580344804617879a14949cf22285f1bae3f27\+      \6e2470b93aac583c9ef6eafca3f730ae"+      BOLT8.InvalidVersion+  , Failure "bad key serialization"+      "0004466d7fcae563e5cb09a0d1870bb580344804617879a14949cf22285f1bae3f27\+      \6e2470b93aac583c9ef6eafca3f730ae"+      BOLT8.InvalidPub+  , Failure "bad MAC"+      "0002466d7fcae563e5cb09a0d1870bb580344804617879a14949cf22285f1bae3f27\+      \6e2470b93aac583c9ef6eafca3f730af"+      BOLT8.InvalidMAC+  ]++act1_failures :: [Failure]+act1_failures = [+    Failure "short read"+      "00036360e856310ce5d294e8be33fc807077dc56ac80d95d9cd4ddbd21325eff73f7\+      \0df6086551151f58b8afe6c195782c"+      BOLT8.InvalidLength+  , Failure "bad version"+      "01036360e856310ce5d294e8be33fc807077dc56ac80d95d9cd4ddbd21325eff73f7\+      \0df6086551151f58b8afe6c195782c6a"+      BOLT8.InvalidVersion+  , Failure "bad key serialization"+      "00046360e856310ce5d294e8be33fc807077dc56ac80d95d9cd4ddbd21325eff73f7\+      \0df6086551151f58b8afe6c195782c6a"+      BOLT8.InvalidPub+  , Failure "bad MAC"+      "00036360e856310ce5d294e8be33fc807077dc56ac80d95d9cd4ddbd21325eff73f7\+      \0df6086551151f58b8afe6c195782c6b"+      BOLT8.InvalidMAC+  ]++act3_failures :: [Failure]+act3_failures = [+    Failure "bad version"+      "01b9e3a702e93e3a9948c2ed6e5fd7590a6e1c3a0344cfc9d5b57357049aa22355\+      \361aa02e55a8fc28fef5bd6d71ad0c38228dc68b1c466263b47fdf31e560e139ba"+      BOLT8.InvalidVersion+  , Failure "short read"+      "00b9e3a702e93e3a9948c2ed6e5fd7590a6e1c3a0344cfc9d5b57357049aa22355\+      \361aa02e55a8fc28fef5bd6d71ad0c38228dc68b1c466263b47fdf31e560e139"+      BOLT8.InvalidLength+  , Failure "bad MAC for ciphertext"+      "00c9e3a702e93e3a9948c2ed6e5fd7590a6e1c3a0344cfc9d5b57357049aa22355\+      \361aa02e55a8fc28fef5bd6d71ad0c38228dc68b1c466263b47fdf31e560e139ba"+      BOLT8.InvalidMAC+  , Failure "bad rs"+      "00bfe3a702e93e3a9948c2ed6e5fd7590a6e1c3a0344cfc9d5b57357049aa22355\+      \36ad09a8ee351870c2bb7f78b754a26c6cef79a98d25139c856d7efd252c2ae73c"+      BOLT8.InvalidPub+  , Failure "bad MAC"+      "00b9e3a702e93e3a9948c2ed6e5fd7590a6e1c3a0344cfc9d5b57357049aa22355\+      \361aa02e55a8fc28fef5bd6d71ad0c38228dc68b1c466263b47fdf31e560e139bb"+      BOLT8.InvalidMAC+  ]++-- message encryption ---------------------------------------------------------++-- Appendix A message test: "hello" sent 1001 times by the initiator+spec_messages :: [(Int, BS.ByteString)]+spec_messages = [+    (0,    "cf2b30ddf0cf3f80e7c35a6e6730b59fe802473180f396d88a8fb0db8cbc\+           \f25d2f214cf9ea1d95")+  , (1,    "72887022101f0b6753e0c7de21657d35a4cb2a1f5cde2650528bbc8f837d\+           \0f0d7ad833b1a256a1")+  , (500,  "178cb9d7387190fa34db9c2d50027d21793c9bc2d40b1e14dcf30ebeeeb2\+           \20f48364f7a4c68bf8")+  , (501,  "1b186c57d44eb6de4c057c49940d79bb838a145cb528d6e8fd26dbe50a60\+           \ca2c104b56b60e45bd")+  , (1000, "4a2f3cc3b5e78ddb83dcb426d9863d9d9a723b0337c89dd0b005d89f8d3c\+           \05c52b76b29b740f09")+  , (1001, "2ecd8c8a5629d0d02ab457a0fdd0f7b90a192cd46be5ecb6ca570bfc5e26\+           \8338b1a16cf4ef2d36")+  ]++-- the initiator's first n frames, each carrying "hello"+hello_stream :: Int -> IO [BS.ByteString]+hello_stream count = do+  (i_res, _) <- spec_results+  let go m s+        | m == count = pure []+        | otherwise = do+            (ct, s') <- expect_right "encrypt" (BOLT8.encrypt s "hello")+            (ct :) <$> go (m + 1) s'+  go (0 :: Int) (BOLT8.handshake_sender i_res)++message_tests :: TestTree+message_tests = testGroup "messages" [+    testGroup "spec vectors" (fmap spec_message spec_messages)+  , testCase "responder decrypts the spec stream" $ do+      (_, r_res) <- spec_results+      frames <- hello_stream 1002+      let go _ _ [] = pure ()+          go m r (f : fs) = do+            (pt, r') <- expect_right ("decrypt " <> show m) (BOLT8.decrypt r f)+            assertEqual ("message " <> show m) "hello" pt+            go (m + 1) r' fs+      go (0 :: Int) (BOLT8.handshake_receiver r_res) frames+  , testCase "reference key rotation matches spec" $ do+      ck <- unhex final_ck+      sk <- unhex final_sk+      ck1 <- unhex+        "cc2c6e467efc8067720c2d09c139d1f77731893aad1defa14f9bf3c48d3f1d31"+      k1 <- unhex+        "3fbdc101abd1132ca3a0ae34a669d8d9ba69a587e0bb4ddd59524541cf4813d8"+      ck2 <- unhex+        "728366ed68565dc17cf6dd97330a859a6a56e87e2beef3bd828a4c4a54d8df06"+      k2 <- unhex+        "9e0477f9850dca41e42db0e4d154e3a098e5a000d995e421849fcd5df27882bd"+      ref_rotate ck sk >>= (@?= (ck1, k1))+      ref_rotate ck1 k1 >>= (@?= (ck2, k2))+  , testCase "initiator sends under sk and ck" $ do+      (i_res, _) <- spec_results+      ck <- unhex final_ck+      sk <- unhex final_sk+      check_sender ck sk (BOLT8.handshake_sender i_res)+  , testCase "initiator receives under rk and ck" $ do+      (i_res, _) <- spec_results+      ck <- unhex final_ck+      rk <- unhex final_rk+      check_receiver ck rk (BOLT8.handshake_receiver i_res)+  , testCase "responder sends under rk and ck" $ do+      (_, r_res) <- spec_results+      ck <- unhex final_ck+      rk <- unhex final_rk+      check_sender ck rk (BOLT8.handshake_sender r_res)+  , testCase "responder receives under sk and ck" $ do+      (_, r_res) <- spec_results+      ck <- unhex final_ck+      sk <- unhex final_sk+      check_receiver ck sk (BOLT8.handshake_receiver r_res)+  , testCase "initiator to responder across rotations" $ do+      (i_res, r_res) <- spec_results+      round_trip 1600+        (BOLT8.handshake_sender i_res) (BOLT8.handshake_receiver r_res)+  , testCase "responder to initiator across rotations" $ do+      (i_res, r_res) <- spec_results+      round_trip 1600+        (BOLT8.handshake_sender r_res) (BOLT8.handshake_receiver i_res)+  ]++spec_message :: (Int, BS.ByteString) -> TestTree+spec_message (m, h) = testCase ("message " <> show m) $ do+  frames <- hello_stream 1002+  got <- expect_just "frame" (at m frames)+  want <- unhex h+  got @?= want++-- transport ------------------------------------------------------------------++-- the spec handshake's transport states and the initiator's first two+-- frames, carrying "hello" and "world!"+transport_fixture+  :: IO (BOLT8.Sender, BOLT8.Receiver, BOLT8.Receiver, BS.ByteString,+         BS.ByteString)+transport_fixture = do+  (i_res, r_res) <- spec_results+  let i_snd = BOLT8.handshake_sender i_res+  (f0, i_snd') <- expect_right "encrypt" (BOLT8.encrypt i_snd "hello")+  (f1, _) <- expect_right "encrypt" (BOLT8.encrypt i_snd' "world!")+  pure ( i_snd, BOLT8.handshake_receiver i_res+       , BOLT8.handshake_receiver r_res, f0, f1 )++-- consume a buffer of frames via decrypt_header and decrypt_body+consume+  :: BOLT8.Receiver+  -> BS.ByteString+  -> Either BOLT8.Error [BS.ByteString]+consume r buf+  | BS.null buf = Right []+  | otherwise = do+      let (hdr, rest) = BS.splitAt 18 buf+      (n, p) <- BOLT8.decrypt_header r hdr+      let (body, rest') = BS.splitAt n rest+      (m, r') <- BOLT8.decrypt_body p body+      (m :) <$> consume r' rest'++transport_tests :: TestTree+transport_tests = testGroup "transport" [+    testCase "frame is message length plus 34 bytes" $ do+      (_, _, _, f0, f1) <- transport_fixture+      BS.length f0 @?= 5 + 34+      BS.length f1 @?= 6 + 34+  , testCase "decrypt_header reports the remaining length" $ do+      (_, _, r, f0, _) <- transport_fixture+      (n, _) <- expect_right "header" (BOLT8.decrypt_header r (BS.take 18 f0))+      n @?= 5 + 16+  , testCase "header and body decrypt consecutive frames" $ do+      (_, _, r, f0, f1) <- transport_fixture+      ms <- expect_right "consume" (consume r (f0 <> f1))+      ms @?= ["hello", "world!"]+  , testCase "decrypt agrees with header and body" $ do+      (_, _, r, f0, f1) <- transport_fixture+      (m0, r') <- expect_right "decrypt 0" (BOLT8.decrypt r f0)+      (m1, _) <- expect_right "decrypt 1" (BOLT8.decrypt r' f1)+      [m0, m1] @?= ["hello", "world!"]+  , testCase "empty message round-trips" $ do+      (s, _, r, _, _) <- transport_fixture+      (f, _) <- expect_right "encrypt" (BOLT8.encrypt s mempty)+      BS.length f @?= 34+      (m, _) <- expect_right "decrypt" (BOLT8.decrypt r f)+      m @?= mempty+  , testCase "65535-byte message round-trips" $ do+      (s, _, r, _, _) <- transport_fixture+      let big = BS.replicate 65535 0xab+      (f, _) <- expect_right "encrypt" (BOLT8.encrypt s big)+      BS.length f @?= 65569+      (n, _) <- expect_right "header" (BOLT8.decrypt_header r (BS.take 18 f))+      n @?= 65551+      (m, _) <- expect_right "decrypt" (BOLT8.decrypt r f)+      m @?= big+  , testCase "encrypt rejects a 65536-byte message" $ do+      (s, _, _, _, _) <- transport_fixture+      expect_error "encrypt" BOLT8.InvalidLength+        (BOLT8.encrypt s (BS.replicate 65536 0))+  ]++transport_failure_tests :: TestTree+transport_failure_tests = testGroup "transport failures" [+    testCase "bad length MAC" $ do+      (_, _, r, f0, _) <- transport_fixture+      for_bytes [2, 17] f0 $ \bad -> do+        expect_error "decrypt" BOLT8.InvalidMAC (BOLT8.decrypt r bad)+        expect_error "decrypt_header" BOLT8.InvalidMAC+          (BOLT8.decrypt_header r (BS.take 18 bad))+  , testCase "tampered length" $ do+      (_, _, r, f0, _) <- transport_fixture+      for_bytes [0, 1] f0 $ \bad -> do+        expect_error "decrypt" BOLT8.InvalidMAC (BOLT8.decrypt r bad)+        expect_error "decrypt_header" BOLT8.InvalidMAC+          (BOLT8.decrypt_header r (BS.take 18 bad))+  , testCase "bad body MAC" $ do+      (_, _, r, f0, _) <- transport_fixture+      for_bytes [18, 23, BS.length f0 - 1] f0 $ \bad -> do+        expect_error "decrypt" BOLT8.InvalidMAC (BOLT8.decrypt r bad)+        (n, p) <- expect_right "header"+          (BOLT8.decrypt_header r (BS.take 18 bad))+        expect_error "decrypt_body" BOLT8.InvalidMAC+          (BOLT8.decrypt_body p (BS.take n (BS.drop 18 bad)))+  , testCase "truncated frame" $ do+      (_, _, r, f0, _) <- transport_fixture+      let short = BS.take (BS.length f0 - 1) f0+      expect_error "decrypt" BOLT8.InvalidLength (BOLT8.decrypt r short)+      expect_error "decrypt, header only" BOLT8.InvalidLength+        (BOLT8.decrypt r (BS.take 18 f0))+      expect_error "decrypt, partial header" BOLT8.InvalidLength+        (BOLT8.decrypt r (BS.take 17 f0))+      expect_error "decrypt, empty" BOLT8.InvalidLength+        (BOLT8.decrypt r mempty)+      expect_error "decrypt_header" BOLT8.InvalidLength+        (BOLT8.decrypt_header r (BS.take 17 f0))+      (_, p) <- expect_right "header" (BOLT8.decrypt_header r (BS.take 18 f0))+      expect_error "decrypt_body" BOLT8.InvalidLength+        (BOLT8.decrypt_body p (BS.drop 18 short))+  , testCase "trailing bytes" $ do+      (_, _, r, f0, _) <- transport_fixture+      let long = f0 <> "\x00"+      expect_error "decrypt" BOLT8.InvalidLength (BOLT8.decrypt r long)+      expect_error "decrypt_header" BOLT8.InvalidLength+        (BOLT8.decrypt_header r (BS.take 19 f0))+      (_, p) <- expect_right "header" (BOLT8.decrypt_header r (BS.take 18 f0))+      expect_error "decrypt_body" BOLT8.InvalidLength+        (BOLT8.decrypt_body p (BS.drop 18 long))+  , testCase "replayed frame" $ do+      (_, _, r, f0, _) <- transport_fixture+      (_, r') <- expect_right "decrypt" (BOLT8.decrypt r f0)+      expect_error "replay" BOLT8.InvalidMAC (BOLT8.decrypt r' f0)+  , testCase "reordered frame" $ do+      (_, _, r, _, f1) <- transport_fixture+      expect_error "decrypt" BOLT8.InvalidMAC (BOLT8.decrypt r f1)+  , testCase "reflected frame" $ do+      (_, i_rcv, _, f0, _) <- transport_fixture+      expect_error "decrypt" BOLT8.InvalidMAC (BOLT8.decrypt i_rcv f0)+  ]+  where+    for_bytes is f act = mapM_ (\i -> flip_byte i f >>= act) is++-- properties -----------------------------------------------------------------++property_tests :: TestTree+property_tests = testGroup "properties" [+    Q.testProperty "handshake agrees on keys and statics" prop_handshake+  , Q.testProperty "messages up to 65535 bytes round-trip" prop_size+  , Q.testProperty "header and body recover a stream" prop_stream+  , Q.testProperty "parse_pub inverts serialize_pub" prop_pub+  ]++-- 32 bytes that form a valid secret key+gen_secret :: Q.Gen BS.ByteString+gen_secret = (BS.pack <$> Q.vectorOf 32 Q.arbitrary)+  `Q.suchThat` (isJust . BOLT8.keypair)++gen_bytes :: Int -> Q.Gen BS.ByteString+gen_bytes n = do+  len <- Q.choose (0, n)+  BS.pack <$> Q.vectorOf len Q.arbitrary++prop_handshake :: Q.Property+prop_handshake =+  Q.forAll gen_secret $ \i_s ->+  Q.forAll gen_secret $ \r_s ->+  Q.forAll gen_secret $ \i_e ->+  Q.forAll gen_secret $ \r_e ->+  Q.forAll (gen_bytes 256) $ \m ->+    case (BOLT8.keypair i_s, BOLT8.keypair r_s) of+      (Just i, Just r) -> check i r (handshake i r i_e r_e) m+      _ -> Q.counterexample "keypair" False+  where+    check _ _ (Left e) _ = Q.counterexample (show e) False+    check i r (Right (i_res, r_res)) m =+      let there = send (BOLT8.handshake_sender i_res)+                       (BOLT8.handshake_receiver r_res) m+          back  = send (BOLT8.handshake_sender r_res)+                       (BOLT8.handshake_receiver i_res) m+      in       BOLT8.handshake_remote_static i_res+                 Q.=== BOLT8.keypair_pub r+        Q..&&. BOLT8.handshake_remote_static r_res+                 Q.=== BOLT8.keypair_pub i+        Q..&&. there Q.=== Right m+        Q..&&. back Q.=== Right m+    send s r m = do+      (ct, _) <- BOLT8.encrypt s m+      fst <$> BOLT8.decrypt r ct++prop_size :: Q.Property+prop_size =+  Q.forAll gen_len $ \len ->+  Q.forAll Q.arbitrary $ \b ->+    let m = BS.replicate len b+    in  case spec_handshake of+          Left e -> Q.counterexample (show e) False+          Right (i_res, r_res) ->+            case BOLT8.encrypt (BOLT8.handshake_sender i_res) m of+              Left e -> Q.counterexample (show e) False+              Right (f, _) ->+                let r = BOLT8.handshake_receiver r_res+                in       BS.length f Q.=== len + 34+                  Q..&&. fmap fst (BOLT8.decrypt_header r (BS.take 18 f))+                           Q.=== Right (len + 16)+                  Q..&&. fmap fst (BOLT8.decrypt r f) Q.=== Right m+  where+    gen_len = Q.frequency [+        (1, pure 0)+      , (1, pure 65535)+      , (8, Q.choose (0, 65535))+      ]++prop_stream :: Q.Property+prop_stream =+  Q.forAll (Q.listOf (gen_bytes 512)) $ \ms ->+    case spec_handshake of+      Left e -> Q.counterexample (show e) False+      Right (i_res, r_res) ->+        let enc _ [] = Right []+            enc s (m : rest) = do+              (f, s') <- BOLT8.encrypt s m+              (f :) <$> enc s' rest+        in  case enc (BOLT8.handshake_sender i_res) ms of+              Left e -> Q.counterexample (show e) False+              Right fs ->+                consume (BOLT8.handshake_receiver r_res) (BS.concat fs)+                  Q.=== Right ms++prop_pub :: Q.Property+prop_pub = Q.forAll gen_secret $ \sec ->+  case BOLT8.keypair sec of+    Nothing -> Q.counterexample "keypair" False+    Just kp ->+      let pub = BOLT8.keypair_pub kp+      in  BOLT8.parse_pub (BOLT8.serialize_pub pub) Q.=== Just pub