Skip to content
Draft
Show file tree
Hide file tree
Changes from 1 commit
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
1 change: 1 addition & 0 deletions .gitignore
Original file line number Diff line number Diff line change
Expand Up @@ -17,3 +17,4 @@ cabal.sandbox.config
*.hp
.stack-work
TAGS
.vscode
8 changes: 7 additions & 1 deletion libsecp256k1.cabal
Original file line number Diff line number Diff line change
@@ -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

Expand Down Expand Up @@ -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
Expand All @@ -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
Expand Down
3 changes: 3 additions & 0 deletions package.yaml
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
105 changes: 102 additions & 3 deletions src/Crypto/Secp256k1.hs
Original file line number Diff line number Diff line change
@@ -1,4 +1,5 @@
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE MultiParamTypeClasses #-}
Expand Down Expand Up @@ -36,6 +37,7 @@ module Crypto.Secp256k1 (
importPubKeyXO,
exportPubKeyXO,
importSignature,
importSignatureDer,
exportSignatureCompact,
exportSignatureDer,
importRecoverableSignature,
Expand All @@ -56,6 +58,7 @@ module Crypto.Secp256k1 (
keyPairPubKeyXY,
keyPairPubKeyXO,
xyToXO,
normalizeSignature,

-- * Tweaks
secKeyTweakAdd,
Expand Down Expand Up @@ -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,
Expand Down Expand Up @@ -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)
Expand All @@ -170,14 +183,38 @@ 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
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
Expand All @@ -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
Expand All @@ -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}

Expand All @@ -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
Expand All @@ -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
Expand Down Expand Up @@ -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
Expand All @@ -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

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

It seems like it would be more ergonomic to have the signature Signature -> (Bool, Signature) where the bool signals whether the signature return parameter is the original or a modified signature.

Copy link
Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Changed it. I also thought it was a bit awkward when copying it over from secp256k1-haskell.

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
Expand Down Expand Up @@ -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))