ppad-bolt4 0.0.1 → 0.1.0

raw patch · 15 files changed

+4431/−2859 lines, 15 filesdep +ppad-bolt1dep +ppad-bolt9dep ~bytestringdep ~deepseqdep ~ppad-aeadPVP ok

version bump matches the API change (PVP)

Dependencies added: ppad-bolt1, ppad-bolt9

Dependency ranges changed: bytestring, deepseq, ppad-aead, ppad-chacha, ppad-fixed, ppad-secp256k1, ppad-sha256

API changes (from Hackage documentation)

Files

• CHANGELOG +49/−1
• bench/Fixtures.hs +150/−0
• bench/Main.hs +48/−3
• bench/Weight.hs +33/−4
• lib/Lightning/Protocol/BOLT4.hs +135/−7
• lib/Lightning/Protocol/BOLT4/Blinding.hs +116/−364
• lib/Lightning/Protocol/BOLT4/Codec.hs +303/−339
• lib/Lightning/Protocol/BOLT4/Construct.hs +129/−169
• lib/Lightning/Protocol/BOLT4/Error.hs +93/−195
• lib/Lightning/Protocol/BOLT4/Prim.hs +207/−175
• lib/Lightning/Protocol/BOLT4/Process.hs +135/−190
• lib/Lightning/Protocol/BOLT4/Types.hs +433/−205
• ppad-bolt4.cabal +39/−23
• test/Main.hs +1461/−1184
• test/Vectors.hs +1100/−0

@@ -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.

@@ -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))

@@ -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)+      ]+    ]   ]

@@ -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)

@@ -6,19 +6,147 @@ -- License: MIT -- Maintainer: Jared Tobin <jared@ppad.tech> ----- BOLT4 onion routing for the Lightning Network.+-- Onion routing for the Lightning Network, per BOLT #4+-- (<https://github.com/lightning/bolts/blob/master/04-onion-routing.md>):+-- 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

@@ -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 <jared@ppad.tech> ----- 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

@@ -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 <jared@ppad.tech> ----- 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

@@ -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 <jared@ppad.tech> ----- 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

@@ -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 <jared@ppad.tech> ----- 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

@@ -1,4 +1,4 @@-{-# OPTIONS_HADDOCK prune #-}+{-# OPTIONS_HADDOCK hide #-} {-# LANGUAGE BangPatterns #-} {-# LANGUAGE OverloadedStrings #-} @@ -8,219 +8,251 @@ -- License: MIT -- Maintainer: Jared Tobin <jared@ppad.tech> ----- 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 <redacted>" --- 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 <redacted>)+--   >>> 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 <redacted>" --- | 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 #-}

@@ -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 <jared@ppad.tech> ----- 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

@@ -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 <jared@ppad.tech> ----- 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 <redacted>" --- 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 <redacted>)+--   >>> 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

@@ -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+  (<https://github.com/lightning/bolts/blob/master/04-onion-routing.md>):+  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

@@ -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 <redacted>"+      show ss @?= "SharedSecret <redacted>"+      show ps @?= "PaymentSecret <redacted>"+  ]+  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+    }

@@ -0,0 +1,1100 @@+{-# LANGUAGE OverloadedStrings #-}++-- |+-- Module: Vectors+-- Copyright: (c) 2025 Jared Tobin+-- License: MIT+-- Maintainer: Jared Tobin <jared@ppad.tech>+--+-- 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"