diff --git a/CHANGELOG b/CHANGELOG --- a/CHANGELOG +++ b/CHANGELOG @@ -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. diff --git a/bench/Main.hs b/bench/Main.hs --- a/bench/Main.hs +++ b/bench/Main.hs @@ -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 diff --git a/bench/Weight.hs b/bench/Weight.hs --- a/bench/Weight.hs +++ b/bench/Weight.hs @@ -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 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 @@ -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 --- "" -derive_pub :: Integer -> Pub -derive_pub _SECRET - | not (ge _SECRET) = - error "ppad-secp256k1 (derive_pub): invalid secret key" - | otherwise = - mul _CURVE_G _SECRET +-- Just "" +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 --- "" -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 "" +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> --- "" +-- Just "" 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 --- "" +-- Just "" 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 --- "" +-- Just "" 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 --- "" +-- Just "" 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 --- "" +-- Just "" 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) 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.3.0 +version: 0.4.0 synopsis: Schnorr signatures, ECDSA, and ECDH on the elliptic curve secp256k1 license: MIT diff --git a/test/BIP340.hs b/test/BIP340.hs --- a/test/BIP340.hs +++ b/test/BIP340.hs @@ -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 diff --git a/test/Noble.hs b/test/Noble.hs --- a/test/Noble.hs +++ b/test/Noble.hs @@ -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 diff --git a/test/WycheproofEcdh.hs b/test/WycheproofEcdh.hs --- a/test/WycheproofEcdh.hs +++ b/test/WycheproofEcdh.hs @@ -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