diff --git a/CHANGELOG b/CHANGELOG --- a/CHANGELOG +++ b/CHANGELOG @@ -1,5 +1,9 @@ # Changelog +- 0.2.1 (2024-12-18) + * Adds 'serialize_point' for compressed-format serialization of + secp256k1 points. + - 0.2.0 (2024-11-08) * Adds wNAF ("w-ary non-adjacent form") scalar multiplication, as well as fast 'sign' and 'verify' variants for Schnorr and ECDSA diff --git a/bench/Main.hs b/bench/Main.hs --- a/bench/Main.hs +++ b/bench/Main.hs @@ -14,7 +14,6 @@ instance NFData S.Affine instance NFData S.ECDSA instance NFData S.Context -instance NFData S.Word256 main :: IO () main = defaultMain [ @@ -93,14 +92,19 @@ pure (tex, int) derive_pub :: Benchmark -derive_pub = env setup $ \x -> +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 ] where - setup = pure . S.parse_int256 $ B16.decodeLenient - "7fffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffed" + setup = do + let !tex = S.precompute + !int = S.parse_int256 $ B16.decodeLenient + "7fffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffed" + pure (tex, int) schnorr :: Benchmark schnorr = env setup $ \ ~(tex, big) -> diff --git a/bench/Weight.hs b/bench/Weight.hs new file mode 100644 --- /dev/null +++ b/bench/Weight.hs @@ -0,0 +1,159 @@ +{-# OPTIONS_GHC -fno-warn-incomplete-uni-patterns #-} +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE OverloadedStrings #-} + +module Main where + +import qualified Data.ByteString as BS +import qualified Data.ByteString.Base16 as B16 +import Control.DeepSeq +import qualified Crypto.Curve.Secp256k1 as S +import qualified Weigh as W + +instance NFData S.Projective +instance NFData S.Affine +instance NFData S.ECDSA +instance NFData S.Context + +big :: Integer +big = 0x7fffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffed + +tex :: S.Context +tex = S.precompute + +-- note that 'weigh' doesn't work properly in a repl +main :: IO () +main = W.mainWith $ do + remQ + parse_int256 + add + mul + mul_unsafe + mul_wnaf + derive_pub + schnorr + ecdsa + +remQ :: W.Weigh () +remQ = W.wgroup "remQ" $ do + W.func "remQ 2" S.remQ 2 + W.func "remQ (2 ^ 255 - 19)" S.remQ big + +parse_int256 :: W.Weigh () +parse_int256 = W.wgroup "parse_int256" $ do + W.func' "parse_int256 (small)" S.parse_int256 (BS.replicate 32 0x00) + W.func' "parse_int256 (big)" S.parse_int256 (BS.replicate 32 0xFF) + +add :: W.Weigh () +add = W.wgroup " add" $ do + W.func "2 p (double, trivial projective point)" (S.add p) p + W.func "2 r (double, nontrivial projective point)" (S.add r) r + W.func "p + q (trivial projective points)" (S.add p) q + W.func "p + s (nontrivial mixed points)" (S.add p) s + W.func "s + r (nontrivial projective points)" (S.add s) r + +mul :: W.Weigh () +mul = W.wgroup "mul" $ do + W.func "2 G" (S.mul S._CURVE_G) 2 + W.func "(2 ^ 255 - 19) G" (S.mul S._CURVE_G) big + +mul_unsafe :: W.Weigh () +mul_unsafe = W.wgroup "mul_unsafe" $ do + W.func "2 G" (S.mul_unsafe S._CURVE_G) 2 + W.func "(2 ^ 255 - 19) G" (S.mul_unsafe S._CURVE_G) big + +mul_wnaf :: W.Weigh () +mul_wnaf = W.wgroup "mul_wnaf" $ do + W.value "precompute" S.precompute + W.func "2 G" (S.mul_wnaf tex) 2 + W.func "(2 ^ 255 - 19) G" (S.mul_wnaf tex) big + +derive_pub :: W.Weigh () +derive_pub = W.wgroup "derive_pub" $ do + W.func "sk = 2" S.derive_pub 2 + W.func "sk = 2 ^ 255 - 19" S.derive_pub big + W.func "wnaf, sk = 2" (S.derive_pub' tex) 2 + W.func "wnaf, sk = 2 ^ 255 - 19" (S.derive_pub' tex) big + +schnorr :: W.Weigh () +schnorr = W.wgroup "schnorr" $ do + W.func "sign_schnorr (small)" (S.sign_schnorr 2 s_msg) s_aux + W.func "sign_schnorr (large)" (S.sign_schnorr big s_msg) s_aux + W.func "sign_schnorr' (small)" (S.sign_schnorr' tex 2 s_msg) s_aux + W.func "sign_schnorr' (large)" (S.sign_schnorr' tex big s_msg) s_aux + W.func "verify_schnorr" (S.verify_schnorr s_msg s_pk) s_sig + W.func "verify_schnorr'" (S.verify_schnorr' tex s_msg s_pk) s_sig + +ecdsa :: W.Weigh () +ecdsa = W.wgroup "ecdsa" $ do + W.func "sign_ecdsa (small)" (S.sign_ecdsa 2) s_msg + W.func "sign_ecdsa (large)" (S.sign_ecdsa big) s_msg + W.func "sign_ecdsa' (small)" (S.sign_ecdsa' tex 2) s_msg + W.func "sign_ecdsa' (large)" (S.sign_ecdsa' tex big) s_msg + W.func "verify_ecdsa" (S.verify_ecdsa msg pub) sig + W.func "verify_ecdsa'" (S.verify_ecdsa' tex msg pub) sig + where + pub = S.derive_pub big + msg = "i approve of this message" + sig = S.sign_ecdsa big s_msg + +s_sk :: Integer +s_sk = S.parse_int256 . B16.decodeLenient $ + "B7E151628AED2A6ABF7158809CF4F3C762E7160F38B4DA56A784D9045190CFEF" + +s_sig :: BS.ByteString +s_sig = B16.decodeLenient "6896BD60EEAE296DB48A229FF71DFE071BDE413E6D43F917DC8DCF8C78DE33418906D11AC976ABCCB20B091292BFF4EA897EFCB639EA871CFA95F6DE339E4B0A" + +s_pk_raw :: BS.ByteString +s_pk_raw = B16.decodeLenient + "DFF1D77F2A671C5F36183726DB2341BE58FEAE1DA2DECED843240F7B502BA659" + +s_pk :: S.Projective +s_pk = case S.parse_point s_pk_raw of + Nothing -> error "bang" + Just !pt -> pt + +s_msg :: BS.ByteString +s_msg = B16.decodeLenient + "243F6A8885A308D313198A2E03707344A4093822299F31D0082EFA98EC4E6C89" + +s_aux :: BS.ByteString +s_aux = B16.decodeLenient + "0000000000000000000000000000000000000000000000000000000000000001" + +p_bs :: BS.ByteString +p_bs = B16.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 = B16.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 = B16.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 = B16.decodeLenient + "0306413898a49c93cccf3db6e9078c1b6a8e62568e4a4770e0d7d96792d1c580ad" + +s :: S.Projective +s = case S.parse_point s_bs of + Nothing -> error "bang" + Just !pt -> pt + diff --git a/lib/Crypto/Curve/Secp256k1.hs b/lib/Crypto/Curve/Secp256k1.hs --- a/lib/Crypto/Curve/Secp256k1.hs +++ b/lib/Crypto/Curve/Secp256k1.hs @@ -24,28 +24,36 @@ -- * secp256k1 points Pub , derive_pub + , derive_pub' -- * Parsing , parse_int256 , parse_point , parse_sig + -- * Serializing + , serialize_point + -- * BIP0340 Schnorr signatures , sign_schnorr - , sign_schnorr' , verify_schnorr - , verify_schnorr' -- * RFC6979 ECDSA , ECDSA(..) , SigType(..) , sign_ecdsa - , sign_ecdsa' , sign_ecdsa_unrestricted - , sign_ecdsa_unrestricted' , verify_ecdsa - , verify_ecdsa' , verify_ecdsa_unrestricted + + -- * Fast variants + , Context + , precompute + , sign_schnorr' + , verify_schnorr' + , sign_ecdsa' + , sign_ecdsa_unrestricted' + , verify_ecdsa' , verify_ecdsa_unrestricted' -- Elliptic curve group operations @@ -54,9 +62,6 @@ , double , mul , mul_unsafe - - , Context(..) - , precompute , mul_wnaf -- Coordinate systems and transformations @@ -67,7 +72,6 @@ , valid -- for testing/benchmarking - , Word256(..) , _sign_ecdsa_no_hash , _sign_ecdsa_no_hash' , _CURVE_P @@ -128,46 +132,33 @@ roll = BS.foldl' alg 0 where alg !a (fi -> !b) = (a `I.integerShiftL` 8) `I.integerOr` b -data Word256 = Word256 - {-# UNPACK #-} !Word64 - {-# UNPACK #-} !Word64 - {-# UNPACK #-} !Word64 - {-# UNPACK #-} !Word64 - deriving (Eq, Show, Generic) - -word256_to_integer :: Word256 -> Integer -word256_to_integer (Word256 w0 w1 w2 w3) = - (fi w0 `B.shiftL` 192) - .|. (fi w1 `B.shiftL` 128) - .|. (fi w2 `B.shiftL` 64) - .|. fi w3 -{-# INLINE word256_to_integer #-} - -- /Note:/ there can be substantial differences in execution time -- when this function is called with "extreme" inputs. For example: a -- bytestring consisting entirely of 0x00 bytes will parse more quickly -- than one consisting of entirely 0xFF bytes. For appropriately-random -- inputs, timings should be indistinguishable. -- --- Using Word256 under the hood speeds up this function dramatically. - -- 256-bit big-endian bytestring decoding. the input size is not checked! roll32 :: BS.ByteString -> Integer -roll32 bs = word256_to_integer $! (go 0 0 0 0 0) where +roll32 bs = go (0 :: Word64) (0 :: Word64) (0 :: Word64) (0 :: Word64) 0 where go !acc0 !acc1 !acc2 !acc3 !j - | j == 32 = Word256 acc0 acc1 acc2 acc3 + | j == 32 = + (fi acc0 `B.unsafeShiftL` 192) + .|. (fi acc1 `B.unsafeShiftL` 128) + .|. (fi acc2 `B.unsafeShiftL` 64) + .|. fi acc3 | j < 8 = let b = fi (BU.unsafeIndex bs j) - in go ((acc0 `B.shiftL` 8) .|. b) acc1 acc2 acc3 (j + 1) + in go ((acc0 `B.unsafeShiftL` 8) .|. b) acc1 acc2 acc3 (j + 1) | j < 16 = let b = fi (BU.unsafeIndex bs j) - in go acc0 ((acc1 `B.shiftL` 8) .|. b) acc2 acc3 (j + 1) + in go acc0 ((acc1 `B.unsafeShiftL` 8) .|. b) acc2 acc3 (j + 1) | j < 24 = let b = fi (BU.unsafeIndex bs j) - in go acc0 acc1 ((acc2 `B.shiftL` 8) .|. b) acc3 (j + 1) + in go acc0 acc1 ((acc2 `B.unsafeShiftL` 8) .|. b) acc3 (j + 1) | otherwise = let b = fi (BU.unsafeIndex bs j) - in go acc0 acc1 acc2 ((acc3 `B.shiftL` 8) .|. b) (j + 1) + 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 @@ -212,7 +203,7 @@ | otherwise = y in if c /= modexp y 2 (fi _CURVE_P) then Nothing - else Just $! (Affine x y_p) + else Just $! Affine x y_p -- coordinate systems & transformations --------------------------------------- @@ -693,6 +684,22 @@ mul _CURVE_G _SECRET {-# 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 +-- "" +derive_pub' :: Context -> Integer -> Pub +derive_pub' tex _SECRET + | not (ge _SECRET) = + error "ppad-secp256k1 (derive_pub): invalid secret key" + | otherwise = + mul_wnaf tex _SECRET +{-# NOINLINE derive_pub' #-} + -- parsing -------------------------------------------------------------------- -- | Parse a positive 256-bit 'Integer', /e.g./ a Schnorr or ECDSA @@ -768,6 +775,17 @@ let (roll -> r, roll -> s) = BS.splitAt 32 bs in ECDSA r s +-- serializing ---------------------------------------------------------------- + +-- | Serialize a secp256k1 point in 33-byte compressed form. +-- +-- >>> serialize_point +-- "<33-byte bytestring>" +serialize_point :: Projective -> BS.ByteString +serialize_point (affine -> Affine x y) = BS.cons b (unroll32 x) where + b | I.integerTestBit y 0 = 0x03 + | otherwise = 0x02 + -- schnorr -------------------------------------------------------------------- -- see https://github.com/bitcoin/bips/blob/master/bip-0340.mediawiki @@ -1126,7 +1144,7 @@ -- You can expect about a 2x performance increase when using this -- function, compared to 'verify_ecdsa'. -- --- let !tex = precompute +-- >>> let !tex = precompute -- >>> verify_ecdsa' tex msg pub valid_sig -- True -- >>> verify_ecdsa' tex msg pub invalid_sig @@ -1161,7 +1179,7 @@ -- You can expect about a 2x performance increase when using this -- function, compared to 'verify_ecdsa_unrestricted'. -- --- let !tex = precompute +-- >>> let !tex = precompute -- >>> verify_ecdsa_unrestricted' tex msg pub valid_sig -- True -- >>> verify_ecdsa_unrestricted' tex msg pub invalid_sig diff --git a/ppad-secp256k1.cabal b/ppad-secp256k1.cabal --- a/ppad-secp256k1.cabal +++ b/ppad-secp256k1.cabal @@ -1,6 +1,6 @@ cabal-version: 3.0 name: ppad-secp256k1 -version: 0.2.0 +version: 0.2.1 synopsis: Schnorr signatures & ECDSA on the elliptic curve secp256k1 license: MIT license-file: LICENSE @@ -72,4 +72,21 @@ , criterion , deepseq , ppad-secp256k1 + +benchmark secp256k1-weigh + type: exitcode-stdio-1.0 + default-language: Haskell2010 + hs-source-dirs: bench + main-is: Weight.hs + + ghc-options: + -rtsopts -O2 -Wall -fno-warn-orphans + + build-depends: + base + , base16-bytestring + , bytestring + , deepseq + , ppad-secp256k1 + , weigh diff --git a/test/Main.hs b/test/Main.hs --- a/test/Main.hs +++ b/test/Main.hs @@ -55,6 +55,7 @@ units :: TestTree units = testGroup "unit tests" [ parse_point_tests + , serialize_point_tests , add_tests , dub_tests ] @@ -66,10 +67,16 @@ , parse_point_test_r ] +serialize_point_tests :: TestTree +serialize_point_tests = testGroup "serialize_point tests" [ + serialize_point_test_p + , serialize_point_test_q + , serialize_point_test_r + ] + render :: Show a => a -> String render = filter (`notElem` ("\"" :: String)) . show --- XX replace these with something non-stupid parse_point_test_p :: TestTree parse_point_test_p = testCase (render p_hex) $ case parse_point (B16.decodeLenient p_hex) of @@ -88,7 +95,18 @@ Nothing -> assertFailure "bad parse" Just r -> assertEqual mempty r_pro r --- XX also make less dumb +serialize_point_test_p :: TestTree +serialize_point_test_p = testCase (render p_hex) $ + assertEqual mempty p_hex (B16.encode (serialize_point p_pro)) + +serialize_point_test_q :: TestTree +serialize_point_test_q = testCase (render q_hex) $ + assertEqual mempty q_hex (B16.encode (serialize_point q_pro)) + +serialize_point_test_r :: TestTree +serialize_point_test_r = testCase (render r_hex) $ + assertEqual mempty r_hex (B16.encode (serialize_point r_pro)) + add_tests :: TestTree add_tests = testGroup "ec addition" [ add_test_pq