Blinding.hs

{-# 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