secp256k1-haskell 0.1.8 → 0.2.0
raw patch · 6 files changed
+510/−44 lines, 6 files
Files
- CHANGELOG.md +8/−0
- secp256k1-haskell.cabal +16/−2
- src/Crypto/Secp256k1.hs +192/−3
- src/Crypto/Secp256k1/Internal.hs +131/−2
- test/Crypto/Secp256k1/InternalSpec.hs +20/−10
- test/Crypto/Secp256k1Spec.hs +143/−27
CHANGELOG.md view
@@ -4,6 +4,14 @@ The format is based on [Keep a Changelog](http://keepachangelog.com/en/1.0.0/) and this project adheres to [Semantic Versioning](http://semver.org/spec/v2.0.0.html). +## 0.2.0+### Added+- Support for ECDH APIs.+- Support for Schnorr APIs.++### Removed+- Enabling key recovery APIs need a flag.+ ## 0.1.8 ### Added - Add missing `NFData` instances for some types.
secp256k1-haskell.cabal view
@@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: 89af02aeb2d034b30650caa8ac3da870deac12d246a8fa513ab1fdc3033461f5+-- hash: b923e5c7c968e7e6740b791bf84e395fcf448a13a190d70959b199e94e9843c7 name: secp256k1-haskell-version: 0.1.8+version: 0.2.0 synopsis: Bindings for secp256k1 library from Bitcoin Core description: Sign and verify signatures using the very fast C secp256k1 library from Pieter Wuille. Has Haskell types and abstractions for keys and signatures. category: Crypto@@ -32,6 +32,16 @@ manual: True default: False +flag recovery+ description: Enable signature key recovery APIs+ manual: True+ default: False++flag schnorr+ description: Enable BIP-340 (Schnorr) APIs+ manual: True+ default: False+ library exposed-modules: Crypto.Secp256k1@@ -54,6 +64,10 @@ , string-conversions if flag(ecdh) cpp-options: -DECDH+ if flag(schnorr)+ cpp-options: -DSCHNORR+ if flag(recovery)+ cpp-options: -DRECOVERY default-language: Haskell2010 test-suite spec
src/Crypto/Secp256k1.hs view
@@ -3,8 +3,8 @@ {-# LANGUAGE MultiParamTypeClasses #-} {-| Module : Crypto.Secp256k1-License : MIT-Maintainer : Jean-Pierre Rupp <root@haskoin.com>+License : UNLICENSE+Maintainer : Jean-Pierre Rupp <jprupp@protonmail.ch> Stability : experimental Portability : POSIX @@ -39,7 +39,8 @@ , CompactSig(..) , exportCompactSig , importCompactSig- -- * Recoverable+#ifdef RECOVERY+ -- ** Recovery , RecSig , CompactRecSig(..) , importCompactRecSig@@ -47,6 +48,7 @@ , convertRecSig , signRecMsg , recover+#endif -- * Addition & Multiplication , Tweak@@ -57,11 +59,27 @@ , tweakAddPubKey , tweakMulPubKey , combinePubKeys+ , tweakNegate #ifdef ECDH -- * Diffie Hellman , ecdh #endif++#ifdef SCHNORR+ , XOnlyPubKey+ , SchnorrSig+ , signMsgSchnorr+ , exportSchnorrSig+ , importSchnorrSig+ , exportXOnlyPubKey+ , importXOnlyPubKey+ , verifyMsgSchnorr+ , deriveXOnlyPubKey+ , schnorrTweakAddPubKey+ , schnorrTweakAddSecKey+ , testTweakXOnlyPubKey+#endif ) where import Control.Monad (replicateM, unless, (<=<))@@ -78,6 +96,7 @@ allocaBytes, mallocForeignPtr, nullFunPtr, nullPtr, peek, poke, pokeArray, withForeignPtr)+import Foreign.C (CInt) import System.IO.Unsafe (unsafePerformIO) import Test.QuickCheck (Arbitrary (..), arbitraryBoundedRandom, suchThat)@@ -93,6 +112,10 @@ newtype SecKey = SecKey (ForeignPtr SecKey32) newtype Tweak = Tweak (ForeignPtr Tweak32) newtype RecSig = RecSig (ForeignPtr RecSig65)+#ifdef SCHNORR+newtype XOnlyPubKey = XOnlyPubKey (ForeignPtr XOnlyPubKey64)+newtype SchnorrSig = SchnorrSig (ForeignPtr SchnorrSig64)+#endif instance NFData PubKey where rnf (PubKey p) = p `seq` ()@@ -161,6 +184,7 @@ instance Show Sig where showsPrec _ = shows . B16.encode . exportSig +#ifdef RECOVERY recSigFromString :: String -> Maybe RecSig recSigFromString str = do bs <- decodeHex str@@ -182,6 +206,7 @@ instance Show RecSig where showsPrec _ = shows . B16.encode . encode . exportCompactRecSig+#endif instance Read SecKey where readPrec = parens $ do@@ -222,8 +247,10 @@ instance Eq Sig where fg1 == fg2 = exportCompactSig fg1 == exportCompactSig fg2 +#ifdef RECOVERY instance Eq RecSig where fg1 == fg2 = exportCompactRecSig fg1 == exportCompactRecSig fg2+#endif instance Eq SecKey where fk1 == fk2 = getSecKey fk1 == getSecKey fk2@@ -231,6 +258,50 @@ instance Eq Tweak where ft1 == ft2 = getTweak ft1 == getTweak ft2 +#ifdef SCHNORR+instance NFData SchnorrSig where+ rnf (SchnorrSig p) = p `seq` ()++instance Show SchnorrSig where+ showsPrec _ = shows . B16.encode . exportSchnorrSig++instance Read SchnorrSig where+ readPrec = parens $ do+ String str <- lexP+ maybe pfail return $ importSchnorrSig =<< decodeHex str++instance Eq SchnorrSig where+ fg1 == fg2 = exportSchnorrSig fg1 == exportSchnorrSig fg2++instance IsString SchnorrSig where+ fromString = fromMaybe e . (importSchnorrSig <=< decodeHex) where+ e = error "Could not decode Schnorr signature from hex string"++instance Hashable SchnorrSig where+ i `hashWithSalt` s = i `hashWithSalt` exportSchnorrSig s++instance NFData XOnlyPubKey where+ rnf (XOnlyPubKey p) = p `seq` ()++instance Show XOnlyPubKey where+ showsPrec _ = shows . B16.encode . exportXOnlyPubKey++instance Read XOnlyPubKey where+ readPrec = do+ String str <- lexP+ maybe pfail return $ importXOnlyPubKey =<< decodeHex str++instance Eq XOnlyPubKey where+ fp1 == fp2 = getXOnlyPubKey fp1 == getXOnlyPubKey fp2++instance IsString XOnlyPubKey where+ fromString = fromMaybe e . (importXOnlyPubKey <=< decodeHex) where+ e = error "Could not decode public key from hex string"++instance Hashable XOnlyPubKey where+ i `hashWithSalt` k = i `hashWithSalt` exportXOnlyPubKey k+#endif+ -- | Import 32-byte 'ByteString' as 'Msg'. msg :: ByteString -> Maybe Msg msg bs@@ -365,6 +436,7 @@ unless (isSuccess ret) $ error "could not compute public key" return $ PubKey fp + -- | Add tweak to secret key. tweakAddSecKey :: SecKey -> Tweak -> Maybe SecKey tweakAddSecKey (SecKey fk) (Tweak ft) = withContext $ \ctx ->@@ -426,6 +498,7 @@ pointers ps (PubKey fp : pubs') f = withForeignPtr fp $ \p -> pointers (p:ps) pubs' f +#ifdef RECOVERY -- | Parse a compact ECDSA signature (64 bytes + recovery id). importCompactRecSig :: CompactRecSig -> Maybe RecSig importCompactRecSig cr =@@ -479,7 +552,20 @@ fp <- mallocForeignPtr ret <- withForeignPtr fp $ \pp -> ecdsaRecover ctx pp prg pm if isSuccess ret then return $ Just $ PubKey fp else return Nothing+#endif +tweakNegate :: Tweak -> Maybe Tweak+tweakNegate (Tweak fk) = withContext $ \ctx -> do+ fnew <- mallocForeignPtr+ peeked <- withForeignPtr fk peek+ ret <- withForeignPtr fnew $ \n -> do+ poke n peeked+ ecTweakNegate ctx n+ return $+ if isSuccess ret+ then Just (Tweak fnew)+ else Nothing+ #ifdef ECDH -- | Compute Diffie-Hellman secret. ecdh :: PubKey -> SecKey -> ByteString@@ -494,6 +580,102 @@ size = 32 #endif +#ifdef SCHNORR+-- Get 64-byte x-only public key.+getXOnlyPubKey :: XOnlyPubKey -> ByteString+getXOnlyPubKey (XOnlyPubKey fp) =+ fromShort $ getXOnlyPubKey64 $ unsafePerformIO $ withForeignPtr fp peek++-- | Add tweak to public key. Tweak is multiplied first by G to obtain a point.+schnorrTweakAddPubKey :: XOnlyPubKey -> Tweak -> Maybe (XOnlyPubKey, CInt)+schnorrTweakAddPubKey (XOnlyPubKey fp) (Tweak ft) = withContext $ \ctx ->+ withForeignPtr fp $ \p -> withForeignPtr ft $ \t -> alloca $ \is_negated -> do+ fp' <- mallocForeignPtr+ ret <- withForeignPtr fp' $ \p' -> do+ pub <- peek p+ poke p' pub+ schnorrPubKeyTweakAdd ctx p' is_negated t+ peeked_is_negated <- peek is_negated+ if isSuccess ret then return $ Just $ (XOnlyPubKey fp', peeked_is_negated) else return Nothing++-- | Add tweak to secret key.+schnorrTweakAddSecKey :: SecKey -> Tweak -> Maybe SecKey+schnorrTweakAddSecKey (SecKey fk) (Tweak ft) = withContext $ \ctx ->+ withForeignPtr fk $ \k -> withForeignPtr ft $ \t -> do+ fk' <- mallocForeignPtr+ ret <- withForeignPtr fk' $ \k' -> do+ key <- peek k+ poke k' key+ schnorrSecKeyTweakAdd ctx k' t+ if isSuccess ret then return $ Just $ SecKey fk' else return Nothing++signMsgSchnorr :: SecKey -> Msg -> SchnorrSig+signMsgSchnorr (SecKey fk) (Msg fm) = withContext $ \ctx ->+ withForeignPtr fk $ \k -> withForeignPtr fm $ \m -> do+ fg <- mallocForeignPtr+ ret <- withForeignPtr fg $ \g -> schnorrSign ctx g m k nullFunPtr nullPtr+ unless (isSuccess ret) $ error "could not schnorr-sign message"+ return $ SchnorrSig fg++exportSchnorrSig :: SchnorrSig -> ByteString+exportSchnorrSig (SchnorrSig fg) = withContext $ \ctx ->+ withForeignPtr fg $ \g -> allocaBytes 64 $ \o -> do+ ret <- signatureSerializeSchnorr ctx o g+ unless (isSuccess ret) $ error "could not serialize schnorr signature"+ packByteString (o, 64)++importXOnlyPubKey :: ByteString -> Maybe XOnlyPubKey+importXOnlyPubKey bs+ | BS.length bs == 32 = withContext $ \ctx -> do+ fp <- mallocForeignPtr+ ret <- withForeignPtr fp $ \pfp -> useByteString bs $ \(inp, _) ->+ schnorrXOnlyPubKeyParse ctx pfp inp+ if isSuccess ret+ then return $ Just $ XOnlyPubKey fp+ else return Nothing+ | otherwise = Nothing++importSchnorrSig :: ByteString -> Maybe SchnorrSig+importSchnorrSig bs+ | BS.length bs == 64 = withContext $ \ctx -> do+ fp <- mallocForeignPtr+ ret <- withForeignPtr fp $ \pfp -> useByteString bs $ \(inp, _) ->+ schnorrSignatureParse ctx pfp inp+ if isSuccess ret+ then return $ Just $ SchnorrSig fp+ else return Nothing+ | otherwise = Nothing++verifyMsgSchnorr :: XOnlyPubKey -> SchnorrSig -> Msg -> Bool+verifyMsgSchnorr (XOnlyPubKey fp) (SchnorrSig fg) (Msg fm) = withContext $ \ctx ->+ withForeignPtr fp $ \p -> withForeignPtr fg $ \g ->+ withForeignPtr fm $ \m -> isSuccess <$> schnorrSignatureVerify ctx g m p++exportXOnlyPubKey :: XOnlyPubKey -> ByteString+exportXOnlyPubKey (XOnlyPubKey pub) = withContext $ \ctx ->+ withForeignPtr pub $ \p -> allocaBytes 32 $ \o -> do+ ret <- schnorrPubKeySerialize ctx o p+ unless (isSuccess ret) $ error "could not serialize x-only public key"+ packByteString (o, 32)++deriveXOnlyPubKey :: SecKey -> XOnlyPubKey+deriveXOnlyPubKey (SecKey fk) = withContext $ \ctx -> withForeignPtr fk $ \k -> do+ fp <- mallocForeignPtr+ ret <- withForeignPtr fp $ \p -> schnorrXOnlyPubKeyCreate ctx p k+ unless (isSuccess ret) $ error "could not derive x-only public key"+ return $ XOnlyPubKey fp++testTweakXOnlyPubKey :: XOnlyPubKey -> CInt -> XOnlyPubKey -> Tweak -> Bool+testTweakXOnlyPubKey (XOnlyPubKey fp) is_negated (XOnlyPubKey internal) (Tweak ft) =+ withContext $ \ctx ->+ withForeignPtr fp $ \p ->+ withForeignPtr internal $ \internalp ->+ withForeignPtr ft $ \t -> do+ ret <- xOnlyPubKeyTweakTest ctx p is_negated internalp t+ return $ isSuccess ret+-- End of Schnorr block+#endif+ instance Arbitrary Msg where arbitrary = gen_msg where@@ -511,3 +693,10 @@ arbitrary = do key <- arbitrary return $ derivePubKey key++#ifdef SCHNORR+instance Arbitrary XOnlyPubKey where+ arbitrary = do+ key <- arbitrary+ return $ deriveXOnlyPubKey key+#endif
src/Crypto/Secp256k1/Internal.hs view
@@ -4,8 +4,8 @@ {-# LANGUAGE RecordWildCards #-} {-| Module : Crypto.Secp256k1.Internal-License : MIT-Maintainer : Jean-Pierre Rupp <root@haskoin.com>+License : UNLICENSE+Maintainer : Jean-Pierre Rupp <jprupp@protonmail.ch> Stability : experimental Portability : POSIX @@ -49,6 +49,7 @@ newtype RecSig65 = RecSig65 { getRecSig65 :: ShortByteString } deriving (Read, Show, Eq, Ord, Generic, NFData) +#ifdef RECOVERY data CompactRecSig = CompactRecSig { getCompactRecSigR :: !ShortByteString@@ -56,6 +57,7 @@ , getCompactRecSigV :: !Word8 } deriving (Show, Eq, Ord, Generic, NFData)+#endif newtype Seed32 = Seed32 { getSeed32 :: ShortByteString } deriving (Read, Show, Eq, Ord, Generic, NFData)@@ -81,6 +83,14 @@ newtype Ret = Ret { getRet :: CInt } deriving (Read, Show, Eq, Ord, Generic, NFData) +#ifdef SCHNORR+newtype XOnlyPubKey64 = XOnlyPubKey64 { getXOnlyPubKey64 :: ShortByteString }+ deriving (Read, Show, Eq, Ord, Generic, NFData)++newtype SchnorrSig64 = SchnorrSig64 { getSchnorrSig64 :: ShortByteString }+ deriving (Read, Show, Eq, Ord, Generic, NFData)+#endif+ -- | Nonce32-generating function type NonceFunction a = Ptr Nonce32@@ -113,6 +123,22 @@ packByteString :: (Ptr CUChar, CSize) -> IO ByteString packByteString (b, l) = BS.packCStringLen (castPtr b, fromIntegral l) +#if SCHNORR+instance Storable XOnlyPubKey64 where+ sizeOf _ = 64+ alignment _ = 1+ peek p = XOnlyPubKey64 . toShort <$> packByteString (castPtr p, 64)+ poke p (XOnlyPubKey64 k) = useByteString (fromShort k) $+ \(b, _) -> copyArray (castPtr p) b 64++instance Storable SchnorrSig64 where+ sizeOf _ = 64+ alignment _ = 1+ peek p = SchnorrSig64 . toShort <$> packByteString (castPtr p, 64)+ poke p (SchnorrSig64 k) = useByteString (fromShort k) $+ \(b, _) -> copyArray (castPtr p) b 64+#endif+ instance Storable PubKey64 where sizeOf _ = 64 alignment _ = 1@@ -154,6 +180,7 @@ Put.putShortByteString s Put.putShortByteString r +#ifdef RECOVERY instance Storable RecSig65 where sizeOf _ = 65 alignment _ = 1@@ -192,6 +219,7 @@ Put.putShortByteString s Put.putShortByteString r Put.putWord8 v+#endif instance Storable Msg32 where sizeOf _ = 32@@ -392,6 +420,13 @@ -> IO Ret foreign import ccall+ "secp256k1.h secp256k1_ec_privkey_negate"+ ecTweakNegate+ :: Ptr Ctx+ -> Ptr Tweak32+ -> IO Ret++foreign import ccall "secp256k1.h secp256k1_ec_pubkey_tweak_add" ecPubKeyTweakAdd :: Ptr Ctx@@ -431,6 +466,7 @@ -> CInt -- ^ number of public keys -> IO Ret +#ifdef RECOVERY foreign import ccall "secp256k1_recovery.h secp256k1_ecdsa_recoverable_signature_parse_compact" ecdsaRecoverableSignatureParseCompact@@ -476,6 +512,99 @@ -> Ptr RecSig65 -> Ptr Msg32 -> IO Ret+#endif++#ifdef SCHNORR+foreign import ccall+ "secp256k1.h secp256k1_xonly_pubkey_tweak_add"+ schnorrPubKeyTweakAdd+ :: Ptr Ctx+ -> Ptr XOnlyPubKey64+ -> Ptr CInt+ -> Ptr Tweak32+ -> IO Ret++foreign import ccall+ "secp256k1.h secp256k1_xonly_seckey_tweak_add"+ schnorrSecKeyTweakAdd+ :: Ptr Ctx+ -> Ptr SecKey32+ -> Ptr Tweak32+ -> IO Ret++foreign import ccall+ "secp256k1.h secp256k1_schnorrsig_serialize"+ signatureSerializeSchnorr+ :: Ptr Ctx+ -> Ptr CUChar -- ^ array for encoded signature, must be large enough+ -> Ptr SchnorrSig64+ -> IO Ret++foreign import ccall+ "secp256k1.h secp256k1_schnorrsig_sign"+ schnorrSign+ :: Ptr Ctx+ -> Ptr SchnorrSig64+ -> Ptr Msg32+ -> Ptr SecKey32+ -- TODO+ -- This is actually an "extended nonce function" in the C code. So this signature is broken,+ -- but we pass a nullFunPtr (and this module is Internal), so it doesn't matter right now.+ -> FunPtr (NonceFunction a)+ -> Ptr a -- ^ nonce data+ -> IO Ret++foreign import ccall+ "secp256k1.h secp256k1_xonly_pubkey_tweak_test"+ xOnlyPubKeyTweakTest+ :: Ptr Ctx+ -> Ptr XOnlyPubKey64 -- output_pubkey+ -> CInt -- is_negated+ -> Ptr XOnlyPubKey64 -- internal_pubkey+ -> Ptr Tweak32+ -> IO Ret++foreign import ccall+ "secp256k1.h secp256k1_xonly_pubkey_serialize"+ schnorrPubKeySerialize+ :: Ptr Ctx+ -> Ptr CUChar -- 32 bytes output buffer+ -> Ptr XOnlyPubKey64+ -> IO Ret++foreign import ccall+ "secp256k1.h secp256k1_schnorrsig_verify"+ schnorrSignatureVerify+ :: Ptr Ctx+ -> Ptr SchnorrSig64+ -> Ptr Msg32+ -> Ptr XOnlyPubKey64+ -> IO Ret++foreign import ccall+ "secp256k1.h secp256k1_schnorrsig_parse"+ schnorrSignatureParse+ :: Ptr Ctx+ -> Ptr SchnorrSig64 -- out+ -> Ptr CUChar -- in+ -> IO Ret++foreign import ccall+ "secp256k1.h secp256k1_xonly_pubkey_parse"+ schnorrXOnlyPubKeyParse+ :: Ptr Ctx+ -> Ptr XOnlyPubKey64 -- out+ -> Ptr CUChar -- in+ -> IO Ret++foreign import ccall+ "secp256k1.h secp256k1_xonly_pubkey_create"+ schnorrXOnlyPubKeyCreate+ :: Ptr Ctx+ -> Ptr XOnlyPubKey64+ -> Ptr SecKey32+ -> IO Ret+#endif #ifdef ECDH foreign import ccall
test/Crypto/Secp256k1/InternalSpec.hs view
@@ -221,7 +221,7 @@ ecdsaSignTest :: Assertion ecdsaSignTest = do- (ret, sig) <- liftIO $ do+ der <- liftIO $ do x <- signCtx alloca $ \s -> alloca $ \m -> alloca $ \k -> alloca $ \ol -> allocaBytes 72 $ \o -> do@@ -232,22 +232,31 @@ -- TODO: -- ecdsaSign x s m k nonce_function_default nullPtr ecdsaSign x s m k nullFunPtr nullPtr+ unless (isSuccess ret1) $ error "could not sign message" ret2 <- ecdsaSignatureSerializeDer x o ol s unless (isSuccess ret2) $ error "could not serialize signature" len <- peek ol- sig <- packCStringLen (castPtr o, fromIntegral len)- return (ret1, sig)- assertBool "successful signing" $ isSuccess ret- assertEqual "signature matches" sig der+ der <- packCStringLen (castPtr o, fromIntegral len)+ return der+ ret <- liftIO $ do+ p <- alloca $ \p -> alloca $ \k -> do+ poke k key+ x <- signCtx+ ret <- ecPubKeyCreate x p k+ unless (isSuccess ret) $ error "failed to create public key"+ return p+ alloca $ \m -> alloca $ \s -> do+ x <- contextCreate verify+ sig <- parseDer x der+ poke m msg+ poke s sig+ ecdsaVerify x s m p+ assertBool "signature matches" (isSuccess ret) where msg = Msg32 $ toShort $ fst $ B16.decode "f5cbe7d88182a4b8e400f96b06128921864a18187d114c8ae8541b566c8ace00" key = SecKey32 $ toShort $ fst $ B16.decode "f65255094d7773ed8dd417badc9fc045c1f80fdc5b2d25172b031ce6933e039a"- der = fst $ B16.decode- "3045022100f502bfa07af43e7ef265618b0d929a7619ee01d6150e37eb6eaaf2c8bd37\- \fb2202206f0415ab0e9a977afd78b2c26ef39b3952096d319fd4b101c768ad6c132e30\- \45" ecSecKeyVerifyTest :: Assertion ecSecKeyVerifyTest = do@@ -266,11 +275,12 @@ poke k key x <- signCtx ret <- ecPubKeyCreate x p k+ unless (isSuccess ret) $ error "failed to create public key" allocaBytes 65 $ \o -> alloca $ \ol -> do poke ol 65 rets <- ecPubKeySerialize x o ol p uncompressed- unless (isSuccess rets) $ error "failed to serialive public key"+ unless (isSuccess rets) $ error "failed to serialize public key" len <- fromIntegral <$> peek ol pk <- packCStringLen (castPtr o, len) return (ret, pk)
test/Crypto/Secp256k1Spec.hs view
@@ -2,6 +2,7 @@ module Crypto.Secp256k1Spec (spec) where import Crypto.Secp256k1+import qualified Data.ByteString as BS import qualified Data.ByteString.Base16 as B16 import qualified Data.ByteString.Char8 as B8 import Data.Maybe (fromMaybe)@@ -16,18 +17,18 @@ spec = do describe "signatures" $ do it "signs message" $ property $ signMsgTest- it "recovers key from signed message" $ property $ signRecMsgTest it "detects bad signature" $ property $ badSignatureTest- it "detects bad recoverable signature" $ property $ badRecSignatureTest it "normalizes signatures" $ property $ normalizeSigTest+#ifdef RECOVERY it "recovers public keys" $ property $ recoverTest- it "Bad recover public keys" $ property $ badRecoverTest+ it "recovers key from signed message" $ property $ signRecMsgTest+ it "does not recover bad public keys" $ property $ badRecoverTest+ it "detects bad recoverable signature" $ property $ badRecSignatureTest+#endif describe "serialization" $ do it "serializes public key" $ property $ serializePubKeyTest it "serializes DER signature" $ property $ serializeSigTest it "serializes compact signature" $ property $ serializeCompactSigTest- it "serializes compact recoverable signature" $- property $ serializeCompactRecSigTest it "serialize secret key" $ property $ serializeSecKeyTest it "shows and reads public key" $ property $ (showRead :: PubKey -> Bool)@@ -37,26 +38,53 @@ property $ (showReadTweak :: SecKey -> Bool) it "shows and reads signature" $ property $ (showReadSig :: (SecKey, Msg) -> Bool)- it "shows and reads recoverable signature" $- property $ (showReadRecSig :: (SecKey, Msg) -> Bool) it "shows and reads message" $ property $ (showRead :: Msg -> Bool) it "reads public key from string" $ property $ isStringPubKey it "reads secret key from string" $ property $ isStringSecKey it "reads signature from string" $ property $ isStringSig- it "reads recoverable signature from string" $ property $ isStringRecSig it "reads message from string" $ property $ isStringMsg it "reads tweak from string" $ property $ isStringTweak+#ifdef RECOVERY+ it "serializes compact recoverable signature" $+ property $ serializeCompactRecSigTest+ it "shows and reads recoverable signature" $+ property $ (showReadRecSig :: (SecKey, Msg) -> Bool)+ it "reads recoverable signature from string" $ property $ isStringRecSig+#endif describe "tweaks" $ do it "add secret key" $ property $ tweakAddSecKeyTest it "multiply secret key" $ property $ tweakMulSecKeyTest it "add public key" $ property $ tweakAddPubKeyTest it "multiply public key" $ property $ tweakMulPubKeyTest it "combine public keys" $ property $ combinePubKeyTest+ it "negates tweak" $ property $ negateTweakTest #ifdef ECDH describe "ecdh" $ do it "computes dh secret" $ property $ computeDhSecret #endif+#ifdef SCHNORR+ describe "schnorr (bip-340)" $ do+ it "validates test vector 0" $ property bip340Vector0+ it "rejects test vector 5" $ property $+ failingVectorToAssertion InvalidPubKey+ (+ hexToBytes "eefdea4cdb677750a420fee807eacf21eb9898ae79b9768766e4faa04a2d4a34",+ hexToBytes "243f6a8885a308d313198a2e03707344a4093822299f31d0082efa98ec4e6c89",+ hexToBytes "667c2f778e0616e611bd0c14b8a600c5884551701a949ef0ebfd72d452d64e844160bcfc3f466ecb8facd19ade57d8699d74e7207d78c6aedc3799b52a8e0598"+ )+ it "rejects test vector 6" $ property $+ failingVectorToAssertion InvalidSig+ (+ hexToBytes "dff1d77f2a671c5f36183726db2341be58feae1da2deced843240f7b502ba659",+ hexToBytes "243f6a8885a308d313198a2e03707344a4093822299f31d0082efa98ec4e6c89",+ hexToBytes "f9308a019258c31049344f85f89d5229b531c845836f99b08601f113bce036f9935554d1aa5f0374e5cdaacb3925035c7c169b27c4426df0a6b19af3baeab138"+ )+ it "makes a valid taproot key spend signature" $ property taprootKeySpend+#endif +hexToBytes :: String -> BS.ByteString+hexToBytes = fst . B16.decode . B8.pack+ isStringPubKey :: (PubKey, Bool) -> Bool isStringPubKey (k, c) = k == fromString (cs hex) where hex = B16.encode $ exportPubKey c k@@ -66,10 +94,12 @@ g = signMsg k m hex = B16.encode $ exportSig g +#ifdef RECOVERY isStringRecSig :: (SecKey, Msg) -> Bool isStringRecSig (k, m) = g == fromString (cs hex) where g = signRecMsg k m hex = B16.encode . encode $ exportCompactRecSig g+#endif isStringMsg :: Msg -> Bool isStringMsg m = m == fromString (cs m') where@@ -93,9 +123,11 @@ showReadSig (k, m) = showRead sig where sig = signMsg k m +#ifdef RECOVERY showReadRecSig :: (SecKey, Msg) -> Bool showReadRecSig (k, m) = showRead recSig where recSig = signRecMsg k m+#endif showRead :: (Show a, Read a, Eq a) => a -> Bool showRead x = read (show x) == x@@ -105,6 +137,7 @@ fp = derivePubKey fk fg = signMsg fk fm +#ifdef RECOVERY signRecMsgTest :: (Msg, SecKey) -> Bool signRecMsgTest (fm, fk) = verifySig fp fg fm where fp = derivePubKey fk@@ -122,14 +155,17 @@ fg = signRecMsg fk fm fp = derivePubKey fk fp' = recover fg fm'+#endif badSignatureTest :: (Msg, SecKey, PubKey) -> Bool badSignatureTest (fm, fk, fp) = not $ verifySig fp fg fm where fg = signMsg fk fm +#ifdef RECOVERY badRecSignatureTest :: (Msg, SecKey, PubKey) -> Bool badRecSignatureTest (fm, fk, fp) = not $ verifySig fp fg fm where fg = convertRecSig $ signRecMsg fk fm+#endif normalizeSigTest :: (Msg, SecKey) -> Bool normalizeSigTest (fm, fk) = not norm && sig == fg where@@ -158,6 +194,7 @@ where fg = signMsg fk fm +#ifdef RECOVERY serializeCompactRecSigTest :: (Msg, SecKey) -> Bool serializeCompactRecSigTest (fm, fk) = case importCompactRecSig $ exportCompactRecSig fg of@@ -165,6 +202,7 @@ Nothing -> False where fg = signRecMsg fk fm+#endif serializeSecKeyTest :: SecKey -> Bool serializeSecKeyTest fk =@@ -177,12 +215,12 @@ assertEqual "tweaked keys match" expected tweaked where tweaked = do- key <- secKey $ fst $ B16.decode $ B8.pack+ key <- secKey $ hexToBytes "f65255094d7773ed8dd417badc9fc045c1f80fdc5b2d25172b031ce6933e039a"- twk <- tweak $ fst $ B16.decode $ B8.pack+ twk <- tweak $ hexToBytes "f5cbe7d88182a4b8e400f96b06128921864a18187d114c8ae8541b566c8ace00" tweakAddSecKey key twk- expected = secKey $ fst $ B16.decode $ B8.pack+ expected = secKey $ hexToBytes "ec1e3ce1cefa18a671d51125e2b249688d934b0e28f5d1665384d9b02f929059" tweakMulSecKeyTest :: Assertion@@ -190,12 +228,12 @@ assertEqual "tweaked keys match" expected tweaked where tweaked = do- key <- secKey $ fst $ B16.decode $ B8.pack+ key <- secKey $ hexToBytes "f65255094d7773ed8dd417badc9fc045c1f80fdc5b2d25172b031ce6933e039a"- twk <- tweak $ fst $ B16.decode $ B8.pack+ twk <- tweak $ hexToBytes "f5cbe7d88182a4b8e400f96b06128921864a18187d114c8ae8541b566c8ace00" tweakMulSecKey key twk- expected = secKey $ fst $ B16.decode $ B8.pack+ expected = secKey $ hexToBytes "a96f5962493acb179f60a86a9785fc7a30e0c39b64c09d24fe064d9aef15e4c0" tweakAddPubKeyTest :: Assertion@@ -203,12 +241,12 @@ assertEqual "tweaked keys match" expected tweaked where tweaked = do- pub <- importPubKey $ fst $ B16.decode $ B8.pack+ pub <- importPubKey $ hexToBytes "04dded4203dac96a7e85f2c374a37ce3e9c9a155a72b64b4551b0bfe779dd4470512213d5ed790522c042dee8e85c4c0ec5f96800b72bc5940c8bc1c5e11e4fcbf"- twk <- tweak $ fst $ B16.decode $ B8.pack+ twk <- tweak $ hexToBytes "f5cbe7d88182a4b8e400f96b06128921864a18187d114c8ae8541b566c8ace00" tweakAddPubKey pub twk- expected = importPubKey $ fst $ B16.decode $ B8.pack+ expected = importPubKey $ hexToBytes "04441c3982b97576646e0df0c96736063df6b42f2ee566d13b9f6424302d1379e518fdc87a14c5435bff7a5db4552042cb4120c6b86a4bbd3d0643f3c14ad01368" tweakMulPubKeyTest :: Assertion@@ -216,12 +254,12 @@ assertEqual "tweaked keys match" expected tweaked where tweaked = do- pub <- importPubKey $ fst $ B16.decode $ B8.pack+ pub <- importPubKey $ hexToBytes "04dded4203dac96a7e85f2c374a37ce3e9c9a155a72b64b4551b0bfe779dd4470512213d5ed790522c042dee8e85c4c0ec5f96800b72bc5940c8bc1c5e11e4fcbf"- twk <- tweak $ fst $ B16.decode $ B8.pack+ twk <- tweak $ hexToBytes "f5cbe7d88182a4b8e400f96b06128921864a18187d114c8ae8541b566c8ace00" tweakMulPubKey pub twk- expected = importPubKey $ fst $ B16.decode $ B8.pack+ expected = importPubKey $ hexToBytes "04f379dc99cdf5c83e433defa267fbb3377d61d6b779c06a0e4ce29ae3ff5353b12ae49c9d07e7368f2ba5a446c203255ce912322991a2d6a9d5d5761c61ed1845" combinePubKeyTest :: Assertion@@ -229,27 +267,105 @@ assertEqual "combined keys match" expected combined where combined = do- pub1 <- importPubKey $ fst $ B16.decode $ B8.pack+ pub1 <- importPubKey $ hexToBytes "04dded4203dac96a7e85f2c374a37ce3e9c9a155a72b64b4551b0bfe779dd4470512213d5ed790522c042dee8e85c4c0ec5f96800b72bc5940c8bc1c5e11e4fcbf"- pub2 <- importPubKey $ fst $ B16.decode $ B8.pack+ pub2 <- importPubKey $ hexToBytes "0487d82042d93447008dfe2af762068a1e53ff394a5bf8f68a045fa642b99ea5d153f577dd2dba6c7ae4cfd7b6622409d7edd2d76dd13a8092cd3af97b77bd2c77"- pub3 <- importPubKey $ fst $ B16.decode $ B8.pack+ pub3 <- importPubKey $ hexToBytes "049b101edcbe1ee37ff6b2318526a425b629e823d7d8d9154417880595a28000ee3febd908754b8ce4e491aa6fe488b41fb5d4bb3788e33c9ff95a7a9229166d59" combinePubKeys [pub1, pub2, pub3]- expected = importPubKey $ fst $ B16.decode $ B8.pack+ expected = importPubKey $ hexToBytes "043d9a7ec70011efc23c33a7e62d2ea73cca87797e3b659d93bea6aa871aebde56c3bc6134ca82e324b0ab9c0e601a6d2933afe7fb5d9f3aae900f5c5dc6e362c8" +negateTweakTest :: Assertion+negateTweakTest =+ assertEqual "can recover secret key 1 after adding tweak 1" oneKey subtracted+ where+ Just oneKey = secKey $ fst $ B16.decode $ B8.pack+ "0000000000000000000000000000000000000000000000000000000000000001"+ Just oneTwk = tweak $ fst $ B16.decode $ B8.pack+ "0000000000000000000000000000000000000000000000000000000000000001"+ Just minusOneTwk = tweakNegate oneTwk+ Just twoKey = tweakAddSecKey oneKey oneTwk+ Just subtracted = tweakAddSecKey twoKey minusOneTwk+ #ifdef ECDH computeDhSecret :: Assertion computeDhSecret = assertEqual "ecdh computes known secret" expected computed where computed = do- pub <- importPubKey $ fst $ B16.decode $ B8.pack+ pub <- importPubKey $ hexToBytes "028d7500dd4c12685d1f568b4c2b5048e8534b873319f3a8daa612b469132ec7f7"- sec <- secKey $ fst $ B16.decode $ B8.pack+ sec <- secKey $ hexToBytes "1212121212121212121212121212121212121212121212121212121212121212" pure $ ecdh pub sec- expected = Just $ fst $ B16.decode $ B8.pack+ expected = Just $ hexToBytes "1e2fb3c8fe8fb9f262f649f64d26ecf0f2c0a805a767cf02dc2d77a6ef1fdcc3"+#endif++#ifdef SCHNORR+data VectorError = InvalidPubKey | InvalidSig | InvalidMsg | InvalidSigFormat+ deriving (Eq, Show)++failingVectorToAssertion :: VectorError -> (BS.ByteString, BS.ByteString, BS.ByteString) -> Assertion+failingVectorToAssertion expectedFailure (pubBytes, msgBytes, sigBytes) =+ assertEqual ("expected error " <> show expectedFailure <> " occurs") (Left expectedFailure) computed+ where+ computed :: Either VectorError ()+ computed =+ let+ pubM = importXOnlyPubKey pubBytes+ sigM = importSchnorrSig sigBytes+ msgM = msg $ msgBytes+ in+ case (pubM, sigM, msgM) of+ (Nothing, _, _) -> Left InvalidPubKey+ (_, Nothing, _) -> Left InvalidSigFormat+ (_, _, Nothing) -> Left InvalidMsg+ (Just pub, Just sig, Just msg) ->+ if verifyMsgSchnorr pub sig msg+ then Right ()+ else Left InvalidSig++bip340Vector0 :: Assertion+bip340Vector0 =+ passingVectorToAssertion 0+ (+ BS.replicate 31 0 <> B8.pack ['\x01']+ , BS.replicate 32 0+ , hexToBytes "db46b5cdc554edbd7765611b75d7bdbc639cf538fb6e9ef04a61884b765343aae148954f27eb69291a9045862f8ae4fa53436c117e9397c70275d5398066d44b"+ )++-- Integer is BIP-340 vector test number+passingVectorToAssertion :: Integer -> (BS.ByteString, BS.ByteString, BS.ByteString) -> Assertion+passingVectorToAssertion idx (secBytes, msgBytes, sigBytes) =+ assertEqual ("BIP-340 test vector " <> show idx <> " signature matches") expectedSig computedSig+ where+ expectedSig :: Maybe SchnorrSig+ expectedSig = importSchnorrSig $ sigBytes+ computedSig :: Maybe SchnorrSig+ computedSig = do+ sec <- secKey secBytes+ msg <- msg $ msgBytes+ pure $ signMsgSchnorr sec msg++-- This test is ported from the C code, it is called 'test_schnorrsig_taproot'.+-- But this version was modified to use fixed keys and messages.+taprootKeySpend :: Assertion+taprootKeySpend =+ assertEqual "derivation succeded and resulting signature is valid" (Just True) computed+ where+ computed = do+ sec <- secKey $ BS.replicate 32 32+ msgToSign <- msg $ BS.replicate 32 00++ let internalPub = deriveXOnlyPubKey sec+ twea <- tweak $ exportXOnlyPubKey internalPub+ (outputPub, isNegated) <- schnorrTweakAddPubKey internalPub twea++ -- This is a 'key spend' in Taproot terminology:+ tweakSec <- schnorrTweakAddSecKey sec twea+ let sig = signMsgSchnorr tweakSec msgToSign+ pure $ verifyMsgSchnorr outputPub sig msgToSign #endif