diff --git a/CHANGELOG b/CHANGELOG new file mode 100644 --- /dev/null +++ b/CHANGELOG diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,20 @@ +Copyright (c) 2025 Jared Tobin + +Permission is hereby granted, free of charge, to any person obtaining +a copy of this software and associated documentation files (the +"Software"), to deal in the Software without restriction, including +without limitation the rights to use, copy, modify, merge, publish, +distribute, sublicense, and/or sell copies of the Software, and to +permit persons to whom the Software is furnished to do so, subject to +the following conditions: + +The above copyright notice and this permission notice shall be included +in all copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. +IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY +CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, +TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE +SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. diff --git a/bench/Main.hs b/bench/Main.hs new file mode 100644 --- /dev/null +++ b/bench/Main.hs @@ -0,0 +1,85 @@ +{-# 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 as BOLT8 + +instance NFData BOLT8.Pub where + rnf p = rnf (BOLT8.serialize_pub p) + +instance NFData BOLT8.Sec +instance NFData BOLT8.Error +instance NFData BOLT8.Session +instance NFData BOLT8.HandshakeState +instance NFData BOLT8.Handshake + +main :: IO () +main = defaultMain [ + keys + , handshake + , messages + ] + +-- test keys (from BOLT #8 spec) +i_s_ent, i_e_ent, r_s_ent, r_e_ent :: BS.ByteString +i_s_ent = BS.replicate 32 0x11 +i_e_ent = BS.replicate 32 0x12 +r_s_ent = BS.replicate 32 0x21 +r_e_ent = BS.replicate 32 0x22 + +keys :: Benchmark +keys = 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 + ] + 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) + +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) diff --git a/bench/Weight.hs b/bench/Weight.hs new file mode 100644 --- /dev/null +++ b/bench/Weight.hs @@ -0,0 +1,75 @@ +{-# 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 as BOLT8 +import Weigh + +instance NFData BOLT8.Pub where + rnf p = rnf (BOLT8.serialize_pub p) + +instance NFData BOLT8.Sec +instance NFData BOLT8.Error +instance NFData BOLT8.Session +instance NFData BOLT8.HandshakeState +instance NFData BOLT8.Handshake + +-- note that 'weigh' doesn't work properly in a repl +main :: IO () +main = mainWith $ do + keys + handshake + messages + +-- test keys (from BOLT #8 spec) +i_s_ent, i_e_ent, r_s_ent, r_e_ent :: BS.ByteString +i_s_ent = BS.replicate 32 0x11 +i_e_ent = BS.replicate 32 0x12 +r_s_ent = BS.replicate 32 0x21 +r_e_ent = BS.replicate 32 0x22 + +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 diff --git a/lib/Lightning/Protocol/BOLT8.hs b/lib/Lightning/Protocol/BOLT8.hs new file mode 100644 --- /dev/null +++ b/lib/Lightning/Protocol/BOLT8.hs @@ -0,0 +1,709 @@ +{-# OPTIONS_HADDOCK prune #-} +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE ViewPatterns #-} + +-- | +-- Module: Lightning.Protocol.BOLT8 +-- Copyright: (c) 2025 Jared Tobin +-- License: MIT +-- Maintainer: Jared Tobin +-- +-- Encrypted and authenticated transport for the Lightning Network, per +-- [BOLT #8](https://github.com/lightning/bolts/blob/master/08-transport.md). +-- +-- This module implements the Noise_XK_secp256k1_ChaChaPoly_SHA256 +-- handshake and subsequent encrypted message transport. +-- +-- = Handshake +-- +-- A BOLT #8 handshake consists of three acts. The /initiator/ knows the +-- responder's static public key in advance and initiates the connection: +-- +-- @ +-- (msg1, state) <- act1 i_sec i_pub r_pub entropy +-- -- send msg1 (50 bytes) to responder +-- -- receive msg2 (50 bytes) from responder +-- (msg3, result) <- act3 state msg2 +-- -- send msg3 (66 bytes) to responder +-- let session = 'session' result +-- @ +-- +-- The /responder/ receives the connection and authenticates the initiator: +-- +-- @ +-- -- receive msg1 (50 bytes) from initiator +-- (msg2, state) <- act2 r_sec r_pub entropy msg1 +-- -- send msg2 (50 bytes) to initiator +-- -- receive msg3 (66 bytes) from initiator +-- result <- finalize state msg3 +-- let session = 'session' result +-- @ +-- +-- = Message Transport +-- +-- After a successful handshake, use 'encrypt' and 'decrypt' to exchange +-- messages. Each returns an updated 'Session' that must be used for the +-- next operation (keys rotate every 1000 messages): +-- +-- @ +-- -- sender +-- (ciphertext, session') <- 'encrypt' session plaintext +-- +-- -- receiver +-- (plaintext, session') <- 'decrypt' session ciphertext +-- @ +-- +-- = Message Framing +-- +-- BOLT #8 runs over a byte stream, so callers often need to deal with +-- partial buffers. Use 'decrypt_frame' when you have exactly one frame, +-- or 'decrypt_frame_partial' to handle incremental reads and return how +-- many bytes are still needed. +-- +-- Maximum plaintext size is 65535 bytes. + +module Lightning.Protocol.BOLT8 ( + -- * Keys + Sec + , Pub + , keypair + , parse_pub + , serialize_pub + + -- * Handshake (initiator) + , act1 + , act3 + + -- * Handshake (responder) + , act2 + , finalize + + -- * Session + , Session + , HandshakeState + , Handshake(..) + , encrypt + , decrypt + , decrypt_frame + , decrypt_frame_partial + , FrameResult(..) + + -- * Errors + , Error(..) + ) where + +import Control.Monad (guard, unless) +import qualified Crypto.AEAD.ChaCha20Poly1305 as AEAD +import qualified Crypto.Curve.Secp256k1 as Secp256k1 +import qualified Crypto.Hash.SHA256 as SHA256 +import qualified Crypto.KDF.HMAC as HKDF +import Data.Bits (unsafeShiftR, (.&.)) +import qualified Data.ByteString as BS +import Data.Word (Word16, Word64) +import GHC.Generics (Generic) + +-- types --------------------------------------------------------------------- + +-- | Secret key (32 bytes). +newtype Sec = Sec BS.ByteString + deriving (Eq, Generic) + +-- | Compressed public key. +newtype Pub = Pub Secp256k1.Projective + +instance Eq Pub where + (Pub a) == (Pub b) = + Secp256k1.serialize_point a == Secp256k1.serialize_point b + +instance Show Pub where + show (Pub p) = "Pub " ++ show (Secp256k1.serialize_point p) + +-- | Handshake errors. +data Error = + InvalidKey + | InvalidPub + | InvalidMAC + | InvalidVersion + | InvalidLength + | DecryptionFailed + deriving (Eq, Show, Generic) + +-- | Result of attempting to decrypt a frame from a partial buffer. +data FrameResult = + NeedMore {-# UNPACK #-} !Int + -- ^ More bytes needed; the 'Int' is the minimum additional bytes required. + | FrameOk !BS.ByteString !BS.ByteString !Session + -- ^ Successfully decrypted: plaintext, remainder, updated session. + | FrameError !Error + -- ^ Decryption failed with the given error. + deriving Generic + +-- | Post-handshake session state. +data Session = Session { + sess_sk :: {-# UNPACK #-} !BS.ByteString -- ^ send key (32 bytes) + , sess_sn :: {-# UNPACK #-} !Word64 -- ^ send nonce + , sess_sck :: {-# UNPACK #-} !BS.ByteString -- ^ send chaining key + , sess_rk :: {-# UNPACK #-} !BS.ByteString -- ^ receive key (32 bytes) + , sess_rn :: {-# UNPACK #-} !Word64 -- ^ receive nonce + , sess_rck :: {-# UNPACK #-} !BS.ByteString -- ^ receive chaining key + } + deriving Generic + +-- | Result of a successful handshake. +data Handshake = Handshake { + session :: !Session -- ^ session state + , remote_static :: !Pub -- ^ authenticated remote static pubkey + } + deriving Generic + +-- | Internal handshake state (exported for benchmarking). +data HandshakeState = HandshakeState { + hs_h :: {-# UNPACK #-} !BS.ByteString -- handshake hash (32 bytes) + , hs_ck :: {-# UNPACK #-} !BS.ByteString -- chaining key (32 bytes) + , hs_temp_k :: {-# UNPACK #-} !BS.ByteString -- temp key (32 bytes) + , hs_e_sec :: !Sec -- ephemeral secret + , hs_e_pub :: !Pub -- ephemeral public + , hs_s_sec :: !Sec -- static secret + , hs_s_pub :: !Pub -- static public + , hs_re :: !(Maybe Pub) -- remote ephemeral + , hs_rs :: !(Maybe Pub) -- remote static + } + deriving Generic + +-- protocol constants -------------------------------------------------------- + +_PROTOCOL_NAME :: BS.ByteString +_PROTOCOL_NAME = "Noise_XK_secp256k1_ChaChaPoly_SHA256" + +_PROLOGUE :: BS.ByteString +_PROLOGUE = "lightning" + +-- key operations ------------------------------------------------------------ + +-- | Derive a keypair from 32 bytes of entropy. +-- +-- Returns Nothing if the entropy is invalid (zero or >= curve order). +-- +-- >>> let ent = BS.replicate 32 0x11 +-- >>> case keypair ent of { Just _ -> "ok"; Nothing -> "fail" } +-- "ok" +-- >>> keypair (BS.replicate 31 0x11) -- wrong length +-- Nothing +keypair :: BS.ByteString -> Maybe (Sec, Pub) +keypair ent = do + guard (BS.length ent == 32) + k <- Secp256k1.parse_int256 ent + p <- Secp256k1.derive_pub k + pure (Sec ent, Pub p) + +-- | Parse a 33-byte compressed public key. +-- +-- >>> let Just (_, pub) = keypair (BS.replicate 32 0x11) +-- >>> let bytes = serialize_pub pub +-- >>> case parse_pub bytes of { Just _ -> "ok"; Nothing -> "fail" } +-- "ok" +-- >>> parse_pub (BS.replicate 32 0x00) -- wrong length +-- Nothing +parse_pub :: BS.ByteString -> Maybe Pub +parse_pub bs = do + guard (BS.length bs == 33) + p <- Secp256k1.parse_point bs + pure (Pub p) + +-- | Serialize a public key to 33-byte compressed form. +-- +-- >>> let Just (_, pub) = keypair (BS.replicate 32 0x11) +-- >>> BS.length (serialize_pub pub) +-- 33 +serialize_pub :: Pub -> BS.ByteString +serialize_pub (Pub p) = Secp256k1.serialize_point p + +-- cryptographic primitives -------------------------------------------------- + +-- bolt8-style ECDH +ecdh :: Sec -> Pub -> Maybe BS.ByteString +ecdh (Sec sec) (Pub pub) = do + k <- Secp256k1.parse_int256 sec + pt <- Secp256k1.mul pub k + let compressed = Secp256k1.serialize_point pt + pure (SHA256.hash compressed) + +-- h' = SHA256(h || data) +mix_hash :: BS.ByteString -> BS.ByteString -> BS.ByteString +mix_hash h dat = SHA256.hash (h <> dat) + +-- Mix key: (ck', k) = HKDF(ck, input_key_material) +-- +-- NB HKDF limits output to 255 * hashlen bytes. For SHA256 that's 8160, +-- well above the 64 bytes requested here, so 'Nothing' is impossible. +mix_key :: BS.ByteString -> BS.ByteString -> (BS.ByteString, BS.ByteString) +mix_key ck ikm = case HKDF.derive hmac ck mempty 64 ikm of + Nothing -> error "ppad-bolt8: internal error, please report a bug!" + Just output -> BS.splitAt 32 output + where + hmac k b = case SHA256.hmac k b of + SHA256.MAC mac -> mac + +-- Encrypt with associated data using ChaCha20-Poly1305 +encrypt_with_ad + :: BS.ByteString -- ^ key (32 bytes) + -> Word64 -- ^ nonce + -> BS.ByteString -- ^ associated data + -> BS.ByteString -- ^ plaintext + -> Maybe BS.ByteString -- ^ ciphertext || mac (16 bytes) +encrypt_with_ad key n ad pt = + case AEAD.encrypt ad key (encode_nonce n) pt of + Left _ -> Nothing + Right (ct, mac) -> Just (ct <> mac) + +-- Decrypt with associated data using ChaCha20-Poly1305 +decrypt_with_ad + :: BS.ByteString -- ^ key (32 bytes) + -> Word64 -- ^ nonce + -> BS.ByteString -- ^ associated data + -> BS.ByteString -- ^ ciphertext || mac + -> Maybe BS.ByteString -- ^ plaintext +decrypt_with_ad key n ad ctmac + | BS.length ctmac < 16 = Nothing + | otherwise = + let (ct, mac) = BS.splitAt (BS.length ctmac - 16) ctmac + in case AEAD.decrypt ad key (encode_nonce n) (ct, mac) of + Left _ -> Nothing + Right pt -> Just pt + +-- Encode nonce as 96-bit value: 4 zero bytes + 8-byte little-endian +encode_nonce :: Word64 -> BS.ByteString +encode_nonce n = BS.replicate 4 0x00 <> encode_le64 n + +-- Little-endian 64-bit encoding +encode_le64 :: Word64 -> BS.ByteString +encode_le64 n = BS.pack [ + fi (n .&. 0xff) + , fi (unsafeShiftR n 8 .&. 0xff) + , fi (unsafeShiftR n 16 .&. 0xff) + , fi (unsafeShiftR n 24 .&. 0xff) + , fi (unsafeShiftR n 32 .&. 0xff) + , fi (unsafeShiftR n 40 .&. 0xff) + , fi (unsafeShiftR n 48 .&. 0xff) + , fi (unsafeShiftR n 56 .&. 0xff) + ] + +-- Big-endian 16-bit encoding +encode_be16 :: Word16 -> BS.ByteString +encode_be16 n = BS.pack [fi (unsafeShiftR n 8), fi (n .&. 0xff)] + +-- Big-endian 16-bit decoding +decode_be16 :: BS.ByteString -> Maybe Word16 +decode_be16 bs + | BS.length bs /= 2 = Nothing + | otherwise = + let !b0 = BS.index bs 0 + !b1 = BS.index bs 1 + in Just (fi b0 * 0x100 + fi b1) + +-- handshake ----------------------------------------------------------------- + +-- Initialize handshake state +-- +-- h = SHA256(protocol_name) +-- ck = h +-- h = SHA256(h || prologue) +-- h = SHA256(h || responder_static_pubkey) +init_handshake + :: Sec -- ^ local static secret + -> Pub -- ^ local static public + -> Sec -- ^ ephemeral secret + -> Pub -- ^ ephemeral public + -> Maybe Pub -- ^ remote static (initiator knows, responder doesn't) + -> Bool -- ^ True if initiator + -> HandshakeState +init_handshake s_sec s_pub e_sec e_pub m_rs is_initiator = + let !h0 = SHA256.hash _PROTOCOL_NAME + !ck = h0 + !h1 = mix_hash h0 _PROLOGUE + -- Mix in responder's static pubkey + !h2 = case (is_initiator, m_rs) of + (True, Just rs) -> mix_hash h1 (serialize_pub rs) + (False, Nothing) -> mix_hash h1 (serialize_pub s_pub) + _ -> h1 -- shouldn't happen + in HandshakeState { + hs_h = h2 + , hs_ck = ck + , hs_temp_k = BS.replicate 32 0x00 + , hs_e_sec = e_sec + , hs_e_pub = e_pub + , hs_s_sec = s_sec + , hs_s_pub = s_pub + , hs_re = Nothing + , hs_rs = m_rs + } + +-- | Initiator: generate Act 1 message (50 bytes). +-- +-- Takes local static key, remote static pubkey, and 32 bytes of +-- entropy for ephemeral key generation. +-- +-- Returns the 50-byte Act 1 message and handshake state for Act 3. +-- +-- >>> let Just (i_sec, i_pub) = keypair (BS.replicate 32 0x11) +-- >>> let Just (r_sec, r_pub) = keypair (BS.replicate 32 0x21) +-- >>> let eph_ent = BS.replicate 32 0x12 +-- >>> case act1 i_sec i_pub r_pub eph_ent of { Right (msg, _) -> BS.length msg; Left _ -> 0 } +-- 50 +act1 + :: Sec -- ^ local static secret + -> Pub -- ^ local static public + -> Pub -- ^ remote static public (responder's) + -> BS.ByteString -- ^ 32 bytes entropy for ephemeral + -> Either Error (BS.ByteString, HandshakeState) +act1 s_sec s_pub rs ent = do + (e_sec, e_pub) <- note InvalidKey (keypair ent) + let !hs0 = init_handshake s_sec s_pub e_sec e_pub (Just rs) True + !e_pub_bytes = serialize_pub e_pub + !h1 = mix_hash (hs_h hs0) e_pub_bytes + es <- note InvalidKey (ecdh e_sec rs) + let !(ck1, temp_k1) = mix_key (hs_ck hs0) es + c <- note InvalidMAC (encrypt_with_ad temp_k1 0 h1 BS.empty) + let !h2 = mix_hash h1 c + !msg = BS.singleton 0x00 <> e_pub_bytes <> c + !hs1 = hs0 { + hs_h = h2 + , hs_ck = ck1 + , hs_temp_k = temp_k1 + } + pure (msg, hs1) + +-- | Responder: process Act 1 and generate Act 2 message (50 bytes). +-- +-- Takes local static key and 32 bytes of entropy for ephemeral key, +-- plus the 50-byte Act 1 message from initiator. +-- +-- Returns the 50-byte Act 2 message and handshake state for finalize. +-- +-- >>> let Just (i_sec, i_pub) = keypair (BS.replicate 32 0x11) +-- >>> let Just (r_sec, r_pub) = keypair (BS.replicate 32 0x21) +-- >>> let Right (msg1, _) = act1 i_sec i_pub r_pub (BS.replicate 32 0x12) +-- >>> case act2 r_sec r_pub (BS.replicate 32 0x22) msg1 of { Right (msg, _) -> BS.length msg; Left _ -> 0 } +-- 50 +act2 + :: Sec -- ^ local static secret + -> Pub -- ^ local static public + -> BS.ByteString -- ^ 32 bytes entropy for ephemeral + -> BS.ByteString -- ^ Act 1 message (50 bytes) + -> Either Error (BS.ByteString, HandshakeState) +act2 s_sec s_pub ent msg1 = do + require (BS.length msg1 == 50) InvalidLength + let !version = BS.index msg1 0 + !re_bytes = BS.take 33 (BS.drop 1 msg1) + !c = BS.drop 34 msg1 + require (version == 0x00) InvalidVersion + re <- note InvalidPub (parse_pub re_bytes) + (e_sec, e_pub) <- note InvalidKey (keypair ent) + let !hs0 = init_handshake s_sec s_pub e_sec e_pub Nothing False + !h1 = mix_hash (hs_h hs0) re_bytes + es <- note InvalidKey (ecdh s_sec re) + let !(ck1, temp_k1) = mix_key (hs_ck hs0) es + _ <- note InvalidMAC (decrypt_with_ad temp_k1 0 h1 c) + let !h2 = mix_hash h1 c + !e_pub_bytes = serialize_pub e_pub + !h3 = mix_hash h2 e_pub_bytes + ee <- note InvalidKey (ecdh e_sec re) + let !(ck2, temp_k2) = mix_key ck1 ee + c2 <- note InvalidMAC (encrypt_with_ad temp_k2 0 h3 BS.empty) + let !h4 = mix_hash h3 c2 + !msg = BS.singleton 0x00 <> e_pub_bytes <> c2 + !hs1 = hs0 { + hs_h = h4 + , hs_ck = ck2 + , hs_temp_k = temp_k2 + , hs_re = Just re + } + pure (msg, hs1) + +-- | Initiator: process Act 2 and generate Act 3 (66 bytes), completing +-- the handshake. +-- +-- Returns the 66-byte Act 3 message and the handshake result. +-- +-- >>> let Just (i_sec, i_pub) = keypair (BS.replicate 32 0x11) +-- >>> let Just (r_sec, r_pub) = keypair (BS.replicate 32 0x21) +-- >>> let Right (msg1, i_hs) = act1 i_sec i_pub r_pub (BS.replicate 32 0x12) +-- >>> let Right (msg2, _) = act2 r_sec r_pub (BS.replicate 32 0x22) msg1 +-- >>> case act3 i_hs msg2 of { Right (msg, _) -> BS.length msg; Left _ -> 0 } +-- 66 +act3 + :: HandshakeState -- ^ state after Act 1 + -> BS.ByteString -- ^ Act 2 message (50 bytes) + -> Either Error (BS.ByteString, Handshake) +act3 hs msg2 = do + require (BS.length msg2 == 50) InvalidLength + let !version = BS.index msg2 0 + !re_bytes = BS.take 33 (BS.drop 1 msg2) + !c = BS.drop 34 msg2 + require (version == 0x00) InvalidVersion + re <- note InvalidPub (parse_pub re_bytes) + let !h1 = mix_hash (hs_h hs) re_bytes + ee <- note InvalidKey (ecdh (hs_e_sec hs) re) + let !(ck1, temp_k2) = mix_key (hs_ck hs) ee + _ <- note InvalidMAC (decrypt_with_ad temp_k2 0 h1 c) + let !h2 = mix_hash h1 c + !s_pub_bytes = serialize_pub (hs_s_pub hs) + c3 <- note InvalidMAC (encrypt_with_ad temp_k2 1 h2 s_pub_bytes) + let !h3 = mix_hash h2 c3 + se <- note InvalidKey (ecdh (hs_s_sec hs) re) + let !(ck2, temp_k3) = mix_key ck1 se + t <- note InvalidMAC (encrypt_with_ad temp_k3 0 h3 BS.empty) + let !(sk, rk) = mix_key ck2 BS.empty + !msg = BS.singleton 0x00 <> c3 <> t + !sess = Session { + sess_sk = sk + , sess_sn = 0 + , sess_sck = ck2 + , sess_rk = rk + , sess_rn = 0 + , sess_rck = ck2 + } + rs <- note InvalidPub (hs_rs hs) + let !result = Handshake { + session = sess + , remote_static = rs + } + pure (msg, result) + +-- | Responder: process Act 3 (66 bytes) and complete the handshake. +-- +-- Returns the handshake result with authenticated remote static pubkey. +-- +-- >>> let Just (i_sec, i_pub) = keypair (BS.replicate 32 0x11) +-- >>> let Just (r_sec, r_pub) = keypair (BS.replicate 32 0x21) +-- >>> let Right (msg1, i_hs) = act1 i_sec i_pub r_pub (BS.replicate 32 0x12) +-- >>> let Right (msg2, r_hs) = act2 r_sec r_pub (BS.replicate 32 0x22) msg1 +-- >>> let Right (msg3, _) = act3 i_hs msg2 +-- >>> case finalize r_hs msg3 of { Right _ -> "ok"; Left e -> show e } +-- "ok" +finalize + :: HandshakeState -- ^ state after Act 2 + -> BS.ByteString -- ^ Act 3 message (66 bytes) + -> Either Error Handshake +finalize hs msg3 = do + require (BS.length msg3 == 66) InvalidLength + let !version = BS.index msg3 0 + !c = BS.take 49 (BS.drop 1 msg3) + !t = BS.drop 50 msg3 + require (version == 0x00) InvalidVersion + rs_bytes <- note InvalidMAC (decrypt_with_ad (hs_temp_k hs) 1 (hs_h hs) c) + rs <- note InvalidPub (parse_pub rs_bytes) + let !h1 = mix_hash (hs_h hs) c + se <- note InvalidKey (ecdh (hs_e_sec hs) rs) + let !(ck1, temp_k3) = mix_key (hs_ck hs) se + _ <- note InvalidMAC (decrypt_with_ad temp_k3 0 h1 t) + -- responder swaps order (receives what initiator sends) + let !(rk, sk) = mix_key ck1 BS.empty + !sess = Session { + sess_sk = sk + , sess_sn = 0 + , sess_sck = ck1 + , sess_rk = rk + , sess_rn = 0 + , sess_rck = ck1 + } + !result = Handshake { + session = sess + , remote_static = rs + } + pure result + +-- message encryption -------------------------------------------------------- + +-- | Encrypt a message (max 65535 bytes). +-- +-- Returns the encrypted packet and updated session. Key rotation +-- is handled automatically at nonce 1000. +-- +-- Wire format: encrypted_length (2) || MAC (16) || encrypted_body || MAC (16) +-- +-- >>> let Just (i_sec, i_pub) = keypair (BS.replicate 32 0x11) +-- >>> let Just (r_sec, r_pub) = keypair (BS.replicate 32 0x21) +-- >>> let Right (msg1, i_hs) = act1 i_sec i_pub r_pub (BS.replicate 32 0x12) +-- >>> let Right (msg2, _) = act2 r_sec r_pub (BS.replicate 32 0x22) msg1 +-- >>> let Right (_, i_result) = act3 i_hs msg2 +-- >>> let sess = session i_result +-- >>> case encrypt sess "hello" of { Right (ct, _) -> BS.length ct; Left _ -> 0 } +-- 39 +encrypt + :: Session + -> BS.ByteString -- ^ plaintext (max 65535 bytes) + -> Either Error (BS.ByteString, Session) +encrypt sess pt = do + let !len = BS.length pt + require (len <= 65535) InvalidLength + let !len_bytes = encode_be16 (fi len) + lc <- note InvalidMAC (encrypt_with_ad (sess_sk sess) (sess_sn sess) + BS.empty len_bytes) + let !(sn1, sck1, sk1) = step_nonce (sess_sn sess) (sess_sck sess) (sess_sk sess) + bc <- note InvalidMAC (encrypt_with_ad sk1 sn1 BS.empty pt) + let !(sn2, sck2, sk2) = step_nonce sn1 sck1 sk1 + !packet = lc <> bc + !sess' = sess { + sess_sk = sk2 + , sess_sn = sn2 + , sess_sck = sck2 + } + pure (packet, sess') + +-- | Decrypt a message, requiring an exact packet with no trailing bytes. +-- +-- Returns the plaintext and updated session. Key rotation +-- is handled automatically at nonce 1000. +-- +-- This is a strict variant that rejects any trailing data. For +-- streaming use cases where you need to handle multiple frames in a +-- buffer, use 'decrypt_frame' instead. +-- +-- >>> let Just (i_sec, i_pub) = keypair (BS.replicate 32 0x11) +-- >>> let Just (r_sec, r_pub) = keypair (BS.replicate 32 0x21) +-- >>> let Right (msg1, i_hs) = act1 i_sec i_pub r_pub (BS.replicate 32 0x12) +-- >>> let Right (msg2, r_hs) = act2 r_sec r_pub (BS.replicate 32 0x22) msg1 +-- >>> let Right (msg3, i_result) = act3 i_hs msg2 +-- >>> let Right r_result = finalize r_hs msg3 +-- >>> let Right (ct, _) = encrypt (session i_result) "hello" +-- >>> case decrypt (session r_result) ct of { Right (pt, _) -> pt; Left _ -> "fail" } +-- "hello" +decrypt + :: Session + -> BS.ByteString -- ^ encrypted packet (exact length required) + -> Either Error (BS.ByteString, Session) +decrypt sess packet = do + (pt, remainder, sess') <- decrypt_frame sess packet + require (BS.null remainder) InvalidLength + pure (pt, sess') + +-- | Decrypt a single frame from a buffer, returning the remainder. +-- +-- Returns the plaintext, any unconsumed bytes, and the updated session. +-- Key rotation is handled automatically every 1000 messages. +-- +-- This is useful for streaming scenarios where multiple messages may +-- be buffered together. The remainder can be passed to the next call +-- to 'decrypt_frame'. +-- +-- Wire format consumed: encrypted_length (18) || encrypted_body (len + 16) +-- +-- >>> let Just (i_sec, i_pub) = keypair (BS.replicate 32 0x11) +-- >>> let Just (r_sec, r_pub) = keypair (BS.replicate 32 0x21) +-- >>> let Right (msg1, i_hs) = act1 i_sec i_pub r_pub (BS.replicate 32 0x12) +-- >>> let Right (msg2, r_hs) = act2 r_sec r_pub (BS.replicate 32 0x22) msg1 +-- >>> let Right (msg3, i_result) = act3 i_hs msg2 +-- >>> let Right r_result = finalize r_hs msg3 +-- >>> let Right (ct, _) = encrypt (session i_result) "hello" +-- >>> case decrypt_frame (session r_result) ct of { Right (pt, rem, _) -> (pt, BS.null rem); Left _ -> ("fail", False) } +-- ("hello",True) +decrypt_frame + :: Session + -> BS.ByteString -- ^ buffer containing at least one encrypted frame + -> Either Error (BS.ByteString, BS.ByteString, Session) +decrypt_frame sess packet = do + require (BS.length packet >= 34) InvalidLength + let !lc = BS.take 18 packet + !rest = BS.drop 18 packet + len_bytes <- note InvalidMAC (decrypt_with_ad (sess_rk sess) (sess_rn sess) + BS.empty lc) + len <- note InvalidLength (decode_be16 len_bytes) + let !(rn1, rck1, rk1) = step_nonce (sess_rn sess) (sess_rck sess) (sess_rk sess) + !body_len = fi len + 16 + require (BS.length rest >= body_len) InvalidLength + let !bc = BS.take body_len rest + !remainder = BS.drop body_len rest + pt <- note InvalidMAC (decrypt_with_ad rk1 rn1 BS.empty bc) + let !(rn2, rck2, rk2) = step_nonce rn1 rck1 rk1 + !sess' = sess { + sess_rk = rk2 + , sess_rn = rn2 + , sess_rck = rck2 + } + pure (pt, remainder, sess') + +-- | Decrypt a frame from a partial buffer, indicating when more data needed. +-- +-- Unlike 'decrypt_frame', this function handles incomplete buffers +-- gracefully by returning 'NeedMore' with the number of additional +-- bytes required to make progress. +-- +-- * If the buffer has fewer than 18 bytes (encrypted length + MAC), +-- returns @'NeedMore' n@ where @n@ is the bytes still needed. +-- * If the length header is complete but the body is incomplete, +-- returns @'NeedMore' n@ with bytes needed for the full frame. +-- * MAC or decryption failures return 'FrameError'. +-- * A complete, valid frame returns 'FrameOk' with plaintext, +-- remainder, and updated session. +-- +-- This is useful for non-blocking I/O where data arrives incrementally. +decrypt_frame_partial + :: Session + -> BS.ByteString -- ^ buffer (possibly incomplete) + -> FrameResult +decrypt_frame_partial sess buf + | buflen < 18 = NeedMore (18 - buflen) + | otherwise = + let !lc = BS.take 18 buf + !rest = BS.drop 18 buf + in case decrypt_with_ad (sess_rk sess) (sess_rn sess) BS.empty lc of + Nothing -> FrameError InvalidMAC + Just len_bytes -> case decode_be16 len_bytes of + Nothing -> FrameError InvalidLength + Just len -> + let !body_len = fi len + 16 + !(rn1, rck1, rk1) = step_nonce (sess_rn sess) + (sess_rck sess) (sess_rk sess) + in if BS.length rest < body_len + then NeedMore (body_len - BS.length rest) + else + let !bc = BS.take body_len rest + !remainder = BS.drop body_len rest + in case decrypt_with_ad rk1 rn1 BS.empty bc of + Nothing -> FrameError InvalidMAC + Just pt -> + let !(rn2, rck2, rk2) = step_nonce rn1 rck1 rk1 + !sess' = sess { + sess_rk = rk2 + , sess_rn = rn2 + , sess_rck = rck2 + } + in FrameOk pt remainder sess' + where + !buflen = BS.length buf + +-- key rotation -------------------------------------------------------------- + +-- Key rotation occurs after nonce reaches 1000 (i.e., before using 1000) +-- (ck', k') = HKDF(ck, k), reset nonce to 0 +step_nonce + :: Word64 + -> BS.ByteString + -> BS.ByteString + -> (Word64, BS.ByteString, BS.ByteString) +step_nonce n ck k + | n + 1 == 1000 = + let !(ck', k') = mix_key ck k + in (0, ck', k') + | otherwise = (n + 1, ck, k) + +-- utilities ----------------------------------------------------------------- + +-- Lift Maybe to Either +note :: e -> Maybe a -> Either e a +note e = maybe (Left e) Right +{-# INLINE note #-} + +-- Require condition or fail +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 new file mode 100644 --- /dev/null +++ b/ppad-bolt8.cabal @@ -0,0 +1,86 @@ +cabal-version: 3.0 +name: ppad-bolt8 +version: 0.0.1 +synopsis: Encrypted and authenticated transport per BOLT #8 +license: MIT +license-file: LICENSE +author: Jared Tobin +maintainer: jared@ppad.tech +category: Cryptography +build-type: Simple +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). + +source-repository head + type: git + location: git.ppad.tech/bolt8.git + +library + default-language: Haskell2010 + hs-source-dirs: lib + ghc-options: + -Wall + exposed-modules: + Lightning.Protocol.BOLT8 + build-depends: + base >= 4.9 && < 5 + , bytestring >= 0.9 && < 0.13 + , ppad-aead >= 0.3 && < 0.4 + , ppad-hkdf >= 0.3.2 && < 0.4 + , ppad-secp256k1 >= 0.5.3 && < 0.6 + , ppad-sha256 >= 0.3 && < 0.4 + +test-suite bolt8-tests + type: exitcode-stdio-1.0 + default-language: Haskell2010 + hs-source-dirs: test + main-is: Main.hs + + ghc-options: + -rtsopts -Wall -O2 + + build-depends: + base + , bytestring + , ppad-base16 + , ppad-bolt8 + , QuickCheck + , tasty + , tasty-hunit + , tasty-quickcheck + +benchmark bolt8-bench + type: exitcode-stdio-1.0 + default-language: Haskell2010 + hs-source-dirs: bench + main-is: Main.hs + + ghc-options: + -rtsopts -O2 -Wall -fno-warn-orphans + + build-depends: + base + , bytestring + , criterion + , deepseq + , ppad-bolt8 + +benchmark bolt8-weigh + type: exitcode-stdio-1.0 + default-language: Haskell2010 + hs-source-dirs: bench + main-is: Weight.hs + + ghc-options: + -rtsopts -O2 -Wall -fno-warn-orphans + + build-depends: + base + , bytestring + , deepseq + , ppad-bolt8 + , weigh + diff --git a/test/Main.hs b/test/Main.hs new file mode 100644 --- /dev/null +++ b/test/Main.hs @@ -0,0 +1,657 @@ +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} + +module Main where + +import Data.Bits (xor) +import qualified Data.ByteString as BS +import qualified Data.ByteString.Base16 as B16 +import qualified Lightning.Protocol.BOLT8 as BOLT8 +import Test.Tasty +import Test.Tasty.HUnit +import Test.Tasty.QuickCheck (Gen, Property, choose, forAll, testProperty, + vectorOf) + +-- test helpers ---------------------------------------------------------------- + +-- | Extract a Just value or fail the test. +expectJust :: String -> Maybe a -> IO a +expectJust msg = \case + Nothing -> assertFailure msg >> error "unreachable" + Just a -> pure a + +-- | Extract a Right value or fail the test. +expectRight :: Show e => String -> Either e a -> IO a +expectRight msg = \case + Left e -> assertFailure (msg ++ ": " ++ show e) >> error "unreachable" + Right a -> pure a + +main :: IO () +main = defaultMain $ testGroup "ppad-bolt8" [ + handshake_tests + , message_tests + , framing_tests + , partial_framing_tests + , negative_tests + , property_tests + ] + +-- test vectors from BOLT #8 specification ----------------------------------- + +-- initiator static private key +initiator_s_priv :: BS.ByteString +initiator_s_priv = hex + "1111111111111111111111111111111111111111111111111111111111111111" + +-- initiator ephemeral private key +initiator_e_priv :: BS.ByteString +initiator_e_priv = hex + "1212121212121212121212121212121212121212121212121212121212121212" + +-- responder static private key +responder_s_priv :: BS.ByteString +responder_s_priv = hex + "2121212121212121212121212121212121212121212121212121212121212121" + +-- responder static public key (known to initiator) +responder_s_pub :: BS.ByteString +responder_s_pub = hex + "028d7500dd4c12685d1f568b4c2b5048e8534b873319f3a8daa612b469132ec7f7" + +-- responder ephemeral private key +responder_e_priv :: BS.ByteString +responder_e_priv = hex + "2222222222222222222222222222222222222222222222222222222222222222" + +-- expected act 1 message +expected_act1 :: BS.ByteString +expected_act1 = hex + "00036360e856310ce5d294e8be33fc807077dc56ac80d95d9cd4ddbd21325eff73f7\ + \0df6086551151f58b8afe6c195782c6a" + +-- expected act 2 message +expected_act2 :: BS.ByteString +expected_act2 = hex + "0002466d7fcae563e5cb09a0d1870bb580344804617879a14949cf22285f1bae3f27\ + \6e2470b93aac583c9ef6eafca3f730ae" + +-- expected act 3 message +expected_act3 :: BS.ByteString +expected_act3 = hex + "00b9e3a702e93e3a9948c2ed6e5fd7590a6e1c3a0344cfc9d5b57357049aa22355\ + \361aa02e55a8fc28fef5bd6d71ad0c38228dc68b1c466263b47fdf31e560e139ba" + +-- handshake tests ----------------------------------------------------------- + +handshake_tests :: TestTree +handshake_tests = testGroup "Handshake" [ + testCase "act1 matches spec vector" test_act1 + , testCase "act2 matches spec vector" test_act2 + , testCase "act3 matches spec vector" test_act3 + , testCase "full handshake round-trip" test_full_handshake + ] + +test_act1 :: Assertion +test_act1 = do + (i_s_sec, i_s_pub) <- expectJust "initiator keypair" + (BOLT8.keypair initiator_s_priv) + rs <- expectJust "responder pub" (BOLT8.parse_pub responder_s_pub) + (act1_msg, _) <- expectRight "act1" (BOLT8.act1 i_s_sec i_s_pub rs + initiator_e_priv) + act1_msg @?= expected_act1 + +test_act2 :: Assertion +test_act2 = do + (i_s_sec, i_s_pub) <- expectJust "initiator keypair" + (BOLT8.keypair initiator_s_priv) + (r_s_sec, r_s_pub) <- expectJust "responder keypair" + (BOLT8.keypair responder_s_priv) + rs <- expectJust "responder pub" (BOLT8.parse_pub responder_s_pub) + (msg1, _) <- expectRight "act1" (BOLT8.act1 i_s_sec i_s_pub rs + initiator_e_priv) + (msg2, _) <- expectRight "act2" (BOLT8.act2 r_s_sec r_s_pub responder_e_priv + msg1) + msg2 @?= expected_act2 + +test_act3 :: Assertion +test_act3 = do + (i_s_sec, i_s_pub) <- expectJust "initiator keypair" + (BOLT8.keypair initiator_s_priv) + (r_s_sec, r_s_pub) <- expectJust "responder keypair" + (BOLT8.keypair responder_s_priv) + rs <- expectJust "responder pub" (BOLT8.parse_pub responder_s_pub) + (msg1, i_hs) <- expectRight "act1" (BOLT8.act1 i_s_sec i_s_pub rs + initiator_e_priv) + (msg2, _) <- expectRight "act2" (BOLT8.act2 r_s_sec r_s_pub responder_e_priv + msg1) + (msg3, _) <- expectRight "act3" (BOLT8.act3 i_hs msg2) + msg3 @?= expected_act3 + +test_full_handshake :: Assertion +test_full_handshake = do + (i_s_sec, i_s_pub) <- expectJust "initiator keypair" + (BOLT8.keypair initiator_s_priv) + (r_s_sec, r_s_pub) <- expectJust "responder keypair" + (BOLT8.keypair responder_s_priv) + rs <- expectJust "responder pub" (BOLT8.parse_pub responder_s_pub) + (msg1, i_hs) <- expectRight "act1" (BOLT8.act1 i_s_sec i_s_pub rs + initiator_e_priv) + (msg2, r_hs) <- expectRight "act2" (BOLT8.act2 r_s_sec r_s_pub responder_e_priv + msg1) + (msg3, i_result) <- expectRight "act3" (BOLT8.act3 i_hs msg2) + r_result <- expectRight "finalize" (BOLT8.finalize r_hs msg3) + BOLT8.remote_static i_result @?= r_s_pub + BOLT8.remote_static r_result @?= i_s_pub + +-- message encryption tests -------------------------------------------------- + +message_tests :: TestTree +message_tests = testGroup "Message Encryption" [ + testCase "message 0 matches spec" test_message_0 + , testCase "message 1 matches spec" test_message_1 + , testCase "message 500 matches spec" test_message_500 + , testCase "message 501 matches spec" test_message_501 + , testCase "message 1000 matches spec" test_message_1000 + , testCase "message 1001 matches spec" test_message_1001 + , testCase "decrypt round-trip" test_decrypt_roundtrip + ] + +-- "hello" = 0x68656c6c6f +hello :: BS.ByteString +hello = "hello" + +-- expected encrypted messages +expected_msg_0 :: BS.ByteString +expected_msg_0 = hex + "cf2b30ddf0cf3f80e7c35a6e6730b59fe802473180f396d88a8fb0db8cbcf25d\ + \2f214cf9ea1d95" + +expected_msg_1 :: BS.ByteString +expected_msg_1 = hex + "72887022101f0b6753e0c7de21657d35a4cb2a1f5cde2650528bbc8f837d0f0d\ + \7ad833b1a256a1" + +expected_msg_500 :: BS.ByteString +expected_msg_500 = hex + "178cb9d7387190fa34db9c2d50027d21793c9bc2d40b1e14dcf30ebeeeb220f4\ + \8364f7a4c68bf8" + +expected_msg_501 :: BS.ByteString +expected_msg_501 = hex + "1b186c57d44eb6de4c057c49940d79bb838a145cb528d6e8fd26dbe50a60ca2c\ + \104b56b60e45bd" + +expected_msg_1000 :: BS.ByteString +expected_msg_1000 = hex + "4a2f3cc3b5e78ddb83dcb426d9863d9d9a723b0337c89dd0b005d89f8d3c05c5\ + \2b76b29b740f09" + +expected_msg_1001 :: BS.ByteString +expected_msg_1001 = hex + "2ecd8c8a5629d0d02ab457a0fdd0f7b90a192cd46be5ecb6ca570bfc5e268338\ + \b1a16cf4ef2d36" + +-- helper to get initiator session after handshake +get_initiator_session :: IO BOLT8.Session +get_initiator_session = do + (i_s_sec, i_s_pub) <- expectJust "initiator keypair" + (BOLT8.keypair initiator_s_priv) + (r_s_sec, r_s_pub) <- expectJust "responder keypair" + (BOLT8.keypair responder_s_priv) + rs <- expectJust "responder pub" (BOLT8.parse_pub responder_s_pub) + (msg1, i_hs) <- expectRight "act1" (BOLT8.act1 i_s_sec i_s_pub rs + initiator_e_priv) + (msg2, _) <- expectRight "act2" (BOLT8.act2 r_s_sec r_s_pub responder_e_priv + msg1) + (_, result) <- expectRight "act3" (BOLT8.act3 i_hs msg2) + pure (BOLT8.session result) + +-- encrypt N messages, return Nth ciphertext +encrypt_n :: Int -> BOLT8.Session -> IO BS.ByteString +encrypt_n n sess0 = go 0 sess0 + where + go i sess + | i == n = case BOLT8.encrypt sess hello of + Left err -> fail $ "encrypt failed at " ++ show i ++ ": " ++ show err + Right (ct, _) -> pure ct + | otherwise = case BOLT8.encrypt sess hello of + Left err -> fail $ "encrypt failed at " ++ show i ++ ": " ++ show err + Right (_, sess') -> go (i + 1) sess' + +test_message_0 :: Assertion +test_message_0 = do + sess <- get_initiator_session + ct <- encrypt_n 0 sess + ct @?= expected_msg_0 + +test_message_1 :: Assertion +test_message_1 = do + sess <- get_initiator_session + ct <- encrypt_n 1 sess + ct @?= expected_msg_1 + +test_message_500 :: Assertion +test_message_500 = do + sess <- get_initiator_session + ct <- encrypt_n 500 sess + ct @?= expected_msg_500 + +test_message_501 :: Assertion +test_message_501 = do + sess <- get_initiator_session + ct <- encrypt_n 501 sess + ct @?= expected_msg_501 + +test_message_1000 :: Assertion +test_message_1000 = do + sess <- get_initiator_session + ct <- encrypt_n 1000 sess + ct @?= expected_msg_1000 + +test_message_1001 :: Assertion +test_message_1001 = do + sess <- get_initiator_session + ct <- encrypt_n 1001 sess + ct @?= expected_msg_1001 + +test_decrypt_roundtrip :: Assertion +test_decrypt_roundtrip = do + (i_s_sec, i_s_pub) <- expectJust "initiator keypair" + (BOLT8.keypair initiator_s_priv) + (r_s_sec, r_s_pub) <- expectJust "responder keypair" + (BOLT8.keypair responder_s_priv) + rs <- expectJust "responder pub" (BOLT8.parse_pub responder_s_pub) + (msg1, i_hs) <- expectRight "act1" (BOLT8.act1 i_s_sec i_s_pub rs + initiator_e_priv) + (msg2, r_hs) <- expectRight "act2" (BOLT8.act2 r_s_sec r_s_pub responder_e_priv + msg1) + (msg3, i_result) <- expectRight "act3" (BOLT8.act3 i_hs msg2) + r_result <- expectRight "finalize" (BOLT8.finalize r_hs msg3) + let i_sess = BOLT8.session i_result + r_sess = BOLT8.session r_result + (ct, _) <- expectRight "encrypt" (BOLT8.encrypt i_sess hello) + (pt, _) <- expectRight "decrypt" (BOLT8.decrypt r_sess ct) + pt @?= hello + +-- framing tests ------------------------------------------------------------- + +framing_tests :: TestTree +framing_tests = testGroup "Packet Framing" [ + testCase "decrypt rejects trailing bytes" test_decrypt_trailing + , testCase "decrypt_frame returns remainder" test_decrypt_frame_remainder + , testCase "decrypt_frame handles multiple frames" test_decrypt_frame_multi + ] + +test_decrypt_trailing :: Assertion +test_decrypt_trailing = do + (i_s_sec, i_s_pub) <- expectJust "initiator keypair" + (BOLT8.keypair initiator_s_priv) + (r_s_sec, r_s_pub) <- expectJust "responder keypair" + (BOLT8.keypair responder_s_priv) + rs <- expectJust "responder pub" (BOLT8.parse_pub responder_s_pub) + (msg1, i_hs) <- expectRight "act1" (BOLT8.act1 i_s_sec i_s_pub rs + initiator_e_priv) + (msg2, r_hs) <- expectRight "act2" (BOLT8.act2 r_s_sec r_s_pub responder_e_priv + msg1) + (msg3, i_result) <- expectRight "act3" (BOLT8.act3 i_hs msg2) + r_result <- expectRight "finalize" (BOLT8.finalize r_hs msg3) + let i_sess = BOLT8.session i_result + r_sess = BOLT8.session r_result + (ct, _) <- expectRight "encrypt" (BOLT8.encrypt i_sess hello) + -- append trailing bytes + let ct_with_trailing = ct <> "extra" + case BOLT8.decrypt r_sess ct_with_trailing of + Left BOLT8.InvalidLength -> pure () + Left err -> assertFailure $ "expected InvalidLength, got: " ++ show err + Right _ -> assertFailure "decrypt should reject trailing bytes" + +test_decrypt_frame_remainder :: Assertion +test_decrypt_frame_remainder = do + (i_s_sec, i_s_pub) <- expectJust "initiator keypair" + (BOLT8.keypair initiator_s_priv) + (r_s_sec, r_s_pub) <- expectJust "responder keypair" + (BOLT8.keypair responder_s_priv) + rs <- expectJust "responder pub" (BOLT8.parse_pub responder_s_pub) + (msg1, i_hs) <- expectRight "act1" (BOLT8.act1 i_s_sec i_s_pub rs + initiator_e_priv) + (msg2, r_hs) <- expectRight "act2" (BOLT8.act2 r_s_sec r_s_pub responder_e_priv + msg1) + (msg3, i_result) <- expectRight "act3" (BOLT8.act3 i_hs msg2) + r_result <- expectRight "finalize" (BOLT8.finalize r_hs msg3) + let i_sess = BOLT8.session i_result + r_sess = BOLT8.session r_result + (ct, _) <- expectRight "encrypt" (BOLT8.encrypt i_sess hello) + let trailing = "remainder" + ct_with_trailing = ct <> trailing + (pt, remainder, _) <- expectRight "decrypt_frame" + (BOLT8.decrypt_frame r_sess ct_with_trailing) + pt @?= hello + remainder @?= trailing + +test_decrypt_frame_multi :: Assertion +test_decrypt_frame_multi = do + (i_s_sec, i_s_pub) <- expectJust "initiator keypair" + (BOLT8.keypair initiator_s_priv) + (r_s_sec, r_s_pub) <- expectJust "responder keypair" + (BOLT8.keypair responder_s_priv) + rs <- expectJust "responder pub" (BOLT8.parse_pub responder_s_pub) + (msg1, i_hs) <- expectRight "act1" (BOLT8.act1 i_s_sec i_s_pub rs + initiator_e_priv) + (msg2, r_hs) <- expectRight "act2" (BOLT8.act2 r_s_sec r_s_pub responder_e_priv + msg1) + (msg3, i_result) <- expectRight "act3" (BOLT8.act3 i_hs msg2) + r_result <- expectRight "finalize" (BOLT8.finalize r_hs msg3) + let i_sess = BOLT8.session i_result + r_sess = BOLT8.session r_result + -- encrypt two messages + (ct1, i_sess') <- expectRight "encrypt 1" (BOLT8.encrypt i_sess "first") + (ct2, _) <- expectRight "encrypt 2" (BOLT8.encrypt i_sess' "second") + -- concatenate frames + let buffer = ct1 <> ct2 + -- decrypt first frame + (pt1, rest, r_sess') <- expectRight "frame 1" + (BOLT8.decrypt_frame r_sess buffer) + pt1 @?= "first" + -- decrypt second frame from remainder + (pt2, rest2, _) <- expectRight "frame 2" (BOLT8.decrypt_frame r_sess' rest) + pt2 @?= "second" + rest2 @?= BS.empty + +-- partial framing tests ----------------------------------------------------- + +partial_framing_tests :: TestTree +partial_framing_tests = testGroup "Partial Framing" [ + testCase "short buffer returns NeedMore" test_partial_short_buffer + , testCase "partial body returns NeedMore" test_partial_body + , testCase "full frame returns FrameOk" test_partial_full_frame + ] + +test_partial_short_buffer :: Assertion +test_partial_short_buffer = do + (i_s_sec, i_s_pub) <- expectJust "initiator keypair" + (BOLT8.keypair initiator_s_priv) + (r_s_sec, r_s_pub) <- expectJust "responder keypair" + (BOLT8.keypair responder_s_priv) + rs <- expectJust "responder pub" (BOLT8.parse_pub responder_s_pub) + (msg1, i_hs) <- expectRight "act1" (BOLT8.act1 i_s_sec i_s_pub rs + initiator_e_priv) + (msg2, r_hs) <- expectRight "act2" (BOLT8.act2 r_s_sec r_s_pub responder_e_priv + msg1) + (msg3, _) <- expectRight "act3" (BOLT8.act3 i_hs msg2) + r_result <- expectRight "finalize" (BOLT8.finalize r_hs msg3) + let r_sess = BOLT8.session r_result + short_buf = BS.replicate 10 0x00 + case BOLT8.decrypt_frame_partial r_sess short_buf of + BOLT8.NeedMore n -> n @?= 8 + BOLT8.FrameOk {} -> assertFailure "expected NeedMore, got FrameOk" + BOLT8.FrameError err -> + assertFailure $ "expected NeedMore, got: " ++ show err + +test_partial_body :: Assertion +test_partial_body = do + (i_s_sec, i_s_pub) <- expectJust "initiator keypair" + (BOLT8.keypair initiator_s_priv) + (r_s_sec, r_s_pub) <- expectJust "responder keypair" + (BOLT8.keypair responder_s_priv) + rs <- expectJust "responder pub" (BOLT8.parse_pub responder_s_pub) + (msg1, i_hs) <- expectRight "act1" (BOLT8.act1 i_s_sec i_s_pub rs + initiator_e_priv) + (msg2, r_hs) <- expectRight "act2" (BOLT8.act2 r_s_sec r_s_pub responder_e_priv + msg1) + (msg3, i_result) <- expectRight "act3" (BOLT8.act3 i_hs msg2) + r_result <- expectRight "finalize" (BOLT8.finalize r_hs msg3) + let i_sess = BOLT8.session i_result + r_sess = BOLT8.session r_result + (ct, _) <- expectRight "encrypt" (BOLT8.encrypt i_sess hello) + -- take only length header (18 bytes) + 5 bytes of body + let partial = BS.take 23 ct + case BOLT8.decrypt_frame_partial r_sess partial of + BOLT8.NeedMore n -> do + -- "hello" = 5 bytes, so body = 5 + 16 = 21 + -- we have 5 bytes of body, need 16 more + n @?= 16 + BOLT8.FrameOk {} -> assertFailure "expected NeedMore, got FrameOk" + BOLT8.FrameError err -> + assertFailure $ "expected NeedMore, got: " ++ show err + +test_partial_full_frame :: Assertion +test_partial_full_frame = do + (i_s_sec, i_s_pub) <- expectJust "initiator keypair" + (BOLT8.keypair initiator_s_priv) + (r_s_sec, r_s_pub) <- expectJust "responder keypair" + (BOLT8.keypair responder_s_priv) + rs <- expectJust "responder pub" (BOLT8.parse_pub responder_s_pub) + (msg1, i_hs) <- expectRight "act1" (BOLT8.act1 i_s_sec i_s_pub rs + initiator_e_priv) + (msg2, r_hs) <- expectRight "act2" (BOLT8.act2 r_s_sec r_s_pub responder_e_priv + msg1) + (msg3, i_result) <- expectRight "act3" (BOLT8.act3 i_hs msg2) + r_result <- expectRight "finalize" (BOLT8.finalize r_hs msg3) + let i_sess = BOLT8.session i_result + r_sess = BOLT8.session r_result + (ct, _) <- expectRight "encrypt" (BOLT8.encrypt i_sess hello) + let trailing = "extra" + buf = ct <> trailing + case BOLT8.decrypt_frame_partial r_sess buf of + BOLT8.FrameOk pt remainder _ -> do + pt @?= hello + remainder @?= trailing + BOLT8.NeedMore n -> + assertFailure $ "expected FrameOk, got NeedMore " ++ show n + BOLT8.FrameError err -> + assertFailure $ "expected FrameOk, got: " ++ show err + +-- negative tests ------------------------------------------------------------ + +negative_tests :: TestTree +negative_tests = testGroup "Negative Tests" [ + testCase "act2 rejects wrong version" test_act2_wrong_version + , testCase "act2 rejects wrong length" test_act2_wrong_length + , testCase "act3 rejects invalid MAC" test_act3_invalid_mac + , testCase "finalize rejects invalid MAC" test_finalize_invalid_mac + , testCase "decrypt rejects short packet" test_decrypt_short_packet + ] + +test_act2_wrong_version :: Assertion +test_act2_wrong_version = do + (i_s_sec, i_s_pub) <- expectJust "initiator keypair" + (BOLT8.keypair initiator_s_priv) + (r_s_sec, r_s_pub) <- expectJust "responder keypair" + (BOLT8.keypair responder_s_priv) + rs <- expectJust "responder pub" (BOLT8.parse_pub responder_s_pub) + (msg1, _) <- expectRight "act1" (BOLT8.act1 i_s_sec i_s_pub rs initiator_e_priv) + let bad_msg1 = BS.cons 0x01 (BS.drop 1 msg1) + case BOLT8.act2 r_s_sec r_s_pub responder_e_priv bad_msg1 of + Left BOLT8.InvalidVersion -> pure () + Left err -> assertFailure $ "expected InvalidVersion, got: " ++ show err + Right _ -> assertFailure "expected rejection, got success" + +test_act2_wrong_length :: Assertion +test_act2_wrong_length = do + (r_s_sec, r_s_pub) <- expectJust "responder keypair" + (BOLT8.keypair responder_s_priv) + let short_msg = BS.replicate 49 0x00 + case BOLT8.act2 r_s_sec r_s_pub responder_e_priv short_msg of + Left BOLT8.InvalidLength -> pure () + Left err -> assertFailure $ "expected InvalidLength, got: " ++ show err + Right _ -> assertFailure "expected rejection, got success" + +test_act3_invalid_mac :: Assertion +test_act3_invalid_mac = do + (i_s_sec, i_s_pub) <- expectJust "initiator keypair" + (BOLT8.keypair initiator_s_priv) + (r_s_sec, r_s_pub) <- expectJust "responder keypair" + (BOLT8.keypair responder_s_priv) + rs <- expectJust "responder pub" (BOLT8.parse_pub responder_s_pub) + (msg1, i_hs) <- expectRight "act1" (BOLT8.act1 i_s_sec i_s_pub rs + initiator_e_priv) + (msg2, _) <- expectRight "act2" (BOLT8.act2 r_s_sec r_s_pub responder_e_priv + msg1) + bad_msg2 <- flip_byte 40 msg2 + case BOLT8.act3 i_hs bad_msg2 of + Left BOLT8.InvalidMAC -> pure () + Left err -> assertFailure $ "expected InvalidMAC, got: " ++ show err + Right _ -> assertFailure "expected rejection, got success" + +test_finalize_invalid_mac :: Assertion +test_finalize_invalid_mac = do + (i_s_sec, i_s_pub) <- expectJust "initiator keypair" + (BOLT8.keypair initiator_s_priv) + (r_s_sec, r_s_pub) <- expectJust "responder keypair" + (BOLT8.keypair responder_s_priv) + rs <- expectJust "responder pub" (BOLT8.parse_pub responder_s_pub) + (msg1, i_hs) <- expectRight "act1" (BOLT8.act1 i_s_sec i_s_pub rs + initiator_e_priv) + (msg2, r_hs) <- expectRight "act2" (BOLT8.act2 r_s_sec r_s_pub responder_e_priv + msg1) + (msg3, _) <- expectRight "act3" (BOLT8.act3 i_hs msg2) + bad_msg3 <- flip_byte 20 msg3 + case BOLT8.finalize r_hs bad_msg3 of + Left BOLT8.InvalidMAC -> pure () + Left err -> assertFailure $ "expected InvalidMAC, got: " ++ show err + Right _ -> assertFailure "expected rejection, got success" + +test_decrypt_short_packet :: Assertion +test_decrypt_short_packet = do + (i_s_sec, i_s_pub) <- expectJust "initiator keypair" + (BOLT8.keypair initiator_s_priv) + (r_s_sec, r_s_pub) <- expectJust "responder keypair" + (BOLT8.keypair responder_s_priv) + rs <- expectJust "responder pub" (BOLT8.parse_pub responder_s_pub) + (msg1, i_hs) <- expectRight "act1" (BOLT8.act1 i_s_sec i_s_pub rs + initiator_e_priv) + (msg2, r_hs) <- expectRight "act2" (BOLT8.act2 r_s_sec r_s_pub responder_e_priv + msg1) + (msg3, _) <- expectRight "act3" (BOLT8.act3 i_hs msg2) + r_result <- expectRight "finalize" (BOLT8.finalize r_hs msg3) + let r_sess = BOLT8.session r_result + short_packet = BS.replicate 17 0x00 + case BOLT8.decrypt r_sess short_packet of + Left BOLT8.InvalidLength -> pure () + Left err -> assertFailure $ "expected InvalidLength, got: " ++ show err + Right _ -> assertFailure "expected rejection, got success" + +-- flip one byte in a bytestring at given index +flip_byte :: Int -> BS.ByteString -> IO BS.ByteString +flip_byte i bs + | i < 0 || i >= BS.length bs = + assertFailure "flip_byte: index out of bounds" >> pure bs + | otherwise = + let (pre, post) = BS.splitAt i bs + b = BS.index post 0 + in pure (pre <> BS.cons (b `xor` 0xff) (BS.drop 1 post)) + +-- utilities ----------------------------------------------------------------- + +-- Safe hex decode for test vectors (only called at top level with known-good +-- literals). This uses error since it's for compile-time constants, not runtime +-- input; wrapping in IO would break the test vector declarations. +hex :: BS.ByteString -> BS.ByteString +hex bs = case B16.decode bs of + Nothing -> error "hex: invalid test vector literal" + Just r -> r + +-- property tests -------------------------------------------------------------- + +property_tests :: TestTree +property_tests = testGroup "Properties" [ + testProperty "handshake round-trip" prop_handshake_roundtrip + , testProperty "encrypt/decrypt round-trip" prop_encrypt_decrypt_roundtrip + , testProperty "decrypt_frame consumes one frame" prop_frame_consumes_one + , testProperty "decrypt_frame_partial NeedMore on short" + prop_partial_needmore_short + ] + +-- generators ------------------------------------------------------------------ + +-- | Generate 32 bytes of entropy that yields a valid keypair. +genValidEntropy :: Gen BS.ByteString +genValidEntropy = do + bytes <- BS.pack <$> vectorOf 32 (choose (0, 255)) + case BOLT8.keypair bytes of + Just _ -> pure bytes + Nothing -> genValidEntropy + +-- | Generate a payload of 0..256 bytes. +genPayload :: Gen BS.ByteString +genPayload = do + len <- choose (0, 256) + BS.pack <$> vectorOf len (choose (0, 255)) + +-- | Perform a full handshake with given static key entropy. +-- Uses fixed ephemeral keys for determinism. +doHandshake + :: BS.ByteString + -> BS.ByteString + -> Maybe (BOLT8.Session, BOLT8.Session) +doHandshake i_entropy r_entropy = do + (i_s_sec, i_s_pub) <- BOLT8.keypair i_entropy + (r_s_sec, r_s_pub) <- BOLT8.keypair r_entropy + let i_e = BS.replicate 32 0x12 + r_e = BS.replicate 32 0x22 + (msg1, i_hs) <- either (const Nothing) Just $ + BOLT8.act1 i_s_sec i_s_pub r_s_pub i_e + (msg2, r_hs) <- either (const Nothing) Just $ + BOLT8.act2 r_s_sec r_s_pub r_e msg1 + (msg3, i_res) <- either (const Nothing) Just $ + BOLT8.act3 i_hs msg2 + r_res <- either (const Nothing) Just $ + BOLT8.finalize r_hs msg3 + pure (BOLT8.session i_res, BOLT8.session r_res) + +-- properties ------------------------------------------------------------------ + +-- | Handshake succeeds for valid keys and sessions are consistent. +prop_handshake_roundtrip :: Property +prop_handshake_roundtrip = forAll genValidEntropy $ \i_ent -> + forAll genValidEntropy $ \r_ent -> + case doHandshake i_ent r_ent of + Nothing -> False + Just _ -> True + +-- | Encrypt then decrypt yields original payload. +prop_encrypt_decrypt_roundtrip :: Property +prop_encrypt_decrypt_roundtrip = forAll genPayload $ \payload -> + case doHandshake initiator_s_priv responder_s_priv of + Nothing -> False + Just (i_sess, r_sess) -> + case BOLT8.encrypt i_sess payload of + Left _ -> False + Right (ct, _) -> + case BOLT8.decrypt r_sess ct of + Left _ -> False + Right (pt, _) -> pt == payload + +-- | decrypt_frame consumes exactly one frame and returns remainder. +prop_frame_consumes_one :: Property +prop_frame_consumes_one = forAll genPayload $ \p1 -> + forAll genPayload $ \p2 -> + case doHandshake initiator_s_priv responder_s_priv of + Nothing -> False + Just (i_sess, r_sess) -> + case BOLT8.encrypt i_sess p1 of + Left _ -> False + Right (ct1, i_sess') -> + case BOLT8.encrypt i_sess' p2 of + Left _ -> False + Right (ct2, _) -> + let buf = ct1 <> ct2 + in case BOLT8.decrypt_frame r_sess buf of + Left _ -> False + Right (pt1, rest, r_sess') -> + pt1 == p1 && + case BOLT8.decrypt_frame r_sess' rest of + Left _ -> False + Right (pt2, rest2, _) -> + pt2 == p2 && BS.null rest2 + +-- | decrypt_frame_partial returns NeedMore when buffer < 18 bytes. +prop_partial_needmore_short :: Property +prop_partial_needmore_short = forAll (choose (0, 17)) $ \len -> + case doHandshake initiator_s_priv responder_s_priv of + Nothing -> False + Just (_, r_sess) -> + let buf = BS.replicate len 0x00 + in case BOLT8.decrypt_frame_partial r_sess buf of + BOLT8.NeedMore n -> n == 18 - len + _ -> False