ppad-secp256k1 0.3.0 → 0.4.0

raw patch · 8 files changed

+199/−200 lines, 8 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGELOG +5/−0
• bench/Main.hs +16/−11
• bench/Weight.hs +10/−5
• lib/Crypto/Curve/Secp256k1.hs +160/−178
• ppad-secp256k1.cabal +1/−1
• test/BIP340.hs +3/−2
• test/Noble.hs +3/−2
• test/WycheproofEcdh.hs +1/−1

@@ -1,5 +1,10 @@ # Changelog +- 0.4.0 (2025-06-21)+  * Scalar multiplication, signing, verifying, and ECHD functions are now+    all total, returning 'Nothing' when supplied with invalid inputs.+  * Adds a group element check to 'mul_wnaf'.+ - 0.3.0 (2025-03-14)   * Adds 'ecdh' for computing ECDH secrets, any given secret being the     SHA256 hash of the x-coordinate of the appropriate secp256k1 point.

@@ -28,6 +28,11 @@   , ecdh   ] +parse_int256 :: BS.ByteString -> Integer+parse_int256 bs = case S.parse_int256 bs of+  Nothing -> error "bang"+  Just v -> v+ remQ :: Benchmark remQ = env setup $ \x ->     bgroup "remQ (remainder modulo _CURVE_Q)" [@@ -35,7 +40,7 @@     , bench "remQ (2 ^ 255 - 19)" $ nf S.remQ x     ]   where-    setup = pure . S.parse_int256 $ B16.decodeLenient+    setup = pure . parse_int256 $ B16.decodeLenient       "7fffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffed"  parse_point :: Benchmark@@ -48,8 +53,8 @@ parse_integer :: Benchmark parse_integer = env setup $ \ ~(small, big) ->     bgroup "parse_int256" [-      bench "parse_int256 (small)" $ nf S.parse_int256 small-    , bench "parse_int256 (big)" $ nf S.parse_int256 big+      bench "parse_int256 (small)" $ nf parse_int256 small+    , bench "parse_int256 (big)" $ nf parse_int256 big     ]   where     setup = do@@ -73,7 +78,7 @@     , bench "(2 ^ 255 - 19) G" $ nf (S.mul S._CURVE_G) x     ]   where-    setup = pure . S.parse_int256 $ B16.decodeLenient+    setup = pure . parse_int256 $ B16.decodeLenient       "7fffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffed"  precompute :: Benchmark@@ -88,7 +93,7 @@   where     setup = do       let !tex = S.precompute-          !int = S.parse_int256 $ B16.decodeLenient+          !int = parse_int256 $ B16.decodeLenient             "7fffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffed"       pure (tex, int) @@ -103,7 +108,7 @@   where     setup = do       let !tex = S.precompute-          !int = S.parse_int256 $ B16.decodeLenient+          !int = parse_int256 $ B16.decodeLenient             "7fffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffed"       pure (tex, int) @@ -120,7 +125,7 @@   where     setup = do       let !tex = S.precompute-          !int = S.parse_int256 $ B16.decodeLenient+          !int = parse_int256 $ B16.decodeLenient             "7fffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffed"       pure (tex, int) @@ -137,11 +142,11 @@   where     setup = do       let !tex = S.precompute-          big = S.parse_int256 $ B16.decodeLenient+          big = parse_int256 $ B16.decodeLenient             "7fffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffed"-          pub = S.derive_pub big+          Just pub = S.derive_pub big           msg = "i approve of this message"-          sig = S.sign_ecdsa big s_msg+          Just sig = S.sign_ecdsa big s_msg       pure (tex, big, pub, msg, sig)  ecdh :: Benchmark@@ -203,7 +208,7 @@   Just !pt -> pt  s_sk :: Integer-s_sk = S.parse_int256 . B16.decodeLenient $+s_sk = parse_int256 . B16.decodeLenient $   "B7E151628AED2A6ABF7158809CF4F3C762E7160F38B4DA56A784D9045190CFEF"  s_sig :: BS.ByteString

@@ -15,6 +15,11 @@ instance NFData S.ECDSA instance NFData S.Context +parse_int :: BS.ByteString -> Integer+parse_int bs = case S.parse_int256 bs of+  Nothing -> error "bang"+  Just v -> v+ big :: Integer big = 0x7fffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffed @@ -42,8 +47,8 @@  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)+  W.func' "parse_int (small)" parse_int (BS.replicate 32 0x00)+  W.func' "parse_int (big)" parse_int (BS.replicate 32 0xFF)  add :: W.Weigh () add = W.wgroup " add" $ do@@ -94,9 +99,9 @@     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+    Just pub = S.derive_pub big     msg = "i approve of this message"-    sig = S.sign_ecdsa big s_msg+    Just sig = S.sign_ecdsa big s_msg  ecdh :: W.Weigh () ecdh = W.wgroup "ecdh" $ do@@ -108,7 +113,7 @@       "bd02b9dfc8ef760708950bd972f2dc244893b61b6b46c3b19be1b2da7b034ac5"  s_sk :: Integer-s_sk = S.parse_int256 . B16.decodeLenient $+s_sk = parse_int . B16.decodeLenient $   "B7E151628AED2A6ABF7158809CF4F3C762E7160F38B4DA56A784D9045190CFEF"  s_sig :: BS.ByteString

@@ -88,7 +88,7 @@   , _sign_ecdsa_no_hash'   ) where -import Control.Monad (when)+import Control.Monad (guard, when) import Control.Monad.ST import qualified Crypto.DRBG.HMAC as DRBG import qualified Crypto.Hash.SHA256 as SHA256@@ -96,6 +96,7 @@ import qualified Data.Bits as B import qualified Data.ByteString as BS import qualified Data.ByteString.Unsafe as BU+import qualified Data.Maybe as M (isJust) import qualified Data.Primitive.Array as A import Data.STRef import Data.Word (Word8, Word64)@@ -119,7 +120,7 @@ modexp :: Integer -> Natural -> Natural -> Integer modexp b (fi -> e) m = case I.integerPowMod# b e m of   (# fi -> n | #) -> n-  (# | _ #) -> error "negative power impossible"+  (# | _ #) -> error "ppad-secp256k1 (modexp): internal error" {-# INLINE modexp #-}  -- generic modular inverse@@ -191,17 +192,15 @@  -- (bip0340) return point with x coordinate == x and with even y coordinate lift :: Integer -> Maybe Affine-lift x-  | not (fe x) = Nothing-  | otherwise =-      let c = remP (modexp x 3 (fi _CURVE_P) + 7) -- modexp always nonnegative-          e = (_CURVE_P + 1) `I.integerQuot` 4-          y = modexp c (fi e) (fi _CURVE_P)-          y_p | B.testBit y 0 = _CURVE_P - y-              | otherwise = y-      in  if   c /= modexp y 2 (fi _CURVE_P)-          then Nothing-          else Just $! Affine x y_p+lift x = do+  guard (fe x)+  let c = remP (modexp x 3 (fi _CURVE_P) + 7) -- modexp always nonnegative+      e = (_CURVE_P + 1) `I.integerQuot` 4+      y = modexp c (fi e) (fi _CURVE_P)+      y_p | B.testBit y 0 = _CURVE_P - y+          | otherwise = y+  guard (c == modexp y 2 (fi _CURVE_P))+  pure $! Affine x y_p  -- coordinate systems & transformations --------------------------------------- @@ -238,7 +237,7 @@   | p == _CURVE_ZERO = Affine 0 0   | z == 1     = Affine x y   | otherwise  = case modinv z (fi _CURVE_P) of-      Nothing -> error "ppad-secp256k1 (affine): impossible point"+      Nothing -> error "ppad-secp256k1 (affine): internal error"       Just iz -> Affine (modP (x * iz)) (modP (y * iz))  -- Convert to projective coordinates.@@ -258,9 +257,9 @@ -- curve parameters ----------------------------------------------------------- -- see https://www.secg.org/sec2-v2.pdf for parameter specs +-- ~ 2^256 - 2^32 - 2^9 - 2^8 - 2^7 - 2^6 - 2^4 - 1+ -- | secp256k1 field prime.------   = 2^256 - 2^32 - 2^9 - 2^8 - 2^7 - 2^6 - 2^4 - 1 _CURVE_P :: Integer _CURVE_P = 0xFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFEFFFFFC2F @@ -288,20 +287,20 @@ _CURVE_B :: Integer _CURVE_B = 7 --- | secp256k1 generator point.------ = parse_point+-- ~ parse_point . B16.decode $ --     "0279BE667EF9DCBBAC55A06295CE870B07029BFCDB2DCE28D959F2815B16F81798"++-- | secp256k1 generator point. _CURVE_G :: Projective _CURVE_G = Projective x y 1 where   x = 0x79be667ef9dcbbac55a06295ce870b07029bfcdb2dce28d959f2815b16f81798   y = 0x483ada7726a3c4655da4fbfc0e1108a8fd17b448a68554199c47d08ffb10d4b8 --- | secp256k1 zero point / point at infinity / monoidal identity.+-- | secp256k1 zero point, point at infinity, or monoidal identity. _CURVE_ZERO :: Projective _CURVE_ZERO = Projective 0 1 0 --- secp256k1 zero point / point at infinity / monoidal identity+-- secp256k1 zero point, point at infinity, or monoidal identity _ZERO :: Projective _ZERO = Projective 0 1 0 {-# DEPRECATED _ZERO "use _CURVE_ZERO instead" #-}@@ -365,11 +364,11 @@    loop   rv  <- readSTRef r-  pure $-    if   remP (rv * rv) == n-    then Just $! rv-    else Nothing +  pure $ do+    guard (remP (rv * rv) == n)+    Just $! rv+ -- ec point operations --------------------------------------------------------  -- Negate secp256k1 point.@@ -459,7 +458,7 @@ -- algo 8, renes et al, 2015 add_mixed :: Projective -> Projective -> Projective add_mixed (Projective x1 y1 z1) (Projective x2 y2 z2)-  | z2 /= 1   = error "ppad-secp256k1: internal error"+  | z2 /= 1   = error "ppad-secp256k1 (add_mixed): internal error"   | otherwise = runST $ do       x3 <- newSTRef 0       y3 <- newSTRef 0@@ -554,10 +553,10 @@   Projective <$> readSTRef x3 <*> readSTRef y3 <*> readSTRef z3  -- Timing-safe scalar multiplication of secp256k1 points.-mul :: Projective -> Integer -> Projective-mul p _SECRET-    | not (ge _SECRET) = error "ppad-secp256k1 (mul): scalar not in group"-    | otherwise  = loop (0 :: Int) _CURVE_ZERO _CURVE_G p _SECRET+mul :: Projective -> Integer -> Maybe Projective+mul p _SECRET = do+    guard (ge _SECRET)+    pure $! loop (0 :: Int) _CURVE_ZERO _CURVE_G p _SECRET   where     loop !j !acc !f !d !m       | j == _CURVE_Q_BITS = acc@@ -572,12 +571,11 @@ -- Timing-unsafe scalar multiplication of secp256k1 points. -- -- Don't use this function if the scalar could potentially be a secret.-mul_unsafe :: Projective -> Integer -> Projective+mul_unsafe :: Projective -> Integer -> Maybe Projective mul_unsafe p n-    | n == 0 = _CURVE_ZERO-    | not (ge n) =-        error "ppad-secp256k1 (mul_unsafe): scalar not in group"-    | otherwise  = loop _CURVE_ZERO p n+    | n == 0 = pure $! _CURVE_ZERO+    | not (ge n) = Nothing+    | otherwise  = pure $! loop _CURVE_ZERO p n   where     loop !r !d m       | m <= 0 = r@@ -635,9 +633,10 @@  -- Timing-safe wNAF (w-ary non-adjacent form) scalar multiplication of -- secp256k1 points.-mul_wnaf :: Context -> Integer -> Projective-mul_wnaf Context {..} _SECRET =-    loop 0 _CURVE_ZERO _CURVE_G _SECRET+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)@@ -677,13 +676,9 @@ --   >>> import qualified System.Entropy as E --   >>> sk <- fmap parse_int256 (E.getEntropy 32) --   >>> derive_pub sk---   "<secp256k1 point>"-derive_pub :: Integer -> Pub-derive_pub _SECRET-  | not (ge _SECRET) =-      error "ppad-secp256k1 (derive_pub): invalid secret key"-  | otherwise =-      mul _CURVE_G _SECRET+--   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@@ -693,13 +688,9 @@ --   >>> 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+--   Just "<secp256k1 point>"+derive_pub' :: Context -> Integer -> Maybe Pub+derive_pub' = mul_wnaf {-# NOINLINE derive_pub' #-}  -- parsing --------------------------------------------------------------------@@ -709,12 +700,11 @@ -- --   >>> import qualified Data.ByteString as BS --   >>> parse_int256 (BS.replicate 32 0xFF)---   <2^256 - 1>-parse_int256 :: BS.ByteString -> Integer-parse_int256 bs-  | BS.length bs /= 32 =-      error "ppad-secp256k1 (parse_int256): requires exactly 32-byte input"-  | otherwise = roll32 bs+--   Just <2^256 - 1>+parse_int256 :: BS.ByteString -> Maybe Integer+parse_int256 bs = do+  guard (BS.length bs == 32)+  pure $! roll32 bs  -- | Parse compressed secp256k1 point (33 bytes), uncompressed point (65 --   bytes), or BIP0340-style point (32 bytes).@@ -760,16 +750,15 @@ _parse_uncompressed :: Word8 -> BS.ByteString -> Maybe Projective _parse_uncompressed h (BS.splitAt _CURVE_Q_BYTES -> (roll32 -> x, roll32 -> y))   | h /= 0x04 = Nothing-  | otherwise =+  | otherwise = do       let p = Projective x y 1-      in  if   valid p-          then Just $! p-          else Nothing+      guard (valid p)+      pure $! p  -- | Parse an ECDSA signature encoded in 64-byte "compact" form. -- --   >>> parse_sig <64-byte compact signature>---   "<ecdsa signature>"+--   Just "<ecdsa signature>" parse_sig :: BS.ByteString -> Maybe ECDSA parse_sig bs   | BS.length bs /= 64 = Nothing@@ -805,12 +794,12 @@ --   >>> import qualified System.Entropy as E --   >>> aux <- E.getEntropy 32 --   >>> sign_schnorr sec msg aux---   "<64-byte schnorr signature>"+--   Just "<64-byte schnorr signature>" sign_schnorr   :: Integer        -- ^ secret key   -> BS.ByteString  -- ^ message   -> BS.ByteString  -- ^ 32 bytes of auxilliary random data-  -> BS.ByteString  -- ^ 64-byte Schnorr signature+  -> Maybe BS.ByteString  -- ^ 64-byte Schnorr signature sign_schnorr = _sign_schnorr (mul _CURVE_G)  -- | The same as 'sign_schnorr', except uses a 'Context' to optimise@@ -823,56 +812,54 @@ --   >>> aux <- E.getEntropy 32 --   >>> let !tex = precompute --   >>> sign_schnorr' tex sec msg aux---   "<64-byte schnorr signature>"+--   Just "<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+  -> Maybe BS.ByteString  -- ^ 64-byte Schnorr signature sign_schnorr' tex = _sign_schnorr (mul_wnaf tex)  _sign_schnorr-  :: (Integer -> Projective)  -- partially-applied multiplication function+  :: (Integer -> Maybe 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 _SECRET-          Affine x_p y_p = affine p_proj-          d | I.integerTestBit y_p 0 = _CURVE_Q - _SECRET-            | otherwise = _SECRET+  -> Maybe BS.ByteString+_sign_schnorr _mul _SECRET m a = do+  p_proj <- _mul _SECRET+  let Affine x_p y_p = affine p_proj+      d | I.integerTestBit y_p 0 = _CURVE_Q - _SECRET+        | otherwise = _SECRET -          bytes_d = unroll32 d-          h_a = hash_aux a-          t = xor bytes_d h_a+      bytes_d = unroll32 d+      h_a = hash_aux a+      t = xor bytes_d h_a -          bytes_p = unroll32 x_p-          rand = hash_nonce (t <> bytes_p <> m)+      bytes_p = unroll32 x_p+      rand = hash_nonce (t <> bytes_p <> m) -          k' = modQ (roll32 rand)+      k' = modQ (roll32 rand) -      in  if   k' == 0 -- negligible probability-          then error "ppad-secp256k1 (sign_schnorr): invalid k"-          else-            let Affine x_r y_r = affine (_mul k')-                k | I.integerTestBit y_r 0 = _CURVE_Q - k'-                  | otherwise = k'+  if   k' == 0 -- negligible probability+  then Nothing -- XX handle me+  else do+    pt <- _mul k'+    let Affine x_r y_r = affine pt+        k | I.integerTestBit y_r 0 = _CURVE_Q - k'+          | otherwise = k' -                bytes_r = unroll32 x_r-                e = modQ . roll32 . hash_challenge-                  $ bytes_r <> bytes_p <> m+        bytes_r = unroll32 x_r+        e = modQ . roll32 . hash_challenge+          $ bytes_r <> bytes_p <> m -                bytes_ked = unroll32 (modQ (k + e * d))+        bytes_ked = unroll32 (modQ (k + e * d)) -                sig = bytes_r <> bytes_ked+        sig = bytes_r <> bytes_ked -            in  if   verify_schnorr m p_proj sig-                then sig-                else error "ppad-secp256k1 (sign_schnorr): invalid signature"+    guard (verify_schnorr m p_proj sig)+    pure $! sig {-# INLINE _sign_schnorr #-}  -- | Verify a 64-byte Schnorr signature for the provided message with@@ -909,27 +896,26 @@ verify_schnorr' tex = _verify_schnorr (mul_wnaf tex)  _verify_schnorr-  :: (Integer -> Projective) -- partially-applied multiplication function+  :: (Integer -> Maybe 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-      Just capP@(Affine x_P _) ->-        let (roll32 -> r, roll32 -> s) = BS.splitAt 32 sig-        in  if   r >= _CURVE_P || s >= _CURVE_Q-            then False-            else let e = modQ . roll32 $ hash_challenge-                           (unroll32 r <> unroll32 x_P <> m)-                     dif = add (_mul s)-                               (neg (mul_unsafe (projective capP) e))-                 in  if   dif == _CURVE_ZERO-                     then False-                     else let Affine x_R y_R = affine dif-                          in  not (I.integerTestBit y_R 0 || x_R /= r)+  | otherwise = M.isJust $ do+      capP@(Affine x_P _) <- lift x_p+      let (roll32 -> r, roll32 -> s) = BS.splitAt 32 sig+      guard (r < _CURVE_P && s < _CURVE_Q)+      let e = modQ . roll32 $ hash_challenge+                (unroll32 r <> unroll32 x_P <> m)+      pt0 <- _mul s+      pt1 <- mul_unsafe (projective capP) e+      let dif = add pt0 (neg pt1)+      guard (dif /= _CURVE_ZERO)+      let Affine x_R y_R = affine dif+      guard $ not (I.integerTestBit y_R 0 || x_R /= r)+      pure () {-# INLINE _verify_schnorr #-}  -- hardcoded tag of BIP0340/aux@@ -1011,11 +997,11 @@ --   signature, use 'sign_ecdsa_unrestricted'. -- --   >>> sign_ecdsa sec msg---   "<ecdsa signature>"+--   Just "<ecdsa signature>" sign_ecdsa   :: Integer         -- ^ secret key   -> BS.ByteString   -- ^ message-  -> ECDSA+  -> Maybe ECDSA sign_ecdsa = _sign_ecdsa (mul _CURVE_G) LowS Hash  -- | The same as 'sign_ecdsa', except uses a 'Context' to optimise internal@@ -1026,12 +1012,12 @@ -- --   >>> let !tex = precompute --   >>> sign_ecdsa' tex sec msg---   "<ecdsa signature>"+--   Just "<ecdsa signature>" sign_ecdsa'   :: Context         -- ^ secp256k1 context   -> Integer         -- ^ secret key   -> BS.ByteString   -- ^ message-  -> ECDSA+  -> Maybe ECDSA sign_ecdsa' tex = _sign_ecdsa (mul_wnaf tex) LowS Hash  -- | Produce an ECDSA signature for the provided message, using the@@ -1043,11 +1029,11 @@ --   "low-s" signature, use 'sign_ecdsa'. -- --   >>> sign_ecdsa_unrestricted sec msg---   "<ecdsa signature>"+--   Just "<ecdsa signature>" sign_ecdsa_unrestricted   :: Integer        -- ^ secret key   -> BS.ByteString  -- ^ message-  -> ECDSA+  -> Maybe ECDSA sign_ecdsa_unrestricted = _sign_ecdsa (mul _CURVE_G) Unrestricted Hash  -- | The same as 'sign_ecdsa_unrestricted', except uses a 'Context' to@@ -1058,12 +1044,12 @@ -- --   >>> let !tex = precompute --   >>> sign_ecdsa_unrestricted' tex sec msg---   "<ecdsa signature>"+--   Just "<ecdsa signature>" sign_ecdsa_unrestricted'   :: Context        -- ^ secp256k1 context   -> Integer        -- ^ secret key   -> BS.ByteString  -- ^ message-  -> ECDSA+  -> Maybe ECDSA sign_ecdsa_unrestricted' tex = _sign_ecdsa (mul_wnaf tex) Unrestricted Hash  -- Produce a "low-s" ECDSA signature for the provided message, using@@ -1075,52 +1061,54 @@ _sign_ecdsa_no_hash   :: Integer        -- ^ secret key   -> BS.ByteString  -- ^ message digest-  -> ECDSA+  -> Maybe ECDSA _sign_ecdsa_no_hash = _sign_ecdsa (mul _CURVE_G) LowS NoHash  _sign_ecdsa_no_hash'   :: Context   -> Integer   -> BS.ByteString-  -> ECDSA+  -> Maybe ECDSA _sign_ecdsa_no_hash' tex = _sign_ecdsa (mul_wnaf tex) LowS NoHash  _sign_ecdsa-  :: (Integer -> Projective) -- partially-applied multiplication function+  :: (Integer -> Maybe 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-          nonce   = bits2octets h-      drbg <- DRBG.new SHA256.hmac entropy nonce mempty-      -- RFC6979 sec 2.4-      sign_loop drbg-    where-      h = case hf of-        Hash -> SHA256.hash m-        NoHash -> m+  -> Maybe ECDSA+_sign_ecdsa _mul ty hf _SECRET m = runST $ do+    -- RFC6979 sec 3.3a+    let entropy = int2octets _SECRET+        nonce   = bits2octets h+    drbg <- DRBG.new SHA256.hmac entropy nonce mempty+    -- RFC6979 sec 2.4+    sign_loop drbg+  where+    h = case hf of+      Hash -> SHA256.hash m+      NoHash -> m -      h_modQ = remQ (bits2int h) -- bits2int yields nonnegative+    h_modQ = remQ (bits2int h) -- bits2int yields nonnegative -      sign_loop g = do-        k <- gen_k g-        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"-              Just kinv -> remQ (remQ (h_modQ + remQ (_SECRET * r)) * kinv)-        if   r == 0 -- negligible probability-        then sign_loop g-        else let !sig = ECDSA r s-             in  case ty of-                   Unrestricted -> pure sig-                   LowS -> pure (low sig)+    sign_loop g = do+      k <- gen_k g+      let mpair = do+            kg <- _mul k+            let Affine (modQ -> r) _ = affine kg+            kinv <- modinv k (fi _CURVE_Q)+            let s = remQ (remQ (h_modQ + remQ (_SECRET * r)) * kinv)+            pure $! (r, s)+      case mpair of+        Nothing -> pure Nothing+        Just (r, s)+          | r == 0 -> sign_loop g -- negligible probability+          | otherwise ->+              let !sig = Just $! ECDSA r s+              in  case ty of+                    Unrestricted -> pure sig+                    LowS -> pure (fmap low sig) {-# INLINE _sign_ecdsa #-}  -- RFC6979 sec 3.3b@@ -1216,28 +1204,25 @@ verify_ecdsa_unrestricted' tex = _verify_ecdsa_unrestricted (mul_wnaf tex)  _verify_ecdsa_unrestricted-  :: (Integer -> Projective) -- partially-applied multiplication function+  :: (Integer -> Maybe Projective) -- partially-applied multiplication function   -> BS.ByteString   -> Pub   -> ECDSA   -> Bool-_verify_ecdsa_unrestricted _mul (SHA256.hash -> h) p (ECDSA r s)+_verify_ecdsa_unrestricted _mul (SHA256.hash -> h) p (ECDSA r s) = M.isJust $ do   -- SEC1-v2 4.1.4-  | not (ge r) || not (ge s) = False-  | otherwise =-      let e     = remQ (bits2int h)-          s_inv = case modinv s (fi _CURVE_Q) of-            -- 'ge s' assures existence of inverse-            Nothing ->-              error "ppad-secp256k1 (verify_ecdsa_unrestricted): no inverse"-            Just si -> si-          u1   = remQ (e * s_inv)-          u2   = remQ (r * s_inv)-          capR = add (_mul u1) (mul_unsafe p u2)-      in  if   capR == _CURVE_ZERO-          then False-          else let Affine (modQ -> v) _ = affine capR-               in  v == r+  guard (ge r && ge s)+  let e = remQ (bits2int h)+  s_inv <- modinv s (fi _CURVE_Q)+  let u1 = remQ (e * s_inv)+      u2 = remQ (r * s_inv)+  pt0 <- _mul u1+  pt1 <- mul_unsafe p u2+  let capR = add pt0 pt1+  guard (capR /= _CURVE_ZERO)+  let Affine (modQ -> v) _ = affine capR+  guard (v == r)+  pure () {-# INLINE _verify_ecdsa_unrestricted #-}  -- ecdh -----------------------------------------------------------------------@@ -1252,8 +1237,8 @@ -- --   >>> let sec_alice = 0x03                   -- contrived --   >>> let sec_bob   = 2 ^ 128 - 1            -- contrived---   >>> let pub_alice = derive_pub sec_alice---   >>> let pub_bob   = derive_pub sec_bob+--   >>> 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@@ -1261,13 +1246,10 @@ ecdh   :: Projective    -- ^ public key   -> Integer       -- ^ secret key-  -> BS.ByteString -- ^ shared secret-ecdh pub _SECRET-  | not (ge _SECRET) = error "ppad-secp256k1 (ecdh): invalid secret key"-  | otherwise =-      let pt = mul pub _SECRET-      in  if   pt == _CURVE_ZERO-          then error "ppad-secp256k1 (ecdh): invalid public key"-          else let Affine x _ = affine pt-               in  SHA256.hash (unroll32 x)+  -> 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) 

@@ -1,6 +1,6 @@ cabal-version:      3.0 name:               ppad-secp256k1-version:            0.3.0+version:            0.4.0 synopsis:           Schnorr signatures, ECDSA, and ECDH on the elliptic curve                     secp256k1 license:            MIT

@@ -1,3 +1,4 @@+{-# OPTIONS_GHC -fno-warn-incomplete-uni-patterns #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ViewPatterns #-}@@ -56,8 +57,8 @@       -- 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-            sig' = sign_schnorr' tex sk c_msg c_aux+            Just sig  = sign_schnorr sk c_msg c_aux+            Just 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

@@ -1,3 +1,4 @@+{-# OPTIONS_GHC -fno-warn-incomplete-uni-patterns #-} {-# LANGUAGE BangPatterns #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-}@@ -40,8 +41,8 @@     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+        Just sig = _sign_ecdsa_no_hash x msg+        Just sig' = _sign_ecdsa_no_hash' tex x msg     assertEqual mempty sig sig'     assertEqual mempty pec sig 

@@ -44,7 +44,7 @@       Right pub -> do         let sec   = parse_bigint t_private             sar   = parse_bigint t_shared-            h_sar = SHA256.hash (unroll32 sar)+            h_sar = Just (SHA256.hash (unroll32 sar))             out   = ecdh pub sec         H.assertEqual mempty h_sar out   where