diff --git a/CHANGELOG b/CHANGELOG --- a/CHANGELOG +++ b/CHANGELOG @@ -1,4 +1,52 @@ # Changelog -- 0.0.1 (UNRELEASED) +- 0.1.0 (2026-10-10) + * A substantial rewrite, with breaking changes throughout: + + * The API is exported from Lightning.Protocol.BOLT4 alone, and uses + snake_case names (e.g. construct, process, construct_error, + create_blinded_path). The Prim, Codec and Internal modules are + no longer exposed. + + * Fundamental types come from ppad-bolt1: points are Points, + amounts are MilliSatoshis, short channel ids and TLV streams are + bolt1's. allowed_features is a ppad-bolt9 FeatureVector. The + private BigSize, TLV and truncated-integer codecs are gone. + + * Secret keys (SecretKey) must be exactly 32 bytes encoding a valid + scalar. Secret keys, shared secrets and payment secrets are + abstract, with redacted Show instances; shared and payment + secrets compare in constant time. + + * process takes the path_key received with an onion, derives the + blinded private key, decrypts encrypted_recipient_data (using + path_key or current_path_key) and returns its contents and the + next path key. + + * Hop payloads and encrypted_data_tlv streams reject unknown even + types and keep unknown odd ones, so re-encoding is exact. + payment_metadata and total_amount_msat are typed fields. + + * Failures are a typed sum of every failure code in the spec, with + an escape hatch for unknown codes; invalid_realm is gone, and + required_channel_feature_missing, unknown_next_peer and + invalid_onion_blinding are new. + + * unwrap_error reports the hop whose HMAC matches even when its + failure message is malformed. wrap_error is total, and + construct_error fails only on an unencodable failure message. + + * Fixes onion construction for routes of three or more hops, the + framing and padding of failure messages, and decoding of payload + lengths past the end of hop_payloads, overlong TLV lengths and + unknown even TLV types. + + * The onion HMAC check is constant time. + + * Tests now cover the onion, error, route blinding and blinded + payment test vectors of BOLT #4, through the public API. + + * Adds NFData instances, and criterion and weigh benchmarks. + +- 0.0.1 (2026-04-18) * Initial release. diff --git a/bench/Fixtures.hs b/bench/Fixtures.hs new file mode 100644 --- /dev/null +++ b/bench/Fixtures.hs @@ -0,0 +1,150 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Fixtures ( + Fixtures(..) + , fixtures + ) where + +import Control.DeepSeq (NFData(..)) +import qualified Data.ByteString as BS +import qualified Lightning.Protocol.BOLT1 as BOLT1 +import Lightning.Protocol.BOLT4 + +data Fixtures = Fixtures { + fx_session :: !SecretKey + , fx_ad :: !BS.ByteString + , fx_route_1 :: ![Hop] + , fx_route_5 :: ![Hop] + , fx_route_20 :: ![Hop] + , fx_first_node :: !SecretKey + , fx_onion_5 :: !OnionPacket + , fx_onion_1 :: !OnionPacket + , fx_secrets_5 :: ![SharedSecret] + , fx_secret :: !SharedSecret + , fx_blinded_node :: !SecretKey + , fx_blinded_onion :: !OnionPacket + , fx_path_key :: !BOLT1.Point + , fx_path_seed :: !SecretKey + , fx_path_nodes :: ![(BOLT1.Point, BlindedHopData)] + , fx_encrypted :: !BS.ByteString + , fx_failure :: !FailureMessage + , fx_error :: !ErrorPacket + , fx_returned :: !ErrorPacket + , fx_onion_bytes :: !BS.ByteString + , fx_payload :: !HopPayload + , fx_payload_bytes :: !BS.ByteString + } + +instance NFData Fixtures where + rnf (Fixtures a b c d e f g h i j k l m n o p q r s t u v) = + rnf a `seq` rnf b `seq` rnf c `seq` rnf d `seq` rnf e `seq` rnf f + `seq` rnf g `seq` rnf h `seq` rnf i `seq` rnf j `seq` rnf k + `seq` rnf l `seq` rnf m `seq` rnf n `seq` rnf o `seq` rnf p + `seq` rnf q `seq` rnf r `seq` rnf s `seq` rnf t `seq` rnf u + `seq` rnf v + +demand :: String -> Maybe a -> IO a +demand msg = maybe (ioError (userError msg)) pure + +right :: Show e => String -> Either e a -> IO a +right msg = either (ioError . userError . (msg ++) . (": " ++) . show) pure + +fixtures :: IO Fixtures +fixtures = do + let key b = demand "secret_key" (secret_key (BS.replicate 32 b)) + ad = BS.replicate 32 0x42 + session <- key 0x41 + nodes <- mapM key [1 .. 20] + amt <- demand "milli_satoshi" (BOLT1.milli_satoshi 100000) + scid <- demand "short_channel_id" (BOLT1.short_channel_id 800000 1 0) + ps <- demand "payment_secret" (payment_secret (BS.replicate 32 0xaa)) + let fwd = empty_hop_payload + { hp_amt_to_forward = Just amt + , hp_outgoing_cltv_value = Just 800000 + , hp_short_channel_id = Just scid + } + final = empty_hop_payload + { hp_amt_to_forward = Just amt + , hp_outgoing_cltv_value = Just 800000 + , hp_payment_data = Just (PaymentData ps amt) + } + route n = [ Hop (public_key k) fwd | k <- take (n - 1) nodes ] + ++ [ Hop (public_key k) final + | k <- take 1 (drop (n - 1) nodes) ] + first_node <- demand "node" (safe_head nodes) + (onion_5, secrets_5) <- right "construct" (construct session (route 5) ad) + (onion_1, _) <- right "construct" (construct session (route 1) ad) + + -- a blinded route through nodes 1 to 3, entered at node 0 + seed <- key 0x55 + let relay = empty_blinded_hop_data + { bhd_short_channel_id = Just scid + , bhd_payment_relay = Just (PaymentRelay 40 100 1000) + } + path_nodes = [ (public_key k, relay) | k <- take 2 (drop 1 nodes) ] + ++ [ (public_key k, empty_blinded_hop_data + { bhd_path_id = Just (BS.replicate 32 1) }) + | k <- take 1 (drop 3 nodes) ] + path <- right "create_blinded_path" (create_blinded_path seed path_nodes) + hops <- case bp_hops path of + [h1, h2, h3] -> pure (h1, h2, h3) + _ -> ioError (userError "expected 3 blinded hops") + let (h1, h2, h3) = hops + bhop h pl = Hop (bh_blinded_node_id h) + pl { hp_encrypted_data = Just (bh_encrypted_data h) } + entry = Hop (public_key first_node) fwd + broute = [ entry + , Hop (bp_first_node_id path) empty_hop_payload + { hp_encrypted_data = Just (bh_encrypted_data h1) + , hp_current_path_key = Just (bp_first_path_key path) } + , bhop h2 empty_hop_payload + , bhop h3 empty_hop_payload + { hp_amt_to_forward = Just amt + , hp_outgoing_cltv_value = Just 800000 + , hp_total_amount_msat = Just amt } ] + (bonion, _) <- right "construct" (construct session broute ad) + -- the onion received, with a path_key, by node 2 + node1 <- demand "node" (safe_head (drop 1 nodes)) + node2 <- demand "node" (safe_head (drop 2 nodes)) + f0 <- forwarded (process first_node bonion ad Nothing) + f1 <- forwarded (process node1 (fwd_next_packet f0) ad Nothing) + b1 <- demand "blinded" (fwd_blinded f1) + + -- node 4 fails a 5-hop payment + ss4 <- demand "secret" (safe_head (drop 4 secrets_5)) + let failure = FailureMessage TemporaryNodeFailure BOLT1.empty_tlv_stream + err <- right "construct_error" (construct_error ss4 failure) + let returned = foldr wrap_error err (take 4 secrets_5) + + payload_bytes <- right "encode_hop_payload" (encode_hop_payload final) + pure Fixtures { + fx_session = session + , fx_ad = ad + , fx_route_1 = route 1 + , fx_route_5 = route 5 + , fx_route_20 = route 20 + , fx_first_node = first_node + , fx_onion_5 = onion_5 + , fx_onion_1 = onion_1 + , fx_secrets_5 = secrets_5 + , fx_secret = ss4 + , fx_blinded_node = node2 + , fx_blinded_onion = fwd_next_packet f1 + , fx_path_key = bi_next_path_key b1 + , fx_path_seed = seed + , fx_path_nodes = path_nodes + , fx_encrypted = bh_encrypted_data h2 + , fx_failure = failure + , fx_error = err + , fx_returned = returned + , fx_onion_bytes = encode_onion_packet onion_5 + , fx_payload = final + , fx_payload_bytes = payload_bytes + } + where + safe_head xs = case xs of + x : _ -> Just x + [] -> Nothing + forwarded r = case r of + Right (Forward f) -> pure f + _ -> ioError (userError ("expected Forward: " ++ show r)) diff --git a/bench/Main.hs b/bench/Main.hs --- a/bench/Main.hs +++ b/bench/Main.hs @@ -1,10 +1,55 @@ -{-# LANGUAGE BangPatterns #-} -{-# LANGUAGE OverloadedStrings #-} - module Main where import Criterion.Main +import Fixtures +import Lightning.Protocol.BOLT4 main :: IO () main = defaultMain [ + env fixtures $ \fx -> bgroup "ppad-bolt4" [ + bgroup "construct" [ + bench "1 hop" $ + nf (construct (fx_session fx) (fx_route_1 fx)) (fx_ad fx) + , bench "5 hops" $ + nf (construct (fx_session fx) (fx_route_5 fx)) (fx_ad fx) + , bench "20 hops" $ + nf (construct (fx_session fx) (fx_route_20 fx)) (fx_ad fx) + ] + , bgroup "process" [ + bench "forward" $ + nf (process (fx_first_node fx) (fx_onion_5 fx) (fx_ad fx)) + Nothing + , bench "receive" $ + nf (process (fx_first_node fx) (fx_onion_1 fx) (fx_ad fx)) + Nothing + , bench "forward (blinded)" $ + nf (process (fx_blinded_node fx) (fx_blinded_onion fx) (fx_ad fx)) + (Just (fx_path_key fx)) + ] + , bgroup "returning errors" [ + bench "construct_error" $ + nf (construct_error (fx_secret fx)) (fx_failure fx) + , bench "wrap_error" $ + nf (wrap_error (fx_secret fx)) (fx_error fx) + , bench "unwrap_error (hop 4 of 5)" $ + nf (unwrap_error (fx_secrets_5 fx)) (fx_returned fx) + ] + , bgroup "route blinding" [ + bench "create_blinded_path (3 hops)" $ + nf (create_blinded_path (fx_path_seed fx)) (fx_path_nodes fx) + , bench "decrypt_recipient_data" $ + nf (decrypt_recipient_data (fx_blinded_node fx) (fx_path_key fx)) + (fx_encrypted fx) + ] + , bgroup "codecs" [ + bench "encode_onion_packet" $ + nf encode_onion_packet (fx_onion_5 fx) + , bench "decode_onion_packet" $ + nf decode_onion_packet (fx_onion_bytes fx) + , bench "encode_hop_payload" $ + nf encode_hop_payload (fx_payload fx) + , bench "decode_hop_payload" $ + nf decode_hop_payload (fx_payload_bytes fx) + ] + ] ] diff --git a/bench/Weight.hs b/bench/Weight.hs --- a/bench/Weight.hs +++ b/bench/Weight.hs @@ -1,9 +1,38 @@ -{-# LANGUAGE BangPatterns #-} -{-# LANGUAGE OverloadedStrings #-} - module Main where +import Fixtures +import Lightning.Protocol.BOLT4 import Weigh main :: IO () -main = mainWith (pure ()) +main = do + fx <- fixtures + mainWith $ do + wgroup "construct" $ do + func "1 hop" (construct (fx_session fx) (fx_route_1 fx)) (fx_ad fx) + func "5 hops" (construct (fx_session fx) (fx_route_5 fx)) (fx_ad fx) + func "20 hops" (construct (fx_session fx) (fx_route_20 fx)) (fx_ad fx) + wgroup "process" $ do + func "forward" + (process (fx_first_node fx) (fx_onion_5 fx) (fx_ad fx)) Nothing + func "receive" + (process (fx_first_node fx) (fx_onion_1 fx) (fx_ad fx)) Nothing + func "forward (blinded)" + (process (fx_blinded_node fx) (fx_blinded_onion fx) (fx_ad fx)) + (Just (fx_path_key fx)) + wgroup "returning errors" $ do + func "construct_error" (construct_error (fx_secret fx)) (fx_failure fx) + func "wrap_error" (wrap_error (fx_secret fx)) (fx_error fx) + func "unwrap_error (hop 4 of 5)" + (unwrap_error (fx_secrets_5 fx)) (fx_returned fx) + wgroup "route blinding" $ do + func "create_blinded_path (3 hops)" + (create_blinded_path (fx_path_seed fx)) (fx_path_nodes fx) + func "decrypt_recipient_data" + (decrypt_recipient_data (fx_blinded_node fx) (fx_path_key fx)) + (fx_encrypted fx) + wgroup "codecs" $ do + func "encode_onion_packet" encode_onion_packet (fx_onion_5 fx) + func "decode_onion_packet" decode_onion_packet (fx_onion_bytes fx) + func "encode_hop_payload" encode_hop_payload (fx_payload fx) + func "decode_hop_payload" decode_hop_payload (fx_payload_bytes fx) diff --git a/lib/Lightning/Protocol/BOLT4.hs b/lib/Lightning/Protocol/BOLT4.hs --- a/lib/Lightning/Protocol/BOLT4.hs +++ b/lib/Lightning/Protocol/BOLT4.hs @@ -6,19 +6,147 @@ -- License: MIT -- Maintainer: Jared Tobin -- --- BOLT4 onion routing for the Lightning Network. +-- Onion routing for the Lightning Network, per BOLT #4 +-- (): +-- onion construction and processing, returning errors, and route +-- blinding. -- --- This module re-exports the public interface from submodules. +-- The examples below assume: +-- +-- >>> :set -XOverloadedStrings +-- >>> import qualified Data.ByteString as BS +-- >>> import qualified Lightning.Protocol.BOLT1 as BOLT1 +-- >>> import Lightning.Protocol.BOLT4 +-- +-- Construct a two-hop onion: +-- +-- >>> let Just session = secret_key (BS.replicate 32 0x41) +-- >>> let Just alice = secret_key (BS.replicate 32 0x42) +-- >>> let Just bob = secret_key (BS.replicate 32 0x43) +-- >>> let Just scid = BOLT1.short_channel_id 800000 1 0 +-- >>> let Just amt = BOLT1.milli_satoshi 100000 +-- >>> :{ +-- let alice_payload = empty_hop_payload { +-- hp_amt_to_forward = Just amt +-- , hp_outgoing_cltv_value = Just 800040 +-- , hp_short_channel_id = Just scid +-- } +-- bob_payload = empty_hop_payload { +-- hp_amt_to_forward = Just amt +-- , hp_outgoing_cltv_value = Just 800000 +-- } +-- route = [ Hop (public_key alice) alice_payload +-- , Hop (public_key bob) bob_payload ] +-- payment_hash = BS.replicate 32 0xff +-- :} +-- >>> let Right (onion, secrets) = construct session route payment_hash +-- +-- Process it at each hop: +-- +-- >>> let Right (Forward fwd) = process alice onion payment_hash Nothing +-- >>> hp_short_channel_id (fwd_payload fwd) == Just scid +-- True +-- >>> let next = fwd_next_packet fwd +-- >>> let Right (Receive rcv) = process bob next payment_hash Nothing +-- >>> hp_outgoing_cltv_value (rcv_payload rcv) +-- Just 800000 +-- +-- Fail at the final hop, wrap the error at the first, and attribute it +-- at the origin: +-- +-- >>> let tlvs = BOLT1.empty_tlv_stream +-- >>> let failure = FailureMessage TemporaryNodeFailure tlvs +-- >>> let Right err = construct_error (rcv_shared_secret rcv) failure +-- >>> let returned = wrap_error (fwd_shared_secret fwd) err +-- >>> unwrap_error secrets returned == Attributed 1 failure +-- True module Lightning.Protocol.BOLT4 ( - -- * Re-exports - module Lightning.Protocol.BOLT4.Blinding - , module Lightning.Protocol.BOLT4.Codec - , module Lightning.Protocol.BOLT4.Prim - , module Lightning.Protocol.BOLT4.Types + -- * Keys + SecretKey + , secret_key + , public_key + , SharedSecret + , shared_secret + , un_shared_secret + + -- * Onion packets + , OnionPacket(..) + , HopPayloads + , hop_payloads + , un_hop_payloads + , Hmac32 + , hmac32 + , un_hmac32 + , encode_onion_packet + , decode_onion_packet + + -- * Hop payloads + , HopPayload(..) + , empty_hop_payload + , PaymentData(..) + , PaymentSecret + , payment_secret + , un_payment_secret + , encode_hop_payload + , decode_hop_payload + + -- * Constructing onions + , Hop(..) + , construct + , ConstructError(..) + + -- * Processing onions + , process + , ProcessResult(..) + , ForwardInfo(..) + , ReceiveInfo(..) + , BlindedInfo(..) + , ProcessError(..) + + -- * Route blinding + , BlindedPath(..) + , BlindedHop(..) + , create_blinded_path + , BlindingError(..) + , decrypt_recipient_data + , BlindedHopData(..) + , empty_blinded_hop_data + , PaymentRelay(..) + , PaymentConstraints(..) + , encode_blinded_hop_data + , decode_blinded_hop_data + + -- * Failure messages + , FailureMessage(..) + , Failure(..) + , OnionHash + , onion_hash + , un_onion_hash + , failure_code + , is_badonion + , is_perm + , is_node + , is_update + , encode_failure_message + , decode_failure_message + + -- * Returning errors + , ErrorPacket(..) + , construct_error + , wrap_error + , unwrap_error + , Attribution(..) + + -- * Encoding errors + , DecodeError(..) + , EncodeError(..) ) where import Lightning.Protocol.BOLT4.Blinding import Lightning.Protocol.BOLT4.Codec +import Lightning.Protocol.BOLT4.Construct +import Lightning.Protocol.BOLT4.Error import Lightning.Protocol.BOLT4.Prim +import Lightning.Protocol.BOLT4.Process import Lightning.Protocol.BOLT4.Types diff --git a/lib/Lightning/Protocol/BOLT4/Blinding.hs b/lib/Lightning/Protocol/BOLT4/Blinding.hs --- a/lib/Lightning/Protocol/BOLT4/Blinding.hs +++ b/lib/Lightning/Protocol/BOLT4/Blinding.hs @@ -1,6 +1,5 @@ -{-# OPTIONS_HADDOCK prune #-} -{-# LANGUAGE BangPatterns #-} -{-# LANGUAGE OverloadedStrings #-} +{-# OPTIONS_HADDOCK hide #-} +{-# LANGUAGE DeriveGeneric #-} -- | -- Module: Lightning.Protocol.BOLT4.Blinding @@ -8,384 +7,137 @@ -- License: MIT -- Maintainer: Jared Tobin -- --- Route blinding for BOLT4 onion routing. +-- Route blinding. module Lightning.Protocol.BOLT4.Blinding ( - -- * Types - BlindedPath(..) - , BlindedHop(..) - , BlindedHopData(..) - , PaymentRelay(..) - , PaymentConstraints(..) - , BlindingError(..) - - -- * Path creation - , createBlindedPath - - -- * Hop processing - , processBlindedHop - - -- * Key derivation (exported for testing) - , deriveBlindingRho - , deriveBlindedNodeId - , nextEphemeral - - -- * TLV encoding (exported for testing) - , encodeBlindedHopData - , decodeBlindedHopData - - -- * Encryption (exported for testing) - , encryptHopData - , decryptHopData + BlindingError(..) + , create_blinded_path + , decrypt_recipient_data + , unblind ) where +import Control.DeepSeq (NFData) import qualified Crypto.AEAD.ChaCha20Poly1305 as AEAD import qualified Crypto.Curve.Secp256k1 as Secp256k1 -import qualified Crypto.Hash.SHA256 as SHA256 import qualified Data.ByteString as BS -import qualified Data.ByteString.Builder as B -import Data.Word (Word16, Word32, Word64) -import qualified Numeric.Montgomery.Secp256k1.Scalar as S +import GHC.Generics (Generic) +import qualified Lightning.Protocol.BOLT1 as BOLT1 import Lightning.Protocol.BOLT4.Codec - ( encodeShortChannelId, decodeShortChannelId - , encodeTlvStream, decodeTlvStream - , toStrict, word16BE, word32BE - , encodeWord64TU, decodeWord64TU - , encodeWord32TU, decodeWord32TU - ) -import Lightning.Protocol.BOLT4.Prim (SharedSecret(..), DerivedKey(..)) -import Lightning.Protocol.BOLT4.Types (ShortChannelId(..), TlvRecord(..)) - --- Types --------------------------------------------------------------------- - --- | A blinded route provided by recipient. -data BlindedPath = BlindedPath - { bpIntroductionNode :: !Secp256k1.Projective -- ^ First node (unblinded) - , bpBlindingKey :: !Secp256k1.Projective -- ^ E_0, initial ephemeral - , bpBlindedHops :: ![BlindedHop] - } deriving (Eq, Show) - --- | A single hop in a blinded path. -data BlindedHop = BlindedHop - { bhBlindedNodeId :: !BS.ByteString -- ^ 33 bytes, blinded pubkey - , bhEncryptedData :: !BS.ByteString -- ^ Encrypted routing data - } deriving (Eq, Show) - --- | Data encrypted for each blinded hop (before encryption). -data BlindedHopData = BlindedHopData - { bhdPadding :: !(Maybe BS.ByteString) -- ^ TLV 1 - , bhdShortChannelId :: !(Maybe ShortChannelId) -- ^ TLV 2 - , bhdNextNodeId :: !(Maybe BS.ByteString) -- ^ TLV 4, 33-byte pubkey - , bhdPathId :: !(Maybe BS.ByteString) -- ^ TLV 6 - , bhdNextPathKeyOverride :: !(Maybe BS.ByteString) -- ^ TLV 8 - , bhdPaymentRelay :: !(Maybe PaymentRelay) -- ^ TLV 10 - , bhdPaymentConstraints :: !(Maybe PaymentConstraints) -- ^ TLV 12 - , bhdAllowedFeatures :: !(Maybe BS.ByteString) -- ^ TLV 14 - } deriving (Eq, Show) - --- | Payment relay parameters (TLV 10). -data PaymentRelay = PaymentRelay - { prCltvExpiryDelta :: {-# UNPACK #-} !Word16 - , prFeeProportional :: {-# UNPACK #-} !Word32 -- ^ Fee in millionths - , prFeeBaseMsat :: {-# UNPACK #-} !Word32 - } deriving (Eq, Show) - --- | Payment constraints (TLV 12). -data PaymentConstraints = PaymentConstraints - { pcMaxCltvExpiry :: {-# UNPACK #-} !Word32 - , pcHtlcMinimumMsat :: {-# UNPACK #-} !Word64 - } deriving (Eq, Show) +import Lightning.Protocol.BOLT4.Prim +import Lightning.Protocol.BOLT4.Types --- | Errors during blinding operations. +-- | Why a blinded route could not be created. data BlindingError - = InvalidSeed - | EmptyPath - | InvalidNodeKey Int - | DecryptionFailed - | InvalidPathKey - deriving (Eq, Show) - --- Key derivation ------------------------------------------------------------ - --- | Derive rho key for encrypting hop data. --- --- @rho = HMAC-SHA256(key="rho", data=shared_secret)@ -deriveBlindingRho :: SharedSecret -> DerivedKey -deriveBlindingRho (SharedSecret !ss) = - let SHA256.MAC !result = SHA256.hmac "rho" ss - in DerivedKey result -{-# INLINE deriveBlindingRho #-} - --- | Derive blinded node ID from shared secret and node pubkey. --- --- @B_i = HMAC256("blinded_node_id", ss_i) * N_i@ -deriveBlindedNodeId - :: SharedSecret - -> Secp256k1.Projective - -> Maybe BS.ByteString -deriveBlindedNodeId (SharedSecret !ss) !nodePub = do - let SHA256.MAC !hmacResult = SHA256.hmac "blinded_node_id" ss - sk <- Secp256k1.roll32 hmacResult - blindedPub <- Secp256k1.mul nodePub sk - pure $! Secp256k1.serialize_point blindedPub -{-# INLINE deriveBlindedNodeId #-} - --- | Compute next ephemeral key pair. --- --- @e_{i+1} = SHA256(E_i || ss_i) * e_i@ --- @E_{i+1} = SHA256(E_i || ss_i) * E_i@ -nextEphemeral - :: BS.ByteString -- ^ e_i (32-byte secret key) - -> Secp256k1.Projective -- ^ E_i - -> SharedSecret -- ^ ss_i - -> Maybe (BS.ByteString, Secp256k1.Projective) -- ^ (e_{i+1}, E_{i+1}) -nextEphemeral !secKey !pubKey (SharedSecret !ss) = do - let !pubBytes = Secp256k1.serialize_point pubKey - !blindingFactor = SHA256.hash (pubBytes <> ss) - bfInt <- Secp256k1.roll32 blindingFactor - -- Compute e_{i+1} = e_i * blindingFactor (mod q) - let !newSecKey = mulSecKey secKey blindingFactor - -- Compute E_{i+1} = E_i * blindingFactor - newPubKey <- Secp256k1.mul pubKey bfInt - pure (newSecKey, newPubKey) -{-# INLINE nextEphemeral #-} - --- | Compute blinding factor for next path key (public key only). -nextPathKey - :: Secp256k1.Projective -- ^ E_i - -> SharedSecret -- ^ ss_i - -> Maybe Secp256k1.Projective -- ^ E_{i+1} -nextPathKey !pubKey (SharedSecret !ss) = do - let !pubBytes = Secp256k1.serialize_point pubKey - !blindingFactor = SHA256.hash (pubBytes <> ss) - bfInt <- Secp256k1.roll32 blindingFactor - Secp256k1.mul pubKey bfInt -{-# INLINE nextPathKey #-} + = EmptyPath + -- ^ the route has no hops + | InvalidNodeId {-# UNPACK #-} !Int + -- ^ the node id of the hop with this index is not a valid point + | InvalidHopData {-# UNPACK #-} !Int !EncodeError + -- ^ the data of the hop with this index can't be encoded + deriving (Eq, Show, Generic) --- Encryption/Decryption ----------------------------------------------------- +instance NFData BlindingError --- | Encrypt hop data with ChaCha20-Poly1305. +-- | Create a blinded route to oneself, given a seed for the route's +-- ephemeral keys (which must be fresh and random for every route) and +-- each node's id and data, from the introduction node to oneself. -- --- Uses rho key and 12-byte zero nonce, empty AAD. -encryptHopData :: DerivedKey -> BlindedHopData -> BS.ByteString -encryptHopData (DerivedKey !rho) !hopData = - let !plaintext = encodeBlindedHopData hopData - !nonce = BS.replicate 12 0 - in case AEAD.encrypt BS.empty rho nonce plaintext of - Left e -> error $ "encryptHopData: unexpected AEAD error: " ++ show e - Right (!ciphertext, !mac) -> ciphertext <> mac -{-# INLINE encryptHopData #-} - --- | Decrypt hop data with ChaCha20-Poly1305. -decryptHopData :: DerivedKey -> BS.ByteString -> Maybe BlindedHopData -decryptHopData (DerivedKey !rho) !encData - | BS.length encData < 16 = Nothing - | otherwise = do - let !ciphertext = BS.take (BS.length encData - 16) encData - !mac = BS.drop (BS.length encData - 16) encData - !nonce = BS.replicate 12 0 - case AEAD.decrypt BS.empty rho nonce (ciphertext, mac) of - Left _ -> Nothing - Right !plaintext -> decodeBlindedHopData plaintext -{-# INLINE decryptHopData #-} - --- TLV Encoding/Decoding ----------------------------------------------------- - --- | Encode BlindedHopData to TLV stream. -encodeBlindedHopData :: BlindedHopData -> BS.ByteString -encodeBlindedHopData !bhd = encodeTlvStream (buildTlvs bhd) - where - buildTlvs :: BlindedHopData -> [TlvRecord] - buildTlvs (BlindedHopData pad sci nid pid pko pr pc af) = - let pad' = maybe [] (\p -> [TlvRecord 1 p]) pad - sci' = maybe [] (\s -> [TlvRecord 2 (encodeShortChannelId s)]) sci - nid' = maybe [] (\n -> [TlvRecord 4 n]) nid - pid' = maybe [] (\p -> [TlvRecord 6 p]) pid - pko' = maybe [] (\k -> [TlvRecord 8 k]) pko - pr' = maybe [] (\r -> [TlvRecord 10 (encodePaymentRelay r)]) pr - pc' = maybe [] (\c -> [TlvRecord 12 (encodePaymentConstraints c)]) pc - af' = maybe [] (\f -> [TlvRecord 14 f]) af - in pad' ++ sci' ++ nid' ++ pid' ++ pko' ++ pr' ++ pc' ++ af' -{-# INLINE encodeBlindedHopData #-} - --- | Decode TLV stream to BlindedHopData. -decodeBlindedHopData :: BS.ByteString -> Maybe BlindedHopData -decodeBlindedHopData !bs = do - tlvs <- decodeTlvStream bs - parseBlindedHopData tlvs - -parseBlindedHopData :: [TlvRecord] -> Maybe BlindedHopData -parseBlindedHopData = go emptyHopData +-- >>> let Just seed = secret_key (BS.replicate 32 0x01) +-- >>> let Just me = secret_key (BS.replicate 32 0x45) +-- >>> let dat = empty_blinded_hop_data { bhd_path_id = Just "deadbeef" } +-- >>> let Right path = create_blinded_path seed [(public_key me, dat)] +-- >>> bp_first_node_id path == public_key me +-- True +-- >>> length (bp_hops path) +-- 1 +create_blinded_path + :: SecretKey + -> [(BOLT1.Point, BlindedHopData)] + -> Either BlindingError BlindedPath +create_blinded_path seed nodes = case nodes of + [] -> Left EmptyPath + (intro, _) : _ -> do + hops <- go (sk_bytes seed) (sk_pub seed) (zip [0 ..] nodes) + pure (BlindedPath intro (public_key seed) hops) where - emptyHopData :: BlindedHopData - emptyHopData = BlindedHopData - Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing - - go :: BlindedHopData -> [TlvRecord] -> Maybe BlindedHopData - go !bhd [] = Just bhd - go !bhd (TlvRecord typ val : rest) = case typ of - 1 -> go bhd { bhdPadding = Just val } rest - 2 -> do - sci <- decodeShortChannelId val - go bhd { bhdShortChannelId = Just sci } rest - 4 -> go bhd { bhdNextNodeId = Just val } rest - 6 -> go bhd { bhdPathId = Just val } rest - 8 -> go bhd { bhdNextPathKeyOverride = Just val } rest - 10 -> do - pr <- decodePaymentRelay val - go bhd { bhdPaymentRelay = Just pr } rest - 12 -> do - pc <- decodePaymentConstraints val - go bhd { bhdPaymentConstraints = Just pc } rest - 14 -> go bhd { bhdAllowedFeatures = Just val } rest - _ -> go bhd rest -- Skip unknown TLVs - --- PaymentRelay encoding/decoding -------------------------------------------- + go _ _ [] = Right [] + go e epub ((i, (nid, dat)) : rest) = do + let note = maybe (Left (InvalidNodeId i)) Right + node <- note (from_point nid) + ss <- note (ecdh e node) + bid <- note (blind_pub node (blinded_node_tweak ss) >>= to_point) + plain <- either (Left . InvalidHopData i) Right + (encode_blinded_hop_data dat) + enc <- maybe (Left (InvalidHopData i FieldTooLong)) Right + (encrypt (derive_rho ss) plain) + let hop = BlindedHop bid enc + case rest of + [] -> Right [hop] + _ -> do + let bf = blinding_factor epub ss + e' <- note (blind_scalar e bf) + epub' <- note (blind_pub epub bf) + (hop :) <$> go e' epub' rest --- | Encode PaymentRelay. +-- | Decrypt the @encrypted_recipient_data@ received by a node in a +-- blinded route, given the node's private key and the path key it +-- received. -- --- Format: 2-byte cltv_delta BE, 4-byte fee_prop BE, tu32 fee_base -encodePaymentRelay :: PaymentRelay -> BS.ByteString -encodePaymentRelay (PaymentRelay !cltv !feeProp !feeBase) = toStrict $ - B.word16BE cltv <> - B.word32BE feeProp <> - B.byteString (encodeWord32TU feeBase) -{-# INLINE encodePaymentRelay #-} - --- | Decode PaymentRelay. -decodePaymentRelay :: BS.ByteString -> Maybe PaymentRelay -decodePaymentRelay !bs - | BS.length bs < 6 = Nothing - | otherwise = do - let !cltv = word16BE (BS.take 2 bs) - !feeProp = word32BE (BS.take 4 (BS.drop 2 bs)) - !feeBaseBytes = BS.drop 6 bs - feeBase <- decodeWord32TU feeBaseBytes - Just (PaymentRelay cltv feeProp feeBase) -{-# INLINE decodePaymentRelay #-} - --- PaymentConstraints encoding/decoding -------------------------------------- - --- | Encode PaymentConstraints. +-- Returns the decrypted data and the path key for the next node (the +-- data's @next_path_key_override@, if present). +-- 'Lightning.Protocol.BOLT4.process' does this for payment onions. -- --- Format: 4-byte max_cltv BE, tu64 htlc_min -encodePaymentConstraints :: PaymentConstraints -> BS.ByteString -encodePaymentConstraints (PaymentConstraints !maxCltv !htlcMin) = toStrict $ - B.word32BE maxCltv <> - B.byteString (encodeWord64TU htlcMin) -{-# INLINE encodePaymentConstraints #-} - --- | Decode PaymentConstraints. -decodePaymentConstraints :: BS.ByteString -> Maybe PaymentConstraints -decodePaymentConstraints !bs - | BS.length bs < 4 = Nothing - | otherwise = do - let !maxCltv = word32BE (BS.take 4 bs) - !htlcMinBytes = BS.drop 4 bs - htlcMin <- decodeWord64TU htlcMinBytes - Just (PaymentConstraints maxCltv htlcMin) -{-# INLINE decodePaymentConstraints #-} - --- Shared secret computation ------------------------------------------------- - --- | Compute shared secret from ECDH. -computeSharedSecret - :: BS.ByteString -- ^ 32-byte secret key - -> Secp256k1.Projective -- ^ Public key - -> Maybe SharedSecret -computeSharedSecret !secBs !pub = do - sec <- Secp256k1.roll32 secBs - ecdhPoint <- Secp256k1.mul pub sec - let !compressed = Secp256k1.serialize_point ecdhPoint - !ss = SHA256.hash compressed - pure $! SharedSecret ss -{-# INLINE computeSharedSecret #-} - --- Path creation ------------------------------------------------------------- - --- | Create a blinded path from a seed and list of nodes with their data. -createBlindedPath - :: BS.ByteString -- ^ 32-byte random seed for ephemeral key - -> [(Secp256k1.Projective, BlindedHopData)] -- ^ Nodes with their data - -> Either BlindingError BlindedPath -createBlindedPath !seed !nodes - | BS.length seed /= 32 = Left InvalidSeed - | otherwise = case nodes of - [] -> Left EmptyPath - ((introNode, _) : _) -> do - -- (e_0, E_0) = keypair from seed - e0 <- maybe (Left InvalidSeed) Right (Secp256k1.roll32 seed) - e0Pub <- maybe (Left InvalidSeed) Right - (Secp256k1.mul Secp256k1._CURVE_G e0) - -- Process all hops - hops <- processHops seed e0Pub nodes 0 - Right (BlindedPath introNode e0Pub hops) - -processHops - :: BS.ByteString -- ^ Current e_i - -> Secp256k1.Projective -- ^ Current E_i - -> [(Secp256k1.Projective, BlindedHopData)] - -> Int -- ^ Index for error reporting - -> Either BlindingError [BlindedHop] -processHops _ _ [] _ = Right [] -processHops !eKey !ePub ((nodePub, hopData) : rest) !idx = do - -- ss_i = SHA256(ECDH(e_i, N_i)) - ss <- maybe (Left (InvalidNodeKey idx)) Right - (computeSharedSecret eKey nodePub) - -- rho_i = deriveBlindingRho(ss_i) - let !rho = deriveBlindingRho ss - -- B_i = deriveBlindedNodeId(ss_i, N_i) - blindedId <- maybe (Left (InvalidNodeKey idx)) Right - (deriveBlindedNodeId ss nodePub) - -- encrypted_i = encryptHopData(rho_i, data_i) - let !encData = encryptHopData rho hopData - !hop = BlindedHop blindedId encData - -- (e_{i+1}, E_{i+1}) = nextEphemeral(e_i, E_i, ss_i) - (nextE, nextEPub) <- maybe (Left (InvalidNodeKey idx)) Right - (nextEphemeral eKey ePub ss) - -- Process remaining hops - restHops <- processHops nextE nextEPub rest (idx + 1) - Right (hop : restHops) - --- Hop processing ------------------------------------------------------------ +-- >>> let Just seed = secret_key (BS.replicate 32 0x01) +-- >>> let Just me = secret_key (BS.replicate 32 0x45) +-- >>> let dat = empty_blinded_hop_data { bhd_path_id = Just "deadbeef" } +-- >>> let Right path = create_blinded_path seed [(public_key me, dat)] +-- >>> let [hop] = bp_hops path +-- >>> let pk = bp_first_path_key path +-- >>> let Right info = decrypt_recipient_data me pk (bh_encrypted_data hop) +-- >>> bhd_path_id (bi_data info) +-- Just "deadbeef" +decrypt_recipient_data + :: SecretKey + -> BOLT1.Point + -> BS.ByteString + -> Either ProcessError BlindedInfo +decrypt_recipient_data sk pk enc = do + e <- maybe (Left InvalidPathKey) Right (from_point pk) + ss <- maybe (Left InvalidPathKey) Right (ecdh (sk_bytes sk) e) + unblind ss e enc --- | Process a blinded hop, returning decrypted data and next path key. -processBlindedHop - :: BS.ByteString -- ^ Node's 32-byte private key - -> Secp256k1.Projective -- ^ E_i, current path key (blinding point) - -> BS.ByteString -- ^ encrypted_data from onion payload - -> Either BlindingError (BlindedHopData, Secp256k1.Projective) -processBlindedHop !nodeSecKey !pathKey !encData = do - -- ss = SHA256(ECDH(node_seckey, path_key)) - ss <- maybe (Left InvalidPathKey) Right - (computeSharedSecret nodeSecKey pathKey) - -- rho = deriveBlindingRho(ss) - let !rho = deriveBlindingRho ss - -- hop_data = decryptHopData(rho, encrypted_data) - hopData <- maybe (Left DecryptionFailed) Right - (decryptHopData rho encData) - -- Compute next path key - nextKey <- case bhdNextPathKeyOverride hopData of - Just override -> do - -- Parse override as compressed point - maybe (Left InvalidPathKey) Right (Secp256k1.parse_point override) - Nothing -> do - -- E_next = SHA256(path_key || ss) * path_key - maybe (Left InvalidPathKey) Right (nextPathKey pathKey ss) - Right (hopData, nextKey) +-- Decrypt encrypted_recipient_data, given the shared secret with the path +-- key, and the path key. +unblind + :: SharedSecret + -> Secp256k1.Projective + -> BS.ByteString + -> Either ProcessError BlindedInfo +unblind ss e enc = do + plain <- maybe (Left InvalidRecipientData) Right + (decrypt (derive_rho ss) enc) + dat <- either (const (Left InvalidRecipientData)) Right + (decode_blinded_hop_data plain) + next <- case bhd_next_path_key_override dat of + Just o -> Right o + Nothing -> maybe (Left InvalidPathKey) Right + (blind_pub e (blinding_factor e ss) >>= to_point) + pure (BlindedInfo dat next) --- Scalar multiplication ----------------------------------------------------- +-- ChaCha20-Poly1305 with an all-zero nonce and no associated data; the +-- tag follows the ciphertext. Fails only on counter overflow. +encrypt :: DerivedKey -> BS.ByteString -> Maybe BS.ByteString +encrypt k plain = + case AEAD.encrypt BS.empty (un_derived_key k) (BS.replicate 12 0) plain of + Right (c, t) -> Just (c <> t) + Left _ -> Nothing --- | Multiply two 32-byte scalars mod curve order q. --- --- Uses Montgomery multiplication from ppad-fixed for efficiency. -mulSecKey :: BS.ByteString -> BS.ByteString -> BS.ByteString -mulSecKey !a !b = - let !aW = Secp256k1.unsafe_roll32 a - !bW = Secp256k1.unsafe_roll32 b - !aM = S.to aW - !bM = S.to bW - !resultM = S.mul aM bM - !resultW = S.retr resultM - in Secp256k1.unroll32 resultW -{-# INLINE mulSecKey #-} +decrypt :: DerivedKey -> BS.ByteString -> Maybe BS.ByteString +decrypt k enc + | BS.length enc < 16 = Nothing + | otherwise = + let (c, t) = BS.splitAt (BS.length enc - 16) enc + in case AEAD.decrypt BS.empty (un_derived_key k) (BS.replicate 12 0) + (c, t) of + Right p -> Just p + Left _ -> Nothing diff --git a/lib/Lightning/Protocol/BOLT4/Codec.hs b/lib/Lightning/Protocol/BOLT4/Codec.hs --- a/lib/Lightning/Protocol/BOLT4/Codec.hs +++ b/lib/Lightning/Protocol/BOLT4/Codec.hs @@ -1,6 +1,4 @@ -{-# OPTIONS_HADDOCK prune #-} -{-# LANGUAGE BangPatterns #-} -{-# LANGUAGE OverloadedStrings #-} +{-# OPTIONS_HADDOCK hide #-} -- | -- Module: Lightning.Protocol.BOLT4.Codec @@ -8,380 +6,346 @@ -- License: MIT -- Maintainer: Jared Tobin -- --- Serialization and deserialization for BOLT4 types. +-- Encodings of the BOLT #4 types. module Lightning.Protocol.BOLT4.Codec ( - -- * BigSize encoding - encodeBigSize - , decodeBigSize - , bigSizeLen - - -- * TLV encoding - , encodeTlv - , decodeTlv - , decodeTlvStream - , encodeTlvStream - - -- * Packet serialization - , encodeOnionPacket - , decodeOnionPacket - , encodeHopPayload - , decodeHopPayload - - -- * ShortChannelId - , encodeShortChannelId - , decodeShortChannelId - - -- * Failure messages - , encodeFailureMessage - , decodeFailureMessage - - -- * Internal helpers (for Blinding) - , toStrict - , word16BE - , word32BE - , encodeWord64TU - , decodeWord64TU - , encodeWord32TU - , decodeWord32TU + encode_onion_packet + , decode_onion_packet + , encode_hop_payload + , decode_hop_payload + , encode_blinded_hop_data + , decode_blinded_hop_data + , encode_failure_message + , decode_failure_message ) where -import Data.Bits (shiftL, shiftR, (.&.)) +import Data.Bifunctor (first) import qualified Data.ByteString as BS -import qualified Data.ByteString.Builder as B -import qualified Data.ByteString.Lazy as BL -import Data.Word (Word16, Word32, Word64) +import Data.Maybe (catMaybes) +import Data.Word (Word16, Word64) +import qualified Lightning.Protocol.BOLT1 as BOLT1 import Lightning.Protocol.BOLT4.Types +import qualified Lightning.Protocol.BOLT9 as BOLT9 --- BigSize encoding --------------------------------------------------------- +-- onion packets -------------------------------------------------------------- --- | Encode integer as BigSize. +-- | Encode an t'OnionPacket' (1366 bytes). -- --- * 0-0xFC: 1 byte --- * 0xFD-0xFFFF: 0xFD ++ 2 bytes BE --- * 0x10000-0xFFFFFFFF: 0xFE ++ 4 bytes BE --- * larger: 0xFF ++ 8 bytes BE -encodeBigSize :: Word64 -> BS.ByteString -encodeBigSize !n - | n < 0xFD = BS.singleton (fromIntegral n) - | n <= 0xFFFF = toStrict $ - B.word8 0xFD <> B.word16BE (fromIntegral n) - | n <= 0xFFFFFFFF = toStrict $ - B.word8 0xFE <> B.word32BE (fromIntegral n) - | otherwise = toStrict $ - B.word8 0xFF <> B.word64BE n -{-# INLINE encodeBigSize #-} +-- >>> let Just pk = BOLT1.point (BS.cons 0x02 (BS.replicate 32 0x01)) +-- >>> let Just hp = hop_payloads (BS.replicate 1300 0) +-- >>> let Just mac = hmac32 (BS.replicate 32 0) +-- >>> BS.length (encode_onion_packet (OnionPacket 0 pk hp mac)) +-- 1366 +encode_onion_packet :: OnionPacket -> BS.ByteString +encode_onion_packet (OnionPacket v k hp mac) = BS.concat + [BS.singleton v, BOLT1.un_point k, un_hop_payloads hp, un_hmac32 mac] --- | Decode BigSize, returning (value, remaining bytes). -decodeBigSize :: BS.ByteString -> Maybe (Word64, BS.ByteString) -decodeBigSize !bs = case BS.uncons bs of - Nothing -> Nothing - Just (b, rest) - | b < 0xFD -> Just (fromIntegral b, rest) - | b == 0xFD -> do - (hi, r1) <- BS.uncons rest - (lo, r2) <- BS.uncons r1 - let !val = fromIntegral hi `shiftL` 8 + fromIntegral lo - -- Canonical: must be >= 0xFD - if val < 0xFD then Nothing else Just (val, r2) - | b == 0xFE -> do - if BS.length rest < 4 then Nothing else do - let !bytes = BS.take 4 rest - !r = BS.drop 4 rest - !val = word32BE bytes - -- Canonical: must be > 0xFFFF - if val <= 0xFFFF then Nothing else Just (fromIntegral val, r) - | otherwise -> do -- b == 0xFF - if BS.length rest < 8 then Nothing else do - let !bytes = BS.take 8 rest - !r = BS.drop 8 rest - !val = word64BE bytes - -- Canonical: must be > 0xFFFFFFFF - if val <= 0xFFFFFFFF then Nothing else Just (val, r) -{-# INLINE decodeBigSize #-} +-- | Decode an t'OnionPacket' from exactly 1366 bytes. The public key must +-- carry a compressed-encoding prefix; the version byte is not checked +-- (see 'Lightning.Protocol.BOLT4.process'). +-- +-- >>> decode_onion_packet (BS.replicate 1365 0) +-- Left InvalidLength +decode_onion_packet :: BS.ByteString -> Either DecodeError OnionPacket +decode_onion_packet bs = case BS.uncons bs of + Just (v, rest) | BS.length bs == 1366 -> do + let (k, r0) = BS.splitAt 33 rest + (hp, mac) = BS.splitAt 1300 r0 + pk <- maybe (Left InvalidPoint) Right (BOLT1.point k) + pure (OnionPacket v pk (HopPayloads hp) (Hmac32 mac)) + _ -> Left InvalidLength --- | Get encoded size of a BigSize value without encoding. -bigSizeLen :: Word64 -> Int -bigSizeLen !n - | n < 0xFD = 1 - | n <= 0xFFFF = 3 - | n <= 0xFFFFFFFF = 5 - | otherwise = 9 -{-# INLINE bigSizeLen #-} +-- TLV helpers ---------------------------------------------------------------- --- TLV encoding ------------------------------------------------------------- +-- encode typed records with extra ones, none of which may have a known +-- type +encode_tlvs + :: [Word64] + -> [BOLT1.TlvRecord] + -> BOLT1.TlvStream + -> Either EncodeError BS.ByteString +encode_tlvs known typed extra + | any ((`elem` known) . BOLT1.tlv_type) ex = Left ConflictingTlv + | otherwise = case BOLT1.tlv_stream (typed ++ ex) of + Nothing -> Left ConflictingTlv + Just s -> Right (BOLT1.encode_tlv_stream s) + where + ex = BOLT1.un_tlv_stream extra --- | Encode a TLV record. -encodeTlv :: TlvRecord -> BS.ByteString -encodeTlv (TlvRecord !typ !val) = toStrict $ - B.byteString (encodeBigSize typ) <> - B.byteString (encodeBigSize (fromIntegral (BS.length val))) <> - B.byteString val -{-# INLINE encodeTlv #-} +record :: Word64 -> (a -> BS.ByteString) -> Maybe a -> Maybe BOLT1.TlvRecord +record t f = fmap (BOLT1.TlvRecord t . f) --- | Decode a single TLV record. -decodeTlv :: BS.ByteString -> Maybe (TlvRecord, BS.ByteString) -decodeTlv !bs = do - (typ, r1) <- decodeBigSize bs - (len, r2) <- decodeBigSize r1 - let !len' = fromIntegral len - if BS.length r2 < len' - then Nothing - else do - let !val = BS.take len' r2 - !rest = BS.drop len' r2 - Just (TlvRecord typ val, rest) -{-# INLINE decodeTlv #-} +-- decode a TLV stream with the given known types +decode_tlvs :: [Word64] -> BS.ByteString -> Either DecodeError BOLT1.TlvStream +decode_tlvs known = + first InvalidTlvStream . BOLT1.decode_tlv_stream (`elem` known) --- | Decode a TLV stream (sequence of records). --- Validates strictly increasing type order. -decodeTlvStream :: BS.ByteString -> Maybe [TlvRecord] -decodeTlvStream = go Nothing - where - go :: Maybe Word64 -> BS.ByteString -> Maybe [TlvRecord] - go _ !bs | BS.null bs = Just [] - go !mPrev !bs = do - (rec@(TlvRecord typ _), rest) <- decodeTlv bs - -- Check strictly increasing order - case mPrev of - Just prev | typ <= prev -> Nothing - _ -> do - recs <- go (Just typ) rest - Just (rec : recs) +-- parse the value of a record, if present +field + :: Word64 + -> (BS.ByteString -> Maybe a) + -> BOLT1.TlvStream + -> Either DecodeError (Maybe a) +field t p s = case BOLT1.lookup_tlv t s of + Nothing -> Right Nothing + Just v -> maybe (Left (InvalidTlvValue t)) (Right . Just) (p v) --- | Encode a TLV stream from records. --- Records must be sorted by type, no duplicates. -encodeTlvStream :: [TlvRecord] -> BS.ByteString -encodeTlvStream !recs = toStrict $ foldMap (B.byteString . encodeTlv) recs -{-# INLINE encodeTlvStream #-} +-- the unknown records of a stream +extra_tlvs :: [Word64] -> BOLT1.TlvStream -> BOLT1.TlvStream +extra_tlvs known = BOLT1.filter_tlv_stream (`notElem` known) --- Packet serialization ----------------------------------------------------- +-- a decoder that must consume its whole input +whole + :: (BS.ByteString -> Maybe (a, BS.ByteString)) + -> BS.ByteString + -> Maybe a +whole d bs = case d bs of + Just (a, r) | BS.null r -> Just a + _ -> Nothing --- | Serialize OnionPacket to 1366 bytes. -encodeOnionPacket :: OnionPacket -> BS.ByteString -encodeOnionPacket (OnionPacket !ver !eph !payloads !mac) = toStrict $ - B.word8 ver <> - B.byteString eph <> - B.byteString payloads <> - B.byteString mac -{-# INLINE encodeOnionPacket #-} +encode_tu_msat :: BOLT1.MilliSatoshi -> BS.ByteString +encode_tu_msat = BOLT1.encode_tu64 . BOLT1.un_milli_satoshi --- | Parse OnionPacket from 1366 bytes. -decodeOnionPacket :: BS.ByteString -> Maybe OnionPacket -decodeOnionPacket !bs - | BS.length bs /= onionPacketSize = Nothing - | otherwise = - let !ver = BS.index bs 0 - !eph = BS.take pubkeySize (BS.drop 1 bs) - !payloads = BS.take hopPayloadsSize (BS.drop (1 + pubkeySize) bs) - !mac = BS.drop (1 + pubkeySize + hopPayloadsSize) bs - in Just (OnionPacket ver eph payloads mac) -{-# INLINE decodeOnionPacket #-} +decode_tu_msat :: BS.ByteString -> Maybe BOLT1.MilliSatoshi +decode_tu_msat v = BOLT1.decode_tu64 v >>= BOLT1.milli_satoshi --- | Encode HopPayload to bytes (without length prefix). -encodeHopPayload :: HopPayload -> BS.ByteString -encodeHopPayload !hp = encodeTlvStream (buildTlvs hp) - where - buildTlvs :: HopPayload -> [TlvRecord] - buildTlvs (HopPayload amt cltv sci pd ed cpk unk) = - let amt' = maybe [] (\a -> [TlvRecord 2 (encodeWord64TU a)]) amt - cltv' = maybe [] (\c -> [TlvRecord 4 (encodeWord32TU c)]) cltv - sci' = maybe [] (\s -> [TlvRecord 6 (encodeShortChannelId s)]) sci - pd' = maybe [] (\p -> [TlvRecord 8 (encodePaymentData p)]) pd - ed' = maybe [] (\e -> [TlvRecord 10 e]) ed - cpk' = maybe [] (\k -> [TlvRecord 12 k]) cpk - in amt' ++ cltv' ++ sci' ++ pd' ++ ed' ++ cpk' ++ unk +-- hop payloads --------------------------------------------------------------- --- | Decode HopPayload from bytes. -decodeHopPayload :: BS.ByteString -> Maybe HopPayload -decodeHopPayload !bs = do - tlvs <- decodeTlvStream bs - parseHopPayload tlvs +hop_payload_types :: [Word64] +hop_payload_types = [2, 4, 6, 8, 10, 12, 16, 18] -parseHopPayload :: [TlvRecord] -> Maybe HopPayload -parseHopPayload = go emptyHop +-- | Encode a t'HopPayload' as a @payload@ TLV stream (without its length +-- prefix). Fails if 'hp_extra' has a record of a known type. +-- +-- >>> let hp = empty_hop_payload { hp_outgoing_cltv_value = Just 144 } +-- >>> encode_hop_payload hp +-- Right "\EOT\SOH\144" +encode_hop_payload :: HopPayload -> Either EncodeError BS.ByteString +encode_hop_payload hp = encode_tlvs hop_payload_types typed (hp_extra hp) where - emptyHop :: HopPayload - emptyHop = HopPayload Nothing Nothing Nothing Nothing Nothing Nothing [] + typed = catMaybes + [ record 2 encode_tu_msat (hp_amt_to_forward hp) + , record 4 BOLT1.encode_tu32 (hp_outgoing_cltv_value hp) + , record 6 BOLT1.encode_short_channel_id (hp_short_channel_id hp) + , record 8 encode_payment_data (hp_payment_data hp) + , record 10 id (hp_encrypted_data hp) + , record 12 BOLT1.un_point (hp_current_path_key hp) + , record 16 id (hp_payment_metadata hp) + , record 18 encode_tu_msat (hp_total_amount_msat hp) + ] - go :: HopPayload -> [TlvRecord] -> Maybe HopPayload - go !hp [] = Just hp { hpUnknownTlvs = reverse (hpUnknownTlvs hp) } - go !hp (TlvRecord typ val : rest) = case typ of - 2 -> do - amt <- decodeWord64TU val - go hp { hpAmtToForward = Just amt } rest - 4 -> do - cltv <- decodeWord32TU val - go hp { hpOutgoingCltv = Just cltv } rest - 6 -> do - sci <- decodeShortChannelId val - go hp { hpShortChannelId = Just sci } rest - 8 -> do - pd <- decodePaymentData val - go hp { hpPaymentData = Just pd } rest - 10 -> go hp { hpEncryptedData = Just val } rest - 12 -> go hp { hpCurrentPathKey = Just val } rest - _ -> go hp { hpUnknownTlvs = TlvRecord typ val : hpUnknownTlvs hp } rest +-- | Decode a @payload@ TLV stream (without its length prefix). Fails on +-- a malformed stream, an unknown even type, or a malformed known +-- record. +-- +-- >>> fmap hp_outgoing_cltv_value (decode_hop_payload "\EOT\SOH\144") +-- Right (Just 144) +-- >>> decode_hop_payload "\DC4\NUL" +-- Left (InvalidTlvStream (TlvUnknownEvenType 20)) +decode_hop_payload :: BS.ByteString -> Either DecodeError HopPayload +decode_hop_payload bs = do + s <- decode_tlvs hop_payload_types bs + HopPayload + <$> field 2 decode_tu_msat s + <*> field 4 BOLT1.decode_tu32 s + <*> field 6 (whole BOLT1.decode_short_channel_id) s + <*> field 8 decode_payment_data s + <*> field 10 Just s + <*> field 12 BOLT1.point s + <*> field 16 Just s + <*> field 18 decode_tu_msat s + <*> pure (extra_tlvs hop_payload_types s) --- ShortChannelId ----------------------------------------------------------- +encode_payment_data :: PaymentData -> BS.ByteString +encode_payment_data (PaymentData s t) = un_payment_secret s <> encode_tu_msat t --- | Encode ShortChannelId to 8 bytes. --- Format: 3 bytes block || 3 bytes tx || 2 bytes output (all BE) -encodeShortChannelId :: ShortChannelId -> BS.ByteString -encodeShortChannelId (ShortChannelId !blk !tx !out) = toStrict $ - -- Block height: 3 bytes - B.word8 (fromIntegral (blk `shiftR` 16) .&. 0xFF) <> - B.word8 (fromIntegral (blk `shiftR` 8) .&. 0xFF) <> - B.word8 (fromIntegral blk .&. 0xFF) <> - -- Tx index: 3 bytes - B.word8 (fromIntegral (tx `shiftR` 16) .&. 0xFF) <> - B.word8 (fromIntegral (tx `shiftR` 8) .&. 0xFF) <> - B.word8 (fromIntegral tx .&. 0xFF) <> - -- Output index: 2 bytes - B.word16BE out -{-# INLINE encodeShortChannelId #-} +decode_payment_data :: BS.ByteString -> Maybe PaymentData +decode_payment_data v = do + let (s, t) = BS.splitAt 32 v + PaymentData <$> payment_secret s <*> decode_tu_msat t --- | Decode ShortChannelId from 8 bytes. -decodeShortChannelId :: BS.ByteString -> Maybe ShortChannelId -decodeShortChannelId !bs - | BS.length bs /= 8 = Nothing - | otherwise = - let !b0 = fromIntegral (BS.index bs 0) :: Word32 - !b1 = fromIntegral (BS.index bs 1) :: Word32 - !b2 = fromIntegral (BS.index bs 2) :: Word32 - !blk = (b0 `shiftL` 16) + (b1 `shiftL` 8) + b2 - !t0 = fromIntegral (BS.index bs 3) :: Word32 - !t1 = fromIntegral (BS.index bs 4) :: Word32 - !t2 = fromIntegral (BS.index bs 5) :: Word32 - !tx = (t0 `shiftL` 16) + (t1 `shiftL` 8) + t2 - !o0 = fromIntegral (BS.index bs 6) :: Word16 - !o1 = fromIntegral (BS.index bs 7) :: Word16 - !out = (o0 `shiftL` 8) + o1 - in Just (ShortChannelId blk tx out) -{-# INLINE decodeShortChannelId #-} +-- blinded hop data ----------------------------------------------------------- --- Failure messages --------------------------------------------------------- +blinded_hop_data_types :: [Word64] +blinded_hop_data_types = [1, 2, 4, 6, 8, 10, 12, 14] --- | Encode failure message. -encodeFailureMessage :: FailureMessage -> BS.ByteString -encodeFailureMessage (FailureMessage (FailureCode !code) !dat !tlvs) = - toStrict $ - B.word16BE code <> - B.word16BE (fromIntegral (BS.length dat)) <> - B.byteString dat <> - B.byteString (encodeTlvStream tlvs) -{-# INLINE encodeFailureMessage #-} +-- | Encode t'BlindedHopData' as an @encrypted_data_tlv@ stream. Fails if +-- 'bhd_extra' has a record of a known type. +encode_blinded_hop_data :: BlindedHopData -> Either EncodeError BS.ByteString +encode_blinded_hop_data d = + encode_tlvs blinded_hop_data_types typed (bhd_extra d) + where + typed = catMaybes + [ record 1 id (bhd_padding d) + , record 2 BOLT1.encode_short_channel_id (bhd_short_channel_id d) + , record 4 BOLT1.un_point (bhd_next_node_id d) + , record 6 id (bhd_path_id d) + , record 8 BOLT1.un_point (bhd_next_path_key_override d) + , record 10 encode_payment_relay (bhd_payment_relay d) + , record 12 encode_payment_constraints (bhd_payment_constraints d) + , record 14 BOLT9.render (bhd_allowed_features d) + ] --- | Decode failure message. -decodeFailureMessage :: BS.ByteString -> Maybe FailureMessage -decodeFailureMessage !bs = do - if BS.length bs < 4 then Nothing else do - let !code = word16BE (BS.take 2 bs) - !dlen = fromIntegral (word16BE (BS.take 2 (BS.drop 2 bs))) - if BS.length bs < 4 + dlen then Nothing else do - let !dat = BS.take dlen (BS.drop 4 bs) - !tlvBytes = BS.drop (4 + dlen) bs - tlvs <- if BS.null tlvBytes - then Just [] - else decodeTlvStream tlvBytes - Just (FailureMessage (FailureCode code) dat tlvs) +-- | Decode an @encrypted_data_tlv@ stream. Fails on a malformed stream, +-- an unknown even type, or a malformed known record. +-- +-- >>> fmap bhd_path_id (decode_blinded_hop_data "\ACK\apath id") +-- Right (Just "path id") +decode_blinded_hop_data :: BS.ByteString -> Either DecodeError BlindedHopData +decode_blinded_hop_data bs = do + s <- decode_tlvs blinded_hop_data_types bs + BlindedHopData + <$> field 1 Just s + <*> field 2 (whole BOLT1.decode_short_channel_id) s + <*> field 4 BOLT1.point s + <*> field 6 Just s + <*> field 8 BOLT1.point s + <*> field 10 decode_payment_relay s + <*> field 12 decode_payment_constraints s + <*> field 14 (Just . BOLT9.parse) s + <*> pure (extra_tlvs blinded_hop_data_types s) --- Helper functions --------------------------------------------------------- +encode_payment_relay :: PaymentRelay -> BS.ByteString +encode_payment_relay (PaymentRelay c p b) = + BOLT1.encode_u16 c <> BOLT1.encode_u32 p <> BOLT1.encode_tu32 b --- | Convert Builder to strict ByteString. -toStrict :: B.Builder -> BS.ByteString -toStrict = BL.toStrict . B.toLazyByteString -{-# INLINE toStrict #-} +decode_payment_relay :: BS.ByteString -> Maybe PaymentRelay +decode_payment_relay v = do + (c, r0) <- BOLT1.decode_u16 v + (p, r1) <- BOLT1.decode_u32 r0 + PaymentRelay c p <$> BOLT1.decode_tu32 r1 --- | Decode big-endian Word16. -word16BE :: BS.ByteString -> Word16 -word16BE !bs = - let !b0 = fromIntegral (BS.index bs 0) :: Word16 - !b1 = fromIntegral (BS.index bs 1) :: Word16 - in (b0 `shiftL` 8) + b1 -{-# INLINE word16BE #-} +encode_payment_constraints :: PaymentConstraints -> BS.ByteString +encode_payment_constraints (PaymentConstraints c m) = + BOLT1.encode_u32 c <> encode_tu_msat m --- | Decode big-endian Word32. -word32BE :: BS.ByteString -> Word32 -word32BE !bs = - let !b0 = fromIntegral (BS.index bs 0) :: Word32 - !b1 = fromIntegral (BS.index bs 1) :: Word32 - !b2 = fromIntegral (BS.index bs 2) :: Word32 - !b3 = fromIntegral (BS.index bs 3) :: Word32 - in (b0 `shiftL` 24) + (b1 `shiftL` 16) + (b2 `shiftL` 8) + b3 -{-# INLINE word32BE #-} +decode_payment_constraints :: BS.ByteString -> Maybe PaymentConstraints +decode_payment_constraints v = do + (c, r) <- BOLT1.decode_u32 v + PaymentConstraints c <$> decode_tu_msat r --- | Decode big-endian Word64. -word64BE :: BS.ByteString -> Word64 -word64BE !bs = - let !b0 = fromIntegral (BS.index bs 0) :: Word64 - !b1 = fromIntegral (BS.index bs 1) :: Word64 - !b2 = fromIntegral (BS.index bs 2) :: Word64 - !b3 = fromIntegral (BS.index bs 3) :: Word64 - !b4 = fromIntegral (BS.index bs 4) :: Word64 - !b5 = fromIntegral (BS.index bs 5) :: Word64 - !b6 = fromIntegral (BS.index bs 6) :: Word64 - !b7 = fromIntegral (BS.index bs 7) :: Word64 - in (b0 `shiftL` 56) + (b1 `shiftL` 48) + (b2 `shiftL` 40) + - (b3 `shiftL` 32) + (b4 `shiftL` 24) + (b5 `shiftL` 16) + - (b6 `shiftL` 8) + b7 -{-# INLINE word64BE #-} +-- failure messages ----------------------------------------------------------- --- | Encode Word64 as truncated unsigned (minimal bytes). -encodeWord64TU :: Word64 -> BS.ByteString -encodeWord64TU !n - | n == 0 = BS.empty - | otherwise = BS.dropWhile (== 0) (toStrict (B.word64BE n)) -{-# INLINE encodeWord64TU #-} +-- | Encode a t'FailureMessage': the failure code, its data and the TLV +-- stream. Fails if a @channel_update@ exceeds 65535 bytes. +-- +-- >>> let tlvs = BOLT1.empty_tlv_stream +-- >>> encode_failure_message (FailureMessage TemporaryNodeFailure tlvs) +-- Right " \STX" +encode_failure_message :: FailureMessage -> Either EncodeError BS.ByteString +encode_failure_message (FailureMessage f tlvs) = do + body <- encode_failure f + pure (BOLT1.encode_u16 (failure_code f) <> body + <> BOLT1.encode_tlv_stream tlvs) --- | Decode truncated unsigned to Word64. -decodeWord64TU :: BS.ByteString -> Maybe Word64 -decodeWord64TU !bs - | BS.null bs = Just 0 - | BS.length bs > 8 = Nothing - | not (BS.null bs) && BS.index bs 0 == 0 = Nothing -- Non-canonical - | otherwise = Just (go 0 bs) +encode_failure :: Failure -> Either EncodeError BS.ByteString +encode_failure f = case f of + TemporaryNodeFailure -> Right mempty + PermanentNodeFailure -> Right mempty + RequiredNodeFeatureMissing -> Right mempty + InvalidOnionVersion h -> Right (un_onion_hash h) + InvalidOnionHmac h -> Right (un_onion_hash h) + InvalidOnionKey h -> Right (un_onion_hash h) + TemporaryChannelFailure u -> update u + PermanentChannelFailure -> Right mempty + RequiredChannelFeatureMissing -> Right mempty + UnknownNextPeer -> Right mempty + AmountBelowMinimum m u -> (msat m <>) <$> update u + FeeInsufficient m u -> (msat m <>) <$> update u + IncorrectCltvExpiry c u -> (BOLT1.encode_u32 c <>) <$> update u + ExpiryTooSoon u -> update u + IncorrectOrUnknownPaymentDetails m h -> Right (msat m <> BOLT1.encode_u32 h) + FinalIncorrectCltvExpiry c -> Right (BOLT1.encode_u32 c) + FinalIncorrectHtlcAmount m -> Right (msat m) + ChannelDisabled d u -> (BOLT1.encode_u16 d <>) <$> update u + ExpiryTooFar -> Right mempty + InvalidOnionPayload Nothing -> Right mempty + InvalidOnionPayload (Just (t, o)) -> + Right (BOLT1.encode_bigsize t <> BOLT1.encode_u16 o) + MppTimeout -> Right mempty + InvalidOnionBlinding h -> Right (un_onion_hash h) + UnknownFailure _ d -> Right d where - go :: Word64 -> BS.ByteString -> Word64 - go !acc !b = case BS.uncons b of - Nothing -> acc - Just (x, rest) -> go ((acc `shiftL` 8) + fromIntegral x) rest -{-# INLINE decodeWord64TU #-} + msat = BOLT1.encode_milli_satoshi + update = maybe (Left FieldTooLong) Right . BOLT1.encode_u16_prefixed --- | Encode Word32 as truncated unsigned. -encodeWord32TU :: Word32 -> BS.ByteString -encodeWord32TU !n - | n == 0 = BS.empty - | otherwise = BS.dropWhile (== 0) (toStrict (B.word32BE n)) -{-# INLINE encodeWord32TU #-} +-- | Decode a failure message. +-- +-- Per BOLT #4, bytes following a failure's data are ignored unless +-- they form a valid TLV stream (which, as no failure TLV types are +-- defined, may hold only odd types). The data of an unknown failure +-- code is every byte following it. +-- +-- >>> fmap fm_failure (decode_failure_message " \STX") +-- Right TemporaryNodeFailure +-- >>> decode_failure_message "\DLE\r" +-- Left (InvalidFailureData 4109) +decode_failure_message :: BS.ByteString -> Either DecodeError FailureMessage +decode_failure_message bs = case BOLT1.decode_u16 bs of + Nothing -> Left InvalidLength + Just (c, rest) -> case decode_failure c rest of + Nothing -> Left (InvalidFailureData c) + Just (f, extra) -> + let tlvs = either (const BOLT1.empty_tlv_stream) id + (BOLT1.decode_tlv_stream (const False) extra) + in Right (FailureMessage f tlvs) --- | Decode truncated unsigned to Word32. -decodeWord32TU :: BS.ByteString -> Maybe Word32 -decodeWord32TU !bs - | BS.null bs = Just 0 - | BS.length bs > 4 = Nothing - | not (BS.null bs) && BS.index bs 0 == 0 = Nothing -- Non-canonical - | otherwise = Just (go 0 bs) +decode_failure :: Word16 -> BS.ByteString -> Maybe (Failure, BS.ByteString) +decode_failure c bs = case c of + 0x2002 -> plain TemporaryNodeFailure + 0x6002 -> plain PermanentNodeFailure + 0x6003 -> plain RequiredNodeFeatureMissing + 0xc004 -> hashed InvalidOnionVersion + 0xc005 -> hashed InvalidOnionHmac + 0xc006 -> hashed InvalidOnionKey + 0x1007 -> do + (u, r) <- update bs + pure (TemporaryChannelFailure u, r) + 0x4008 -> plain PermanentChannelFailure + 0x4009 -> plain RequiredChannelFeatureMissing + 0x400a -> plain UnknownNextPeer + 0x100b -> do + (m, r0) <- BOLT1.decode_milli_satoshi bs + (u, r1) <- update r0 + pure (AmountBelowMinimum m u, r1) + 0x100c -> do + (m, r0) <- BOLT1.decode_milli_satoshi bs + (u, r1) <- update r0 + pure (FeeInsufficient m u, r1) + 0x100d -> do + (e, r0) <- BOLT1.decode_u32 bs + (u, r1) <- update r0 + pure (IncorrectCltvExpiry e u, r1) + 0x100e -> do + (u, r) <- update bs + pure (ExpiryTooSoon u, r) + 0x400f -> do + (m, r0) <- BOLT1.decode_milli_satoshi bs + (h, r1) <- BOLT1.decode_u32 r0 + pure (IncorrectOrUnknownPaymentDetails m h, r1) + 0x0012 -> do + (e, r) <- BOLT1.decode_u32 bs + pure (FinalIncorrectCltvExpiry e, r) + 0x0013 -> do + (m, r) <- BOLT1.decode_milli_satoshi bs + pure (FinalIncorrectHtlcAmount m, r) + 0x1014 -> do + (d, r0) <- BOLT1.decode_u16 bs + (u, r1) <- update r0 + pure (ChannelDisabled d u, r1) + 0x0015 -> plain ExpiryTooFar + 0x4016 -> Just $ case BOLT1.decode_bigsize bs of + Just (t, r0) | Just (o, r1) <- BOLT1.decode_u16 r0 -> + (InvalidOnionPayload (Just (t, o)), r1) + _ -> (InvalidOnionPayload Nothing, bs) + 0x0017 -> plain MppTimeout + 0xc018 -> hashed InvalidOnionBlinding + _ -> Just (UnknownFailure c bs, BS.empty) where - go :: Word32 -> BS.ByteString -> Word32 - go !acc !b = case BS.uncons b of - Nothing -> acc - Just (x, rest) -> go ((acc `shiftL` 8) + fromIntegral x) rest -{-# INLINE decodeWord32TU #-} - --- | Encode PaymentData. -encodePaymentData :: PaymentData -> BS.ByteString -encodePaymentData (PaymentData !secret !total) = - secret <> encodeWord64TU total -{-# INLINE encodePaymentData #-} - --- | Decode PaymentData. -decodePaymentData :: BS.ByteString -> Maybe PaymentData -decodePaymentData !bs - | BS.length bs < 32 = Nothing - | otherwise = do - let !secret = BS.take 32 bs - !rest = BS.drop 32 bs - total <- decodeWord64TU rest - Just (PaymentData secret total) -{-# INLINE decodePaymentData #-} + plain f = Just (f, bs) + hashed g + | BS.length bs < 32 = Nothing + | otherwise = + let (h, r) = BS.splitAt 32 bs + in Just (g (OnionHash h), r) + update = BOLT1.decode_u16_prefixed diff --git a/lib/Lightning/Protocol/BOLT4/Construct.hs b/lib/Lightning/Protocol/BOLT4/Construct.hs --- a/lib/Lightning/Protocol/BOLT4/Construct.hs +++ b/lib/Lightning/Protocol/BOLT4/Construct.hs @@ -1,6 +1,6 @@ -{-# OPTIONS_HADDOCK prune #-} +{-# OPTIONS_HADDOCK hide #-} {-# LANGUAGE BangPatterns #-} -{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE DeriveGeneric #-} -- | -- Module: Lightning.Protocol.BOLT4.Construct @@ -8,205 +8,165 @@ -- License: MIT -- Maintainer: Jared Tobin -- --- Onion packet construction for BOLT4. +-- Onion packet construction. module Lightning.Protocol.BOLT4.Construct ( - -- * Types Hop(..) - , Error(..) - - -- * Packet construction + , ConstructError(..) , construct ) where -import Data.Bits (xor) +import Control.DeepSeq (NFData) import qualified Crypto.Curve.Secp256k1 as Secp256k1 import qualified Data.ByteString as BS -import Lightning.Protocol.BOLT4.Codec +import qualified Data.List as L +import GHC.Generics (Generic) +import qualified Lightning.Protocol.BOLT1 as BOLT1 +import Lightning.Protocol.BOLT4.Codec (encode_hop_payload) import Lightning.Protocol.BOLT4.Prim import Lightning.Protocol.BOLT4.Types --- | Route information for a single hop. +-- | A hop of a route: the public key the hop's onion layer is encrypted +-- to (its node id, or its blinded node id in a blinded route), and its +-- payload. data Hop = Hop - { hopPubKey :: !Secp256k1.Projective -- ^ node's public key - , hopPayload :: !HopPayload -- ^ routing data for this hop - } deriving (Eq, Show) + { hop_pubkey :: !BOLT1.Point + , hop_payload :: !HopPayload + } deriving (Eq, Show, Generic) --- | Errors during packet construction. -data Error - = InvalidSessionKey - | EmptyRoute +instance NFData Hop + +-- | Why an onion packet could not be constructed. +data ConstructError + = EmptyRoute + -- ^ the route has no hops | TooManyHops - | PayloadTooLarge !Int - | InvalidHopPubKey !Int - deriving (Eq, Show) + -- ^ the route has more than 20 hops + | InvalidHopPubKey {-# UNPACK #-} !Int + -- ^ the public key of the hop with this index is not a valid point + | InvalidHopPayload {-# UNPACK #-} !Int + -- ^ the payload of the hop with this index can't be encoded, or + -- encodes to fewer than 2 bytes + | PayloadsTooLarge {-# UNPACK #-} !Int + -- ^ the hops' payloads, with their length prefixes and HMACs, take + -- this many bytes, more than the 1300 available + deriving (Eq, Show, Generic) --- | Maximum number of hops in a route. -maxHops :: Int -maxHops = 20 -{-# INLINE maxHops #-} +instance NFData ConstructError --- | Construct an onion packet for a payment route. +-- | Construct an onion packet for a route, given a session key (which +-- must be fresh and random for every onion), the route's hops from +-- the first to the final one, and the associated data (the payment +-- hash, for a payment). -- --- Takes a session key (32 bytes random), list of hops, and associated --- data (typically payment_hash). +-- Returns the packet and the shared secret of each hop, in route +-- order; keep the latter to attribute returned errors with +-- 'Lightning.Protocol.BOLT4.unwrap_error'. -- --- Returns the onion packet and list of shared secrets (for error --- attribution). +-- >>> let Just session = secret_key (BS.replicate 32 0x41) +-- >>> let Just node = secret_key (BS.replicate 32 0x42) +-- >>> let Just amt = BOLT1.milli_satoshi 1000 +-- >>> :{ +-- let payload = empty_hop_payload { +-- hp_amt_to_forward = Just amt +-- , hp_outgoing_cltv_value = Just 800000 +-- } +-- route = [Hop (public_key node) payload] +-- :} +-- >>> let Right (pkt, sss) = construct session route (BS.replicate 32 0) +-- >>> BS.length (encode_onion_packet pkt) +-- 1366 +-- >>> length sss +-- 1 construct - :: BS.ByteString -- ^ 32-byte session key (random) - -> [Hop] -- ^ route (first hop to final destination) - -> BS.ByteString -- ^ associated data - -> Either Error (OnionPacket, [SharedSecret]) -construct !sessionKey !hops !assocData - | BS.length sessionKey /= 32 = Left InvalidSessionKey - | null hops = Left EmptyRoute - | length hops > maxHops = Left TooManyHops + :: SecretKey + -> [Hop] + -> BS.ByteString + -> Either ConstructError (OnionPacket, [SharedSecret]) +construct sk hops ad + | null hops = Left EmptyRoute + | length hops > 20 = Left TooManyHops | otherwise = do - -- Initialize ephemeral keypair from session key - ephSec <- maybe (Left InvalidSessionKey) Right - (Secp256k1.roll32 sessionKey) - ephPub <- maybe (Left InvalidSessionKey) Right - (Secp256k1.derive_pub ephSec) - - -- Compute shared secrets and blinding factors for all hops - let hopPubKeys = map hopPubKey hops - (secrets, _) <- computeAllSecrets sessionKey ephPub hopPubKeys - - -- Validate payload sizes - let payloadBytes = map (encodeHopPayload . hopPayload) hops - payloadSizes = map payloadShiftSize payloadBytes - totalSize = sum payloadSizes - if totalSize > hopPayloadsSize - then Left (PayloadTooLarge totalSize) + pubs <- traverse parse_pub ihops + pls <- traverse encode_pl ihops + let sizes = map shift_size pls + total = sum sizes + if total > 1300 + then Left (PayloadsTooLarge total) else do - -- Generate filler using secrets for all but final hop - let numHops = length hops - secretsExceptFinal = take (numHops - 1) secrets - sizesExceptFinal = take (numHops - 1) payloadSizes - filler = generateFiller secretsExceptFinal sizesExceptFinal - - -- Initialize hop_payloads with deterministic padding - let DerivedKey padKey = derivePad (SharedSecret sessionKey) - initialPayloads = generateStream (DerivedKey padKey) - hopPayloadsSize - - -- Wrap payloads in reverse order (final hop first) - let (finalPayloads, finalHmac) = wrapAllHops - secrets payloadBytes filler assocData initialPayloads + sss <- shared_secrets (sk_bytes sk) (sk_pub sk) (zip [0 ..] pubs) + let streams = map (\ss -> keystream (derive_rho ss) 2600) sss + n = length hops + fill = filler (take (n - 1) streams) (take (n - 1) sizes) + start = keystream (derive_pad sk) 1300 + (body, mac) = wrap ad fill start + (reverse (zip3 sss streams pls)) + pkt = OnionPacket 0 (public_key sk) (HopPayloads body) + (Hmac32 mac) + pure (pkt, sss) + where + ihops = zip [0 ..] hops - -- Build the final packet - let ephPubBytes = Secp256k1.serialize_point ephPub - packet = OnionPacket - { opVersion = versionByte - , opEphemeralKey = ephPubBytes - , opHopPayloads = finalPayloads - , opHmac = finalHmac - } + parse_pub (i, h) = + maybe (Left (InvalidHopPubKey i)) Right (from_point (hop_pubkey h)) - Right (packet, secrets) + encode_pl (i, h) = case encode_hop_payload (hop_payload h) of + Right p | BS.length p >= 2 -> Right p + _ -> Left (InvalidHopPayload i) --- | Compute the total shift size for a payload. -payloadShiftSize :: BS.ByteString -> Int -payloadShiftSize !payload = - let !len = BS.length payload - !bsLen = bigSizeLen (fromIntegral len) - in bsLen + len + hmacSize -{-# INLINE payloadShiftSize #-} +-- bytes a payload takes in hop_payloads: length prefix, payload and HMAC +shift_size :: BS.ByteString -> Int +shift_size p = + let !l = BS.length p + in BS.length (BOLT1.encode_bigsize (fromIntegral l)) + l + 32 --- | Compute shared secrets for all hops. -computeAllSecrets +-- the shared secret of each hop, blinding the ephemeral key pair after +-- each one +shared_secrets :: BS.ByteString -> Secp256k1.Projective - -> [Secp256k1.Projective] - -> Either Error ([SharedSecret], Secp256k1.Projective) -computeAllSecrets !initSec !initPub = go initSec initPub 0 [] + -> [(Int, Secp256k1.Projective)] + -> Either ConstructError [SharedSecret] +shared_secrets _ _ [] = Right [] +shared_secrets e epub ((i, pub) : rest) = do + ss <- note (ecdh e pub) + case rest of + [] -> Right [ss] + _ -> do + let bf = blinding_factor epub ss + e' <- note (blind_scalar e bf) + epub' <- note (blind_pub epub bf) + (ss :) <$> shared_secrets e' epub' rest where - go !_ephSec !ephPub !_ !acc [] = Right (reverse acc, ephPub) - go !ephSec !ephPub !idx !acc (hopPub:rest) = do - ss <- maybe (Left (InvalidHopPubKey idx)) Right - (computeSharedSecret ephSec hopPub) - let !bf = computeBlindingFactor ephPub ss - newEphSec <- maybe (Left (InvalidHopPubKey idx)) Right - (blindSecKey ephSec bf) - newEphPub <- maybe (Left (InvalidHopPubKey idx)) Right - (blindPubKey ephPub bf) - go newEphSec newEphPub (idx + 1) (ss : acc) rest + note = maybe (Left (InvalidHopPubKey i)) Right --- | Generate filler bytes. -generateFiller :: [SharedSecret] -> [Int] -> BS.ByteString -generateFiller !secrets !sizes = go BS.empty secrets sizes +-- the filler, from the 2600-byte rho streams and shift sizes of all +-- hops but the final one +filler :: [BS.ByteString] -> [Int] -> BS.ByteString +filler streams sizes = L.foldl' step BS.empty (zip streams sizes) where - go !filler [] [] = filler - go !filler (ss:sss) (sz:szs) = - let !extended = filler <> BS.replicate sz 0 - !rhoKey = deriveRho ss - !stream = generateStream rhoKey (2 * hopPayloadsSize) - !streamOffset = hopPayloadsSize - !streamPart = BS.take (BS.length extended) - (BS.drop streamOffset stream) - !newFiller = xorBytes extended streamPart - in go newFiller sss szs - go !filler _ _ = filler -{-# INLINE generateFiller #-} + step f (s, n) = + let !ext = f <> BS.replicate n 0 + !off = 1300 - BS.length f + in xor_bytes ext (BS.take (BS.length ext) (BS.drop off s)) --- | Wrap all hops in reverse order. -wrapAllHops - :: [SharedSecret] - -> [BS.ByteString] - -> BS.ByteString +-- wrap the hops' payloads, given (shared secret, rho stream, payload) +-- from the final hop to the first, returning hop_payloads and the HMAC +wrap + :: BS.ByteString -> BS.ByteString -> BS.ByteString + -> [(SharedSecret, BS.ByteString, BS.ByteString)] -> (BS.ByteString, BS.ByteString) -wrapAllHops !secrets !payloads !filler !assocData !initPayloads = - let !paired = reverse (zip secrets payloads) - !numHops = length paired - !initHmac = BS.replicate hmacSize 0 - in go numHops initPayloads initHmac paired +wrap ad fill = go True (BS.replicate 32 0) where - go !_ !hopPayloads !hmac [] = (hopPayloads, hmac) - go !remaining !hopPayloads !hmac ((ss, payload):rest) = - let !isLastHop = remaining == length (reverse (zip secrets payloads)) - (!newPayloads, !newHmac) = wrapHop ss payload hmac hopPayloads - assocData filler isLastHop - in go (remaining - 1) newPayloads newHmac rest - --- | Wrap a single hop's payload. -wrapHop - :: SharedSecret - -> BS.ByteString - -> BS.ByteString - -> BS.ByteString - -> BS.ByteString - -> BS.ByteString - -> Bool - -> (BS.ByteString, BS.ByteString) -wrapHop !ss !payload !hmac !hopPayloads !assocData !filler !isFinalHop = - let !payloadLen = BS.length payload - !lenBytes = encodeBigSize (fromIntegral payloadLen) - !shiftSize = BS.length lenBytes + payloadLen + hmacSize - !shifted = BS.take (hopPayloadsSize - shiftSize) hopPayloads - !prepended = lenBytes <> payload <> hmac <> shifted - !rhoKey = deriveRho ss - !stream = generateStream rhoKey hopPayloadsSize - !obfuscated = xorBytes prepended stream - !withFiller = if isFinalHop && not (BS.null filler) - then applyFiller obfuscated filler - else obfuscated - !muKey = deriveMu ss - !newHmac = computeHmac muKey withFiller assocData - in (withFiller, newHmac) -{-# INLINE wrapHop #-} - --- | Apply filler to the tail of hop_payloads. -applyFiller :: BS.ByteString -> BS.ByteString -> BS.ByteString -applyFiller !hopPayloads !filler = - let !fillerLen = BS.length filler - !prefix = BS.take (hopPayloadsSize - fillerLen) hopPayloads - in prefix <> filler -{-# INLINE applyFiller #-} - --- | XOR two ByteStrings. -xorBytes :: BS.ByteString -> BS.ByteString -> BS.ByteString -xorBytes !a !b = BS.pack $ BS.zipWith xor a b -{-# INLINE xorBytes #-} + go _ !mac !buf [] = (buf, mac) + go final !mac !buf ((ss, stream, pl) : rest) = + let !len = BOLT1.encode_bigsize (fromIntegral (BS.length pl)) + !n = BS.length len + BS.length pl + 32 + !shifted = BS.concat [len, pl, mac, BS.take (1300 - n) buf] + !obf = xor_bytes shifted stream + !buf' | final = BS.take (1300 - BS.length fill) obf <> fill + | otherwise = obf + !mac' = hmac (derive_mu ss) (buf' <> ad) + in go False mac' buf' rest diff --git a/lib/Lightning/Protocol/BOLT4/Error.hs b/lib/Lightning/Protocol/BOLT4/Error.hs --- a/lib/Lightning/Protocol/BOLT4/Error.hs +++ b/lib/Lightning/Protocol/BOLT4/Error.hs @@ -1,6 +1,5 @@ -{-# OPTIONS_HADDOCK prune #-} -{-# LANGUAGE BangPatterns #-} -{-# LANGUAGE OverloadedStrings #-} +{-# OPTIONS_HADDOCK hide #-} +{-# LANGUAGE DeriveGeneric #-} -- | -- Module: Lightning.Protocol.BOLT4.Error @@ -8,216 +7,115 @@ -- License: MIT -- Maintainer: Jared Tobin -- --- Error packet construction and unwrapping for BOLT4 onion routing. --- --- Failing nodes construct error packets that are wrapped at each --- intermediate hop on the return path. The origin node unwraps --- layers to attribute the error to a specific hop. +-- Returning errors: construction, wrapping and attribution of return +-- packets. module Lightning.Protocol.BOLT4.Error ( - -- * Types ErrorPacket(..) - , AttributionResult(..) - , minErrorPacketSize - - -- * Error construction (failing node) - , constructError - - -- * Error forwarding (intermediate node) - , wrapError - - -- * Error unwrapping (origin node) - , unwrapError + , Attribution(..) + , construct_error + , wrap_error + , unwrap_error ) where -import Data.Bits (xor) +import Control.DeepSeq (NFData) import qualified Data.ByteString as BS -import qualified Data.ByteString.Builder as B -import qualified Data.ByteString.Lazy as BL -import qualified Crypto.Hash.SHA256 as SHA256 -import Data.Word (Word8, Word16) -import Lightning.Protocol.BOLT4.Codec (encodeFailureMessage, decodeFailureMessage) +import GHC.Generics (Generic) +import qualified Lightning.Protocol.BOLT1 as BOLT1 +import Lightning.Protocol.BOLT4.Codec import Lightning.Protocol.BOLT4.Prim -import Lightning.Protocol.BOLT4.Types (FailureMessage) +import Lightning.Protocol.BOLT4.Types --- | Wrapped error packet ready for return to origin. +-- | An obfuscated return packet (the @reason@ of @update_fail_htlc@). newtype ErrorPacket = ErrorPacket BS.ByteString - deriving (Eq, Show) - --- | Result of error attribution. -data AttributionResult - = Attributed {-# UNPACK #-} !Int !FailureMessage - -- ^ (hop index, failure) - | UnknownOrigin !BS.ByteString - -- ^ Could not attribute to any hop - deriving (Eq, Show) - --- | Minimum error packet size (256 bytes per spec). -minErrorPacketSize :: Int -minErrorPacketSize = 256 -{-# INLINE minErrorPacketSize #-} - --- Error construction --------------------------------------------------------- + deriving (Eq, Show, Generic) --- | Construct an error packet at a failing node. --- --- Takes the shared secret (from processing) and failure message, --- and wraps it for return to origin. -constructError - :: SharedSecret -- ^ from packet processing - -> FailureMessage -- ^ failure details - -> ErrorPacket -constructError !ss !failure = - let !um = deriveUm ss - !ammag = deriveAmmag ss - !inner = buildErrorMessage um failure - !obfuscated = obfuscateError ammag inner - in ErrorPacket obfuscated -{-# INLINE constructError #-} +instance NFData ErrorPacket --- | Wrap an existing error packet for forwarding back. --- --- Each intermediate node wraps the error with its own layer. -wrapError - :: SharedSecret -- ^ this node's shared secret - -> ErrorPacket -- ^ error from downstream - -> ErrorPacket -wrapError !ss (ErrorPacket !packet) = - let !ammag = deriveAmmag ss - !wrapped = obfuscateError ammag packet - in ErrorPacket wrapped -{-# INLINE wrapError #-} +-- | The origin of a return packet, as found by 'unwrap_error'. +data Attribution + = Attributed {-# UNPACK #-} !Int !FailureMessage + -- ^ the hop with this index (from 0, in route order) returned the + -- failure + | MalformedFailure {-# UNPACK #-} !Int + -- ^ the hop with this index returned the packet, but its failure + -- message can't be decoded + | UnknownOrigin + -- ^ no hop's HMAC matches + deriving (Eq, Show, Generic) --- Error unwrapping ----------------------------------------------------------- +instance NFData Attribution --- | Attempt to attribute an error to a specific hop. --- --- Takes the shared secrets from original packet construction --- (in order from first hop to final) and the error packet. +-- | Construct a return packet at the failing node, given the shared +-- secret from processing the onion and the failure. -- --- Tries each hop's keys until HMAC verifies, revealing origin. -unwrapError - :: [SharedSecret] -- ^ secrets from construction, in route order - -> ErrorPacket -- ^ received error - -> AttributionResult -unwrapError secrets (ErrorPacket !initialPacket) = go 0 initialPacket secrets - where - go :: Int -> BS.ByteString -> [SharedSecret] -> AttributionResult - go !_ !packet [] = UnknownOrigin packet - go !idx !packet (ss:rest) = - let !ammag = deriveAmmag ss - !um = deriveUm ss - !deobfuscated = deobfuscateError ammag packet - in if verifyErrorHmac um deobfuscated - then case parseErrorMessage (BS.drop 32 deobfuscated) of - Just msg -> Attributed idx msg - Nothing -> UnknownOrigin deobfuscated - else go (idx + 1) deobfuscated rest - --- Internal functions --------------------------------------------------------- - --- | Build the inner error message structure. +-- The failure message is padded so that its length plus that of the +-- padding is at least 256 bytes. Fails if the failure message can't +-- be encoded, or exceeds 65535 bytes. -- --- Format: HMAC (32) || len (2) || message || pad_len (2) || padding --- Total must be >= 256 bytes. -buildErrorMessage - :: DerivedKey -- ^ um key - -> FailureMessage -- ^ failure to encode - -> BS.ByteString -- ^ complete message with HMAC -buildErrorMessage (DerivedKey !umKey) !failure = - let !encoded = encodeFailureMessage failure - !msgLen = BS.length encoded - -- Total payload: len(2) + msg + pad_len(2) + padding = 256 - 32 = 224 - -- padding = 224 - 2 - msgLen - 2 = 220 - msgLen - !padLen = max 0 (minErrorPacketSize - 32 - 2 - msgLen - 2) - !padding = BS.replicate padLen 0 - -- Build: len || message || pad_len || padding - !payload = toStrict $ - B.word16BE (fromIntegral msgLen) <> - B.byteString encoded <> - B.word16BE (fromIntegral padLen) <> - B.byteString padding - -- HMAC over the payload - SHA256.MAC !hmac = SHA256.hmac umKey payload - in hmac <> payload -{-# INLINE buildErrorMessage #-} +-- >>> let Just ss = shared_secret (BS.replicate 32 0x01) +-- >>> let fm = FailureMessage TemporaryNodeFailure BOLT1.empty_tlv_stream +-- >>> let Right (ErrorPacket pkt) = construct_error ss fm +-- >>> BS.length pkt +-- 292 +construct_error + :: SharedSecret + -> FailureMessage + -> Either EncodeError ErrorPacket +construct_error ss fm = do + msg <- encode_failure_message fm + let len = BS.length msg + if len > 65535 + then Left FieldTooLong + else do + let pad = max 0 (256 - len) + body = BS.concat + [ BOLT1.encode_u16 (fromIntegral len), msg + , BOLT1.encode_u16 (fromIntegral pad), BS.replicate pad 0 ] + mac = hmac (derive_um ss) body + pure (wrap_error ss (ErrorPacket (mac <> body))) --- | Obfuscate error packet with ammag stream. +-- | Wrap a return packet from downstream at an intermediate node, given +-- the shared secret from processing the onion. -- --- XORs the entire packet with pseudo-random stream. -obfuscateError - :: DerivedKey -- ^ ammag key - -> BS.ByteString -- ^ error packet - -> BS.ByteString -- ^ obfuscated packet -obfuscateError !ammag !packet = - let !stream = generateStream ammag (BS.length packet) - in xorBytes packet stream -{-# INLINE obfuscateError #-} +-- >>> let Just ss = shared_secret (BS.replicate 32 0x01) +-- >>> wrap_error ss (wrap_error ss (ErrorPacket "packet")) +-- ErrorPacket "packet" +wrap_error :: SharedSecret -> ErrorPacket -> ErrorPacket +wrap_error ss (ErrorPacket p) = + ErrorPacket (xor_bytes p (keystream (derive_ammag ss) (BS.length p))) --- | Remove one layer of obfuscation from error packet. +-- | Find the origin of a return packet at the origin node, given the +-- shared secrets from 'Lightning.Protocol.BOLT4.construct', in route +-- order. -- --- XOR is its own inverse, so same as obfuscation. -deobfuscateError - :: DerivedKey -- ^ ammag key - -> BS.ByteString -- ^ obfuscated packet - -> BS.ByteString -- ^ deobfuscated packet -deobfuscateError = obfuscateError -{-# INLINE deobfuscateError #-} - --- | Verify error HMAC after deobfuscation. -verifyErrorHmac - :: DerivedKey -- ^ um key - -> BS.ByteString -- ^ deobfuscated packet (HMAC || rest) - -> Bool -verifyErrorHmac (DerivedKey !umKey) !packet - | BS.length packet < 32 = False - | otherwise = - let !receivedHmac = BS.take 32 packet - !payload = BS.drop 32 packet - SHA256.MAC !computedHmac = SHA256.hmac umKey payload - in constantTimeEq receivedHmac computedHmac -{-# INLINE verifyErrorHmac #-} - --- | Parse error message from deobfuscated packet (after HMAC). -parseErrorMessage - :: BS.ByteString -- ^ packet after HMAC (len || msg || pad_len || pad) - -> Maybe FailureMessage -parseErrorMessage !bs - | BS.length bs < 4 = Nothing - | otherwise = - let !msgLen = fromIntegral (word16BE (BS.take 2 bs)) - in if BS.length bs < 2 + msgLen - then Nothing - else decodeFailureMessage (BS.take msgLen (BS.drop 2 bs)) -{-# INLINE parseErrorMessage #-} - --- Helper functions ----------------------------------------------------------- - --- | XOR two ByteStrings of equal length. -xorBytes :: BS.ByteString -> BS.ByteString -> BS.ByteString -xorBytes !a !b = BS.pack $ BS.zipWith xor a b -{-# INLINE xorBytes #-} - --- | Constant-time equality comparison. -constantTimeEq :: BS.ByteString -> BS.ByteString -> Bool -constantTimeEq !a !b - | BS.length a /= BS.length b = False - | otherwise = go 0 (BS.zip a b) +-- >>> let Just ss0 = shared_secret (BS.replicate 32 0x01) +-- >>> let Just ss1 = shared_secret (BS.replicate 32 0x02) +-- >>> let fm = FailureMessage TemporaryNodeFailure BOLT1.empty_tlv_stream +-- >>> let Right pkt = construct_error ss1 fm +-- >>> unwrap_error [ss0, ss1] (wrap_error ss0 pkt) == Attributed 1 fm +-- True +-- >>> unwrap_error [ss0] (wrap_error ss0 pkt) +-- UnknownOrigin +unwrap_error :: [SharedSecret] -> ErrorPacket -> Attribution +unwrap_error = go 0 where - go :: Word8 -> [(Word8, Word8)] -> Bool - go !acc [] = acc == 0 - go !acc ((x, y):rest) = go (acc `xor` (x `xor` y)) rest -{-# INLINE constantTimeEq #-} - --- | Decode big-endian Word16. -word16BE :: BS.ByteString -> Word16 -word16BE !bs = - let !b0 = fromIntegral (BS.index bs 0) :: Word16 - !b1 = fromIntegral (BS.index bs 1) :: Word16 - in (b0 * 256) + b1 -{-# INLINE word16BE #-} + go _ [] _ = UnknownOrigin + go i (ss : rest) p = + let ErrorPacket q = wrap_error ss p + (mac, body) = BS.splitAt 32 q + in if ct_eq mac (hmac (derive_um ss) body) + then either (const (MalformedFailure i)) (Attributed i) + (failure_message body) + else go (i + 1) rest (ErrorPacket q) --- | Convert Builder to strict ByteString. -toStrict :: B.Builder -> BS.ByteString -toStrict = BL.toStrict . B.toLazyByteString -{-# INLINE toStrict #-} +-- The failure message of a return packet (after its HMAC). +failure_message :: BS.ByteString -> Either DecodeError FailureMessage +failure_message body = case BOLT1.decode_u16 body of + Just (len, r0) + | BS.length r0 >= fromIntegral len + , let (msg, r1) = BS.splitAt (fromIntegral len) r0 + , Just (pad, r2) <- BOLT1.decode_u16 r1 + , BS.length r2 >= fromIntegral pad + -> decode_failure_message msg + _ -> Left InvalidLength diff --git a/lib/Lightning/Protocol/BOLT4/Prim.hs b/lib/Lightning/Protocol/BOLT4/Prim.hs --- a/lib/Lightning/Protocol/BOLT4/Prim.hs +++ b/lib/Lightning/Protocol/BOLT4/Prim.hs @@ -1,4 +1,4 @@ -{-# OPTIONS_HADDOCK prune #-} +{-# OPTIONS_HADDOCK hide #-} {-# LANGUAGE BangPatterns #-} {-# LANGUAGE OverloadedStrings #-} @@ -8,219 +8,251 @@ -- License: MIT -- Maintainer: Jared Tobin -- --- Low-level cryptographic primitives for BOLT4 onion routing. +-- Keys, secrets and the cryptographic primitives of BOLT #4. module Lightning.Protocol.BOLT4.Prim ( - -- * Types - SharedSecret(..) - , DerivedKey(..) - , BlindingFactor(..) - - -- * Key derivation - , deriveRho - , deriveMu - , deriveUm - , derivePad - , deriveAmmag + -- * Secret keys + SecretKey + , secret_key + , public_key + , sk_bytes + , sk_pub - -- * Shared secret computation - , computeSharedSecret + -- * Shared secrets + , SharedSecret + , shared_secret + , un_shared_secret + , ecdh - -- * Blinding factor computation - , computeBlindingFactor + -- * Derived keys + , DerivedKey + , un_derived_key + , derive_rho + , derive_mu + , derive_um + , derive_ammag + , derive_pad - -- * Key blinding - , blindPubKey - , blindSecKey + -- * Blinding + , blinding_factor + , blinded_node_tweak + , blind_pub + , blind_scalar - -- * Stream generation - , generateStream + -- * Points + , to_point + , from_point - -- * HMAC operations - , computeHmac - , verifyHmac + -- * Streams and MACs + , keystream + , hmac + , ct_eq + , xor_bytes ) where +import Control.DeepSeq (NFData(..)) import qualified Crypto.Cipher.ChaCha20 as ChaCha import qualified Crypto.Curve.Secp256k1 as Secp256k1 import qualified Crypto.Hash.SHA256 as SHA256 import Data.Bits (xor) import qualified Data.ByteString as BS -import qualified Data.List as L -import Data.Word (Word8, Word32) +import qualified Lightning.Protocol.BOLT1 as BOLT1 import qualified Numeric.Montgomery.Secp256k1.Scalar as S --- | 32-byte shared secret derived from ECDH. -newtype SharedSecret = SharedSecret BS.ByteString - deriving (Eq, Show) +-- secret keys ---------------------------------------------------------------- --- | 32-byte derived key (rho, mu, um, pad, ammag). -newtype DerivedKey = DerivedKey BS.ByteString - deriving (Eq, Show) +-- | A secp256k1 secret key: a session key, a node's private key, or the +-- seed of a blinded path. +-- +-- This is secret material: its 'Show' instance is redacted and it +-- has no 'Eq' instance. +data SecretKey = SecretKey + !BS.ByteString -- the key + !Secp256k1.Projective -- its public key + !BOLT1.Point -- its serialized public key --- | 32-byte blinding factor for ephemeral key updates. -newtype BlindingFactor = BlindingFactor BS.ByteString - deriving (Eq, Show) +instance Show SecretKey where + showsPrec d _ = showParen (d > 10) $ + showString "SecretKey " --- Key derivation ------------------------------------------------------------ +instance NFData SecretKey where + rnf (SecretKey k p q) = rnf k `seq` p `seq` rnf q --- | Derive rho key for obfuscation stream generation. +-- | Construct a t'SecretKey' from exactly 32 big-endian bytes encoding an +-- integer in [1, n - 1], where n is the secp256k1 group order. -- --- @rho = HMAC-SHA256(key="rho", data=shared_secret)@ -deriveRho :: SharedSecret -> DerivedKey -deriveRho = deriveKey "rho" -{-# INLINE deriveRho #-} +-- >>> secret_key (BS.replicate 32 0x41) +-- Just (SecretKey ) +-- >>> secret_key (BS.replicate 32 0x00) +-- Nothing +-- >>> secret_key (BS.replicate 31 0x41) +-- Nothing +secret_key :: BS.ByteString -> Maybe SecretKey +secret_key bs + | BS.length bs /= 32 = Nothing + | otherwise = do + pub <- Secp256k1.derive_pub (Secp256k1.unsafe_roll32 bs) + pt <- to_point pub + pure $! SecretKey bs pub pt --- | Derive mu key for HMAC computation. +-- | The public key of a t'SecretKey'. -- --- @mu = HMAC-SHA256(key="mu", data=shared_secret)@ -deriveMu :: SharedSecret -> DerivedKey -deriveMu = deriveKey "mu" -{-# INLINE deriveMu #-} +-- >>> let Just sk = secret_key (BS.replicate 32 0x41) +-- >>> BS.length (BOLT1.un_point (public_key sk)) +-- 33 +public_key :: SecretKey -> BOLT1.Point +public_key (SecretKey _ _ p) = p +{-# INLINE public_key #-} --- | Derive um key for return error HMAC. --- --- @um = HMAC-SHA256(key="um", data=shared_secret)@ -deriveUm :: SharedSecret -> DerivedKey -deriveUm = deriveKey "um" -{-# INLINE deriveUm #-} +sk_bytes :: SecretKey -> BS.ByteString +sk_bytes (SecretKey k _ _) = k +{-# INLINE sk_bytes #-} --- | Derive pad key for filler generation. --- --- @pad = HMAC-SHA256(key="pad", data=shared_secret)@ -derivePad :: SharedSecret -> DerivedKey -derivePad = deriveKey "pad" -{-# INLINE derivePad #-} +sk_pub :: SecretKey -> Secp256k1.Projective +sk_pub (SecretKey _ p _) = p +{-# INLINE sk_pub #-} --- | Derive ammag key for error obfuscation. +-- shared secrets ------------------------------------------------------------- + +-- | A 32-byte shared secret, established between the origin of an onion +-- and one of its hops. -- --- @ammag = HMAC-SHA256(key="ammag", data=shared_secret)@ -deriveAmmag :: SharedSecret -> DerivedKey -deriveAmmag = deriveKey "ammag" -{-# INLINE deriveAmmag #-} +-- This is secret material: its 'Show' instance is redacted and its +-- 'Eq' instance runs in constant time. +newtype SharedSecret = SharedSecret BS.ByteString --- Internal helper for key derivation. -deriveKey :: BS.ByteString -> SharedSecret -> DerivedKey -deriveKey !keyType (SharedSecret !ss) = - let SHA256.MAC !result = SHA256.hmac keyType ss - in DerivedKey result -{-# INLINE deriveKey #-} +instance Eq SharedSecret where + SharedSecret a == SharedSecret b = ct_eq a b --- Shared secret computation ------------------------------------------------- +instance Show SharedSecret where + showsPrec d _ = showParen (d > 10) $ + showString "SharedSecret " --- | Compute shared secret from ECDH. +instance NFData SharedSecret where + rnf (SharedSecret bs) = rnf bs + +-- | Construct a t'SharedSecret' from exactly 32 bytes (e.g. to restore one +-- that was stored with 'un_shared_secret'). -- --- Takes a 32-byte secret key and a public key. --- Returns SHA256 of the compressed ECDH point (33 bytes). -computeSharedSecret - :: BS.ByteString -- ^ 32-byte secret key - -> Secp256k1.Projective -- ^ public key - -> Maybe SharedSecret -computeSharedSecret !secBs !pub = do - sec <- Secp256k1.roll32 secBs - ecdhPoint <- Secp256k1.mul pub sec - let !compressed = Secp256k1.serialize_point ecdhPoint - !ss = SHA256.hash compressed - pure $! SharedSecret ss -{-# INLINE computeSharedSecret #-} +-- >>> let Just ss = shared_secret (BS.replicate 32 0x01) +-- >>> BS.length (un_shared_secret ss) +-- 32 +-- >>> shared_secret "too short" +-- Nothing +shared_secret :: BS.ByteString -> Maybe SharedSecret +shared_secret bs + | BS.length bs == 32 = Just (SharedSecret bs) + | otherwise = Nothing +{-# INLINE shared_secret #-} --- Blinding factor ----------------------------------------------------------- +-- | The bytes of a t'SharedSecret'. +un_shared_secret :: SharedSecret -> BS.ByteString +un_shared_secret (SharedSecret bs) = bs +{-# INLINE un_shared_secret #-} --- | Compute blinding factor for ephemeral key updates. --- --- @blinding_factor = SHA256(ephemeral_pubkey || shared_secret)@ -computeBlindingFactor - :: Secp256k1.Projective -- ^ ephemeral public key - -> SharedSecret -- ^ shared secret - -> BlindingFactor -computeBlindingFactor !pub (SharedSecret !ss) = - let !pubBytes = Secp256k1.serialize_point pub - !combined = pubBytes <> ss - !hashed = SHA256.hash combined - in BlindingFactor hashed -{-# INLINE computeBlindingFactor #-} +-- | ECDH per BOLT #4: SHA256 of the compressed product of a point and a +-- 32-byte scalar. Fails if the scalar is not in [1, n - 1]. +ecdh :: BS.ByteString -> Secp256k1.Projective -> Maybe SharedSecret +ecdh k pub = do + pt <- Secp256k1.mul pub (Secp256k1.unsafe_roll32 k) + pure $! SharedSecret (SHA256.hash (Secp256k1.serialize_point pt)) --- Key blinding -------------------------------------------------------------- +-- derived keys --------------------------------------------------------------- --- | Blind a public key by multiplying with blinding factor. --- --- @new_pubkey = pubkey * blinding_factor@ -blindPubKey - :: Secp256k1.Projective - -> BlindingFactor - -> Maybe Secp256k1.Projective -blindPubKey !pub (BlindingFactor !bf) = do - sk <- Secp256k1.roll32 bf - Secp256k1.mul pub sk -{-# INLINE blindPubKey #-} +-- A 32-byte key derived from a shared secret. +newtype DerivedKey = DerivedKey BS.ByteString --- | Blind a secret key by multiplying with blinding factor (mod curve order). --- --- @new_seckey = seckey * blinding_factor (mod q)@ --- --- Uses Montgomery multiplication from ppad-fixed for efficiency. --- Takes a 32-byte secret key and returns a 32-byte blinded secret key. -blindSecKey - :: BS.ByteString -- ^ 32-byte secret key - -> BlindingFactor -- ^ blinding factor - -> Maybe BS.ByteString -- ^ 32-byte blinded secret key -blindSecKey !secBs (BlindingFactor !bf) - | BS.length secBs /= 32 = Nothing - | BS.length bf /= 32 = Nothing - | otherwise = - let !secW = Secp256k1.unsafe_roll32 secBs - !bfW = Secp256k1.unsafe_roll32 bf - !secM = S.to secW - !bfM = S.to bfW - !resultM = S.mul secM bfM - !resultW = S.retr resultM - in Just $! Secp256k1.unroll32 resultW -{-# INLINE blindSecKey #-} +un_derived_key :: DerivedKey -> BS.ByteString +un_derived_key (DerivedKey k) = k +{-# INLINE un_derived_key #-} --- Stream generation --------------------------------------------------------- +derive :: BS.ByteString -> BS.ByteString -> DerivedKey +derive label ss = + let SHA256.MAC k = SHA256.hmac label ss + in DerivedKey k +{-# INLINE derive #-} --- | Generate pseudo-random byte stream using ChaCha20. --- --- Uses derived key as ChaCha20 key, 96-bit zero nonce, counter=0. --- Encrypts zeros to produce keystream. -generateStream - :: DerivedKey -- ^ rho or ammag key - -> Int -- ^ desired length - -> BS.ByteString -generateStream (DerivedKey !key) !len = - let !nonce = BS.replicate 12 0 - !zeros = BS.replicate len 0 - in either (const (BS.replicate len 0)) id - (ChaCha.cipher key (0 :: Word32) nonce zeros) -{-# INLINE generateStream #-} +derive_rho :: SharedSecret -> DerivedKey +derive_rho (SharedSecret ss) = derive "rho" ss --- HMAC operations ----------------------------------------------------------- +derive_mu :: SharedSecret -> DerivedKey +derive_mu (SharedSecret ss) = derive "mu" ss --- | Compute HMAC-SHA256 for packet integrity. -computeHmac - :: DerivedKey -- ^ mu key - -> BS.ByteString -- ^ hop_payloads - -> BS.ByteString -- ^ associated_data - -> BS.ByteString -- ^ 32-byte HMAC -computeHmac (DerivedKey !key) !payloads !assocData = - let SHA256.MAC !result = SHA256.hmac key (payloads <> assocData) - in result -{-# INLINE computeHmac #-} +derive_um :: SharedSecret -> DerivedKey +derive_um (SharedSecret ss) = derive "um" ss --- | Constant-time HMAC comparison. -verifyHmac - :: BS.ByteString -- ^ expected - -> BS.ByteString -- ^ computed - -> Bool -verifyHmac !expected !computed - | BS.length expected /= BS.length computed = False - | otherwise = constantTimeEq expected computed -{-# INLINE verifyHmac #-} +derive_ammag :: SharedSecret -> DerivedKey +derive_ammag (SharedSecret ss) = derive "ammag" ss --- Constant-time equality comparison. -constantTimeEq :: BS.ByteString -> BS.ByteString -> Bool -constantTimeEq !a !b = - let !diff = L.foldl' (\acc (x, y) -> acc `xor` (x `xor` y)) (0 :: Word8) - (BS.zip a b) - in diff == 0 -{-# INLINE constantTimeEq #-} +-- The pad key is derived from the session key itself. +derive_pad :: SecretKey -> DerivedKey +derive_pad (SecretKey k _ _) = derive "pad" k + +-- blinding ------------------------------------------------------------------- + +-- SHA256(E || ss), the factor by which ephemeral keys are blinded. +blinding_factor :: Secp256k1.Projective -> SharedSecret -> BS.ByteString +blinding_factor e (SharedSecret ss) = + SHA256.hash (Secp256k1.serialize_point e <> ss) + +-- HMAC256("blinded_node_id", ss), the factor by which node ids are +-- blinded in a blinded route. +blinded_node_tweak :: SharedSecret -> BS.ByteString +blinded_node_tweak (SharedSecret ss) = + let SHA256.MAC t = SHA256.hmac "blinded_node_id" ss + in t + +-- Multiply a point by a 32-byte factor. +blind_pub + :: Secp256k1.Projective -> BS.ByteString -> Maybe Secp256k1.Projective +blind_pub p t = Secp256k1.mul p (Secp256k1.unsafe_roll32 t) + +-- Multiply a 32-byte scalar by a 32-byte factor, mod n. Fails if the +-- product is zero. +blind_scalar :: BS.ByteString -> BS.ByteString -> Maybe BS.ByteString +blind_scalar k t = + let !r = S.retr (S.mul (S.to (Secp256k1.unsafe_roll32 k)) + (S.to (Secp256k1.unsafe_roll32 t))) + in if Secp256k1.ge r + then Just $! Secp256k1.unroll32 r + else Nothing + +-- points --------------------------------------------------------------------- + +to_point :: Secp256k1.Projective -> Maybe BOLT1.Point +to_point = BOLT1.point . Secp256k1.serialize_point +{-# INLINE to_point #-} + +from_point :: BOLT1.Point -> Maybe Secp256k1.Projective +from_point = Secp256k1.parse_point . BOLT1.un_point +{-# INLINE from_point #-} + +-- streams and MACs ----------------------------------------------------------- + +-- The ChaCha20 keystream of the given length under a derived key, with +-- an all-zero nonce. The cipher fails only for a key or nonce of the +-- wrong length, or past 256 GiB of output, none of which can occur +-- here; the empty result in that case truncates any output XORed with +-- it, rather than leaving it unencrypted. +keystream :: DerivedKey -> Int -> BS.ByteString +keystream (DerivedKey k) n = + case ChaCha.cipher k 0 (BS.replicate 12 0) (BS.replicate n 0) of + Right s -> s + Left _ -> BS.empty + +-- HMAC-SHA256 under a derived key. +hmac :: DerivedKey -> BS.ByteString -> BS.ByteString +hmac (DerivedKey k) m = + let SHA256.MAC h = SHA256.hmac k m + in h +{-# INLINE hmac #-} + +-- Constant-time equality (variable-time only in the lengths). +ct_eq :: BS.ByteString -> BS.ByteString -> Bool +ct_eq a b = SHA256.MAC a == SHA256.MAC b +{-# INLINE ct_eq #-} + +-- XOR, truncated to the shorter input. +xor_bytes :: BS.ByteString -> BS.ByteString -> BS.ByteString +xor_bytes = BS.packZipWith xor +{-# INLINE xor_bytes #-} diff --git a/lib/Lightning/Protocol/BOLT4/Process.hs b/lib/Lightning/Protocol/BOLT4/Process.hs --- a/lib/Lightning/Protocol/BOLT4/Process.hs +++ b/lib/Lightning/Protocol/BOLT4/Process.hs @@ -1,7 +1,5 @@ -{-# OPTIONS_HADDOCK prune #-} -{-# LANGUAGE BangPatterns #-} +{-# OPTIONS_HADDOCK hide #-} {-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE OverloadedStrings #-} -- | -- Module: Lightning.Protocol.BOLT4.Process @@ -9,212 +7,159 @@ -- License: MIT -- Maintainer: Jared Tobin -- --- Onion packet processing for BOLT4. +-- Onion packet processing. module Lightning.Protocol.BOLT4.Process ( - -- * Processing - process - - -- * Rejection reasons - , RejectReason(..) + ProcessResult(..) + , ForwardInfo(..) + , ReceiveInfo(..) + , process ) where -import Data.Bits (xor) +import Control.DeepSeq (NFData) import qualified Crypto.Curve.Secp256k1 as Secp256k1 import qualified Data.ByteString as BS -import Data.Word (Word8) import GHC.Generics (Generic) -import Lightning.Protocol.BOLT4.Codec +import qualified Lightning.Protocol.BOLT1 as BOLT1 +import Lightning.Protocol.BOLT4.Blinding (unblind) +import Lightning.Protocol.BOLT4.Codec (decode_hop_payload) import Lightning.Protocol.BOLT4.Prim import Lightning.Protocol.BOLT4.Types --- | Reasons for rejecting a packet. -data RejectReason - = InvalidVersion !Word8 -- ^ Version byte is not 0x00 - | InvalidEphemeralKey -- ^ Malformed public key - | HmacMismatch -- ^ HMAC verification failed - | InvalidPayload !String -- ^ Malformed hop payload +-- | The result of processing an onion packet. +data ProcessResult + = Forward !ForwardInfo + -- ^ forward the onion to the next hop + | Receive !ReceiveInfo + -- ^ this node is the onion's final hop deriving (Eq, Show, Generic) --- | Process an incoming onion packet. --- --- Takes the receiving node's private key, the incoming packet, and --- associated data (typically the payment hash). --- --- Returns either a rejection reason or the processing result --- (forward to next hop or receive at final destination). -process - :: BS.ByteString -- ^ 32-byte secret key of this node - -> OnionPacket -- ^ incoming onion packet - -> BS.ByteString -- ^ associated data (payment hash) - -> Either RejectReason ProcessResult -process !secKey !packet !assocData = do - -- Step 1: Validate version - validateVersion packet - - -- Step 2: Parse ephemeral public key - ephemeral <- parseEphemeralKey packet - - -- Step 3: Compute shared secret - ss <- case computeSharedSecret secKey ephemeral of - Nothing -> Left InvalidEphemeralKey - Just s -> Right s - - -- Step 4: Derive keys - let !muKey = deriveMu ss - !rhoKey = deriveRho ss - - -- Step 5: Verify HMAC - if not (verifyPacketHmac muKey packet assocData) - then Left HmacMismatch - else pure () - - -- Step 6: Decrypt hop payloads - let !decrypted = decryptPayloads rhoKey (opHopPayloads packet) - - -- Step 7: Extract payload - (payloadBytes, nextHmac, remaining) <- extractPayload decrypted - - -- Step 8: Parse payload TLV - hopPayload <- case decodeHopPayload payloadBytes of - Nothing -> Left (InvalidPayload "failed to decode TLV") - Just hp -> Right hp - - -- Step 9: Check if final hop - let SharedSecret ssBytes = ss - if isFinalHop nextHmac - then Right $! Receive $! ReceiveInfo - { riPayload = hopPayload - , riSharedSecret = ssBytes - } - else do - -- Step 10: Prepare forward packet - nextPacket <- case prepareForward ephemeral ss remaining nextHmac of - Nothing -> Left InvalidEphemeralKey - Just np -> Right np - - Right $! Forward $! ForwardInfo - { fiNextPacket = nextPacket - , fiPayload = hopPayload - , fiSharedSecret = ssBytes - } +instance NFData ProcessResult --- | Validate packet version is 0x00. -validateVersion :: OnionPacket -> Either RejectReason () -validateVersion !packet - | opVersion packet == versionByte = Right () - | otherwise = Left (InvalidVersion (opVersion packet)) -{-# INLINE validateVersion #-} +-- | What a forwarding node learns from an onion. +data ForwardInfo = ForwardInfo + { fwd_payload :: !HopPayload + -- ^ this node's payload + , fwd_blinded :: !(Maybe BlindedInfo) + -- ^ the decrypted @encrypted_recipient_data@ and next path key, in + -- a blinded route + , fwd_next_packet :: !OnionPacket + -- ^ the onion for the next hop + , fwd_shared_secret :: !SharedSecret + -- ^ the shared secret, to wrap returned errors with + } deriving (Eq, Show, Generic) --- | Parse and validate ephemeral public key from packet. -parseEphemeralKey :: OnionPacket -> Either RejectReason Secp256k1.Projective -parseEphemeralKey !packet = - case Secp256k1.parse_point (opEphemeralKey packet) of - Nothing -> Left InvalidEphemeralKey - Just pub -> Right pub -{-# INLINE parseEphemeralKey #-} +instance NFData ForwardInfo --- | Decrypt hop payloads by XORing with rho stream. --- --- Generates a stream of 2*1300 bytes and XORs with hop_payloads --- extended with 1300 zero bytes. -decryptPayloads - :: DerivedKey -- ^ rho key - -> BS.ByteString -- ^ hop_payloads (1300 bytes) - -> BS.ByteString -- ^ decrypted (2600 bytes, first 1300 useful) -decryptPayloads !rhoKey !payloads = - let !streamLen = 2 * hopPayloadsSize -- 2600 bytes - !stream = generateStream rhoKey streamLen - -- Extend payloads with zeros for the shift operation - !extended = payloads <> BS.replicate hopPayloadsSize 0 - in xorBytes stream extended -{-# INLINE decryptPayloads #-} +-- | What the final node learns from an onion. +data ReceiveInfo = ReceiveInfo + { rcv_payload :: !HopPayload + -- ^ this node's payload + , rcv_blinded :: !(Maybe BlindedInfo) + -- ^ the decrypted @encrypted_recipient_data@, in a blinded route + , rcv_shared_secret :: !SharedSecret + -- ^ the shared secret, to construct errors with + } deriving (Eq, Show, Generic) --- | XOR two bytestrings of equal length. -xorBytes :: BS.ByteString -> BS.ByteString -> BS.ByteString -xorBytes !a !b = BS.pack (BS.zipWith xor a b) -{-# INLINE xorBytes #-} +instance NFData ReceiveInfo --- | Extract payload from decrypted buffer. +-- | Process an onion packet, given this node's private key, the packet, +-- its associated data (the payment hash, for a payment), and the +-- @path_key@ received with it (in @update_add_htlc@), if any. -- --- Parses BigSize length prefix, extracts payload bytes and next HMAC. -extractPayload - :: BS.ByteString - -> Either RejectReason (BS.ByteString, BS.ByteString, BS.ByteString) - -- ^ (payload_bytes, next_hmac, remaining_hop_payloads) -extractPayload !decrypted = do - -- Parse length prefix - (len, afterLen) <- case decodeBigSize decrypted of - Nothing -> Left (InvalidPayload "invalid length prefix") - Just (l, r) -> Right (fromIntegral l :: Int, r) - - -- Validate length - if len > BS.length afterLen - then Left (InvalidPayload "payload length exceeds buffer") - else if len == 0 - then Left (InvalidPayload "zero-length payload") - else pure () - - -- Extract payload bytes - let !payloadBytes = BS.take len afterLen - !afterPayload = BS.drop len afterLen - - -- Extract next HMAC (32 bytes) - if BS.length afterPayload < hmacSize - then Left (InvalidPayload "insufficient bytes for HMAC") - else do - let !nextHmac = BS.take hmacSize afterPayload - -- Remaining payloads: skip the HMAC, take first 1300 bytes - -- This is already "shifted" by the payload extraction - !remaining = BS.drop hmacSize afterPayload - - Right (payloadBytes, nextHmac, remaining) - --- | Verify packet HMAC. +-- In a blinded route, the onion is encrypted to this node's blinded +-- node id: given a @path_key@, the matching private key is derived +-- from it. The @encrypted_recipient_data@ in the payload is decrypted +-- with the @path_key@, or, at the introduction node, with the +-- payload's @current_path_key@; a path key without +-- @encrypted_recipient_data@, or both kinds of path key, are +-- rejected. -- --- Computes HMAC over (hop_payloads || associated_data) using mu key --- and compares with packet's HMAC using constant-time comparison. -verifyPacketHmac - :: DerivedKey -- ^ mu key - -> OnionPacket -- ^ packet with HMAC to verify - -> BS.ByteString -- ^ associated data - -> Bool -verifyPacketHmac !muKey !packet !assocData = - let !computed = computeHmac muKey (opHopPayloads packet) assocData - in verifyHmac (opHmac packet) computed -{-# INLINE verifyPacketHmac #-} - --- | Prepare packet for forwarding to next hop. +-- The payload is otherwise returned as is. The caller must apply the +-- remaining reader requirements of BOLT #4: the presence of the +-- fields required for forwarding or receiving, the HTLC amount and +-- expiry checks (in a blinded route, against @payment_relay@ and +-- @payment_constraints@), @allowed_features@, the rule that +-- @encrypted_recipient_data@ hold only one of @short_channel_id@ and +-- @next_node_id@, and the rejection of replayed HMACs. -- --- Computes blinded ephemeral key and constructs next OnionPacket. -prepareForward - :: Secp256k1.Projective -- ^ current ephemeral key - -> SharedSecret -- ^ shared secret (for blinding) - -> BS.ByteString -- ^ remaining hop_payloads (after shift) - -> BS.ByteString -- ^ next HMAC - -> Maybe OnionPacket -prepareForward !ephemeral !ss !remaining !nextHmac = do - -- Compute blinding factor and blind ephemeral key - let !bf = computeBlindingFactor ephemeral ss - newEphemeral <- blindPubKey ephemeral bf - - -- Serialize new ephemeral key - let !newEphBytes = Secp256k1.serialize_point newEphemeral - - -- Truncate remaining to exactly 1300 bytes - let !newPayloads = BS.take hopPayloadsSize remaining +-- >>> let Just session = secret_key (BS.replicate 32 0x41) +-- >>> let Just node = secret_key (BS.replicate 32 0x42) +-- >>> let pl = empty_hop_payload { hp_outgoing_cltv_value = Just 144 } +-- >>> let ad = BS.replicate 32 0 +-- >>> let Right (pkt, _) = construct session [Hop (public_key node) pl] ad +-- >>> let Right (Receive info) = process node pkt ad Nothing +-- >>> hp_outgoing_cltv_value (rcv_payload info) +-- Just 144 +process + :: SecretKey + -> OnionPacket + -> BS.ByteString + -> Maybe BOLT1.Point + -> Either ProcessError ProcessResult +process sk pkt ad mpk = do + let ver = onion_version pkt + if ver /= 0 then Left (InvalidVersion ver) else Right () + eph <- note InvalidPublicKey (from_point (onion_public_key pkt)) + -- with a path_key, the onion is encrypted to the blinded node id + blinding <- traverse path_secret mpk + key <- case blinding of + Nothing -> Right (sk_bytes sk) + Just (_, bss) -> + note InvalidPathKey (blind_scalar (sk_bytes sk) (blinded_node_tweak bss)) + ss <- note InvalidPublicKey (ecdh key eph) + let payloads = un_hop_payloads (onion_hop_payloads pkt) + mac = hmac (derive_mu ss) (payloads <> ad) + if ct_eq mac (un_hmac32 (onion_hmac pkt)) + then Right () + else Left HmacMismatch + let plain = xor_bytes (payloads <> BS.replicate 1300 0) + (keystream (derive_rho ss) 2600) + (pl, next_mac, rest) <- split_payload plain + hp <- either (Left . InvalidPayload) Right (decode_hop_payload pl) + binfo <- case (hp_encrypted_data hp, blinding, hp_current_path_key hp) of + (Nothing, Nothing, Nothing) -> Right Nothing + (Nothing, _, _) -> Left UnexpectedPathKey + (Just _, Just _, Just _) -> Left UnexpectedPathKey + (Just _, Nothing, Nothing) -> Left MissingPathKey + (Just enc, Just (e, bss), Nothing) -> Just <$> unblind bss e enc + (Just enc, Nothing, Just cpk) -> do + (e, bss) <- path_secret cpk + Just <$> unblind bss e enc + if BS.all (== 0) next_mac + then Right (Receive (ReceiveInfo hp binfo ss)) + else do + eph' <- note InvalidPublicKey + (blind_pub eph (blinding_factor eph ss) >>= to_point) + let next = OnionPacket 0 eph' (HopPayloads rest) (Hmac32 next_mac) + Right (Forward (ForwardInfo hp binfo next ss)) + where + note :: ProcessError -> Maybe a -> Either ProcessError a + note e = maybe (Left e) Right - -- Construct next packet - pure $! OnionPacket - { opVersion = versionByte - , opEphemeralKey = newEphBytes - , opHopPayloads = newPayloads - , opHmac = nextHmac - } + -- a path key, and its shared secret with this node + path_secret + :: BOLT1.Point + -> Either ProcessError (Secp256k1.Projective, SharedSecret) + path_secret pk = do + e <- note InvalidPathKey (from_point pk) + bss <- note InvalidPathKey (ecdh (sk_bytes sk) e) + Right (e, bss) --- | Check if this is the final hop. --- --- Final hop is indicated by next_hmac being all zeros. -isFinalHop :: BS.ByteString -> Bool -isFinalHop !hmac = hmac == BS.replicate hmacSize 0 -{-# INLINE isFinalHop #-} +-- Split the decrypted 2600-byte buffer into the payload, the next HMAC +-- and the next hop_payloads. The length prefix, payload and HMAC must +-- fit in the 1300-byte hop_payloads. +split_payload + :: BS.ByteString + -> Either ProcessError (BS.ByteString, BS.ByteString, BS.ByteString) +split_payload plain = case BOLT1.decode_bigsize plain of + Nothing -> Left InvalidPayloadLength + Just (len, r0) + | len < 2 -> Left InvalidPayloadLength + | len > fromIntegral (1300 - prefix - 32) -> Left InvalidPayloadLength + | otherwise -> + let (pl, r1) = BS.splitAt (fromIntegral len) r0 + (mac, r2) = BS.splitAt 32 r1 + in Right (pl, mac, BS.take 1300 r2) + where + prefix = BS.length plain - BS.length r0 diff --git a/lib/Lightning/Protocol/BOLT4/Types.hs b/lib/Lightning/Protocol/BOLT4/Types.hs --- a/lib/Lightning/Protocol/BOLT4/Types.hs +++ b/lib/Lightning/Protocol/BOLT4/Types.hs @@ -1,7 +1,5 @@ -{-# OPTIONS_HADDOCK prune #-} -{-# LANGUAGE BangPatterns #-} +{-# OPTIONS_HADDOCK hide #-} {-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE PatternSynonyms #-} -- | -- Module: Lightning.Protocol.BOLT4.Types @@ -9,271 +7,501 @@ -- License: MIT -- Maintainer: Jared Tobin -- --- Core data types for BOLT4 onion routing. +-- Data types for BOLT #4. module Lightning.Protocol.BOLT4.Types ( - -- * Packet types + -- * Onion packets OnionPacket(..) + , HopPayloads(..) + , hop_payloads + , un_hop_payloads + , Hmac32(..) + , hmac32 + , un_hmac32 + + -- * Hop payloads , HopPayload(..) - , ShortChannelId(..) + , empty_hop_payload , PaymentData(..) - , TlvRecord(..) + , PaymentSecret(..) + , payment_secret + , un_payment_secret - -- * Error types - , FailureMessage(..) - , FailureCode(..) - -- ** Flag bits - , pattern BADONION - , pattern PERM - , pattern NODE - , pattern UPDATE - -- ** Common failure codes - , pattern InvalidRealm - , pattern TemporaryNodeFailure - , pattern PermanentNodeFailure - , pattern RequiredNodeFeatureMissing - , pattern InvalidOnionVersion - , pattern InvalidOnionHmac - , pattern InvalidOnionKey - , pattern TemporaryChannelFailure - , pattern PermanentChannelFailure - , pattern AmountBelowMinimum - , pattern FeeInsufficient - , pattern IncorrectCltvExpiry - , pattern ExpiryTooSoon - , pattern IncorrectOrUnknownPaymentDetails - , pattern FinalIncorrectCltvExpiry - , pattern FinalIncorrectHtlcAmount - , pattern ChannelDisabled - , pattern ExpiryTooFar - , pattern InvalidOnionPayload - , pattern MppTimeout + -- * Route blinding + , BlindedPath(..) + , BlindedHop(..) + , BlindedHopData(..) + , empty_blinded_hop_data + , PaymentRelay(..) + , PaymentConstraints(..) + , BlindedInfo(..) - -- * Processing results - , ProcessResult(..) - , ForwardInfo(..) - , ReceiveInfo(..) + -- * Failure messages + , FailureMessage(..) + , Failure(..) + , OnionHash(..) + , onion_hash + , un_onion_hash + , failure_code + , is_badonion + , is_perm + , is_node + , is_update - -- * Constants - , onionPacketSize - , hopPayloadsSize - , hmacSize - , pubkeySize - , versionByte - , maxPayloadSize + -- * Errors + , DecodeError(..) + , EncodeError(..) + , ProcessError(..) ) where -import Data.Bits ((.&.), (.|.)) +import Control.DeepSeq (NFData(..)) +import Data.Bits ((.&.)) import qualified Data.ByteString as BS import Data.Word (Word8, Word16, Word32, Word64) import GHC.Generics (Generic) +import qualified Lightning.Protocol.BOLT1 as BOLT1 +import qualified Lightning.Protocol.BOLT4.Prim as P +import qualified Lightning.Protocol.BOLT9 as BOLT9 --- Packet types ------------------------------------------------------------- +-- onion packets -------------------------------------------------------------- --- | Complete onion packet (1366 bytes). +-- | An onion packet (@onion_packet@): 1366 bytes on the wire. data OnionPacket = OnionPacket - { opVersion :: {-# UNPACK #-} !Word8 - , opEphemeralKey :: !BS.ByteString -- ^ 33 bytes, compressed pubkey - , opHopPayloads :: !BS.ByteString -- ^ 1300 bytes - , opHmac :: !BS.ByteString -- ^ 32 bytes + { onion_version :: {-# UNPACK #-} !Word8 + -- ^ the version byte; 0 in this version of the protocol + , onion_public_key :: !BOLT1.Point + -- ^ the ephemeral public key + , onion_hop_payloads :: !HopPayloads + -- ^ the obfuscated hop payloads + , onion_hmac :: !Hmac32 + -- ^ the HMAC authenticating the packet } deriving (Eq, Show, Generic) --- | Parsed hop payload after decryption. +instance NFData OnionPacket + +-- | The 1300-byte @hop_payloads@ field of an onion packet. +newtype HopPayloads = HopPayloads BS.ByteString + deriving (Eq, Show, Generic) + +instance NFData HopPayloads + +-- | Construct t'HopPayloads' from exactly 1300 bytes. +-- +-- >>> let Just hp = hop_payloads (BS.replicate 1300 0) +-- >>> BS.length (un_hop_payloads hp) +-- 1300 +-- >>> hop_payloads (BS.replicate 1299 0) +-- Nothing +hop_payloads :: BS.ByteString -> Maybe HopPayloads +hop_payloads bs + | BS.length bs == 1300 = Just (HopPayloads bs) + | otherwise = Nothing +{-# INLINE hop_payloads #-} + +-- | The bytes of t'HopPayloads'. +un_hop_payloads :: HopPayloads -> BS.ByteString +un_hop_payloads (HopPayloads bs) = bs +{-# INLINE un_hop_payloads #-} + +-- | A 32-byte HMAC. +newtype Hmac32 = Hmac32 BS.ByteString + deriving (Eq, Show, Generic) + +instance NFData Hmac32 + +-- | Construct an t'Hmac32' from exactly 32 bytes. +-- +-- >>> fmap (BS.length . un_hmac32) (hmac32 (BS.replicate 32 0)) +-- Just 32 +-- >>> hmac32 "too short" +-- Nothing +hmac32 :: BS.ByteString -> Maybe Hmac32 +hmac32 bs + | BS.length bs == 32 = Just (Hmac32 bs) + | otherwise = Nothing +{-# INLINE hmac32 #-} + +-- | The bytes of an t'Hmac32'. +un_hmac32 :: Hmac32 -> BS.ByteString +un_hmac32 (Hmac32 bs) = bs +{-# INLINE un_hmac32 #-} + +-- hop payloads --------------------------------------------------------------- + +-- | A hop's @payload@ TLV stream. +-- +-- Each known record has a typed field. 'hp_extra' holds the remaining +-- records: decoding fills it with the unknown odd records (unknown even +-- records are rejected), and encoding accepts any record in it whose +-- type isn't one of the known ones. data HopPayload = HopPayload - { hpAmtToForward :: !(Maybe Word64) -- ^ TLV type 2 - , hpOutgoingCltv :: !(Maybe Word32) -- ^ TLV type 4 - , hpShortChannelId :: !(Maybe ShortChannelId) -- ^ TLV type 6 - , hpPaymentData :: !(Maybe PaymentData) -- ^ TLV type 8 - , hpEncryptedData :: !(Maybe BS.ByteString) -- ^ TLV type 10 - , hpCurrentPathKey :: !(Maybe BS.ByteString) -- ^ TLV type 12 - , hpUnknownTlvs :: ![TlvRecord] -- ^ Unknown types + { hp_amt_to_forward :: !(Maybe BOLT1.MilliSatoshi) + -- ^ type 2: @amt_to_forward@ + , hp_outgoing_cltv_value :: !(Maybe Word32) + -- ^ type 4: @outgoing_cltv_value@ + , hp_short_channel_id :: !(Maybe BOLT1.ShortChannelId) + -- ^ type 6: @short_channel_id@ + , hp_payment_data :: !(Maybe PaymentData) + -- ^ type 8: @payment_data@ + , hp_encrypted_data :: !(Maybe BS.ByteString) + -- ^ type 10: @encrypted_recipient_data@ + , hp_current_path_key :: !(Maybe BOLT1.Point) + -- ^ type 12: @current_path_key@ + , hp_payment_metadata :: !(Maybe BS.ByteString) + -- ^ type 16: @payment_metadata@ + , hp_total_amount_msat :: !(Maybe BOLT1.MilliSatoshi) + -- ^ type 18: @total_amount_msat@ + , hp_extra :: !BOLT1.TlvStream + -- ^ other records } deriving (Eq, Show, Generic) --- | Short channel ID (8 bytes): block height, tx index, output index. -data ShortChannelId = ShortChannelId - { sciBlockHeight :: {-# UNPACK #-} !Word32 -- ^ 3 bytes in encoding - , sciTxIndex :: {-# UNPACK #-} !Word32 -- ^ 3 bytes in encoding - , sciOutputIndex :: {-# UNPACK #-} !Word16 -- ^ 2 bytes in encoding - } deriving (Eq, Show, Generic) +instance NFData HopPayload --- | Payment data for final hop (TLV type 8). +-- | The empty t'HopPayload', to be updated with record syntax. +-- +-- >>> let Just amt = BOLT1.milli_satoshi 1000 +-- >>> let hp = empty_hop_payload { hp_amt_to_forward = Just amt } +-- >>> encode_hop_payload hp +-- Right "\STX\STX\ETX\232" +empty_hop_payload :: HopPayload +empty_hop_payload = HopPayload + Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing + BOLT1.empty_tlv_stream + +-- | The @payment_data@ record of a final hop's payload. data PaymentData = PaymentData - { pdPaymentSecret :: !BS.ByteString -- ^ 32 bytes - , pdTotalMsat :: {-# UNPACK #-} !Word64 + { pd_payment_secret :: !PaymentSecret + , pd_total_msat :: !BOLT1.MilliSatoshi } deriving (Eq, Show, Generic) --- | Generic TLV record for unknown/extension types. -data TlvRecord = TlvRecord - { tlvType :: {-# UNPACK #-} !Word64 - , tlvValue :: !BS.ByteString - } deriving (Eq, Show, Generic) +instance NFData PaymentData --- Error types -------------------------------------------------------------- +-- | A 32-byte payment secret. +-- +-- Its 'Show' instance is redacted and its 'Eq' instance runs in +-- constant time. +newtype PaymentSecret = PaymentSecret BS.ByteString --- | Failure message from intermediate or final node. -data FailureMessage = FailureMessage - { fmCode :: {-# UNPACK #-} !FailureCode - , fmData :: !BS.ByteString - , fmTlvs :: ![TlvRecord] - } deriving (Eq, Show, Generic) +instance Eq PaymentSecret where + PaymentSecret a == PaymentSecret b = P.ct_eq a b --- | 2-byte failure code with flag bits. -newtype FailureCode = FailureCode Word16 - deriving (Eq, Show) +instance Show PaymentSecret where + showsPrec d _ = showParen (d > 10) $ + showString "PaymentSecret " --- Flag bits +instance NFData PaymentSecret where + rnf (PaymentSecret bs) = rnf bs --- | BADONION flag (0x8000): error was in parsing the onion. -pattern BADONION :: Word16 -pattern BADONION = 0x8000 +-- | Construct a t'PaymentSecret' from exactly 32 bytes. +-- +-- >>> payment_secret (BS.replicate 32 0x01) +-- Just (PaymentSecret ) +-- >>> payment_secret (BS.replicate 16 0x01) +-- Nothing +payment_secret :: BS.ByteString -> Maybe PaymentSecret +payment_secret bs + | BS.length bs == 32 = Just (PaymentSecret bs) + | otherwise = Nothing +{-# INLINE payment_secret #-} --- | PERM flag (0x4000): permanent failure, do not retry. -pattern PERM :: Word16 -pattern PERM = 0x4000 +-- | The bytes of a t'PaymentSecret'. +un_payment_secret :: PaymentSecret -> BS.ByteString +un_payment_secret (PaymentSecret bs) = bs +{-# INLINE un_payment_secret #-} --- | NODE flag (0x2000): node failure rather than channel. -pattern NODE :: Word16 -pattern NODE = 0x2000 +-- route blinding ------------------------------------------------------------- --- | UPDATE flag (0x1000): channel update is attached. -pattern UPDATE :: Word16 -pattern UPDATE = 0x1000 +-- | A blinded route (@blinded_path@), as created by a recipient. +data BlindedPath = BlindedPath + { bp_first_node_id :: !BOLT1.Point + -- ^ the (unblinded) introduction node + , bp_first_path_key :: !BOLT1.Point + -- ^ the path key for the introduction node + , bp_hops :: ![BlindedHop] + -- ^ the blinded hops, starting with the introduction node + } deriving (Eq, Show, Generic) --- Common failure codes +instance NFData BlindedPath --- | Invalid realm byte in onion. -pattern InvalidRealm :: FailureCode -pattern InvalidRealm = FailureCode 0x4001 -- PERM .|. 1 +-- | A hop of a blinded route (@blinded_path_hop@). +data BlindedHop = BlindedHop + { bh_blinded_node_id :: !BOLT1.Point + -- ^ the hop's blinded node id + , bh_encrypted_data :: !BS.ByteString + -- ^ the hop's @encrypted_recipient_data@ + } deriving (Eq, Show, Generic) --- | Temporary node failure. -pattern TemporaryNodeFailure :: FailureCode -pattern TemporaryNodeFailure = FailureCode 0x2002 -- NODE .|. 2 +instance NFData BlindedHop --- | Permanent node failure. -pattern PermanentNodeFailure :: FailureCode -pattern PermanentNodeFailure = FailureCode 0x6002 -- PERM .|. NODE .|. 2 +-- | The @encrypted_data_tlv@ stream carried, encrypted, in a hop's +-- @encrypted_recipient_data@. +-- +-- 'bhd_extra' plays the same role as 'hp_extra' in t'HopPayload'. +data BlindedHopData = BlindedHopData + { bhd_padding :: !(Maybe BS.ByteString) + -- ^ type 1: @padding@ + , bhd_short_channel_id :: !(Maybe BOLT1.ShortChannelId) + -- ^ type 2: @short_channel_id@ + , bhd_next_node_id :: !(Maybe BOLT1.Point) + -- ^ type 4: @next_node_id@ + , bhd_path_id :: !(Maybe BS.ByteString) + -- ^ type 6: @path_id@ + , bhd_next_path_key_override :: !(Maybe BOLT1.Point) + -- ^ type 8: @next_path_key_override@ + , bhd_payment_relay :: !(Maybe PaymentRelay) + -- ^ type 10: @payment_relay@ + , bhd_payment_constraints :: !(Maybe PaymentConstraints) + -- ^ type 12: @payment_constraints@ + , bhd_allowed_features :: !(Maybe BOLT9.FeatureVector) + -- ^ type 14: @allowed_features@ + , bhd_extra :: !BOLT1.TlvStream + -- ^ other records + } deriving (Eq, Show, Generic) --- | Required node feature missing. -pattern RequiredNodeFeatureMissing :: FailureCode -pattern RequiredNodeFeatureMissing = FailureCode 0x6003 -- PERM .|. NODE .|. 3 +instance NFData BlindedHopData --- | Invalid onion version. -pattern InvalidOnionVersion :: FailureCode -pattern InvalidOnionVersion = FailureCode 0xC004 -- BADONION .|. PERM .|. 4 +-- | The empty t'BlindedHopData', to be updated with record syntax. +-- +-- >>> let bhd = empty_blinded_hop_data { bhd_path_id = Just "path id" } +-- >>> encode_blinded_hop_data bhd +-- Right "\ACK\apath id" +empty_blinded_hop_data :: BlindedHopData +empty_blinded_hop_data = BlindedHopData + Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing + BOLT1.empty_tlv_stream --- | Invalid HMAC in onion. -pattern InvalidOnionHmac :: FailureCode -pattern InvalidOnionHmac = FailureCode 0xC005 -- BADONION .|. PERM .|. 5 +-- | The @payment_relay@ record of t'BlindedHopData'. +data PaymentRelay = PaymentRelay + { pr_cltv_expiry_delta :: {-# UNPACK #-} !Word16 + , pr_fee_proportional_millionths :: {-# UNPACK #-} !Word32 + , pr_fee_base_msat :: {-# UNPACK #-} !Word32 + } deriving (Eq, Show, Generic) --- | Invalid ephemeral key in onion. -pattern InvalidOnionKey :: FailureCode -pattern InvalidOnionKey = FailureCode 0xC006 -- BADONION .|. PERM .|. 6 +instance NFData PaymentRelay --- | Temporary channel failure. -pattern TemporaryChannelFailure :: FailureCode -pattern TemporaryChannelFailure = FailureCode 0x1007 -- UPDATE .|. 7 +-- | The @payment_constraints@ record of t'BlindedHopData'. +data PaymentConstraints = PaymentConstraints + { pc_max_cltv_expiry :: {-# UNPACK #-} !Word32 + , pc_htlc_minimum_msat :: !BOLT1.MilliSatoshi + } deriving (Eq, Show, Generic) --- | Permanent channel failure. -pattern PermanentChannelFailure :: FailureCode -pattern PermanentChannelFailure = FailureCode 0x4008 -- PERM .|. 8 +instance NFData PaymentConstraints --- | Amount below minimum for channel. -pattern AmountBelowMinimum :: FailureCode -pattern AmountBelowMinimum = FailureCode 0x100B -- UPDATE .|. 11 +-- | What a node in a blinded route learns from its +-- @encrypted_recipient_data@. +data BlindedInfo = BlindedInfo + { bi_data :: !BlindedHopData + -- ^ the decrypted @encrypted_data_tlv@ + , bi_next_path_key :: !BOLT1.Point + -- ^ the @path_key@ to send to the next node + } deriving (Eq, Show, Generic) --- | Fee insufficient. -pattern FeeInsufficient :: FailureCode -pattern FeeInsufficient = FailureCode 0x100C -- UPDATE .|. 12 +instance NFData BlindedInfo --- | Incorrect CLTV expiry. -pattern IncorrectCltvExpiry :: FailureCode -pattern IncorrectCltvExpiry = FailureCode 0x100D -- UPDATE .|. 13 +-- failure messages ----------------------------------------------------------- --- | Expiry too soon. -pattern ExpiryTooSoon :: FailureCode -pattern ExpiryTooSoon = FailureCode 0x100E -- UPDATE .|. 14 +-- | A failure message (@failuremsg@): a failure, followed by an optional +-- TLV stream. +data FailureMessage = FailureMessage + { fm_failure :: !Failure + , fm_tlvs :: !BOLT1.TlvStream + } deriving (Eq, Show, Generic) --- | Payment details incorrect or unknown. -pattern IncorrectOrUnknownPaymentDetails :: FailureCode -pattern IncorrectOrUnknownPaymentDetails = FailureCode 0x400F -- PERM .|. 15 +instance NFData FailureMessage --- | Final incorrect CLTV expiry. -pattern FinalIncorrectCltvExpiry :: FailureCode -pattern FinalIncorrectCltvExpiry = FailureCode 18 -- 0x12 +-- | A failure: a failure code and its data. +-- +-- A @channel_update@ field holds the raw bytes of the update; it is +-- empty when the update is omitted. +data Failure + = TemporaryNodeFailure + -- ^ NODE|2 + | PermanentNodeFailure + -- ^ PERM|NODE|2 + | RequiredNodeFeatureMissing + -- ^ PERM|NODE|3 + | InvalidOnionVersion !OnionHash + -- ^ BADONION|PERM|4: @sha256_of_onion@ + | InvalidOnionHmac !OnionHash + -- ^ BADONION|PERM|5: @sha256_of_onion@ + | InvalidOnionKey !OnionHash + -- ^ BADONION|PERM|6: @sha256_of_onion@ + | TemporaryChannelFailure !BS.ByteString + -- ^ UPDATE|7: @channel_update@ + | PermanentChannelFailure + -- ^ PERM|8 + | RequiredChannelFeatureMissing + -- ^ PERM|9 + | UnknownNextPeer + -- ^ PERM|10 + | AmountBelowMinimum !BOLT1.MilliSatoshi !BS.ByteString + -- ^ UPDATE|11: @htlc_msat@, @channel_update@ + | FeeInsufficient !BOLT1.MilliSatoshi !BS.ByteString + -- ^ UPDATE|12: @htlc_msat@, @channel_update@ + | IncorrectCltvExpiry {-# UNPACK #-} !Word32 !BS.ByteString + -- ^ UPDATE|13: @cltv_expiry@, @channel_update@ + | ExpiryTooSoon !BS.ByteString + -- ^ UPDATE|14: @channel_update@ + | IncorrectOrUnknownPaymentDetails !BOLT1.MilliSatoshi + {-# UNPACK #-} !Word32 + -- ^ PERM|15: @htlc_msat@, @height@ + | FinalIncorrectCltvExpiry {-# UNPACK #-} !Word32 + -- ^ 18: @cltv_expiry@ + | FinalIncorrectHtlcAmount !BOLT1.MilliSatoshi + -- ^ 19: @incoming_htlc_amt@ + | ChannelDisabled {-# UNPACK #-} !Word16 !BS.ByteString + -- ^ UPDATE|20: @disabled_flags@, @channel_update@ + | ExpiryTooFar + -- ^ 21 + | InvalidOnionPayload !(Maybe (Word64, Word16)) + -- ^ PERM|22: the optional @type@ and @offset@ + | MppTimeout + -- ^ 23 + | InvalidOnionBlinding !OnionHash + -- ^ BADONION|PERM|24: @sha256_of_onion@ + | UnknownFailure {-# UNPACK #-} !Word16 !BS.ByteString + -- ^ a failure code not defined above, and the bytes following it + deriving (Eq, Show, Generic) --- | Final incorrect HTLC amount. -pattern FinalIncorrectHtlcAmount :: FailureCode -pattern FinalIncorrectHtlcAmount = FailureCode 19 -- 0x13 +instance NFData Failure --- | Channel disabled. -pattern ChannelDisabled :: FailureCode -pattern ChannelDisabled = FailureCode 0x1014 -- UPDATE .|. 20 +-- | A 32-byte @sha256_of_onion@. +newtype OnionHash = OnionHash BS.ByteString + deriving (Eq, Show, Generic) --- | Expiry too far. -pattern ExpiryTooFar :: FailureCode -pattern ExpiryTooFar = FailureCode 21 -- 0x15 +instance NFData OnionHash --- | Invalid onion payload. -pattern InvalidOnionPayload :: FailureCode -pattern InvalidOnionPayload = FailureCode 0x4016 -- PERM .|. 22 +-- | Construct an t'OnionHash' from exactly 32 bytes. +-- +-- >>> fmap (BS.length . un_onion_hash) (onion_hash (BS.replicate 32 0)) +-- Just 32 +onion_hash :: BS.ByteString -> Maybe OnionHash +onion_hash bs + | BS.length bs == 32 = Just (OnionHash bs) + | otherwise = Nothing +{-# INLINE onion_hash #-} --- | MPP timeout. -pattern MppTimeout :: FailureCode -pattern MppTimeout = FailureCode 23 -- 0x17 +-- | The bytes of an t'OnionHash'. +un_onion_hash :: OnionHash -> BS.ByteString +un_onion_hash (OnionHash bs) = bs +{-# INLINE un_onion_hash #-} --- Processing results ------------------------------------------------------- +-- | The @failure_code@ of a 'Failure'. +-- +-- >>> failure_code TemporaryNodeFailure +-- 8194 +-- >>> failure_code (UnknownFailure 0x1234 mempty) +-- 4660 +failure_code :: Failure -> Word16 +failure_code f = case f of + TemporaryNodeFailure -> 0x2002 + PermanentNodeFailure -> 0x6002 + RequiredNodeFeatureMissing -> 0x6003 + InvalidOnionVersion _ -> 0xc004 + InvalidOnionHmac _ -> 0xc005 + InvalidOnionKey _ -> 0xc006 + TemporaryChannelFailure _ -> 0x1007 + PermanentChannelFailure -> 0x4008 + RequiredChannelFeatureMissing -> 0x4009 + UnknownNextPeer -> 0x400a + AmountBelowMinimum _ _ -> 0x100b + FeeInsufficient _ _ -> 0x100c + IncorrectCltvExpiry _ _ -> 0x100d + ExpiryTooSoon _ -> 0x100e + IncorrectOrUnknownPaymentDetails _ _ -> 0x400f + FinalIncorrectCltvExpiry _ -> 0x0012 + FinalIncorrectHtlcAmount _ -> 0x0013 + ChannelDisabled _ _ -> 0x1014 + ExpiryTooFar -> 0x0015 + InvalidOnionPayload _ -> 0x4016 + MppTimeout -> 0x0017 + InvalidOnionBlinding _ -> 0xc018 + UnknownFailure c _ -> c --- | Result of processing an onion packet. -data ProcessResult - = Forward !ForwardInfo -- ^ Forward to next hop - | Receive !ReceiveInfo -- ^ Final destination reached - deriving (Eq, Show, Generic) +-- | Is the BADONION flag (0x8000) set: was the onion unparsable? +-- +-- >>> is_badonion TemporaryNodeFailure +-- False +is_badonion :: Failure -> Bool +is_badonion f = failure_code f .&. 0x8000 /= 0 +{-# INLINE is_badonion #-} --- | Information for forwarding to next hop. -data ForwardInfo = ForwardInfo - { fiNextPacket :: !OnionPacket - , fiPayload :: !HopPayload - , fiSharedSecret :: !BS.ByteString -- ^ For error attribution - } deriving (Eq, Show, Generic) +-- | Is the PERM flag (0x4000) set: is the failure permanent? +-- +-- >>> is_perm PermanentNodeFailure +-- True +is_perm :: Failure -> Bool +is_perm f = failure_code f .&. 0x4000 /= 0 +{-# INLINE is_perm #-} --- | Information for receiving at final destination. -data ReceiveInfo = ReceiveInfo - { riPayload :: !HopPayload - , riSharedSecret :: !BS.ByteString - } deriving (Eq, Show, Generic) +-- | Is the NODE flag (0x2000) set: is it a node (not channel) failure? +-- +-- >>> is_node TemporaryNodeFailure +-- True +is_node :: Failure -> Bool +is_node f = failure_code f .&. 0x2000 /= 0 +{-# INLINE is_node #-} --- Constants ---------------------------------------------------------------- +-- | Is the UPDATE flag (0x1000) set: was a channel forwarding parameter +-- violated? +-- +-- >>> is_update (ExpiryTooSoon mempty) +-- True +is_update :: Failure -> Bool +is_update f = failure_code f .&. 0x1000 /= 0 +{-# INLINE is_update #-} --- | Total onion packet size (1366 bytes). -onionPacketSize :: Int -onionPacketSize = 1366 -{-# INLINE onionPacketSize #-} +-- errors --------------------------------------------------------------------- --- | Hop payloads section size (1300 bytes). -hopPayloadsSize :: Int -hopPayloadsSize = 1300 -{-# INLINE hopPayloadsSize #-} +-- | Why a decoder failed. +data DecodeError + = InvalidLength + -- ^ the input has the wrong length + | InvalidPoint + -- ^ a point lacks a compressed-encoding prefix + | InvalidTlvStream !BOLT1.TlvError + -- ^ the TLV stream is malformed, or has an unknown even type + | InvalidTlvValue {-# UNPACK #-} !Word64 + -- ^ the value of the record of this type is malformed + | InvalidFailureData {-# UNPACK #-} !Word16 + -- ^ the data of a failure with this code is malformed + deriving (Eq, Show, Generic) --- | HMAC size (32 bytes). -hmacSize :: Int -hmacSize = 32 -{-# INLINE hmacSize #-} +instance NFData DecodeError --- | Compressed public key size (33 bytes). -pubkeySize :: Int -pubkeySize = 33 -{-# INLINE pubkeySize #-} +-- | Why an encoder failed. +data EncodeError + = ConflictingTlv + -- ^ an extra TLV record has the type of a known record + | FieldTooLong + -- ^ a length-prefixed field exceeds its maximum length + deriving (Eq, Show, Generic) --- | Version byte for onion packets. -versionByte :: Word8 -versionByte = 0x00 -{-# INLINE versionByte #-} +instance NFData EncodeError --- | Maximum payload size (1300 - 32 - 1 = 1267 bytes). -maxPayloadSize :: Int -maxPayloadSize = hopPayloadsSize - hmacSize - 1 -{-# INLINE maxPayloadSize #-} +-- | Why an onion packet was rejected. +data ProcessError + = InvalidVersion {-# UNPACK #-} !Word8 + -- ^ the version byte is not 0 + | InvalidPublicKey + -- ^ the ephemeral public key is not a valid point + | HmacMismatch + -- ^ the packet's HMAC is wrong + | InvalidPayloadLength + -- ^ the payload length is malformed, below 2, or past the end of + -- @hop_payloads@ + | InvalidPayload !DecodeError + -- ^ the payload is not a valid @payload@ TLV stream + | InvalidPathKey + -- ^ the path key is not a valid point + | UnexpectedPathKey + -- ^ a path key was given with no @encrypted_recipient_data@, or + -- both a @path_key@ and a @current_path_key@ were given + | MissingPathKey + -- ^ @encrypted_recipient_data@ was given with no path key + | InvalidRecipientData + -- ^ the @encrypted_recipient_data@ doesn't decrypt to a valid + -- @encrypted_data_tlv@ stream + deriving (Eq, Show, Generic) --- Silence unused import warning -_useBits :: Word16 -_useBits = BADONION .&. PERM .|. NODE .|. UPDATE +instance NFData ProcessError diff --git a/ppad-bolt4.cabal b/ppad-bolt4.cabal --- a/ppad-bolt4.cabal +++ b/ppad-bolt4.cabal @@ -1,18 +1,20 @@ cabal-version: 3.0 name: ppad-bolt4 -version: 0.0.1 -synopsis: BOLT4 (onion routing) for Lightning Network +version: 0.1.0 +synopsis: Onion routing per BOLT #4 license: MIT license-file: LICENSE author: Jared Tobin maintainer: jared@ppad.tech category: Cryptography build-type: Simple -tested-with: GHC == 9.10.3 +tested-with: GHC == { 9.10.3 } extra-doc-files: CHANGELOG description: - A pure Haskell implementation of BOLT4 (onion routing) from - the Lightning Network protocol specification. + Onion routing for the Lightning Network, per BOLT #4 + (): + onion construction and processing, returning errors, and route + blinding. source-repository head type: git @@ -22,38 +24,47 @@ default-language: Haskell2010 hs-source-dirs: lib ghc-options: - -Wall + -Wall exposed-modules: - Lightning.Protocol.BOLT4 - Lightning.Protocol.BOLT4.Blinding - Lightning.Protocol.BOLT4.Codec - Lightning.Protocol.BOLT4.Construct - Lightning.Protocol.BOLT4.Error - Lightning.Protocol.BOLT4.Prim - Lightning.Protocol.BOLT4.Process - Lightning.Protocol.BOLT4.Types + Lightning.Protocol.BOLT4 + other-modules: + Lightning.Protocol.BOLT4.Blinding + Lightning.Protocol.BOLT4.Codec + Lightning.Protocol.BOLT4.Construct + Lightning.Protocol.BOLT4.Error + Lightning.Protocol.BOLT4.Prim + Lightning.Protocol.BOLT4.Process + Lightning.Protocol.BOLT4.Types build-depends: base >= 4.9 && < 5 - , bytestring >= 0.9 && < 0.13 - , ppad-aead >= 0.3 && < 0.4 - , ppad-chacha >= 0.2 && < 0.3 - , ppad-fixed >= 0.1 && < 0.2 - , ppad-secp256k1 >= 0.5 && < 0.6 - , ppad-sha256 >= 0.3 && < 0.4 + , bytestring >= 0.11.1 && < 0.13 + , deepseq >= 1.4 && < 1.6 + , ppad-aead >= 0.3.6 && < 0.4 + , ppad-bolt1 >= 0.1 && < 0.2 + , ppad-bolt9 >= 0.1 && < 0.2 + , ppad-chacha >= 0.3 && < 0.4 + , ppad-fixed >= 0.2 && < 0.3 + , ppad-secp256k1 >= 0.5.8 && < 0.6 + , ppad-sha256 >= 0.3.2 && < 0.4 test-suite bolt4-tests type: exitcode-stdio-1.0 default-language: Haskell2010 hs-source-dirs: test main-is: Main.hs + other-modules: Vectors ghc-options: - -rtsopts -Wall -O2 + -rtsopts -Wall build-depends: base , bytestring , ppad-base16 + , ppad-bolt1 , ppad-bolt4 + , ppad-bolt9 + , ppad-chacha , ppad-secp256k1 + , ppad-sha256 , tasty , tasty-hunit , tasty-quickcheck @@ -63,13 +74,15 @@ default-language: Haskell2010 hs-source-dirs: bench main-is: Main.hs + other-modules: Fixtures ghc-options: - -rtsopts -O2 -Wall -fno-warn-orphans + -rtsopts -O2 -Wall build-depends: base , bytestring , criterion , deepseq + , ppad-bolt1 , ppad-bolt4 benchmark bolt4-weigh @@ -77,10 +90,13 @@ default-language: Haskell2010 hs-source-dirs: bench main-is: Weight.hs + other-modules: Fixtures ghc-options: - -rtsopts -O2 -Wall -fno-warn-orphans + -rtsopts -O2 -Wall build-depends: base , bytestring + , deepseq + , ppad-bolt1 , ppad-bolt4 , weigh diff --git a/test/Main.hs b/test/Main.hs --- a/test/Main.hs +++ b/test/Main.hs @@ -2,1187 +2,1464 @@ module Main where -import Data.Bits (xor) -import qualified Data.ByteString as BS -import qualified Data.ByteString.Base16 as B16 -import qualified Crypto.Curve.Secp256k1 as Secp256k1 -import Data.Word (Word8) -import Lightning.Protocol.BOLT4.Blinding -import Lightning.Protocol.BOLT4.Codec -import Lightning.Protocol.BOLT4.Construct -import Lightning.Protocol.BOLT4.Error -import Lightning.Protocol.BOLT4.Prim -import Lightning.Protocol.BOLT4.Process -import Lightning.Protocol.BOLT4.Types -import Test.Tasty -import Test.Tasty.HUnit -import Test.Tasty.QuickCheck - --- | Demand a Just value in IO, failing the test on Nothing. -demand :: String -> Maybe a -> IO a -demand _ (Just a) = pure a -demand msg Nothing = assertFailure msg - -main :: IO () -main = defaultMain $ testGroup "ppad-bolt4" [ - testGroup "Prim" [ - primTests - ] - , testGroup "BigSize" [ - bigsizeTests - , bigsizeRoundtripProp - ] - , testGroup "TLV" [ - tlvTests - ] - , testGroup "ShortChannelId" [ - sciTests - ] - , testGroup "OnionPacket" [ - onionPacketTests - ] - , testGroup "Construct" [ - constructTests - ] - , testGroup "Process" [ - processTests - ] - , testGroup "Error" [ - errorTests - ] - , testGroup "Blinding" [ - blindingKeyDerivationTests - , blindingEphemeralKeyTests - , blindingTlvTests - , blindingEncryptionTests - , blindingCreatePathTests - , blindingProcessHopTests - ] - ] - --- BigSize tests ------------------------------------------------------------ - -bigsizeTests :: TestTree -bigsizeTests = testGroup "boundary values" [ - testCase "0" $ - encodeBigSize 0 @?= BS.pack [0x00] - , testCase "0xFC" $ - encodeBigSize 0xFC @?= BS.pack [0xFC] - , testCase "0xFD" $ - encodeBigSize 0xFD @?= BS.pack [0xFD, 0x00, 0xFD] - , testCase "0xFFFF" $ - encodeBigSize 0xFFFF @?= BS.pack [0xFD, 0xFF, 0xFF] - , testCase "0x10000" $ - encodeBigSize 0x10000 @?= BS.pack [0xFE, 0x00, 0x01, 0x00, 0x00] - , testCase "0xFFFFFFFF" $ - encodeBigSize 0xFFFFFFFF @?= BS.pack [0xFE, 0xFF, 0xFF, 0xFF, 0xFF] - , testCase "0x100000000" $ - encodeBigSize 0x100000000 @?= - BS.pack [0xFF, 0x00, 0x00, 0x00, 0x01, 0x00, 0x00, 0x00, 0x00] - , testCase "decode 0" $ do - let result = decodeBigSize (BS.pack [0x00]) - result @?= Just (0, BS.empty) - , testCase "decode 0xFC" $ do - let result = decodeBigSize (BS.pack [0xFC]) - result @?= Just (0xFC, BS.empty) - , testCase "decode 0xFD" $ do - let result = decodeBigSize (BS.pack [0xFD, 0x00, 0xFD]) - result @?= Just (0xFD, BS.empty) - , testCase "decode 0xFFFF" $ do - let result = decodeBigSize (BS.pack [0xFD, 0xFF, 0xFF]) - result @?= Just (0xFFFF, BS.empty) - , testCase "decode 0x10000" $ do - let result = decodeBigSize (BS.pack [0xFE, 0x00, 0x01, 0x00, 0x00]) - result @?= Just (0x10000, BS.empty) - , testCase "decode 0xFFFFFFFF" $ do - let result = decodeBigSize (BS.pack [0xFE, 0xFF, 0xFF, 0xFF, 0xFF]) - result @?= Just (0xFFFFFFFF, BS.empty) - , testCase "decode 0x100000000" $ do - let result = decodeBigSize $ - BS.pack [0xFF, 0x00, 0x00, 0x00, 0x01, 0x00, 0x00, 0x00, 0x00] - result @?= Just (0x100000000, BS.empty) - , testCase "reject non-canonical 0xFD encoding of small value" $ do - let result = decodeBigSize (BS.pack [0xFD, 0x00, 0xFC]) - result @?= Nothing - , testCase "reject non-canonical 0xFE encoding of small value" $ do - let result = decodeBigSize (BS.pack [0xFE, 0x00, 0x00, 0xFF, 0xFF]) - result @?= Nothing - , testCase "bigSizeLen" $ do - bigSizeLen 0 @?= 1 - bigSizeLen 0xFC @?= 1 - bigSizeLen 0xFD @?= 3 - bigSizeLen 0xFFFF @?= 3 - bigSizeLen 0x10000 @?= 5 - bigSizeLen 0xFFFFFFFF @?= 5 - bigSizeLen 0x100000000 @?= 9 - ] - -bigsizeRoundtripProp :: TestTree -bigsizeRoundtripProp = testProperty "roundtrip" $ \n -> - let encoded = encodeBigSize n - decoded = decodeBigSize encoded - in decoded == Just (n, BS.empty) - --- TLV tests ---------------------------------------------------------------- - -tlvTests :: TestTree -tlvTests = testGroup "encoding/decoding" [ - testCase "single record" $ do - let rec = TlvRecord 2 (BS.pack [0x01, 0x02, 0x03]) - encoded = encodeTlv rec - decoded = decodeTlv encoded - decoded @?= Just (rec, BS.empty) - , testCase "stream roundtrip" $ do - let recs = [ TlvRecord 2 (BS.pack [0x01]) - , TlvRecord 4 (BS.pack [0x02, 0x03]) - , TlvRecord 100 (BS.pack [0x04, 0x05, 0x06]) - ] - encoded = encodeTlvStream recs - decoded = decodeTlvStream encoded - decoded @?= Just recs - , testCase "reject out-of-order types" $ do - let rec1 = encodeTlv (TlvRecord 4 (BS.pack [0x01])) - rec2 = encodeTlv (TlvRecord 2 (BS.pack [0x02])) - badStream = rec1 <> rec2 - decoded = decodeTlvStream badStream - decoded @?= Nothing - , testCase "reject duplicate types" $ do - let rec1 = encodeTlv (TlvRecord 2 (BS.pack [0x01])) - rec2 = encodeTlv (TlvRecord 2 (BS.pack [0x02])) - badStream = rec1 <> rec2 - decoded = decodeTlvStream badStream - decoded @?= Nothing - , testCase "empty stream" $ do - let decoded = decodeTlvStream BS.empty - decoded @?= Just [] - ] - --- ShortChannelId tests ----------------------------------------------------- - -sciTests :: TestTree -sciTests = testGroup "encoding/decoding" [ - testCase "known value" $ do - let sci = ShortChannelId 700000 1234 5 - encoded = encodeShortChannelId sci - BS.length encoded @?= 8 - let decoded = decodeShortChannelId encoded - decoded @?= Just sci - , testCase "maximum values" $ do - let sci = ShortChannelId 0xFFFFFF 0xFFFFFF 0xFFFF - encoded = encodeShortChannelId sci - BS.length encoded @?= 8 - let decoded = decodeShortChannelId encoded - decoded @?= Just sci - , testCase "zero values" $ do - let sci = ShortChannelId 0 0 0 - encoded = encodeShortChannelId sci - expected = BS.pack [0, 0, 0, 0, 0, 0, 0, 0] - encoded @?= expected - let decoded = decodeShortChannelId encoded - decoded @?= Just sci - , testCase "reject wrong length" $ do - let decoded = decodeShortChannelId (BS.pack [0, 1, 2, 3, 4, 5, 6]) - decoded @?= Nothing - ] - --- OnionPacket tests -------------------------------------------------------- - -onionPacketTests :: TestTree -onionPacketTests = testGroup "encoding/decoding" [ - testCase "roundtrip" $ do - let packet = OnionPacket - { opVersion = 0x00 - , opEphemeralKey = BS.replicate 33 0xAB - , opHopPayloads = BS.replicate 1300 0xCD - , opHmac = BS.replicate 32 0xEF - } - encoded = encodeOnionPacket packet - BS.length encoded @?= onionPacketSize - let decoded = decodeOnionPacket encoded - decoded @?= Just packet - , testCase "reject wrong size" $ do - let decoded = decodeOnionPacket (BS.replicate 1000 0x00) - decoded @?= Nothing - ] - --- Prim tests --------------------------------------------------------------- - -sessionKey :: BS.ByteString -sessionKey = BS.replicate 32 0x41 - -hop0PubKeyHex :: BS.ByteString -hop0PubKeyHex = - "02eec7245d6b7d2ccb30380bfbe2a3648cd7a942653f5aa340edcea1f283686619" - -hop0SharedSecretHex :: BS.ByteString -hop0SharedSecretHex = - "53eb63ea8a3fec3b3cd433b85cd62a4b145e1dda09391b348c4e1cd36a03ea66" - -hop0BlindingFactorHex :: BS.ByteString -hop0BlindingFactorHex = - "2ec2e5da605776054187180343287683aa6a51b4b1c04d6dd49c45d8cffb3c36" - -fromHex :: BS.ByteString -> BS.ByteString -fromHex h = case B16.decode h of - Just bs -> bs - Nothing -> error "fromHex: invalid hex" - -primTests :: TestTree -primTests = testGroup "cryptographic primitives" [ - testSharedSecret - , testBlindingFactor - , testKeyDerivation - , testBlindPubKey - , testGenerateStream - , testHmacOperations - ] - -testSharedSecret :: TestTree -testSharedSecret = testCase "computeSharedSecret (BOLT4 spec hop 0)" $ do - pubKey <- demand "parse_point" $ - Secp256k1.parse_point (fromHex hop0PubKeyHex) - case computeSharedSecret sessionKey pubKey of - Nothing -> assertFailure "computeSharedSecret returned Nothing" - Just (SharedSecret computed) -> do - let expected = fromHex hop0SharedSecretHex - computed @?= expected - -testBlindingFactor :: TestTree -testBlindingFactor = testCase "computeBlindingFactor (BOLT4 spec hop 0)" $ do - sk <- demand "roll32" $ Secp256k1.roll32 sessionKey - ephemPubKey <- demand "derive_pub" $ Secp256k1.derive_pub sk - nodePubKey <- demand "parse_point" $ - Secp256k1.parse_point (fromHex hop0PubKeyHex) - case computeSharedSecret sessionKey nodePubKey of - Nothing -> assertFailure "computeSharedSecret returned Nothing" - Just sharedSecret -> do - let BlindingFactor computed = - computeBlindingFactor ephemPubKey sharedSecret - expected = fromHex hop0BlindingFactorHex - computed @?= expected - -testKeyDerivation :: TestTree -testKeyDerivation = testGroup "key derivation" [ - testCase "deriveRho produces 32 bytes" $ do - let ss = SharedSecret (BS.replicate 32 0) - DerivedKey rho = deriveRho ss - BS.length rho @?= 32 - , testCase "deriveMu produces 32 bytes" $ do - let ss = SharedSecret (BS.replicate 32 0) - DerivedKey mu = deriveMu ss - BS.length mu @?= 32 - , testCase "deriveUm produces 32 bytes" $ do - let ss = SharedSecret (BS.replicate 32 0) - DerivedKey um = deriveUm ss - BS.length um @?= 32 - , testCase "derivePad produces 32 bytes" $ do - let ss = SharedSecret (BS.replicate 32 0) - DerivedKey pad = derivePad ss - BS.length pad @?= 32 - , testCase "deriveAmmag produces 32 bytes" $ do - let ss = SharedSecret (BS.replicate 32 0) - DerivedKey ammag = deriveAmmag ss - BS.length ammag @?= 32 - , testCase "different key types produce different results" $ do - let ss = SharedSecret (BS.replicate 32 0x42) - DerivedKey rho = deriveRho ss - DerivedKey mu = deriveMu ss - DerivedKey um = deriveUm ss - assertBool "rho /= mu" (rho /= mu) - assertBool "mu /= um" (mu /= um) - assertBool "rho /= um" (rho /= um) - ] - -testBlindPubKey :: TestTree -testBlindPubKey = testGroup "key blinding" [ - testCase "blindPubKey produces valid key" $ do - sk <- demand "roll32" $ Secp256k1.roll32 sessionKey - pubKey <- demand "derive_pub" $ Secp256k1.derive_pub sk - let bf = BlindingFactor (fromHex hop0BlindingFactorHex) - case blindPubKey pubKey bf of - Nothing -> assertFailure "blindPubKey returned Nothing" - Just _blinded -> return () - , testCase "blindSecKey produces valid key" $ do - let bf = BlindingFactor (fromHex hop0BlindingFactorHex) - case blindSecKey sessionKey bf of - Nothing -> assertFailure "blindSecKey returned Nothing" - Just _blinded -> return () - ] - -testGenerateStream :: TestTree -testGenerateStream = testGroup "generateStream" [ - testCase "produces correct length" $ do - let dk = DerivedKey (BS.replicate 32 0) - stream = generateStream dk 100 - BS.length stream @?= 100 - , testCase "1300-byte stream for hop_payloads" $ do - let dk = DerivedKey (BS.replicate 32 0x42) - stream = generateStream dk 1300 - BS.length stream @?= 1300 - , testCase "deterministic output" $ do - let dk = DerivedKey (BS.replicate 32 0x55) - stream1 = generateStream dk 64 - stream2 = generateStream dk 64 - stream1 @?= stream2 - ] - -testHmacOperations :: TestTree -testHmacOperations = testGroup "HMAC operations" [ - testCase "computeHmac produces 32 bytes" $ do - let dk = DerivedKey (BS.replicate 32 0) - hmac = computeHmac dk "payloads" "assocdata" - BS.length hmac @?= 32 - , testCase "verifyHmac succeeds for matching" $ do - let dk = DerivedKey (BS.replicate 32 0) - hmac = computeHmac dk "payloads" "assocdata" - assertBool "verifyHmac should succeed" (verifyHmac hmac hmac) - , testCase "verifyHmac fails for different" $ do - let dk = DerivedKey (BS.replicate 32 0) - hmac1 = computeHmac dk "payloads1" "assocdata" - hmac2 = computeHmac dk "payloads2" "assocdata" - assertBool "verifyHmac should fail" (not $ verifyHmac hmac1 hmac2) - , testCase "verifyHmac fails for different lengths" $ do - assertBool "verifyHmac should fail" - (not $ verifyHmac "short" "different length") - ] - --- Construct tests ------------------------------------------------------------ - --- Test vectors from BOLT4 spec -hop1PubKeyHex :: BS.ByteString -hop1PubKeyHex = - "0324653eac434488002cc06bbfb7f10fe18991e35f9fe4302dbea6d2353dc0ab1c" - -hop2PubKeyHex :: BS.ByteString -hop2PubKeyHex = - "027f31ebc5462c1fdce1b737ecff52d37d75dea43ce11c74d25aa297165faa2007" - -hop3PubKeyHex :: BS.ByteString -hop3PubKeyHex = - "032c0b7cf95324a07d05398b240174dc0c2be444d96b159aa6c7f7b1e668680991" - -hop4PubKeyHex :: BS.ByteString -hop4PubKeyHex = - "02edabbd16b41c8371b92ef2f04c1185b4f03b6dcd52ba9b78d9d7c89c8f221145" - --- Expected shared secrets from BOLT4 error test vectors (in route order) -hop1SharedSecretHex :: BS.ByteString -hop1SharedSecretHex = - "a6519e98832a0b179f62123b3567c106db99ee37bef036e783263602f3488fae" - -hop2SharedSecretHex :: BS.ByteString -hop2SharedSecretHex = - "3a6b412548762f0dbccce5c7ae7bb8147d1caf9b5471c34120b30bc9c04891cc" - -hop3SharedSecretHex :: BS.ByteString -hop3SharedSecretHex = - "21e13c2d7cfe7e18836df50872466117a295783ab8aab0e7ecc8c725503ad02d" - -hop4SharedSecretHex :: BS.ByteString -hop4SharedSecretHex = - "b5756b9b542727dbafc6765a49488b023a725d631af688fc031217e90770c328" - -constructTests :: TestTree -constructTests = testGroup "packet construction" [ - testConstructErrorCases - , testSharedSecretComputation - , testPacketStructure - , testSingleHop - ] - -testConstructErrorCases :: TestTree -testConstructErrorCases = testGroup "error cases" [ - testCase "rejects invalid session key (too short)" $ do - let result = construct (BS.replicate 31 0x41) [] "" - case result of - Left InvalidSessionKey -> return () - _ -> assertFailure "Expected InvalidSessionKey" - , testCase "rejects invalid session key (too long)" $ do - let result = construct (BS.replicate 33 0x41) [] "" - case result of - Left InvalidSessionKey -> return () - _ -> assertFailure "Expected InvalidSessionKey" - , testCase "rejects empty route" $ do - let result = construct sessionKey [] "" - case result of - Left EmptyRoute -> return () - _ -> assertFailure "Expected EmptyRoute" - , testCase "rejects too many hops" $ do - pub <- demand "parse_point" $ - Secp256k1.parse_point (fromHex hop0PubKeyHex) - let emptyPayload = HopPayload Nothing Nothing Nothing Nothing - Nothing Nothing [] - hop = Hop pub emptyPayload - hops = replicate 21 hop - result = construct sessionKey hops "" - case result of - Left TooManyHops -> return () - _ -> assertFailure "Expected TooManyHops" - ] - -testSharedSecretComputation :: TestTree -testSharedSecretComputation = - testCase "computes correct shared secrets (BOLT4 spec)" $ do - pub0 <- demand "parse_point" $ - Secp256k1.parse_point (fromHex hop0PubKeyHex) - pub1 <- demand "parse_point" $ - Secp256k1.parse_point (fromHex hop1PubKeyHex) - pub2 <- demand "parse_point" $ - Secp256k1.parse_point (fromHex hop2PubKeyHex) - pub3 <- demand "parse_point" $ - Secp256k1.parse_point (fromHex hop3PubKeyHex) - pub4 <- demand "parse_point" $ - Secp256k1.parse_point (fromHex hop4PubKeyHex) - let emptyPayload = HopPayload Nothing Nothing Nothing Nothing - Nothing Nothing [] - hops = [ Hop pub0 emptyPayload - , Hop pub1 emptyPayload - , Hop pub2 emptyPayload - , Hop pub3 emptyPayload - , Hop pub4 emptyPayload - ] - result = construct sessionKey hops "" - case result of - Left err -> assertFailure $ "construct failed: " ++ show err - Right (_, secrets) -> case secrets of - [SharedSecret ss0, SharedSecret ss1, SharedSecret ss2, - SharedSecret ss3, SharedSecret ss4] -> do - ss0 @?= fromHex hop0SharedSecretHex - ss1 @?= fromHex hop1SharedSecretHex - ss2 @?= fromHex hop2SharedSecretHex - ss3 @?= fromHex hop3SharedSecretHex - ss4 @?= fromHex hop4SharedSecretHex - _ -> assertFailure "expected 5 shared secrets" - -testPacketStructure :: TestTree -testPacketStructure = testCase "produces valid packet structure" $ do - pub0 <- demand "parse_point" $ - Secp256k1.parse_point (fromHex hop0PubKeyHex) - pub1 <- demand "parse_point" $ - Secp256k1.parse_point (fromHex hop1PubKeyHex) - let emptyPayload = HopPayload Nothing Nothing Nothing Nothing - Nothing Nothing [] - hops = [Hop pub0 emptyPayload, Hop pub1 emptyPayload] - result = construct sessionKey hops "" - case result of - Left err -> assertFailure $ "construct failed: " ++ show err - Right (packet, _) -> do - opVersion packet @?= versionByte - BS.length (opEphemeralKey packet) @?= pubkeySize - BS.length (opHopPayloads packet) @?= hopPayloadsSize - BS.length (opHmac packet) @?= hmacSize - sk <- demand "roll32" $ Secp256k1.roll32 sessionKey - expectedPub <- demand "derive_pub" $ - Secp256k1.derive_pub sk - let expectedPubBytes = Secp256k1.serialize_point expectedPub - opEphemeralKey packet @?= expectedPubBytes - -testSingleHop :: TestTree -testSingleHop = testCase "constructs single-hop packet" $ do - pub0 <- demand "parse_point" $ - Secp256k1.parse_point (fromHex hop0PubKeyHex) - let payload = HopPayload - { hpAmtToForward = Just 1000 - , hpOutgoingCltv = Just 500000 - , hpShortChannelId = Nothing - , hpPaymentData = Nothing - , hpEncryptedData = Nothing - , hpCurrentPathKey = Nothing - , hpUnknownTlvs = [] - } - hops = [Hop pub0 payload] - result = construct sessionKey hops "" - case result of - Left err -> assertFailure $ "construct failed: " ++ show err - Right (packet, secrets) -> do - length secrets @?= 1 - -- Packet should be valid structure - let encoded = encodeOnionPacket packet - BS.length encoded @?= onionPacketSize - -- Should decode back - decoded <- demand "decodeOnionPacket" $ - decodeOnionPacket encoded - decoded @?= packet - --- Process tests ------------------------------------------------------------- - -processTests :: TestTree -processTests = testGroup "packet processing" [ - testVersionValidation - , testEphemeralKeyValidation - , testHmacValidation - , testProcessBasic - ] - -testVersionValidation :: TestTree -testVersionValidation = testGroup "version validation" [ - testCase "reject invalid version 0x01" $ do - let packet = OnionPacket - { opVersion = 0x01 -- Invalid, should be 0x00 - , opEphemeralKey = BS.replicate 33 0x02 - , opHopPayloads = BS.replicate 1300 0x00 - , opHmac = BS.replicate 32 0x00 - } - case process sessionKey packet BS.empty of - Left (InvalidVersion v) -> v @?= 0x01 - Left other -> assertFailure $ "expected InvalidVersion, got: " - ++ show other - Right _ -> assertFailure "expected rejection, got success" - , testCase "reject invalid version 0xFF" $ do - let packet = OnionPacket - { opVersion = 0xFF - , opEphemeralKey = BS.replicate 33 0x02 - , opHopPayloads = BS.replicate 1300 0x00 - , opHmac = BS.replicate 32 0x00 - } - case process sessionKey packet BS.empty of - Left (InvalidVersion v) -> v @?= 0xFF - Left other -> assertFailure $ "expected InvalidVersion, got: " - ++ show other - Right _ -> assertFailure "expected rejection, got success" - ] - -testEphemeralKeyValidation :: TestTree -testEphemeralKeyValidation = testGroup "ephemeral key validation" [ - testCase "reject invalid ephemeral key (all zeros)" $ do - let packet = OnionPacket - { opVersion = 0x00 - , opEphemeralKey = BS.replicate 33 0x00 -- Invalid pubkey - , opHopPayloads = BS.replicate 1300 0x00 - , opHmac = BS.replicate 32 0x00 - } - case process sessionKey packet BS.empty of - Left InvalidEphemeralKey -> return () - Left other -> assertFailure $ "expected InvalidEphemeralKey, got: " - ++ show other - Right _ -> assertFailure "expected rejection, got success" - , testCase "reject malformed ephemeral key" $ do - -- 0x04 prefix is for uncompressed keys, but we only have 33 bytes - let packet = OnionPacket - { opVersion = 0x00 - , opEphemeralKey = BS.pack (0x04 : replicate 32 0xAB) - , opHopPayloads = BS.replicate 1300 0x00 - , opHmac = BS.replicate 32 0x00 - } - case process sessionKey packet BS.empty of - Left InvalidEphemeralKey -> return () - Left other -> assertFailure $ "expected InvalidEphemeralKey, got: " - ++ show other - Right _ -> assertFailure "expected rejection, got success" - ] - -testHmacValidation :: TestTree -testHmacValidation = testGroup "HMAC validation" [ - testCase "reject invalid HMAC" $ do - -- Use a valid ephemeral key but wrong HMAC - hop0PubKey <- demand "parse_point" $ - Secp256k1.parse_point (fromHex hop0PubKeyHex) - let ephKeyBytes = Secp256k1.serialize_point hop0PubKey - packet = OnionPacket - { opVersion = 0x00 - , opEphemeralKey = ephKeyBytes - , opHopPayloads = BS.replicate 1300 0x00 - , opHmac = BS.replicate 32 0xFF -- Wrong HMAC - } - case process sessionKey packet BS.empty of - Left HmacMismatch -> return () - Left other -> assertFailure $ "expected HmacMismatch, got: " - ++ show other - Right _ -> assertFailure "expected rejection, got success" - ] - --- | Test basic packet processing with a properly constructed packet. -testProcessBasic :: TestTree -testProcessBasic = testGroup "basic processing" [ - testCase "process valid packet (final hop, all-zero next HMAC)" $ do - -- Construct a valid packet for a final hop - -- The hop payload needs to be properly formatted TLV - hop0PubKey <- demand "parse_point" $ - Secp256k1.parse_point (fromHex hop0PubKeyHex) - let ephKeyBytes = Secp256k1.serialize_point hop0PubKey - hopPayloadTlv = encodeHopPayload HopPayload - { hpAmtToForward = Just 1000 - , hpOutgoingCltv = Just 500000 - , hpShortChannelId = Nothing - , hpPaymentData = Nothing - , hpEncryptedData = Nothing - , hpCurrentPathKey = Nothing - , hpUnknownTlvs = [] - } - payloadLen = BS.length hopPayloadTlv - lenPrefix = encodeBigSize (fromIntegral payloadLen) - payloadWithHmac = lenPrefix <> hopPayloadTlv - <> BS.replicate 32 0x00 - padding = BS.replicate - (1300 - BS.length payloadWithHmac) 0x00 - rawPayloads = payloadWithHmac <> padding - ss <- demand "computeSharedSecret" $ - computeSharedSecret sessionKey hop0PubKey - let rhoKey = deriveRho ss - muKey = deriveMu ss - stream = generateStream rhoKey 1300 - encryptedPayloads = - BS.pack (BS.zipWith xor rawPayloads stream) - correctHmac = - computeHmac muKey encryptedPayloads BS.empty - packet = OnionPacket - { opVersion = 0x00 - , opEphemeralKey = ephKeyBytes - , opHopPayloads = encryptedPayloads - , opHmac = correctHmac - } - - case process sessionKey packet BS.empty of - Left err -> assertFailure $ "expected success, got: " ++ show err - Right (Receive ri) -> do - -- Verify we got the payload back - hpAmtToForward (riPayload ri) @?= Just 1000 - hpOutgoingCltv (riPayload ri) @?= Just 500000 - Right (Forward _) -> assertFailure "expected Receive, got Forward" - ] - --- Error tests ----------------------------------------------------------------- - -errorTests :: TestTree -errorTests = testGroup "error handling" [ - testErrorConstruction - , testErrorRoundtrip - , testMultiHopWrapping - , testErrorAttribution - , testFailureMessageParsing - ] - --- Shared secrets for testing (deterministic) -testSecret1 :: SharedSecret -testSecret1 = SharedSecret (BS.replicate 32 0x11) - -testSecret2 :: SharedSecret -testSecret2 = SharedSecret (BS.replicate 32 0x22) - -testSecret3 :: SharedSecret -testSecret3 = SharedSecret (BS.replicate 32 0x33) - -testSecret4 :: SharedSecret -testSecret4 = SharedSecret (BS.replicate 32 0x44) - --- Simple failure message for testing -testFailure :: FailureMessage -testFailure = FailureMessage IncorrectOrUnknownPaymentDetails BS.empty [] - -testErrorConstruction :: TestTree -testErrorConstruction = testCase "error packet construction" $ do - let errPacket = constructError testSecret1 testFailure - ErrorPacket bs = errPacket - -- Error packet should be at least minErrorPacketSize - assertBool "error packet >= 256 bytes" (BS.length bs >= minErrorPacketSize) - -testErrorRoundtrip :: TestTree -testErrorRoundtrip = testCase "construct and unwrap roundtrip" $ do - let errPacket = constructError testSecret1 testFailure - result = unwrapError [testSecret1] errPacket - case result of - Attributed idx msg -> do - idx @?= 0 - fmCode msg @?= IncorrectOrUnknownPaymentDetails - UnknownOrigin _ -> - assertFailure "Expected Attributed, got UnknownOrigin" - -testMultiHopWrapping :: TestTree -testMultiHopWrapping = testGroup "multi-hop wrapping" [ - testCase "3-hop route, error from hop 2 (final)" $ do - -- Route: origin -> hop0 -> hop1 -> hop2 (final, fails) - -- Error constructed at hop2, wrapped at hop1, wrapped at hop0 - let secrets = [testSecret1, testSecret2, testSecret3] - -- Hop 2 constructs error - err0 = constructError testSecret3 testFailure - -- Hop 1 wraps - err1 = wrapError testSecret2 err0 - -- Hop 0 wraps - err2 = wrapError testSecret1 err1 - -- Origin unwraps - result = unwrapError secrets err2 - case result of - Attributed idx msg -> do - idx @?= 2 - fmCode msg @?= IncorrectOrUnknownPaymentDetails - UnknownOrigin _ -> - assertFailure "Expected Attributed, got UnknownOrigin" - - , testCase "4-hop route, error from hop 1 (intermediate)" $ do - -- Route: origin -> hop0 -> hop1 (fails) -> hop2 -> hop3 - let secrets = [testSecret1, testSecret2, testSecret3, testSecret4] - -- Hop 1 constructs error - err0 = constructError testSecret2 testFailure - -- Hop 0 wraps - err1 = wrapError testSecret1 err0 - -- Origin unwraps - result = unwrapError secrets err1 - case result of - Attributed idx msg -> do - idx @?= 1 - fmCode msg @?= IncorrectOrUnknownPaymentDetails - UnknownOrigin _ -> - assertFailure "Expected Attributed, got UnknownOrigin" - - , testCase "4-hop route, error from hop 0 (first)" $ do - let secrets = [testSecret1, testSecret2, testSecret3, testSecret4] - -- Hop 0 constructs error (no wrapping needed) - err0 = constructError testSecret1 testFailure - -- Origin unwraps - result = unwrapError secrets err0 - case result of - Attributed idx msg -> do - idx @?= 0 - fmCode msg @?= IncorrectOrUnknownPaymentDetails - UnknownOrigin _ -> - assertFailure "Expected Attributed, got UnknownOrigin" - ] - -testErrorAttribution :: TestTree -testErrorAttribution = testGroup "error attribution" [ - testCase "wrong secrets gives UnknownOrigin" $ do - let err = constructError testSecret1 testFailure - wrongSecrets = [testSecret2, testSecret3] - result = unwrapError wrongSecrets err - case result of - UnknownOrigin _ -> return () - Attributed _ _ -> - assertFailure "Expected UnknownOrigin with wrong secrets" - - , testCase "empty secrets gives UnknownOrigin" $ do - let err = constructError testSecret1 testFailure - result = unwrapError [] err - case result of - UnknownOrigin _ -> return () - Attributed _ _ -> - assertFailure "Expected UnknownOrigin with empty secrets" - - , testCase "correct attribution with multiple failures" $ do - -- Test different failure codes - let failures = - [ (TemporaryNodeFailure, testSecret1) - , (PermanentNodeFailure, testSecret2) - , (InvalidOnionHmac, testSecret3) - ] - mapM_ (\(code, secret) -> do - let failure = FailureMessage code BS.empty [] - err = constructError secret failure - result = unwrapError [secret] err - case result of - Attributed 0 msg -> fmCode msg @?= code - _ -> assertFailure $ "Failed for code: " ++ show code - ) failures - ] - -testFailureMessageParsing :: TestTree -testFailureMessageParsing = testGroup "failure message parsing" [ - testCase "code with data" $ do - -- AmountBelowMinimum typically includes channel update data - let failData = BS.replicate 10 0xAB - failure = FailureMessage AmountBelowMinimum failData [] - err = constructError testSecret1 failure - result = unwrapError [testSecret1] err - case result of - Attributed 0 msg -> do - fmCode msg @?= AmountBelowMinimum - fmData msg @?= failData - _ -> assertFailure "Expected Attributed" - - , testCase "various failure codes roundtrip" $ do - let codes = - [ InvalidRealm - , TemporaryNodeFailure - , PermanentNodeFailure - , InvalidOnionHmac - , TemporaryChannelFailure - , IncorrectOrUnknownPaymentDetails - ] - mapM_ (\code -> do - let failure = FailureMessage code BS.empty [] - err = constructError testSecret1 failure - result = unwrapError [testSecret1] err - case result of - Attributed 0 msg -> fmCode msg @?= code - _ -> assertFailure $ "Failed for code: " ++ show code - ) codes - ] - --- Blinding tests ----------------------------------------------------------- - --- Test data setup - -testSeed :: BS.ByteString -testSeed = BS.pack [1..32] - -makeSecKey :: Word8 -> BS.ByteString -makeSecKey seed = BS.pack $ replicate 31 0x00 ++ [seed] - -makePubKey :: Word8 -> Maybe Secp256k1.Projective -makePubKey seed = do - sk <- Secp256k1.roll32 (makeSecKey seed) - Secp256k1.derive_pub sk - -testNodeSecKey1, testNodeSecKey2, testNodeSecKey3 :: BS.ByteString -testNodeSecKey1 = makeSecKey 0x11 -testNodeSecKey2 = makeSecKey 0x22 -testNodeSecKey3 = makeSecKey 0x33 - -testNodePubKey1, testNodePubKey2, testNodePubKey3 :: Secp256k1.Projective -testNodePubKey1 = case makePubKey 0x11 of - Just pk -> pk - Nothing -> error "testNodePubKey1: invalid key" -testNodePubKey2 = case makePubKey 0x22 of - Just pk -> pk - Nothing -> error "testNodePubKey2: invalid key" -testNodePubKey3 = case makePubKey 0x33 of - Just pk -> pk - Nothing -> error "testNodePubKey3: invalid key" - -testSharedSecretBS :: SharedSecret -testSharedSecretBS = SharedSecret (BS.pack [0x42..0x61]) - -emptyHopData :: BlindedHopData -emptyHopData = BlindedHopData - Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing - -sampleHopData :: BlindedHopData -sampleHopData = BlindedHopData - { bhdPadding = Nothing - , bhdShortChannelId = Just (ShortChannelId 700000 1234 0) - , bhdNextNodeId = Nothing - , bhdPathId = Just (BS.pack [0x42, 0x42]) - , bhdNextPathKeyOverride = Nothing - , bhdPaymentRelay = Just (PaymentRelay 40 1000 500) - , bhdPaymentConstraints = Just (PaymentConstraints 144 1000000) - , bhdAllowedFeatures = Nothing - } - -hopDataWithNextNode :: BlindedHopData -hopDataWithNextNode = emptyHopData - { bhdNextNodeId = Just (Secp256k1.serialize_point testNodePubKey2) } - --- 1. Key Derivation Tests -------------------------------------------------- - -blindingKeyDerivationTests :: TestTree -blindingKeyDerivationTests = testGroup "key derivation" [ - testCase "deriveBlindingRho produces 32 bytes" $ do - let DerivedKey rho = deriveBlindingRho testSharedSecretBS - BS.length rho @?= 32 - - , testCase "deriveBlindingRho is deterministic" $ do - let rho1 = deriveBlindingRho testSharedSecretBS - rho2 = deriveBlindingRho testSharedSecretBS - rho1 @?= rho2 - - , testCase "deriveBlindingRho differs for different secrets" $ do - let ss1 = SharedSecret (BS.replicate 32 0x00) - ss2 = SharedSecret (BS.replicate 32 0x01) - rho1 = deriveBlindingRho ss1 - rho2 = deriveBlindingRho ss2 - assertBool "rho values should differ" (rho1 /= rho2) - - , testCase "deriveBlindedNodeId produces 33 bytes" $ do - case deriveBlindedNodeId testSharedSecretBS testNodePubKey1 of - Nothing -> assertFailure "deriveBlindedNodeId returned Nothing" - Just blindedId -> BS.length blindedId @?= 33 - - , testCase "deriveBlindedNodeId is deterministic" $ do - let result1 = deriveBlindedNodeId testSharedSecretBS testNodePubKey1 - result2 = deriveBlindedNodeId testSharedSecretBS testNodePubKey1 - result1 @?= result2 - - , testCase "deriveBlindedNodeId differs for different nodes" $ do - let result1 = deriveBlindedNodeId testSharedSecretBS testNodePubKey1 - result2 = deriveBlindedNodeId testSharedSecretBS testNodePubKey2 - assertBool "blinded node IDs should differ" (result1 /= result2) - ] - --- 2. Ephemeral Key Iteration Tests ----------------------------------------- - --- | Derive the public key for testSeed -testSeedPubKey :: Secp256k1.Projective -testSeedPubKey = case Secp256k1.roll32 testSeed of - Nothing -> error "testSeedPubKey: invalid seed" - Just sk -> case Secp256k1.derive_pub sk of - Nothing -> error "testSeedPubKey: invalid key" - Just pk -> pk - -blindingEphemeralKeyTests :: TestTree -blindingEphemeralKeyTests = testGroup "ephemeral key iteration" [ - testCase "nextEphemeral produces valid keys" $ do - -- Use matching secret/public key pair - case nextEphemeral testSeed testSeedPubKey testSharedSecretBS of - Nothing -> assertFailure "nextEphemeral returned Nothing" - Just (newSecKey, newPubKey) -> do - BS.length newSecKey @?= 32 - let serialized = Secp256k1.serialize_point newPubKey - BS.length serialized @?= 33 - - , testCase "nextEphemeral: new secret key derives new public key" $ do - -- Use matching secret/public key pair - case nextEphemeral testSeed testSeedPubKey testSharedSecretBS of - Nothing -> assertFailure "nextEphemeral returned Nothing" - Just (newSecKey, newPubKey) -> do - sk <- demand "roll32" $ Secp256k1.roll32 newSecKey - derivedPub <- demand "derive_pub" $ - Secp256k1.derive_pub sk - derivedPub @?= newPubKey - - , testCase "nextEphemeral is deterministic" $ do - let result1 = nextEphemeral testSeed testSeedPubKey testSharedSecretBS - result2 = nextEphemeral testSeed testSeedPubKey testSharedSecretBS - result1 @?= result2 - - , testCase "nextEphemeral differs for different shared secrets" $ do - let ss1 = SharedSecret (BS.replicate 32 0xAA) - ss2 = SharedSecret (BS.replicate 32 0xBB) - result1 = nextEphemeral testSeed testSeedPubKey ss1 - result2 = nextEphemeral testSeed testSeedPubKey ss2 - assertBool "results should differ" (result1 /= result2) - ] - --- 3. TLV Encoding/Decoding Tests ------------------------------------------- - -blindingTlvTests :: TestTree -blindingTlvTests = testGroup "TLV encoding/decoding" [ - testCase "roundtrip: empty hop data" $ do - let encoded = encodeBlindedHopData emptyHopData - decoded = decodeBlindedHopData encoded - decoded @?= Just emptyHopData - - , testCase "roundtrip: sample hop data" $ do - let encoded = encodeBlindedHopData sampleHopData - decoded = decodeBlindedHopData encoded - decoded @?= Just sampleHopData - - , testCase "roundtrip: hop data with next node ID" $ do - let encoded = encodeBlindedHopData hopDataWithNextNode - decoded = decodeBlindedHopData encoded - decoded @?= Just hopDataWithNextNode - - , testCase "roundtrip: hop data with padding" $ do - let hopData = emptyHopData { bhdPadding = Just (BS.replicate 16 0x00) } - encoded = encodeBlindedHopData hopData - decoded = decodeBlindedHopData encoded - decoded @?= Just hopData - - , testCase "PaymentRelay encoding/decoding" $ do - let relay = PaymentRelay 40 1000 500 - hopData = emptyHopData { bhdPaymentRelay = Just relay } - encoded = encodeBlindedHopData hopData - decoded = decodeBlindedHopData encoded - case decoded of - Nothing -> assertFailure "decodeBlindedHopData returned Nothing" - Just hd -> bhdPaymentRelay hd @?= Just relay - - , testCase "PaymentConstraints encoding/decoding" $ do - let constraints = PaymentConstraints 144 1000000 - hopData = emptyHopData { bhdPaymentConstraints = Just constraints } - encoded = encodeBlindedHopData hopData - decoded = decodeBlindedHopData encoded - case decoded of - Nothing -> assertFailure "decodeBlindedHopData returned Nothing" - Just hd -> bhdPaymentConstraints hd @?= Just constraints - - , testCase "decode empty bytestring returns empty hop data" $ do - let decoded = decodeBlindedHopData BS.empty - decoded @?= Just emptyHopData - ] - --- 4. Encryption/Decryption Tests ------------------------------------------- - -blindingEncryptionTests :: TestTree -blindingEncryptionTests = testGroup "encryption/decryption" [ - testCase "roundtrip: encrypt then decrypt" $ do - let rho = deriveBlindingRho testSharedSecretBS - encrypted = encryptHopData rho sampleHopData - decrypted = decryptHopData rho encrypted - decrypted @?= Just sampleHopData - - , testCase "roundtrip: empty hop data" $ do - let rho = deriveBlindingRho testSharedSecretBS - encrypted = encryptHopData rho emptyHopData - decrypted = decryptHopData rho encrypted - decrypted @?= Just emptyHopData - - , testCase "decryption with wrong key fails" $ do - let rho1 = deriveBlindingRho testSharedSecretBS - rho2 = deriveBlindingRho (SharedSecret (BS.replicate 32 0xFF)) - encrypted = encryptHopData rho1 sampleHopData - decrypted = decryptHopData rho2 encrypted - assertBool "decryption should fail or produce garbage" - (decrypted /= Just sampleHopData) - - , testCase "encrypt is deterministic" $ do - let rho = deriveBlindingRho testSharedSecretBS - encrypted1 = encryptHopData rho sampleHopData - encrypted2 = encryptHopData rho sampleHopData - encrypted1 @?= encrypted2 - ] - --- 5. createBlindedPath Tests ----------------------------------------------- - -blindingCreatePathTests :: TestTree -blindingCreatePathTests = testGroup "createBlindedPath" [ - testCase "create path with 2 hops" $ do - let nodes = [(testNodePubKey1, emptyHopData), - (testNodePubKey2, sampleHopData)] - case createBlindedPath testSeed nodes of - Left err -> assertFailure $ "createBlindedPath failed: " ++ show err - Right path -> do - length (bpBlindedHops path) @?= 2 - let serialized = Secp256k1.serialize_point (bpBlindingKey path) - BS.length serialized @?= 33 - - , testCase "create path with 3 hops" $ do - let nodes = [ (testNodePubKey1, emptyHopData) - , (testNodePubKey2, hopDataWithNextNode) - , (testNodePubKey3, sampleHopData) - ] - case createBlindedPath testSeed nodes of - Left err -> assertFailure $ "createBlindedPath failed: " ++ show err - Right path -> length (bpBlindedHops path) @?= 3 - - , testCase "all blinded node IDs are 33 bytes" $ do - let nodes = [ (testNodePubKey1, emptyHopData) - , (testNodePubKey2, emptyHopData) - , (testNodePubKey3, emptyHopData) - ] - case createBlindedPath testSeed nodes of - Left err -> assertFailure $ "createBlindedPath failed: " ++ show err - Right path -> do - let blindedIds = map bhBlindedNodeId (bpBlindedHops path) - mapM_ (\bid -> BS.length bid @?= 33) blindedIds - - , testCase "empty path returns EmptyPath error" $ do - case createBlindedPath testSeed [] of - Left EmptyPath -> return () - Left err -> assertFailure $ "Expected EmptyPath, got: " ++ show err - Right _ -> assertFailure "Expected error, got success" - - , testCase "invalid seed returns InvalidSeed error" $ do - let invalidSeed = BS.pack [1..16] - nodes = [(testNodePubKey1, emptyHopData)] - case createBlindedPath invalidSeed nodes of - Left InvalidSeed -> return () - Left err -> assertFailure $ "Expected InvalidSeed, got: " ++ show err - Right _ -> assertFailure "Expected error, got success" - - , testCase "createBlindedPath is deterministic" $ do - let nodes = [(testNodePubKey1, emptyHopData), - (testNodePubKey2, sampleHopData)] - result1 = createBlindedPath testSeed nodes - result2 = createBlindedPath testSeed nodes - result1 @?= result2 - ] - --- 6. processBlindedHop Tests ----------------------------------------------- - -blindingProcessHopTests :: TestTree -blindingProcessHopTests = testGroup "processBlindedHop" [ - testCase "process first hop decrypts correctly" $ do - let nodes = [(testNodePubKey1, sampleHopData), - (testNodePubKey2, emptyHopData)] - case createBlindedPath testSeed nodes of - Left err -> assertFailure $ "createBlindedPath failed: " ++ show err - Right path -> case bpBlindedHops path of - firstHop : _ -> do - let pathKey = bpBlindingKey path - case processBlindedHop testNodeSecKey1 pathKey - (bhEncryptedData firstHop) of - Left err -> assertFailure $ - "processBlindedHop failed: " ++ show err - Right (decryptedData, _) -> - decryptedData @?= sampleHopData - [] -> assertFailure "expected non-empty hops" - - , testCase "process hop chain correctly" $ do - let nodes = [ (testNodePubKey1, emptyHopData) - , (testNodePubKey2, sampleHopData) - , (testNodePubKey3, hopDataWithNextNode) - ] - case createBlindedPath testSeed nodes of - Left err -> assertFailure $ "createBlindedPath failed: " ++ show err - Right path -> case bpBlindedHops path of - [hop1, hop2, hop3] -> do - let pathKey1 = bpBlindingKey path - case processBlindedHop testNodeSecKey1 pathKey1 - (bhEncryptedData hop1) of - Left err -> assertFailure $ - "processBlindedHop hop1 failed: " ++ show err - Right (data1, pathKey2) -> do - data1 @?= emptyHopData - case processBlindedHop testNodeSecKey2 pathKey2 - (bhEncryptedData hop2) of - Left err -> assertFailure $ - "processBlindedHop hop2 failed: " - ++ show err - Right (data2, pathKey3) -> do - data2 @?= sampleHopData - case processBlindedHop testNodeSecKey3 - pathKey3 - (bhEncryptedData hop3) of - Left err -> assertFailure $ - "processBlindedHop hop3 failed: " - ++ show err - Right (data3, _) -> - data3 @?= hopDataWithNextNode - _ -> assertFailure "expected 3 blinded hops" - - , testCase "process hop with wrong node key fails" $ do - let nodes = [(testNodePubKey1, sampleHopData)] - case createBlindedPath testSeed nodes of - Left err -> assertFailure $ - "createBlindedPath failed: " ++ show err - Right path -> case bpBlindedHops path of - firstHop : _ -> do - let pathKey = bpBlindingKey path - case processBlindedHop testNodeSecKey2 pathKey - (bhEncryptedData firstHop) of - Left _ -> return () - Right (decryptedData, _) -> - assertBool "should not decrypt correctly" - (decryptedData /= sampleHopData) - [] -> assertFailure "expected non-empty hops" - - , testCase "next path key is valid point" $ do - let nodes = [(testNodePubKey1, emptyHopData), - (testNodePubKey2, emptyHopData)] - case createBlindedPath testSeed nodes of - Left err -> assertFailure $ - "createBlindedPath failed: " ++ show err - Right path -> case bpBlindedHops path of - firstHop : _ -> do - let pathKey = bpBlindingKey path - case processBlindedHop testNodeSecKey1 pathKey - (bhEncryptedData firstHop) of - Left err -> assertFailure $ - "processBlindedHop failed: " ++ show err - Right (_, nextPathKey) -> do - let serialized = - Secp256k1.serialize_point nextPathKey - BS.length serialized @?= 33 - [] -> assertFailure "expected non-empty hops" - - , testCase "next_path_key_override is used when present" $ do - let overrideKey = Secp256k1.serialize_point testNodePubKey3 - hopDataWithOverride' = emptyHopData - { bhdNextPathKeyOverride = Just overrideKey } - nodes = [(testNodePubKey1, hopDataWithOverride'), - (testNodePubKey2, emptyHopData)] - case createBlindedPath testSeed nodes of - Left err -> assertFailure $ - "createBlindedPath failed: " ++ show err - Right path -> case bpBlindedHops path of - firstHop : _ -> do - let pathKey = bpBlindingKey path - case processBlindedHop testNodeSecKey1 pathKey - (bhEncryptedData firstHop) of - Left err -> assertFailure $ - "processBlindedHop failed: " ++ show err - Right (decryptedData, nextPathKey) -> do - bhdNextPathKeyOverride decryptedData - @?= Just overrideKey - nextPathKey @?= testNodePubKey3 - [] -> assertFailure "expected non-empty hops" - ] +import Control.Monad (forM_) +import qualified Crypto.Cipher.ChaCha20 as ChaCha +import qualified Crypto.Curve.Secp256k1 as Secp256k1 +import qualified Crypto.Hash.SHA256 as SHA256 +import Data.Bits (xor) +import qualified Data.ByteString as BS +import qualified Data.ByteString.Base16 as B16 +import Data.List (nubBy) +import Data.Word (Word8, Word16, Word32, Word64) +import qualified Lightning.Protocol.BOLT1 as BOLT1 +import Lightning.Protocol.BOLT4 +import qualified Lightning.Protocol.BOLT9 as BOLT9 +import Test.Tasty +import Test.Tasty.HUnit +import Test.Tasty.QuickCheck +import qualified Vectors as V + +main :: IO () +main = defaultMain $ testGroup "ppad-bolt4" [ + key_tests + , codec_tests + , failure_tests + , construct_tests + , process_tests + , blinding_tests + , error_tests + , testGroup "spec vectors" [ + onion_vectors + , error_vectors + , trace_vectors + , route_blinding_vectors + , blinded_payment_vectors + ] + , properties + ] + +-- helpers -------------------------------------------------------------------- + +demand :: String -> Maybe a -> IO a +demand _ (Just a) = pure a +demand msg Nothing = assertFailure msg + +right :: Show e => String -> Either e a -> IO a +right _ (Right a) = pure a +right msg (Left e) = assertFailure (msg ++ ": " ++ show e) + +unhex :: BS.ByteString -> IO BS.ByteString +unhex = demand "invalid hex" . B16.decode + +hex_key :: BS.ByteString -> IO SecretKey +hex_key h = unhex h >>= demand "invalid secret key" . secret_key + +hex_point :: BS.ByteString -> IO BOLT1.Point +hex_point h = unhex h >>= demand "invalid point" . BOLT1.point + +hex_secret :: BS.ByteString -> IO SharedSecret +hex_secret h = unhex h >>= demand "invalid shared secret" . shared_secret + +-- strip a BigSize length prefix, checking that it is exact +unprefix :: BS.ByteString -> IO BS.ByteString +unprefix bs = do + (len, body) <- demand "invalid length prefix" (BOLT1.decode_bigsize bs) + assertEqual "length prefix" (fromIntegral len) (BS.length body) + pure body + +msat :: Word64 -> IO BOLT1.MilliSatoshi +msat = demand "invalid amount" . BOLT1.milli_satoshi + +scid :: Word32 -> Word32 -> Word16 -> IO BOLT1.ShortChannelId +scid b t o = demand "invalid scid" (BOLT1.short_channel_id b t o) + +tlvs :: [BOLT1.TlvRecord] -> IO BOLT1.TlvStream +tlvs = demand "invalid tlv stream" . BOLT1.tlv_stream + +no_tlvs :: BOLT1.TlvStream +no_tlvs = BOLT1.empty_tlv_stream + +key :: Word8 -> IO SecretKey +key b = demand "invalid secret key" (secret_key (BS.replicate 32 b)) + +ad :: BS.ByteString +ad = BS.replicate 32 0x42 + +-- a point with a valid prefix but not on the curve +off_curve :: IO BOLT1.Point +off_curve = + case [ p | x <- [0 .. 255 :: Word8] + , let bs = BS.cons 0x02 (BS.replicate 31 0 <> BS.singleton x) + , Secp256k1.parse_point bs == Nothing + , Just p <- [BOLT1.point bs] ] of + p : _ -> pure p + [] -> assertFailure "no off-curve point found" + +-- a payload with the given outgoing_cltv_value +cltv_payload :: Word32 -> HopPayload +cltv_payload c = empty_hop_payload { hp_outgoing_cltv_value = Just c } + +expect_process + :: ProcessError -> Either ProcessError ProcessResult -> Assertion +expect_process e r = case r of + Left e' -> e' @?= e + Right _ -> assertFailure ("expected " ++ show e) + +forward :: Either ProcessError ProcessResult -> IO ForwardInfo +forward r = case r of + Right (Forward f) -> pure f + Right (Receive _) -> assertFailure "expected Forward, got Receive" + Left e -> assertFailure ("process: " ++ show e) + +receive :: Either ProcessError ProcessResult -> IO ReceiveInfo +receive r = case r of + Right (Receive i) -> pure i + Right (Forward _) -> assertFailure "expected Receive, got Forward" + Left e -> assertFailure ("process: " ++ show e) + +-- A single-hop onion, built independently of the library, whose +-- decrypted hop_payloads is the given 1300-byte plaintext. +raw_onion :: SecretKey -> BS.ByteString -> IO OnionPacket +raw_onion node plain = do + let session = BS.replicate 32 0x77 + e <- demand "session" (Secp256k1.parse_int256 session) + epub <- demand "session pub" (Secp256k1.derive_pub e) + n <- demand "node pub" + (Secp256k1.parse_point (BOLT1.un_point (public_key node))) + pt <- demand "ecdh" (Secp256k1.mul n e) + let ss = SHA256.hash (Secp256k1.serialize_point pt) + derive l = let SHA256.MAC k = SHA256.hmac l ss in k + stream <- right "chacha" + (ChaCha.cipher (derive "rho") 0 (BS.replicate 12 0) + (BS.replicate 1300 0)) + let body = BS.packZipWith xor plain stream + SHA256.MAC mac = SHA256.hmac (derive "mu") (body <> ad) + pk <- demand "point" (BOLT1.point (Secp256k1.serialize_point epub)) + OnionPacket 0 pk + <$> demand "hop_payloads" (hop_payloads body) + <*> demand "hmac" (hmac32 mac) + +-- pad a plaintext region to 1300 bytes +pad1300 :: BS.ByteString -> BS.ByteString +pad1300 bs = bs <> BS.replicate (1300 - BS.length bs) 0 + +-- keys ----------------------------------------------------------------------- + +key_tests :: TestTree +key_tests = testGroup "keys" [ + testCase "secret_key accepts 32-byte keys in range" $ do + _ <- key 0x01 + sk <- demand "n - 1" . secret_key =<< unhex + "fffffffffffffffffffffffffffffffebaaedce6af48a03bbfd25e8cd0364140" + BS.length (BOLT1.un_point (public_key sk)) @?= 33 + , testCase "secret_key rejects other lengths" $ do + assertNone (secret_key (BS.replicate 31 0x01)) + assertNone (secret_key (BS.replicate 33 0x01)) + assertNone (secret_key (BS.cons 0x00 (BS.replicate 32 0x01))) + assertNone (secret_key BS.empty) + , testCase "secret_key rejects zero and keys >= n" $ do + assertNone (secret_key (BS.replicate 32 0x00)) + n <- unhex + "fffffffffffffffffffffffffffffffebaaedce6af48a03bbfd25e8cd0364141" + assertNone (secret_key n) + assertNone (secret_key (BS.replicate 32 0xff)) + , testCase "public_key matches secp256k1" $ do + sk <- key 0x41 + expected <- unhex V.onionPubKey0 + BOLT1.un_point (public_key sk) @?= expected + , testCase "shared_secret requires 32 bytes" $ do + assertNone (shared_secret (BS.replicate 31 0)) + assertNone (shared_secret (BS.replicate 33 0)) + ss <- demand "ss" (shared_secret (BS.replicate 32 7)) + un_shared_secret ss @?= BS.replicate 32 7 + , testCase "shared secrets compare by value" $ do + a <- demand "a" (shared_secret (BS.replicate 32 7)) + b <- demand "b" (shared_secret (BS.replicate 32 7)) + c <- demand "c" (shared_secret (BS.cons 8 (BS.replicate 31 7))) + assertBool "equal" (a == b) + assertBool "not equal" (a /= c) + , testCase "secrets don't show their bytes" $ do + sk <- key 0x41 + ss <- demand "ss" (shared_secret (BS.replicate 32 0x41)) + ps <- demand "ps" (payment_secret (BS.replicate 32 0x41)) + show sk @?= "SecretKey " + show ss @?= "SharedSecret " + show ps @?= "PaymentSecret " + ] + where + assertNone m = case m of + Nothing -> pure () + Just _ -> assertFailure "expected Nothing" + +-- codecs --------------------------------------------------------------------- + +codec_tests :: TestTree +codec_tests = testGroup "codecs" [ + testCase "decode_onion_packet rejects other lengths" $ do + decode_onion_packet (BS.replicate 1365 0) @?= Left InvalidLength + decode_onion_packet (BS.replicate 1367 0) @?= Left InvalidLength + decode_onion_packet BS.empty @?= Left InvalidLength + , testCase "decode_onion_packet rejects a bad point prefix" $ do + let bs = BS.concat [ BS.singleton 0, BS.singleton 0x04 + , BS.replicate 1364 0 ] + decode_onion_packet bs @?= Left InvalidPoint + , testCase "decode_onion_packet keeps the version byte" $ do + let bs = BS.concat [ BS.singleton 7, BS.singleton 0x02 + , BS.replicate 1364 0 ] + pkt <- right "decode" (decode_onion_packet bs) + onion_version pkt @?= 7 + encode_onion_packet pkt @?= bs + , testCase "smart constructors check lengths" $ do + hop_payloads (BS.replicate 1299 0) @?= Nothing + hop_payloads (BS.replicate 1301 0) @?= Nothing + hmac32 (BS.replicate 31 0) @?= Nothing + onion_hash (BS.replicate 33 0) @?= Nothing + case payment_secret (BS.replicate 31 0) of + Nothing -> pure () + Just _ -> assertFailure "short payment secret" + + , testCase "hop payload: all typed fields" $ do + amt <- msat 1000 + tot <- msat 5000 + s <- scid 1 2 3 + ps <- demand "ps" (payment_secret (BS.replicate 32 0xaa)) + pk <- hex_point V.onionPubKey0 + ex <- tlvs [BOLT1.TlvRecord 19 "x"] + let hp = HopPayload + { hp_amt_to_forward = Just amt + , hp_outgoing_cltv_value = Just 500000 + , hp_short_channel_id = Just s + , hp_payment_data = Just (PaymentData ps tot) + , hp_encrypted_data = Just "enc" + , hp_current_path_key = Just pk + , hp_payment_metadata = Just "meta" + , hp_total_amount_msat = Just tot + , hp_extra = ex + } + bs <- right "encode" (encode_hop_payload hp) + expected <- unhex $ BS.concat + [ "020203e8", "040307a120", "06080000010000020003" + , "0822", BS.concat (replicate 32 "aa"), "1388" + , "0a03656e63", "0c21", V.onionPubKey0, "10046d657461" + , "12021388", "130178" ] + bs @?= expected + decode_hop_payload bs @?= Right hp + , testCase "hop payload: zero values encode minimally" $ do + zero <- msat 0 + let hp = empty_hop_payload { hp_amt_to_forward = Just zero + , hp_outgoing_cltv_value = Just 0 } + encode_hop_payload hp @?= Right "\STX\NUL\EOT\NUL" + decode_hop_payload "\STX\NUL\EOT\NUL" @?= Right hp + , testCase "hop payload: unknown odd types are kept" $ do + hp <- right "decode" (decode_hop_payload "\STX\SOH\SOH\ETX\NUL") + ex <- tlvs [BOLT1.TlvRecord 3 ""] + hp_extra hp @?= ex + encode_hop_payload hp @?= Right "\STX\SOH\SOH\ETX\NUL" + , testCase "hop payload: rejects unknown even types" $ do + decode_hop_payload "\DC4\NUL" @?= + Left (InvalidTlvStream (BOLT1.TlvUnknownEvenType 20)) + decode_hop_payload "\SO\NUL" @?= + Left (InvalidTlvStream (BOLT1.TlvUnknownEvenType 14)) + , testCase "hop payload: rejects malformed streams" $ do + decode_hop_payload "\EOT\SOH\SOH\STX\SOH\SOH" @?= + Left (InvalidTlvStream BOLT1.TlvNotStrictlyIncreasing) + decode_hop_payload "\STX\SOH\SOH\STX\SOH\SOH" @?= + Left (InvalidTlvStream BOLT1.TlvNotStrictlyIncreasing) + decode_hop_payload "\STX\ENQ\SOH" @?= + Left (InvalidTlvStream BOLT1.TlvTruncated) + decode_hop_payload "\STX\255\255\255\255\255\255\255\255\255" @?= + Left (InvalidTlvStream BOLT1.TlvTruncated) + decode_hop_payload "\253\NUL\STX\NUL" @?= + Left (InvalidTlvStream BOLT1.TlvNonMinimalBigSize) + , testCase "hop payload: rejects malformed values" $ do + -- non-minimal tu64 and tu32 + decode_hop_payload "\STX\STX\NUL\SOH" @?= Left (InvalidTlvValue 2) + decode_hop_payload "\EOT\STX\NUL\SOH" @?= Left (InvalidTlvValue 4) + -- tu32 longer than 4 bytes + decode_hop_payload "\EOT\ENQ\SOH\SOH\SOH\SOH\SOH" @?= + Left (InvalidTlvValue 4) + -- amount above 21M BTC + decode_hop_payload "\STX\b\255\255\255\255\255\255\255\255" @?= + Left (InvalidTlvValue 2) + -- short_channel_id of 7 bytes + decode_hop_payload (BS.pack [6, 7] <> BS.replicate 7 0) @?= + Left (InvalidTlvValue 6) + -- payment_data with a 31-byte secret + decode_hop_payload (BS.pack [8, 31] <> BS.replicate 31 0) @?= + Left (InvalidTlvValue 8) + -- current_path_key of the wrong length or prefix + decode_hop_payload (BS.pack [12, 32] <> BS.replicate 32 2) @?= + Left (InvalidTlvValue 12) + decode_hop_payload (BS.pack [12, 33, 4] <> BS.replicate 32 2) @?= + Left (InvalidTlvValue 12) + -- total_amount_msat non-minimal + decode_hop_payload "\DC2\STX\NUL\SOH" @?= Left (InvalidTlvValue 18) + , testCase "hop payload: extra records may not have known types" $ do + ex <- tlvs [BOLT1.TlvRecord 16 "meta"] + encode_hop_payload empty_hop_payload { hp_extra = ex } @?= + Left ConflictingTlv + ex' <- tlvs [BOLT1.TlvRecord 2 "\SOH"] + encode_hop_payload (cltv_payload 1) { hp_extra = ex' } @?= + Left ConflictingTlv + , testCase "hop payload: extra records may have unknown even types" $ do + ex <- tlvs [BOLT1.TlvRecord 5482373484 (BS.replicate 32 1)] + bs <- right "encode" (encode_hop_payload (cltv_payload 1) + { hp_extra = ex }) + decode_hop_payload bs @?= + Left (InvalidTlvStream (BOLT1.TlvUnknownEvenType 5482373484)) + + , testCase "blinded hop data: all typed fields" $ do + s <- scid 0 0 1729 + pk <- hex_point V.rbDavePathKey + m <- msat 1500 + ex <- tlvs [BOLT1.TlvRecord 561 "\DC24V"] + let d = BlindedHopData + { bhd_padding = Just (BS.replicate 3 0) + , bhd_short_channel_id = Just s + , bhd_next_node_id = Just pk + , bhd_path_id = Just "id" + , bhd_next_path_key_override = Just pk + , bhd_payment_relay = Just (PaymentRelay 36 150 10000) + , bhd_payment_constraints = + Just (PaymentConstraints 748005 m) + , bhd_allowed_features = Just (BOLT9.parse "\STX") + , bhd_extra = ex + } + bs <- right "encode" (encode_blinded_hop_data d) + expected <- unhex $ BS.concat + [ "0103000000", "020800000000000006c1", "0421", V.rbDavePathKey + , "06026964", "0821", V.rbDavePathKey, "0a080024000000962710" + , "0c06000b69e505dc", "0e0102", "fd023103123456" ] + bs @?= expected + decode_blinded_hop_data bs @?= Right d + , testCase "blinded hop data: unknown types" $ do + decode_blinded_hop_data "\DLE\NUL" @?= + Left (InvalidTlvStream (BOLT1.TlvUnknownEvenType 16)) + d <- right "decode" (decode_blinded_hop_data "\ETX\NUL") + ex <- tlvs [BOLT1.TlvRecord 3 ""] + bhd_extra d @?= ex + , testCase "blinded hop data: rejects malformed values" $ do + -- payment_relay shorter than its fixed fields + decode_blinded_hop_data "\n\ENQ\NUL\NUL\NUL\NUL\NUL" @?= + Left (InvalidTlvValue 10) + -- payment_relay with a non-minimal fee_base_msat + decode_blinded_hop_data "\n\a\NUL\NUL\NUL\NUL\NUL\NUL\NUL" @?= + Left (InvalidTlvValue 10) + -- payment_constraints shorter than its fixed fields + decode_blinded_hop_data "\f\ETX\NUL\NUL\NUL" @?= + Left (InvalidTlvValue 12) + -- next_node_id and next_path_key_override of the wrong length + decode_blinded_hop_data (BS.pack [4, 2, 2, 2]) @?= + Left (InvalidTlvValue 4) + decode_blinded_hop_data (BS.pack [8, 2, 2, 2]) @?= + Left (InvalidTlvValue 8) + -- short_channel_id of 9 bytes + decode_blinded_hop_data (BS.pack [2, 9] <> BS.replicate 9 0) @?= + Left (InvalidTlvValue 2) + , testCase "blinded hop data: extra records may not have known types" $ do + ex <- tlvs [BOLT1.TlvRecord 1 ""] + encode_blinded_hop_data empty_blinded_hop_data { bhd_extra = ex } @?= + Left ConflictingTlv + ] + +-- failure messages ----------------------------------------------------------- + +failure_tests :: TestTree +failure_tests = testGroup "failure messages" [ + testCase "encodings and codes of every failure" $ do + h <- demand "hash" (onion_hash (BS.replicate 32 0xab)) + m <- msat 100 + let hh = BS.concat (replicate 32 "ab") + cases = + [ (TemporaryNodeFailure, "2002") + , (PermanentNodeFailure, "6002") + , (RequiredNodeFeatureMissing, "6003") + , (InvalidOnionVersion h, "c004" <> hh) + , (InvalidOnionHmac h, "c005" <> hh) + , (InvalidOnionKey h, "c006" <> hh) + , (TemporaryChannelFailure "cu", "100700026375") + , (PermanentChannelFailure, "4008") + , (RequiredChannelFeatureMissing, "4009") + , (UnknownNextPeer, "400a") + , (AmountBelowMinimum m "", "100b00000000000000640000") + , (FeeInsufficient m "cu", "100c000000000000006400026375") + , (IncorrectCltvExpiry 800000 "", "100d000c35000000") + , (ExpiryTooSoon "", "100e0000") + , ( IncorrectOrUnknownPaymentDetails m 800000 + , "400f0000000000000064000c3500" ) + , (FinalIncorrectCltvExpiry 800000, "0012000c3500") + , (FinalIncorrectHtlcAmount m, "00130000000000000064") + , (ChannelDisabled 0 "", "101400000000") + , (ExpiryTooFar, "0015") + , (InvalidOnionPayload Nothing, "4016") + , (InvalidOnionPayload (Just (2, 7)), "401602 0007") + , (MppTimeout, "0017") + , (InvalidOnionBlinding h, "c018" <> hh) + , (UnknownFailure 0x0042 "data", "004264617461") + ] + forM_ cases $ \(f, hx) -> do + bs <- unhex (BS.filter (/= 0x20) hx) + let fm = FailureMessage f no_tlvs + encode_failure_message fm @?= Right bs + decode_failure_message bs @?= Right fm + Just (failure_code f) @?= fmap fst (BOLT1.decode_u16 bs) + , testCase "flags" $ do + h <- demand "hash" (onion_hash (BS.replicate 32 0)) + let flags f = (is_badonion f, is_perm f, is_node f, is_update f) + flags TemporaryNodeFailure @?= (False, False, True, False) + flags PermanentNodeFailure @?= (False, True, True, False) + flags (InvalidOnionBlinding h) @?= (True, True, False, False) + flags (ExpiryTooSoon "") @?= (False, False, False, True) + flags MppTimeout @?= (False, False, False, False) + flags (UnknownFailure 0xf000 "") @?= (True, True, True, True) + , testCase "spec example: incorrect_or_unknown_payment_details" $ do + bs <- unhex "400f0000000000000064000c3500" + m <- msat 100 + decode_failure_message bs @?= Right + (FailureMessage (IncorrectOrUnknownPaymentDetails m 800000) no_tlvs) + , testCase "a trailing TLV stream is kept" $ do + ex <- tlvs [BOLT1.TlvRecord 34001 (BS.replicate 3 0x80)] + let fm = FailureMessage TemporaryNodeFailure ex + bs <- right "encode" (encode_failure_message fm) + bs @?= "\x20\x02\xfd\x84\xd1\x03\x80\x80\x80" + decode_failure_message bs @?= Right fm + , testCase "other trailing bytes are ignored" $ do + let ignored f bs = decode_failure_message bs @?= + Right (FailureMessage f no_tlvs) + ignored TemporaryNodeFailure "\x20\x02\xff" + -- an even type: not a valid stream without known types + ignored TemporaryNodeFailure "\x20\x02\x02\x00" + ignored (FinalIncorrectCltvExpiry 1) "\NUL\DC2\NUL\NUL\NUL\SOH\SOH" + , testCase "truncated data is rejected" $ do + decode_failure_message "" @?= Left InvalidLength + decode_failure_message "\x20" @?= Left InvalidLength + decode_failure_message "\xc0\x05\x00" @?= + Left (InvalidFailureData 0xc005) + decode_failure_message "\x10\x07\x00\x02\x00" @?= + Left (InvalidFailureData 0x1007) + decode_failure_message "\x40\x0f\x00\x00\x00\x00\x00\x00\x00\x64" @?= + Left (InvalidFailureData 0x400f) + decode_failure_message "\x00\x13\x00" @?= + Left (InvalidFailureData 0x0013) + decode_failure_message "\x10\x14\x00\x00\x00" @?= + Left (InvalidFailureData 0x1014) + , testCase "amounts above 21M BTC are rejected" $ + decode_failure_message "\x00\x13\xff\xff\xff\xff\xff\xff\xff\xff" @?= + Left (InvalidFailureData 0x0013) + , testCase "unknown codes keep their data" $ + decode_failure_message "\x12\x34\x01\x00" @?= + Right (FailureMessage (UnknownFailure 0x1234 "\x01\x00") no_tlvs) + , testCase "channel_update longer than 65535 bytes" $ + encode_failure_message + (FailureMessage (ExpiryTooSoon (BS.replicate 65536 0)) no_tlvs) + @?= Left FieldTooLong + ] + +-- construct ------------------------------------------------------------------ + +construct_tests :: TestTree +construct_tests = testGroup "construct" [ + testCase "empty route" $ do + sk <- key 0x41 + assertConstructError EmptyRoute (construct sk [] ad) + , testCase "more than 20 hops" $ do + sk <- key 0x41 + node <- key 0x42 + let hop = Hop (public_key node) (cltv_payload 1) + assertConstructError TooManyHops (construct sk (replicate 21 hop) ad) + case construct sk (replicate 20 hop) ad of + Right (_, sss) -> length sss @?= 20 + Left e -> assertFailure (show e) + , testCase "invalid hop public key" $ do + sk <- key 0x41 + node <- key 0x42 + bad <- off_curve + let good = Hop (public_key node) (cltv_payload 1) + assertConstructError (InvalidHopPubKey 1) + (construct sk [good, Hop bad (cltv_payload 1), good] ad) + , testCase "payloads under 2 bytes" $ do + sk <- key 0x41 + node <- key 0x42 + let good = Hop (public_key node) (cltv_payload 1) + assertConstructError (InvalidHopPayload 1) + (construct sk [good, Hop (public_key node) empty_hop_payload] ad) + , testCase "unencodable payload" $ do + sk <- key 0x41 + node <- key 0x42 + ex <- tlvs [BOLT1.TlvRecord 4 "\SOH"] + let bad = Hop (public_key node) empty_hop_payload { hp_extra = ex } + assertConstructError (InvalidHopPayload 0) (construct sk [bad] ad) + , testCase "payloads over 1300 bytes" $ do + sk <- key 0x41 + node <- key 0x42 + -- a 1265-byte payload exactly fills hop_payloads + ex <- tlvs [BOLT1.TlvRecord 1 (BS.replicate 1261 0)] + let full = Hop (public_key node) empty_hop_payload { hp_extra = ex } + case construct sk [full] ad of + Right _ -> pure () + Left e -> assertFailure (show e) + ex' <- tlvs [BOLT1.TlvRecord 1 (BS.replicate 1262 0)] + let over = Hop (public_key node) empty_hop_payload { hp_extra = ex' } + assertConstructError (PayloadsTooLarge 1301) (construct sk [over] ad) + let hops = replicate 2 (Hop (public_key node) (cltv_payload 1)) + assertConstructError (PayloadsTooLarge 1372) + (construct sk (full : hops) ad) + ] + where + assertConstructError e r = case r of + Left e' -> e' @?= e + Right _ -> assertFailure ("expected " ++ show e) + +-- process -------------------------------------------------------------------- + +process_tests :: TestTree +process_tests = testGroup "process" [ + testCase "rejects versions other than 0" $ do + (node, pkt) <- simple_onion + expect_process (InvalidVersion 1) + (process node pkt { onion_version = 1 } ad Nothing) + , testCase "rejects a public key not on the curve" $ do + (node, pkt) <- simple_onion + bad <- off_curve + expect_process InvalidPublicKey + (process node pkt { onion_public_key = bad } ad Nothing) + , testCase "rejects a wrong HMAC" $ do + (node, pkt) <- simple_onion + flipped <- demand "flip" $ + case BS.uncons (un_hop_payloads (onion_hop_payloads pkt)) of + Just (h, t) -> hop_payloads (BS.cons (h `xor` 1) t) + Nothing -> Nothing + expect_process HmacMismatch + (process node pkt { onion_hop_payloads = flipped } ad Nothing) + mac <- demand "mac" (hmac32 (BS.replicate 32 0)) + expect_process HmacMismatch + (process node pkt { onion_hmac = mac } ad Nothing) + , testCase "rejects other associated data" $ do + (node, pkt) <- simple_onion + expect_process HmacMismatch + (process node pkt (BS.replicate 32 0) Nothing) + , testCase "rejects other node keys" $ do + (_, pkt) <- simple_onion + other <- key 0x44 + expect_process HmacMismatch (process other pkt ad Nothing) + , testCase "rejects payload lengths 0 and 1" $ do + node <- key 0x42 + p0 <- raw_onion node (pad1300 "\NUL") + expect_process InvalidPayloadLength (process node p0 ad Nothing) + p1 <- raw_onion node (pad1300 "\SOH\SOH") + expect_process InvalidPayloadLength (process node p1 ad Nothing) + , testCase "rejects a malformed length prefix" $ do + node <- key 0x42 + p <- raw_onion node (pad1300 "\253\NUL\DLE") + expect_process InvalidPayloadLength (process node p ad Nothing) + , testCase "rejects payloads past the end of hop_payloads" $ do + node <- key 0x42 + -- 3-byte prefix, 1265-byte payload and 32-byte HMAC fill it + let rec n = BS.concat [ "\SOH\253", BOLT1.encode_u16 n + , BS.replicate (fromIntegral n) 0 ] + ok <- raw_onion node (pad1300 ("\253\EOT\241" <> rec 1261)) + _ <- receive (process node ok ad Nothing) + over <- raw_onion node (pad1300 ("\253\EOT\242" <> rec 1262)) + expect_process InvalidPayloadLength (process node over ad Nothing) + -- a length reaching into the zero-extended stream + far <- raw_onion node (pad1300 ("\253\a\208" <> rec 1261)) + expect_process InvalidPayloadLength (process node far ad Nothing) + huge <- raw_onion node + (pad1300 ("\255\128\NUL\NUL\NUL\NUL\NUL\NUL\NUL" <> rec 1)) + expect_process InvalidPayloadLength (process node huge ad Nothing) + , testCase "rejects malformed payloads" $ do + node <- key 0x42 + let bad pl = raw_onion node + (pad1300 (BOLT1.encode_bigsize (fromIntegral (BS.length pl)) + <> pl)) + p0 <- bad "\EOT\SOH\SOH\STX\SOH\SOH" + expect_process + (InvalidPayload (InvalidTlvStream BOLT1.TlvNotStrictlyIncreasing)) + (process node p0 ad Nothing) + p1 <- bad "\DC4\NUL" + expect_process + (InvalidPayload (InvalidTlvStream (BOLT1.TlvUnknownEvenType 20))) + (process node p1 ad Nothing) + p2 <- bad "\STX\STX\NUL\SOH" + expect_process (InvalidPayload (InvalidTlvValue 2)) + (process node p2 ad Nothing) + , testCase "the final hop receives" $ do + (node, pkt) <- simple_onion + info <- receive (process node pkt ad Nothing) + rcv_payload info @?= cltv_payload 144 + rcv_blinded info @?= Nothing + , testCase "forwarded packets are well formed" $ do + sk <- key 0x41 + a <- key 0x42 + b <- key 0x43 + (pkt, sss) <- right "construct" $ construct sk + [Hop (public_key a) (cltv_payload 1), Hop (public_key b) + (cltv_payload 2)] ad + fwd <- forward (process a pkt ad Nothing) + let next = fwd_next_packet fwd + onion_version next @?= 0 + decode_onion_packet (encode_onion_packet next) @?= Right next + Just (fwd_shared_secret fwd) @?= safe_head sss + rcv <- receive (process b next ad Nothing) + rcv_payload rcv @?= cltv_payload 2 + , testCase "path keys without encrypted_recipient_data" $ do + sk <- key 0x41 + alice <- key 0x42 + seed <- key 0x01 + path <- right "path" $ + create_blinded_path seed [(public_key alice, empty_blinded_hop_data)] + bid <- blinded_id path 0 + let pk = bp_first_path_key path + -- a path_key, onion encrypted to the blinded id + (p0, _) <- right "construct" $ + construct sk [Hop bid (cltv_payload 1)] ad + expect_process UnexpectedPathKey (process alice p0 ad (Just pk)) + -- a current_path_key + let pl = (cltv_payload 1) { hp_current_path_key = Just pk } + (p1, _) <- right "construct" $ + construct sk [Hop (public_key alice) pl] ad + expect_process UnexpectedPathKey (process alice p1 ad Nothing) + , testCase "both a path_key and a current_path_key" $ do + sk <- key 0x41 + alice <- key 0x42 + seed <- key 0x01 + path <- right "path" $ + create_blinded_path seed [(public_key alice, empty_blinded_hop_data)] + bid <- blinded_id path 0 + enc <- blinded_data path 0 + let pk = bp_first_path_key path + pl = empty_hop_payload { hp_encrypted_data = Just enc + , hp_current_path_key = Just pk } + (pkt, _) <- right "construct" $ construct sk [Hop bid pl] ad + expect_process UnexpectedPathKey (process alice pkt ad (Just pk)) + , testCase "encrypted_recipient_data without a path key" $ do + sk <- key 0x41 + alice <- key 0x42 + let pl = empty_hop_payload { hp_encrypted_data = Just "data" } + (pkt, _) <- right "construct" $ + construct sk [Hop (public_key alice) pl] ad + expect_process MissingPathKey (process alice pkt ad Nothing) + , testCase "undecryptable encrypted_recipient_data" $ do + sk <- key 0x41 + alice <- key 0x42 + pk <- hex_point V.rbBobPathKey + let pl = empty_hop_payload { hp_encrypted_data = Just + (BS.replicate 40 0) + , hp_current_path_key = Just pk } + (pkt, _) <- right "construct" $ + construct sk [Hop (public_key alice) pl] ad + expect_process InvalidRecipientData (process alice pkt ad Nothing) + , testCase "invalid path keys" $ do + sk <- key 0x41 + alice <- key 0x42 + bad <- off_curve + let pl = empty_hop_payload { hp_encrypted_data = Just "data" + , hp_current_path_key = Just bad } + (pkt, _) <- right "construct" $ + construct sk [Hop (public_key alice) pl] ad + expect_process InvalidPathKey (process alice pkt ad Nothing) + (pkt', _) <- right "construct" $ + construct sk [Hop (public_key alice) (cltv_payload 1)] ad + expect_process InvalidPathKey (process alice pkt' ad (Just bad)) + ] + where + simple_onion = do + sk <- key 0x41 + node <- key 0x42 + (pkt, _) <- right "construct" $ + construct sk [Hop (public_key node) (cltv_payload 144)] ad + pure (node, pkt) + +three :: [a] -> IO (a, a, a) +three xs = case xs of + [a, b, c] -> pure (a, b, c) + _ -> assertFailure "expected three elements" + +safe_head :: [a] -> Maybe a +safe_head xs = case xs of + x : _ -> Just x + [] -> Nothing + +safe_index :: [a] -> Int -> Maybe a +safe_index xs i = safe_head (drop i xs) + +blinded_id :: BlindedPath -> Int -> IO BOLT1.Point +blinded_id p i = + demand "blinded hop" (bh_blinded_node_id <$> safe_index (bp_hops p) i) + +blinded_data :: BlindedPath -> Int -> IO BS.ByteString +blinded_data p i = + demand "blinded hop" (bh_encrypted_data <$> safe_index (bp_hops p) i) + +-- route blinding ------------------------------------------------------------- + +blinding_tests :: TestTree +blinding_tests = testGroup "route blinding" [ + testCase "empty path" $ do + seed <- key 0x01 + create_blinded_path seed [] @?= Left EmptyPath + , testCase "invalid node id" $ do + seed <- key 0x01 + alice <- key 0x42 + bad <- off_curve + create_blinded_path seed + [ (public_key alice, empty_blinded_hop_data) + , (bad, empty_blinded_hop_data) ] + @?= Left (InvalidNodeId 1) + , testCase "unencodable hop data" $ do + seed <- key 0x01 + alice <- key 0x42 + ex <- tlvs [BOLT1.TlvRecord 6 "id"] + create_blinded_path seed + [(public_key alice, empty_blinded_hop_data { bhd_extra = ex })] + @?= Left (InvalidHopData 0 ConflictingTlv) + , testCase "decrypt_recipient_data rejects bad input" $ do + seed <- key 0x01 + alice <- key 0x42 + bob <- key 0x43 + path <- right "path" $ + create_blinded_path seed [(public_key alice, empty_blinded_hop_data)] + enc <- blinded_data path 0 + let pk = bp_first_path_key path + _ <- right "decrypt" (decrypt_recipient_data alice pk enc) + decrypt_recipient_data bob pk enc @?= Left InvalidRecipientData + decrypt_recipient_data alice pk (BS.take 15 enc) @?= + Left InvalidRecipientData + decrypt_recipient_data alice pk (BS.drop 1 enc) @?= + Left InvalidRecipientData + bad <- off_curve + decrypt_recipient_data alice bad enc @?= Left InvalidPathKey + , testCase "unknown even types in encrypted data are rejected" $ do + seed <- key 0x01 + alice <- key 0x42 + ex <- tlvs [BOLT1.TlvRecord 20 ""] + path <- right "path" $ create_blinded_path seed + [(public_key alice, empty_blinded_hop_data { bhd_extra = ex })] + enc <- blinded_data path 0 + decrypt_recipient_data alice (bp_first_path_key path) enc @?= + Left InvalidRecipientData + , testCase "a payment through a blinded route" $ do + -- Carol creates a route Alice -> Bob -> Carol; Dave pays through it, + -- reaching Alice unblinded with current_path_key. + seed <- key 0x01 + session <- key 0x02 + alice <- key 0x42 + bob <- key 0x43 + carol <- key 0x44 + s1 <- scid 1 1 1 + s2 <- scid 2 2 2 + m <- msat 1 + let relay = Just (PaymentRelay 40 100 1000) + cons = Just (PaymentConstraints 900000 m) + alice_data = empty_blinded_hop_data + { bhd_short_channel_id = Just s1, bhd_payment_relay = relay + , bhd_payment_constraints = cons } + bob_data = empty_blinded_hop_data + { bhd_short_channel_id = Just s2, bhd_payment_relay = relay + , bhd_payment_constraints = cons } + carol_data = empty_blinded_hop_data + { bhd_path_id = Just "invoice" } + path <- right "path" $ create_blinded_path seed + [ (public_key alice, alice_data), (public_key bob, bob_data) + , (public_key carol, carol_data) ] + bp_first_node_id path @?= public_key alice + bp_first_path_key path @?= public_key seed + (e0, e1, e2) <- three =<< mapM (blinded_data path) [0, 1, 2] + (_, b1, b2) <- three =<< mapM (blinded_id path) [0, 1, 2] + amt <- msat 5000 + let intro = empty_hop_payload + { hp_encrypted_data = Just e0 + , hp_current_path_key = Just (bp_first_path_key path) } + final = empty_hop_payload + { hp_encrypted_data = Just e2, hp_amt_to_forward = Just amt + , hp_outgoing_cltv_value = Just 800000 + , hp_total_amount_msat = Just amt } + route = [ Hop (public_key alice) intro + , Hop b1 empty_hop_payload { hp_encrypted_data = Just e1 } + , Hop b2 final ] + (pkt, sss) <- right "construct" (construct session route ad) + fa <- forward (process alice pkt ad Nothing) + ia <- demand "alice blinded" (fwd_blinded fa) + bi_data ia @?= alice_data + fb <- forward (process bob (fwd_next_packet fa) ad + (Just (bi_next_path_key ia))) + ib <- demand "bob blinded" (fwd_blinded fb) + bi_data ib @?= bob_data + rc <- receive (process carol (fwd_next_packet fb) ad + (Just (bi_next_path_key ib))) + ic <- demand "carol blinded" (rcv_blinded rc) + bi_data ic @?= carol_data + rcv_payload rc @?= final + [fwd_shared_secret fa, fwd_shared_secret fb, rcv_shared_secret rc] + @?= sss + -- the wrong path key yields the wrong blinded key + expect_process HmacMismatch + (process bob (fwd_next_packet fa) ad + (Just (bp_first_path_key path))) + ] + +-- returning errors ----------------------------------------------------------- + +error_tests :: TestTree +error_tests = testGroup "returning errors" [ + testCase "padding brings failure_len + pad_len to 256" $ do + ss <- demand "ss" (shared_secret (BS.replicate 32 1)) + let fm = FailureMessage TemporaryNodeFailure no_tlvs + pkt <- right "construct_error" (construct_error ss fm) + let ErrorPacket raw = wrap_error ss pkt + BS.length raw @?= 32 + 2 + 2 + 2 + 254 + BS.take 4 (BS.drop 32 raw) @?= "\NUL\STX\x20\x02" + BS.take 2 (BS.drop 36 raw) @?= "\NUL\254" + , testCase "long failure messages are not padded" $ do + ss <- demand "ss" (shared_secret (BS.replicate 32 1)) + ex <- tlvs [BOLT1.TlvRecord 1 (BS.replicate 300 0)] + let fm = FailureMessage TemporaryNodeFailure ex + ErrorPacket raw <- wrap_error ss <$> + right "construct_error" (construct_error ss fm) + BS.length raw @?= 32 + 2 + 306 + 2 + BS.drop (32 + 2 + 306) raw @?= "\NUL\NUL" + , testCase "failure messages over 65535 bytes" $ do + ss <- demand "ss" (shared_secret (BS.replicate 32 1)) + ex <- tlvs [BOLT1.TlvRecord 1 (BS.replicate 65535 0)] + construct_error ss (FailureMessage TemporaryNodeFailure ex) + @?= Left FieldTooLong + , testCase "attributes the failing hop" $ do + sss <- mapM (\b -> demand "ss" (shared_secret (BS.replicate 32 b))) + [1 .. 5] + let fm = FailureMessage PermanentChannelFailure no_tlvs + forM_ (zip [0 ..] sss) $ \(i, ss) -> do + pkt <- right "construct_error" (construct_error ss fm) + let back = foldr wrap_error pkt (take i sss) + unwrap_error sss back @?= Attributed i fm + , testCase "reports the hop of a malformed failure" $ do + sss <- mapM (\b -> demand "ss" (shared_secret (BS.replicate 32 b))) + [1 .. 3] + ss2 <- demand "ss2" (safe_index sss 2) + -- incorrect_cltv_expiry with no data + let fm = FailureMessage (UnknownFailure 0x100d "") no_tlvs + pkt <- right "construct_error" (construct_error ss2 fm) + let back = foldr wrap_error pkt (take 2 sss) + unwrap_error sss back @?= MalformedFailure 2 + , testCase "reports a malformed return packet" $ do + ss <- demand "ss" (shared_secret (BS.replicate 32 1)) + -- a valid HMAC over a body whose failure_len overruns it + let body = "\SOH\NUL\x20\x02" + SHA256.MAC um = SHA256.hmac "um" (un_shared_secret ss) + SHA256.MAC mac = SHA256.hmac um body + pkt = wrap_error ss (ErrorPacket (mac <> body)) + unwrap_error [ss] pkt @?= MalformedFailure 0 + , testCase "unknown origin" $ do + sss <- mapM (\b -> demand "ss" (shared_secret (BS.replicate 32 b))) + [1 .. 3] + other <- demand "ss" (shared_secret (BS.replicate 32 9)) + let fm = FailureMessage TemporaryNodeFailure no_tlvs + pkt <- right "construct_error" (construct_error other fm) + unwrap_error sss pkt @?= UnknownOrigin + unwrap_error [] pkt @?= UnknownOrigin + unwrap_error sss (ErrorPacket "short") @?= UnknownOrigin + ] + +-- spec vectors: onion-test.json ---------------------------------------------- + +onion_hops :: IO [(SecretKey, BOLT1.Point, BS.ByteString)] +onion_hops = mapM hop + [ (V.onionNodeKey0, V.onionPubKey0, V.onionPayload0) + , (V.onionNodeKey1, V.onionPubKey1, V.onionPayload1) + , (V.onionNodeKey2, V.onionPubKey2, V.onionPayload2) + , (V.onionNodeKey3, V.onionPubKey3, V.onionPayload3) + , (V.onionNodeKey4, V.onionPubKey4, V.onionPayload4) + ] + where + hop (k, p, pl) = (,,) <$> hex_key k <*> hex_point p + <*> (unhex pl >>= unprefix) + +-- the shared secrets of the onion-test.json route, as listed in +-- onion-error-test.json +route_secrets :: IO [SharedSecret] +route_secrets = mapM hex_secret + [ V.errSharedSecret0, V.errSharedSecret1, V.errSharedSecret2 + , V.errSharedSecret3, V.errSharedSecret4 ] + +onion_vectors :: TestTree +onion_vectors = testGroup "onion-test.json" [ + testCase "construct reproduces the onion" $ do + hops <- onion_hops + sk <- hex_key V.onionSessionKey + assoc <- unhex V.onionAssocData + expected <- unhex V.onionPacket + sss <- route_secrets + route <- mapM (\(_, pub, body) -> do + hp <- right "decode_hop_payload" (decode_hop_payload body) + encode_hop_payload hp @?= Right body + pure (Hop pub hp)) hops + (pkt, secrets) <- right "construct" (construct sk route assoc) + encode_onion_packet pkt @?= expected + secrets @?= sss + , testCase "process peels the onion at every hop" $ do + hops <- onion_hops + assoc <- unhex V.onionAssocData + sss <- route_secrets + pkt <- unhex V.onionPacket >>= right "decode" . decode_onion_packet + let go [] _ = assertFailure "no hops" + go [((k, _, body), ss)] p = do + r <- receive (process k p assoc Nothing) + encode_hop_payload (rcv_payload r) @?= Right body + rcv_shared_secret r @?= ss + go (((k, _, body), ss) : rest) p = do + f <- forward (process k p assoc Nothing) + encode_hop_payload (fwd_payload f) @?= Right body + fwd_shared_secret f @?= ss + fwd_blinded f @?= Nothing + go rest (fwd_next_packet f) + go (zip hops sss) pkt + ] + +-- spec vectors: onion-error-test.json ---------------------------------------- + +-- the failing node's shared secret, and those of the hops back to the +-- origin, from hop 3 to hop 0 +error_wrappers :: IO (SharedSecret, [SharedSecret]) +error_wrappers = do + sss <- route_secrets + case reverse sss of + ss4 : rest -> pure (ss4, rest) + [] -> assertFailure "no shared secrets" + +error_vectors :: TestTree +error_vectors = testGroup "onion-error-test.json" [ + testCase "failure message" $ do + msg <- unhex V.errFailureMessage + let fm = FailureMessage TemporaryNodeFailure no_tlvs + encode_failure_message fm @?= Right msg + decode_failure_message msg @?= Right fm + , testCase "the failing node's return packet" $ do + (ss4, _) <- error_wrappers + payload <- unhex V.errPayload4 + let fm = FailureMessage TemporaryNodeFailure no_tlvs + pkt <- right "construct_error" (construct_error ss4 fm) + -- removing hop 4's obfuscation leaves the HMAC and payload + let ErrorPacket raw = wrap_error ss4 pkt + BS.drop 32 raw @?= payload + , testCase "wrapping at each hop yields the returned packet" $ do + (ss4, wrappers) <- error_wrappers + expected <- unhex V.errPacket + let fm = FailureMessage TemporaryNodeFailure no_tlvs + pkt <- right "construct_error" (construct_error ss4 fm) + foldl (flip wrap_error) pkt wrappers @?= ErrorPacket expected + , testCase "the origin attributes the packet to hop 4" $ do + sss <- route_secrets + pkt <- unhex V.errPacket + unwrap_error sss (ErrorPacket pkt) @?= + Attributed 4 (FailureMessage TemporaryNodeFailure no_tlvs) + ] + +-- spec vectors: 'Returning Errors' trace ------------------------------------- + +trace_failure :: IO FailureMessage +trace_failure = do + m <- msat 100 + ex <- tlvs [BOLT1.TlvRecord 34001 (BS.replicate 300 0x80)] + pure (FailureMessage (IncorrectOrUnknownPaymentDetails m 800000) ex) + +trace_vectors :: TestTree +trace_vectors = testGroup "returning errors trace" [ + testCase "failure message encoding" $ do + fm <- trace_failure + -- the trace lists failuremsg || pad_len || pad + encoded <- unhex V.traceFailureMessage + msg <- right "encode" (encode_failure_message fm) + BS.length msg @?= 320 + BS.take 320 encoded @?= msg + decode_failure_message msg @?= Right fm + , testCase "each hop's packet matches the trace" $ do + (ss4, wrappers) <- error_wrappers + raw <- unhex V.traceRawPacket + expected <- mapM unhex + [ V.tracePacket4, V.tracePacket3, V.tracePacket2 + , V.tracePacket1, V.tracePacket0 ] + let packets = drop 1 $ + scanl (flip wrap_error) (ErrorPacket raw) (ss4 : wrappers) + packets @?= map ErrorPacket expected + , testCase "the origin attributes the packet to hop 4" $ do + fm <- trace_failure + sss <- route_secrets + pkt <- unhex V.tracePacket0 + unwrap_error sss (ErrorPacket pkt) @?= Attributed 4 fm + ] + +-- spec vectors: route-blinding-test.json ------------------------------------- + +empty_features :: Maybe BOLT9.FeatureVector +empty_features = Just (BOLT9.parse BS.empty) + +rb_bob_data :: IO BlindedHopData +rb_bob_data = do + s <- scid 0 0 1729 + m <- msat 1500 + ex <- tlvs [BOLT1.TlvRecord 561 "\DC24V"] + pure empty_blinded_hop_data + { bhd_padding = Just (BS.replicate 26 0) + , bhd_short_channel_id = Just s + , bhd_payment_relay = Just (PaymentRelay 36 150 10000) + , bhd_payment_constraints = Just (PaymentConstraints 748005 m) + , bhd_allowed_features = empty_features + , bhd_extra = ex + } + +rb_carol_data :: IO BlindedHopData +rb_carol_data = do + s <- scid 0 0 1105 + m <- msat 1500 + override <- hex_point V.rbDavePathKey + pure empty_blinded_hop_data + { bhd_short_channel_id = Just s + , bhd_next_path_key_override = Just override + , bhd_payment_relay = Just (PaymentRelay 48 100 500) + , bhd_payment_constraints = Just (PaymentConstraints 747969 m) + , bhd_allowed_features = empty_features + } + +rb_dave_data :: IO BlindedHopData +rb_dave_data = do + s <- scid 0 0 561 + m <- msat 1500 + pure empty_blinded_hop_data + { bhd_padding = Just (BS.replicate 35 0) + , bhd_short_channel_id = Just s + , bhd_payment_relay = Just (PaymentRelay 144 250 0) + , bhd_payment_constraints = Just (PaymentConstraints 747921 m) + , bhd_allowed_features = empty_features + } + +rb_eve_data :: IO BlindedHopData +rb_eve_data = do + m <- msat 1500 + ex <- tlvs [BOLT1.TlvRecord 65535 "\ACK\193"] + pure empty_blinded_hop_data + { bhd_padding = Just (BS.replicate 26 0) + , bhd_path_id = Just "\222\173\190\239" + , bhd_payment_constraints = Just (PaymentConstraints 747777 m) + , bhd_allowed_features = + Just (BOLT9.parse (BS.cons 0x02 (BS.replicate 14 0))) + , bhd_extra = ex + } + +-- a hop of route-blinding-test.json +data RbHop = RbHop + { rb_data :: !BlindedHopData + , rb_node_id :: !BOLT1.Point + , rb_tlvs :: !BS.ByteString + , rb_path_key :: !BOLT1.Point + , rb_encrypted :: !BS.ByteString + , rb_blinded_id :: !BOLT1.Point + , rb_node_key :: !SecretKey + , rb_next_path_key :: !BOLT1.Point + } + +rb_hops :: IO [RbHop] +rb_hops = sequence + [ hop rb_bob_data + ( V.rbBobNodeId, V.rbBobTlvs, V.rbBobPathKey + , V.rbBobEncryptedData, V.rbBobBlindedNodeId ) + (V.rbBobNodeKey, V.rbBobNextPathKey) + , hop rb_carol_data + ( V.rbCarolNodeId, V.rbCarolTlvs, V.rbCarolPathKey + , V.rbCarolEncryptedData, V.rbCarolBlindedNodeId ) + (V.rbCarolNodeKey, V.rbCarolNextPathKey) + , hop rb_dave_data + ( V.rbDaveNodeId, V.rbDaveTlvs, V.rbDavePathKey + , V.rbDaveEncryptedData, V.rbDaveBlindedNodeId ) + (V.rbDaveNodeKey, V.rbDaveNextPathKey) + , hop rb_eve_data + ( V.rbEveNodeId, V.rbEveTlvs, V.rbEvePathKey + , V.rbEveEncryptedData, V.rbEveBlindedNodeId ) + (V.rbEveNodeKey, V.rbEveNextPathKey) + ] + where + hop mk (nid, tl, pk, enc, bid) (nk, npk) = + RbHop <$> mk <*> hex_point nid <*> unhex tl <*> hex_point pk + <*> unhex enc <*> hex_point bid <*> hex_key nk + <*> hex_point npk + +route_blinding_vectors :: TestTree +route_blinding_vectors = testGroup "route-blinding-test.json" [ + testCase "encrypted_data_tlv encodings" $ do + hops <- rb_hops + forM_ hops $ \h -> do + encode_blinded_hop_data (rb_data h) @?= Right (rb_tlvs h) + decode_blinded_hop_data (rb_tlvs h) @?= Right (rb_data h) + , testCase "create_blinded_path reproduces the route" $ do + hops <- rb_hops + (bob, carol, dave, eve) <- case hops of + [b, c, d, e] -> pure (b, c, d, e) + _ -> assertFailure "expected 4 hops" + -- Bob creates Bob -> Carol, Eve creates Dave -> Eve + bob_seed <- hex_key V.rbBobPathPrivKey + dave_seed <- hex_key V.rbDavePathPrivKey + let check seed hs = do + path <- right "create_blinded_path" $ create_blinded_path seed + [ (rb_node_id h, rb_data h) | h <- hs ] + case hs of + h : _ -> do + bp_first_node_id path @?= rb_node_id h + bp_first_path_key path @?= rb_path_key h + [] -> assertFailure "no hops" + bp_hops path @?= + [ BlindedHop (rb_blinded_id h) (rb_encrypted h) | h <- hs ] + check bob_seed [bob, carol] + check dave_seed [dave, eve] + , testCase "each hop decrypts its data and next path key" $ do + hops <- rb_hops + forM_ hops $ \h -> do + info <- right "decrypt_recipient_data" $ + decrypt_recipient_data (rb_node_key h) (rb_path_key h) + (rb_encrypted h) + bi_data info @?= rb_data h + encode_blinded_hop_data (bi_data info) @?= Right (rb_tlvs h) + -- Carol's next path key is her next_path_key_override + bi_next_path_key info @?= rb_next_path_key h + , testCase "each hop decrypts an onion to its blinded id" $ do + -- the onion is encrypted to blinded_node_id, so processing it + -- requires the blinded private key of the vector + hops <- rb_hops + session <- key 0x55 + forM_ hops $ \h -> do + let pl = empty_hop_payload + { hp_encrypted_data = Just (rb_encrypted h) } + (pkt, sss) <- right "construct" $ + construct session [Hop (rb_blinded_id h) pl] ad + r <- receive (process (rb_node_key h) pkt ad (Just (rb_path_key h))) + Just (rcv_shared_secret r) @?= safe_head sss + fmap bi_next_path_key (rcv_blinded r) @?= Just (rb_next_path_key h) + ] + +-- spec vectors: blinded-payment-onion-test.json ------------------------------ + +bp_bob_data :: IO BlindedHopData +bp_bob_data = do + s <- scid 0 0 1 + m <- msat 50 + pure empty_blinded_hop_data + { bhd_padding = Just (BS.replicate 32 0) + , bhd_short_channel_id = Just s + , bhd_payment_relay = Just (PaymentRelay 50 0 10000) + , bhd_payment_constraints = Just (PaymentConstraints 750150 m) + , bhd_allowed_features = empty_features + } + +bp_carol_data :: IO BlindedHopData +bp_carol_data = do + s <- scid 0 0 2 + m <- msat 50 + override <- hex_point V.rbDavePathKey + pure empty_blinded_hop_data + { bhd_short_channel_id = Just s + , bhd_next_path_key_override = Just override + , bhd_payment_relay = Just (PaymentRelay 75 150 100) + , bhd_payment_constraints = Just (PaymentConstraints 750100 m) + , bhd_allowed_features = empty_features + } + +bp_dave_data :: IO BlindedHopData +bp_dave_data = do + s <- scid 0 0 3 + m <- msat 50 + pure empty_blinded_hop_data + { bhd_padding = Just (BS.replicate 34 0) + , bhd_short_channel_id = Just s + , bhd_payment_relay = Just (PaymentRelay 25 100 0) + , bhd_payment_constraints = Just (PaymentConstraints 750025 m) + , bhd_allowed_features = empty_features + } + +bp_eve_data :: IO BlindedHopData +bp_eve_data = do + m <- msat 50 + path_id <- unhex "c9cf92f45ade68345bc20ae672e2012f4af487ed4415" + pure empty_blinded_hop_data + { bhd_padding = Just (BS.replicate 28 0) + , bhd_path_id = Just path_id + , bhd_payment_constraints = Just (PaymentConstraints 750000 m) + , bhd_allowed_features = empty_features + } + +-- per hop: node key, public key the onion is encrypted to, onion +-- received, payload (without its length prefix) +bp_route + :: IO [(SecretKey, BOLT1.Point, BS.ByteString, BS.ByteString)] +bp_route = mapM hop + [ (V.onionNodeKey0, V.bpAlicePubKey, V.bpAliceOnion, V.bpAlicePayload) + , (V.rbBobNodeKey, V.bpBobPubKey, V.bpBobOnion, V.bpBobPayload) + , (V.rbCarolNodeKey, V.bpCarolPubKey, V.bpCarolOnion, V.bpCarolPayload) + , (V.rbDaveNodeKey, V.bpDavePubKey, V.bpDaveOnion, V.bpDavePayload) + , (V.rbEveNodeKey, V.bpEvePubKey, V.bpEveOnion, V.bpEvePayload) + ] + where + hop (k, p, o, pl) = (,,,) <$> hex_key k <*> hex_point p <*> unhex o + <*> (unhex pl >>= unprefix) + +blinded_payment_vectors :: TestTree +blinded_payment_vectors = testGroup "blinded-payment-onion-test.json" [ + testCase "construct reproduces the onion" $ do + route <- bp_route + sk <- hex_key V.bpSessionKey + assoc <- unhex V.bpAssocData + expected <- unhex V.bpAliceOnion + hops <- mapM (\(_, pub, _, body) -> do + hp <- right "decode_hop_payload" (decode_hop_payload body) + encode_hop_payload hp @?= Right body + pure (Hop pub hp)) route + (pkt, _) <- right "construct" (construct sk hops assoc) + encode_onion_packet pkt @?= expected + , testCase "the route's payloads" $ do + route <- bp_route + first_pk <- hex_point V.rbBobPathKey + s <- scid 0 0 10 + (a0, a1, a2) <- three =<< mapM msat [110125, 100000, 150000] + payloads <- mapM (\(_, _, _, body) -> + right "decode_hop_payload" (decode_hop_payload body)) route + case payloads of + [alice, bob, carol, dave, eve] -> do + alice @?= empty_hop_payload + { hp_short_channel_id = Just s, hp_amt_to_forward = Just a0 + , hp_outgoing_cltv_value = Just 749150 } + hp_current_path_key bob @?= Just first_pk + forM_ [bob, carol, dave] $ \hp -> do + assertBool "encrypted data" (hp_encrypted_data hp /= Nothing) + hp { hp_encrypted_data = Nothing + , hp_current_path_key = Nothing } @?= empty_hop_payload + eve { hp_encrypted_data = Nothing } @?= empty_hop_payload + { hp_amt_to_forward = Just a1, hp_total_amount_msat = Just a2 + , hp_outgoing_cltv_value = Just 749000 } + _ -> assertFailure "expected 5 payloads" + , testCase "each hop processes its onion" $ do + route <- bp_route + assoc <- unhex V.bpAssocData + datas <- sequence [bp_bob_data, bp_carol_data, bp_dave_data, + bp_eve_data] + nexts <- mapM hex_point + [ V.bpBobNextPathKey, V.bpCarolNextPathKey, V.bpDaveNextPathKey + , V.bpEveNextPathKey ] + -- (hop, path_key received, expected blinded info) + let expect = zip3 route + (Nothing : Nothing : map Just (take 3 nexts)) + (Nothing : map Just (zipWith BlindedInfo datas nexts)) + go [] = assertFailure "no hops" + go [((k, _, onion, body), mpk, binfo)] = do + pkt <- right "decode" (decode_onion_packet onion) + r <- receive (process k pkt assoc mpk) + encode_hop_payload (rcv_payload r) @?= Right body + rcv_blinded r @?= binfo + go (((k, _, onion, body), mpk, binfo) : rest) = do + pkt <- right "decode" (decode_onion_packet onion) + f <- forward (process k pkt assoc mpk) + encode_hop_payload (fwd_payload f) @?= Right body + fwd_blinded f @?= binfo + forM_ (take 1 rest) $ \((_, _, next, _), _, _) -> + encode_onion_packet (fwd_next_packet f) @?= next + go rest + go expect + ] + +-- properties ----------------------------------------------------------------- + +properties :: TestTree +properties = testGroup "properties" [ + testProperty "onion packets round-trip" $ + forAll gen_onion $ \pkt -> + decode_onion_packet (encode_onion_packet pkt) === Right pkt + , testProperty "hop payloads round-trip" $ + forAll gen_hop_payload $ \hp -> + fmap decode_hop_payload (encode_hop_payload hp) === Right (Right hp) + , testProperty "blinded hop data round-trips" $ + forAll gen_blinded_hop_data $ \d -> + fmap decode_blinded_hop_data (encode_blinded_hop_data d) + === Right (Right d) + , testProperty "failure messages round-trip" $ + forAll gen_failure_message $ \fm -> + fmap decode_failure_message (encode_failure_message fm) + === Right (Right fm) + , testProperty "wrap_error is an involution" $ + forAll gen_secret $ \ss -> + forAll (gen_bytes 0 600) $ \bs -> + wrap_error ss (wrap_error ss (ErrorPacket bs)) === ErrorPacket bs + , testProperty "errors are attributed to the failing hop" $ + forAll (choose (1, 20)) $ \n -> + forAll (vectorOf n gen_secret) $ \sss -> + forAll (choose (0, n - 1)) $ \i -> + forAll gen_failure_message $ \fm -> + case drop i sss of + ss : _ | Right pkt <- construct_error ss fm -> + unwrap_error sss (foldr wrap_error pkt (take i sss)) + === Attributed i fm + _ -> property False + , testProperty "routes of 1 to 20 hops construct and process" $ + forAll (choose (1, 20)) $ \n -> + forAll gen_key $ \sk -> + forAll (vectorOf n gen_key) $ \keys -> + forAll (vectorOf n (gen_route_payload n)) $ \pls -> + route_roundtrip sk (zip keys pls) + ] + +-- construct an onion over a route, then process it at every hop +route_roundtrip :: SecretKey -> [(SecretKey, HopPayload)] -> Property +route_roundtrip sk route = + case construct sk [Hop (public_key k) hp | (k, hp) <- route] ad of + Left e -> counterexample (show e) False + Right (pkt, sss) -> length sss === length route .&&. go route sss pkt + where + go [(k, hp)] [ss] pkt = case process k pkt ad Nothing of + Right (Receive r) -> + rcv_payload r === hp .&&. property (rcv_shared_secret r == ss) + other -> counterexample (show other) False + go ((k, hp) : rest) (ss : sss) pkt = case process k pkt ad Nothing of + Right (Forward f) -> + fwd_payload f === hp + .&&. property (fwd_shared_secret f == ss) + .&&. go rest sss (fwd_next_packet f) + other -> counterexample (show other) False + go _ _ _ = property False + +-- generators ----------------------------------------------------------------- + +gen_bytes :: Int -> Int -> Gen BS.ByteString +gen_bytes lo hi = do + n <- choose (lo, hi) + BS.pack <$> vectorOf n arbitrary + +gen_key :: Gen SecretKey +gen_key = gen_bytes 32 32 `suchThatMap` secret_key + +gen_secret :: Gen SharedSecret +gen_secret = gen_bytes 32 32 `suchThatMap` shared_secret + +gen_point :: Gen BOLT1.Point +gen_point = do + prefix <- elements [0x02, 0x03] + x <- gen_bytes 32 32 + pure (BS.cons prefix x) `suchThatMap` BOLT1.point + +gen_msat :: Gen BOLT1.MilliSatoshi +gen_msat = oneof + [ choose (0, 0xffff), choose (0, BOLT1.un_milli_satoshi + BOLT1.max_milli_satoshi) ] + `suchThatMap` BOLT1.milli_satoshi + +gen_scid :: Gen BOLT1.ShortChannelId +gen_scid = BOLT1.ShortChannelId <$> arbitrary + +gen_maybe :: Gen a -> Gen (Maybe a) +gen_maybe g = oneof [pure Nothing, Just <$> g] + +-- extra records with odd types not in the given list +gen_extra :: [Word64] -> Gen BOLT1.TlvStream +gen_extra known = do + n <- choose (0, 3) + ts <- vectorOf n (oneof [choose (1, 300), choose (65536, 70000)]) + recs <- mapM (\t -> BOLT1.TlvRecord t <$> gen_bytes 0 20) + [ t | t <- ts, odd t, t `notElem` known ] + let uniq = nubBy (\a b -> BOLT1.tlv_type a == BOLT1.tlv_type b) recs + pure uniq `suchThatMap` BOLT1.tlv_stream + +gen_onion :: Gen OnionPacket +gen_onion = OnionPacket + <$> arbitrary + <*> gen_point + <*> (gen_bytes 1300 1300 `suchThatMap` hop_payloads) + <*> (gen_bytes 32 32 `suchThatMap` hmac32) + +gen_hop_payload :: Gen HopPayload +gen_hop_payload = HopPayload + <$> gen_maybe gen_msat + <*> gen_maybe arbitrary + <*> gen_maybe gen_scid + <*> gen_maybe (PaymentData + <$> (gen_bytes 32 32 `suchThatMap` payment_secret) + <*> gen_msat) + <*> gen_maybe (gen_bytes 0 50) + <*> gen_maybe gen_point + <*> gen_maybe (gen_bytes 0 50) + <*> gen_maybe gen_msat + <*> gen_extra [] + +gen_blinded_hop_data :: Gen BlindedHopData +gen_blinded_hop_data = BlindedHopData + <$> gen_maybe (gen_bytes 0 40) + <*> gen_maybe gen_scid + <*> gen_maybe gen_point + <*> gen_maybe (gen_bytes 0 40) + <*> gen_maybe gen_point + <*> gen_maybe (PaymentRelay <$> arbitrary <*> arbitrary <*> arbitrary) + <*> gen_maybe (PaymentConstraints <$> arbitrary <*> gen_msat) + <*> gen_maybe (BOLT9.parse <$> gen_bytes 0 8) + <*> gen_extra [1] + +gen_failure_message :: Gen FailureMessage +gen_failure_message = do + f <- gen_failure + ex <- case f of + -- these take every byte after the code, or may be ambiguous with a + -- TLV stream + UnknownFailure _ _ -> pure no_tlvs + InvalidOnionPayload Nothing -> pure no_tlvs + _ -> gen_extra [] + pure (FailureMessage f ex) + +gen_failure :: Gen Failure +gen_failure = oneof + [ pure TemporaryNodeFailure + , pure PermanentNodeFailure + , pure RequiredNodeFeatureMissing + , InvalidOnionVersion <$> hash + , InvalidOnionHmac <$> hash + , InvalidOnionKey <$> hash + , TemporaryChannelFailure <$> update + , pure PermanentChannelFailure + , pure RequiredChannelFeatureMissing + , pure UnknownNextPeer + , AmountBelowMinimum <$> gen_msat <*> update + , FeeInsufficient <$> gen_msat <*> update + , IncorrectCltvExpiry <$> arbitrary <*> update + , ExpiryTooSoon <$> update + , IncorrectOrUnknownPaymentDetails <$> gen_msat <*> arbitrary + , FinalIncorrectCltvExpiry <$> arbitrary + , FinalIncorrectHtlcAmount <$> gen_msat + , ChannelDisabled <$> arbitrary <*> update + , pure ExpiryTooFar + , InvalidOnionPayload <$> gen_maybe ((,) <$> arbitrary <*> arbitrary) + , pure MppTimeout + , InvalidOnionBlinding <$> hash + , UnknownFailure <$> (arbitrary `suchThat` unknown) <*> gen_bytes 0 20 + ] + where + hash = gen_bytes 32 32 `suchThatMap` onion_hash + update = gen_bytes 0 100 + unknown c = c `notElem` + [ 0x2002, 0x6002, 0x6003, 0xc004, 0xc005, 0xc006, 0x1007, 0x4008 + , 0x4009, 0x400a, 0x100b, 0x100c, 0x100d, 0x100e, 0x400f, 0x0012 + , 0x0013, 0x1014, 0x0015, 0x4016, 0x0017, 0xc018 ] + +-- a payload whose shift size fits n hops in 1300 bytes +-- +-- The typed fields take at most 26 bytes; an odd record of type 65537 +-- adds at most 8 bytes of framing plus its value. With a 3-byte length +-- prefix and 32-byte HMAC a hop then shifts at most 69 bytes plus the +-- value's length. +gen_route_payload :: Int -> Gen HopPayload +gen_route_payload n = do + amt <- gen_msat + cltv <- arbitrary + s <- gen_maybe gen_scid + let budget = 1300 `div` n - 69 + ex <- if budget < 0 + then pure no_tlvs + else do + v <- gen_bytes 0 budget + pure (BOLT1.TlvRecord 65537 v : []) + `suchThatMap` BOLT1.tlv_stream + pure empty_hop_payload + { hp_amt_to_forward = Just amt + , hp_outgoing_cltv_value = Just cltv + , hp_short_channel_id = s + , hp_extra = ex + } diff --git a/test/Vectors.hs b/test/Vectors.hs new file mode 100644 --- /dev/null +++ b/test/Vectors.hs @@ -0,0 +1,1100 @@ +{-# LANGUAGE OverloadedStrings #-} + +-- | +-- Module: Vectors +-- Copyright: (c) 2025 Jared Tobin +-- License: MIT +-- Maintainer: Jared Tobin +-- +-- BOLT4 test vectors, hex-encoded. +-- +-- Taken from the bolt04/*.json files in lightning/bolts, and from the +-- 'Returning Errors' trace in 04-onion-routing.md. + +module Vectors where + +import qualified Data.ByteString as BS + +-- onion-test.json --------------------------------------------------------- + +-- | Session key. +onionSessionKey :: BS.ByteString +onionSessionKey = + "4141414141414141414141414141414141414141414141414141414141414141" + +-- | Associated data. +onionAssocData :: BS.ByteString +onionAssocData = + "4242424242424242424242424242424242424242424242424242424242424242" + +-- | Hop 0 public key. +onionPubKey0 :: BS.ByteString +onionPubKey0 = + "02eec7245d6b7d2ccb30380bfbe2a3648cd7a942653f5aa340edcea1f283686619" + +-- | Hop 0 payload, with its length prefix. +onionPayload0 :: BS.ByteString +onionPayload0 = "1202023a98040205dc06080000000000000001" + +-- | Hop 1 public key. +onionPubKey1 :: BS.ByteString +onionPubKey1 = + "0324653eac434488002cc06bbfb7f10fe18991e35f9fe4302dbea6d2353dc0ab1c" + +-- | Hop 1 payload, with its length prefix. +onionPayload1 :: BS.ByteString +onionPayload1 = BS.concat + [ "52020236b00402057806080000000000000002fd02013c010203040506070809" + , "0a0b0c0d0e0f0102030405060708090a0b0c0d0e0f0102030405060708090a0b" + , "0c0d0e0f0102030405060708090a0b0c0d0e0f" + ] + +-- | Hop 2 public key. +onionPubKey2 :: BS.ByteString +onionPubKey2 = + "027f31ebc5462c1fdce1b737ecff52d37d75dea43ce11c74d25aa297165faa2007" + +-- | Hop 2 payload, with its length prefix. +onionPayload2 :: BS.ByteString +onionPayload2 = "12020230d4040204e206080000000000000003" + +-- | Hop 3 public key. +onionPubKey3 :: BS.ByteString +onionPubKey3 = + "032c0b7cf95324a07d05398b240174dc0c2be444d96b159aa6c7f7b1e668680991" + +-- | Hop 3 payload, with its length prefix. +onionPayload3 :: BS.ByteString +onionPayload3 = "1202022710040203e806080000000000000004" + +-- | Hop 4 public key. +onionPubKey4 :: BS.ByteString +onionPubKey4 = + "02edabbd16b41c8371b92ef2f04c1185b4f03b6dcd52ba9b78d9d7c89c8f221145" + +-- | Hop 4 payload, with its length prefix. +onionPayload4 :: BS.ByteString +onionPayload4 = BS.concat + [ "fd011002022710040203e8082224a33562c54507a9334e79f0dc4f17d407e6d7" + , "c61f0e2f3d0d38599502f617042710fd012de02a2a2a2a2a2a2a2a2a2a2a2a2a" + , "2a2a2a2a2a2a2a2a2a2a2a2a2a2a2a2a2a2a2a2a2a2a2a2a2a2a2a2a2a2a2a2a" + , "2a2a2a2a2a2a2a2a2a2a2a2a2a2a2a2a2a2a2a2a2a2a2a2a2a2a2a2a2a2a2a2a" + , "2a2a2a2a2a2a2a2a2a2a2a2a2a2a2a2a2a2a2a2a2a2a2a2a2a2a2a2a2a2a2a2a" + , "2a2a2a2a2a2a2a2a2a2a2a2a2a2a2a2a2a2a2a2a2a2a2a2a2a2a2a2a2a2a2a2a" + , "2a2a2a2a2a2a2a2a2a2a2a2a2a2a2a2a2a2a2a2a2a2a2a2a2a2a2a2a2a2a2a2a" + , "2a2a2a2a2a2a2a2a2a2a2a2a2a2a2a2a2a2a2a2a2a2a2a2a2a2a2a2a2a2a2a2a" + , "2a2a2a2a2a2a2a2a2a2a2a2a2a2a2a2a2a2a2a" + ] + +-- | The resulting onion packet. +onionPacket :: BS.ByteString +onionPacket = BS.concat + [ "0002eec7245d6b7d2ccb30380bfbe2a3648cd7a942653f5aa340edcea1f28368" + , "6619f7f3416a5aa36dc7eeb3ec6d421e9615471ab870a33ac07fa5d5a51df0a8" + , "823aabe3fea3f90d387529d4f72837f9e687230371ccd8d263072206dbed0234" + , "f6505e21e282abd8c0e4f5b9ff8042800bbab065036eadd0149b37f27dde6647" + , "25a49866e052e809d2b0198ab9610faa656bbf4ec516763a59f8f42c171b1791" + , "66ba38958d4f51b39b3e98706e2d14a2dafd6a5df808093abfca5aeaaca16ede" + , "d5db7d21fb0294dd1a163edf0fb445d5c8d7d688d6dd9c541762bf5a5123bf99" + , "39d957fe648416e88f1b0928bfa034982b22548e1a4d922690eecf546275afb2" + , "33acf4323974680779f1a964cfe687456035cc0fba8a5428430b390f0057b6d1" + , "fe9a8875bfa89693eeb838ce59f09d207a503ee6f6299c92d6361bc335fcbf9b" + , "5cd44747aadce2ce6069cfdc3d671daef9f8ae590cf93d957c9e873e9a1bc62d" + , "9640dc8fc39c14902d49a1c80239b6c5b7fd91d05878cbf5ffc7db2569f47c43" + , "d6c0d27c438abff276e87364deb8858a37e5a62c446af95d8b786eaf0b5fcf78" + , "d98b41496794f8dcaac4eef34b2acfb94c7e8c32a9e9866a8fa0b6f2a06f00a1" + , "ccde569f97eec05c803ba7500acc96691d8898d73d8e6a47b8f43c3d5de74458" + , "d20eda61474c426359677001fbd75a74d7d5db6cb4feb83122f133206203e4e2" + , "d293f838bf8c8b3a29acb321315100b87e80e0edb272ee80fda944e3fb6084ed" + , "4d7f7c7d21c69d9da43d31a90b70693f9b0cc3eac74c11ab8ff655905688916c" + , "fa4ef0bd04135f2e50b7c689a21d04e8e981e74c6058188b9b1f9dfc3eec6838" + , "e9ffbcf22ce738d8a177c19318dffef090cee67e12de1a3e2a39f61247547ba5" + , "257489cbc11d7d91ed34617fcc42f7a9da2e3cf31a94a210a1018143173913c3" + , "8f60e62b24bf0d7518f38b5bab3e6a1f8aeb35e31d6442c8abb5178efc892d2e" + , "787d79c6ad9e2fc271792983fa9955ac4d1d84a36c024071bc6e431b625519d5" + , "56af38185601f70e29035ea6a09c8b676c9d88cf7e05e0f17098b584c4168735" + , "940263f940033a220f40be4c85344128b14beb9e75696db37014107801a59b13" + , "e89cd9d2258c169d523be6d31552c44c82ff4bb18ec9f099f3bf0e5b1bb2ba9a" + , "87d7e26f98d294927b600b5529c47e04d98956677cbcee8fa2b60f49776d8b8c" + , "367465b7c626da53700684fb6c918ead0eab8360e4f60edd25b4f43816a75ecf" + , "70f909301825b512469f8389d79402311d8aecb7b3ef8599e79485a4388d8774" + , "4d899f7c47ee644361e17040a7958c8911be6f463ab6a9b2afacd688ec55ef51" + , "7b38f1339efc54487232798bb25522ff4572ff68567fe830f92f7b8113efce3e" + , "98c3fffbaedce4fd8b50e41da97c0c08e423a72689cc68e68f752a5e3a9003e6" + , "4e35c957ca2e1c48bb6f64b05f56b70b575ad2f278d57850a7ad568c24a4d32a" + , "3d74b29f03dc125488bc7c637da582357f40b0a52d16b3b40bb2c2315d03360b" + , "c24209e20972c200566bcf3bbe5c5b0aedd83132a8a4d5b4242ba370b6d67d9b" + , "67eb01052d132c7866b9cb502e44796d9d356e4e3cb47cc527322cd24976fe7c" + , "9257a2864151a38e568ef7a79f10d6ef27cc04ce382347a2488b1f404fdbf407" + , "fe1ca1c9d0d5649e34800e25e18951c98cae9f43555eef65fee1ea8f15828807" + , "366c3b612cd5753bf9fb8fced08855f742cddd6f765f74254f03186683d646e6" + , "f09ac2805586c7cf11998357cafc5df3f285329366f475130c928b2dceba4aa3" + , "83758e7a9d20705c4bb9db619e2992f608a1ba65db254bb389468741d0502e25" + , "88aeb54390ac600c19af5c8e61383fc1bebe0029e4474051e4ef908828db9cca" + , "13277ef65db3fd47ccc2179126aaefb627719f421e20" + ] + +-- | Hop 0 node private key. +onionNodeKey0 :: BS.ByteString +onionNodeKey0 = + "4141414141414141414141414141414141414141414141414141414141414141" + +-- | Hop 1 node private key. +onionNodeKey1 :: BS.ByteString +onionNodeKey1 = + "4242424242424242424242424242424242424242424242424242424242424242" + +-- | Hop 2 node private key. +onionNodeKey2 :: BS.ByteString +onionNodeKey2 = + "4343434343434343434343434343434343434343434343434343434343434343" + +-- | Hop 3 node private key. +onionNodeKey3 :: BS.ByteString +onionNodeKey3 = + "4444444444444444444444444444444444444444444444444444444444444444" + +-- | Hop 4 node private key. +onionNodeKey4 :: BS.ByteString +onionNodeKey4 = + "4545454545454545454545454545454545454545454545454545454545454545" + +-- onion-error-test.json --------------------------------------------------- + +-- | Failure message. +errFailureMessage :: BS.ByteString +errFailureMessage = "2002" + +-- | Hop 0 shared secret. +errSharedSecret0 :: BS.ByteString +errSharedSecret0 = + "53eb63ea8a3fec3b3cd433b85cd62a4b145e1dda09391b348c4e1cd36a03ea66" + +-- | Hop 0 ammag key. +errAmmagKey0 :: BS.ByteString +errAmmagKey0 = + "3761ba4d3e726d8abb16cba5950ee976b84937b61b7ad09e741724d7dee12eb5" + +-- | Hop 1 shared secret. +errSharedSecret1 :: BS.ByteString +errSharedSecret1 = + "a6519e98832a0b179f62123b3567c106db99ee37bef036e783263602f3488fae" + +-- | Hop 1 ammag key. +errAmmagKey1 :: BS.ByteString +errAmmagKey1 = + "59ee5867c5c151daa31e36ee42530f429c433836286e63744f2020b980302564" + +-- | Hop 2 shared secret. +errSharedSecret2 :: BS.ByteString +errSharedSecret2 = + "3a6b412548762f0dbccce5c7ae7bb8147d1caf9b5471c34120b30bc9c04891cc" + +-- | Hop 2 ammag key. +errAmmagKey2 :: BS.ByteString +errAmmagKey2 = + "1bf08df8628d452141d56adfd1b25c1530d7921c23cecfc749ac03a9b694b0d3" + +-- | Hop 3 shared secret. +errSharedSecret3 :: BS.ByteString +errSharedSecret3 = + "21e13c2d7cfe7e18836df50872466117a295783ab8aab0e7ecc8c725503ad02d" + +-- | Hop 3 ammag key. +errAmmagKey3 :: BS.ByteString +errAmmagKey3 = + "cd9ac0e09064f039fa43a31dea05f5fe5f6443d40a98be4071af4a9d704be5ad" + +-- | Hop 4 shared secret. +errSharedSecret4 :: BS.ByteString +errSharedSecret4 = + "b5756b9b542727dbafc6765a49488b023a725d631af688fc031217e90770c328" + +-- | Hop 4 ammag key. +errAmmagKey4 :: BS.ByteString +errAmmagKey4 = + "2f36bb8822e1f0d04c27b7d8bb7d7dd586e032a3218b8d414afbba6f169a4d68" + +-- | Hop 4 um key. +errUmKey4 :: BS.ByteString +errUmKey4 = "4da7f2923edce6c2d85987d1d9fa6d88023e6c3a9c3d20f07d3b10b61a78d646" + +-- | Hop 4 return packet, without its HMAC. +errPayload4 :: BS.ByteString +errPayload4 = BS.concat + [ "0002200200fe0000000000000000000000000000000000000000000000000000" + , "0000000000000000000000000000000000000000000000000000000000000000" + , "0000000000000000000000000000000000000000000000000000000000000000" + , "0000000000000000000000000000000000000000000000000000000000000000" + , "0000000000000000000000000000000000000000000000000000000000000000" + , "0000000000000000000000000000000000000000000000000000000000000000" + , "0000000000000000000000000000000000000000000000000000000000000000" + , "0000000000000000000000000000000000000000000000000000000000000000" + , "00000000" + ] + +-- | The return packet received by the origin. +errPacket :: BS.ByteString +errPacket = BS.concat + [ "9c5add3963fc7f6ed7f148623c84134b5647e1306419dbe2174e523fa9e2fbed" + , "3a06a19f899145610741c83ad40b7712aefaddec8c6baf7325d92ea4ca4d1df8" + , "bce517f7e54554608bf2bd8071a4f52a7a2f7ffbb1413edad81eeea5785aa9d9" + , "90f2865dc23b4bc3c301a94eec4eabebca66be5cf638f693ec256aec514620cc" + , "28ee4a94bd9565bc4d4962b9d3641d4278fb319ed2b84de5b665f307a2db0f7f" + , "bb757366067d88c50f7e829138fde4f78d39b5b5802f1b92a8a820865af5cc79" + , "f9f30bc3f461c66af95d13e5e1f0381c184572a91dee1c849048a647a1158cf8" + , "84064deddbf1b0b88dfe2f791428d0ba0f6fb2f04e14081f69165ae66d9297c1" + , "18f0907705c9c4954a199bae0bb96fad763d690e7daa6cfda59ba7f2c8d11448" + , "b604d12d" + ] + +-- BOLT4 'Returning Errors' trace ------------------------------------------ + +-- | Encoded failure message, followed by pad_len and pad. +traceFailureMessage :: BS.ByteString +traceFailureMessage = BS.concat + [ "400f0000000000000064000c3500fd84d1fd012c808080808080808080808080" + , "8080808080808080808080808080808080808080808080808080808080808080" + , "8080808080808080808080808080808080808080808080808080808080808080" + , "8080808080808080808080808080808080808080808080808080808080808080" + , "8080808080808080808080808080808080808080808080808080808080808080" + , "8080808080808080808080808080808080808080808080808080808080808080" + , "8080808080808080808080808080808080808080808080808080808080808080" + , "8080808080808080808080808080808080808080808080808080808080808080" + , "8080808080808080808080808080808080808080808080808080808080808080" + , "8080808080808080808080808080808080808080808080808080808080808080" + , "02c0000000000000000000000000000000000000000000000000000000000000" + , "0000000000000000000000000000000000000000000000000000000000000000" + , "0000000000000000000000000000000000000000000000000000000000000000" + , "0000000000000000000000000000000000000000000000000000000000000000" + , "0000000000000000000000000000000000000000000000000000000000000000" + , "0000000000000000000000000000000000000000000000000000000000000000" + , "0000000000000000000000000000000000000000000000000000000000000000" + , "0000000000000000000000000000000000000000000000000000000000000000" + , "0000000000000000000000000000000000000000000000000000000000000000" + , "0000000000000000000000000000000000000000000000000000000000000000" + , "0000000000000000000000000000000000000000000000000000000000000000" + , "0000000000000000000000000000000000000000000000000000000000000000" + , "0000000000000000000000000000000000000000000000000000000000000000" + , "0000000000000000000000000000000000000000000000000000000000000000" + , "0000000000000000000000000000000000000000000000000000000000000000" + , "0000000000000000000000000000000000000000000000000000000000000000" + , "0000000000000000000000000000000000000000000000000000000000000000" + , "0000000000000000000000000000000000000000000000000000000000000000" + , "0000000000000000000000000000000000000000000000000000000000000000" + , "0000000000000000000000000000000000000000000000000000000000000000" + , "0000000000000000000000000000000000000000000000000000000000000000" + , "0000000000000000000000000000000000000000000000000000000000000000" + , "0000" + ] + +-- | Return packet before obfuscation. +traceRawPacket :: BS.ByteString +traceRawPacket = BS.concat + [ "fda7e11974f78ca6cc456f2d17ae54463664696e93842548245dd2a2c513a626" + , "0140400f0000000000000064000c3500fd84d1fd012c80808080808080808080" + , "8080808080808080808080808080808080808080808080808080808080808080" + , "8080808080808080808080808080808080808080808080808080808080808080" + , "8080808080808080808080808080808080808080808080808080808080808080" + , "8080808080808080808080808080808080808080808080808080808080808080" + , "8080808080808080808080808080808080808080808080808080808080808080" + , "8080808080808080808080808080808080808080808080808080808080808080" + , "8080808080808080808080808080808080808080808080808080808080808080" + , "8080808080808080808080808080808080808080808080808080808080808080" + , "8080808080808080808080808080808080808080808080808080808080808080" + , "808002c000000000000000000000000000000000000000000000000000000000" + , "0000000000000000000000000000000000000000000000000000000000000000" + , "0000000000000000000000000000000000000000000000000000000000000000" + , "0000000000000000000000000000000000000000000000000000000000000000" + , "0000000000000000000000000000000000000000000000000000000000000000" + , "0000000000000000000000000000000000000000000000000000000000000000" + , "0000000000000000000000000000000000000000000000000000000000000000" + , "0000000000000000000000000000000000000000000000000000000000000000" + , "0000000000000000000000000000000000000000000000000000000000000000" + , "0000000000000000000000000000000000000000000000000000000000000000" + , "0000000000000000000000000000000000000000000000000000000000000000" + , "0000000000000000000000000000000000000000000000000000000000000000" + , "0000000000000000000000000000000000000000000000000000000000000000" + , "0000000000000000000000000000000000000000000000000000000000000000" + , "0000000000000000000000000000000000000000000000000000000000000000" + , "0000000000000000000000000000000000000000000000000000000000000000" + , "0000000000000000000000000000000000000000000000000000000000000000" + , "0000000000000000000000000000000000000000000000000000000000000000" + , "0000000000000000000000000000000000000000000000000000000000000000" + , "0000000000000000000000000000000000000000000000000000000000000000" + , "0000000000000000000000000000000000000000000000000000000000000000" + , "0000000000000000000000000000000000000000000000000000000000000000" + , "00000000" + ] + +-- | Return packet as sent by node 4. +tracePacket4 :: BS.ByteString +tracePacket4 = BS.concat + [ "146e94a9086dbbed6a0ab6932d00c118a7195dbf69b7d7a12b0e6956fc54b5e0" + , "a989f165b5f12fd45edd73a5b0c48630ff5be69500d3d82a29c0803f0a0679a6" + , "a073c33a6fb8250090a3152eba3f11a85184fa87b67f1b0354d6f48e3b342e33" + , "2a17b7710f342f342a87cf32eccdf0afc2160808d58abb5e5840d2c760c538e6" + , "3a6f841970f97d2e6fe5b8739dc45e2f7f5f532f227bcc2988ab0f9cc6d3f129" + , "09cd5842c37bc8c7608475a5ebbe10626d5ecc1f3388ad5f645167b44a4d166f" + , "87863fe34918cea25c18059b4c4d9cb414b59f6bc50c1cea749c80c43e2344f5" + , "d23159122ed4ab9722503b212016470d9610b46c35dbeebaf2e342e09770b383" + , "92a803bc9d2e7c8d6d384ffcbeb74943fe3f64afb2a543a6683c7db3088441c5" + , "31eeb4647518cb41992f8954f1269fb969630944928c2d2b45593731b5da0c4e" + , "70d04a0a57afe4af42e99912fbb4f8883a5ecb9cb29b883cb6bfa0f4db2279ff" + , "8c6d2b56a232f55ba28fe7dfa70a9ab0433a085388f25cce8d53de6a2fbd7546" + , "377d6ede9027ad173ba1f95767461a3689ef405ab608a21086165c64b02c1782" + , "b04a6dba2361a7784603069124e12f2f6dcb1ec7612a4fbf94c0e14631a2bef6" + , "190c3d5f35e0c4b32aa85201f449d830fd8f782ec758b0910428e3ec3ca1dba3" + , "b6c7d89f69e1ee1b9df3dfbbf6d361e1463886b38d52e8f43b73a3bd48c6f36f" + , "5897f514b93364a31d49d1d506340b1315883d425cb36f4ea553430d538fd6f3" + , "596d4afc518db2f317dd051abc0d4bfb0a7870c3db70f19fe78d6604bbf088fc" + , "b4613f54e67b038277fedcd9680eb97bdffc3be1ab2cbcbafd625b8a7ac34d8c" + , "190f98d3064ecd3b95b8895157c6a37f31ef4de094b2cb9dbf8ff1f419ba0eca" + , "cb1bb13df0253b826bec2ccca1e745dd3b3e7cc6277ce284d649e7b828572773" + , "5ff4ef6cca6c18e2714f4e2a1ac67b25213d3bb49763b3b94e7ebf72507b71fb" + , "2fe0329666477ee7cb7ebd6b88ad5add8b217188b1ca0fa13de1ec09cc674346" + , "875105be6e0e0d6c8928eb0df23c39a639e04e4aedf535c4e093f08b2c905a14" + , "f25c0c0fe47a5a1535ab9eae0d9d67bdd79de13a08d59ee05385c7ea4af1ad32" + , "48e61dd22f8990e9e99897d653dd7b1b1433a6d464ea9f74e377f2d8ce99ba7d" + , "bc753297644234d25ecb5bd528e2e2082824681299ac30c05354baaa9c3967d8" + , "6d7c07736f87fc0f63e5036d47235d7ae12178ced3ae36ee5919c093a02579e4" + , "fc9edad2c446c656c790704bfc8e2c491a42500aa1d75c8d4921ce29b753f883" + , "e17c79b09ea324f1f32ddf1f3284cd70e847b09d90f6718c42e5c94484cc9cbb" + , "0df659d255630a3f5a27e7d5dd14fa6b974d1719aa98f01a20fb4b7b1c77b42d" + , "57fab3c724339d459ee4a1c6b5d3bd4e08624c786a257872acc9ad3ff62222f2" + , "265a658d9f2a007229a5293b67ec91c84c4b4407c228434bad8a815ca9b256c7" + , "76bd2c9f" + ] + +-- | Return packet as sent by node 3. +tracePacket3 :: BS.ByteString +tracePacket3 = BS.concat + [ "7512354d6a26781d25e65539772ba049b7ed7c530bf75ab7ef80cf974b978a07" + , "a1c3dabc61940011585323f70fa98cfa1d4c868da30b1f751e44a72d9b3f7980" + , "9c8c51c9f0843daa8fe83587844fedeacb7348362003b31922cbb4d6169b2087" + , "b6f8d192d9cfe5363254cd1fde24641bde9e422f170c3eb146f194c48a459ae2" + , "889d706dc654235fa9dd20307ea54091d09970bf956c067a3bcc05af03c41e01" + , "af949a131533778bf6ee3b546caf2eabe9d53d0fb2e8cc952b7e0f5326a69ed2" + , "e58e088729a1d85971c6b2e129a5643f3ac43da031e655b27081f10543262cf9" + , "d72d6f64d5d96387ac0d43da3e3a03da0c309af121dcf3e99192efa754eab696" + , "0c256ffd4c546208e292e0ab9894e3605db098dc16b40f17c320aa4a0e42fc8b" + , "105c22f08c9bc6537182c24e32062c6cd6d7ec7062a0c2c2ecdae1588c82185c" + , "dc61d874ee916a7873ac54cddf929354f307e870011704a0e9fbc5c7802d6140" + , "134028aca0e78a7e2f3d9e5c7e49e20c3a56b624bfea51196ec9e88e4e56be38" + , "ff56031369f45f1e03be826d44a182f270c153ee0d9f8cf9f1f4132f33974e37" + , "c7887d5b857365c873cb218cbf20d4be3abdb2a2011b14add0a5672e01e58454" + , "21cf6dd6faca1f2f443757aae575c53ab797c2227ecdab03882bbbf4599318ce" + , "fafa72fa0c9a0f5a51d13c9d0e5d25bfcfb0154ed25895260a9df8743ac18871" + , "4a3f16960e6e2ff663c08bffda41743d50960ea2f28cda0bc3bd4a180e297b5b" + , "41c700b674cb31d99c7f2a1445e121e772984abff2bbe3f42d757ceeda3d03fb" + , "1ffe710aecabda21d738b1f4620e757e57b123dbc3c4aa5d9617dfa72f4a12d7" + , "88ca596af14bea583f502f16fdc13a5e739afb0715424af2767049f6b9aa107f" + , "69c5da0e85f6d8c5e46507e14616d5d0b797c3dea8b74a1b12d4e47ba7f57f09" + , "d515f6c7314543f78b5e85329d50c5f96ee2f55bbe0df742b4003b24ccbd4598" + , "a64413ee4807dc7f2a9c0b92424e4ae1b418a3cdf02ea4da5c3b12139348aa70" + , "22cc8272a3a1714ee3e4ae111cffd1bdfd62c503c80bdf27b2feaea0d5ab8fe0" + , "0f9cec66e570b00fd24b4a2ed9a5f6384f148a4d6325110a41ca5659ebc5b987" + , "21d298a52819b6fb150f273383f1c5754d320be428941922da790e17f482989c" + , "365c078f7f3ae100965e1b38c052041165295157e1a7c5b7a57671b842d4d85a" + , "7d971323ad1f45e17a16c4656d889fc75c12fc3d8033f598306196e29571e414" + , "281c5da19c12605f48347ad5b4648e371757cbe1c40adb93052af1d6110cfbf6" + , "11af5c8fc682b7e2ade3bfca8b5c7717d19fc9f97964ba6025aebbc91a6671e2" + , "59949dcf40984342118de1f6b514a7786bd4f6598ffbe1604cef476b2a4cb134" + , "3db608aca09d1d38fc23e98ee9c65e7f6023a8d1e61fd4f34f753454bd8e858c" + , "8ad6be6403edc599c220e03ca917db765980ac781e758179cd93983e9c1e769e" + , "4241d47c" + ] + +-- | Return packet as sent by node 2. +tracePacket2 :: BS.ByteString +tracePacket2 = BS.concat + [ "145bc1c63058f7204abbd2320d422e69fb1b3801a14312f81e5e29e6b5f4774c" + , "fed8a25241d3dfb7466e749c1b3261559e49090853612e07bd669dfb5f4c5416" + , "2fa504138dabd6ebcf0db8017840c35f12a2cfb84f89cc7c8959a6d51815b1d2" + , "c5136cedec2e4106bb5f2af9a21bd0a02c40b44ded6e6a90a145850614fb1b0e" + , "ef2a03389f3f2693bc8a755630fc81fff1d87a147052863a71ad5aebe8770537" + , "f333e07d841761ec448257f948540d8f26b1d5b66f86e073746106dfdbb86ac9" + , "475acf59d95ece037fba360670d924dce53aaa74262711e62a8fc9eb70cd8618" + , "fbedae22853d3053c7f10b1a6f75369d7f73c419baa7dbf9f1fc5895362dcc8b" + , "6bd60cca4943ef7143956c91992119bccbe1666a20b7de8a2ff30a46112b53a6" + , "bb79b763903ecbd1f1f74952fb1d8eb0950c504df31fe702679c23b463f82a92" + , "1a2c931500ab08e686cffb2d87258d254fb17843959cccd265a57ba26c740f0f" + , "231bb76df932b50c12c10be90174b37d454a3f8b284c849e86578a6182c4a7b2" + , "e47dd57d44730a1be9fec4ad07287a397e28dce4fda57e9cdfdb2eb5afdf0d38" + , "ef19d982341d18d07a556bb16c1416f480a396f278373b8fd9897023a4ac506e" + , "65cf4c306377730f9c8ca63cf47565240b59c4861e52f1dab84d938e96fb3182" + , "0064d534aca05fd3d2600834fe4caea98f2a748eb8f200af77bd9fbf46141952" + , "b9ddda66ef0ebea17ea1e7bb5bce65b6e71554c56dd0d4e14f4cf74c77a15077" + , "6bf31e7419756c71e7421dc22efe9cf01de9e19fc8808d5b525431b944400db1" + , "21a77994518d6025711cb25a18774068bba7faaa16d8f65c91bec87688483331" + , "56dcb4a08dfbbd9fef392da3e4de13d4d74e83a7d6e46cfe530ee7a6f711e2ca" + , "f8ad5461ba8177b2ef0a518baf9058ff9156e6aa7b08d938bd8d1485a787809d" + , "7b4c8aed97be880708470cd2b2cdf8e2f13428cc4b04ef1f2acbc9562f3693b9" + , "48d0aa94b0e6113cafa684f8e4a67dc431dfb835726874bef1de36f273f52ee6" + , "94ec46b0700f77f8538067642a552968e866a72a3f2031ad116663ac17b172b4" + , "46c5bc705b84777363a9a3fdc6443c07b2f4ef58858122168d4ebbaee920cefc" + , "312e1cea870ed6e15eec046ab2073bbf08b0a3366f55cfc6ad4681a12ab09465" + , "34e7b6f90ea8992d530ec3daa6b523b3cf03101c60cadd914f30dec932c1ef43" + , "41b5a8efac3c921e203574cfe0f1f83433fddb8ccfd273f7c3cab7bc27efe3bb" + , "61fdccd5146f1185364b9b621e7fb2b74b51f5ee6be72ab6ff46a6359dc2c855" + , "e61469724c1dbeb273df9d2e1c1fb74891239c0019dc12d5c7535f7238f963b7" + , "61d7102b585372cf021b64c4fc85bfb3161e59d2e298bba44cfd34d6859d9dba" + , "9dc6271e5047d525468c814f2ae438474b0a977273036da1a2292f88fcfb8957" + , "4a6bdca1185b40f8aa54026d5926725f99ef028da1be892e3586361efe15f4a1" + , "48ff1bc9" + ] + +-- | Return packet as sent by node 1. +tracePacket1 :: BS.ByteString +tracePacket1 = BS.concat + [ "1b4b09a935ce7af95b336baae307f2b400e3a7e808d9b4cf421cc4b3955620ac" + , "b69dcdb656128dae8857adbd4e6b37fbb1be9c1f2f02e61e9e59a630c4c77cf3" + , "83cb37b07413aa4de2f2fbf5b40ae40a91a8f4c6d74aeacef1bb1be4ecbc26ec" + , "2c824d2bc45db4b9098e732a769788f1cff3f5b41b0d25c132d40dc5ad045ef0" + , "043b15332ca3c5a09de2cdb17455a0f82a8f20da08346282823dab062cdbd211" + , "1e238528141d69de13de6d83994fbc711e3e269df63a12d3a4177c5c149150eb" + , "4dc2f589cd8acabcddba14dec3b0dada12d663b36176cd3c257c5460bab93981" + , "ad99f58660efa9b31d7e63b39915329695b3fa60e0a3bdb93e7e29a54ca6a8f3" + , "60d3848866198f9c3da3ba958e7730847fe1e6478ce8597848d3412b4ae48b06" + , "e05ba9a104e648f6eaf183226b5f63ed2e68f77f7e38711b393766a6fab7921b" + , "03eba82b5d7cb78e34dc961948d6161eadd7cf5d95d9c56df2ff5faa6ccf85ea" + , "cdc9ff2fc3abafe41c365a5bd14fd486d6b5e2f24199319e7813e02e798877ff" + , "e31a70ae2398d9e31b9e3727e6c1a3c0d995c67d37bb6e72e9660aaaa9232670" + , "f382add2edd468927e3303b6142672546997fe105583e7c5a3c4c2b599731308" + , "b5416e6c9a3f3ba55b181ad0439d3535356108b059f2cb8742eed7a58d4eba9f" + , "e79eaa77c34b12aff1abdaea93197aabd0e74cb271269ca464b3b06aef1d6573" + , "df5e1224179616036b368677f26479376681b772d3760e871d99efd34cca5cd6" + , "beca95190d967da820b21e5bec60082ea46d776b0517488c84f26d12873912d1" + , "f68fafd67bcf4c298e43cfa754959780682a2db0f75f95f0598c0d04fd014c50" + , "e4beb86a9e37d95f2bba7e5065ae052dc306555bca203d104c44a538b438c976" + , "2de299e1c4ad30d5b4a6460a76484661fc907682af202cd69b9a4473813b2fdc" + , "1142f1403a49b7e69a650b7cde9ff133997dcc6d43f049ecac5fce097a21e2bc" + , "e49c810346426585e3a5a18569b4cddd5ff6bdec66d0b69fcbc5ab3b137b34cc" + , "8aefb8b850a764df0e685c81c326611d901c392a519866e132bbb73234f6a358" + , "ba284fbafb21aa3605cacbaf9d0c901390a98b7a7dac9d4f0b405f7291c88b2f" + , "f45874241c90ac6c5fc895a440453c344d3a365cb929f9c91b9e39cb98b14244" + , "4aae03a6ae8284c77eb04b0a163813d4c21883df3c0f398f47bf127b5525f222" + , "107a2d8fe55289f0cfd3f4bbad6c5387b0594ef8a966afc9e804ccaf75fe39f3" + , "5c6446f7ee076d433f2f8a44dba1515acc78e589fa8c71b0a006fe14feebd51d" + , "0e0aa4e51110d16759eee86192eee90b34432130f387e0ccd2ee71023f1f641c" + , "ddb571c690107e08f592039fe36d81336a421e89378f351e633932a2f5f697d2" + , "5b620ffb8e84bb6478e9bd229bf3b164b48d754ae97bd23f319e3c56b3bcdaae" + , "b3bd7fc02ec02066b324cb72a09b6b43dec1097f49d69d3c138ce6f1a6402898" + , "baf7568c" + ] + +-- | Return packet as sent by node 0. +tracePacket0 :: BS.ByteString +tracePacket0 = BS.concat + [ "2dd2f49c1f5af0fcad371d96e8cddbdcd5096dc309c1d4e110f955926506b3c0" + , "3b44c192896f45610741c85ed4074212537e0c118d472ff3a559ae244acd9d78" + , "3c65977765c5d4e00b723d00f12475aafaafff7b31c1be5a589e6e25f8da2959" + , "107206dd42bbcb43438129ce6cce2b6b4ae63edc76b876136ca5ea6cd1c6a04c" + , "a86eca143d15e53ccdc9e23953e49dc2f87bb11e5238cd6536e57387225b8fff" + , "3bf5f3e686fd08458ffe0211b87d64770db9353500af9b122828a006da754cf9" + , "79738b4374e146ea79dd93656170b89c98c5f2299d6e9c0410c826c721950c78" + , "0486cd6d5b7130380d7eaff994a8503a8fef3270ce94889fe996da66ed121741" + , "987010f785494415ca991b2e8b39ef2df6bde98efd2aec7d251b2772485194c8" + , "368451ad49c2354f9d30d95367bde316fec6cbdddc7dc0d25e99d3075e13d3de" + , "0822669861dafcd29de74eac48b64411987285491f98d78584d0c2a163b7221e" + , "a796f9e8671b2bb91e38ef5e18aaf32c6c02f2fb690358872a1ed28166172631" + , "a82c2568d23238017188ebbd48944a147f6cdb3690d5f88e51371cb70adf1fa0" + , "2afe4ed8b581afc8bcc5104922843a55d52acde09bc9d2b71a663e178788280f" + , "3c3eae127d21b0b95777976b3eb17be40a702c244d0e5f833ff49dae6403ff44" + , "b131e66df8b88e33ab0a58e379f2c34bf5113c66b9ea8241fc7aa2b1fa53cf4e" + , "d3cdd91d407730c66fb039ef3a36d4050dde37d34e80bcfe02a48a6b14ae2822" + , "7b1627b5ad07608a7763a531f2ffc96dff850e8c583461831b19feffc783bc1b" + , "eab6301f647e9617d14c92c4b1d63f5147ccda56a35df8ca4806b8884c4aa3c3" + , "cc6a174fdc2232404822569c01aba686c1df5eecc059ba97e9688c8b16b70f0d" + , "24eacfdba15db1c71f72af1b2af85bd168f0b0800483f115eeccd9b02adf03bd" + , "d4a88eab03e43ce342877af2b61f9d3d85497cd1c6b96674f3d4f07f635bb26a" + , "dd1e36835e321d70263b1c04234e222124dad30ffb9f2a138e3ef453442df1af" + , "7e566890aedee568093aa922dd62db188aa8361c55503f8e2c2e6ba93de744b5" + , "5c15260f15ec8e69bb01048ca1fa7bbbd26975bde80930a5b95054688a0ea73a" + , "f0353cc84b997626a987cc06a517e18f91e02908829d4f4efc011b9867bd9bfe" + , "04c5f94e4b9261d30cc39982eb7b250f12aee2a4cce0484ff34eebba89bc6e35" + , "bd48d3968e4ca2d77527212017e202141900152f2fd8af0ac3aa456aae13276a" + , "13b9b9492a9a636e18244654b3245f07b20eb76b8e1cea8c55e5427f08a63a16" + , "b0a633af67c8e48ef8e53519041c9138176eb14b8782c6c2ee76146b8490b979" + , "78ee73cd0104e12f483be5a4af414404618e9f6633c55dda6f22252cb793d3d1" + , "6fae4f0e1431434e7acc8fa2c009d4f6e345ade172313d558a4e61b4377e31b8" + , "ed4e28f7cd13a7fe3f72a409bc3bdabfe0ba47a6d861e21f64d2fac706dab18b" + , "3e546df4" + ] + +-- route-blinding-test.json ---------------------------------------------- + +-- | Bob's node id. +rbBobNodeId :: BS.ByteString +rbBobNodeId = + "0324653eac434488002cc06bbfb7f10fe18991e35f9fe4302dbea6d2353dc0ab1c" + +-- | Bob's encoded encrypted_data_tlv. +rbBobTlvs :: BS.ByteString +rbBobTlvs = BS.concat + [ "011a000000000000000000000000000000000000000000000000000002080000" + , "0000000006c10a0800240000009627100c06000b69e505dc0e00fd0231031234" + , "56" + ] + +-- | Path private key at Bob (the session key for the first hop of a path). +rbBobPathPrivKey :: BS.ByteString +rbBobPathPrivKey = + "0202020202020202020202020202020202020202020202020202020202020202" + +-- | Path key at Bob. +rbBobPathKey :: BS.ByteString +rbBobPathKey = + "024d4b6cd1361032ca9bd2aeb9d900aa4d45d9ead80ac9423374c451a7254d0766" + +-- | Shared secret at Bob. +rbBobSharedSecret :: BS.ByteString +rbBobSharedSecret = + "76771bab0cc3d0de6e6f60147fd7c9c7249a5ced3d0612bdfaeec3b15452229d" + +-- | rho key at Bob. +rbBobRho :: BS.ByteString +rbBobRho = "ba217b23c0978d84c4a19be8a9ff64bc1b40ed0d7ecf59521567a5b3a9a1dd48" + +-- | Bob's encrypted_data. +rbBobEncryptedData :: BS.ByteString +rbBobEncryptedData = BS.concat + [ "cd4100ff9c09ed28102b210ac73aa12d63e90852cebc496c49f57c49982088b4" + , "9f2e70b99287fdee0aa58aa39913ab405813b999f66783aa2fe637b3cda91ffc" + , "0913c30324e2c6ce327e045183e4bffecb" + ] + +-- | Bob's blinded node id. +rbBobBlindedNodeId :: BS.ByteString +rbBobBlindedNodeId = + "03da173ad2aee2f701f17e59fbd16cb708906d69838a5f088e8123fb36e89a2c25" + +-- | Carol's node id. +rbCarolNodeId :: BS.ByteString +rbCarolNodeId = + "027f31ebc5462c1fdce1b737ecff52d37d75dea43ce11c74d25aa297165faa2007" + +-- | Carol's encoded encrypted_data_tlv. +rbCarolTlvs :: BS.ByteString +rbCarolTlvs = BS.concat + [ "020800000000000004510821031b84c5567b126440995d3ed5aaba0565d71e18" + , "34604819ff9c17f5e9d5dd078f0a0800300000006401f40c06000b69c105dc0e" + , "00" + ] + +-- | Path private key at Carol (the session key for the first hop of a path). +rbCarolPathPrivKey :: BS.ByteString +rbCarolPathPrivKey = + "0a2aa791ac81265c139237b2b84564f6000b1d4d0e68d4b9cc97c5536c9b61c1" + +-- | Path key at Carol. +rbCarolPathKey :: BS.ByteString +rbCarolPathKey = + "034e09f450a80c3d252b258aba0a61215bf60dda3b0dc78ffb0736ea1259dfd8a0" + +-- | Shared secret at Carol. +rbCarolSharedSecret :: BS.ByteString +rbCarolSharedSecret = + "dc91516ec6b530a3d641c01f29b36ed4dc29a74e063258278c0eeed50313d9b8" + +-- | rho key at Carol. +rbCarolRho :: BS.ByteString +rbCarolRho = "d1e62bae1a8e169da08e6204997b60b1a7971e0f246814c648125c35660f5416" + +-- | Carol's encrypted_data. +rbCarolEncryptedData :: BS.ByteString +rbCarolEncryptedData = BS.concat + [ "cc0f16524fd7f8bb0b1d8d40ad71709ef140174c76faa574cac401bb8992fef7" + , "6c4d004aa485dd599ed1cf2715f57ff62da5aaec5d7b10d59b04d8a9d77e472b" + , "9b3ecc2179334e411be22fa4c02b467c7e" + ] + +-- | Carol's blinded node id. +rbCarolBlindedNodeId :: BS.ByteString +rbCarolBlindedNodeId = + "02e466727716f044290abf91a14a6d90e87487da160c2a3cbd0d465d7a78eb83a7" + +-- | Dave's node id. +rbDaveNodeId :: BS.ByteString +rbDaveNodeId = + "032c0b7cf95324a07d05398b240174dc0c2be444d96b159aa6c7f7b1e668680991" + +-- | Dave's encoded encrypted_data_tlv. +rbDaveTlvs :: BS.ByteString +rbDaveTlvs = BS.concat + [ "0123000000000000000000000000000000000000000000000000000000000000" + , "0000000000020800000000000002310a060090000000fa0c06000b699105dc0e" + , "00" + ] + +-- | Path private key at Dave (the session key for the first hop of a path). +rbDavePathPrivKey :: BS.ByteString +rbDavePathPrivKey = + "0101010101010101010101010101010101010101010101010101010101010101" + +-- | Path key at Dave. +rbDavePathKey :: BS.ByteString +rbDavePathKey = + "031b84c5567b126440995d3ed5aaba0565d71e1834604819ff9c17f5e9d5dd078f" + +-- | Shared secret at Dave. +rbDaveSharedSecret :: BS.ByteString +rbDaveSharedSecret = + "dc46f3d1d99a536300f17bc0512376cc24b9502c5d30144674bfaa4b923d9057" + +-- | rho key at Dave. +rbDaveRho :: BS.ByteString +rbDaveRho = "393aa55d35c9e207a8f28180b81628a31dff558c84959cdc73130f8c321d6a06" + +-- | Dave's encrypted_data. +rbDaveEncryptedData :: BS.ByteString +rbDaveEncryptedData = BS.concat + [ "0fa0a72cff3b64a3d6e1e4903cf8c8b0a17144aeb249dcb86561adee1f679ee8" + , "db3e561d9c43815fd4bcebf6f58c546da0cd8a9bf5cebd0d554802f6c0255e28" + , "e4a27343f761fe518cd897463187991105" + ] + +-- | Dave's blinded node id. +rbDaveBlindedNodeId :: BS.ByteString +rbDaveBlindedNodeId = + "036861b366f284f0a11738ffbf7eda46241a8977592878fe3175ae1d1e4754eccf" + +-- | Eve's node id. +rbEveNodeId :: BS.ByteString +rbEveNodeId = + "02edabbd16b41c8371b92ef2f04c1185b4f03b6dcd52ba9b78d9d7c89c8f221145" + +-- | Eve's encoded encrypted_data_tlv. +rbEveTlvs :: BS.ByteString +rbEveTlvs = BS.concat + [ "011a00000000000000000000000000000000000000000000000000000604dead" + , "beef0c06000b690105dc0e0f020000000000000000000000000000fdffff0206" + , "c1" + ] + +-- | Path private key at Eve (the session key for the first hop of a path). +rbEvePathPrivKey :: BS.ByteString +rbEvePathPrivKey = + "62e8bcd6b5f7affe29bec4f0515aab2eebd1ce848f4746a9638aa14e3024fb1b" + +-- | Path key at Eve. +rbEvePathKey :: BS.ByteString +rbEvePathKey = + "03e09038ee76e50f444b19abf0a555e8697e035f62937168b80adf0931b31ce52a" + +-- | Shared secret at Eve. +rbEveSharedSecret :: BS.ByteString +rbEveSharedSecret = + "352a706b194c2b6d0a04ba1f617383fb816dc5f8f9ac0b60dd19c9ae3b517289" + +-- | rho key at Eve. +rbEveRho :: BS.ByteString +rbEveRho = "719d0307340b1c68b79865111f0de6e97b093a30bc603cebd1beb9eef116f2d8" + +-- | Eve's encrypted_data. +rbEveEncryptedData :: BS.ByteString +rbEveEncryptedData = BS.concat + [ "da1a7e5f7881219884beae6ae68971de73bab4c3055d9865b1afb60724a2e4d3" + , "f0489ad884f7f3f77149209f0df51efd6b276294a02e3949c7254fbc8b5cab58" + , "212d9a78983e1cf86fe218b30c4ca8f6d8" + ] + +-- | Eve's blinded node id. +rbEveBlindedNodeId :: BS.ByteString +rbEveBlindedNodeId = + "021982a48086cb8984427d3727fe35a03d396b234f0701f5249daa12e8105c8dae" + +-- | Bob's node private key. +rbBobNodeKey :: BS.ByteString +rbBobNodeKey = + "4242424242424242424242424242424242424242424242424242424242424242" + +-- | Bob's blinded private key. +rbBobBlindedPrivKey :: BS.ByteString +rbBobBlindedPrivKey = + "d12fec0332c3e9d224789a17ebd93595f37d37bd8ef8bd3d2e6ce50acb9e554f" + +-- | Next path key after Bob (override if present). +rbBobNextPathKey :: BS.ByteString +rbBobNextPathKey = + "034e09f450a80c3d252b258aba0a61215bf60dda3b0dc78ffb0736ea1259dfd8a0" + +-- | Carol's node private key. +rbCarolNodeKey :: BS.ByteString +rbCarolNodeKey = + "4343434343434343434343434343434343434343434343434343434343434343" + +-- | Carol's blinded private key. +rbCarolBlindedPrivKey :: BS.ByteString +rbCarolBlindedPrivKey = + "bfa697fbbc8bbc43ca076e6dd60d306038a32af216b9dc6fc4e59e5ae28823c1" + +-- | Next path key after Carol (override if present). +rbCarolNextPathKey :: BS.ByteString +rbCarolNextPathKey = + "031b84c5567b126440995d3ed5aaba0565d71e1834604819ff9c17f5e9d5dd078f" + +-- | Dave's node private key. +rbDaveNodeKey :: BS.ByteString +rbDaveNodeKey = + "4444444444444444444444444444444444444444444444444444444444444444" + +-- | Dave's blinded private key. +rbDaveBlindedPrivKey :: BS.ByteString +rbDaveBlindedPrivKey = + "cebc115c7fce4c295dc396dea6c79115b289b8ceeceea2ed61cf31428d88fc4e" + +-- | Next path key after Dave (override if present). +rbDaveNextPathKey :: BS.ByteString +rbDaveNextPathKey = + "03e09038ee76e50f444b19abf0a555e8697e035f62937168b80adf0931b31ce52a" + +-- | Eve's node private key. +rbEveNodeKey :: BS.ByteString +rbEveNodeKey = + "4545454545454545454545454545454545454545454545454545454545454545" + +-- | Eve's blinded private key. +rbEveBlindedPrivKey :: BS.ByteString +rbEveBlindedPrivKey = + "ff4e07da8d92838bedd019ce532eb990ed73b574e54a67862a1df81b40c0d2af" + +-- | Next path key after Eve (override if present). +rbEveNextPathKey :: BS.ByteString +rbEveNextPathKey = + "038fc6859a402b96ce4998c537c823d6ab94d1598fca02c788ba5dd79fbae83589" + +-- blinded-payment-onion-test.json --------------------------------------- + +-- | Session key. +bpSessionKey :: BS.ByteString +bpSessionKey = + "0303030303030303030303030303030303030303030303030303030303030303" + +-- | Associated data. +bpAssocData :: BS.ByteString +bpAssocData = + "4242424242424242424242424242424242424242424242424242424242424242" + +-- | Public key the onion is encrypted to at Alice. +bpAlicePubKey :: BS.ByteString +bpAlicePubKey = + "02eec7245d6b7d2ccb30380bfbe2a3648cd7a942653f5aa340edcea1f283686619" + +-- | Alice's payload, with its length prefix. +bpAlicePayload :: BS.ByteString +bpAlicePayload = "14020301ae2d04030b6e5e0608000000000000000a" + +-- | Public key the onion is encrypted to at Bob. +bpBobPubKey :: BS.ByteString +bpBobPubKey = + "0324653eac434488002cc06bbfb7f10fe18991e35f9fe4302dbea6d2353dc0ab1c" + +-- | Bob's payload, with its length prefix. +bpBobPayload :: BS.ByteString +bpBobPayload = BS.concat + [ "740a4fcd7b00ff9c09ed28102b210ac73aa12d63e90852cebc496c49f57c499a" + , "2888b49f2e72b19446f7e60a818aa2938d8c625415b992b8928a7321edb8f7ce" + , "a40de362bed082ad51acc6156dca5532fb680c21024d4b6cd1361032ca9bd2ae" + , "b9d900aa4d45d9ead80ac9423374c451a7254d0766" + ] + +-- | Public key the onion is encrypted to at Carol. +bpCarolPubKey :: BS.ByteString +bpCarolPubKey = + "02e466727716f044290abf91a14a6d90e87487da160c2a3cbd0d465d7a78eb83a7" + +-- | Carol's payload, with its length prefix. +bpCarolPayload :: BS.ByteString +bpCarolPayload = BS.concat + [ "510a4fcc0f16524fd7f8bb0f4e8d40ad71709ef140174c76faa574cac401bb89" + , "92fef76c4d004aa485dd599ed1cf2715f570f656a5aaecaf1ee8dc9d0fa1d424" + , "759be1932a8f29fac08bc2d2a1ed7159f28b" + ] + +-- | Public key the onion is encrypted to at Dave. +bpDavePubKey :: BS.ByteString +bpDavePubKey = + "036861b366f284f0a11738ffbf7eda46241a8977592878fe3175ae1d1e4754eccf" + +-- | Dave's payload, with its length prefix. +bpDavePayload :: BS.ByteString +bpDavePayload = BS.concat + [ "510a4f0fa1a72cff3b64a3d6e1e4903cf8c8b0a17144aeb249dcb86561adee1f" + , "679ee8db3e561d9e49895fd4bcebf6f58d6f61a6d41a9bf5aa4b045343785663" + , "2e8255c351873143ddf2bb2b0832b091e1b4" + ] + +-- | Public key the onion is encrypted to at Eve. +bpEvePubKey :: BS.ByteString +bpEvePubKey = + "021982a48086cb8984427d3727fe35a03d396b234f0701f5249daa12e8105c8dae" + +-- | Eve's payload, with its length prefix. +bpEvePayload :: BS.ByteString +bpEvePayload = BS.concat + [ "6002030186a004030b6dc80a4fda1c7e5f7881219884beae6ae68971de73bab4" + , "c3055d9865b1afb60722a63c688768042ade22f2c22f5724767d171fd221d3e5" + , "79e43b354cc72e3ef146ada91a892d95fc48662f5b158add0af457da12030249" + , "f0" + ] + +-- | Onion received by Alice. +bpAliceOnion :: BS.ByteString +bpAliceOnion = BS.concat + [ "0002531fe6068134503d2723133227c867ac8fa6c83c537e9a44c3c5bdbdcb1f" + , "e337dadf610256c6ab518495dce9cdedf9391e21a71dada75be905267ba82f32" + , "6c0513dda706908cfee834996700f881b2aed106585d61a2690de4ebe5d56ad2" + , "013b520af2a3c49316bc590ee83e8c31b1eb11ff766dad27ca993326b1ed582f" + , "b451a2ad87fbf6601134c6341c4a2deb6850e25a355be68dbb6923dc89444fdd" + , "74a0f700433b667bda345926099f5547b07e97ad903e8a01566a78ae17736623" + , "9e793dac719de805565b6d0a1d290e273f705cfc56873f8b5e28225f7ded7a1d" + , "4ceffae63f91e477be8c917c786435976102a924ba4ba3de6150c829ce01c254" + , "28f2f5d05ef023be7d590ecdf6603730db3948f80ca1ed3d85227e64ef77200b" + , "9b557f427b6e1073cfa0e63e4485441768b98ab11ba8104a6cee1d7af7bb5ee9" + , "c05cf9cf4718901e92e09dfe5cb3af336a953072391c1e91fc2f4b92e124b38e" + , "0c6d17ef6ba7bbe93f02046975bb01b7f766fcfc5a755af11a90cc7eb3505986" + , "b56e07a7855534d03b79f0dfbfe645b0d6d4185c038771fd25b800aa26b2ed2e" + , "30b1e713659468618a2fea04fcd0473284598f76b11b0d159d343bc9711d3bea" + , "8d561547bcc8fff12317c0e7b1ee75bcb8082d762b6417f99d0f71ff7c060f6b" + , "564ad6827edaffa72eefcc4ce633a8da8d41c19d8f6aebd8878869eb518ccc16" + , "dccae6a94c690957598ce0295c1c46af5d7a2f0955b5400526bfd1430f554562" + , "614b5d00feff3946427be520dee629b76b6a9c2b1da6701c8ca628a69d6d40e2" + , "0dd69d6e879d7a052d9c16f544b49738c7ff3cdd0613e9ed00ead7707702d1a6" + , "a0b88de1927a50c36beb78f4ff81e3dd97b706307596eebb363d418a891e1cb4" + , "589ce86ce81cdc0e1473d7a7dd5f6bb6e147c1f7c46fa879b4512c25704da6cd" + , "bb3c123a72e3585dc07b3e5cbe7fecf3a08426eee8c70ddc46ebf98b0bcb14a0" + , "8c469cb5cfb6702acc0befd17640fa60244eca491280a95fbbc5833d26e4be70" + , "fcf798b55e06eb9fcb156942dcf108236f32a5a6c605687ba4f037eddbb1834d" + , "cbcd5293a0b66c621346ca5d893d239c26619b24c71f25cecc275e1ab24436ac" + , "01c80c0006fab2d95e82e3a0c3ea02d08ec5b24eb39205c49f4b549dcab7a889" + , "62336c4624716902f4e08f2b23cfd324f18405d66e9da3627ac34a6873ba2238" + , "386313af20d5a13bbd507fdc73015a17e3bd38fae1145f7f70d7cb8c5e1cdf9c" + , "f06d1246592a25d56ec2ae44cd7f75aa7f5f4a2b2ee49a41a26be4fab3f3f2ce" + , "b7b08510c5e2b7255326e4c417325b333cafe96dde1314a15dd6779a7d5a8a40" + , "622260041e936247eec8ec39ca29a1e18161db37497bdd4447a7d5ef3b8d22a2" + , "acd7f486b152bb66d3a15afc41dc9245a8d75e1d33704d4471e417ccc8d31645" + , "fdd647a2c191692675cf97664951d6ce98237d78b0962ad1433b5a3e49ddddbf" + , "57a391b14dcce00b4d7efe5cbb1e78f30d5ef53d66c381a45e275d2dcf6be559" + , "acb3c42494a9a2156eb8dcf03dd92b2ebaa697ea628fa0f75f125e4a7daa10f8" + , "dcf56ebaf7814557708c75580fad2bbb33e66ad7a4788a7aaac792aaae76138d" + , "7ff09df6a1a1920ddcf22e5e7007b15171b51ff81799355232ce39f7d5ceeaf7" + , "04255d790041d6390a69f42816cba641ec81faa3d7c0fdec59dfe4ca41f31a69" + , "2eaffc66b083995d86c575aea4514a3e09e8b3a1fa4d1591a2505f253ad0b6bf" + , "d9d87f063d2be414d3a427c0506a88ac5bdbef9b50d73bce876f85c196dca435" + , "e210e1d6713695b529ddda3350fb5065a6a8288abd265380917bac8ebbc7d5ce" + , "d564587471dddf90c22ce6dbadea7e7a6723438d4cf6ac6dae27d033a8cadd77" + , "ab262e8defb33445ddb2056ec364c7629c33745e2338" + ] + +-- | Onion received by Bob. +bpBobOnion :: BS.ByteString +bpBobOnion = BS.concat + [ "000280caa47c2a0ea677f6a77529e46caa04212153a8d5f829bee1e7339b17e2" + , "e2a9a3461d10472364a4ff12344beb6df96fb0c38ec47d1e956ddff5a665190f" + , "cca5ed02c3a3903fd8bbd4a4b95b197867c378b67b08f0624cfe80734ba51286" + , "9c0fa22099beb1f6f1ea325b07ce7449736d7ffad79178b428d8ea2d7bc6578f" + , "12dbd788ef933f3b5ba352797c41f6786c3820c96726acf8bddf2cfa5d9c617d" + , "2b0bd5ab7b93f7964c98f44cf47db8422f47d11100236a29579f1cafcd38bd97" + , "9814e1d2bf6d625edf50e1e21bfaf6268e3180dd7aafd3892da281c6dd53c1c3" + , "66d0fdaf670b6ad84a38d6e8a3f4a80d132d686fd3b7443bc2250023bdb93031" + , "90f74c9220481cf99da30b5ec2bdb5a49028f5014e3eaeaa48429a0c78ebd3bb" + , "7c7d582c22b7d547cd269f0c4490373a81bf92687e73dac2075b4bda189ce0be" + , "225f5f510655e37a6e724a1415bede0a076b92a882cc2a82878ba67aaedf7145" + , "4eb42b7f8638df8e21d5f708006e5112e2dc0a4afbcfed9f2c7959be812853ca" + , "8e313fbc99a0f38f1ee4479c96ccb836632b0808401db159bd2637f7a6640132" + , "41e4664e994a0a9a3940115a702c60381e66d291e1ade1be2802e1226e311e32" + , "01a7c9682b6bc4354caff3d439adb1dfee53ad3fb3dd5e169d64796853bb3231" + , "29f41213b166a7cac00f728c3e33bd7e59aa2ac0d1341cdb1532b507a0f446e5" + , "1022a882ac16405442347b70f78c9b6e122f8e70096a4fae4c0405db5b869e0b" + , "7b59b09519c4dbf4d4980483906e837da0bee93f668ffaad37d6a4764211a02f" + , "95ad2dc2d942c198796741c20a3baf8efb5a53bd9c1a0148318d60a97d0013ab" + , "63269097ea295d62c1426d064f0b31c02e74a348ee0509998e701069f5a1e0c1" + , "086aed38d2ec87da69fb57a992d88ace3b4a16b0960f5a94936e2e684a9926cf" + , "4f911969a2a5d31fed0c7616d30197848253170e51274278873b11f3f5cc1b04" + , "b14aa5812524e4d86cbf08306c2aa671288324d7a009b2be533b1d7d0ce6defe" + , "eb630b86a9655f1e6424fcb559ed67457c115fba0d0719374802ea68fab299fd" + , "3f273be86fa3d2e7456020db2f47c6ec16c21ce6ec65de495e20af1941a5dcd6" + , "5d910c1cb93f22e1318c173c645c81aed681c9704a8a541ac3d6ff604f46d026" + , "0468acbfec1b771b9eb8cd49a2124468dae786571895a569aae18438eaee6343" + , "ab2634823119fa2439634645d12e3b4a748b9cc0398b8416a834eb5d9e5cf619" + , "bbfaba4894d1c574c738caf530d0862f4cc75eb52bd3921d2d9edb09940edb1e" + , "3776423b0046d870ccdcc5d61f72e0440b97a93eeef21fb246a779d339be301a" + , "5971400749d6cc9911dfbf9de8ae86fac83c860fdd0e2bfa40af37c99d50e50f" + , "d6e5ae86597a201112ed404042b55e132f243dec481a2adc1d5e4b71e1efdea8" + , "06ea900b2907ce877742d5ecf700ff3640f737863d0dd7207e462ee8d0e17d52" + , "047a88ae7446f419560d23968bf64957949e36953155b0ac2511c66be2890b40" + , "36329a21e132efb635297a64431899e0c351e50c6682c9b4d79b5d122466d02c" + , "d84f206369417d9c194a9349d3c631d72eb7857a9cd542906fc02ad6cdcf9bcf" + , "25ace3d826b6623fa5164351e14d3f0de5c8445a2ba3aae26595d0e31c3e307c" + , "1d56d4274f61f056145c1b8d6880872b9b10a8bfa4a923cad2edbcf5c50eba48" + , "936ed2bcc0be60eb721a74b46704aaae5ad24e2797852195dfacbb30a777d33b" + , "63d4dc4f35cfbe5e88fd1944c55a54fd53581446ea061ad29f4671da819ad748" + , "8c5dfc700f5f7a1b2af0d6a6e9d9ffc570a6d3209614ab4dc43728f3f0cd7eb4" + , "ce36ccd98936bbcbd32627384434bd01e9c0f93b2a5173fba184685e19b9af78" + , "afe876aa4e4b4242382b293133771d95a2bd83fa9c62" + ] + +-- | Next path key after Bob. +bpBobNextPathKey :: BS.ByteString +bpBobNextPathKey = + "034e09f450a80c3d252b258aba0a61215bf60dda3b0dc78ffb0736ea1259dfd8a0" + +-- | Onion received by Carol. +bpCarolOnion :: BS.ByteString +bpCarolOnion = BS.concat + [ "000288b48876fb0dc0d7375233ccaf2910dc0dc81ba52e5a7906f00d75e0d58d" + , "bd4bb7c2714870529410735f0951e72cbe981e2e167c0d8f3de33a36e39e7846" + , "5aea2acad1e23c78b6fd342d63e37d214c912b4a0be344618f779138edc1b42a" + , "5ca3218ca2fea4be427f6cd0d387160db2bf6c2ba8e82941c8cf3626bd6bed71" + , "87f633012ef49df38f6b12963cb639e9eed1b9d269dcebcbd0b25287aa536ec8" + , "5e7320b02e193122199a745ccbaaebd37f5d4b71f52f9b50feeb793eeef56924" + , "a046bc5e7003f6253e0284a8d3fe2e42c3564050f1e753cd32cc258ac0ffa6e0" + , "5eecad5ba1286f78252e60dd884a65405ab673a85ba52adfa65c1086d4bb37ba" + , "2e0848adb2b04379775ad798492b14e8997f30ffa9cf5d432bdf5b246fce008f" + , "d876399beed827db58195f4f6192f6ff4ec63cb17fdcb497cb7aec26846a71dd" + , "8dca02fc3bb14dd7231a4d62a981bec54b71eb20331096dfa214a0ff4489ee96" + , "db663826ae8c850e9f06baa52a47b8eb576363f97e742aab2dc616acc6e74588" + , "e1d2ac16694febc90abaf5b1c684163c0e615a68d32633f01934adc8c6bf91fa" + , "3fd7aad033b7596d60402494e45e2c1632c40f7bfbd88a81a896a1d28ed6338c" + , "83e1eeaa467945d59998eb456c95f94bf1892e8f326ec2d5e0196b7073f106fe" + , "bc6ab8ca5bcc23f77ffc819bc1b5debce418ccc7d8391bbf33bceee6110beba1" + , "70121bd99f54c956e64970bdab31227b03ee0ea3f01fbd9bd74015f6f82d04fa" + , "b072e8f85f4370d09f41ee3e48eb959767bd989abb4eea42c4daa0437a7f747d" + , "7f9b70eb87b9f9b0b6f283b8205912601a432999b8869fd9fe5bad3572edac24" + , "da7184f9298f21ff60923db277264d29c846dd2f228f6fc53b6b60364237de64" + , "773f803f174ed10229c374f603ccc5fd3a62cb413ffe6f5630dc646bb33f231b" + , "2350537ec39e5d3f2fe1a1cb019ed0b18ad14019cad27afcca8ad70387ca1103" + , "94c0432774f1aa1fa404b2e086c84a55388d3bd102501c78ef925cce89d76fa0" + , "4c3f20f2d1f0ce507ac8b37b7913e3949ba12bbc5a4f6bac37c2415622d365bc" + , "8b83709a28e3d46f3850c89a3ff4d027fef6e3e4ce5c6c85f663c7eaec3c9730" + , "106fb82f53249a905533cfabee812aae51965b24b42f7ab471967bc8e73354e6" + , "9141ee26a1f03684d5fb9c256a34de8257210e0390dd3962db521ae0a3bdab28" + , "300610ab2a634b699e5f092da5a061609ef6414bd805c8171f54ad6f285fb64c" + , "e0becca0b61188badcf8ef21190dad629e3fb3e89f55ebba829919540ebf5f8a" + , "e4283836d3c9133c1ca3365f6b9394916730411650686e0c2ab9c53b6cda9efd" + , "d5cfcb53ba9b6962bb6aa49d0a83a87460b60a9c7d2643ee99afe652883795f1" + , "4014ec5df61b1e30c041c1fa6487f3c82f1ded5f83ffbef5017e197b7fb77be3" + , "b36e284a15e57d45bf9316dcaf97eb78ee4642b731ba05c5063bce1333fab4af" + , "6da97c80a96ee599b4df823efbedc250c0abba9783da7ddf2414b2a4774ff288" + , "0a7dc6791103e18b8631e39743cf9e87aed71700daa5dc72fdae520324741f92" + , "ea3d510ff555dea5e45f15cda87272d4559a12d4777680acb06993840e3c748d" + , "a82c16cae556015fb2acd0335da11a3388575394048ab71199793ab706abc9d6" + , "8add2075d79a5cc0f779845ee8b98951be61fd293d6c15b9d4653935bf17cf50" + , "bd31f8b79e60dba0e7fd6864754fd94262485a4f65e7eb3e1922f51b1a4dd2b4" + , "fd2c20d94d1213fbe90bd603dfc7e15176382e3ce0f43f980d44d23bf3c57f54" + , "a15f42c171a8f2511e28ac178c6f01396e50397a57ffb09c5e6c315bd3ae7983" + , "577c1a0386c6d5d9a2223438e321b0fedfdee58fa452d57dc11a256834bb49ac" + , "9deeec88e4bf563c7340f44a240caec941c7e50f09cf" + ] + +-- | Next path key after Carol. +bpCarolNextPathKey :: BS.ByteString +bpCarolNextPathKey = + "031b84c5567b126440995d3ed5aaba0565d71e1834604819ff9c17f5e9d5dd078f" + +-- | Onion received by Dave. +bpDaveOnion :: BS.ByteString +bpDaveOnion = BS.concat + [ "0003f25471c0f2ff549a7fd7859100306bb6c294c209f34c77f782897f184b96" + , "7c498efc246bdb8e060a6d1cf8dd0d4d732e33311fb96c9e9f1274005fa3d08b" + , "41704a1b7224c6300a7caead7baa0a8263eba2e0de6956ee8e4a1958264f47e4" + , "cf20d194eb576f5bd249ee4fece563f80fd76dc3eaca8f956188406d83195752" + , "b5c90c4b2a5e7ac3a8d5c62b17b551aff48ef6842a7e9326832c9a4a2fd41501" + , "1150a9e71beb901fd9747bac8add1c694b612730dc86b5b19a0bbbc675947a95" + , "3316e3303d7b30c182f94def9206671edac9a3ec3e52d28fc28247a1c73ab751" + , "bf61c82c3950f617e758f79bd0ba294defb20466eaf1e801462046baad3aec3e" + , "5b8868a7b037f23d73a47a7e74c77107334f37388cff863e452820c61d89728f" + , "a75c84bc7cdfc06dcdd1911f5f803353926d073efd65251380e174913aae0331" + , "8ea5b6f0ec83998c55ab99bef62803ea2da9f6d1ea892b90efc4f8ffb685a520" + , "1a781da2e6ac5923645638c9709ae32171a00c0cd3d8c7eedfb06b4eedc7d3e5" + , "66987e2e3805a038f21d78ded5d6c7137a5e8e592f3180ee4d5f4e1289176f67" + , "fc38690d0958bc82e240b72b10577f340f1e14b8633f0b6d9729ff4618be2a97" + , "2400a015a871ba33be70335f652a8d70f2bd32421d6ac2af781d667dad787d6a" + , "ef4505a15d046579e46eebe757444cffca6d0610f0dd36a7ce57af969bd0c3f7" + , "006298ef406a25f689daf58f875d44d2423ebf195b503f11c37c506ea6abe50a" + , "463f7bb5e9b964604d832724de768513f6b38bf71715e1feea8a6e86797788d4" + , "87146891564919da1372016ed8f08c7fcbff66a4a65a3d0fcd8e3daac6eba41f" + , "5d65ef2d8075364a9e78b3a273549f6eac4abb72e912e237990367e0d43e8994" + , "5f8ac3907be5a6c662139485a50cb5ce3f0ba08586c39f6c515368ec3f91b722" + , "95f1b7a73a9df322ae9a45d363d6c616be3300083764cbdee31221f25a318f09" + , "5feacb09f957c96db30fccca47a0215b576c3ed925a0bad05d6400abe318c11f" + , "36628c387a4ee38832182cd44b3cd48e5422c1f1e3b57218dfe72c611f541512" + , "7720e60f6e2400607e61841b76de1704bcbeb0daf1377ccb2253916de2b6d490" + , "bb71ba0a44fea2e94f2423d723934557d5905e01b2b80232a884e258d46dc92e" + , "a11e0818d0ece5b914f02049866e151801ab8c9aea155479b354dc91151fb9ba" + , "43277458f9760dd859faaa139e3b9ab36a1dbc36a93ef2c90598b20cb30ef3c4" + , "f23a2d6178b4d1da668fb328a25d84d30a132d9f2a6a988cbe2e5c2be01cb6db" + , "4b4725a50d6cdacf5fb083e7d650a25bec1407fbc047d26076c7596429a29606" + , "ad527e97ef0824ad6c1b05831a3e5b71c63a528918a3301cdd4061fc1fcce3da" + , "601961f2602a2b002ac8404125c2d52666263858a923e197efcda873c32d8689" + , "7352e4f2264ad6a1b48acc0fe78ff55cb442cb2bb5fa2880810e1d00aa024705" + , "7fb80b7ed36cf9647af41b44ee4a63ee2d6f652526404572520a7d2d9dcde4e6" + , "2df0c3be89f8471550594cdd16a51a9cacc58729c092c68506162fe65edc2314" + , "055d389f724ced189d826a546b5c4d08a43d977b3cf033de5760b71a7cc38ee5" + , "851592031aafb467a89b3b6c7ed67b15d44c48d6baedce3e95e08ec7c55038f3" + , "eba90ccb900895734f0fb7efe54961ce493369cc56416898a9bed7c2482871c1" + , "5a7f1eb5ed17c33657fc31333539c2dfb59461af09e7049228113b5c9feea5a6" + , "e9959c18c51b19c90995afb9c76f2c0c820964cd7989c993a73925818a656c6a" + , "18dcd1a1e3782b2eae06dd5a41250ec2d1c203626ab9920c1673339eff04b1eb" + , "0cab85ef5909f571f9b83cdf21697c9f5cfa1c76e7bca955510e2126b3bb989a" + , "4ac21cf948f965e48bc363d2997437797b4f770e8b65" + ] + +-- | Next path key after Dave. +bpDaveNextPathKey :: BS.ByteString +bpDaveNextPathKey = + "03e09038ee76e50f444b19abf0a555e8697e035f62937168b80adf0931b31ce52a" + +-- | Onion received by Eve. +bpEveOnion :: BS.ByteString +bpEveOnion = BS.concat + [ "0002ef43c4dfe9aee14248c445406ac7980474ce106c504d9025f57963739130" + , "adfd06eb26201baee8866af2d1b7a7ab26595349dad002af0590193aaa8f400a" + , "b394f5994ec831aeeecb64421c566e3556cbdd7e7e50deb1fc49fd5e007308ab" + , "6494415514abff978899623f9b6065ca1e243bb78170118e8b8c8b53b750b59c" + , "c1ec017d167adbb3aabab7c2d84fbf94f5d827239f4c2b9d2c3cfe68fe5641f2" + , "5e386202a4b6edff2a71e700229df7230c8ca31bd5588f04799e9640c9c20a47" + , "cba713f3cc5ad3202e14bb520880f2a8409d8e7835cae21b48a651c2d47fe6af" + , "785889ab98f1416f6e4ad67a66ae681e9a8828bad3f9b6890221c4a7ec80531d" + , "6b63eb30843f613ce644795bc8bcee60e8f7b36f3fd04de762f103c52efaf36a" + , "2f3bbbaac482d6271dc4180c10bcc076c04d06ea7fd8fb6a647e0e10523b05da" + , "2d89e4139fb55c2315cd01bdcbd57587fef8442d7ff5620630fd2d2e79739d90" + , "be811bf2cba60415d6cba2cea14ba1859f3122cd905c4e12e3e2a1ab6fab54b2" + , "ec40e434626e2d3c3195c02c82a8bd64d226c2328ac72ca12197d9908eaf5433" + , "3717448ce6ed73adc0ac05e2ee1d735131d87918beb8995993dc8f63fe10f2c8" + , "eba2be7ab8bb44d9f78f59ef3e4c180bd75e4eef2381450c6f0480d543997305" + , "f1d07815993b5aca8d88d474966d9abec93bb069a16aa2da75b87f94576e01d0" + , "8a17d3e0e3d0370f010733a7d7affb12cdf94c259a62607fce71003535c47273" + , "05de5ff7bba3840922844b3a45f62c29715fccf440517ef121450f6962396fba" + , "9b07036d085582405dcae6ee95964b66bc7c85b8d02d90091500db3cebf6de58" + , "4f86b7b55335a8c9aa26381b00747f055cc458a2cadfccf9c29702bf941447be" + , "aca6583cca09492a57d4b03b2ca00dbaf41dfd6a9b249381626a7debe475735a" + , "7e39e77a363eccf14669046f656cc09ad448da8d8b545e6a604f46dc481786d0" + , "9a94c63cf23f49ba367d2929466364dbce2a8ffce3dadf8f4cef8a56e1fefa1a" + , "3304a953fe83018e57d8a95694b02d994fea2630a9a3d5f1e2f6d6142d503ec4" + , "152871f7122d7e566a03261f554639e7a759e0e73846f71d5cace37d91336fc9" + , "ca9396bf64ca2cf45fa2db779b3b5c63b04f1c0c1fb79fdfcf5a82b0202df934" + , "ae1720a7ce1e047cbec3f82737b50168c974f4623cacce87e3f5bd5232caca79" + , "56d28ffedcf11ac5998662c5f6b13c6126584ca2e894d3fcbad4d130bbe22e88" + , "a135e0020cdd43853e0b3af3800e9544854d211e873cf68ab683578d501d69ec" + , "5dc7fce42ac436d58243880c1b88227b0681c6c9dd8a8ad0793202b15ab63b78" + , "7b748e258da3e68d0e649fc4ac081a71de8adbc891c113d5f722686b6ac4ed9e" + , "3cc247bc4a4643416f480627e9de20f7307f434a499f5c6951c2e8b3ff51d455" + , "bf65ceb5ee3dee47b968ac2642e13d8a68f903b73627c2e75788fecca5836371" + , "a908eea4f1ea44db2315bc185f77e478efeaaa4da2da13fe7aeaa79ed1d04876" + , "a8b2b7b333c5de8c4c9a50274c2eb7b9bd2a3630c57173174781fc9785235f83" + , "0cefa1c82080eaffdef257f18eedc9ddfd25a696a11a3dc56cd836be72f5f4a2" + , "cbb6316d5d3b1ad91a7ec7d877f28d2c29a5525b0b24362699281b0e3b48f38c" + , "af1085045fe9089f9e6fb29e4b47aa4cecf68c9bf72073469bd9beeea5e88bfe" + , "554cb6a81231149ba7fe7784c154fd8b0f9179ecdf1e9fd5c2939ec1ab16df9c" + , "be9359101ebce933d4f65d3f66f87afaecfe9c046b52f4878b6c430329df7bd8" + , "79fba8864fcbd9b782bf545734699b9b5a66b466dcedc0c9368803b5b0f12329" + , "50cef398ad3e057a5db964bd3e5c8a5717b30b41601a4f11ad63afe404cb6f1e" + , "8ea5fd7a8e085b65ca5136146febf4d47928dcc9a9e0" + ] + +-- | Next path key after Eve. +bpEveNextPathKey :: BS.ByteString +bpEveNextPathKey = + "038fc6859a402b96ce4998c537c823d6ab94d1598fca02c788ba5dd79fbae83589"