From 2688e0b86dbbc81a9eb117af3f3a078c84e1c2ef Mon Sep 17 00:00:00 2001 From: Tochi Obudulu Date: Sun, 27 Nov 2022 14:30:07 +0000 Subject: [PATCH 1/3] build haskell-bitcoin/libsecp256k1-haskell with haskell-bitcoin/bitcoin --- .gitignore | 1 + libsecp256k1.cabal | 8 ++- package.yaml | 3 ++ src/Crypto/Secp256k1.hs | 105 ++++++++++++++++++++++++++++++++++++++-- 4 files changed, 113 insertions(+), 4 deletions(-) diff --git a/.gitignore b/.gitignore index b1fdcd7..d4ab84d 100644 --- a/.gitignore +++ b/.gitignore @@ -17,3 +17,4 @@ cabal.sandbox.config *.hp .stack-work TAGS +.vscode diff --git a/libsecp256k1.cabal b/libsecp256k1.cabal index c064342..780231e 100644 --- a/libsecp256k1.cabal +++ b/libsecp256k1.cabal @@ -1,6 +1,6 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.34.4. +-- This file has been generated from package.yaml by hpack version 0.35.0. -- -- see: https://github.com/sol/hpack @@ -40,7 +40,10 @@ library build-depends: base >=4.9 && <5 , bytestring >=0.10.8 && <0.12 + , cereal + , deepseq , entropy >=0.3.8 && <0.5 + , hashable , hedgehog , memory >=0.14.15 && <1.0 , transformers >=0.4.0.0 && <1.0 @@ -63,7 +66,10 @@ test-suite spec HUnit , base >=4.9 && <5 , bytestring >=0.10.8 && <0.12 + , cereal + , deepseq , entropy >=0.3.8 && <0.5 + , hashable , hedgehog , hspec , libsecp256k1 diff --git a/package.yaml b/package.yaml index 2be2a10..4e57591 100644 --- a/package.yaml +++ b/package.yaml @@ -16,7 +16,10 @@ extra-source-files: dependencies: - base >=4.9 && <5 - bytestring >=0.10.8 && <0.12 + - cereal + - deepseq - entropy >= 0.3.8 && <0.5 + - hashable - hedgehog - memory >= 0.14.15 && <1.0 - transformers >= 0.4.0.0 && <1.0 diff --git a/src/Crypto/Secp256k1.hs b/src/Crypto/Secp256k1.hs index 8a0f72f..d6a3b66 100644 --- a/src/Crypto/Secp256k1.hs +++ b/src/Crypto/Secp256k1.hs @@ -1,4 +1,5 @@ {-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE MultiParamTypeClasses #-} @@ -36,6 +37,7 @@ module Crypto.Secp256k1 ( importPubKeyXO, exportPubKeyXO, importSignature, + importSignatureDer, exportSignatureCompact, exportSignatureDer, importRecoverableSignature, @@ -56,6 +58,7 @@ module Crypto.Secp256k1 ( keyPairPubKeyXY, keyPairPubKeyXO, xyToXO, + normalizeSignature, -- * Tweaks secKeyTweakAdd, @@ -99,9 +102,12 @@ import Data.String (IsString (..)) -- import Data.String.Conversions (ConvertibleStrings, cs) +import Control.DeepSeq (NFData (rnf)) import qualified Data.ByteString.Char8 as B8 import Data.Foldable (for_) +import Data.Hashable (Hashable (hashWithSalt)) import Data.Memory.PtrMethods (memCompare) +import Data.Serialize (Serialize (put), get, getByteString, putByteString) import Foreign ( Bits (..), ForeignPtr, @@ -159,7 +165,14 @@ instance Show SecKey where secKeyPtr <- ContT (withForeignPtr secKeyFPtr) -- avoid allocating a new bytestring because we are only reading from this pointer bs <- lift (Data.ByteString.Unsafe.unsafePackCStringLen (castPtr secKeyPtr, 32)) - pure $ "0x" <> B8.unpack (BA.convertToBase BA.Base16 bs) + pure $ quoteString $ B8.unpack (BA.convertToBase BA.Base16 bs) +instance Read SecKey where + readPrec = do + String hexString <- lexP + maybe pfail return $ + importSecKey =<< case BA.convertFromBase BA.Base16 (B8.pack hexString) of + Left _ -> Nothing + Right x -> Just x instance Eq SecKey where sk == sk' = unsafePerformIO . evalContT $ do skp <- ContT $ withForeignPtr (secKeyFPtr sk) @@ -170,6 +183,21 @@ instance Ord SecKey where skp <- ContT $ withForeignPtr (secKeyFPtr sk) skp' <- ContT $ withForeignPtr (secKeyFPtr sk') lift (memCompare (castPtr skp) (castPtr skp') 32) +instance NFData SecKey where + rnf x = seq x () +instance Hashable SecKey where + i `hashWithSalt` k = i `hashWithSalt` exportSecKey k +instance Serialize SecKey where + put = putByteString . exportSecKey + get = do + Just k <- importSecKey <$> getByteString 32 + return k +instance IsString SecKey where + fromString str = + fromMaybe (error "Could not decode secret key from hex string") $ + importSecKey =<< case BA.convertFromBase BA.Base16 (B8.pack str) of + Left _ -> Nothing + Right x -> Just x -- | Public Key with both X and Y coordinates @@ -177,7 +205,16 @@ newtype PubKeyXY = PubKeyXY {pubKeyXYFPtr :: ForeignPtr Prim.Pubkey64} instance Show PubKeyXY where - show pk = "0x" <> B8.unpack (BA.convertToBase BA.Base16 (exportPubKeyXY True pk)) + show pk = quoteString $ B8.unpack (BA.convertToBase BA.Base16 (exportPubKeyXY True pk)) + + +instance Read PubKeyXY where + readPrec = do + String hexString <- lexP + maybe pfail return $ + importPubKeyXY =<< case BA.convertFromBase BA.Base16 (B8.pack hexString) of + Left _ -> Nothing + Right x -> Just x instance Eq PubKeyXY where @@ -194,12 +231,37 @@ instance Ord PubKeyXY where pure $ compare res 0 +instance NFData PubKeyXY where + rnf x = seq x () + + +instance Hashable PubKeyXY where + i `hashWithSalt` k = i `hashWithSalt` exportPubKeyXY True k + + +instance IsString PubKeyXY where + fromString str = + fromMaybe (error "Could not decode public key from hex string") $ + importPubKeyXY =<< case BA.convertFromBase BA.Base16 (B8.pack str) of + Left _ -> Nothing + Right x -> Just x + + -- | Public Key with only an X coordinate. newtype PubKeyXO = PubKeyXO {pubKeyXOFPtr :: ForeignPtr Prim.XonlyPubkey64} instance Show PubKeyXO where - show pk = "0x" <> B8.unpack (BA.convertToBase BA.Base16 (exportPubKeyXO pk)) + show pk = quoteString $ B8.unpack (BA.convertToBase BA.Base16 (exportPubKeyXO pk)) + + +instance Read PubKeyXO where + readPrec = do + String hexString <- lexP + maybe pfail return $ + importPubKeyXO =<< case BA.convertFromBase BA.Base16 (B8.pack hexString) of + Left _ -> Nothing + Right x -> Just x instance Eq PubKeyXO where @@ -216,6 +278,10 @@ instance Ord PubKeyXO where pure $ compare res 0 +instance NFData PubKeyXO where + rnf x = seq x () + + -- | Structure containing information equivalent to 'SecKey' and 'PubKeyXY' newtype KeyPair = KeyPair {keyPairFPtr :: ForeignPtr Prim.Keypair96} @@ -227,8 +293,13 @@ instance Eq KeyPair where (EQ ==) <$> lift (memCompare (castPtr kpp) (castPtr kpp') 32) +instance NFData KeyPair where + rnf x = seq x () + + -- | Structure containing Signature (R,S) data. newtype Signature = Signature {signatureFPtr :: ForeignPtr Prim.Sig64} + deriving (Generic) instance Show Signature where @@ -238,6 +309,8 @@ instance Eq Signature where sigp <- ContT $ withForeignPtr (signatureFPtr sig) sigp' <- ContT $ withForeignPtr (signatureFPtr sig') (EQ ==) <$> lift (memCompare (castPtr sigp) (castPtr sigp') 32) +instance NFData Signature where + rnf x = seq x () -- | Structure containing Signature AND recovery ID @@ -373,6 +446,17 @@ importSignature bs = unsafePerformIO $ else free outBuf $> Nothing +-- | Parses 'Signature' from DER (any length) representations. +importSignatureDer :: ByteString -> Maybe Signature +importSignatureDer bs = unsafePerformIO $ + unsafeUseByteString bs $ \(inBuf, len) -> do + outBuf <- mallocBytes 64 + ret <- Prim.ecdsaSignatureParseDer ctx outBuf inBuf len + if isSuccess ret + then Just . Signature <$> newForeignPtr finalizerFree outBuf + else free outBuf $> Nothing + + -- | Serializes 'Signature' to Compact (64 byte) representation exportSignatureCompact :: Signature -> ByteString exportSignatureCompact (Signature fptr) = unsafePerformIO $ do @@ -395,6 +479,17 @@ exportSignatureDer (Signature fptr) = unsafePerformIO $ do unsafePackByteString (outBuf, len) +-- | Convert signature to a normalized lower-S form. 'Nothing' indicates that it +-- was already normal. +normalizeSignature :: Signature -> Maybe Signature +normalizeSignature (Signature fptr) = unsafePerformIO $ do + outBuf <- mallocBytes 64 + ret <- withForeignPtr fptr $ Prim.ecdsaSignatureNormalize ctx outBuf + if isSuccess ret + then Just . Signature <$> newForeignPtr finalizerFree outBuf + else free outBuf $> Nothing + + -- | Parses 'RecoverableSignature' from Compact (65 byte) representation importRecoverableSignature :: ByteString -> Maybe RecoverableSignature importRecoverableSignature bs @@ -765,5 +860,9 @@ pubKeyXOTweakAddCheck PubKeyXO{pubKeyXOFPtr = tweakedFPtr} parity PubKeyXO{pubKe lift $ isSuccess <$> Prim.xonlyPubkeyTweakAddCheck ctx tweakedPtr parityInt origPtr tweakPtr +quoteString :: String -> String +quoteString x = '"' : x <> "\"" + + foreign import ccall "wrapper" mkNonceFunHardened :: Prim.NonceFunHardened a -> IO (FunPtr (Prim.NonceFunHardened a)) From d6df5a2942674614d96131695283e865802fc072 Mon Sep 17 00:00:00 2001 From: Tochi Obudulu Date: Mon, 28 Nov 2022 22:53:16 +0000 Subject: [PATCH 2/3] Change `normalizeSignature` ergonomics --- src/Crypto/Secp256k1.hs | 13 +++++++------ 1 file changed, 7 insertions(+), 6 deletions(-) diff --git a/src/Crypto/Secp256k1.hs b/src/Crypto/Secp256k1.hs index d6a3b66..403972e 100644 --- a/src/Crypto/Secp256k1.hs +++ b/src/Crypto/Secp256k1.hs @@ -479,15 +479,16 @@ exportSignatureDer (Signature fptr) = unsafePerformIO $ do unsafePackByteString (outBuf, len) --- | Convert signature to a normalized lower-S form. 'Nothing' indicates that it --- was already normal. -normalizeSignature :: Signature -> Maybe Signature -normalizeSignature (Signature fptr) = unsafePerformIO $ do +-- | Convert signature to a normalized lower-S form. The first element of the +-- returned pair is 'True' if the given and normalized signatures are different, +-- otherwise it is 'False' when the signature is already normalized. +normalizeSignature :: Signature -> (Bool,Signature) +normalizeSignature signature@(Signature fptr) = unsafePerformIO $ do outBuf <- mallocBytes 64 ret <- withForeignPtr fptr $ Prim.ecdsaSignatureNormalize ctx outBuf if isSuccess ret - then Just . Signature <$> newForeignPtr finalizerFree outBuf - else free outBuf $> Nothing + then (True,) . Signature <$> newForeignPtr finalizerFree outBuf + else free outBuf $> (False, signature) -- | Parses 'RecoverableSignature' from Compact (65 byte) representation From 3a23ec0d8616bd3cc45e3b5764f604c4bed2e144 Mon Sep 17 00:00:00 2001 From: Tochi Obudulu Date: Mon, 28 Nov 2022 23:08:52 +0000 Subject: [PATCH 3/3] Remove `cereal` dependency no longer used upstream --- libsecp256k1.cabal | 2 -- package.yaml | 1 - src/Crypto/Secp256k1.hs | 6 ------ 3 files changed, 9 deletions(-) diff --git a/libsecp256k1.cabal b/libsecp256k1.cabal index 780231e..0b2a90b 100644 --- a/libsecp256k1.cabal +++ b/libsecp256k1.cabal @@ -40,7 +40,6 @@ library build-depends: base >=4.9 && <5 , bytestring >=0.10.8 && <0.12 - , cereal , deepseq , entropy >=0.3.8 && <0.5 , hashable @@ -66,7 +65,6 @@ test-suite spec HUnit , base >=4.9 && <5 , bytestring >=0.10.8 && <0.12 - , cereal , deepseq , entropy >=0.3.8 && <0.5 , hashable diff --git a/package.yaml b/package.yaml index 4e57591..78f1bef 100644 --- a/package.yaml +++ b/package.yaml @@ -16,7 +16,6 @@ extra-source-files: dependencies: - base >=4.9 && <5 - bytestring >=0.10.8 && <0.12 - - cereal - deepseq - entropy >= 0.3.8 && <0.5 - hashable diff --git a/src/Crypto/Secp256k1.hs b/src/Crypto/Secp256k1.hs index 403972e..39fa741 100644 --- a/src/Crypto/Secp256k1.hs +++ b/src/Crypto/Secp256k1.hs @@ -107,7 +107,6 @@ import qualified Data.ByteString.Char8 as B8 import Data.Foldable (for_) import Data.Hashable (Hashable (hashWithSalt)) import Data.Memory.PtrMethods (memCompare) -import Data.Serialize (Serialize (put), get, getByteString, putByteString) import Foreign ( Bits (..), ForeignPtr, @@ -187,11 +186,6 @@ instance NFData SecKey where rnf x = seq x () instance Hashable SecKey where i `hashWithSalt` k = i `hashWithSalt` exportSecKey k -instance Serialize SecKey where - put = putByteString . exportSecKey - get = do - Just k <- importSecKey <$> getByteString 32 - return k instance IsString SecKey where fromString str = fromMaybe (error "Could not decode secret key from hex string") $