commit 980e33ce58cd126eb9f645eef21cfd05192b9849
parent 4010a25186e47ca20ae02d8d342723e466652b4a
Author: Jared Tobin <jared@jtobin.io>
Date: Sun, 23 Nov 2025 17:05:45 +0400
meta: use llvm flag when building ppad-fixed
Diffstat:
4 files changed, 293 insertions(+), 253 deletions(-)
diff --git a/bench/Main.hs b/bench/Main.hs
@@ -1,4 +1,4 @@
-{-# OPTIONS_GHC -fno-warn-incomplete-uni-patterns #-}
+{-# OPTIONS_GHC -fno-warn-incomplete-uni-patterns -fno-warn-type-defaults #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE OverloadedStrings #-}
@@ -11,10 +11,12 @@ import Control.DeepSeq
import Criterion.Main
import qualified Crypto.Curve.Secp256k1 as S
+import qualified Numeric.Montgomery.Secp256k1.Curve as C
+
instance NFData S.Projective
instance NFData S.Affine
-- instance NFData S.ECDSA
--- instance NFData S.Context
+instance NFData S.Context
decodeLenient :: BS.ByteString -> BS.ByteString
decodeLenient bs = case B16.decode bs of
@@ -27,11 +29,11 @@ main = defaultMain [
add
, mul
--, precompute
- --, mul_wnaf
- --, derive_pub
+ , mul_wnaf
+ , derive_pub
--, schnorr
--, ecdsa
- --, ecdh
+ , ecdh
]
parse_int256 :: BS.ByteString -> Integer
@@ -68,6 +70,12 @@ parse_int256 bs = case S.parse_int256 bs of
-- big = BS.replicate 32 0xFF
-- pure (small, big)
+mul_fixed :: Benchmark
+mul_fixed = bgroup "mul_fixed" [
+ bench "curve: M(2) * M(2)" $ nf (C.mul 2) 2
+ , bench "curve: M(2) * M(2 ^ 255 - 19)" $ nf (C.mul 2) (2 ^ 255 - 19)
+ ]
+
add :: Benchmark
add = bgroup "add" [
bench "2 p (double, trivial projective point)" $ nf (S.add p) p
@@ -78,46 +86,50 @@ add = bgroup "add" [
]
mul :: Benchmark
-mul = env setup $ \x ->
- bgroup "mul" [
- bench "2 G" $ nf (S.mul S._CURVE_G) (W.to 2)
- , bench "(2 ^ 255 - 19) G" $ nf (S.mul S._CURVE_G) x
- ]
- where
- setup = pure . W.to . parse_int256 $ decodeLenient
- "7fffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffed"
+mul = bench "mul" $ nf (S.mul p) (W.to 12831231)
--- precompute :: Benchmark
--- precompute = bench "precompute" $ nfIO (pure S.precompute)
---
--- mul_wnaf :: Benchmark
--- mul_wnaf = env setup $ \ ~(tex, x) ->
--- bgroup "mul_wnaf" [
--- bench "2 G" $ nf (S.mul_wnaf tex) 2
--- , bench "(2 ^ 255 - 19) G" $ nf (S.mul_wnaf tex) x
--- ]
--- where
--- setup = do
--- let !tex = S.precompute
--- !int = parse_int256 $ decodeLenient
--- "7fffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffed"
--- pure (tex, int)
---
--- derive_pub :: Benchmark
--- derive_pub = env setup $ \ ~(tex, x) ->
--- bgroup "derive_pub" [
--- bench "sk = 2" $ nf S.derive_pub 2
--- , bench "sk = 2 ^ 255 - 19" $ nf S.derive_pub x
--- , bench "wnaf, sk = 2" $ nf (S.derive_pub' tex) 2
--- , bench "wnaf, sk = 2 ^ 255 - 19" $ nf (S.derive_pub' tex) x
+
+-- mul :: Benchmark
+-- mul = env setup $ \x ->
+-- bgroup "mul" [
+-- bench "2 G" $ nf (S.mul S._CURVE_G) (W.to 2)
+-- , bench "(2 ^ 255 - 19) G" $ nf (S.mul S._CURVE_G) x
-- ]
-- where
--- setup = do
--- let !tex = S.precompute
--- !int = parse_int256 $ decodeLenient
--- "7fffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffed"
--- pure (tex, int)
---
+-- setup = pure . W.to . parse_int256 $ decodeLenient
+-- "7fffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffed"
+
+-- precompute :: Benchmark
+-- precompute = bench "precompute" $ nfIO (pure S.precompute)
+
+mul_wnaf :: Benchmark
+mul_wnaf = env setup $ \ ~(tex, x) ->
+ bgroup "mul_wnaf" [
+ bench "2 G" $ nf (S.mul_wnaf tex) 2
+ , bench "(2 ^ 255 - 19) G" $ nf (S.mul_wnaf tex) x
+ ]
+ where
+ setup = do
+ let !tex = S.precompute
+ !int = parse_int256 $ decodeLenient
+ "7fffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffed"
+ pure (tex, int)
+
+derive_pub :: Benchmark
+derive_pub = env setup $ \ ~(tex, x) ->
+ bgroup "derive_pub" [
+ bench "sk = 2" $ nf S.derive_pub (W.to 2)
+ , bench "sk = 2 ^ 255 - 19" $ nf S.derive_pub x
+ , bench "wnaf, sk = 2" $ nf (S.derive_pub' tex) 2
+ , bench "wnaf, sk = 2 ^ 255 - 19" $ nf (S.derive_pub' tex) (W.from x)
+ ]
+ where
+ setup = do
+ let !tex = S.precompute
+ !int = parse_int256 $ decodeLenient
+ "7fffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffed"
+ pure (tex, W.to int)
+
-- schnorr :: Benchmark
-- schnorr = env setup $ \ ~(tex, big) ->
-- bgroup "schnorr" [
@@ -154,47 +166,66 @@ mul = env setup $ \x ->
-- msg = "i approve of this message"
-- Just sig = S.sign_ecdsa big s_msg
-- pure (tex, big, pub, msg, sig)
---
--- ecdh :: Benchmark
--- ecdh = env setup $ \ ~(big, pub) ->
--- bgroup "ecdh" [
--- bench "ecdh (small)" $ nf (S.ecdh pub) 2
--- , bench "ecdh (large)" $ nf (S.ecdh pub) big
--- ]
--- where
--- setup = do
--- let !big =
--- 0x7fffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffed
--- !(Just !pub) = S.parse_point . decodeLenient $
--- "bd02b9dfc8ef760708950bd972f2dc244893b61b6b46c3b19be1b2da7b034ac5"
--- pure (big, pub)
-p_bs :: BS.ByteString
-p_bs = decodeLenient
- "0279be667ef9dcbbac55a06295ce870b07029bfcdb2dce28d959f2815b16f81798"
+ecdh :: Benchmark
+ecdh = env setup $ \ ~(big, pub) ->
+ bgroup "ecdh" [
+ bench "ecdh (small)" $ nf (S.ecdh pub) (W.to 2)
+ , bench "ecdh (large)" $ nf (S.ecdh pub) big
+ ]
+ where
+ setup = do
+ let !big =
+ W.to 0x7fffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffed
+ !(Just !pub) = S.parse_point . decodeLenient $
+ "bd02b9dfc8ef760708950bd972f2dc244893b61b6b46c3b19be1b2da7b034ac5"
+ pure (big, pub)
-p :: S.Projective
-p = case S.parse_point p_bs of
- Nothing -> error "bang"
- Just !pt -> pt
-q_bs :: BS.ByteString
-q_bs = decodeLenient
- "02f9308a019258c31049344f85f89d5229b531c845836f99b08601f113bce036f9"
+p :: S.Projective
+p = S.Projective
+ 55066263022277343669578718895168534326250603453777594175500187360389116729240
+ 32670510020758816978083085130507043184471273380659243275938904335757337482424
+ 1
q :: S.Projective
-q = case S.parse_point q_bs of
- Nothing -> error "bang"
- Just !pt -> pt
-
-r_bs :: BS.ByteString
-r_bs = decodeLenient
- "03a2113cf152585d96791a42cdd78782757fbfb5c6b2c11b59857eb4f7fda0b0e8"
+q = S.Projective
+ 112711660439710606056748659173929673102114977341539408544630613555209775888121
+ 25583027980570883691656905877401976406448868254816295069919888960541586679410
+ 1
r :: S.Projective
-r = case S.parse_point r_bs of
- Nothing -> error "bang"
- Just !pt -> pt
+r = S.Projective
+ 73305138481390301074068425511419969342201196102229546346478796034582161436904
+ 77311080844824646227678701997218206005272179480834599837053144390237051080427
+ 1
+
+-- p_bs :: BS.ByteString
+-- p_bs = decodeLenient
+-- "0279be667ef9dcbbac55a06295ce870b07029bfcdb2dce28d959f2815b16f81798"
+--
+-- p :: S.Projective
+-- p = case S.parse_point p_bs of
+-- Nothing -> error "bang"
+-- Just !pt -> pt
+--
+-- q_bs :: BS.ByteString
+-- q_bs = decodeLenient
+-- "02f9308a019258c31049344f85f89d5229b531c845836f99b08601f113bce036f9"
+--
+-- q :: S.Projective
+-- q = case S.parse_point q_bs of
+-- Nothing -> error "bang"
+-- Just !pt -> pt
+--
+-- r_bs :: BS.ByteString
+-- r_bs = decodeLenient
+-- "03a2113cf152585d96791a42cdd78782757fbfb5c6b2c11b59857eb4f7fda0b0e8"
+--
+-- r :: S.Projective
+-- r = case S.parse_point r_bs of
+-- Nothing -> error "bang"
+-- Just !pt -> pt
s_bs :: BS.ByteString
s_bs = decodeLenient
@@ -205,13 +236,13 @@ s = case S.parse_point s_bs of
Nothing -> error "bang"
Just !pt -> pt
-t_bs :: BS.ByteString
-t_bs = decodeLenient "04b838ff44e5bc177bf21189d0766082fc9d843226887fc9760371100b7ee20a6ff0c9d75bfba7b31a6bca1974496eeb56de357071955d83c4b1badaa0b21832e9"
-
-t :: S.Projective
-t = case S.parse_point t_bs of
- Nothing -> error "bang"
- Just !pt -> pt
+-- t_bs :: BS.ByteString
+-- t_bs = decodeLenient "04b838ff44e5bc177bf21189d0766082fc9d843226887fc9760371100b7ee20a6ff0c9d75bfba7b31a6bca1974496eeb56de357071955d83c4b1badaa0b21832e9"
+--
+-- t :: S.Projective
+-- t = case S.parse_point t_bs of
+-- Nothing -> error "bang"
+-- Just !pt -> pt
-- s_sk :: Integer
-- s_sk = parse_int256 . decodeLenient $
diff --git a/flake.lock b/flake.lock
@@ -184,11 +184,11 @@
]
},
"locked": {
- "lastModified": 1763816080,
- "narHash": "sha256-dHPSezr7Y5M5YgK2d+p62XW6jckNiDfjpAw32VqT8nQ=",
+ "lastModified": 1763905570,
+ "narHash": "sha256-uqTvkAlY/1rUEQx1G54UuMxkAbrWtLhPtvFU4nmq2Rk=",
"ref": "master",
- "rev": "5145ed6597dfdac8ffa3d52f2ed892f69831315b",
- "revCount": 162,
+ "rev": "1517cd938c0447460d32872e75ab798d2d5d245b",
+ "revCount": 171,
"type": "git",
"url": "git://git.ppad.tech/fixed.git"
},
diff --git a/flake.nix b/flake.nix
@@ -56,17 +56,23 @@
pkgs = import nixpkgs { inherit system; };
hlib = pkgs.haskell.lib;
+ llvm = pkgs.llvmPackages_15.llvm;
base16 = ppad-base16.packages.${system}.default;
sha256 = ppad-sha256.packages.${system}.default;
hmac-drbg = ppad-hmac-drbg.packages.${system}.default;
+
fixed = ppad-fixed.packages.${system}.default;
+ fixed-llvm =
+ hlib.addBuildTools
+ (hlib.enableCabalFlag fixed "llvm")
+ [ llvm ];
hpkgs = pkgs.haskell.packages.ghc981.extend (new: old: {
ppad-base16 = base16;
ppad-sha256 = sha256;
ppad-hmac-drbg = hmac-drbg;
- ppad-fixed = fixed;
+ ppad-fixed = fixed-llvm;
${lib} = new.callCabal2nix lib ./. {
ppad-base16 = new.ppad-base16;
ppad-sha256 = new.ppad-sha256;
@@ -78,7 +84,6 @@
cc = pkgs.stdenv.cc;
ghc = hpkgs.ghc;
cabal = hpkgs.cabal-install;
- llvm = pkgs.llvmPackages_15.llvm;
in
{
packages.default = hpkgs.${lib};
@@ -94,7 +99,7 @@
llvm
];
- inputsFrom = builtins.attrValues self.packages.${system};
+ # inputsFrom = builtins.attrValues self.packages.${system};
doBenchmark = true;
diff --git a/lib/Crypto/Curve/Secp256k1.hs b/lib/Crypto/Curve/Secp256k1.hs
@@ -175,26 +175,26 @@ roll32 bs = go (0 :: Word64) (0 :: Word64) (0 :: Word64) (0 :: Word64) 0 where
in go acc0 acc1 acc2 ((acc3 `B.unsafeShiftL` 8) .|. b) (j + 1)
{-# INLINE roll32 #-}
--- -- this "looks" inefficient due to the call to reverse, but it's
--- -- actually really fast
---
--- -- big-endian bytestring encoding
--- unroll :: Integer -> BS.ByteString
--- unroll i = case i of
--- 0 -> BS.singleton 0
--- _ -> BS.reverse $ BS.unfoldr step i
--- where
--- step 0 = Nothing
--- step m = Just (fi m, m `I.integerShiftR` 8)
---
--- -- big-endian bytestring encoding for 256-bit ints, left-padding with
--- -- zeros if necessary. the size of the integer is not checked.
--- unroll32 :: Integer -> BS.ByteString
--- unroll32 (unroll -> u)
--- | l < 32 = BS.replicate (32 - l) 0 <> u
--- | otherwise = u
--- where
--- l = BS.length u
+-- this "looks" inefficient due to the call to reverse, but it's
+-- actually really fast
+
+-- big-endian bytestring encoding
+unroll :: Integer -> BS.ByteString
+unroll i = case i of
+ 0 -> BS.singleton 0
+ _ -> BS.reverse $ BS.unfoldr step i
+ where
+ step 0 = Nothing
+ step m = Just (fi m, m `I.integerShiftR` 8)
+
+-- big-endian bytestring encoding for 256-bit ints, left-padding with
+-- zeros if necessary. the size of the integer is not checked.
+unroll32 :: Integer -> BS.ByteString
+unroll32 (unroll -> u)
+ | l < 32 = BS.replicate (32 - l) 0 <> u
+ | otherwise = u
+ where
+ l = BS.length u
-- (bip0340) return point with x coordinate == x and with even y coordinate
lift :: Integer -> Maybe Affine
@@ -249,6 +249,10 @@ affine p@(Projective x y z)
let !iz = C.inv z
in Affine (x * iz) (y * iz)
+from_montgomery :: Affine -> Pair Integer Integer
+from_montgomery (Affine (C.retr -> x) (C.retr -> y)) =
+ Pair (W.from x) (W.from y)
+
-- Convert to projective coordinates.
projective :: Affine -> Projective
projective p@(Affine x y)
@@ -598,124 +602,124 @@ mul p sec@(W.Wider _SECRET) = do
-- nm = I.integerShiftR m 1
-- nr = if I.integerTestBit m 0 then add r d else r
-- in loop nr nd nm
+
+-- | Precomputed multiples of the secp256k1 base or generator point.
+data Context = Context {
+ ctxW :: {-# UNPACK #-} !Int
+ , ctxArray :: !(A.Array Projective)
+ } deriving (Eq, Generic)
+
+instance Show Context where
+ show Context {} = "<secp256k1 context>"
+
+-- | Create a secp256k1 context by precomputing multiples of the curve's
+-- generator point.
--
--- -- | Precomputed multiples of the secp256k1 base or generator point.
--- data Context = Context {
--- ctxW :: {-# UNPACK #-} !Int
--- , ctxArray :: !(A.Array Projective)
--- } deriving (Eq, Generic)
---
--- instance Show Context where
--- show Context {} = "<secp256k1 context>"
---
--- -- | Create a secp256k1 context by precomputing multiples of the curve's
--- -- generator point.
--- --
--- -- This should be used once to create a 'Context' to be reused
--- -- repeatedly afterwards.
--- --
--- -- >>> let !tex = precompute
--- -- >>> sign_ecdsa' tex sec msg
--- -- >>> sign_schnorr' tex sec msg aux
--- precompute :: Context
--- precompute = _precompute 8
---
--- -- dumb strict pair
--- data Pair a b = Pair !a !b
---
--- -- translation of noble-secp256k1's 'precompute'
--- _precompute :: Int -> Context
--- _precompute ctxW = Context {..} where
--- ctxArray = A.arrayFromListN size (loop_w mempty _CURVE_G 0)
--- capJ = (2 :: Int) ^ (ctxW - 1)
--- ws = 256 `quot` ctxW + 1
--- size = ws * capJ
---
--- loop_w !acc !p !w
--- | w == ws = reverse acc
--- | otherwise =
--- let b = p
--- !(Pair nacc nb) = loop_j p (b : acc) b 1
--- np = double nb
--- in loop_w nacc np (succ w)
+-- This should be used once to create a 'Context' to be reused
+-- repeatedly afterwards.
--
--- loop_j !p !acc !b !j
--- | j == capJ = Pair acc b
--- | otherwise =
--- let nb = add b p
--- in loop_j p (nb : acc) nb (succ j)
+-- >>> let !tex = precompute
+-- >>> sign_ecdsa' tex sec msg
+-- >>> sign_schnorr' tex sec msg aux
+precompute :: Context
+precompute = _precompute 8
+
+-- dumb strict pair
+data Pair a b = Pair !a !b
+
+-- translation of noble-secp256k1's 'precompute'
+_precompute :: Int -> Context
+_precompute ctxW = Context {..} where
+ ctxArray = A.arrayFromListN size (loop_w mempty _CURVE_G 0)
+ capJ = (2 :: Int) ^ (ctxW - 1)
+ ws = 256 `quot` ctxW + 1
+ size = ws * capJ
+
+ loop_w !acc !p !w
+ | w == ws = reverse acc
+ | otherwise =
+ let b = p
+ !(Pair nacc nb) = loop_j p (b : acc) b 1
+ np = double nb
+ in loop_w nacc np (succ w)
+
+ loop_j !p !acc !b !j
+ | j == capJ = Pair acc b
+ | otherwise =
+ let nb = add b p
+ in loop_j p (nb : acc) nb (succ j)
-- -- Timing-safe wNAF (w-ary non-adjacent form) scalar multiplication of
--- -- secp256k1 points.
--- mul_wnaf :: Context -> Integer -> Maybe Projective
--- mul_wnaf Context {..} _SECRET = do
--- guard (ge _SECRET)
--- pure $! loop 0 _CURVE_ZERO _CURVE_G _SECRET
--- where
--- wins = 256 `quot` ctxW + 1
--- wsize = 2 ^ (ctxW - 1)
--- mask = 2 ^ ctxW - 1
--- mnum = 2 ^ ctxW
---
--- loop !w !acc !f !n
--- | w == wins = acc
--- | otherwise =
--- let !off0 = w * fi wsize
---
--- -- XX branches on secret data
---
--- -- b0 = n & (m-1)
--- -- carry = (b0 >> (w-1)) & 1 -- 0 or 1
--- -- d = b0 - carry*m -- signed in [-(m-1), ..., +(m-1)]
--- -- n' = (n >> w) + carry
--- !b0 = n `I.integerAnd` mask
--- !n0 = n `I.integerShiftR` fi ctxW
---
--- !(Pair b1 n1) | b0 > wsize = Pair (b0 - mnum) (n0 + 1)
--- | otherwise = Pair b0 n0
---
--- -- XX branches on secret data
---
--- -- sgn = maskbit(d < 0) -- 0x..FF if d<0 else 0x..00
--- -- ad = abs(d) = (d ^ sgn) - sgn
--- !c0 = B.testBit w 0
--- !c1 = b1 < 0
---
--- !off1 = off0 + fi (abs b1) - 1
---
--- in if b1 == 0
--- then let !pr = A.indexArray ctxArray off0
--- !pt | c0 = neg pr
--- | otherwise = pr
--- in loop (w + 1) acc (add f pt) n1
--- else let !pr = A.indexArray ctxArray off1
--- !pt | c1 = neg pr
--- | otherwise = pr
--- in loop (w + 1) (add acc pt) f n1
--- {-# INLINE mul_wnaf #-}
-
--- -- | Derive a public key (i.e., a secp256k1 point) from the provided
--- -- secret.
--- --
--- -- >>> import qualified System.Entropy as E
--- -- >>> sk <- fmap parse_int256 (E.getEntropy 32)
--- -- >>> derive_pub sk
--- -- Just "<secp256k1 point>"
--- derive_pub :: Integer -> Maybe Pub
--- derive_pub = mul _CURVE_G
--- {-# NOINLINE derive_pub #-}
---
--- -- | The same as 'derive_pub', except uses a 'Context' to optimise
--- -- internal calculations.
--- --
--- -- >>> import qualified System.Entropy as E
--- -- >>> sk <- fmap parse_int256 (E.getEntropy 32)
--- -- >>> let !tex = precompute
--- -- >>> derive_pub' tex sk
--- -- Just "<secp256k1 point>"
--- derive_pub' :: Context -> Integer -> Maybe Pub
--- derive_pub' = mul_wnaf
--- {-# NOINLINE derive_pub' #-}
+-- secp256k1 points.
+mul_wnaf :: Context -> Integer -> Maybe Projective
+mul_wnaf Context {..} _SECRET = do
+ guard (ge _SECRET)
+ pure $! loop 0 _CURVE_ZERO _CURVE_G _SECRET
+ where
+ wins = 256 `quot` ctxW + 1
+ wsize = 2 ^ (ctxW - 1)
+ mask = 2 ^ ctxW - 1
+ mnum = 2 ^ ctxW
+
+ loop !w !acc !f !n
+ | w == wins = acc
+ | otherwise =
+ let !off0 = w * fi wsize
+
+ -- XX branches on secret data
+
+ -- b0 = n & (m-1)
+ -- carry = (b0 >> (w-1)) & 1 -- 0 or 1
+ -- d = b0 - carry*m -- signed in [-(m-1), ..., +(m-1)]
+ -- n' = (n >> w) + carry
+ !b0 = n `I.integerAnd` mask
+ !n0 = n `I.integerShiftR` fi ctxW
+
+ !(Pair b1 n1) | b0 > wsize = Pair (b0 - mnum) (n0 + 1)
+ | otherwise = Pair b0 n0
+
+ -- XX branches on secret data
+
+ -- sgn = maskbit(d < 0) -- 0x..FF if d<0 else 0x..00
+ -- ad = abs(d) = (d ^ sgn) - sgn
+ !c0 = B.testBit w 0
+ !c1 = b1 < 0
+
+ !off1 = off0 + fi (abs b1) - 1
+
+ in if b1 == 0
+ then let !pr = A.indexArray ctxArray off0
+ !pt | c0 = neg pr
+ | otherwise = pr
+ in loop (w + 1) acc (add f pt) n1
+ else let !pr = A.indexArray ctxArray off1
+ !pt | c1 = neg pr
+ | otherwise = pr
+ in loop (w + 1) (add acc pt) f n1
+{-# INLINE mul_wnaf #-}
+
+-- | Derive a public key (i.e., a secp256k1 point) from the provided
+-- secret.
+--
+-- >>> import qualified System.Entropy as E
+-- >>> sk <- fmap parse_int256 (E.getEntropy 32)
+-- >>> derive_pub sk
+-- Just "<secp256k1 point>"
+derive_pub :: W.Wider -> Maybe Pub
+derive_pub = mul _CURVE_G
+{-# NOINLINE derive_pub #-}
+
+-- | The same as 'derive_pub', except uses a 'Context' to optimise
+-- internal calculations.
+--
+-- >>> import qualified System.Entropy as E
+-- >>> sk <- fmap parse_int256 (E.getEntropy 32)
+-- >>> let !tex = precompute
+-- >>> derive_pub' tex sk
+-- Just "<secp256k1 point>"
+derive_pub' :: Context -> Integer -> Maybe Pub
+derive_pub' = mul_wnaf
+{-# NOINLINE derive_pub' #-}
-- parsing --------------------------------------------------------------------
@@ -1246,32 +1250,32 @@ _parse_uncompressed h (BS.splitAt _CURVE_Q_BYTES -> (roll32 -> x, roll32 -> y))
-- let Affine (modQ -> v) _ = affine capR
-- guard (v == r)
-- {-# INLINE _verify_ecdsa_unrestricted #-}
---
--- -- ecdh -----------------------------------------------------------------------
---
--- -- SEC1-v2 3.3.1, plus SHA256 hash
---
--- -- | Compute a shared secret, given a secret key and public secp256k1 point,
--- -- via Elliptic Curve Diffie-Hellman (ECDH).
--- --
--- -- The shared secret is the SHA256 hash of the x-coordinate of the
--- -- point obtained by scalar multiplication.
--- --
--- -- >>> let sec_alice = 0x03 -- contrived
--- -- >>> let sec_bob = 2 ^ 128 - 1 -- contrived
--- -- >>> let Just pub_alice = derive_pub sec_alice
--- -- >>> let Just pub_bob = derive_pub sec_bob
--- -- >>> let secret_as_computed_by_alice = ecdh pub_bob sec_alice
--- -- >>> let secret_as_computed_by_bob = ecdh pub_alice sec_bob
--- -- >>> secret_as_computed_by_alice == secret_as_computed_by_bob
--- -- True
--- ecdh
--- :: Projective -- ^ public key
--- -> Integer -- ^ secret key
--- -> Maybe BS.ByteString -- ^ shared secret
--- ecdh pub _SECRET = do
--- pt <- mul pub _SECRET
--- guard (pt /= _CURVE_ZERO)
--- let Affine x _ = affine pt
--- pure $! SHA256.hash (unroll32 x)
---
+
+-- ecdh -----------------------------------------------------------------------
+
+-- SEC1-v2 3.3.1, plus SHA256 hash
+
+-- | Compute a shared secret, given a secret key and public secp256k1 point,
+-- via Elliptic Curve Diffie-Hellman (ECDH).
+--
+-- The shared secret is the SHA256 hash of the x-coordinate of the
+-- point obtained by scalar multiplication.
+--
+-- >>> let sec_alice = 0x03 -- contrived
+-- >>> let sec_bob = 2 ^ 128 - 1 -- contrived
+-- >>> let Just pub_alice = derive_pub sec_alice
+-- >>> let Just pub_bob = derive_pub sec_bob
+-- >>> let secret_as_computed_by_alice = ecdh pub_bob sec_alice
+-- >>> let secret_as_computed_by_bob = ecdh pub_alice sec_bob
+-- >>> secret_as_computed_by_alice == secret_as_computed_by_bob
+-- True
+ecdh
+ :: Projective -- ^ public key
+ -> W.Wider -- ^ secret key
+ -> Maybe BS.ByteString -- ^ shared secret
+ecdh pub _SECRET = do
+ pt <- mul pub _SECRET
+ guard (pt /= _CURVE_ZERO)
+ let !(Pair x _) = from_montgomery (affine pt)
+ pure $! SHA256.hash (unroll32 x)
+
