secp256k1

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

commit 9bfc6b6037ac9e4446a271cd350f8dc56dd94752
parent 4ed3bc557d7f5183374ba224f8ef892ea2dca538
Author: Jared Tobin <jared@jtobin.io>
Date:   Fri,  5 Apr 2024 17:07:12 +0400

lib: add RFC6979 conversion utilities

Diffstat:
Mlib/Crypto/Secp256k1.hs | 121++++++++++++++++++++++++++++++++++++++++++++++---------------------------------
1 file changed, 70 insertions(+), 51 deletions(-)

diff --git a/lib/Crypto/Secp256k1.hs b/lib/Crypto/Secp256k1.hs @@ -18,12 +18,18 @@ import GHC.Natural import qualified GHC.Num.Integer as I import Prelude hiding (mod) +-- see https://www.secg.org/sec2-v2.pdf for parameter specs + -- secp256k1 field prime -- --- _CURVE_P == 2^256 - 2^32 - 2^9 - 2^8 - 2^7 - 2^6 - 2^4 - 1 +-- ~ 2^256 - 2^32 - 2^9 - 2^8 - 2^7 - 2^6 - 2^4 - 1 _CURVE_P :: Integer _CURVE_P = 0xFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFEFFFFFC2F +-- | Division modulo secp256k1 field prime. +modP :: Integer -> Integer +modP a = I.integerMod a _CURVE_P + -- secp256k1 group order _CURVE_N :: Integer _CURVE_N = 0xFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFEBAAEDCE6AF48A03BBFD25E8CD0364141 @@ -32,6 +38,10 @@ _CURVE_N = 0xFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFEBAAEDCE6AF48A03BBFD25E8CD0364141 _CURVE_N_LEN :: Integer _CURVE_N_LEN = 256 +-- bytelength of _CURVE_N +_CURVE_N_BYTES :: Int +_CURVE_N_BYTES = 32 + -- secp256k1 short weierstrass form, /a/ coefficient _CURVE_A :: Integer _CURVE_A = 0 @@ -40,12 +50,8 @@ _CURVE_A = 0 _CURVE_B :: Integer _CURVE_B = 7 -_CURVE_G :: BS.ByteString -_CURVE_G = - "0279BE667EF9DCBBAC55A06295CE870B07029BFCDB2DCE28D959F2815B16F81798" - -- point in affine coordinates -data Affine = Affine Integer Integer +data Affine = Affine !Integer !Integer deriving stock (Show, Generic) instance Eq Affine where @@ -68,11 +74,11 @@ instance Eq Projective where y2z1 = modP (by * az) in x1z2 == x2z1 && y1z2 == y2z1 --- secp256k1 base point +-- secp256k1 generator -- --- Just _BASE == parse _CURVE_G -_BASE :: Projective -_BASE = Projective x y 1 where +-- ~ parse "0279BE667EF9DCBBAC55A06295CE870B07029BFCDB2DCE28D959F2815B16F81798" +_CURVE_G :: Projective +_CURVE_G = Projective x y 1 where x = 0x79be667ef9dcbbac55a06295ce870b07029bfcdb2dce28d959f2815b16f81798 y = 0x483ada7726a3c4655da4fbfc0e1108a8fd17b448a68554199c47d08ffb10d4b8 @@ -80,9 +86,9 @@ _BASE = Projective x y 1 where _ZERO :: Projective _ZERO = Projective 0 1 0 --- | Division modulo secp256k1 field prime. -modP :: Integer -> Integer -modP a = I.integerMod a _CURVE_P +-- | Division modulo secp256k1 group order. +modN :: Integer -> Integer +modN a = I.integerMod a _CURVE_N -- | Is field element. fe :: Integer -> Bool @@ -92,6 +98,7 @@ fe n = 0 < n && n < _CURVE_P ge :: Integer -> Bool ge n = 0 < n && n < _CURVE_N +-- modular inverse -- for a, m return x such that ax = 1 mod m modinv :: Integer -> Natural -> Maybe Integer modinv a m = case I.integerRecipMod# a m of @@ -99,6 +106,7 @@ modinv a m = case I.integerRecipMod# a m of (# | _ #) -> Nothing -- modular square root (shanks-tonelli) +-- for a, m return x such that a = xx mod m modsqrt :: Integer -> Maybe Integer modsqrt n = runST $ do r <- newSTRef 1 @@ -304,6 +312,7 @@ double (Projective x y z) = runST $ do modifySTRef' x3 (\rx3 -> modP (rx3 + rx3)) Projective <$> readSTRef x3 <*> readSTRef y3 <*> readSTRef z3 +-- ec scalar multiplication mul :: Projective -> Integer -> Projective mul p n | n == 0 = _ZERO @@ -322,7 +331,7 @@ mul p n mul_safe :: Projective -> Integer -> Projective mul_safe p n | not (ge n) = error "ppad-secp256k1 (mul_safe): scalar not in group" - | otherwise = loop _ZERO _BASE p n + | otherwise = loop _ZERO _CURVE_G p n where loop !r !f !d m | m <= 0 = r @@ -362,35 +371,32 @@ valid p = case affine p of -- | Parse hex-encoded compressed or uncompressed point. parse :: BS.ByteString -> Maybe Projective parse (B16.decode -> ebs) = case ebs of - Left _ -> Nothing - Right bs -> case BS.uncons bs of - Nothing -> Nothing - Just (fromIntegral -> h, t) -> - let (roll -> x, etc) = BS.splitAt _CURVE_N_BYTES t - len = BS.length bs - in -- compressed - if len == 33 && (h == 0x02 || h == 0x03) - then if not (fe x) - then Nothing - else do - y <- modsqrt (weierstrass x) - let yodd = I.integerTestBit y 0 - hodd = I.integerTestBit h 0 - pure $ - if hodd /= yodd - then Projective x (modP (negate y)) 1 - else Projective x y 1 - else -- uncompressed - if len == 65 && h == 0x04 - then let (roll -> y, _) = BS.splitAt _CURVE_N_BYTES etc - p = Projective x y 1 - in if valid p - then Just p - else Nothing - else Nothing - where - _CURVE_N_BYTES :: Int - _CURVE_N_BYTES = 32 + Left _ -> Nothing + Right bs -> case BS.uncons bs of + Nothing -> Nothing + Just (fromIntegral -> h, t) -> + let (roll -> x, etc) = BS.splitAt _CURVE_N_BYTES t + len = BS.length bs + in -- compressed + if len == 33 && (h == 0x02 || h == 0x03) + then if not (fe x) + then Nothing + else do + y <- modsqrt (weierstrass x) + let yodd = I.integerTestBit y 0 + hodd = I.integerTestBit h 0 + pure $ + if hodd /= yodd + then Projective x (modP (negate y)) 1 + else Projective x y 1 + else -- uncompressed + if len == 65 && h == 0x04 + then let (roll -> y, _) = BS.splitAt _CURVE_N_BYTES etc + p = Projective x y 1 + in if valid p + then Just p + else Nothing + else Nothing -- big-endian bytestring decoding roll :: BS.ByteString -> Integer @@ -406,26 +412,39 @@ unroll i = case i of step 0 = Nothing step m = Just (fromIntegral m, m `I.integerShiftR` 8) --- XX not sure how much i need these things; do roll and unroll suffice? - -- RFC6979 bits2int :: BS.ByteString -> Integer bits2int bs = - let (fromIntegral -> del) = BS.length bs * 8 - 256 - num = roll bs + let (fromIntegral -> blen) = BS.length bs * 8 + (fromIntegral -> qlen) = _CURVE_N_LEN + del = blen - qlen in if del > 0 - then num `I.integerShiftR` del - else num + then roll bs `I.integerShiftR` del + else roll bs -- RFC6979 int2octets :: Integer -> BS.ByteString -int2octets = unroll +int2octets i = pad (unroll i) where + pad !bs + | BS.length bs < _CURVE_N_BYTES = pad (BS.cons 0 bs) + | otherwise = bs -- RFC6979 bits2octets :: BS.ByteString -> BS.ByteString bits2octets bs = let z1 = bits2int bs - z2 = modP z1 -- XX correct modulo? + z2 = let d = z1 - _CURVE_N + in if d < 0 + then z1 + else d in int2octets z2 +-- XX test + +test_h1 :: BS.ByteString +test_h1 = B16.decodeLenient + "AF2BDBE1AA9B6EC1E2ADE1D694F41FC71A831D0268E9891562113D8A62ADD1BF" + +test_x :: Integer +test_x = 0x09A4D6792295A7F730FC3F2B49CBC0F62E862272F