secp256k1

Pure Haskell cryptographic primitives on the secp256k1 elliptic curve.
git clone git://git.ppad.tech/secp256k1.git
Log | Files | Refs | LICENSE

commit f8f3f3f61d6b5f5b5fa4a69617c3b5c18f4495b6
parent 406c97d2685be0614a0cee210717cf63165c23c4
Author: Jared Tobin <jared@jtobin.io>
Date:   Sat,  5 Oct 2024 16:45:03 +0400

lib: deterministic ecdsa

Diffstat:
Mlib/Crypto/Curve/Secp256k1.hs | 85++++++++++++++++++++++++++++++++++++++++---------------------------------------
1 file changed, 43 insertions(+), 42 deletions(-)

diff --git a/lib/Crypto/Curve/Secp256k1.hs b/lib/Crypto/Curve/Secp256k1.hs @@ -181,6 +181,8 @@ modsqrt n = runST $ do neg :: Projective -> Projective neg (Projective x y z) = Projective x (modP (negate y)) z +-- XX check implications on timing safety by special-casing algos below + -- | Elliptic curve addition on secp256k1. add :: Projective -> Projective -> Projective add p q@(Projective _ _ z) @@ -433,7 +435,7 @@ unroll i = case i of step 0 = Nothing step m = Just (fi m, m `I.integerShiftR` 8) --- RFC6979 +-- RFC6979 2.3.2 bits2int :: BS.ByteString -> Integer bits2int bs = let (fi -> blen) = BS.length bs * 8 @@ -443,64 +445,63 @@ bits2int bs = then roll bs `I.integerShiftR` del else roll bs --- XX think this shouldn't be padded as it is - --- RFC6979 +-- RFC6979 2.3.3 int2octets :: Integer -> BS.ByteString int2octets i = pad (unroll i) where pad !bs | BS.length bs < fi _CURVE_Q_BYTES = pad (BS.cons 0 bs) | otherwise = bs --- RFC6979 +-- RFC6979 2.3.4 bits2octets :: BS.ByteString -> BS.ByteString bits2octets bs = let z1 = bits2int bs z2 = modQ z1 in int2octets z2 +-- ecdsa ---------------------------------------------------------------------- +-- see https://www.rfc-editor.org/rfc/rfc6979 for deterministic ECDSA spec + +data ECDSA = ECDSA { + ecdsa_r :: !Integer + , ecdsa_s :: !Integer + } + deriving (Eq, Show, Generic) + -- XX handle low-s -sign :: BS.ByteString -> Integer -> Integer -> (Integer, Integer) -sign (modQ . bits2int -> h) k x = - let kg = mul _CURVE_G k - Affine (modQ -> r) _ = affine kg - s = case modinv k (fi _CURVE_Q) of - Nothing -> error "ppad-secp256k1 (sign): bad k value" - Just kinv -> modQ (modQ (h + modQ (x * r)) * kinv) - in if r == 0 - then error "ppad-secp256k1 (sign): <negligible probability outcome>" - else (r, s) - --- RFC6979 sec 2.4 -gen_k :: BS.ByteString -> Integer -> Integer -gen_k m x = runST $ do - let entropy = int2octets x - nonce = bits2octets (SHA256.hash m) - drbg <- DRBG.new SHA256.hmac entropy nonce mempty - loop drbg - where - qlen = fi _CURVE_Q_BITS -- RFC6979 notation - loop drbg = do - bytes <- DRBG.gen mempty qlen drbg - let !can = bits2int bytes - if can >= _CURVE_Q - then loop drbg - else pure can - -gen_k' :: BS.ByteString -> Integer -> Integer -gen_k' h x = runST $ do + +sign :: BS.ByteString -> Integer -> ECDSA +sign (SHA256.hash -> h) x = runST $ do + -- RFC6979 sec 3.3a let entropy = int2octets x nonce = bits2octets h drbg <- DRBG.new SHA256.hmac entropy nonce mempty - loop drbg + -- RFC6979 sec 2.4 + sign_loop drbg where - qlen = fi _CURVE_Q_BITS -- RFC6979 notation - loop drbg = do - bytes <- DRBG.gen mempty qlen drbg - let !can = bits2int bytes - if can >= _CURVE_Q - then loop drbg - else pure can + h_modQ = modQ (bits2int h) + + sign_loop g = do + k <- gen_k g + let kg = mul _CURVE_G k + Affine (modQ -> r) _ = affine kg + s = case modinv k (fi _CURVE_Q) of + Nothing -> error "ppad-secp256k1 (sign): bad k value" + Just kinv -> modQ (modQ (h_modQ + modQ (x * r)) * kinv) + if r == 0 -- negligible probability + then sign_loop g + else pure (ECDSA r s) + +-- RFC6979 sec 3.3b +gen_k :: DRBG.DRBG s -> ST s Integer +gen_k g = loop g where + loop drbg = do + bytes <- DRBG.gen mempty (fi _CURVE_Q_BYTES) drbg + let !can = bits2int bytes + if can >= _CURVE_Q + then loop drbg + else pure can +{-# INLINE gen_k #-} -- XX test