diff --git a/.github/workflows/build.yaml b/.github/workflows/build.yaml index fe789956..7daf757d 100644 --- a/.github/workflows/build.yaml +++ b/.github/workflows/build.yaml @@ -54,7 +54,7 @@ jobs: name: Checkout bitcoin-core/secp256k1 with: repository: bitcoin-core/secp256k1 - ref: 694ce8fb2d1fd8a3d641d7c33705691d41a2a860 + ref: 751c4354d51fb5b10a80764df627b84e1a5ccd4f path: lib/secp256k1 - uses: haskell/actions/setup@f7b0997283589ea5a6b4f2ade6a239d70a412877 @@ -83,7 +83,7 @@ jobs: working-directory: ./lib/secp256k1 run: | ./autogen.sh - ./configure + ./configure --enable-module-schnorrsig --enable-module-recovery make make check sudo make install @@ -97,7 +97,7 @@ jobs: pacman --noconfirm -S mingw-w64-x86_64-pkg-config pacman --noconfirm -S mingw-w64-x86_64-autotools ./autogen.sh - ./configure --prefix=/mingw64 + ./configure --prefix=/mingw64 --enable-module-schnorrsig --enable-module-recovery make make check make install diff --git a/.gitignore b/.gitignore index fb6f9d11..f81f76f5 100644 --- a/.gitignore +++ b/.gitignore @@ -22,3 +22,4 @@ cabal.project.local~ .ghc.environment.* TAGS tags +.vscode diff --git a/bitcoin.cabal b/bitcoin.cabal index f8acc0f2..5ef9678e 100644 --- a/bitcoin.cabal +++ b/bitcoin.cabal @@ -111,12 +111,12 @@ library , entropy >=0.4.1.5 , hashable >=1.3.0.0 , hspec >=2.7.1 + , libsecp256k1 >=0.1.0 , memory >=0.15.0 , murmur3 >=1.0.3 , network >=3.1.1.1 , safe >=0.3.18 , scientific >=0.3.6.2 - , secp256k1-haskell >=0.4.0 , split >=0.2.3.3 , string-conversions >=0.4.0.1 , text >=1.2.3.0 @@ -165,12 +165,12 @@ test-suite spec , entropy >=0.4.1.5 , hashable >=1.3.0.0 , hspec >=2.7.1 + , libsecp256k1 >=0.1.0 , memory >=0.15.0 , murmur3 >=1.0.3 , network >=3.1.1.1 , safe >=0.3.18 , scientific >=0.3.6.2 - , secp256k1-haskell >=0.4.0 , split >=0.2.3.3 , string-conversions >=0.4.0.1 , text >=1.2.3.0 @@ -202,12 +202,12 @@ benchmark benchmark , entropy >=0.4.1.5 , hashable >=1.3.0.0 , hspec >=2.7.1 + , libsecp256k1 >=0.1.0 , memory >=0.15.0 , murmur3 >=1.0.3 , network >=3.1.1.1 , safe >=0.3.18 , scientific >=0.3.6.2 - , secp256k1-haskell >=0.4.0 , split >=0.2.3.3 , string-conversions >=0.4.0.1 , text >=1.2.3.0 diff --git a/package.yaml b/package.yaml index f69cd2dc..2d214e4a 100644 --- a/package.yaml +++ b/package.yaml @@ -38,7 +38,7 @@ dependencies: - split >= 0.2.3.3 - safe >= 0.3.18 - scientific >= 0.3.6.2 - - secp256k1-haskell >= 0.4.0 + - libsecp256k1 >= 0.1.0 - string-conversions >= 0.4.0.1 - text >= 1.2.3.0 - time >= 1.9.3 diff --git a/src/Bitcoin/Crypto/Signature.hs b/src/Bitcoin/Crypto/Signature.hs index 655978bf..15d435ec 100644 --- a/src/Bitcoin/Crypto/Signature.hs +++ b/src/Bitcoin/Crypto/Signature.hs @@ -14,55 +14,44 @@ module Bitcoin.Crypto.Signature ( verifyHashSig, isCanonicalHalfOrder, decodeStrictSig, - exportSig, ) where -import Bitcoin.Crypto.Hash (Hash256) +import Bitcoin.Crypto.Hash (Hash256 (getHash256)) import qualified Bitcoin.Util as U import Control.Monad (guard, unless, when) import Crypto.Secp256k1 ( - CompactSig (getCompactSig), - Msg, - PubKey, + PubKeyXY, SecKey, - Sig, - exportCompactSig, - exportSig, - importSig, - msg, - normalizeSig, - signMsg, - verifySig, + Signature, + ecdsaSign, + ecdsaVerify, + exportSignatureCompact, + exportSignatureDer, + importSignatureDer, + normalizeSignature, ) import Data.Binary.Get (Get, getByteString, getWord8, lookAhead) import Data.Binary.Put (Put, putByteString) import Data.ByteString (ByteString) import qualified Data.ByteString as BS -import Data.Maybe (fromMaybe, isNothing) +import Data.ByteString.Short (fromShort) import Numeric (showHex) --- | Convert 256-bit hash into a 'Msg' for signing or verification. -hashToMsg :: Hash256 -> Msg -hashToMsg = fromMaybe e . msg . U.encodeS - where - e = error "Could not convert 32-byte hash to secp256k1 message" - - -- | Sign a 256-bit hash using secp256k1 elliptic curve. -signHash :: SecKey -> Hash256 -> Sig -signHash k = signMsg k . hashToMsg +signHash :: SecKey -> Hash256 -> Maybe Signature +signHash k = ecdsaSign k . fromShort . getHash256 -- | Verify an ECDSA signature for a 256-bit hash. -verifyHashSig :: Hash256 -> Sig -> PubKey -> Bool -verifyHashSig h s p = verifySig p norm (hashToMsg h) +verifyHashSig :: Hash256 -> Signature -> PubKeyXY -> Bool +verifyHashSig h s p = ecdsaVerify (fromShort $ getHash256 h) p norm where - norm = fromMaybe s (normalizeSig s) + norm = snd $ normalizeSignature s -- | Deserialize an ECDSA signature as commonly encoded in Bitcoin. -getSig :: Get Sig +getSig :: Get Signature getSig = do l <- lookAhead $ do @@ -82,24 +71,24 @@ getSig = do -- | Serialize an ECDSA signature for Bitcoin use. -putSig :: Sig -> Put -putSig s = putByteString $ exportSig s +putSig :: Signature -> Put +putSig s = putByteString $ exportSignatureDer s -- | Is canonical half order. -isCanonicalHalfOrder :: Sig -> Bool -isCanonicalHalfOrder = isNothing . normalizeSig +isCanonicalHalfOrder :: Signature -> Bool +isCanonicalHalfOrder = not . fst . normalizeSignature -- | Decode signature strictly. -decodeStrictSig :: ByteString -> Maybe Sig +decodeStrictSig :: ByteString -> Maybe Signature decodeStrictSig bs = do - g <- importSig bs + g <- importSignatureDer bs -- -- 4.1.4.1 (r and s can not be zero) - let compact = exportCompactSig g + let compact = exportSignatureCompact g let zero = BS.replicate 32 0 - guard $ BS.take 32 (getCompactSig compact) /= zero - guard $ BS.take 32 (BS.drop 32 (getCompactSig compact)) /= zero + guard $ BS.take 32 compact /= zero + guard $ BS.take 32 (BS.drop 32 compact) /= zero guard $ isCanonicalHalfOrder g return g diff --git a/src/Bitcoin/Keys/Common.hs b/src/Bitcoin/Keys/Common.hs index b256d5c8..8fe45031 100644 --- a/src/Bitcoin/Keys/Common.hs +++ b/src/Bitcoin/Keys/Common.hs @@ -15,16 +15,16 @@ module Bitcoin.Keys.Common ( -- * Public & Private Keys PubKeyI (..), SecKeyI (..), - exportPubKey, - importPubKey, + exportPubKeyXY, + importPubKeyXY, wrapPubKey, derivePubKeyI, wrapSecKey, fromMiniKey, tweakPubKey, tweakSecKey, - getSecKey, - secKey, + exportSecKey, + importSecKey, -- ** Private Key Wallet Import Format (WIF) fromWif, @@ -45,15 +45,16 @@ import Control.Monad (guard, mzero, (<=<)) import Crypto.Hash (hashWith) import Crypto.Hash.Algorithms (SHA256 (SHA256)) import Crypto.Secp256k1 ( - PubKey, + PubKeyXY, SecKey (..), derivePubKey, - exportPubKey, - importPubKey, - secKey, - tweak, - tweakAddPubKey, - tweakAddSecKey, + exportPubKeyXY, + exportSecKey, + importPubKeyXY, + importSecKey, + importTweak, + pubKeyTweakAdd, + secKeyTweakAdd, ) import Data.Binary (Binary (..)) import Data.Binary.Get (getByteString, getWord8, lookAhead) @@ -71,7 +72,7 @@ import GHC.Generics (Generic) -- | Elliptic curve public key type with expected serialized compression flag. data PubKeyI = PubKeyI - { pubKeyPoint :: !PubKey + { pubKeyPoint :: !PubKeyXY , pubKeyCompressed :: !Bool } deriving (Generic, Eq, Show, Read, Hashable, NFData) @@ -100,18 +101,18 @@ instance Binary PubKeyI where c = do bs <- getByteString 33 maybe (fail "Could not decode public key") return $ - PubKeyI <$> importPubKey bs <*> pure True + PubKeyI <$> importPubKeyXY bs <*> pure True u = do bs <- getByteString 65 maybe (fail "Could not decode public key") return $ - PubKeyI <$> importPubKey bs <*> pure False + PubKeyI <$> importPubKeyXY bs <*> pure False - put pk = putByteString $ (exportPubKey <$> pubKeyCompressed <*> pubKeyPoint) pk + put pk = putByteString $ (exportPubKeyXY <$> pubKeyCompressed <*> pubKeyPoint) pk -- | Wrap a public key from secp256k1 library adding information about compression. -wrapPubKey :: Bool -> PubKey -> PubKeyI +wrapPubKey :: Bool -> PubKeyXY -> PubKeyI wrapPubKey c p = PubKeyI p c @@ -122,8 +123,8 @@ derivePubKeyI (SecKeyI d c) = PubKeyI (derivePubKey d) c -- | Tweak a public key. -tweakPubKey :: PubKey -> Hash256 -> Maybe PubKey -tweakPubKey p = tweakAddPubKey p <=< tweak . U.encodeS +tweakPubKey :: PubKeyXY -> Hash256 -> Maybe PubKeyXY +tweakPubKey p = pubKeyTweakAdd p <=< importTweak . U.encodeS -- | Elliptic curve private key type with expected public key compression @@ -144,14 +145,14 @@ wrapSecKey c d = SecKeyI d c -- | Tweak a private key. tweakSecKey :: SecKey -> Hash256 -> Maybe SecKey -tweakSecKey key = tweakAddSecKey key <=< tweak . U.encodeS +tweakSecKey key = secKeyTweakAdd key <=< importTweak . U.encodeS -- | Decode Casascius mini private keys (22 or 30 characters). fromMiniKey :: ByteString -> Maybe SecKeyI fromMiniKey bs = do guard checkShortKey - wrapSecKey False <$> (secKey . BA.convert . hashWith SHA256) bs + wrapSecKey False <$> (importSecKey . BA.convert . hashWith SHA256) bs where checkHash = BA.convert . hashWith SHA256 $ bs `BS.append` "?" checkShortKey = BS.length bs `elem` [22, 30] && BS.head checkHash == 0x00 @@ -165,11 +166,11 @@ fromWif net wif = do guard (BSL.head bs == getSecretPrefix net) case BSL.length bs of -- Uncompressed format - 33 -> wrapSecKey False <$> (secKey . BSL.toStrict) (BSL.tail bs) + 33 -> wrapSecKey False <$> (importSecKey . BSL.toStrict) (BSL.tail bs) -- Compressed format 34 -> do guard $ BSL.last bs == 0x01 - wrapSecKey True <$> (secKey . BS.tail . BS.init . BSL.toStrict) bs + wrapSecKey True <$> (importSecKey . BS.tail . BS.init . BSL.toStrict) bs -- Bad length _ -> Nothing @@ -179,5 +180,5 @@ toWif :: Network -> SecKeyI -> Base58 toWif net (SecKeyI k c) = encodeBase58Check . BSL.cons (getSecretPrefix net) . BSL.fromStrict $ if c - then getSecKey k `BS.snoc` 0x01 - else getSecKey k + then exportSecKey k `BS.snoc` 0x01 + else exportSecKey k diff --git a/src/Bitcoin/Keys/Extended.hs b/src/Bitcoin/Keys/Extended.hs index c0c2cf11..abc2450a 100644 --- a/src/Bitcoin/Keys/Extended.hs +++ b/src/Bitcoin/Keys/Extended.hs @@ -141,12 +141,12 @@ import Control.Exception (Exception, throw) import Control.Monad (guard, mzero, unless, (<=<)) import Crypto.Hash (SHA256 (SHA256), hashWith) import Crypto.Secp256k1 ( - PubKey, + PubKeyXY, SecKey, derivePubKey, - exportPubKey, - getSecKey, - secKey, + exportPubKeyXY, + exportSecKey, + importSecKey, ) import Data.Binary (Binary, Get, Put, get, put) import qualified Data.Binary as Bin @@ -233,7 +233,7 @@ data XPubKey = XPubKey -- ^ derivation index , xPubChain :: !ChainCode -- ^ chain code - , xPubKey :: !PubKey + , xPubKey :: !PubKeyXY -- ^ public key of this node } deriving (Generic, Eq, Show, Read, NFData, Hashable) @@ -262,7 +262,7 @@ makeXPrvKey bs = XPrvKey 0 (Fingerprint 0) 0 c k where (p, c) = split512 $ hmac512 "Bitcoin seed" bs - k = fromMaybe err . secKey . BSS.fromShort $ getHash256 p + k = fromMaybe err . importSecKey . BSS.fromShort $ getHash256 p err = throw $ DerivationException "Invalid seed" @@ -295,7 +295,7 @@ prvSubKey xkey child | otherwise = error "Invalid child derivation index" where pK = xPubKey $ deriveXPubKey xkey - m = BSL.append (BSL.fromStrict $ exportPubKey True pK) $ Bin.encode child + m = BSL.append (BSL.fromStrict $ exportPubKeyXY True pK) $ Bin.encode child (a, c) = split512 $ (hmac512L . U.encodeS) (xPrvChain xkey) m k = fromMaybe err $ tweakSecKey (xPrvKey xkey) a err = throw $ DerivationException "Invalid prvSubKey derivation" @@ -315,7 +315,7 @@ pubSubKey xKey child XPubKey (xPubDepth xKey + 1) (xPubFP xKey) child c pK | otherwise = error "Invalid child derivation index" where - m = BSL.append (BSL.fromStrict . exportPubKey True $ xPubKey xKey) $ Bin.encode child + m = BSL.append (BSL.fromStrict . exportPubKeyXY True $ xPubKey xKey) $ Bin.encode child (a, c) = split512 $ (hmac512L . U.encodeS) (xPubChain xKey) m pK = fromMaybe err $ tweakPubKey (xPubKey xKey) a err = throw $ DerivationException "Invalid pubSubKey derivation" @@ -377,7 +377,7 @@ xPrvID = xPubID . deriveXPubKey -- | Computes the key identifier of an extended public key. xPubID :: XPubKey -> Hash160 -xPubID = ripemd160 . hashWith SHA256 . exportPubKey True . xPubKey +xPubID = ripemd160 . hashWith SHA256 . exportPubKeyXY True . xPubKey -- | Computes the key fingerprint of an extended private key. @@ -497,7 +497,7 @@ hardSubKeys k = map (\i -> (hardSubKey k i, i)) . cycleIndex -- | Derive a standard address from an extended public key and an index. -deriveAddr :: XPubKey -> KeyIndex -> (Address, PubKey) +deriveAddr :: XPubKey -> KeyIndex -> (Address, PubKeyXY) deriveAddr k i = (xPubAddr key, xPubKey key) where @@ -505,7 +505,7 @@ deriveAddr k i = -- | Derive a SegWit P2WPKH address from an extended public key and an index. -deriveWitnessAddr :: XPubKey -> KeyIndex -> (Address, PubKey) +deriveWitnessAddr :: XPubKey -> KeyIndex -> (Address, PubKeyXY) deriveWitnessAddr k i = (xPubWitnessAddr key, xPubKey key) where @@ -514,7 +514,7 @@ deriveWitnessAddr k i = -- | Derive a backwards-compatible SegWit P2SH-P2WPKH address from an extended -- public key and an index. -deriveCompatWitnessAddr :: XPubKey -> KeyIndex -> (Address, PubKey) +deriveCompatWitnessAddr :: XPubKey -> KeyIndex -> (Address, PubKeyXY) deriveCompatWitnessAddr k i = (xPubCompatWitnessAddr key, xPubKey key) where @@ -523,7 +523,7 @@ deriveCompatWitnessAddr k i = -- | Cyclic list of all addresses derived from a public key starting from an -- offset index. -deriveAddrs :: XPubKey -> KeyIndex -> [(Address, PubKey, KeyIndex)] +deriveAddrs :: XPubKey -> KeyIndex -> [(Address, PubKeyXY, KeyIndex)] deriveAddrs k = map f . cycleIndex where @@ -532,7 +532,7 @@ deriveAddrs k = -- | Cyclic list of all SegWit P2WPKH addresses derived from a public key -- starting from an offset index. -deriveWitnessAddrs :: XPubKey -> KeyIndex -> [(Address, PubKey, KeyIndex)] +deriveWitnessAddrs :: XPubKey -> KeyIndex -> [(Address, PubKeyXY, KeyIndex)] deriveWitnessAddrs k = map f . cycleIndex where @@ -541,7 +541,7 @@ deriveWitnessAddrs k = -- | Cyclic list of all backwards-compatible SegWit P2SH-P2WPKH addresses -- derived from a public key starting from an offset index. -deriveCompatWitnessAddrs :: XPubKey -> KeyIndex -> [(Address, PubKey, KeyIndex)] +deriveCompatWitnessAddrs :: XPubKey -> KeyIndex -> [(Address, PubKeyXY, KeyIndex)] deriveCompatWitnessAddrs k = map f . cycleIndex where @@ -1016,14 +1016,14 @@ applyPath path key = {- Helpers for derivation paths and addresses -} -- | Derive an address from a given parent path. -derivePathAddr :: XPubKey -> SoftPath -> KeyIndex -> (Address, PubKey) +derivePathAddr :: XPubKey -> SoftPath -> KeyIndex -> (Address, PubKeyXY) derivePathAddr key path = deriveAddr (derivePubPath path key) -- | Cyclic list of all addresses derived from a given parent path and starting -- from the given offset index. derivePathAddrs :: - XPubKey -> SoftPath -> KeyIndex -> [(Address, PubKey, KeyIndex)] + XPubKey -> SoftPath -> KeyIndex -> [(Address, PubKeyXY, KeyIndex)] derivePathAddrs key path = deriveAddrs (derivePubPath path key) @@ -1060,12 +1060,12 @@ getPadPrvKey = do pad <- Get.getWord8 unless (pad == 0x00) $ fail "Private key must be padded with 0x00" Get.getByteString 32 - >>= maybe (error "getPadPrvKey: unreachable") pure . secKey + >>= maybe (error "getPadPrvKey: unreachable") pure . importSecKey -- | Serialize HDW-specific private key. putPadPrvKey :: SecKey -> Put -putPadPrvKey p = Put.putWord8 0x00 >> Put.putByteString (getSecKey p) +putPadPrvKey p = Put.putWord8 0x00 >> Put.putByteString (exportSecKey p) bsPadPrvKey :: SecKey -> BSL.ByteString diff --git a/src/Bitcoin/Script/SigHash.hs b/src/Bitcoin/Script/SigHash.hs index c6163a37..166ab33c 100644 --- a/src/Bitcoin/Script/SigHash.hs +++ b/src/Bitcoin/Script/SigHash.hs @@ -30,7 +30,7 @@ module Bitcoin.Script.SigHash ( import Bitcoin.Crypto ( Hash256, - Sig, + Signature, decodeStrictSig, putSig, ) @@ -293,7 +293,7 @@ txSigHashSegwitV0 _ tx out v i sh = -- transaction inputs are of type 'TxSignature'. data TxSignature = TxSignature - { txSignature :: !Sig + { txSignature :: !Signature , txSignatureSigHash :: !SigHash } | TxSignatureEmpty diff --git a/src/Bitcoin/Transaction/Builder.hs b/src/Bitcoin/Transaction/Builder.hs index 59198f02..96d6b0f1 100644 --- a/src/Bitcoin/Transaction/Builder.hs +++ b/src/Bitcoin/Transaction/Builder.hs @@ -83,7 +83,7 @@ import qualified Bitcoin.Util as U import Control.Applicative ((<|>)) import Control.Arrow (first) import Control.Monad (foldM, unless) -import Crypto.Secp256k1 (PubKey, SecKey) +import Crypto.Secp256k1 (PubKeyXY, SecKey) import qualified Data.Binary as Bin import qualified Data.ByteString as BS import qualified Data.ByteString.Lazy as BSL @@ -342,7 +342,7 @@ countMulSig :: Script -> Word64 -> Int -> - [PubKey] -> + [PubKeyXY] -> [TxSignature] -> Int countMulSig net tx out val i = @@ -351,7 +351,7 @@ countMulSig net tx out val i = h = txSigHash net tx out val i -countMulSig' :: (SigHash -> Hash256) -> [PubKey] -> [TxSignature] -> Int +countMulSig' :: (SigHash -> Hash256) -> [PubKeyXY] -> [TxSignature] -> Int countMulSig' _ [] _ = 0 countMulSig' _ _ [] = 0 countMulSig' h (_ : pubs) (TxSignatureEmpty : sigs) = countMulSig' h pubs sigs diff --git a/src/Bitcoin/Transaction/Builder/Sign.hs b/src/Bitcoin/Transaction/Builder/Sign.hs index 31485209..3d647a24 100644 --- a/src/Bitcoin/Transaction/Builder/Sign.hs +++ b/src/Bitcoin/Transaction/Builder/Sign.hs @@ -131,7 +131,7 @@ signInput :: SecKeyI -> Either String Tx signInput net tx i (sigIn@(SigInput so val _ _ rdmM), nest) key = do - let sig = makeSignature net tx i sigIn key + sig <- maybe (Left "cannot sign input") return $ makeSignature net tx i sigIn key si <- buildInput net tx i so val rdmM sig $ derivePubKeyI key w <- updatedWitnessData tx i so si return @@ -269,9 +269,9 @@ parseExistingSigs net tx so i = insSigs <> witSigs -- | Produce a structured representation of a deterministic (RFC-6979) signature over an input. -makeSignature :: Network -> Tx -> Int -> SigInput -> SecKeyI -> TxSignature +makeSignature :: Network -> Tx -> Int -> SigInput -> SecKeyI -> Maybe TxSignature makeSignature net tx i (SigInput so val _ sh rdmM) key = - TxSignature (signHash (secKeyData key) m) sh + TxSignature <$> signHash (secKeyData key) m <*> pure sh where m = makeSigHash net tx i so val sh rdmM diff --git a/src/Bitcoin/Transaction/Partial.hs b/src/Bitcoin/Transaction/Partial.hs index 31aaeec9..2f915da2 100644 --- a/src/Bitcoin/Transaction/Partial.hs +++ b/src/Bitcoin/Transaction/Partial.hs @@ -358,10 +358,14 @@ onPrevTxOut net signer tx ix input prevTxData = { partialSigs = newSigs <> partialSigs input } where - newSigs = HM.mapWithKey sigForInput sigKeys + newSigs = HM.foldMapWithKey sigForInput sigKeys sigForInput thePubKey theSecKey = - encodeTxSig . makeSignature net tx ix theSigInput $ - SecKeyI theSecKey (pubKeyCompressed thePubKey) + maybe + mempty + (HM.singleton thePubKey . encodeTxSig) + ( makeSignature net tx ix theSigInput $ + SecKeyI theSecKey (pubKeyCompressed thePubKey) + ) theSigInput = SigInput diff --git a/src/Bitcoin/Transaction/Taproot.hs b/src/Bitcoin/Transaction/Taproot.hs index 4cc0339f..eb343f50 100644 --- a/src/Bitcoin/Transaction/Taproot.hs +++ b/src/Bitcoin/Transaction/Taproot.hs @@ -25,7 +25,7 @@ module Bitcoin.Transaction.Taproot ( verifyScriptPathData, ) where -import Bitcoin.Crypto (PubKey, initTaggedHash, tweak, tweakAddPubKey) +import Bitcoin.Crypto (PubKeyXY, importTweak, initTaggedHash, pubKeyTweakAdd) import Bitcoin.Keys.Common (PubKeyI (PubKeyI), pubKeyPoint) import Bitcoin.Network.Common (VarInt (VarInt)) import Bitcoin.Script.Common (Script) @@ -61,7 +61,7 @@ import Data.Word (Word8) -- | 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. -newtype XOnlyPubKey = XOnlyPubKey {xOnlyPubKey :: PubKey} +newtype XOnlyPubKey = XOnlyPubKey {xOnlyPubKey :: PubKeyXY} deriving (Show) @@ -145,21 +145,21 @@ leafHash leafVersion leafScript = -- | Representation of a full taproot output. data TaprootOutput = TaprootOutput - { taprootInternalKey :: PubKey + { taprootInternalKey :: PubKeyXY , taprootMAST :: Maybe MAST } deriving (Show) -taprootOutputKey :: TaprootOutput -> PubKey +taprootOutputKey :: TaprootOutput -> PubKeyXY taprootOutputKey TaprootOutput{taprootInternalKey, taprootMAST} = - fromMaybe keyFail $ tweak commitment >>= tweakAddPubKey taprootInternalKey + fromMaybe keyFail $ importTweak commitment >>= pubKeyTweakAdd taprootInternalKey where commitment = taprootCommitment taprootInternalKey $ mastCommitment <$> taprootMAST keyFail = error "bitcoin taprootOutputKey: key derivation failed" -taprootCommitment :: PubKey -> Maybe (Digest SHA256) -> ByteString +taprootCommitment :: PubKeyXY -> Maybe (Digest SHA256) -> ByteString taprootCommitment internalKey merkleRoot = BA.convert . hashFinalize @@ -190,7 +190,7 @@ data ScriptPathData = ScriptPathData , scriptPathExternalIsOdd :: Bool , scriptPathLeafVersion :: Word8 -- ^ This value is masked by 0xFE - , scriptPathInternalKey :: PubKey + , scriptPathInternalKey :: PubKeyXY , scriptPathControl :: [ByteString] } deriving (Eq, Show) @@ -249,11 +249,11 @@ encodeTaprootWitness = \case -- | Verify that the script path spend is valid, except for script execution. verifyScriptPathData :: -- | Output key - PubKey -> + PubKeyXY -> ScriptPathData -> Bool verifyScriptPathData outputKey scriptPathData = fromMaybe False $ do - tweak commitment >>= fmap onComputedKey . tweakAddPubKey (scriptPathInternalKey scriptPathData) + importTweak commitment >>= fmap onComputedKey . pubKeyTweakAdd (scriptPathInternalKey scriptPathData) where onComputedKey computedKey = XOnlyPubKey outputKey == XOnlyPubKey computedKey @@ -267,7 +267,7 @@ verifyScriptPathData outputKey scriptPathData = fromMaybe False $ do expectedParity = bool 0 1 $ scriptPathExternalIsOdd scriptPathData -keyParity :: PubKey -> Word8 +keyParity :: PubKeyXY -> Word8 keyParity key = case BSL.unpack . Bin.encode $ PubKeyI key True of 0x02 : _ -> 0x00 _ -> 0x01 diff --git a/src/Bitcoin/Util/Arbitrary/Keys.hs b/src/Bitcoin/Util/Arbitrary/Keys.hs index d1aa8848..d40c48e0 100644 --- a/src/Bitcoin/Util/Arbitrary/Keys.hs +++ b/src/Bitcoin/Util/Arbitrary/Keys.hs @@ -8,9 +8,12 @@ import Bitcoin.Keys.Common import Bitcoin.Keys.Extended import Bitcoin.Keys.Extended.Internal (Fingerprint (..)) import Bitcoin.Util.Arbitrary.Crypto +import Control.Monad (replicateM) import Data.Bits (clearBit) +import qualified Data.ByteString as BS import Data.Coerce (coerce) import Data.List (foldl') +import Data.Maybe (fromJust, isJust) import Data.Word (Word32) import Test.QuickCheck @@ -92,9 +95,17 @@ arbitraryParsedPath = -- | Arbitrary message hash, private key, nonce and corresponding signature. The -- signature is generated with a random message, random private key and a random -- nonce. -arbitrarySignature :: Gen (Hash256, SecKey, Sig) +arbitrarySignature :: Gen (Hash256, SecKey, Signature) arbitrarySignature = do m <- arbitraryHash256 key <- arbitrary - let sig = signHash key m + let Just sig = signHash key m return (m, key, sig) + + +instance Arbitrary SecKey where + arbitrary = gen_key + where + valid_bs = bs_gen `suchThat` isJust + bs_gen = importSecKey . BS.pack <$> replicateM 32 arbitraryBoundedRandom + gen_key = fromJust <$> valid_bs diff --git a/stack.yaml b/stack.yaml index 5a6a9190..c2174168 100644 --- a/stack.yaml +++ b/stack.yaml @@ -7,3 +7,5 @@ nix: extra-deps: - fourmolu-0.8.2.0 - cryptonite-0.30 + - github: tochicool/libsecp256k1-haskell + commit: 3a23ec0d8616bd3cc45e3b5764f604c4bed2e144 diff --git a/stack.yaml.lock b/stack.yaml.lock index c24f3d9f..b5c35096 100644 --- a/stack.yaml.lock +++ b/stack.yaml.lock @@ -18,6 +18,17 @@ packages: size: 23323 original: hackage: cryptonite-0.30 +- completed: + name: libsecp256k1 + pantry-tree: + sha256: e81e2a02eb41c57005a7bfeacbd54b29f8395667ddb912c2c9fae377f4791efa + size: 1259 + sha256: 853107597d46f48b7ebb010bae145147db624ddd149f96fdcb23a0aafc59f47e + size: 30221 + url: https://github.com/tochicool/libsecp256k1-haskell/archive/3a23ec0d8616bd3cc45e3b5764f604c4bed2e144.tar.gz + version: 0.1.0 + original: + url: https://github.com/tochicool/libsecp256k1-haskell/archive/3a23ec0d8616bd3cc45e3b5764f604c4bed2e144.tar.gz snapshots: - completed: sha256: 1ecad1f0bd2c27de88dbff6572446cfdf647c615d58a7e2e2085c6b7dfc04176 diff --git a/test/Bitcoin/Crypto/SignatureSpec.hs b/test/Bitcoin/Crypto/SignatureSpec.hs index 53ff9b61..6c9e89dd 100644 --- a/test/Bitcoin/Crypto/SignatureSpec.hs +++ b/test/Bitcoin/Crypto/SignatureSpec.hs @@ -2,7 +2,6 @@ module Bitcoin.Crypto.SignatureSpec (spec) where -import Bitcoin (getCompactSig) import Bitcoin.Address ( Address (WitnessPubKeyAddress), pubKeyWitnessAddr, @@ -10,19 +9,19 @@ import Bitcoin.Address ( import Bitcoin.Constants (btc) import Bitcoin.Crypto ( SecKey, - Sig, + Signature, decodeStrictSig, derivePubKey, - exportCompactSig, - exportSig, + ecdsaSign, + exportSignatureCompact, + exportSignatureDer, getSig, - importSig, + importSecKey, + importSignature, isCanonicalHalfOrder, putSig, - secKey, sha256, signHash, - signMsg, verifyHashSig, ) import Bitcoin.Keys (PubKeyI, derivePubKeyI, wrapSecKey) @@ -79,12 +78,12 @@ spec = do prop "encoded signature is canonical" $ forAll arbitrarySignature $ testIsCanonical . lst3 - prop "decodeStrictSig . exportSig identity" $ + prop "decodeStrictSig . exportSignatureDer identity" $ forAll arbitrarySignature $ - (\s -> decodeStrictSig (exportSig s) == Just s) . lst3 - prop "importSig . exportSig identity" $ + (\s -> decodeStrictSig (exportSignatureDer s) == Just s) . lst3 + prop "importSignature . exportSignatureDer identity" $ forAll arbitrarySignature $ - (\s -> importSig (exportSig s) == Just s) . lst3 + (\s -> importSignature (exportSignatureDer s) == Just s) . lst3 prop "getSig . putSig identity" $ forAll arbitrarySignature $ \(_, _, s) -> (U.runGet getSig . runPut . putSig) s == Right s @@ -105,7 +104,7 @@ spec = do -- github.com/bitcoin/bitcoin/blob/master/src/script.cpp -- from function IsCanonicalSignature -testIsCanonical :: Sig -> Bool +testIsCanonical :: Signature -> Bool testIsCanonical sig = not $ -- Non-canonical signature: too short @@ -156,7 +155,7 @@ testIsCanonical sig = && not (testBit (BS.index s (fromIntegral rlen + 7)) 7) ) where - s = exportSig sig + s = exportSignatureDer sig len = fromIntegral $ BS.length s rlen = BS.index s 3 slen = BS.index s (fromIntegral rlen + 5) @@ -165,7 +164,7 @@ testIsCanonical sig = -- RFC6979 note: Different libraries of libsecp256k1 use different constants -- to produce a nonce. Thus, their deterministric signatures will be different. -- We still want to test against fixed signatures so we need a way to switch --- between implementations. We check the output of signMsg 1 0 +-- between implementations. We check the output of ecdsaSign 1 0 data ValidImpl = ImplCore @@ -175,10 +174,11 @@ data ValidImpl implSig :: Text implSig = encodeHex $ - exportSig $ - signMsg - "0000000000000000000000000000000000000000000000000000000000000001" - "0000000000000000000000000000000000000000000000000000000000000000" + exportSignatureDer $ + fromJust $ + ecdsaSign + "0000000000000000000000000000000000000000000000000000000000000001" + (BS.replicate 32 0) -- We have test vectors for these cases @@ -223,18 +223,18 @@ checkDistSig go = -- github.com/trezor/python-ecdsa/blob/master/ecdsa/test_pyecdsa.py toVector :: (Text, Text, Text) -> (SecKey, ByteString, Text) -toVector (prv, m, res) = (fromJust $ (secKey <=< decodeHex) prv, cs m, res) +toVector (prv, m, res) = (fromJust $ (importSecKey <=< decodeHex) prv, cs m, res) testRFC6979Vector :: (SecKey, ByteString, Text) -> Assertion testRFC6979Vector (prv, m, res) = do - assertEqual "RFC 6979 Vector" res $ encodeHex . getCompactSig $ exportCompactSig s + assertEqual "RFC 6979 Vector" res $ encodeHex $ exportSignatureCompact s assertBool "Signature is valid" $ verifyHashSig h s (derivePubKey prv) assertBool "Signature is canonical" $ testIsCanonical s assertBool "Signature is normalized" $ isCanonicalHalfOrder s where h = sha256 m - s = signHash prv h + s = fromJust $ signHash prv h -- Test vectors from: @@ -242,13 +242,13 @@ testRFC6979Vector (prv, m, res) = do testRFC6979DERVector :: (SecKey, ByteString, Text) -> Assertion testRFC6979DERVector (prv, m, res) = do - assertEqual "RFC 6979 DER Vector" res (encodeHex $ exportSig s) + assertEqual "RFC 6979 DER Vector" res (encodeHex $ exportSignatureDer s) assertBool "DER Signature is valid" $ verifyHashSig h s (derivePubKey prv) assertBool "DER Signature is canonical" $ testIsCanonical s assertBool "DER Signature is normalized" $ isCanonicalHalfOrder s where h = sha256 m - s = signHash prv h + s = fromJust $ signHash prv h -- Reproduce the P2WPKH example from BIP 143 @@ -497,7 +497,7 @@ testBip143p2shp2wpkhMulsig = secHexKey :: Text -> Maybe SecKey -secHexKey = decodeHex >=> secKey +secHexKey = decodeHex >=> importSecKey toPubKey :: SecKey -> PubKeyI diff --git a/test/Bitcoin/Keys/ExtendedSpec.hs b/test/Bitcoin/Keys/ExtendedSpec.hs index a6b9a420..45ac18fe 100644 --- a/test/Bitcoin/Keys/ExtendedSpec.hs +++ b/test/Bitcoin/Keys/ExtendedSpec.hs @@ -17,8 +17,8 @@ import Bitcoin.Keys ( derivePath, derivePubPath, deriveXPubKey, - exportPubKey, - getSecKey, + exportPubKeyXY, + exportSecKey, getXPrvKey, getXPubKey, hardSubKey, @@ -451,10 +451,10 @@ runVector m v = do assertBool "bip44Addr" $ addrToText btc (xPubAddr $ deriveXPubKey $ derivePath bip44Addr m) == Just (v !! 3) - assertBool "prvKey" $ encodeHex (getSecKey $ xPrvKey m) == v !! 4 + assertBool "prvKey" $ encodeHex (exportSecKey $ xPrvKey m) == v !! 4 assertBool "xPrvWIF" $ xPrvWif btc m == v !! 5 assertBool "pubKey" $ - encodeHex (exportPubKey True $ xPubKey $ deriveXPubKey m) == v !! 6 + encodeHex (exportPubKeyXY True $ xPubKey $ deriveXPubKey m) == v !! 6 assertBool "chain code" $ encodeHex (U.encodeS $ xPrvChain m) == v !! 7 assertBool "Hex PubKey" $ (encodeHex . BSL.toStrict . runPut . putXPubKey btc) (deriveXPubKey m) == v !! 8 diff --git a/test/Bitcoin/KeysSpec.hs b/test/Bitcoin/KeysSpec.hs index 2c69fee9..49f3639d 100644 --- a/test/Bitcoin/KeysSpec.hs +++ b/test/Bitcoin/KeysSpec.hs @@ -3,7 +3,7 @@ module Bitcoin.KeysSpec (spec) where -import Bitcoin (getSecKey, secKey) +import Bitcoin (exportSecKey, importSecKey) import Bitcoin.Address ( addrToText, addressToOutput, @@ -107,7 +107,7 @@ spec = do describe "Bitcoin core vectors /src/test/key_tests.cpp" $ do it "Passes WIF decoding tests" testPrivkey it "Passes SecKey compression tests" testPrvKeyCompressed - it "Passes PubKey compression tests" testKeyCompressed + it "Passes PubKeyXY compression tests" testKeyCompressed it "Passes address matching tests" testMatchingAddress it "Passes signature verification" testSigs it "Passes deterministic signing tests" testDetSigning @@ -147,7 +147,7 @@ testMiniKey :: Assertion testMiniKey = assertEqual "fromMiniKey" (Just res) (go "S6c56bnXQiBjk9mqSYE7ykVQ7NzrRy") where - go = fmap (encodeHex . getSecKey . secKeyData) . fromMiniKey + go = fmap (encodeHex . exportSecKey . secKeyData) . fromMiniKey res = "4c7a9640c72dc2099f23715d0c8a0d8a35f8906e3cab61dd3f78b67bf887c9ab" @@ -161,14 +161,14 @@ testKeyIOValidVector (a, payload, obj) -- Test from WIF to SecKey let Just isComp = A.lookup "isCompressed" obj >>= getBool prvKeyM = fromWif net a - prvKeyHexM = encodeHex . getSecKey . secKeyData <$> prvKeyM + prvKeyHexM = encodeHex . exportSecKey . secKeyData <$> prvKeyM assertBool "Valid PrvKey" $ isJust prvKeyM assertEqual "Valid compression" (Just isComp) (secKeyCompressed <$> prvKeyM) assertEqual "WIF matches payload" (Just payload) prvKeyHexM let prvAsPubM = (eitherToMaybe . decodeOutputBS <=< decodeHex) a assertBool "PrvKey is invalid ScriptOutput" $ isNothing prvAsPubM -- Test from SecKey to WIF - let secM = secKey =<< decodeHex payload + let secM = importSecKey =<< decodeHex payload wifM = toWif net . wrapSecKey isComp <$> secM assertEqual "Payload matches WIF" (Just a) wifM | otherwise = do @@ -178,7 +178,7 @@ testKeyIOValidVector (a, payload, obj) assertBool ("Valid Address " <> cs a) $ isJust addrM assertEqual "Address matches payload" (Just payload) scriptM let pubAsWifM = fromWif net a - pubAsSecM = secKey =<< decodeHex a + pubAsSecM = importSecKey =<< decodeHex a assertBool "Address is invalid Wif" $ isNothing pubAsWifM assertBool "Address is invalid PrvKey" $ isNothing pubAsSecM -- Test Script to Addr @@ -203,7 +203,7 @@ testKeyIOValidVector (a, payload, obj) testKeyIOInvalidVector :: [Text] -> Assertion testKeyIOInvalidVector [a] = do let wifMs = (`fromWif` a) <$> allNets - secKeyM = (secKey <=< decodeHex) a :: Maybe SecKey + secKeyM = (importSecKey <=< decodeHex) a :: Maybe SecKey scriptM = (eitherToMaybe . decodeOutputBS <=< decodeHex) a :: Maybe ScriptOutput assertBool "Payload is invalid WIF" $ all isNothing wifMs assertBool "Payload is invalid SecKey" $ isNothing secKeyM @@ -260,10 +260,10 @@ sigMsg = testSignature :: Hash256 -> Assertion testSignature h = do - let sign1 = signHash (secKeyData sec1) h - sign2 = signHash (secKeyData sec2) h - sign1C = signHash (secKeyData sec1C) h - sign2C = signHash (secKeyData sec2C) h + let sign1 = fromJust $ signHash (secKeyData sec1) h + sign2 = fromJust $ signHash (secKeyData sec2) h + sign1C = fromJust $ signHash (secKeyData sec1C) h + sign2C = fromJust $ signHash (secKeyData sec2C) h assertBool "Key 1, Sign1" $ verifyHashSig h sign1 (pubKeyPoint pub1) assertBool "Key 1, Sign2" $ not $ verifyHashSig h sign2 (pubKeyPoint pub1) assertBool "Key 1, Sign1C" $ verifyHashSig h sign1C (pubKeyPoint pub1) diff --git a/test/Bitcoin/ScriptSpec.hs b/test/Bitcoin/ScriptSpec.hs index 7babb050..e404ceaa 100644 --- a/test/Bitcoin/ScriptSpec.hs +++ b/test/Bitcoin/ScriptSpec.hs @@ -4,7 +4,7 @@ module Bitcoin.ScriptSpec (spec) where import Bitcoin.Address (addrToText, payToScriptAddress) import Bitcoin.Constants (Network (getNetworkName), btc) -import Bitcoin.Keys (derivePubKeyI, secKey, wrapSecKey) +import Bitcoin.Keys (derivePubKeyI, importSecKey, wrapSecKey) import Bitcoin.Orphans () import Bitcoin.Script ( Script (Script), @@ -179,7 +179,7 @@ standardSpec net = do derivePubKeyI $ wrapSecKey True $ fromJust $ - secKey $ + importSecKey $ BS.replicate 32 1 decodeInput net (Script [OP_0, opPushData $ U.encodeS pk]) `shouldBe` Right (RegularInput (SpendPKHash TxSignatureEmpty pk)) diff --git a/test/Bitcoin/Transaction/PartialSpec.hs b/test/Bitcoin/Transaction/PartialSpec.hs index 0c3d2610..4654bbf6 100644 --- a/test/Bitcoin/Transaction/PartialSpec.hs +++ b/test/Bitcoin/Transaction/PartialSpec.hs @@ -5,7 +5,7 @@ module Bitcoin.Transaction.PartialSpec (spec) where import Bitcoin.Address (addressToScript, pubKeyAddr) import Bitcoin.Constants (Network, btc) -import Bitcoin.Crypto (derivePubKey, secKey, signHash) +import Bitcoin.Crypto (derivePubKey, importSecKey, signHash) import Bitcoin.Keys ( DerivPathI (Deriv, (:/), (:|)), PubKeyI (..), @@ -345,7 +345,7 @@ psbtSignerTest = do where signer = secKeySigner theSecKey <> xPrvSigner xprv (Just origin) - Just theSecKey = secKey "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx" + Just theSecKey = importSecKey "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx" thePubKey = PubKeyI{pubKeyPoint = derivePubKey theSecKey, pubKeyCompressed = True} rootXPrv = makeXPrvKey "psbtSignerTest" @@ -454,7 +454,7 @@ unfinalizedPkhPSBT net (prvKey, pubKey) = , scriptOutput = U.encodeS prevOutScript } h = txSigHash net currTx prevOutScript (outValue prevOut) 0 sigHashAll - sig = encodeTxSig $ TxSignature (signHash (secKeyData prvKey) h) sigHashAll + sig = encodeTxSig $ TxSignature (fromJust $ signHash (secKeyData prvKey) h) sigHashAll arbitraryMultiSig :: Gen ([(SecKeyI, PubKeyI)], Int) @@ -482,7 +482,7 @@ unfinalizedMsPSBT net (keys, m) = prevOut = TxOut{outValue = 200000000, scriptOutput = encodeOutputBS (toP2SH prevOutScript)} h = txSigHash net currTx prevOutScript (outValue prevOut) 0 sigHashAll sigs = fromList $ map sig keys - sig (prvKey, pubKey) = (pubKey, encodeTxSig $ TxSignature (signHash (secKeyData prvKey) h) sigHashAll) + sig (prvKey, pubKey) = (pubKey, encodeTxSig $ TxSignature (fromJust $ signHash (secKeyData prvKey) h) sigHashAll) unfinalizedTx :: TxHash -> Tx diff --git a/test/Bitcoin/Transaction/TaprootSpec.hs b/test/Bitcoin/Transaction/TaprootSpec.hs index 5846cf2e..d3ac874f 100644 --- a/test/Bitcoin/Transaction/TaprootSpec.hs +++ b/test/Bitcoin/Transaction/TaprootSpec.hs @@ -6,8 +6,8 @@ module Bitcoin.Transaction.TaprootSpec (spec) where import Bitcoin ( MAST (..), - PubKey, PubKeyI (PubKeyI), + PubKeyXY, ScriptOutput, ScriptPathData (..), TaprootOutput (TaprootOutput), @@ -111,7 +111,7 @@ testControlBlocks testData = do checkVerification = assertBool "Script verifies" . verifyScriptPathData theOutputKey -keyParity :: PubKey -> Word8 +keyParity :: PubKeyXY -> Word8 keyParity key = case BS.unpack . U.encodeS $ PubKeyI key True of 0x02 : _ -> 0x00 _ -> 0x01 @@ -151,7 +151,7 @@ instance FromJSON SpkGiven where data SpkIntermediary = SpkIntermediary { spkiLeafHashes :: Maybe [ByteString] , spkiMerkleRoot :: Maybe ByteString - , spkiTweakedPubKey :: PubKey + , spkiTweakedPubKey :: PubKeyXY }