commit ef36b92784c66bc92571fcb901936c03ea1d192e
parent 4c69057276a15fee999dd71ddbe77a1eef9c35ea
Author: Jared Tobin <jared@jtobin.io>
Date: Wed, 16 Oct 2024 11:29:07 +0400
lib: remove base16-bytestring dep
Diffstat:
6 files changed, 50 insertions(+), 54 deletions(-)
diff --git a/lib/Crypto/Curve/Secp256k1.hs b/lib/Crypto/Curve/Secp256k1.hs
@@ -60,7 +60,6 @@ import qualified Crypto.DRBG.HMAC as DRBG
import qualified Crypto.Hash.SHA256 as SHA256
import qualified Data.Bits as B
import qualified Data.ByteString as BS
-import qualified Data.ByteString.Base16 as B16 -- XX kill this dep
import Data.Int (Int64)
import Data.STRef
import GHC.Generics
@@ -488,42 +487,40 @@ mul p n
-- parsing --------------------------------------------------------------------
--- | Parse a hex-encoded integer.
+-- | Parse an integer.
parse_integer :: BS.ByteString -> Integer
-parse_integer = roll . B16.decodeLenient
+parse_integer = roll
--- | Parse hex-encoded compressed point (33 bytes), uncompressed point
--- (65 bytes), or BIP0340-style point (32 bytes).
+-- | Parse compressed point (33 bytes), uncompressed point (65 bytes),
+-- or BIP0340-style point (32 bytes).
parse_point :: BS.ByteString -> Maybe Projective
-parse_point (B16.decode -> ebs) = case ebs of
- Left _ -> Nothing
- Right bs
- | BS.length bs == 32 -> -- bip0340 public key
- fmap projective (lift (roll bs))
- | otherwise -> case BS.uncons bs of
- Nothing -> Nothing
- Just (fi -> h, t) ->
- let (roll -> x, etc) = BS.splitAt (fi _CURVE_Q_BYTES) t
- len = BS.length bs
- in if len == 33 && (h == 0x02 || h == 0x03) -- compressed
- 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
- if len == 65 && h == 0x04 -- uncompressed
- then let (roll -> y, _) = BS.splitAt (fi _CURVE_Q_BYTES) etc
- p = Projective x y 1
- in if valid p
- then Just p
- else Nothing
- else Nothing
+parse_point bs
+ | BS.length bs == 32 = -- bip0340 public key
+ fmap projective (lift (roll bs))
+ | otherwise = case BS.uncons bs of
+ Nothing -> Nothing
+ Just (fi -> h, t) ->
+ let (roll -> x, etc) = BS.splitAt (fi _CURVE_Q_BYTES) t
+ len = BS.length bs
+ in if len == 33 && (h == 0x02 || h == 0x03) -- compressed
+ 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
+ if len == 65 && h == 0x04 -- uncompressed
+ then let (roll -> y, _) = BS.splitAt (fi _CURVE_Q_BYTES) etc
+ p = Projective x y 1
+ in if valid p
+ then Just p
+ else Nothing
+ else Nothing
-- schnorr --------------------------------------------------------------------
-- see https://github.com/bitcoin/bips/blob/master/bip-0340.mediawiki
@@ -662,9 +659,10 @@ sign_ecdsa = _sign_ecdsa LowS Hash
-- | Produce an ECDSA signature for the provided message, using the
-- provided private key.
--
--- 'sign_ecdsa_unrestricted' produces an unrestricted ECDSA signature, which
--- is less common in applications. If you need a conventional "low-s"
--- signature, use 'sign_ecdsa'.
+-- 'sign_ecdsa_unrestricted' produces an unrestricted ECDSA signature,
+-- which is less common in applications due to its inherent
+-- malleability. If you need a conventional "low-s" signature, use
+-- 'sign_ecdsa'.
sign_ecdsa_unrestricted
:: Integer -- ^ secret key
-> BS.ByteString -- ^ message
diff --git a/ppad-secp256k1.cabal b/ppad-secp256k1.cabal
@@ -27,7 +27,6 @@ library
Crypto.Curve.Secp256k1
build-depends:
base
- , base16-bytestring
, bytestring
, ppad-hmac-drbg
, ppad-sha256
diff --git a/test/BIP340.hs b/test/BIP340.hs
@@ -39,7 +39,7 @@ data Case = Case {
execute :: Case -> TestTree
execute Case {..} = testCase ("bip0340 " <> show c_index) $
- case parse_point c_pk of
+ case parse_point (B16.decodeLenient c_pk) of
Nothing -> assertBool mempty (not c_res)
Just pk -> do
if c_sk == mempty
diff --git a/test/Main.hs b/test/Main.hs
@@ -1,13 +1,10 @@
-{-# OPTIONS_GHC -fno-warn-unused-imports #-} -- XX delete me
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
module Main where
-import Control.Monad (when)
import Crypto.Curve.Secp256k1
-import qualified Data.Bits as B
import qualified Data.Aeson as A
import qualified Data.Attoparsec.ByteString as AT
import qualified Data.ByteString as BS
@@ -15,7 +12,6 @@ import qualified Data.ByteString.Base16 as B16
import Test.Tasty
import Test.Tasty.HUnit
import qualified Data.Text.IO as TIO
-import qualified Data.Text.Encoding as TE
import qualified Noble as N
import qualified Wycheproof as W
import qualified BIP340
@@ -73,19 +69,22 @@ render = filter (`notElem` ("\"" :: String)) . show
-- XX replace these with something non-stupid
parse_point_test_p :: TestTree
-parse_point_test_p = testCase (render p_hex) $ case parse_point p_hex of
- Nothing -> assertFailure "bad parse"
- Just p -> assertEqual mempty p_pro p
+parse_point_test_p = testCase (render p_hex) $
+ case parse_point (B16.decodeLenient p_hex) of
+ Nothing -> assertFailure "bad parse"
+ Just p -> assertEqual mempty p_pro p
parse_point_test_q :: TestTree
-parse_point_test_q = testCase (render q_hex) $ case parse_point q_hex of
- Nothing -> assertFailure "bad parse"
- Just q -> assertEqual mempty q_pro q
+parse_point_test_q = testCase (render q_hex) $
+ case parse_point (B16.decodeLenient q_hex) of
+ Nothing -> assertFailure "bad parse"
+ Just q -> assertEqual mempty q_pro q
parse_point_test_r :: TestTree
-parse_point_test_r = testCase (render r_hex) $ case parse_point r_hex of
- Nothing -> assertFailure "bad parse"
- Just r -> assertEqual mempty r_pro r
+parse_point_test_r = testCase (render r_hex) $
+ case parse_point (B16.decodeLenient r_hex) of
+ Nothing -> assertFailure "bad parse"
+ Just r -> assertEqual mempty r_pro r
-- XX also make less dumb
add_tests :: TestTree
diff --git a/test/Noble.hs b/test/Noble.hs
@@ -58,7 +58,7 @@ execute_invalid_sign (label, InvalidSignTest {..}) =
execute_invalid_verify :: (Int, InvalidVerifyTest) -> TestTree
execute_invalid_verify (label, InvalidVerifyTest {..}) =
testCase ("noble-secp256k1, invalid verify (" <> show label <> ")") $
- case parse_point ivv_Q of
+ case parse_point (B16.decodeLenient ivv_Q) of
Nothing -> assertBool "no parse" True
Just pub -> do
let sig = parse_compact ivv_signature
diff --git a/test/Wycheproof.hs b/test/Wycheproof.hs
@@ -135,7 +135,7 @@ data PublicKey = PublicKey {
} deriving Show
toProjective :: T.Text -> Projective
-toProjective (TE.encodeUtf8 -> bs) = case parse_point bs of
+toProjective (B16.decodeLenient . TE.encodeUtf8 -> bs) = case parse_point bs of
Nothing -> error "wycheproof: couldn't parse pubkey"
Just p -> p
