packages feed

ppad-secp256k1 0.2.0 → 0.2.1

raw patch · 6 files changed

+262/−42 lines, 6 filesdep +weighdep ~basedep ~bytestringPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: weigh

Dependency ranges changed: base, bytestring

API changes (from Hackage documentation)

- Crypto.Curve.Secp256k1: Context :: {-# UNPACK #-} !Int -> !Array Projective -> Context
- Crypto.Curve.Secp256k1: [ctxArray] :: Context -> !Array Projective
- Crypto.Curve.Secp256k1: [ctxW] :: Context -> {-# UNPACK #-} !Int
- Crypto.Curve.Secp256k1: instance GHC.Classes.Eq Crypto.Curve.Secp256k1.Word256
- Crypto.Curve.Secp256k1: instance GHC.Generics.Generic Crypto.Curve.Secp256k1.Word256
- Crypto.Curve.Secp256k1: instance GHC.Show.Show Crypto.Curve.Secp256k1.Word256
+ Crypto.Curve.Secp256k1: derive_pub' :: Context -> Integer -> Pub
+ Crypto.Curve.Secp256k1: serialize_point :: Projective -> ByteString

Files

CHANGELOG view
@@ -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
bench/Main.hs view
@@ -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) ->
+ bench/Weight.hs view
@@ -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+
lib/Crypto/Curve/Secp256k1.hs view
@@ -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+--   "<secp256k1 point>"+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 <secp256k1 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
ppad-secp256k1.cabal view
@@ -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 
test/Main.hs view
@@ -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