ppad-secp256k1 0.1.0 → 0.2.0

raw patch · 8 files changed

+409/−80 lines, 8 filesdep +primitivePVP ok

version bump matches the API change (PVP)

Dependencies added: primitive

API changes (from Hackage documentation)

Files

• CHANGELOG +18/−0
• bench/Main.hs +37/−8
• lib/Crypto/Curve/Secp256k1.hs +293/−33
• ppad-secp256k1.cabal +2/−1
• test/BIP340.hs +21/−9
• test/Main.hs +10/−8
• test/Noble.hs +21/−15
• test/Wycheproof.hs +7/−6

@@ -1,5 +1,23 @@ # Changelog +- 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+    (disambiguated by a trailing apostrophe) that make use of it.++    Each wNAF-powered function requires a 'Context' consisting of+    precomputed secp256k1 generator multiples; one can be gotten via+    'precompute'.++    Note that the non-wNAF-powered sign and verify functions have+    incurred a slight performance decrease (on the order of tens to+    hundreds of microseconds) as a result.++  * Adds 'parse_sig' for parsing compact signatures.++  * Adds a dependency on the 'primitive' library (already transitively required+    via 'ppad-hmac-drbg').+ - 0.1.0 (2024-10-19)   * Initial release, supporting public key derivation and Schnorr &     ECDSA signatures on secp256k1.

@@ -13,6 +13,7 @@ instance NFData S.Projective instance NFData S.Affine instance NFData S.ECDSA+instance NFData S.Context instance NFData S.Word256  main :: IO ()@@ -20,6 +21,8 @@     parse_point   , add   , mul+  , precompute+  , mul_wnaf   , derive_pub   , schnorr   , ecdsa@@ -73,6 +76,22 @@     setup = pure . S.parse_int256 $ B16.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 = S.parse_int256 $ B16.decodeLenient+            "7fffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffed"+      pure (tex, int)+ derive_pub :: Benchmark derive_pub = env setup $ \x ->     bgroup "derive_pub" [@@ -84,31 +103,41 @@       "7fffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffed"  schnorr :: Benchmark-schnorr = env setup $ \big ->+schnorr = env setup $ \ ~(tex, big) ->     bgroup "schnorr" [-      bench "sign_schnorr (small secret)" $ nf (S.sign_schnorr 2 s_msg) s_aux-    , bench "sign_schnorr (large secret)" $ nf (S.sign_schnorr big s_msg) s_aux+      bench "sign_schnorr (small)" $ nf (S.sign_schnorr 2 s_msg) s_aux+    , bench "sign_schnorr (large)" $ nf (S.sign_schnorr big s_msg) s_aux+    , bench "sign_schnorr' (small)" $ nf (S.sign_schnorr' tex 2 s_msg) s_aux+    , bench "sign_schnorr' (large)" $ nf (S.sign_schnorr' tex big s_msg) s_aux     , bench "verify_schnorr" $ nf (S.verify_schnorr s_msg s_pk) s_sig+    , bench "verify_schnorr'" $ nf (S.verify_schnorr' tex s_msg s_pk) s_sig     ]   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)  ecdsa :: Benchmark-ecdsa = env setup $ \ ~(big, pub, msg, sig) ->+ecdsa = env setup $ \ ~(tex, big, pub, msg, sig) ->     bgroup "ecdsa" [       bench "sign_ecdsa (small)" $ nf (S.sign_ecdsa 2) s_msg     , bench "sign_ecdsa (large)" $ nf (S.sign_ecdsa big) s_msg+    , bench "sign_ecdsa' (small)" $ nf (S.sign_ecdsa' tex 2) s_msg+    , bench "sign_ecdsa' (large)" $ nf (S.sign_ecdsa' tex big) s_msg     , bench "verify_ecdsa" $ nf (S.verify_ecdsa msg pub) sig+    , bench "verify_ecdsa'" $ nf (S.verify_ecdsa' tex msg pub) sig     ]   where     setup = do-      let big = S.parse_int256 $ B16.decodeLenient+      let !tex = S.precompute+          big = S.parse_int256 $ B16.decodeLenient             "7fffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffed"           pub = S.derive_pub big           msg = "i approve of this message"           sig = S.sign_ecdsa big s_msg-      pure (big, pub, msg, sig)+      pure (tex, big, pub, msg, sig)  p_bs :: BS.ByteString p_bs = B16.decodeLenient

@@ -4,6 +4,7 @@ {-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE MagicHash #-} {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE UnboxedSums #-} {-# LANGUAGE ViewPatterns #-} @@ -27,18 +28,25 @@   -- * Parsing   , parse_int256   , parse_point+  , parse_sig    -- * 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+  , verify_ecdsa_unrestricted'    -- Elliptic curve group operations   , neg@@ -47,6 +55,10 @@   , mul   , mul_unsafe +  , Context(..)+  , precompute+  , mul_wnaf+   -- Coordinate systems and transformations   , Affine(..)   , Projective(..)@@ -57,6 +69,7 @@   -- for testing/benchmarking   , Word256(..)   , _sign_ecdsa_no_hash+  , _sign_ecdsa_no_hash'   , _CURVE_P   , _CURVE_Q   , _CURVE_G@@ -72,6 +85,7 @@ import qualified Data.Bits as B import qualified Data.ByteString as BS import qualified Data.ByteString.Unsafe as BU+import qualified Data.Primitive.Array as A import Data.STRef import Data.Word (Word8, Word64) import GHC.Generics@@ -342,26 +356,26 @@ -- For a, return x such that a = x x mod _CURVE_P. modsqrtP :: Integer -> Maybe Integer modsqrtP n = runST $ do-    r   <- newSTRef 1-    num <- newSTRef n-    e   <- newSTRef ((_CURVE_P + 1) `I.integerQuot` 4)+  r   <- newSTRef 1+  num <- newSTRef n+  e   <- newSTRef ((_CURVE_P + 1) `I.integerQuot` 4) -    let loop = do-          ev <- readSTRef e-          when (ev > 0) $ do-            when (I.integerTestBit ev 0) $ do-              numv <- readSTRef num-              modifySTRef' r (\rv -> (rv * numv) `I.integerRem` _CURVE_P)-            modifySTRef' num (\numv -> (numv * numv) `I.integerRem` _CURVE_P)-            modifySTRef' e (`I.integerShiftR` 1)-            loop+  let loop = do+        ev <- readSTRef e+        when (ev > 0) $ do+          when (I.integerTestBit ev 0) $ do+            numv <- readSTRef num+            modifySTRef' r (\rv -> (rv * numv) `I.integerRem` _CURVE_P)+          modifySTRef' num (\numv -> (numv * numv) `I.integerRem` _CURVE_P)+          modifySTRef' e (`I.integerShiftR` 1)+          loop -    loop-    rv  <- readSTRef r-    pure $-      if   remP (rv * rv) == n-      then Just $! rv-      else Nothing+  loop+  rv  <- readSTRef r+  pure $+    if   remP (rv * rv) == n+    then Just $! rv+    else Nothing  -- ec point operations -------------------------------------------------------- @@ -560,7 +574,7 @@           in  if   I.integerTestBit m 0               then loop (succ j) (add acc d) f nd nm               else loop (succ j) acc (add f d) nd nm-{-# NOINLINE mul #-}+{-# INLINE mul #-}  -- Timing-unsafe scalar multiplication of secp256k1 points. --@@ -580,6 +594,90 @@               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.+--+--   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)++  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 -> Projective+mul_wnaf Context {..} _SECRET =+    loop 0 _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++              !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++              !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. --@@ -659,6 +757,17 @@           then Just $! p           else Nothing +-- | Parse an ECDSA signature encoded in 64-byte "compact" form.+--+--   >>> parse_sig <64-byte compact signature>+--   "<ecdsa signature>"+parse_sig :: BS.ByteString -> Maybe ECDSA+parse_sig bs+  | BS.length bs /= 64 = Nothing+  | otherwise = pure $+      let (roll -> r, roll -> s) = BS.splitAt 32 bs+      in  ECDSA r s+ -- schnorr -------------------------------------------------------------------- -- see https://github.com/bitcoin/bips/blob/master/bip-0340.mediawiki @@ -682,10 +791,37 @@   -> BS.ByteString  -- ^ message   -> BS.ByteString  -- ^ 32 bytes of auxilliary random data   -> BS.ByteString  -- ^ 64-byte Schnorr signature-sign_schnorr _SECRET m a+sign_schnorr = _sign_schnorr (mul _CURVE_G)++-- | The same as 'sign_schnorr', except uses a 'Context' to optimise+--   internal calculations.+--+--   You can expect about a 2x performance increase when using this+--   function, compared to 'sign_schnorr'.+--+--   >>> import qualified System.Entropy as E+--   >>> aux <- E.getEntropy 32+--   >>> let !tex = precompute+--   >>> sign_schnorr' tex sec msg aux+--   "<64-byte schnorr signature>"+sign_schnorr'+  :: Context        -- ^ secp256k1 context+  -> Integer        -- ^ secret key+  -> BS.ByteString  -- ^ message+  -> BS.ByteString  -- ^ 32 bytes of auxilliary random data+  -> BS.ByteString  -- ^ 64-byte Schnorr signature+sign_schnorr' tex = _sign_schnorr (mul_wnaf tex)++_sign_schnorr+  :: (Integer -> Projective)  -- partially-applied multiplication function+  -> Integer                  -- secret key+  -> BS.ByteString            -- message+  -> BS.ByteString            -- 32 bytes of auxilliary random data+  -> BS.ByteString+_sign_schnorr _mul _SECRET m a   | not (ge _SECRET) = error "ppad-secp256k1 (sign_schnorr): invalid secret key"   | otherwise  =-      let p_proj = mul _CURVE_G _SECRET+      let p_proj = _mul _SECRET           Affine x_p y_p = affine p_proj           d | I.integerTestBit y_p 0 = _CURVE_Q - _SECRET             | otherwise = _SECRET@@ -702,7 +838,7 @@       in  if   k' == 0 -- negligible probability           then error "ppad-secp256k1 (sign_schnorr): invalid k"           else-            let Affine x_r y_r = affine (mul _CURVE_G k')+            let Affine x_r y_r = affine (_mul k')                 k | I.integerTestBit y_r 0 = _CURVE_Q - k'                   | otherwise = k' @@ -717,6 +853,7 @@             in  if   verify_schnorr m p_proj sig                 then sig                 else error "ppad-secp256k1 (sign_schnorr): invalid signature"+{-# INLINE _sign_schnorr #-}  -- | Verify a 64-byte Schnorr signature for the provided message with --   the supplied public key.@@ -730,7 +867,34 @@   -> Pub            -- ^ public key   -> BS.ByteString  -- ^ 64-byte Schnorr signature   -> Bool-verify_schnorr m (affine -> Affine x_p _) sig+verify_schnorr = _verify_schnorr (mul_unsafe _CURVE_G)++-- | The same as 'verify_schnorr', except uses a 'Context' to optimise+--   internal calculations.+--+--   You can expect about a 1.5x performance increase when using this+--   function, compared to 'verify_schnorr'.+--+--   >>> let !tex = precompute+--   >>> verify_schnorr' tex msg pub <valid signature>+--   True+--   >>> verify_schnorr' tex msg pub <invalid signature>+--   False+verify_schnorr'+  :: Context        -- ^ secp256k1 context+  -> BS.ByteString  -- ^ message+  -> Pub            -- ^ public key+  -> BS.ByteString  -- ^ 64-byte Schnorr signature+  -> Bool+verify_schnorr' tex = _verify_schnorr (mul_wnaf tex)++_verify_schnorr+  :: (Integer -> Projective) -- partially-applied multiplication function+  -> BS.ByteString+  -> Pub+  -> BS.ByteString+  -> Bool+_verify_schnorr _mul m (affine -> Affine x_p _) sig   | BS.length sig /= 64 = False   | otherwise = case lift x_p of       Nothing -> False@@ -740,12 +904,13 @@             then False             else let e = modQ . roll32 $ hash_tagged "BIP0340/challenge"                            (unroll32 r <> unroll32 x_P <> m)-                     dif = add (mul_unsafe _CURVE_G s)+                     dif = add (_mul s)                                (neg (mul_unsafe (projective capP) e))                  in  if   dif == _ZERO                      then False                      else let Affine x_R y_R = affine dif                           in  not (I.integerTestBit y_R 0 || x_R /= r)+{-# INLINE _verify_schnorr #-}  -- ecdsa ---------------------------------------------------------------------- -- see https://www.rfc-editor.org/rfc/rfc6979, https://secg.org/sec1-v2.pdf@@ -810,8 +975,24 @@   :: Integer         -- ^ secret key   -> BS.ByteString   -- ^ message   -> ECDSA-sign_ecdsa = _sign_ecdsa LowS Hash+sign_ecdsa = _sign_ecdsa (mul _CURVE_G) LowS Hash +-- | The same as 'sign_ecdsa', except uses a 'Context' to optimise internal+--   calculations.+--+--   You can expect about a 10x performance increase when using this+--   function, compared to 'sign_ecdsa'.+--+--   >>> let !tex = precompute+--   >>> sign_ecdsa' tex sec msg+--   "<ecdsa signature>"+sign_ecdsa'+  :: Context         -- ^ secp256k1 context+  -> Integer         -- ^ secret key+  -> BS.ByteString   -- ^ message+  -> ECDSA+sign_ecdsa' tex = _sign_ecdsa (mul_wnaf tex) LowS Hash+ -- | Produce an ECDSA signature for the provided message, using the --   provided private key. --@@ -826,8 +1007,24 @@   :: Integer        -- ^ secret key   -> BS.ByteString  -- ^ message   -> ECDSA-sign_ecdsa_unrestricted = _sign_ecdsa Unrestricted Hash+sign_ecdsa_unrestricted = _sign_ecdsa (mul _CURVE_G) Unrestricted Hash +-- | The same as 'sign_ecdsa_unrestricted', except uses a 'Context' to+--   optimise internal calculations.+--+--   You can expect about a 10x performance increase when using this+--   function, compared to 'sign_ecdsa_unrestricted'.+--+--   >>> let !tex = precompute+--   >>> sign_ecdsa_unrestricted' tex sec msg+--   "<ecdsa signature>"+sign_ecdsa_unrestricted'+  :: Context        -- ^ secp256k1 context+  -> Integer        -- ^ secret key+  -> BS.ByteString  -- ^ message+  -> ECDSA+sign_ecdsa_unrestricted' tex = _sign_ecdsa (mul_wnaf tex) Unrestricted Hash+ -- Produce a "low-s" ECDSA signature for the provided message, using -- the provided private key. Assumes that the message has already been -- pre-hashed.@@ -838,14 +1035,27 @@   :: Integer        -- ^ secret key   -> BS.ByteString  -- ^ message digest   -> ECDSA-_sign_ecdsa_no_hash = _sign_ecdsa LowS NoHash+_sign_ecdsa_no_hash = _sign_ecdsa (mul _CURVE_G) LowS NoHash -_sign_ecdsa :: SigType -> HashFlag -> Integer -> BS.ByteString -> ECDSA-_sign_ecdsa ty hf _SECRET m+_sign_ecdsa_no_hash'+  :: Context+  -> Integer+  -> BS.ByteString+  -> ECDSA+_sign_ecdsa_no_hash' tex = _sign_ecdsa (mul_wnaf tex) LowS NoHash++_sign_ecdsa+  :: (Integer -> Projective) -- partially-applied multiplication function+  -> SigType+  -> HashFlag+  -> Integer+  -> BS.ByteString+  -> ECDSA+_sign_ecdsa _mul ty hf _SECRET m   | not (ge _SECRET) = error "ppad-secp256k1 (sign_ecdsa): invalid secret key"   | otherwise  = runST $ do       -- RFC6979 sec 3.3a-      let entropy = int2octets _SECRET -- XX timing concern+      let entropy = int2octets _SECRET           nonce   = bits2octets h       drbg <- DRBG.new SHA256.hmac entropy nonce mempty       -- RFC6979 sec 2.4@@ -859,7 +1069,7 @@        sign_loop g = do         k <- gen_k g-        let kg = mul _CURVE_G k+        let kg = _mul k             Affine (modQ -> r) _ = affine kg             s = case modinv k (fi _CURVE_Q) of               Nothing   -> error "ppad-secp256k1 (sign_ecdsa): bad k value"@@ -870,6 +1080,7 @@              in  case ty of                    Unrestricted -> pure sig                    LowS -> pure (low sig)+{-# INLINE _sign_ecdsa #-}  -- RFC6979 sec 3.3b gen_k :: DRBG.DRBG s -> ST s Integer@@ -909,6 +1120,27 @@   | s > B.unsafeShiftR _CURVE_Q 1 = False   | otherwise = verify_ecdsa_unrestricted m p sig +-- | The same as 'verify_ecdsa', except uses a 'Context' to optimise+--   internal calculations.+--+--   You can expect about a 2x performance increase when using this+--   function, compared to 'verify_ecdsa'.+--+--   let !tex = precompute+--   >>> verify_ecdsa' tex msg pub valid_sig+--   True+--   >>> verify_ecdsa' tex msg pub invalid_sig+--   False+verify_ecdsa'+  :: Context       -- ^ secp256k1 context+  -> BS.ByteString -- ^ message+  -> Pub           -- ^ public key+  -> ECDSA         -- ^ signature+  -> Bool+verify_ecdsa' tex m p sig@(ECDSA _ s)+  | s > B.unsafeShiftR _CURVE_Q 1 = False+  | otherwise = verify_ecdsa_unrestricted' tex m p sig+ -- | Verify an unrestricted ECDSA signature for the provided message and --   public key. --@@ -921,7 +1153,34 @@   -> Pub           -- ^ public key   -> ECDSA         -- ^ signature   -> Bool-verify_ecdsa_unrestricted (SHA256.hash -> h) p (ECDSA r s)+verify_ecdsa_unrestricted = _verify_ecdsa_unrestricted (mul_unsafe _CURVE_G)++-- | The same as 'verify_ecdsa_unrestricted', except uses a 'Context' to+--   optimise internal calculations.+--+--   You can expect about a 2x performance increase when using this+--   function, compared to 'verify_ecdsa_unrestricted'.+--+--   let !tex = precompute+--   >>> verify_ecdsa_unrestricted' tex msg pub valid_sig+--   True+--   >>> verify_ecdsa_unrestricted' tex msg pub invalid_sig+--   False+verify_ecdsa_unrestricted'+  :: Context       -- ^ secp256k1 context+  -> BS.ByteString -- ^ message+  -> Pub           -- ^ public key+  -> ECDSA         -- ^ signature+  -> Bool+verify_ecdsa_unrestricted' tex = _verify_ecdsa_unrestricted (mul_wnaf tex)++_verify_ecdsa_unrestricted+  :: (Integer -> Projective) -- partially-applied multiplication function+  -> BS.ByteString+  -> Pub+  -> ECDSA+  -> Bool+_verify_ecdsa_unrestricted _mul (SHA256.hash -> h) p (ECDSA r s)   -- SEC1-v2 4.1.4   | not (ge r) || not (ge s) = False   | otherwise =@@ -933,9 +1192,10 @@             Just si -> si           u1   = remQ (e * s_inv)           u2   = remQ (r * s_inv)-          capR = add (mul_unsafe _CURVE_G u1) (mul_unsafe p u2)+          capR = add (_mul u1) (mul_unsafe p u2)       in  if   capR == _ZERO           then False           else let Affine (modQ -> v) _ = affine capR                in  v == r+{-# INLINE _verify_ecdsa_unrestricted #-} 

@@ -1,6 +1,6 @@ cabal-version:      3.0 name:               ppad-secp256k1-version:            0.1.0+version:            0.2.0 synopsis:           Schnorr signatures & ECDSA on the elliptic curve secp256k1 license:            MIT license-file:       LICENSE@@ -30,6 +30,7 @@     , bytestring >= 0.9 && < 0.13     , ppad-hmac-drbg >= 0.1 && < 0.2     , ppad-sha256 >= 0.2 && < 0.3+    , primitive >= 0.8 && < 0.10  test-suite secp256k1-tests   type:                exitcode-stdio-1.0

@@ -37,26 +37,38 @@   , c_comment :: !BS.ByteString   } deriving Show -execute :: Case -> TestTree-execute Case {..} = testCase ("bip0340 " <> show c_index) $+execute :: Context -> Case -> TestTree+execute tex Case {..} = testCase ("bip0340 " <> show c_index) $   case parse_point (B16.decodeLenient c_pk) of     Nothing -> assertBool mempty (not c_res)     Just pk -> do       if   c_sk == mempty       then do -- no signature; test verification-        let ver = verify_schnorr c_msg pk c_sig+        let ver  = verify_schnorr c_msg pk c_sig+            ver' = verify_schnorr' tex c_msg pk c_sig         if   c_res-        then assertBool mempty ver-        else assertBool mempty (not ver)+        then do+          assertBool mempty ver+          assertBool mempty ver'+        else do+          assertBool mempty (not ver)+          assertBool mempty (not ver')       -- XX test pubkey derivation from sk       else do -- signature present; test sig too         let sk = roll c_sk-            sig = sign_schnorr sk c_msg c_aux-            ver = verify_schnorr c_msg pk sig+            sig  = sign_schnorr sk c_msg c_aux+            sig' = sign_schnorr' tex sk c_msg c_aux+            ver  = verify_schnorr c_msg pk sig+            ver' = verify_schnorr' tex c_msg pk sig         assertEqual mempty c_sig sig+        assertEqual mempty c_sig sig'         if   c_res-        then assertBool mempty ver-        else assertBool mempty (not ver)+        then do+          assertBool mempty ver+          assertBool mempty ver'+        else do+          assertBool mempty (not ver)+          assertBool mempty (not ver')  header :: AT.Parser () header = do

@@ -27,7 +27,8 @@     "etc/ecdsa_secp256k1_sha256_bitcoin_test.json"   noble_ecdsa <- TIO.readFile "etc/noble_ecdsa.json"   bip340 <- BS.readFile "etc/bip-0340-test-vectors.csv"-  let quar = do+  let !tex = precompute+      quar = do         wp0 <- A.decodeStrictText wp_ecdsa_sha256 :: Maybe W.Wycheproof         wp1 <- A.decodeStrictText wp_ecdsa_sha256_bitcoin :: Maybe W.Wycheproof         nob <- A.decodeStrictText noble_ecdsa :: Maybe N.Ecdsa@@ -39,16 +40,17 @@     Nothing -> error "couldn't parse wycheproof vectors"     Just (w0, w1, no, ip) -> defaultMain $ testGroup "ppad-secp256k1" [         units-      , wycheproof_ecdsa_verify_tests "(ecdsa, sha256)" Unrestricted w0-      , wycheproof_ecdsa_verify_tests "(ecdsa, sha256, low-s)" LowS w1-      , N.execute_ecdsa no-      , testGroup "bip0340 vectors (schnorr)" (fmap BIP340.execute ip)+      , wycheproof_ecdsa_verify_tests tex "(ecdsa, sha256)" Unrestricted w0+      , wycheproof_ecdsa_verify_tests tex "(ecdsa, sha256, low-s)" LowS w1+      , N.execute_ecdsa tex no+      , testGroup "bip0340 vectors (schnorr)" (fmap (BIP340.execute tex) ip)       ] -wycheproof_ecdsa_verify_tests :: String -> SigType -> W.Wycheproof -> TestTree-wycheproof_ecdsa_verify_tests msg ty W.Wycheproof {..} =+wycheproof_ecdsa_verify_tests+  :: Context -> String -> SigType -> W.Wycheproof -> TestTree+wycheproof_ecdsa_verify_tests tex msg ty W.Wycheproof {..} =   testGroup ("wycheproof vectors " <> msg) $-    fmap (W.execute_group ty) wp_testGroups+    fmap (W.execute_group tex ty) wp_testGroups  units :: TestTree units = testGroup "unit tests" [

@@ -1,3 +1,4 @@+{-# LANGUAGE BangPatterns #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ViewPatterns #-}@@ -24,46 +25,51 @@   , ec_invalid :: !InvalidTest   } deriving Show -execute_ecdsa :: Ecdsa -> TestTree-execute_ecdsa Ecdsa {..} = testGroup "noble_ecdsa" [-      testGroup "valid" (fmap execute_valid ec_valid)-    , testGroup "invalid (sign)" (fmap execute_invalid_sign iv_sign)-    , testGroup "invalid (verify)" (fmap execute_invalid_verify iv_verify)+execute_ecdsa :: Context -> Ecdsa -> TestTree+execute_ecdsa tex Ecdsa {..} = testGroup "noble_ecdsa" [+      testGroup "valid" (fmap (execute_valid tex) ec_valid)+    , testGroup "invalid (sign)" (fmap (execute_invalid_sign tex) iv_sign)+    , testGroup "invalid (verify)" (fmap (execute_invalid_verify tex) iv_verify)     ]   where     InvalidTest {..} = ec_invalid -execute_valid :: (Int, ValidTest) -> TestTree-execute_valid (label, ValidTest {..}) =+execute_valid :: Context -> (Int, ValidTest) -> TestTree+execute_valid tex (label, ValidTest {..}) =   testCase ("noble-secp256k1, valid (" <> show label <> ")") $ do     let msg = vt_m         x   = vt_d         pec = parse_compact vt_signature         sig = _sign_ecdsa_no_hash x msg+        sig' = _sign_ecdsa_no_hash' tex x msg+    assertEqual mempty sig sig'     assertEqual mempty pec sig -execute_invalid_sign :: (Int, InvalidSignTest) -> TestTree-execute_invalid_sign (label, InvalidSignTest {..}) =+execute_invalid_sign :: Context -> (Int, InvalidSignTest) -> TestTree+execute_invalid_sign tex (label, InvalidSignTest {..}) =     testCase ("noble-secp256k1, invalid sign (" <> show label <> ")") $ do       let x   = ivs_d           m   = ivs_m       err <- catch (pure (_sign_ecdsa_no_hash x m) >> pure False) handler-      if   err+      err' <- catch (pure (_sign_ecdsa_no_hash' tex x m) >> pure False) handler+      if   err || err'       then assertFailure "expected error not caught"       else pure ()   where     handler :: ErrorCall -> IO Bool     handler _ = pure True -execute_invalid_verify :: (Int, InvalidVerifyTest) -> TestTree-execute_invalid_verify (label, InvalidVerifyTest {..}) =+execute_invalid_verify :: Context -> (Int, InvalidVerifyTest) -> TestTree+execute_invalid_verify tex (label, InvalidVerifyTest {..}) =   testCase ("noble-secp256k1, invalid verify (" <> show label <> ")") $     case parse_point (B16.decodeLenient ivv_Q) of       Nothing -> assertBool "no parse" True       Just pub -> do         let sig = parse_compact ivv_signature             ver = verify_ecdsa ivv_m pub sig+            ver' = verify_ecdsa' tex ivv_m pub sig         assertBool mempty (not ver)+        assertBool mempty (not ver')  fi :: (Integral a, Num b) => a -> b fi = fromIntegral@@ -100,9 +106,9 @@     <*> fmap toBS (m .: "signature")  parse_compact :: BS.ByteString -> ECDSA-parse_compact bs =-  let (roll -> r, roll -> s) = BS.splitAt 32 bs-  in  ECDSA r s+parse_compact bs = case parse_sig bs of+  Nothing -> error "bang"+  Just s -> s  data InvalidTest = InvalidTest {     iv_sign   :: ![(Int, InvalidSignTest)]

@@ -30,23 +30,24 @@ roll = BS.foldl' unstep 0 where   unstep a (fi -> b) = (a `I.integerShiftL` 8) `I.integerOr` b -execute_group :: SigType -> EcdsaTestGroup -> TestTree-execute_group ty EcdsaTestGroup {..} =-    testGroup msg (fmap (execute ty pk_uncompressed) etg_tests)+execute_group :: Context -> SigType -> EcdsaTestGroup -> TestTree+execute_group tex ty EcdsaTestGroup {..} =+    testGroup msg (fmap (execute tex ty pk_uncompressed) etg_tests)   where     msg = "wycheproof (" <> T.unpack etg_type <> ", " <> T.unpack etg_sha <> ")"     PublicKey {..} = etg_publicKey -execute :: SigType -> Projective -> EcdsaVerifyTest -> TestTree-execute ty pub EcdsaVerifyTest {..} = testCase report $ do+execute :: Context -> SigType -> Projective -> EcdsaVerifyTest -> TestTree+execute tex ty pub EcdsaVerifyTest {..} = testCase report $ do     let msg = B16.decodeLenient (TE.encodeUtf8 t_msg)         sig = toEcdsa t_sig     case sig of       Left _  -> assertBool mempty (t_result == "invalid")       Right s -> do         let ver = case ty of-              LowS -> verify_ecdsa msg pub s+              LowS -> verify_ecdsa msg pub s && verify_ecdsa' tex msg pub s               Unrestricted -> verify_ecdsa_unrestricted msg pub s+                           && verify_ecdsa_unrestricted' tex msg pub s         if   t_result == "invalid"         then assertBool mempty (not ver)         else assertBool mempty ver