bolt4

Blinding.hs (5242B)

---

 {-# OPTIONS_HADDOCK hide #-}
 {-# LANGUAGE DeriveGeneric #-}
 
 -- |
 -- Module: Lightning.Protocol.BOLT4.Blinding
 -- Copyright: (c) 2025 Jared Tobin
 -- License: MIT
 -- Maintainer: Jared Tobin <jared@ppad.tech>
 --
 -- Route blinding.
 
 module Lightning.Protocol.BOLT4.Blinding (
     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 Data.ByteString as BS
 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
 
 -- | Why a blinded route could not be created.
 data BlindingError
   = 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)
 
 instance NFData BlindingError
 
 -- | 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.
 --
 --   >>> 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
     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
 
 -- | 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.
 --
 --   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.
 --
 --   >>> 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
 
 -- 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)
 
 -- 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
 
 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