diff --git a/CHANGELOG b/CHANGELOG --- a/CHANGELOG +++ b/CHANGELOG @@ -1,5 +1,9 @@ # Changelog +- 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. + - 0.2.2 (2025-02-16) * Exports the secp256k1 "point at infinity" as _CURVE_ZERO. diff --git a/bench/Main.hs b/bench/Main.hs --- a/bench/Main.hs +++ b/bench/Main.hs @@ -25,6 +25,7 @@ , derive_pub , schnorr , ecdsa + , ecdh ] remQ :: Benchmark @@ -142,6 +143,20 @@ msg = "i approve of this message" sig = S.sign_ecdsa big s_msg pure (tex, big, pub, msg, sig) + +ecdh :: Benchmark +ecdh = env setup $ \ ~(big, pub) -> + bgroup "ecdh" [ + bench "ecdh (small)" $ nf (S.ecdh pub) 2 + , bench "ecdh (large)" $ nf (S.ecdh pub) big + ] + where + setup = do + let !big = + 0x7fffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffed + !(Just !pub) = S.parse_point . B16.decodeLenient $ + "bd02b9dfc8ef760708950bd972f2dc244893b61b6b46c3b19be1b2da7b034ac5" + pure (big, pub) p_bs :: BS.ByteString p_bs = B16.decodeLenient diff --git a/bench/Weight.hs b/bench/Weight.hs --- a/bench/Weight.hs +++ b/bench/Weight.hs @@ -33,6 +33,7 @@ derive_pub schnorr ecdsa + ecdh remQ :: W.Weigh () remQ = W.wgroup "remQ" $ do @@ -96,6 +97,15 @@ pub = S.derive_pub big msg = "i approve of this message" sig = S.sign_ecdsa big s_msg + +ecdh :: W.Weigh () +ecdh = W.wgroup "ecdh" $ do + W.func "ecdh (small)" (S.ecdh pub) 2 + W.func "ecdh (large)" (S.ecdh pub) b + where + b = 0x7fffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffed + Just pub = S.parse_point . B16.decodeLenient $ + "bd02b9dfc8ef760708950bd972f2dc244893b61b6b46c3b19be1b2da7b034ac5" s_sk :: Integer s_sk = S.parse_int256 . B16.decodeLenient $ 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 @@ -15,10 +15,11 @@ -- Maintainer: Jared Tobin -- -- Pure [BIP0340](https://github.com/bitcoin/bips/blob/master/bip-0340.mediawiki) --- Schnorr signatures and deterministic +-- Schnorr signatures, deterministic -- [RFC6979](https://www.rfc-editor.org/rfc/rfc6979) ECDSA (with -- [BIP0146](https://github.com/bitcoin/bips/blob/master/bip-0146.mediawiki)-style --- "low-S" signatures) on the elliptic curve secp256k1. +-- "low-S" signatures), and ECDH shared secret computation +-- on the elliptic curve secp256k1. module Crypto.Curve.Secp256k1 ( -- * Field and group parameters @@ -42,6 +43,9 @@ -- * Serializing , serialize_point + -- * ECDH + , ecdh + -- * BIP0340 Schnorr signatures , sign_schnorr , verify_schnorr @@ -1235,4 +1239,35 @@ else let Affine (modQ -> v) _ = affine capR in v == r {-# INLINE _verify_ecdsa_unrestricted #-} + +-- ecdh ----------------------------------------------------------------------- + +-- SEC1-v2 3.3.1, plus SHA256 hash + +-- | Compute a shared secret, given a secret key and public secp256k1 point, +-- via Elliptic Curve Diffie-Hellman (ECDH). +-- +-- The shared secret is the SHA256 hash of the x-coordinate of the +-- point obtained by scalar multiplication. +-- +-- >>> 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 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 +-- True +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) diff --git a/ppad-secp256k1.cabal b/ppad-secp256k1.cabal --- a/ppad-secp256k1.cabal +++ b/ppad-secp256k1.cabal @@ -1,7 +1,8 @@ cabal-version: 3.0 name: ppad-secp256k1 -version: 0.2.2 -synopsis: Schnorr signatures & ECDSA on the elliptic curve secp256k1 +version: 0.3.0 +synopsis: Schnorr signatures, ECDSA, and ECDH on the elliptic curve + secp256k1 license: MIT license-file: LICENSE author: Jared Tobin @@ -11,8 +12,8 @@ tested-with: GHC == { 9.8.1, 9.6.4 } extra-doc-files: CHANGELOG description: - Pure BIP0340-style Schnorr signatures and deterministic RFC6979 ECDSA on - the elliptic curve secp256k1. + Pure BIP0340-style Schnorr signatures, deterministic RFC6979 ECDSA, and + ECDH shared secret computation on the elliptic curve secp256k1. source-repository head type: git @@ -41,6 +42,7 @@ BIP340 , Noble , Wycheproof + , WycheproofEcdh ghc-options: -rtsopts -Wall @@ -52,6 +54,7 @@ , base16-bytestring , bytestring , ppad-secp256k1 + , ppad-sha256 , tasty , tasty-hunit , text diff --git a/test/Main.hs b/test/Main.hs --- a/test/Main.hs +++ b/test/Main.hs @@ -14,6 +14,7 @@ import qualified Data.Text.IO as TIO import qualified Noble as N import qualified Wycheproof as W +import qualified WycheproofEcdh as WE import qualified BIP340 fi :: (Integral a, Num b) => a -> b @@ -25,23 +26,27 @@ wp_ecdsa_sha256 <- TIO.readFile "etc/ecdsa_secp256k1_sha256_test.json" wp_ecdsa_sha256_bitcoin <- TIO.readFile "etc/ecdsa_secp256k1_sha256_bitcoin_test.json" + wp_ecdh <- TIO.readFile + "etc/ecdh_secp256k1_test.json" noble_ecdsa <- TIO.readFile "etc/noble_ecdsa.json" bip340 <- BS.readFile "etc/bip-0340-test-vectors.csv" let !tex = precompute - quar = do + pen = do wp0 <- A.decodeStrictText wp_ecdsa_sha256 :: Maybe W.Wycheproof wp1 <- A.decodeStrictText wp_ecdsa_sha256_bitcoin :: Maybe W.Wycheproof + wp2 <- A.decodeStrictText wp_ecdh :: Maybe WE.Wycheproof nob <- A.decodeStrictText noble_ecdsa :: Maybe N.Ecdsa bip <- case AT.parseOnly BIP340.cases bip340 of Left _ -> Nothing Right b -> pure b - pure (wp0, wp1, nob, bip) - case quar of + pure (wp0, wp1, wp2, nob, bip) + case pen of Nothing -> error "couldn't parse wycheproof vectors" - Just (w0, w1, no, ip) -> defaultMain $ testGroup "ppad-secp256k1" [ + Just (w0, w1, w2, no, ip) -> defaultMain $ testGroup "ppad-secp256k1" [ units , wycheproof_ecdsa_verify_tests tex "(ecdsa, sha256)" Unrestricted w0 , wycheproof_ecdsa_verify_tests tex "(ecdsa, sha256, low-s)" LowS w1 + , wycheproof_ecdh_tests "(ecdh)" w2 , N.execute_ecdsa tex no , testGroup "bip0340 vectors (schnorr)" (fmap (BIP340.execute tex) ip) ] @@ -51,6 +56,11 @@ wycheproof_ecdsa_verify_tests tex msg ty W.Wycheproof {..} = testGroup ("wycheproof vectors " <> msg) $ fmap (W.execute_group tex ty) wp_testGroups + +wycheproof_ecdh_tests :: String -> WE.Wycheproof -> TestTree +wycheproof_ecdh_tests msg WE.Wycheproof {..} = + testGroup ("wycheproof vectors " <> msg) $ + fmap (WE.execute_group) wp_testGroups units :: TestTree units = testGroup "unit tests" [ diff --git a/test/WycheproofEcdh.hs b/test/WycheproofEcdh.hs new file mode 100644 --- /dev/null +++ b/test/WycheproofEcdh.hs @@ -0,0 +1,190 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE ViewPatterns #-} + +module WycheproofEcdh ( + Wycheproof(..) + , execute_group + ) where + +import Crypto.Curve.Secp256k1 +import qualified Crypto.Hash.SHA256 as SHA256 +import Data.Aeson ((.:)) +import qualified Data.Aeson as A +import qualified Data.Attoparsec.ByteString as AT +import Data.Bits ((.<<.), (.>>.), (.|.)) +import qualified Data.ByteString as BS +import qualified Data.ByteString.Base16 as B16 +import qualified Data.Text as T +import qualified Data.Text.Encoding as TE +import Test.Tasty (TestTree, testGroup) +import qualified Test.Tasty.HUnit as H (assertBool, assertEqual, testCase) + +fi :: (Integral a, Num b) => a -> b +fi = fromIntegral +{-# INLINE fi #-} + +execute_group :: EcdhTestGroup -> TestTree +execute_group EcdhTestGroup {..} = + testGroup msg (fmap execute etg_tests) + where + msg = "wycheproof ecdh" + +execute :: EcdhTest -> TestTree +execute EcdhTest {..} = H.testCase report $ do + case der_to_pub t_public of + Left _ -> + -- 'acceptable' in wycheproof-speak means that a public key + -- contains a parameter that, whilst invalid, doesn't actually + -- affect the ECDH computation. we work only with valid + -- secp256k1 points, so rule these out as invalid as well. + -- + H.assertBool "invalid" (t_result `elem` ["invalid", "acceptable"]) + Right pub -> do + let sec = parse_bigint t_private + sar = parse_bigint t_shared + h_sar = SHA256.hash (unroll32 sar) + out = ecdh pub sec + H.assertEqual mempty h_sar out + where + report = "wycheproof ecdh " <> show t_tcId + +-- RFC 5280 ASN.1 +-- SubjectPublicKeyInfo ::= SEQUENCE { +-- algorithm AlgorithmIdentifier, +-- subjectPublicKey BIT STRING +-- } +-- AlgorithmIdentifier ::= SEQUENCE { +-- algorithm OBJECT IDENTIFIER, +-- parameters ANY DEFINED BY algorithm OPTIONAL +-- } +parse_der_pub :: AT.Parser Projective +parse_der_pub = do + _ <- AT.word8 0x30 -- SEQUENCE + _ <- AT.anyWord8 + _ <- parse_der_algo + parse_der_subjectpubkey + +parse_der_algo :: AT.Parser () +parse_der_algo = do + _ <- AT.word8 0x30 -- SEQUENCE + _ <- AT.anyWord8 + _ <- parse_der_ecpubkey + _ <- parse_der_secp256k1 + pure () + +-- RFC 5480 2.1.1 +-- id-ecPublicKey OBJECT IDENTIFIER ::= { +-- iso(1) member-body(2) us(840) ansi-X9-62(10045) keyType(2) 1 } +-- +-- DER encoded -> 06 07 2A 86 48 CE 3D 02 01 +parse_der_ecpubkey :: AT.Parser () +parse_der_ecpubkey = do + _ <- AT.word8 0x06 + _ <- AT.word8 0x07 + _ <- AT.word8 0x2a + _ <- AT.word8 0x86 + _ <- AT.word8 0x48 + _ <- AT.word8 0xce + _ <- AT.word8 0x3d + _ <- AT.word8 0x02 + _ <- AT.word8 0x01 + pure () + +-- SEC1-v2 A.2 +-- certicom-arc OBJECT IDENTIFIER ::= { +-- iso(1) identified-organization(3) certicom(132) +-- } +-- +-- ellipticCurve OBJECT IDENTIFIER ::= { certicom-arc curve(0) } +-- +-- secp256k1 OBJECT IDENTIFIER ::= { ellipticCurve 10 } +-- +-- (i.e., 1.3.132.0.10) +-- +-- DER encoded -> 06 05 2B 81 04 00 0A +parse_der_secp256k1 :: AT.Parser () +parse_der_secp256k1 = do + _ <- AT.word8 0x06 + _ <- AT.word8 0x05 + _ <- AT.word8 0x2b + _ <- AT.word8 0x81 + _ <- AT.word8 0x04 + _ <- AT.word8 0x00 + _ <- AT.word8 0x0a + pure () + +parse_der_subjectpubkey :: AT.Parser Projective +parse_der_subjectpubkey = do + _ <- AT.word8 0x03 -- BIT STRING + len <- fmap fi AT.anyWord8 + _ <- AT.word8 0x00 -- extra bits (always 0x00 for DER) + content <- AT.take (len - 1) -- len counts 'extra bits' field + etc <- AT.takeByteString + if BS.length content /= len - 1 || etc /= mempty + then fail "invalid content" + else case parse_point content of + Nothing -> fail "invalid content" + Just pt -> pure pt + +der_to_pub :: T.Text -> Either String Projective +der_to_pub (B16.decodeLenient . TE.encodeUtf8 -> bs) = + AT.parseOnly parse_der_pub bs + +parse_bigint :: T.Text -> Integer +parse_bigint (B16.decodeLenient . TE.encodeUtf8 -> bs) = roll bs where + roll :: BS.ByteString -> Integer + roll = BS.foldl' alg 0 where + alg !a (fi -> !b) = (a .<<. 8) .|. b + +-- big-endian bytestring encoding +unroll :: Integer -> BS.ByteString +unroll i = case i of + 0 -> BS.singleton 0 + _ -> BS.reverse $ BS.unfoldr step i + where + step 0 = Nothing + step m = Just (fi m, m .>>. 8) + +-- big-endian bytestring encoding for 256-bit ints, left-padding with +-- zeros if necessary. the size of the integer is not checked. +unroll32 :: Integer -> BS.ByteString +unroll32 (unroll -> u) + | l < 32 = BS.replicate (32 - l) 0 <> u + | otherwise = u + where + l = BS.length u + +data Wycheproof = Wycheproof { + wp_testGroups :: ![EcdhTestGroup] + } deriving Show + +instance A.FromJSON Wycheproof where + parseJSON = A.withObject "Wycheproof" $ \m -> Wycheproof + <$> m .: "testGroups" + +data EcdhTestGroup = EcdhTestGroup { + etg_tests :: ![EcdhTest] + } deriving Show + +instance A.FromJSON EcdhTestGroup where + parseJSON = A.withObject "EcdhTestGroup" $ \m -> EcdhTestGroup + <$> m .: "tests" + +data EcdhTest = EcdhTest { + t_tcId :: !Int + , t_public :: !T.Text + , t_private :: !T.Text + , t_shared :: !T.Text + , t_result :: !T.Text + } deriving Show + +instance A.FromJSON EcdhTest where + parseJSON = A.withObject "EcdhTest" $ \m -> EcdhTest + <$> m .: "tcId" + <*> m .: "public" + <*> m .: "private" + <*> m .: "shared" + <*> m .: "result" +