secp256k1

commit 6ea32c355fea5564d688ae4e2209b770032f36c9
parent 188bc9415064a02082ede321d98bef3846d62fd5
Author: Jared Tobin <jared@jtobin.io>
Date:   Wed, 18 Dec 2024 17:01:34 -0330

lib: add serialize_point

Diffstat:
M
lib/Crypto/Curve/Secp256k1.hs
 | 
14
++++++++++++++
M
test/Main.hs
 | 
20
++++++++++++++++++++

2 files changed, 34 insertions(+), 0 deletions(-)
diff --git a/lib/Crypto/Curve/Secp256k1.hs b/lib/Crypto/Curve/Secp256k1.hs
@@ -31,6 +31,9 @@ module Crypto.Curve.Secp256k1 (
   , parse_point
   , parse_sig
 
+  -- * Serializing
+  , serialize_point
+
   -- * BIP0340 Schnorr signatures
   , sign_schnorr
   , verify_schnorr
@@ -772,6 +775,17 @@ parse_sig bs
       let (roll -> r, roll -> s) = BS.splitAt 32 bs
       in  ECDSA r s
 
+-- serializing ----------------------------------------------------------------
+
+-- | Serialize a secp256k1 point in 33-byte compressed form.
+--
+--   >>> serialize_point <secp256k1 point>
+--   "<33-byte bytestring>"
+serialize_point :: Projective -> BS.ByteString
+serialize_point (affine -> Affine x y) = BS.cons b (unroll32 x) where
+  b | I.integerTestBit y 0 = 0x03
+    | otherwise = 0x02
+
 -- schnorr --------------------------------------------------------------------
 -- see https://github.com/bitcoin/bips/blob/master/bip-0340.mediawiki
 
diff --git a/test/Main.hs b/test/Main.hs
@@ -55,6 +55,7 @@ wycheproof_ecdsa_verify_tests tex msg ty W.Wycheproof {..} =
 units :: TestTree
 units = testGroup "unit tests" [
     parse_point_tests
+  , serialize_point_tests
   , add_tests
   , dub_tests
   ]
@@ -66,6 +67,13 @@ parse_point_tests = testGroup "parse_point tests" [
   , parse_point_test_r
   ]
 
+serialize_point_tests :: TestTree
+serialize_point_tests = testGroup "serialize_point tests" [
+    serialize_point_test_p
+  , serialize_point_test_q
+  , serialize_point_test_r
+  ]
+
 render :: Show a => a -> String
 render = filter (`notElem` ("\"" :: String)) . show
 
@@ -87,6 +95,18 @@ parse_point_test_r = testCase (render r_hex) $
     Nothing -> assertFailure "bad parse"
     Just r  -> assertEqual mempty r_pro r
 
+serialize_point_test_p :: TestTree
+serialize_point_test_p = testCase (render p_hex) $
+  assertEqual mempty p_hex (B16.encode (serialize_point p_pro))
+
+serialize_point_test_q :: TestTree
+serialize_point_test_q = testCase (render q_hex) $
+  assertEqual mempty q_hex (B16.encode (serialize_point q_pro))
+
+serialize_point_test_r :: TestTree
+serialize_point_test_r = testCase (render r_hex) $
+  assertEqual mempty r_hex (B16.encode (serialize_point r_pro))
+
 add_tests :: TestTree
 add_tests = testGroup "ec addition" [
     add_test_pq