Bip340 support

hie.yaml

@@ -0,0 +1,7 @@
+cradle:
+  cabal:
+    - path: "src"
+      component: "lib:secp256k1-haskell"
+
+    - path: "test"
+      component: "secp256k1-haskell:test:spec"

package.yaml

@@ -1,5 +1,5 @@
 name: secp256k1-haskell
-version: 0.6.1
+version: 0.7.0
 synopsis: Bindings for secp256k1
 description: Sign and verify signatures using the secp256k1 library.
 category: Crypto
@@ -10,6 +10,8 @@ license: MIT
 license-file: LICENSE
 github: haskoin/secp256k1-haskell.git
 homepage: http://github.com/haskoin/secp256k1-haskell#readme
+verbatim:
+  cabal-version: 2.0
 extra-source-files:
   - CHANGELOG.md
   - README.md
@@ -23,13 +25,21 @@ dependencies:
   - hashable >=1.2.6 && <1.5
   - QuickCheck >=2.9.2 && <2.15
   - string-conversions >=0.4 && <0.5
-  - unliftio-core >=0.1.0 && <0.3 
+  - unliftio-core >=0.1.0 && <0.3
+flags:
+  bip340:
+    description: Enable support for BIP340
+    default: false
+    manual: true
 library:
   source-dirs: src
   generated-exposed-modules:
     - Paths_secp256k1_haskell
   pkg-config-dependencies:
     - libsecp256k1
+  when:
+    condition: flag(bip340)
+    cpp-options: -DBIP340
 tests:
   spec:
     main: Spec.hs
@@ -47,3 +57,6 @@ tests:
       - monad-par
       - mtl
       - HUnit
+    when:
+      condition: flag(bip340)
+      cpp-options: -DBIP340

secp256k1-haskell.cabal

@@ -1,11 +1,11 @@
 cabal-version: 2.0
 
--- 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
 
 name:           secp256k1-haskell
-version:        0.6.1
+version:        0.7.0
 synopsis:       Bindings for secp256k1
 description:    Sign and verify signatures using the secp256k1 library.
 category:       Crypto
@@ -25,6 +25,11 @@ source-repository head
   type: git
   location: https://github.com/haskoin/secp256k1-haskell.git
 
+flag bip340
+  description: Enable support for BIP340
+  manual: True
+  default: False
+
 library
   exposed-modules:
       Crypto.Secp256k1
@@ -48,6 +53,8 @@ library
     , string-conversions ==0.4.*
     , unliftio-core >=0.1.0 && <0.3
   default-language: Haskell2010
+  if flag(bip340)
+    cpp-options: -DBIP340
 
 test-suite spec
   type: exitcode-stdio-1.0
@@ -56,6 +63,8 @@ test-suite spec
       Crypto.Secp256k1.InternalSpec
       Crypto.Secp256k1Spec
       Paths_secp256k1_haskell
+  autogen-modules:
+      Paths_secp256k1_haskell
   hs-source-dirs:
       test
   ghc-options: -threaded -rtsopts -with-rtsopts=-N
@@ -76,4 +85,6 @@ test-suite spec
     , string-conversions ==0.4.*
     , unliftio-core >=0.1.0 && <0.3
   default-language: Haskell2010
+  if flag(bip340)
+    cpp-options: -DBIP340
   build-tool-depends: hspec-discover:hspec-discover

src/Crypto/Secp256k1.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE CPP                        #-}
 {-# LANGUAGE DeriveGeneric              #-}
 {-# LANGUAGE FlexibleContexts           #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
@@ -53,6 +54,21 @@ module Crypto.Secp256k1
     , tweakMulPubKey
     , combinePubKeys
     , tweakNegate
+
+    -- * BIP340 Support
+    , XOnlyPubKey
+
+#ifdef BIP340
+
+    , deriveXOnlyPubKey
+    , Rand32
+    , mkRand32
+    , Bip340Sig
+    , signBip340
+    , verifyBip340
+
+#endif
+
     ) where
 
 import           Control.DeepSeq           (NFData)
@@ -61,6 +77,7 @@ import           Crypto.Secp256k1.Internal
 import           Data.ByteString           (ByteString)
 import qualified Data.ByteString           as BS
 import qualified Data.ByteString.Base16    as B16
+import qualified Data.ByteString.Unsafe    as BU
 import           Data.Hashable             (Hashable (..))
 import           Data.Maybe                (fromJust, fromMaybe, isJust)
 import           Data.Serialize            (Serialize (..), getByteString,
@@ -117,7 +134,7 @@ instance Serialize CompactSig where
 decodeHex :: ConvertibleStrings a ByteString => a -> Maybe ByteString
 decodeHex str = case B16.decodeBase16 $ cs str of
   Right bs -> Just bs
-  Left _ -> Nothing
+  Left _   -> Nothing
 
 instance Read PubKey where
     readPrec = do
@@ -441,3 +458,120 @@ instance Arbitrary SecKey where
 
 instance Arbitrary PubKey where
     arbitrary = derivePubKey <$> arbitrary
+
+{- | An x-only pubkey corresponds to the keys @(x,y)@ and @(x, -y)@.  The
+equality test only checks the x-coordinate.  An x-only pubkey serializes to 32
+bytes.
+
+@since 0.7.0
+-}
+newtype XOnlyPubKey = XOnlyPubKey { unXOnlyPubKey :: ByteString }
+    deriving (Eq, Hashable)
+
+#ifdef BIP340
+
+instance Show XOnlyPubKey where
+    showsPrec _ = shows . B16.encodeBase16 . serializeXOnlyPubKey
+
+instance Serialize XOnlyPubKey where
+    get =
+        maybe (fail "Unable to parse x-only pubkey") pure . parseXOnlyPubKey
+            =<< getByteString 32
+    put = putByteString . serializeXOnlyPubKey
+
+newtype Bip340Sig = Bip340Sig {unBip340Sig :: ByteString}
+    deriving Eq
+
+instance Show Bip340Sig where
+    showsPrec _ = shows . B16.encodeBase16 . unBip340Sig
+
+instance Serialize Bip340Sig where
+    get = Bip340Sig <$> getByteString 64
+    put = putByteString . unBip340Sig
+
+newtype Rand32 = Rand32 {unRand32 :: ByteString}
+
+-- | Create a 'Rand32' value from a 32-byte 'ByteString'
+mkRand32 :: ByteString -> Maybe Rand32
+mkRand32 bytes
+    | BS.length bytes == 32 = Just $ Rand32 bytes
+    | otherwise = Nothing
+
+serializeXOnlyPubKey :: XOnlyPubKey -> ByteString
+serializeXOnlyPubKey pubKey = unsafePerformIO $
+    BU.unsafeUseAsCString (unXOnlyPubKey pubKey) $ \xOnlyPubKeyPtr -> do
+        outputBuffer <- mallocBytes 32
+        result <- xOnlyPubKeySerialize ctx outputBuffer xOnlyPubKeyPtr
+        if isSuccess result
+           then BU.unsafePackMallocCStringLen (outputBuffer, 32)
+           else free outputBuffer >> error "Unable to serialize x-only pubkey"
+
+parseXOnlyPubKey :: ByteString -> Maybe XOnlyPubKey
+parseXOnlyPubKey inputBytes
+    | BS.length inputBytes == 32 = unsafePerformIO $
+      BS.useAsCString inputBytes $ \inputBytesPtr -> do
+        xOnlyPubKeyPtr <- mallocBytes 64
+        result <- xOnlyPubKeyParse ctx xOnlyPubKeyPtr inputBytesPtr
+        if isSuccess result
+           then Just . XOnlyPubKey <$> BU.unsafePackMallocCStringLen (xOnlyPubKeyPtr, 64)
+           else pure Nothing
+    | otherwise = Nothing
+
+-- | Derive an x-only key from a pub key
+deriveXOnlyPubKey :: PubKey -> XOnlyPubKey
+deriveXOnlyPubKey pubKey = unsafePerformIO $
+    BU.unsafeUseAsCString (getPubKey pubKey) $ \pubKeyPtr -> do
+        xOnlyPubKeyPtr <- mallocBytes 64
+        result <- xOnlyPubKeyFromPubKey ctx xOnlyPubKeyPtr nullPtr pubKeyPtr
+        if isSuccess result
+            then XOnlyPubKey <$> BU.unsafePackMallocCStringLen (xOnlyPubKeyPtr, 64)
+            else free xOnlyPubKeyPtr >> error "Unable to derive x-only pubkey"
+
+-- | Sign a message according to BIP 340
+signBip340 ::
+    -- | Secret key
+    SecKey ->
+    -- | Message
+    Msg ->
+    -- | Randomness
+    Maybe Rand32 ->
+    -- | Signature
+    Maybe Bip340Sig
+signBip340 theSecKey message rand32 = unsafePerformIO $
+    BU.unsafeUseAsCString (getSecKey theSecKey) $ \secKeyPtr ->
+        allocaBytes 96 $ \keyPairPtr -> do
+            -- The 'SecKey' API guarantees that the following call will succeed
+            _ <- keyPairCreate ctx keyPairPtr secKeyPtr
+            BU.unsafeUseAsCString (getMsg message) $ \messageCStr -> do
+                withRand32 $ \rand32Ptr -> do
+                    sigPtr <- mallocBytes 64
+                    result <- schnorrSign ctx sigPtr messageCStr keyPairPtr rand32Ptr
+                    if isSuccess result
+                        then Just . Bip340Sig <$> BU.unsafePackMallocCStringLen (sigPtr, 64)
+                        else Nothing <$ free sigPtr
+    where
+        withRand32 = maybe ($ nullPtr) (BU.unsafeUseAsCString . unRand32) rand32
+
+
+-- | Verify a message according to BIP 340
+verifyBip340 ::
+    XOnlyPubKey ->
+    -- | Message
+    Msg ->
+    -- | Signature
+    Bip340Sig ->
+    Bool
+verifyBip340 xOnlyPubKey message sig = unsafePerformIO $
+    BU.unsafeUseAsCString (unXOnlyPubKey xOnlyPubKey) $ \xOnlyPubKeyPtr ->
+        BU.unsafeUseAsCStringLen (getMsg message) $ \(messageCStr, messageSize) ->
+            BU.unsafeUseAsCString (unBip340Sig sig) $ \signatureCStr ->
+                isSuccess
+                    <$> schnorrVerify
+                        ctx
+                        signatureCStr
+                        messageCStr
+                        (fromIntegral messageSize)
+                        xOnlyPubKeyPtr
+
+
+#endif

src/Crypto/Secp256k1/Internal.hs

@@ -1,3 +1,5 @@
+{-# LANGUAGE CPP #-}
+
 {-|
 Module      : Crypto.Secp256k1.Internal
 License     : UNLICENSE
@@ -20,8 +22,11 @@ import           System.IO.Unsafe       (unsafePerformIO)
 
 data LCtx
 data PubKey64
+data XOnlyPubKey32
+data KeyPair96
 data Msg32
 data Sig64
+data Bip340Sig64
 data Compact64
 data Seed32
 data SecKey32
@@ -268,3 +273,71 @@ foreign import ccall safe
     -> Ptr (Ptr PubKey64) -- ^ pointer to array of public keys
     -> CInt               -- ^ number of public keys
     -> IO Ret
+
+#ifdef BIP340
+
+foreign import ccall unsafe "secp256k1.h secp256k1_schnorrsig_sign"
+    schnorrSign ::
+        Ctx ->
+        -- | Signature
+        CString ->
+        -- | Message
+        CString ->
+        -- | Keypair
+        CString ->
+        -- | Randomness
+        CString ->
+        IO CInt
+
+foreign import ccall unsafe "secp256k1.h secp256k1_schnorrsig_verify"
+    schnorrVerify ::
+        Ctx ->
+        -- | Signature
+        CString ->
+        -- | Message
+        CString ->
+        -- | Message length
+        CSize ->
+        -- | X-Only pubkey
+        CString ->
+        IO CInt
+
+foreign import ccall unsafe "secp256k1.h secp256k1_keypair_create"
+    keyPairCreate ::
+        Ctx ->
+        -- | Keypair
+        CString ->
+        -- | Secret key
+        CString ->
+        IO CInt
+
+foreign import ccall unsafe "secp256k1.h secp256k1_xonly_pubkey_parse"
+    xOnlyPubKeyParse ::
+        Ctx ->
+        -- | Parsed X-Only pubkey
+        CString ->
+        -- | Input buffer
+        CString ->
+        IO CInt
+
+foreign import ccall unsafe "secp256k1.h secp256k1_xonly_pubkey_serialize"
+    xOnlyPubKeySerialize ::
+        Ctx ->
+        -- | Output buffer
+        CString ->
+        -- | X-Only pubkey
+        CString ->
+        IO CInt
+
+foreign import ccall unsafe "secp256k1.h secp256k1_xonly_pubkey_from_pubkey"
+    xOnlyPubKeyFromPubKey ::
+        Ctx ->
+        -- | X-only pubkey
+        CString ->
+        -- | Parity
+        Ptr CInt ->
+        -- | Pubkey
+        CString ->
+        IO CInt
+
+#endif