commit f2031cfb310fda6bbe02150668e084cdabea0eca
parent acfdcfd23aa99407cfcf1f03aa3c637edd030a32
Author: Jared Tobin <jared@jtobin.io>
Date: Sun, 17 May 2026 18:46:15 -0230
test: assert wNAF derive_* variants match non-wNAF byte-for-byte
One vector test pinned against Appendix E for derive_pubkey', plus
seven QuickCheck properties (one per wNAF variant) randomly
generating basepoint/per-commit-point pairs from secret keys and
checking byte equivalence with the non-wNAF counterpart.
ppad-secp256k1 added to test-suite deps for S.precompute /
S.derive_pub used in the test fixture.
Diffstat:
2 files changed, 101 insertions(+), 0 deletions(-)
diff --git a/ppad-bolt3.cabal b/ppad-bolt3.cabal
@@ -56,6 +56,7 @@ test-suite bolt3-tests
, base16-bytestring
, bytestring
, ppad-bolt3
+ , ppad-secp256k1 >= 0.5.4 && < 0.6
, QuickCheck
, tasty
, tasty-hunit
diff --git a/test/Main.hs b/test/Main.hs
@@ -2,6 +2,7 @@
module Main where
+import qualified Crypto.Curve.Secp256k1 as S
import qualified Data.ByteString as BS
import qualified Data.ByteString.Base16 as B16
import Data.Maybe (isJust, isNothing)
@@ -13,8 +14,16 @@ import Lightning.Protocol.BOLT3
import Lightning.Protocol.BOLT3.Types
( Pubkey(..), Point(..)
, PaymentHash(..), PerCommitmentPoint(..)
+ , PerCommitmentSecret(..)
)
+-- Module-level wNAF context. Built once; reused across every
+-- equivalence test below. Mirrors how downstream callers should use
+-- it.
+tex :: S.Context
+tex = S.precompute
+{-# NOINLINE tex #-}
+
main :: IO ()
main = defaultMain $ testGroup "ppad-bolt3" [
testGroup "Key derivation" [
@@ -61,6 +70,17 @@ keyDerivationTests = testGroup "BOLT #3 Appendix E" [
Nothing -> assertFailure "derive_pubkey returned Nothing"
Just (Pubkey pk) -> pk @?= expected
+ , testCase "derive_pubkey' matches vector" $ do
+ let basepoint = Point $ hex
+ "036d6caac248af96f6afa7f904f550253a0f3ef3f5aa2fe6838a95b216691468e2"
+ perCommitmentPoint = PerCommitmentPoint $ Point $ hex
+ "025f7117a78150fe2ef97db7cfc83bd57b2e2c0d0dd25eaf467a4a1c2a45ce1486"
+ expected = hex
+ "0235f2dbfaa89b57ec7b055afe29849ef7ddfeb1cefdb9ebdc43f5494984db29e5"
+ case derive_pubkey' tex basepoint perCommitmentPoint of
+ Nothing -> assertFailure "derive_pubkey' returned Nothing"
+ Just (Pubkey pk) -> pk @?= expected
+
, testCase "derive_revocationpubkey" $ do
let revocationBasepoint = RevocationBasepoint $ Point $ hex
"036d6caac248af96f6afa7f904f550253a0f3ef3f5aa2fe6838a95b216691468e2"
@@ -381,8 +401,88 @@ propertyTests = testGroup "invariants" [
propTrimPartition
, testProperty "commitment_fee increases with HTLCs"
propFeeMonotonic
+ , testProperty "derive_per_commitment_point' ≡ derive_per_commitment_point"
+ propDerivePcpEquiv
+ , testProperty "derive_pubkey' ≡ derive_pubkey"
+ propDerivePubkeyEquiv
+ , testProperty "derive_localpubkey' ≡ derive_localpubkey"
+ propDeriveLocalEquiv
+ , testProperty "derive_local_htlcpubkey' ≡ derive_local_htlcpubkey"
+ propDeriveLocalHtlcEquiv
+ , testProperty "derive_remote_htlcpubkey' ≡ derive_remote_htlcpubkey"
+ propDeriveRemoteHtlcEquiv
+ , testProperty "derive_local_delayedpubkey' ≡ derive_local_delayedpubkey"
+ propDeriveLocalDelEquiv
+ , testProperty "derive_remote_delayedpubkey' ≡ derive_remote_delayedpubkey"
+ propDeriveRemoteDelEquiv
]
+-- | Random 32-byte secret, then derive a basepoint and per-commit
+-- point from it. Returns (basepoint, pcp). Using derived points
+-- keeps us on the curve without having to generate valid points
+-- directly.
+genPointPair :: Gen (Point, PerCommitmentPoint)
+genPointPair = do
+ sk1 <- vectorOf 32 (choose (0, 255 :: Int))
+ sk2 <- vectorOf 32 (choose (0, 255 :: Int))
+ let bs1 = BS.pack (fmap fromIntegral sk1)
+ bs2 = BS.pack (fmap fromIntegral sk2)
+ mkPt b = case S.parse_int256 b of
+ Nothing -> Nothing
+ Just w -> S.serialize_point <$> S.derive_pub w
+ case (mkPt bs1, mkPt bs2) of
+ (Just p1, Just p2) ->
+ pure (Point p1, PerCommitmentPoint (Point p2))
+ _ -> genPointPair -- ~negligible retry; sk=0 or sk>=q
+
+propDerivePcpEquiv :: Property
+propDerivePcpEquiv =
+ forAll (vectorOf 32 (choose (0, 255 :: Int))) $ \sk ->
+ let bs = BS.pack (fmap fromIntegral sk)
+ sec = PerCommitmentSecret bs
+ in derive_per_commitment_point' tex sec
+ === derive_per_commitment_point sec
+
+propDerivePubkeyEquiv :: Property
+propDerivePubkeyEquiv =
+ forAll genPointPair $ \(bp, pcp) ->
+ derive_pubkey' tex bp pcp === derive_pubkey bp pcp
+
+propDeriveLocalEquiv :: Property
+propDeriveLocalEquiv =
+ forAll genPointPair $ \(bp, pcp) ->
+ let pbp = PaymentBasepoint bp
+ in derive_localpubkey' tex pbp pcp
+ === derive_localpubkey pbp pcp
+
+propDeriveLocalHtlcEquiv :: Property
+propDeriveLocalHtlcEquiv =
+ forAll genPointPair $ \(bp, pcp) ->
+ let hbp = HtlcBasepoint bp
+ in derive_local_htlcpubkey' tex hbp pcp
+ === derive_local_htlcpubkey hbp pcp
+
+propDeriveRemoteHtlcEquiv :: Property
+propDeriveRemoteHtlcEquiv =
+ forAll genPointPair $ \(bp, pcp) ->
+ let hbp = HtlcBasepoint bp
+ in derive_remote_htlcpubkey' tex hbp pcp
+ === derive_remote_htlcpubkey hbp pcp
+
+propDeriveLocalDelEquiv :: Property
+propDeriveLocalDelEquiv =
+ forAll genPointPair $ \(bp, pcp) ->
+ let dbp = DelayedPaymentBasepoint bp
+ in derive_local_delayedpubkey' tex dbp pcp
+ === derive_local_delayedpubkey dbp pcp
+
+propDeriveRemoteDelEquiv :: Property
+propDeriveRemoteDelEquiv =
+ forAll genPointPair $ \(bp, pcp) ->
+ let dbp = DelayedPaymentBasepoint bp
+ in derive_remote_delayedpubkey' tex dbp pcp
+ === derive_remote_delayedpubkey dbp pcp
+
-- | commitment_number accepts values in [0, 2^48-1] and
-- rejects values >= 2^48.
propCommitmentNumberRange :: Property
