commit 05f1c4c421269b4dda6592b1b9928f42e01deaaa
parent 4b104d803b2655047c7a66bad50254e7100e06b8
Author: Jared Tobin <jared@jtobin.io>
Date: Sat, 10 Oct 2026 13:39:08 +0400
lib: split transport state, bind keypairs, drop dead API
Redesigns the public API around misuse resistance:
- Post-handshake state is split into a Sender and a Receiver, so a
single state can't serve both directions, and a writer and reader
thread can each own one. Every operation returns the next state.
- Streaming decryption follows 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 handles one whole
frame. decrypt_frame, decrypt_frame_partial and FrameResult go.
- The local static key is a Keypair, so its halves can't be
mismatched. Handshake states are distinct Initiator and Responder
types carrying only what the next act needs, replacing the phantom
HandshakeFor and the Maybe/Bool-laden HandshakeState.
- Key32, SessionNonce, MessagePayload, the public Sec type and the
unused DecryptionFailed error are removed; InvalidKey becomes
InvalidEntropy. Secret-bearing types have no Generic, Show or Eq
instances; all public types get NFData via seq on strict fields.
- The Internal module is folded into Lightning.Protocol.BOLT8, the
only exposed module.
- Docs stress that states must be used exactly once, that ephemeral
entropy must be fresh and uniformly random, and that any error is
fatal for the connection.
Diffstat:
3 files changed, 686 insertions(+), 936 deletions(-)
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,708 @@
-- 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 a
+-- state (t'Initiator', t'Responder', t'Sender', t'Receiver' or
+-- t'Pending') returns the next one, 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.
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 (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.
+data Handshake = Handshake {
+ handshake_sender :: !Sender
+ -- ^ state for encrypting outgoing messages
+ , handshake_receiver :: !Receiver
+ -- ^ state for decrypting incoming messages
+ , handshake_remote_static :: !Pub
+ -- ^ the remote party's authenticated static public key
+ }
+
+instance NFData Handshake where
+ rnf (Handshake s r p) = rnf s `seq` rnf r `seq` rnf 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 {
+ handshake_sender = Sender (Cipher sk 0 ck2)
+ , handshake_receiver = Receiver (Cipher rk 0 ck2)
+ , handshake_remote_static = 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 {
+ handshake_sender = Sender (Cipher sk 0 ck1)
+ , handshake_receiver = Receiver (Cipher rk 0 ck1)
+ , handshake_remote_static = 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.
+--
+-- 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
@@ -32,14 +32,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
