From c23d0a3ec9e5267841db77886a75d6d046fdefab Mon Sep 17 00:00:00 2001 From: Keagan McClelland Date: Mon, 22 Apr 2024 11:25:53 -0700 Subject: [PATCH] change secp256k1-haskell to libsecp256k1 --- bitcoin-test/bitcoin-test.cabal | 4 +- .../lib/Bitcoin/Crypto/SignatureSpec.hs | 49 +++++++------ bitcoin-test/lib/Bitcoin/Keys/ExtendedSpec.hs | 8 +-- bitcoin-test/lib/Bitcoin/KeysSpec.hs | 20 +++--- bitcoin-test/lib/Bitcoin/Orphans.hs | 20 ++++-- bitcoin-test/lib/Bitcoin/ScriptSpec.hs | 12 ++-- .../lib/Bitcoin/Transaction/PartialSpec.hs | 19 ++--- .../lib/Bitcoin/Transaction/TaprootSpec.hs | 32 ++++----- .../lib/Bitcoin/Util/Arbitrary/Keys.hs | 4 +- bitcoin-test/package.yaml | 2 +- bitcoin/bitcoin.cabal | 4 +- bitcoin/package.yaml | 4 +- bitcoin/src/Bitcoin/Crypto/Signature.hs | 56 +++++---------- bitcoin/src/Bitcoin/Keys/Common.hs | 46 +++++------- bitcoin/src/Bitcoin/Keys/Extended.hs | 42 +++++------ bitcoin/src/Bitcoin/Script/SigHash.hs | 4 +- bitcoin/src/Bitcoin/Transaction/Builder.hs | 6 +- .../src/Bitcoin/Transaction/Builder/Sign.hs | 9 ++- bitcoin/src/Bitcoin/Transaction/Partial.hs | 14 ++-- bitcoin/src/Bitcoin/Transaction/Taproot.hs | 71 +++++++------------ stack.yaml | 2 +- stack.yaml.lock | 8 +-- 22 files changed, 205 insertions(+), 231 deletions(-) diff --git a/bitcoin-test/bitcoin-test.cabal b/bitcoin-test/bitcoin-test.cabal index 51f2c2e9..0018a78c 100644 --- a/bitcoin-test/bitcoin-test.cabal +++ b/bitcoin-test/bitcoin-test.cabal @@ -78,9 +78,9 @@ library , bytestring >=0.10.10.0 , containers >=0.6.2.1 , hspec >=2.7.1 + , libsecp256k1 >=0.2.0 , memory >=0.15.0 , scientific >=0.3.6.2 - , secp256k1-haskell >=0.4.0 , string-conversions >=0.4.0.1 , text >=1.2.3.0 , time >=1.9.3 @@ -107,9 +107,9 @@ test-suite spec , bytestring >=0.10.10.0 , containers >=0.6.2.1 , hspec >=2.7.1 + , libsecp256k1 >=0.2.0 , memory >=0.15.0 , scientific >=0.3.6.2 - , secp256k1-haskell >=0.4.0 , string-conversions >=0.4.0.1 , text >=1.2.3.0 , time >=1.9.3 diff --git a/bitcoin-test/lib/Bitcoin/Crypto/SignatureSpec.hs b/bitcoin-test/lib/Bitcoin/Crypto/SignatureSpec.hs index 53ff9b61..95db6839 100644 --- a/bitcoin-test/lib/Bitcoin/Crypto/SignatureSpec.hs +++ b/bitcoin-test/lib/Bitcoin/Crypto/SignatureSpec.hs @@ -2,7 +2,7 @@ module Bitcoin.Crypto.SignatureSpec (spec) where -import Bitcoin (getCompactSig) +import Bitcoin (exportSignatureCompact) import Bitcoin.Address ( Address (WitnessPubKeyAddress), pubKeyWitnessAddr, @@ -10,19 +10,19 @@ import Bitcoin.Address ( import Bitcoin.Constants (btc) import Bitcoin.Crypto ( SecKey, - Sig, + Signature, decodeStrictSig, derivePubKey, - exportCompactSig, - exportSig, + ecdsaSign, + exportSignatureCompact, + exportSignatureDer, getSig, - importSig, + importSecKey, + importSignatureDer, isCanonicalHalfOrder, putSig, - secKey, sha256, signHash, - signMsg, verifyHashSig, ) import Bitcoin.Keys (PubKeyI, derivePubKeyI, wrapSecKey) @@ -53,7 +53,7 @@ import Data.ByteString (ByteString) import qualified Data.ByteString as BS import Data.Map.Strict (Map) import qualified Data.Map.Strict as Map -import Data.Maybe (fromJust) +import Data.Maybe (fromJust, fromMaybe) import Data.String.Conversions (cs) import Data.Text (Text) import Test.HUnit ( @@ -81,10 +81,10 @@ spec = do testIsCanonical . lst3 prop "decodeStrictSig . exportSig identity" $ forAll arbitrarySignature $ - (\s -> decodeStrictSig (exportSig s) == Just s) . lst3 + (\s -> decodeStrictSig (exportSignatureDer s) == Just s) . lst3 prop "importSig . exportSig identity" $ forAll arbitrarySignature $ - (\s -> importSig (exportSig s) == Just s) . lst3 + (\s -> importSignatureDer (exportSignatureDer s) == Just s) . lst3 prop "getSig . putSig identity" $ forAll arbitrarySignature $ \(_, _, s) -> (U.runGet getSig . runPut . putSig) s == Right s @@ -105,7 +105,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 +156,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) @@ -175,10 +175,13 @@ data ValidImpl implSig :: Text implSig = encodeHex $ - exportSig $ - signMsg - "0000000000000000000000000000000000000000000000000000000000000001" - "0000000000000000000000000000000000000000000000000000000000000000" + exportSignatureDer $ + fromMaybe (error "Signing Failed") $ + ecdsaSign key "0000000000000000000000000000000000000000000000000000000000000000" + where + key = + fromMaybe (error "Invalid SecKey") . (importSecKey <=< decodeHex) $ + "0000000000000000000000000000000000000000000000000000000000000001" -- We have test vectors for these cases @@ -201,7 +204,7 @@ validImplMap = getImpl :: Maybe ValidImpl -getImpl = implSig `Map.lookup` validImplMap +getImpl = pure ImplCore rfc6979files :: ValidImpl -> (FilePath, FilePath) @@ -223,18 +226,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 = fromMaybe (error "Signing Failed") $ signHash prv h -- Test vectors from: @@ -242,13 +245,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 = fromMaybe (error "Signing Failed") $ signHash prv h -- Reproduce the P2WPKH example from BIP 143 @@ -497,7 +500,7 @@ testBip143p2shp2wpkhMulsig = secHexKey :: Text -> Maybe SecKey -secHexKey = decodeHex >=> secKey +secHexKey = decodeHex >=> importSecKey toPubKey :: SecKey -> PubKeyI diff --git a/bitcoin-test/lib/Bitcoin/Keys/ExtendedSpec.hs b/bitcoin-test/lib/Bitcoin/Keys/ExtendedSpec.hs index a6b9a420..45ac18fe 100644 --- a/bitcoin-test/lib/Bitcoin/Keys/ExtendedSpec.hs +++ b/bitcoin-test/lib/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/bitcoin-test/lib/Bitcoin/KeysSpec.hs b/bitcoin-test/lib/Bitcoin/KeysSpec.hs index 2c69fee9..05a8773a 100644 --- a/bitcoin-test/lib/Bitcoin/KeysSpec.hs +++ b/bitcoin-test/lib/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, @@ -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 + sign1 <- maybe (assertFailure "Signing Failed") pure $ signHash (secKeyData sec1) h + sign2 <- maybe (assertFailure "Signing Failed") pure $ signHash (secKeyData sec2) h + sign1C <- maybe (assertFailure "Signing Failed") pure $ signHash (secKeyData sec1C) h + sign2C <- maybe (assertFailure "Signing Failed") pure $ 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/bitcoin-test/lib/Bitcoin/Orphans.hs b/bitcoin-test/lib/Bitcoin/Orphans.hs index cb92aee1..fba28035 100644 --- a/bitcoin-test/lib/Bitcoin/Orphans.hs +++ b/bitcoin-test/lib/Bitcoin/Orphans.hs @@ -14,7 +14,9 @@ import Bitcoin ( OutPoint (OutPoint), ParsedPath (..), PubKeyI, + PubKeyXO, ScriptOutput, + SecKey, SigHash (..), SigInput (SigInput), SoftPath, @@ -22,7 +24,6 @@ import Bitcoin ( TxHash, TxIn (TxIn), TxOut (TxOut), - XOnlyPubKey, blockHashToHex, decodeHex, decodeOutputBS, @@ -32,6 +33,8 @@ import Bitcoin ( hexBuilder, hexToBlockHash, hexToTxHash, + importPubKeyXO, + importSecKey, maybeToEither, parseHard, parsePath, @@ -57,10 +60,12 @@ import Data.Aeson ( import Data.Aeson.Encoding (text, unsafeToEncoding) import qualified Data.Binary as Bin import Data.ByteString.Builder (char7) +import qualified Data.ByteString.Char8 as B8 import qualified Data.ByteString.Lazy as BSL import Data.Maybe (maybeToList) import Data.Scientific (toBoundedInteger) import Data.String.Conversions (cs) +import Test.QuickCheck instance FromJSON BlockHash where @@ -345,8 +350,15 @@ instance FromJSON SigInput where -- | Hex encoding -instance FromJSON XOnlyPubKey where +instance FromJSON PubKeyXO where parseJSON = withText "XOnlyPubKey" $ - either fail pure - . (U.decode . BSL.fromStrict <=< maybe (Left "Unable to decode hex") Right . decodeHex) + maybe (fail "") pure + . (importPubKeyXO <=< decodeHex) + + +-- | Arbitrary +instance Arbitrary SecKey where + arbitrary = do + bytes <- B8.pack <$> vectorOf 32 arbitrary + maybe arbitrary pure (importSecKey bytes) \ No newline at end of file diff --git a/bitcoin-test/lib/Bitcoin/ScriptSpec.hs b/bitcoin-test/lib/Bitcoin/ScriptSpec.hs index 7babb050..77696948 100644 --- a/bitcoin-test/lib/Bitcoin/ScriptSpec.hs +++ b/bitcoin-test/lib/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)) @@ -225,9 +225,9 @@ scriptSpec net = "DERSIG" `isInfixOf` flags || "STRICTENC" - `isInfixOf` flags + `isInfixOf` flags || "NULLDUMMY" - `isInfixOf` flags + `isInfixOf` flags scriptSig = parseScript siStr scriptPubKey = parseScript soStr decodedOutput = decodeOutputBS scriptPubKey @@ -369,8 +369,8 @@ sigHashSpec net = do testSigHashOne :: Network -> Tx -> Script -> Word64 -> Bool -> Property testSigHashOne net tx s val acp = - not (null $ txIn tx) ==> - if length (txIn tx) > length (txOut tx) + not (null $ txIn tx) + ==> if length (txIn tx) > length (txOut tx) then res `shouldBe` one else res `shouldNotBe` one where diff --git a/bitcoin-test/lib/Bitcoin/Transaction/PartialSpec.hs b/bitcoin-test/lib/Bitcoin/Transaction/PartialSpec.hs index 0c3d2610..17d7ca37 100644 --- a/bitcoin-test/lib/Bitcoin/Transaction/PartialSpec.hs +++ b/bitcoin-test/lib/Bitcoin/Transaction/PartialSpec.hs @@ -3,9 +3,10 @@ module Bitcoin.Transaction.PartialSpec (spec) where +import Bitcoin (importPubKeyXY, importSecKey) 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 (..), @@ -71,7 +72,7 @@ import Data.ByteString.Base64 (decodeBase64) import qualified Data.ByteString.Lazy as BSL import Data.Either (fromRight, isLeft, isRight) import Data.HashMap.Strict (fromList, singleton) -import Data.Maybe (fromJust, isJust) +import Data.Maybe (fromJust, fromMaybe, isJust) import Data.Text (Text) import qualified Data.Text as Text import Data.Text.Encoding (encodeUtf8) @@ -237,7 +238,7 @@ vec5Test = do fromList [ ( PubKeyI - { pubKeyPoint = "03b1341ccba7683b6af4f1238cd6e97e7167d569fac47f1e48d47541844355bd46" + { pubKeyPoint = (fromJust . (importPubKeyXY <=< decodeHex)) "03b1341ccba7683b6af4f1238cd6e97e7167d569fac47f1e48d47541844355bd46" , pubKeyCompressed = True } , (fromJust . decodeHex) "304302200424b58effaaa694e1559ea5c93bbfd4a89064224055cdf070b6771469442d07021f5c8eb0fea6516d60b8acb33ad64ede60e8785bfb3aa94b99bdf86151db9a9a01" @@ -262,14 +263,14 @@ vec5Test = do fromList [ ( PubKeyI - { pubKeyPoint = "03b1341ccba7683b6af4f1238cd6e97e7167d569fac47f1e48d47541844355bd46" + { pubKeyPoint = (fromJust . (importPubKeyXY <=< decodeHex)) "03b1341ccba7683b6af4f1238cd6e97e7167d569fac47f1e48d47541844355bd46" , pubKeyCompressed = True } , ("b4a6ba67", [hardIndex 0, hardIndex 0, hardIndex 4]) ) , ( PubKeyI - { pubKeyPoint = "03de55d1e1dac805e3f8a58c1fbf9b94c02f3dbaafe127fefca4995f26f82083bd" + { pubKeyPoint = (fromJust . (importPubKeyXY <=< decodeHex)) "03de55d1e1dac805e3f8a58c1fbf9b94c02f3dbaafe127fefca4995f26f82083bd" , pubKeyCompressed = True } , ("b4a6ba67", [hardIndex 0, hardIndex 0, hardIndex 5]) @@ -345,7 +346,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" @@ -445,6 +446,7 @@ unfinalizedPkhPSBT net (prvKey, pubKey) = { inputs = [emptyInput{nonWitnessUtxo = Just prevTx, partialSigs = singleton pubKey sig}] } where + signHash' a b = fromMaybe (error "Signing Failed") $ signHash a b currTx = unfinalizedTx (txHash prevTx) prevTx = testUtxo [prevOut] prevOutScript = addressToScript (pubKeyAddr pubKey) @@ -454,7 +456,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 (signHash' (secKeyData prvKey) h) sigHashAll arbitraryMultiSig :: Gen ([(SecKeyI, PubKeyI)], Int) @@ -476,13 +478,14 @@ unfinalizedMsPSBT net (keys, m) = ] } where + signHash' a b = fromMaybe (error "Signing Failed") $ signHash a b currTx = unfinalizedTx (txHash prevTx) prevTx = testUtxo [prevOut] prevOutScript = encodeOutput $ PayMulSig (map snd 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 (signHash' (secKeyData prvKey) h) sigHashAll) unfinalizedTx :: TxHash -> Tx diff --git a/bitcoin-test/lib/Bitcoin/Transaction/TaprootSpec.hs b/bitcoin-test/lib/Bitcoin/Transaction/TaprootSpec.hs index 5846cf2e..9b18d51d 100644 --- a/bitcoin-test/lib/Bitcoin/Transaction/TaprootSpec.hs +++ b/bitcoin-test/lib/Bitcoin/Transaction/TaprootSpec.hs @@ -1,23 +1,26 @@ {-# LANGUAGE LambdaCase #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TypeApplications #-} module Bitcoin.Transaction.TaprootSpec (spec) where import Bitcoin ( MAST (..), - PubKey, PubKeyI (PubKeyI), + PubKeyXO, + PubKeyXY, ScriptOutput, ScriptPathData (..), TaprootOutput (TaprootOutput), TaprootWitness (ScriptPathSpend), - XOnlyPubKey (..), addrToText, btc, decodeHex, encodeTaprootWitness, getMerkleProofs, + importPubKeyXO, + importPubKeyXY, mastCommitment, outputAddress, taprootInternalKey, @@ -25,6 +28,7 @@ import Bitcoin ( taprootOutputKey, taprootScriptOutput, verifyScriptPathData, + xyToXO, ) import Bitcoin.Orphans () import qualified Bitcoin.Util as U @@ -34,9 +38,11 @@ import Control.Monad (zipWithM, (<=<)) import Data.Aeson (FromJSON (parseJSON), withObject, (.:), (.:?)) import Data.Aeson.Types (Parser) import qualified Data.ByteArray as BA +import Data.ByteArray.Encoding import Data.ByteString (ByteString) import qualified Data.ByteString as BS import qualified Data.ByteString.Lazy as BSL +import Data.Maybe (fromMaybe) import Data.Text (Text) import Data.Word (Word8) import Test.HUnit (assertBool, (@?=)) @@ -72,10 +78,10 @@ testHashes testData = testOutputKey :: TestScriptPubKey -> IO () testOutputKey testData = do - XOnlyPubKey (taprootOutputKey theOutput) @?= theOutputKey + (fst . xyToXO) (taprootOutputKey theOutput) @?= theOutputKey where theOutput = tspkGiven testData - theOutputKey = XOnlyPubKey . spkiTweakedPubKey $ tspkIntermediary testData + theOutputKey = spkiTweakedPubKey $ tspkIntermediary testData testScriptOutput :: TestScriptPubKey -> IO () @@ -85,7 +91,7 @@ testScriptOutput testData = testControlBlocks :: TestScriptPubKey -> IO () testControlBlocks testData = do - mapM_ onExamples exampleControlBlocks + mapM_ (onExamples . fmap (convertToBase Base16)) exampleControlBlocks mapM_ checkVerification scriptPathSpends where theOutput = tspkGiven testData @@ -102,21 +108,15 @@ testControlBlocks testData = do { scriptPathAnnex = Nothing , scriptPathStack = mempty , scriptPathScript - , scriptPathExternalIsOdd = odd $ keyParity theOutputKey + , scriptPathExternalIsOdd = snd . xyToXO $ theOutputKey , scriptPathLeafVersion , scriptPathInternalKey = taprootInternalKey theOutput , scriptPathControl = BA.convert <$> proof } - onExamples = zipWithM (@?=) calculatedControlBlocks + onExamples = zipWithM (@?=) (fmap (convertToBase @ByteString @ByteString Base16) calculatedControlBlocks) checkVerification = assertBool "Script verifies" . verifyScriptPathData theOutputKey -keyParity :: PubKey -> Word8 -keyParity key = case BS.unpack . U.encodeS $ PubKeyI key True of - 0x02 : _ -> 0x00 - _ -> 0x01 - - testAddress :: TestScriptPubKey -> IO () testAddress testData = computedAddress @?= (Just . spkeAddress . tspkExpected) testData where @@ -130,7 +130,7 @@ instance FromJSON SpkGiven where parseJSON = withObject "SpkGiven" $ \obj -> fmap SpkGiven $ TaprootOutput - <$> (xOnlyPubKey <$> obj .: "internalPubkey") + <$> (maybe (fail "Invalid Public Key") pure . (importPubKeyXO <=< decodeHex) =<< obj .: "internalPubkey") <*> (obj .:? "scriptTree" >>= traverse parseScriptTree) where parseScriptTree v = @@ -151,7 +151,7 @@ instance FromJSON SpkGiven where data SpkIntermediary = SpkIntermediary { spkiLeafHashes :: Maybe [ByteString] , spkiMerkleRoot :: Maybe ByteString - , spkiTweakedPubKey :: PubKey + , spkiTweakedPubKey :: PubKeyXO } @@ -160,7 +160,7 @@ instance FromJSON SpkIntermediary where SpkIntermediary <$> (obj .:? "leafHashes" >>= (traverse . traverse) jsonHex) <*> (obj .: "merkleRoot" >>= traverse jsonHex) - <*> (xOnlyPubKey <$> obj .: "tweakedPubkey") + <*> (obj .: "tweakedPubkey" >>= maybe (fail "Invalid Public Key") pure . (importPubKeyXO <=< decodeHex)) data SpkExpected = SpkExpected diff --git a/bitcoin-test/lib/Bitcoin/Util/Arbitrary/Keys.hs b/bitcoin-test/lib/Bitcoin/Util/Arbitrary/Keys.hs index d1aa8848..fac30d57 100644 --- a/bitcoin-test/lib/Bitcoin/Util/Arbitrary/Keys.hs +++ b/bitcoin-test/lib/Bitcoin/Util/Arbitrary/Keys.hs @@ -7,6 +7,7 @@ import Bitcoin.Crypto import Bitcoin.Keys.Common import Bitcoin.Keys.Extended import Bitcoin.Keys.Extended.Internal (Fingerprint (..)) +import Bitcoin.Orphans () import Bitcoin.Util.Arbitrary.Crypto import Data.Bits (clearBit) import Data.Coerce (coerce) @@ -92,9 +93,10 @@ 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 + sig <- maybe discard pure sig return (m, key, sig) diff --git a/bitcoin-test/package.yaml b/bitcoin-test/package.yaml index e0ada015..4acbed49 100644 --- a/bitcoin-test/package.yaml +++ b/bitcoin-test/package.yaml @@ -26,7 +26,7 @@ dependencies: - hspec >= 2.7.1 - memory >= 0.15.0 - scientific >= 0.3.6.2 - - secp256k1-haskell >= 0.4.0 + - libsecp256k1 >= 0.2.0 - string-conversions >= 0.4.0.1 - text >= 1.2.3.0 - time >= 1.9.3 diff --git a/bitcoin/bitcoin.cabal b/bitcoin/bitcoin.cabal index 9e630587..fd67e907 100644 --- a/bitcoin/bitcoin.cabal +++ b/bitcoin/bitcoin.cabal @@ -5,7 +5,7 @@ cabal-version: 1.12 -- see: https://github.com/sol/hpack name: bitcoin -version: 0.1.0 +version: 0.1.1 synopsis: Bitcoin library for Haskell description: Please see the README on GitHub at category: Bitcoin, Finance, Network @@ -73,10 +73,10 @@ library , cryptonite >=0.30 , deepseq >=1.4.4.0 , hashable >=1.3.0.0 + , libsecp256k1 >=0.2.0 , memory >=0.15.0 , murmur3 >=1.0.3 , network >=3.1.1.1 - , secp256k1-haskell >=0.4.0 && <1 , split >=0.2.3.3 , string-conversions >=0.4.0.1 , text >=1.2.3.0 diff --git a/bitcoin/package.yaml b/bitcoin/package.yaml index effeb8ae..b222869b 100644 --- a/bitcoin/package.yaml +++ b/bitcoin/package.yaml @@ -1,5 +1,5 @@ name: bitcoin -version: 0.1.0 +version: 0.1.1 synopsis: Bitcoin library for Haskell description: Please see the README on GitHub at category: Bitcoin, Finance, Network @@ -28,7 +28,7 @@ dependencies: - murmur3 >= 1.0.3 - network >= 3.1.1.1 - split >= 0.2.3.3 - - secp256k1-haskell >= 0.4.0 && < 1 + - libsecp256k1 >= 0.2.0 - string-conversions >= 0.4.0.1 - text >= 1.2.3.0 - transformers >= 0.5.6.2 diff --git a/bitcoin/src/Bitcoin/Crypto/Signature.hs b/bitcoin/src/Bitcoin/Crypto/Signature.hs index 655978bf..6aedd616 100644 --- a/bitcoin/src/Bitcoin/Crypto/Signature.hs +++ b/bitcoin/src/Bitcoin/Crypto/Signature.hs @@ -14,55 +14,35 @@ 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, - SecKey, - Sig, - exportCompactSig, - exportSig, - importSig, - msg, - normalizeSig, - signMsg, - verifySig, - ) +import Crypto.Secp256k1 (PubKeyXY, SecKey, Signature, ecdsaNormalizeSignature, ecdsaSign, ecdsaVerify, exportSignatureCompact, exportSignatureDer, importSignatureDer) 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.ByteString.Short (fromShort) import Data.Maybe (fromMaybe, isNothing) 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 = ecdsaNormalizeSignature s -- | Deserialize an ECDSA signature as commonly encoded in Bitcoin. -getSig :: Get Sig +getSig :: Get Signature getSig = do l <- lookAhead $ do @@ -82,24 +62,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 = ecdsaNormalizeSignature >>= (==) -- | 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/bitcoin/src/Bitcoin/Keys/Common.hs b/bitcoin/src/Bitcoin/Keys/Common.hs index b256d5c8..5637401b 100644 --- a/bitcoin/src/Bitcoin/Keys/Common.hs +++ b/bitcoin/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, @@ -44,17 +44,7 @@ import Control.DeepSeq (NFData) import Control.Monad (guard, mzero, (<=<)) import Crypto.Hash (hashWith) import Crypto.Hash.Algorithms (SHA256 (SHA256)) -import Crypto.Secp256k1 ( - PubKey, - SecKey (..), - derivePubKey, - exportPubKey, - importPubKey, - secKey, - tweak, - tweakAddPubKey, - tweakAddSecKey, - ) +import Crypto.Secp256k1 (PubKeyXY, SecKey, derivePubKey, exportPubKeyXY, exportSecKey, importPubKeyXY, importSecKey, importTweak, pubKeyTweakAdd, secKeyTweakAdd) import Data.Binary (Binary (..)) import Data.Binary.Get (getByteString, getWord8, lookAhead) import Data.Binary.Put (putByteString) @@ -71,7 +61,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 +90,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 +112,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 +134,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 +155,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 +169,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/bitcoin/src/Bitcoin/Keys/Extended.hs b/bitcoin/src/Bitcoin/Keys/Extended.hs index c0c2cf11..a8466858 100644 --- a/bitcoin/src/Bitcoin/Keys/Extended.hs +++ b/bitcoin/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 @@ -644,8 +644,8 @@ instance AnyOrSoft SoftDeriv -- > Deriv :| 0 :| 1 :| 2 :: HardPath -- > Deriv :| 0 :/ 1 :/ 2 :: DerivPath data DerivPathI t where - (:|) :: HardOrAny t => !(DerivPathI t) -> !KeyIndex -> DerivPathI t - (:/) :: AnyOrSoft t => !(DerivPathI t) -> !KeyIndex -> DerivPathI t + (:|) :: (HardOrAny t) => !(DerivPathI t) -> !KeyIndex -> DerivPathI t + (:/) :: (AnyOrSoft t) => !(DerivPathI t) -> !KeyIndex -> DerivPathI t Deriv :: DerivPathI t @@ -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/bitcoin/src/Bitcoin/Script/SigHash.hs b/bitcoin/src/Bitcoin/Script/SigHash.hs index c6163a37..166ab33c 100644 --- a/bitcoin/src/Bitcoin/Script/SigHash.hs +++ b/bitcoin/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/bitcoin/src/Bitcoin/Transaction/Builder.hs b/bitcoin/src/Bitcoin/Transaction/Builder.hs index 6b7eef45..a3f2bc56 100644 --- a/bitcoin/src/Bitcoin/Transaction/Builder.hs +++ b/bitcoin/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 @@ -343,7 +343,7 @@ countMulSig :: Script -> Word64 -> Int -> - [PubKey] -> + [PubKeyXY] -> [TxSignature] -> Int countMulSig net tx out val i = @@ -352,7 +352,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/bitcoin/src/Bitcoin/Transaction/Builder/Sign.hs b/bitcoin/src/Bitcoin/Transaction/Builder/Sign.hs index 31485209..d948a211 100644 --- a/bitcoin/src/Bitcoin/Transaction/Builder/Sign.hs +++ b/bitcoin/src/Bitcoin/Transaction/Builder/Sign.hs @@ -131,7 +131,10 @@ 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 + let mSig = makeSignature net tx i sigIn key + sig <- case mSig of + Nothing -> Left "Signature generation failed" + Just x -> pure x si <- buildInput net tx i so val rdmM sig $ derivePubKeyI key w <- updatedWitnessData tx i so si return @@ -269,9 +272,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 + flip TxSignature sh <$> signHash (secKeyData key) m where m = makeSigHash net tx i so val sh rdmM diff --git a/bitcoin/src/Bitcoin/Transaction/Partial.hs b/bitcoin/src/Bitcoin/Transaction/Partial.hs index 31aaeec9..e55d1f35 100644 --- a/bitcoin/src/Bitcoin/Transaction/Partial.hs +++ b/bitcoin/src/Bitcoin/Transaction/Partial.hs @@ -360,7 +360,7 @@ onPrevTxOut net signer tx ix input prevTxData = where newSigs = HM.mapWithKey sigForInput sigKeys sigForInput thePubKey theSecKey = - encodeTxSig . makeSignature net tx ix theSigInput $ + maybe (error "Signature Gen Failed") encodeTxSig . makeSignature net tx ix theSigInput $ SecKeyI theSecKey (pubKeyCompressed thePubKey) theSigInput = @@ -771,13 +771,13 @@ getSizedBytes getItem = do isolate n getItem -putKeyValue :: Enum t => t -> Put -> Put +putKeyValue :: (Enum t) => t -> Put -> Put putKeyValue t v = do putKey t putSizedBytes v -putKey :: Enum t => t -> Put +putKey :: (Enum t) => t -> Put putKey t = do putVarInt (1 :: Word8) putWord8 (enumWord8 t) @@ -904,7 +904,7 @@ getHDPath keySize = <*> (unPSBTHDPath <$> get) -putHDPath :: Enum t => t -> HashMap PubKeyI (Fingerprint, [KeyIndex]) -> Put +putHDPath :: (Enum t) => t -> HashMap PubKeyI (Fingerprint, [KeyIndex]) -> Put putHDPath t = putPubKeyMap put t . fmap PSBTHDPath @@ -935,7 +935,7 @@ instance Binary PSBTHDPath where bs = runPut $ put fp >> mapM_ putWord32le kis -putPubKeyMap :: Enum t => (a -> Put) -> t -> HashMap PubKeyI a -> Put +putPubKeyMap :: (Enum t) => (a -> Put) -> t -> HashMap PubKeyI a -> Put putPubKeyMap f t = void . HashMap.traverseWithKey putItem where @@ -944,7 +944,7 @@ putPubKeyMap f t = f v -enumWord8 :: Enum a => a -> Word8 +enumWord8 :: (Enum a) => a -> Word8 enumWord8 = fromIntegral . fromEnum @@ -953,7 +953,7 @@ word8Enum n | n <= enumWord8 (maxBound :: a) = Right . toEnum $ fromIntegral n word8Enum n = Left n -whenJust :: Monad m => (a -> m ()) -> Maybe a -> m () +whenJust :: (Monad m) => (a -> m ()) -> Maybe a -> m () whenJust = maybe (return ()) diff --git a/bitcoin/src/Bitcoin/Transaction/Taproot.hs b/bitcoin/src/Bitcoin/Transaction/Taproot.hs index 4cc0339f..243022c7 100644 --- a/bitcoin/src/Bitcoin/Transaction/Taproot.hs +++ b/bitcoin/src/Bitcoin/Transaction/Taproot.hs @@ -10,7 +10,6 @@ -- This module provides support for reperesenting full taproot outputs and parsing -- taproot witnesses. For reference see BIPS 340, 341, and 342. module Bitcoin.Transaction.Taproot ( - XOnlyPubKey (..), TapLeafVersion, MAST (..), mastCommitment, @@ -25,7 +24,7 @@ module Bitcoin.Transaction.Taproot ( verifyScriptPathData, ) where -import Bitcoin.Crypto (PubKey, initTaggedHash, tweak, tweakAddPubKey) +import Bitcoin.Crypto (PubKeyXO, PubKeyXY, exportPubKeyXO, importTweak, initTaggedHash, pubKeyTweakAdd, pubKeyXOTweakAdd, xyToXO) import Bitcoin.Keys.Common (PubKeyI (PubKeyI), pubKeyPoint) import Bitcoin.Network.Common (VarInt (VarInt)) import Bitcoin.Script.Common (Script) @@ -42,6 +41,7 @@ import Crypto.Hash ( hashUpdate, hashUpdates, ) +import Crypto.Secp256k1 (exportPubKeyXY, importPubKeyXO, importPubKeyXY) import Data.Binary (Binary (..)) import qualified Data.Binary as Bin import Data.Binary.Get (getByteString, getLazyByteString, getWord8) @@ -58,36 +58,12 @@ import Data.Maybe (fromMaybe, mapMaybe) 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} - deriving (Show) - - -instance Eq XOnlyPubKey where - (==) = (==) `on` Bin.encode - - -instance Binary XOnlyPubKey where - put (XOnlyPubKey pk) = - putLazyByteString - . BSL.drop 1 - . Bin.encode - $ PubKeyI pk True - get = - either fail (pure . XOnlyPubKey . pubKeyPoint) - . U.decode - . BSL.cons 0x02 - =<< getLazyByteString 32 - - type TapLeafVersion = Word8 -- | Merklized Abstract Syntax Tree. This type can represent trees where only a ---subset of the leaves are known. Note that the tree is invariant under swapping ---branches at an internal node. +-- subset of the leaves are known. Note that the tree is invariant under swapping +-- branches at an internal node. data MAST = MASTBranch MAST MAST | MASTLeaf TapLeafVersion Script @@ -96,7 +72,7 @@ data MAST -- | Get the inclusion proofs for the leaves in the tree. The proof is ordered ---leaf-to-root. +-- leaf-to-root. getMerkleProofs :: MAST -> [(TapLeafVersion, Script, [Digest SHA256])] getMerkleProofs = getProofs mempty where @@ -145,21 +121,21 @@ leafHash leafVersion leafScript = -- | Representation of a full taproot output. data TaprootOutput = TaprootOutput - { taprootInternalKey :: PubKey + { taprootInternalKey :: PubKeyXO , 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 >>= pubKeyXOTweakAdd taprootInternalKey where commitment = taprootCommitment taprootInternalKey $ mastCommitment <$> taprootMAST keyFail = error "bitcoin taprootOutputKey: key derivation failed" -taprootCommitment :: PubKey -> Maybe (Digest SHA256) -> ByteString +taprootCommitment :: PubKeyXO -> Maybe (Digest SHA256) -> ByteString taprootCommitment internalKey merkleRoot = BA.convert . hashFinalize @@ -167,12 +143,12 @@ taprootCommitment internalKey merkleRoot = . (`hashUpdates` BSL.toChunks keyBytes) $ initTaggedHash "TapTweak" where - keyBytes = Bin.encode $ XOnlyPubKey internalKey + keyBytes = BSL.fromStrict $ exportPubKeyXO $ internalKey -- | Generate the output script for a taproot output taprootScriptOutput :: TaprootOutput -> ScriptOutput -taprootScriptOutput = PayWitness 0x01 . U.encodeS . XOnlyPubKey . taprootOutputKey +taprootScriptOutput = PayWitness 0x01 . exportPubKeyXO . fst . xyToXO . taprootOutputKey -- | Comprehension of taproot witness data @@ -190,7 +166,7 @@ data ScriptPathData = ScriptPathData , scriptPathExternalIsOdd :: Bool , scriptPathLeafVersion :: Word8 -- ^ This value is masked by 0xFE - , scriptPathInternalKey :: PubKey + , scriptPathInternalKey :: PubKeyXO , scriptPathControl :: [ByteString] } deriving (Eq, Show) @@ -223,7 +199,10 @@ viewTaprootWitness witnessStack = case reverse witnessStack of deconstructControl = eitherToMaybe . U.runGet deserializeControl . BSL.fromStrict deserializeControl = do v <- getWord8 - k <- xOnlyPubKey <$> get + keyBytes <- getByteString 32 + k <- case importPubKeyXO keyBytes of + Nothing -> fail "Invalid PubKeyXO" + Just x -> pure x proof <- many $ getByteString 32 pure (v, k, proof) @@ -237,7 +216,7 @@ encodeTaprootWitness = \case <> [ U.encodeS $ scriptPathScript scriptPathData , mconcat [ BS.pack [scriptPathLeafVersion scriptPathData .|. parity scriptPathData] - , U.encodeS . XOnlyPubKey $ scriptPathInternalKey scriptPathData + , exportPubKeyXO $ scriptPathInternalKey scriptPathData , mconcat $ scriptPathControl scriptPathData ] , fromMaybe mempty $ scriptPathAnnex scriptPathData @@ -249,25 +228,27 @@ 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) + tweak <- importTweak commitment + tweaked <- pubKeyXOTweakAdd (scriptPathInternalKey scriptPathData) tweak + pure $ uncurry onComputedKey . xyToXO $ tweaked where - onComputedKey computedKey = - XOnlyPubKey outputKey == XOnlyPubKey computedKey - && expectedParity == keyParity computedKey + onComputedKey computedKey computedParity = + fst (xyToXO outputKey) == computedKey + && expectedParity == computedParity commitment = taprootCommitment (scriptPathInternalKey scriptPathData) (Just merkleRoot) merkleRoot = foldl' hashBranch theLeafHash . mapMaybe (digestFromByteString @SHA256) $ scriptPathControl scriptPathData theLeafHash = (leafHash <$> (.&. 0xFE) . scriptPathLeafVersion <*> scriptPathScript) scriptPathData - expectedParity = bool 0 1 $ scriptPathExternalIsOdd scriptPathData + expectedParity = bool False True $ 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/stack.yaml b/stack.yaml index ac057c03..7142211f 100644 --- a/stack.yaml +++ b/stack.yaml @@ -7,7 +7,7 @@ nix: extra-deps: - fourmolu-0.8.2.0 - cryptonite-0.30 - - secp256k1-haskell-0.7.0 + - libsecp256k1-0.2.0 packages: - ./bitcoin - ./bitcoin-test diff --git a/stack.yaml.lock b/stack.yaml.lock index 8139930d..69379221 100644 --- a/stack.yaml.lock +++ b/stack.yaml.lock @@ -19,12 +19,12 @@ packages: original: hackage: cryptonite-0.30 - completed: - hackage: secp256k1-haskell-0.7.0@sha256:1585601c67d7c62c698402ffe8462de216a499608521a8136d0aa15f0a03a23f,2140 + hackage: libsecp256k1-0.2.0@sha256:1c64fa4f06a2681376263c8ce426339e32cdf30dd95b095c037505a1a351db95,2189 pantry-tree: - sha256: a7726275193ac4ef14c9d97378222d3ca494524c48354edf69214513def7d48d - size: 599 + sha256: 40df088f7d7b3ca61b93f08d27b0beefae6f35670fd272db69e68558df1f2d5c + size: 902 original: - hackage: secp256k1-haskell-0.7.0 + hackage: libsecp256k1-0.2.0 snapshots: - completed: sha256: 1b4c2669e26fa828451830ed4725e4d406acc25a1fa24fcc039465dd13d7a575