commit 1cc9d1a92181a1d5c0828d942ae47c0418a22ed1
parent 4b104d803b2655047c7a66bad50254e7100e06b8
Author: Jared Tobin <jared@jtobin.io>
Date: Sat, 10 Oct 2026 14:06:37 +0400
Merge branch 'impl/modernize'
Prepares ppad-bolt8 0.1.0, implementing BOLT #8 as of
lightning/bolts@1aadb719.
API (breaking):
- The post-handshake session is split into a Sender and a Receiver,
so one state can't serve both directions and a writer thread and a
reader thread can each own one. Every operation returns the next
state; the docs stress that reusing an old state reuses a nonce or
accepts replays, that ephemeral entropy must be fresh and uniformly
random, and that any error is fatal for the connection.
- Handshake is abstract, with single-use accessors handshake_sender,
handshake_receiver and handshake_remote_static.
- The local static key is a Keypair (keypair, keypair_pub), so its
halves can't be mismatched. Handshake states are distinct Initiator
and Responder types carrying only what the next act needs.
- Decryption is either whole-frame (decrypt) or streaming, following
the spec's procedure: decrypt_header takes exactly 18 bytes and
reports how many to read next, and decrypt_body takes exactly that
many. decrypt_frame, decrypt_frame_partial and FrameResult are gone.
- Removed: Key32, SessionNonce, MessagePayload, HandshakeState, the
public Sec type, the DecryptionFailed error and the exposed Internal
module; InvalidKey is now InvalidEntropy. Secret-bearing types have
no Generic, Show or Eq instances; all public types have NFData.
Tests cover every Appendix A vector (all 13 failure cases exactly, the
six message vectors, final sk/rk/ck on both sides via an independent
reference across two rotations per direction), negative transport
cases (bad MACs, tampered length, truncated, over-long, replayed,
reordered and reflected frames), off-curve keys, invalid entropy, and
properties for key agreement, sizes up to 65535 and stream framing.
Benches use the public API and add streaming and rotation cases.
Packaging: version 0.1.0, CHANGELOG, tighter ppad bounds
(ppad-secp256k1 >= 0.5.8, ppad-sha256 >= 0.3.2), deepseq for NFData,
README with a verified usage example and spec commit.
Diffstat:
11 files changed, 1718 insertions(+), 1911 deletions(-)
diff --git a/AGENTS.md b/AGENTS.md
@@ -3,11 +3,12 @@
Haskell implementation of BOLT #8 (Lightning Network encrypted transport).
Specification: https://github.com/lightning/bolts/blob/master/08-transport.md
+(implemented as of lightning/bolts@1aadb719; copy in `etc/08-transport.md`).
## Project Structure
-- `lib/` - library source (Lightning.Protocol.BOLT8)
-- `test/` - tests (tasty + tasty-hunit)
+- `lib/` - library source (Lightning.Protocol.BOLT8, the only module)
+- `test/` - tests (tasty, tasty-hunit, tasty-quickcheck), public API only
- `bench/` - benchmarks (criterion for timing, weigh for allocations)
- `flake.nix` - nix flake for dependency and build management
- `ppad-bolt8.cabal` - cabal package definition
@@ -59,7 +60,7 @@ Use only minimal external dependencies. Prefer GHC's core/boot libraries
### Type safety
- Encode invariants into the type system
-- Use newtypes liberally (e.g., Sec, Pub, Session)
+- Use newtypes liberally (e.g., Pub, Sender, Receiver)
- Use ADTs to make illegal states unrepresentable
- Prefer smart constructors that validate inputs
diff --git a/CHANGELOG b/CHANGELOG
@@ -0,0 +1,33 @@
+# Changelog
+
+- 0.1.0 (UNRELEASED)
+ * 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.
diff --git a/CLAUDE.md b/CLAUDE.md
@@ -3,11 +3,12 @@
Haskell implementation of BOLT #8 (Lightning Network encrypted transport).
Specification: https://github.com/lightning/bolts/blob/master/08-transport.md
+(implemented as of lightning/bolts@1aadb719; copy in `etc/08-transport.md`).
## Project Structure
-- `lib/` - library source (Lightning.Protocol.BOLT8)
-- `test/` - tests (tasty + tasty-hunit)
+- `lib/` - library source (Lightning.Protocol.BOLT8, the only module)
+- `test/` - tests (tasty, tasty-hunit, tasty-quickcheck), public API only
- `bench/` - benchmarks (criterion for timing, weigh for allocations)
- `flake.nix` - nix flake for dependency and build management
- `ppad-bolt8.cabal` - cabal package definition
@@ -59,7 +60,7 @@ Use only minimal external dependencies. Prefer GHC's core/boot libraries
### Type safety
- Encode invariants into the type system
-- Use newtypes liberally (e.g., Sec, Pub, Session)
+- Use newtypes liberally (e.g., Pub, Sender, Receiver)
- Use ADTs to make illegal states unrepresentable
- Prefer smart constructors that validate inputs
diff --git a/README.md b/README.md
@@ -4,9 +4,11 @@
[](https://docs.ppad.tech/bolt8)
-Haskell implementation of BOLT #8 (Lightning Network encrypted
-transport), including the `Noise_XK_secp256k1_ChaChaPoly_SHA256` handshake
-and encrypted message transport.
+A pure Haskell implementation of [BOLT #8][bolt8], the Lightning
+Network's encrypted and authenticated transport: the
+`Noise_XK_secp256k1_ChaChaPoly_SHA256` handshake, followed by
+length-prefixed, authenticated encryption of messages with periodic key
+rotation.
## Usage
@@ -14,46 +16,89 @@ A sample GHCi session:
```
> :set -XOverloadedStrings
- >
> import qualified Data.ByteString as BS
> import qualified Lightning.Protocol.BOLT8 as BOLT8
>
- > let Just (i_s_sec, i_s_pub) = BOLT8.keypair (BS.replicate 32 0x11)
- > let Just (r_s_sec, r_s_pub) = BOLT8.keypair (BS.replicate 32 0x21)
+ > -- static keypairs (use 32 bytes of secure randomness in practice)
+ > let Just i = BOLT8.keypair (BS.replicate 32 0x11)
+ > let Just r = BOLT8.keypair (BS.replicate 32 0x21)
+ >
+ > -- ephemeral entropy MUST be fresh, uniformly random bytes
+ > let i_ent = BS.replicate 32 0x12
+ > let r_ent = BS.replicate 32 0x22
>
- > -- initiator knows responder static pubkey
- > let Right (msg1, i_hs) = BOLT8.act1 i_s_sec i_s_pub r_s_pub
- > (BS.replicate 32 0x12)
- > let Right (msg2, r_hs) = BOLT8.act2 r_s_sec r_s_pub
- > (BS.replicate 32 0x22) msg1
+ > -- the initiator knows the responder's static public key
+ > let Right (msg1, i_hs) = BOLT8.act1 i (BOLT8.keypair_pub r) i_ent
+ > let Right (msg2, r_hs) = BOLT8.act2 r r_ent msg1
> let Right (msg3, i_res) = BOLT8.act3 i_hs msg2
> let Right r_res = BOLT8.finalize r_hs msg3
>
- > let i_sess = BOLT8.session i_res
- > let r_sess = BOLT8.session r_res
+ > -- the responder has authenticated the initiator's static key
+ > BOLT8.handshake_remote_static r_res == BOLT8.keypair_pub i
+ True
+ >
+ > -- each side gets a Sender and a Receiver
+ > let i_snd = BOLT8.handshake_sender i_res
+ > let r_rcv = BOLT8.handshake_receiver r_res
>
- > let Right (ct, i_sess') = BOLT8.encrypt i_sess "hello"
- > let Right (pt, r_sess') = BOLT8.decrypt r_sess ct
+ > -- every operation returns the next state; never reuse an old one
+ > let Right (ct, i_snd') = BOLT8.encrypt i_snd "hello"
+ > let Right (pt, r_rcv') = BOLT8.decrypt r_rcv ct
> pt
"hello"
+ >
+ > -- on a byte stream: decrypt the 18-byte header, which says how many
+ > -- bytes to read next, then decrypt the rest of the frame
+ > let Right (ct', _) = BOLT8.encrypt i_snd' "world"
+ > let (hdr, rest) = BS.splitAt 18 ct'
+ > let Right (n, pending) = BOLT8.decrypt_header r_rcv' hdr
+ > n
+ 21
+ > fmap fst (BOLT8.decrypt_body pending (BS.take n rest))
+ Right "world"
```
-## Framing
-
-On a byte stream, use `decrypt` when you have exactly one frame,
-`decrypt_frame` when a buffer starts with a complete frame (it returns
-the unconsumed remainder), or `decrypt_frame_partial` to work
-incrementally and learn how many bytes are still required for the next
-step.
+The `Sender` and `Receiver` are independent, so a writer thread can own
+one and a reader thread the other. Any error from a handshake or
+transport function means the connection must be closed.
## Documentation
-Haddocks are hosted at [docs.ppad.tech/bolt8][hadoc].
+Haddocks (API documentation, etc.) are hosted at
+[docs.ppad.tech/bolt8][hadoc].
+
+## Specification
+
+This library implements BOLT #8 as of [lightning/bolts@1aadb719][spec]
+(2026-09-21), a copy of which is in `etc/08-transport.md`.
+
+The library is pure, and leaves the following to the caller:
+
+* Network I/O, including reading exactly the number of bytes each step
+ requires, and terminating the connection on any failure.
+* Generating ephemeral keys: `act1` and `act2` take the ephemeral
+ secret key as 32 bytes of caller-supplied entropy.
## Security
-This is a pre-release library that, at present, claims no security
-properties whatsoever.
+This library aims at the maximum security achievable in a
+garbage-collected language under an optimizing compiler such as GHC, in
+which strict constant-timeness can be [challenging to achieve][const].
+
+The implementation passes all BOLT #8 Appendix A test vectors,
+including every handshake failure case and the message vectors spanning
+two key rotations. The cryptography is provided by
+[ppad-secp256k1][secp] (ECDH, using constant-time scalar
+multiplication), [ppad-aead][aead] (ChaCha20-Poly1305, with
+constant-time MAC verification), [ppad-hkdf][hkdf] and
+[ppad-sha256][sha256].
+
+Session state is a pure value that each operation advances. Reusing an
+old `Sender` reuses a nonce, and reusing an old `Receiver` accepts
+replayed frames; see the module documentation.
+
+If you discover any vulnerabilities, please disclose them via
+security@ppad.tech.
## Development
@@ -72,6 +117,13 @@ $ cabal test
$ cabal bench
```
+[bolt8]: https://github.com/lightning/bolts/blob/master/08-transport.md
+[spec]: https://github.com/lightning/bolts/blob/1aadb719b4007c4cea0ba6e36b08c4fb53788dee/08-transport.md
[nixos]: https://nixos.org/
[flake]: https://nixos.org/manual/nix/unstable/command-ref/new-cli/nix3-flake.html
[hadoc]: https://docs.ppad.tech/bolt8
+[const]: https://www.chosenplaintext.ca/articles/beginners-guide-constant-time-cryptography.html
+[secp]: https://git.ppad.tech/secp256k1
+[aead]: https://git.ppad.tech/aead
+[hkdf]: https://git.ppad.tech/hkdf
+[sha256]: https://git.ppad.tech/sha256
diff --git a/bench/Fixture.hs b/bench/Fixture.hs
@@ -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
diff --git a/bench/Main.hs b/bench/Main.hs
@@ -1,113 +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 qualified Lightning.Protocol.BOLT8.Internal 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.Key32
-instance NFData BOLT8.SessionNonce
-instance NFData BOLT8.Session
-instance NFData BOLT8.HandshakeState
-instance NFData BOLT8.Handshake
-instance NFData (BOLT8.HandshakeFor a) where
- rnf (BOLT8.HandshakeFor s) = rnf s
+import Fixture
+import qualified Lightning.Protocol.BOLT8 as BOLT8
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
-
-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 )
+ pub = BOLT8.keypair_pub (fx_r fx)
+ pub_bs = BOLT8.serialize_pub pub
+
+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))
+ ]
diff --git a/bench/Weight.hs b/bench/Weight.hs
@@ -1,98 +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 qualified Lightning.Protocol.BOLT8.Internal as BOLT8
+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.Key32
-instance NFData BOLT8.SessionNonce
-instance NFData BOLT8.Session
-instance NFData BOLT8.HandshakeState
-instance NFData BOLT8.Handshake
-instance NFData (BOLT8.HandshakeFor a) where
- rnf (BOLT8.HandshakeFor s) = rnf s
-
-- 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
-
-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
-
-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
-
-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
+main = do
+ fx <- fixture
+ mainWith $ do
+ keys fx
+ handshake fx
+ transport fx
+
+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 :: 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)
+
+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))
diff --git a/lib/Lightning/Protocol/BOLT8.hs b/lib/Lightning/Protocol/BOLT8.hs
@@ -1,4 +1,7 @@
{-# OPTIONS_HADDOCK prune #-}
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE OverloadedStrings #-}
-- |
-- Module: Lightning.Protocol.BOLT8
@@ -6,112 +9,727 @@
-- 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).
+-- 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.
--
--- This module implements the
--- Noise_XK_secp256k1_ChaChaPoly_SHA256 handshake and
--- subsequent encrypted message transport.
+-- The library is pure; reading from and writing to the network is up
+-- to the caller.
--
-- = 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 nonces, i.e. every 500 messages in each
--- direction):
---
--- @
--- -- 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' when you have
--- exactly one frame, 'decrypt_frame' when a buffer starts
--- with a complete frame (it returns the unconsumed
--- remainder), or 'decrypt_frame_partial' to handle
--- incremental reads and return how many bytes are still
--- needed.
---
--- Maximum plaintext size is 65535 bytes.
+-- 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
- Sec
- , Pub
+ Keypair
, keypair
+ , keypair_pub
+ , Pub
, parse_pub
, serialize_pub
- -- * Newtypes
- , Key32
- , key32
- , unKey32
- , SessionNonce
- , unSessionNonce
- , MessagePayload
- , unMessagePayload
- , mkMessagePayload
-
- -- * Handshake roles
- , Initiator
- , Responder
- , HandshakeFor
+ -- * Handshake
+ , Handshake
+ , handshake_sender
+ , handshake_receiver
+ , handshake_remote_static
- -- * Handshake (initiator)
+ -- ** Initiator
+ , Initiator
, act1
, act3
- -- * Handshake (responder)
+ -- ** Responder
+ , Responder
, act2
, finalize
- -- * Session
- , Session
- , HandshakeState
- , Handshake(..)
+ -- * Transport
+ , Sender
, encrypt
+ , Receiver
, decrypt
- , decrypt_frame
- , decrypt_frame_partial
- , FrameResult(..)
+ , Pending
+ , decrypt_header
+ , decrypt_body
-- * Errors
, Error(..)
) where
-import Lightning.Protocol.BOLT8.Internal
+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 #-}
+
+fi :: (Integral a, Num b) => a -> b
+fi = fromIntegral
+{-# INLINE fi #-}
diff --git a/lib/Lightning/Protocol/BOLT8/Internal.hs b/lib/Lightning/Protocol/BOLT8/Internal.hs
@@ -1,849 +0,0 @@
-{-# OPTIONS_HADDOCK prune #-}
-{-# LANGUAGE BangPatterns #-}
-{-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE LambdaCase #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE RecordWildCards #-}
-{-# LANGUAGE ViewPatterns #-}
-
--- |
--- Module: Lightning.Protocol.BOLT8.Internal
--- Copyright: (c) 2025 Jared Tobin
--- License: MIT
--- Maintainer: Jared Tobin <jared@ppad.tech>
---
--- Internal module exporting all constructors for testing and
--- benchmarking. Prefer "Lightning.Protocol.BOLT8" for general use.
-
-module Lightning.Protocol.BOLT8.Internal (
- -- * Keys
- Sec(..)
- , Pub(..)
- , keypair
- , parse_pub
- , serialize_pub
-
- -- * Newtypes
- , Key32(..)
- , key32
- , unsafeKey32
- , SessionNonce(..)
- , MessagePayload(..)
- , mkMessagePayload
-
- -- * Handshake roles
- , Initiator
- , Responder
- , HandshakeFor(..)
-
- -- * 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, xor, (.&.), (.|.))
-import qualified Data.ByteString as BS
-import qualified Data.ByteString.Unsafe as BU
-import Data.Word (Word16, Word64)
-import GHC.Generics (Generic)
-
--- types -----------------------------------------------------------
-
--- | Secret key (32 bytes).
---
--- The 'Eq' instance compares in constant time.
-newtype Sec = Sec BS.ByteString
- deriving Generic
-
-instance Eq Sec where
- Sec a == Sec b = ct_eq_bs a b
-
--- | 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)
-
--- | A 32-byte key, validated at construction.
---
--- The 'Eq' instance compares in constant time.
-newtype Key32 = Key32 { unKey32 :: BS.ByteString }
- deriving Generic
-
-instance Eq Key32 where
- Key32 a == Key32 b = ct_eq_bs a b
-
--- | Constant-time bytestring equality via XOR-accumulate.
---
--- Returns 'False' immediately on length mismatch (length is
--- not considered secret); otherwise inspects every byte
--- regardless of where (or whether) inputs differ.
-ct_eq_bs :: BS.ByteString -> BS.ByteString -> Bool
-ct_eq_bs a b
- | la /= lb = False
- | otherwise = go 0 0
- where
- !la = BS.length a
- !lb = BS.length b
- go !i !acc
- | i >= la = acc == 0
- | otherwise =
- let !x = BU.unsafeIndex a i
- !y = BU.unsafeIndex b i
- in go (i + 1) (acc .|. (x `xor` y))
-{-# NOINLINE ct_eq_bs #-}
-
--- | Construct a 'Key32' from a 32-byte 'BS.ByteString'.
---
--- Returns 'Nothing' if the input is not exactly 32 bytes.
---
--- >>> key32 (BS.replicate 32 0x00)
--- Just (Key32 {unKey32 = ...})
--- >>> key32 (BS.replicate 31 0x00)
--- Nothing
-key32 :: BS.ByteString -> Maybe Key32
-key32 bs
- | BS.length bs == 32 = Just (Key32 bs)
- | otherwise = Nothing
-
--- | Construct a 'Key32' without validation.
---
--- For test and benchmark use only; prefer 'key32'.
-unsafeKey32 :: BS.ByteString -> Key32
-unsafeKey32 = Key32
-
--- | Session nonce, distinguishing send from receive direction.
-newtype SessionNonce =
- SessionNonce { unSessionNonce :: Word64 }
- deriving (Eq, Generic)
-
--- | Message payload (max 65535 bytes), validated at construction.
-newtype MessagePayload =
- MessagePayload { unMessagePayload :: BS.ByteString }
- deriving (Eq, Generic)
-
--- | Construct a 'MessagePayload' from a 'BS.ByteString'.
---
--- Returns 'Left' if the payload exceeds 65535 bytes.
-mkMessagePayload
- :: BS.ByteString -> Either Error MessagePayload
-mkMessagePayload bs
- | BS.length bs > 65535 = Left InvalidLength
- | otherwise = Right (MessagePayload bs)
-
--- | 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 :: !Key32
- -- ^ send key (32 bytes)
- , sess_sn :: !SessionNonce
- -- ^ send nonce
- , sess_sck :: !Key32
- -- ^ send chaining key
- , sess_rk :: !Key32
- -- ^ receive key (32 bytes)
- , sess_rn :: !SessionNonce
- -- ^ receive nonce
- , sess_rck :: !Key32
- -- ^ 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
-
--- handshake roles -------------------------------------------------
-
--- | Phantom type for initiator role.
-data Initiator
-
--- | Phantom type for responder role.
-data Responder
-
--- | Role-indexed handshake state.
---
--- The phantom type parameter prevents passing an initiator's
--- state to a responder function and vice versa.
-data HandshakeFor a =
- HandshakeFor { unHandshakeFor :: !HandshakeState }
-
--- 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 LE
-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
- -> Bool -- ^ True if initiator
- -> HandshakeState
-init_handshake s_sec s_pub e_sec e_pub m_rs is_init =
- let !h0 = SHA256.hash _PROTOCOL_NAME
- !ck = h0
- !h1 = mix_hash h0 _PROLOGUE
- -- Mix in responder's static pubkey
- !h2 = case (is_init, 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
- -> Pub
- -> Pub
- -> BS.ByteString
- -> Either Error
- (BS.ByteString, HandshakeFor Initiator)
-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, HandshakeFor 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
- -> Pub
- -> BS.ByteString
- -> BS.ByteString
- -> Either Error
- (BS.ByteString, HandshakeFor Responder)
-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, HandshakeFor 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
- :: HandshakeFor Initiator
- -> BS.ByteString
- -> Either Error (BS.ByteString, Handshake)
-act3 (HandshakeFor 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 = Key32 sk
- , sess_sn = SessionNonce 0
- , sess_sck = Key32 ck2
- , sess_rk = Key32 rk
- , sess_rn = SessionNonce 0
- , sess_rck = Key32 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
- :: HandshakeFor Responder
- -> BS.ByteString
- -> Either Error Handshake
-finalize (HandshakeFor 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 = Key32 sk
- , sess_sn = SessionNonce 0
- , sess_sck = Key32 ck1
- , sess_rk = Key32 rk
- , sess_rn = SessionNonce 0
- , sess_rck = Key32 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
- -> 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)
- !sk = unKey32 (sess_sk sess)
- !sn = unSessionNonce (sess_sn sess)
- !sck = unKey32 (sess_sck sess)
- lc <- note InvalidMAC
- (encrypt_with_ad sk sn BS.empty len_bytes)
- let !(sn1, sck1, sk1) = step_nonce sn sck sk
- 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 = Key32 sk2
- , sess_sn = SessionNonce sn2
- , sess_sck = Key32 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
- -> 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 nonces (i.e. every 500 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
- -> 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
- !rk = unKey32 (sess_rk sess)
- !rn = unSessionNonce (sess_rn sess)
- !rck = unKey32 (sess_rck sess)
- len_bytes <- note InvalidMAC
- (decrypt_with_ad rk rn BS.empty lc)
- len <- note InvalidLength (decode_be16 len_bytes)
- let !(rn1, rck1, rk1) = step_nonce rn rck rk
- !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 = Key32 rk2
- , sess_rn = SessionNonce rn2
- , sess_rck = Key32 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
- -> FrameResult
-decrypt_frame_partial sess buf
- | buflen < 18 = NeedMore (18 - buflen)
- | otherwise =
- let !lc = BS.take 18 buf
- !rest = BS.drop 18 buf
- !rk = unKey32 (sess_rk sess)
- !rn = unSessionNonce (sess_rn sess)
- !rck = unKey32 (sess_rck sess)
- in case decrypt_with_ad rk rn 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 rn rck rk
- 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 = Key32 rk2
- , sess_rn =
- SessionNonce rn2
- , sess_rck = Key32 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
-require :: Bool -> e -> Either e ()
-require cond e = unless cond (Left e)
-{-# INLINE require #-}
-
-fi :: (Integral a, Num b) => a -> b
-fi = fromIntegral
-{-# INLINE fi #-}
diff --git a/ppad-bolt8.cabal b/ppad-bolt8.cabal
@@ -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,11 +8,13 @@ author: Jared Tobin
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
@@ -32,14 +34,14 @@ library
ghc-options: -fllvm -O2
exposed-modules:
Lightning.Protocol.BOLT8
- Lightning.Protocol.BOLT8.Internal
build-depends:
base >= 4.9 && < 5
, bytestring >= 0.9 && < 0.13
+ , 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
@@ -48,14 +50,16 @@ test-suite bolt8-tests
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
@@ -65,15 +69,15 @@ benchmark bolt8-bench
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
@@ -81,14 +85,14 @@ benchmark bolt8-weigh
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
diff --git a/test/Main.hs b/test/Main.hs
@@ -1,791 +1,774 @@
-{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
module Main where
-import Data.Bits (xor)
+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 qualified Lightning.Protocol.BOLT8.Internal as I
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
+import qualified Test.Tasty.QuickCheck as Q
main :: IO ()
main = defaultMain $ testGroup "ppad-bolt8" [
- handshake_tests
+ key_tests
+ , handshake_tests
+ , handshake_failure_tests
, message_tests
- , framing_tests
- , partial_framing_tests
- , negative_tests
- , rotation_tests
+ , transport_tests
+ , transport_failure_tests
, property_tests
]
--- test vectors from BOLT #8 specification -----------------------------------
+-- helpers --------------------------------------------------------------------
--- initiator static private key
-initiator_s_priv :: BS.ByteString
-initiator_s_priv = hex
- "1111111111111111111111111111111111111111111111111111111111111111"
+expect_just :: String -> Maybe a -> IO a
+expect_just msg = maybe (assertFailure msg) pure
--- initiator ephemeral private key
-initiator_e_priv :: BS.ByteString
-initiator_e_priv = hex
- "1212121212121212121212121212121212121212121212121212121212121212"
+expect_right :: Show e => String -> Either e a -> IO a
+expect_right msg = either (\e -> assertFailure (msg <> ": " <> show e)) pure
--- responder static private key
-responder_s_priv :: BS.ByteString
-responder_s_priv = hex
- "2121212121212121212121212121212121212121212121212121212121212121"
+-- 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)
--- responder static public key (known to initiator)
-responder_s_pub :: BS.ByteString
-responder_s_pub = hex
- "028d7500dd4c12685d1f568b4c2b5048e8534b873319f3a8daa612b469132ec7f7"
+-- 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 ----------------------------------------------------
--- responder ephemeral private key
-responder_e_priv :: BS.ByteString
-responder_e_priv = hex
- "2222222222222222222222222222222222222222222222222222222222222222"
+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
--- expected act 1 message
-expected_act1 :: BS.ByteString
-expected_act1 = hex
+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"
-
--- expected act 2 message
-expected_act2 :: BS.ByteString
-expected_act2 = hex
+act2_msg =
"0002466d7fcae563e5cb09a0d1870bb580344804617879a14949cf22285f1bae3f27\
\6e2470b93aac583c9ef6eafca3f730ae"
-
--- expected act 3 message
-expected_act3 :: BS.ByteString
-expected_act3 = hex
+act3_msg =
"00b9e3a702e93e3a9948c2ed6e5fd7590a6e1c3a0344cfc9d5b57357049aa22355\
\361aa02e55a8fc28fef5bd6d71ad0c38228dc68b1c466263b47fdf31e560e139ba"
--- handshake tests -----------------------------------------------------------
+-- 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 "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
+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"))
]
-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 --------------------------------------------------
+-- Appendix A failure vectors -------------------------------------------------
-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
+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)
]
--- "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
+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
]
-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
+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
]
-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
+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
]
-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))
+-- 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)
--- rotation tests ------------------------------------------------------------
+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))
+ ]
-rotation_tests :: TestTree
-rotation_tests = testGroup "Key Rotation" [
- testCase "send key rotates when nonce is past 1000"
- test_rotate_past_1000_send
- , testCase "receive key rotates when nonce is past 1000"
- test_rotate_past_1000_recv
+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
--- A session whose nonces are already past 1000 must still rotate on
--- the next step rather than letting the nonce grow without bound.
-test_rotate_past_1000_send :: Assertion
-test_rotate_past_1000_send = do
- sess <- get_initiator_session
- let stale = sess { I.sess_sn = I.SessionNonce 1001 }
- (_, sess') <- expectRight "encrypt" (BOLT8.encrypt stale hello)
- I.unSessionNonce (I.sess_sn sess') @?= 1
- assertBool "send key rotated" (I.sess_sk sess' /= I.sess_sk sess)
- assertBool "send ck rotated" (I.sess_sck sess' /= I.sess_sck sess)
-
-test_rotate_past_1000_recv :: Assertion
-test_rotate_past_1000_recv = do
- i_sess <- get_initiator_session
- let i_stale = i_sess { I.sess_sn = I.SessionNonce 1001 }
- r_stale = I.Session {
- I.sess_sk = I.sess_rk i_sess
- , I.sess_sn = I.SessionNonce 0
- , I.sess_sck = I.sess_rck i_sess
- , I.sess_rk = I.sess_sk i_sess
- , I.sess_rn = I.SessionNonce 1001
- , I.sess_rck = I.sess_sck i_sess
- }
- (ct, _) <- expectRight "encrypt" (BOLT8.encrypt i_stale hello)
- (pt, r_sess') <- expectRight "decrypt" (BOLT8.decrypt r_stale ct)
- pt @?= hello
- I.unSessionNonce (I.sess_rn r_sess') @?= 1
- assertBool "recv key rotated" (I.sess_rk r_sess' /= I.sess_rk r_stale)
-
--- 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 --------------------------------------------------------------
+-- properties -----------------------------------------------------------------
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
- , testProperty "handshake authenticates remote statics"
- prop_handshake_remote_statics
- , testProperty "encrypt/decrypt survives key rotation"
- prop_key_rotation_roundtrip
- , testProperty "mkMessagePayload validates size"
- prop_mkMessagePayload_validates
- , testProperty "key32 validates length"
- prop_key32_validates
+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
]
--- 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_res, r_res) <- doHandshake' i_entropy r_entropy
- pure (BOLT8.session i_res, BOLT8.session r_res)
-
--- | Like 'doHandshake' but returns full Handshake results.
-doHandshake'
- :: BS.ByteString
- -> BS.ByteString
- -> Maybe (BOLT8.Handshake, BOLT8.Handshake)
-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 (i_res, r_res)
-
--- | Send n messages from initiator to responder,
--- advancing both session states in sync.
-advanceSessions
- :: Int
- -> BOLT8.Session
- -> BOLT8.Session
- -> Maybe (BOLT8.Session, BOLT8.Session)
-advanceSessions 0 i r = Just (i, r)
-advanceSessions n i r =
- case BOLT8.encrypt i (BS.replicate 5 0x00) of
- Left _ -> Nothing
- Right (ct, i') ->
- case BOLT8.decrypt r ct of
- Left _ -> Nothing
- Right (_, r') -> advanceSessions (n - 1) i' r'
-
--- 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
-
--- | Handshake authenticates remote static keys: each side
--- sees the other's static pubkey.
-prop_handshake_remote_statics :: Property
-prop_handshake_remote_statics =
- forAll genValidEntropy $ \i_ent ->
- forAll genValidEntropy $ \r_ent ->
- case (doHandshake' i_ent r_ent,
- BOLT8.keypair i_ent,
- BOLT8.keypair r_ent) of
- (Just (i_res, r_res),
- Just (_, i_pub),
- Just (_, r_pub)) ->
- BOLT8.remote_static i_res == r_pub
- && BOLT8.remote_static r_res == i_pub
- _ -> False
-
--- | Encrypt/decrypt roundtrip survives key rotation at
--- nonce 1000. Each encrypt uses 2 nonces (length +
--- body), so rotation happens after 500 messages.
--- We advance to message 499 then send a test payload
--- across the rotation boundary.
-prop_key_rotation_roundtrip :: Property
-prop_key_rotation_roundtrip = forAll genPayload $ \payload ->
- case doHandshake initiator_s_priv responder_s_priv of
- Nothing -> False
- Just (i_sess, r_sess) ->
- case advanceSessions 499 i_sess r_sess 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
-
--- | mkMessagePayload accepts payloads <= 65535 bytes and
--- rejects payloads > 65535.
-prop_mkMessagePayload_validates :: Property
-prop_mkMessagePayload_validates =
- forAll (choose (0, 256)) $ \len ->
- let bs = BS.replicate len 0x00
- in case BOLT8.mkMessagePayload bs of
- Right mp ->
- BOLT8.unMessagePayload mp === bs
- Left _ -> False === True
-
--- | key32 accepts exactly 32-byte inputs and rejects others.
-prop_key32_validates :: Property
-prop_key32_validates =
- forAll (choose (0, 64)) $ \len ->
- let bs = BS.replicate len 0x00
- in case BOLT8.key32 bs of
- Just k -> len === 32
- .&&. BOLT8.unKey32 k === bs
- Nothing -> (len /= 32) === True
+-- 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
