diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -4,6 +4,13 @@ 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.11.0 +### Added +- High-level representation of segwit v0 data and auxilliary functions. + +### Changed +- Adds handling of segwit signing parameters to transaction signing code. + ## 0.10.1 ### Added - Lower bound versions for some dependencies. diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -10,7 +10,7 @@ - BIP39 mnemonic keys - ECDSA secp256k1 cryptographic primitives - Script parsing -- Building and signing of standard transactions (regular, multisig, p2sh) +- Building and signing of standard transactions (regular, multisig, p2sh, segwit) - Parsing and manipulation of all Bitcoin and Bitcoin Cash protocol messages - Bloom filters and partial merkle trees (used in SPV wallets) - Comprehensive test suite diff --git a/haskoin-core.cabal b/haskoin-core.cabal --- a/haskoin-core.cabal +++ b/haskoin-core.cabal @@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack -- --- hash: 5dfd121f9d6338f5c72981eb0ec765cba99a662710318432e7eeb6da5ec119bf +-- hash: 1ce94eac889a0e1f03131ba2275354d9e3fcffbb001fa4c0cd8e70cff3e8940a name: haskoin-core -version: 0.10.1 +version: 0.12.0 synopsis: Bitcoin & Bitcoin Cash library for Haskell description: Haskoin Core is a complete Bitcoin and Bitcoin Cash library of functions and data types for Haskell developers. category: Bitcoin, Finance, Network @@ -52,6 +52,7 @@ Network.Haskoin.Test Network.Haskoin.Transaction Network.Haskoin.Transaction.Partial + Network.Haskoin.Transaction.Segwit Network.Haskoin.Util other-modules: Network.Haskoin.Block.Common @@ -76,6 +77,7 @@ Network.Haskoin.Test.Transaction Network.Haskoin.Test.Util Network.Haskoin.Transaction.Builder + Network.Haskoin.Transaction.Builder.Sign Network.Haskoin.Transaction.Common Paths_haskoin_core hs-source-dirs: @@ -102,7 +104,7 @@ , network , safe , scientific - , secp256k1-haskell >=0.1.8 + , secp256k1-haskell >=0.2.1 , split , string-conversions , text diff --git a/src/Haskoin.hs b/src/Haskoin.hs --- a/src/Haskoin.hs +++ b/src/Haskoin.hs @@ -3,7 +3,7 @@ Description : Bitcoin (BTC/BCH) Libraries for Haskell Copyright : No rights reserved License : UNLICENSE -Maintainer : xenog@protonmail.com +Maintainer : jprupp@protonmail.ch Stability : experimental Portability : POSIX diff --git a/src/Network/Haskoin/Address.hs b/src/Network/Haskoin/Address.hs --- a/src/Network/Haskoin/Address.hs +++ b/src/Network/Haskoin/Address.hs @@ -6,7 +6,7 @@ Module : Network.Haskoin.Address Copyright : No rights reserved License : UNLICENSE -Maintainer : xenog@protonmail.com +Maintainer : jprupp@protonmail.ch Stability : experimental Portability : POSIX diff --git a/src/Network/Haskoin/Address/Base58.hs b/src/Network/Haskoin/Address/Base58.hs --- a/src/Network/Haskoin/Address/Base58.hs +++ b/src/Network/Haskoin/Address/Base58.hs @@ -3,7 +3,7 @@ Module : Network.Haskoin.Address.Base58 Copyright : No rights reserved License : UNLICENSE -Maintainer : xenog@protonmail.com +Maintainer : jprupp@protonmail.ch Stability : experimental Portability : POSIX diff --git a/src/Network/Haskoin/Address/Bech32.hs b/src/Network/Haskoin/Address/Bech32.hs --- a/src/Network/Haskoin/Address/Bech32.hs +++ b/src/Network/Haskoin/Address/Bech32.hs @@ -3,7 +3,7 @@ Module : Network.Haskoin.Address.Base58 Copyright : No rights reserved License : UNLICENSE -Maintainer : xenog@protonmail.com +Maintainer : jprupp@protonmail.ch Stability : experimental Portability : POSIX diff --git a/src/Network/Haskoin/Address/CashAddr.hs b/src/Network/Haskoin/Address/CashAddr.hs --- a/src/Network/Haskoin/Address/CashAddr.hs +++ b/src/Network/Haskoin/Address/CashAddr.hs @@ -3,7 +3,7 @@ Module : Network.Haskoin.Address.CashAddr Copyright : No rights reserved License : UNLICENSE -Maintainer : xenog@protonmail.com +Maintainer : jprupp@protonmail.ch Stability : experimental Portability : POSIX diff --git a/src/Network/Haskoin/Block.hs b/src/Network/Haskoin/Block.hs --- a/src/Network/Haskoin/Block.hs +++ b/src/Network/Haskoin/Block.hs @@ -2,7 +2,7 @@ Module : Network.Haskoin.Block Copyright : No rights reserved License : UNLICENSE -Maintainer : xenog@protonmail.com +Maintainer : jprupp@protonmail.ch Stability : experimental Portability : POSIX diff --git a/src/Network/Haskoin/Block/Common.hs b/src/Network/Haskoin/Block/Common.hs --- a/src/Network/Haskoin/Block/Common.hs +++ b/src/Network/Haskoin/Block/Common.hs @@ -4,7 +4,7 @@ Module : Network.Haskoin.Block.Common Copyright : No rights reserved License : UNLICENSE -Maintainer : xenog@protonmail.com +Maintainer : jprupp@protonmail.ch Stability : experimental Portability : POSIX diff --git a/src/Network/Haskoin/Block/Headers.hs b/src/Network/Haskoin/Block/Headers.hs --- a/src/Network/Haskoin/Block/Headers.hs +++ b/src/Network/Haskoin/Block/Headers.hs @@ -8,7 +8,7 @@ Module : Network.Haskoin.Block.Headers Copyright : No rights reserved License : UNLICENSE -Maintainer : xenog@protonmail.com +Maintainer : jprupp@protonmail.ch Stability : experimental Portability : POSIX diff --git a/src/Network/Haskoin/Block/Merkle.hs b/src/Network/Haskoin/Block/Merkle.hs --- a/src/Network/Haskoin/Block/Merkle.hs +++ b/src/Network/Haskoin/Block/Merkle.hs @@ -4,7 +4,7 @@ Module : Network.Haskoin.Block.Merkle Copyright : No rights reserved License : UNLICENSE -Maintainer : xenog@protonmail.com +Maintainer : jprupp@protonmail.ch Stability : experimental Portability : POSIX diff --git a/src/Network/Haskoin/Constants.hs b/src/Network/Haskoin/Constants.hs --- a/src/Network/Haskoin/Constants.hs +++ b/src/Network/Haskoin/Constants.hs @@ -5,7 +5,7 @@ Module : Network.Haskoin.Constants Copyright : No rights reserved License : UNLICENSE -Maintainer : xenog@protonmail.com +Maintainer : jprupp@protonmail.ch Stability : experimental Portability : POSIX diff --git a/src/Network/Haskoin/Crypto.hs b/src/Network/Haskoin/Crypto.hs --- a/src/Network/Haskoin/Crypto.hs +++ b/src/Network/Haskoin/Crypto.hs @@ -2,7 +2,7 @@ Module : Network.Haskoin.Crypto Copyright : No rights reserved License : UNLICENSE -Maintainer : xenog@protonmail.com +Maintainer : jprupp@protonmail.ch Stability : experimental Portability : POSIX diff --git a/src/Network/Haskoin/Crypto/Hash.hs b/src/Network/Haskoin/Crypto/Hash.hs --- a/src/Network/Haskoin/Crypto/Hash.hs +++ b/src/Network/Haskoin/Crypto/Hash.hs @@ -4,7 +4,7 @@ Module : Network.Haskoin.Crypto.Hash Copyright : No rights reserved License : UNLICENSE -Maintainer : xenog@protonmail.com +Maintainer : jprupp@protonmail.ch Stability : experimental Portability : POSIX @@ -168,7 +168,7 @@ -- | Computes a 32 bit checksum. checkSum32 :: ByteArrayAccess b => b -> CheckSum32 -checkSum32 = fromRight (error "Colud not decode bytes as CheckSum32") +checkSum32 = fromRight (error "Could not decode bytes as CheckSum32") . decode . BS.take 4 . BA.convert diff --git a/src/Network/Haskoin/Crypto/Signature.hs b/src/Network/Haskoin/Crypto/Signature.hs --- a/src/Network/Haskoin/Crypto/Signature.hs +++ b/src/Network/Haskoin/Crypto/Signature.hs @@ -3,7 +3,7 @@ Module : Network.Haskoin.Crypto.Signature Copyright : No rights reserved License : UNLICENSE -Maintainer : xenog@protonmail.com +Maintainer : jprupp@protonmail.ch Stability : experimental Portability : POSIX diff --git a/src/Network/Haskoin/Keys.hs b/src/Network/Haskoin/Keys.hs --- a/src/Network/Haskoin/Keys.hs +++ b/src/Network/Haskoin/Keys.hs @@ -2,7 +2,7 @@ Module : Network.Haskoin.Keys Copyright : No rights reserved License : UNLICENSE -Maintainer : xenog@protonmail.com +Maintainer : jprupp@protonmail.ch Stability : experimental Portability : POSIX diff --git a/src/Network/Haskoin/Keys/Common.hs b/src/Network/Haskoin/Keys/Common.hs --- a/src/Network/Haskoin/Keys/Common.hs +++ b/src/Network/Haskoin/Keys/Common.hs @@ -7,7 +7,7 @@ Module : Network.Haskoin.Keys.Common Copyright : No rights reserved License : UNLICENSE -Maintainer : xenog@protonmail.com +Maintainer : jprupp@protonmail.ch Stability : experimental Portability : POSIX diff --git a/src/Network/Haskoin/Keys/Extended.hs b/src/Network/Haskoin/Keys/Extended.hs --- a/src/Network/Haskoin/Keys/Extended.hs +++ b/src/Network/Haskoin/Keys/Extended.hs @@ -7,7 +7,7 @@ Module : Network.Haskoin.Keys.Extended Copyright : No rights reserved License : UNLICENSE -Maintainer : xenog@protonmail.com +Maintainer : jprupp@protonmail.ch Stability : experimental Portability : POSIX diff --git a/src/Network/Haskoin/Keys/Mnemonic.hs b/src/Network/Haskoin/Keys/Mnemonic.hs --- a/src/Network/Haskoin/Keys/Mnemonic.hs +++ b/src/Network/Haskoin/Keys/Mnemonic.hs @@ -3,7 +3,7 @@ Module : Network.Haskoin.Keys.Mnemonic Copyright : No rights reserved License : UNLICENSE -Maintainer : xenog@protonmail.com +Maintainer : jprupp@protonmail.ch Stability : experimental Portability : POSIX diff --git a/src/Network/Haskoin/Network.hs b/src/Network/Haskoin/Network.hs --- a/src/Network/Haskoin/Network.hs +++ b/src/Network/Haskoin/Network.hs @@ -2,7 +2,7 @@ Module : Network.Haskoin.Network Copyright : No rights reserved License : UNLICENSE -Maintainer : xenog@protonmail.com +Maintainer : jprupp@protonmail.ch Stability : experimental Portability : POSIX diff --git a/src/Network/Haskoin/Network/Bloom.hs b/src/Network/Haskoin/Network/Bloom.hs --- a/src/Network/Haskoin/Network/Bloom.hs +++ b/src/Network/Haskoin/Network/Bloom.hs @@ -4,7 +4,7 @@ Module : Network.Haskoin.Network.Bloom Copyright : No rights reserved License : UNLICENSE -Maintainer : xenog@protonmail.com +Maintainer : jprupp@protonmail.ch Stability : experimental Portability : POSIX diff --git a/src/Network/Haskoin/Network/Common.hs b/src/Network/Haskoin/Network/Common.hs --- a/src/Network/Haskoin/Network/Common.hs +++ b/src/Network/Haskoin/Network/Common.hs @@ -6,7 +6,7 @@ Module : Network.Haskoin.Network.Common Copyright : No rights reserved License : UNLICENSE -Maintainer : xenog@protonmail.com +Maintainer : jprupp@protonmail.ch Stability : experimental Portability : POSIX diff --git a/src/Network/Haskoin/Network/Message.hs b/src/Network/Haskoin/Network/Message.hs --- a/src/Network/Haskoin/Network/Message.hs +++ b/src/Network/Haskoin/Network/Message.hs @@ -4,7 +4,7 @@ Module : Network.Haskoin.Network.Message Copyright : No rights reserved License : UNLICENSE -Maintainer : xenog@protonmail.com +Maintainer : jprupp@protonmail.ch Stability : experimental Portability : POSIX diff --git a/src/Network/Haskoin/Script.hs b/src/Network/Haskoin/Script.hs --- a/src/Network/Haskoin/Script.hs +++ b/src/Network/Haskoin/Script.hs @@ -2,7 +2,7 @@ Module : Network.Haskoin.Script Copyright : No rights reserved License : UNLICENSE -Maintainer : xenog@protonmail.com +Maintainer : jprupp@protonmail.ch Stability : experimental Portability : POSIX diff --git a/src/Network/Haskoin/Script/Common.hs b/src/Network/Haskoin/Script/Common.hs --- a/src/Network/Haskoin/Script/Common.hs +++ b/src/Network/Haskoin/Script/Common.hs @@ -5,7 +5,7 @@ Module : Network.Haskoin.Script.Common Copyright : No rights reserved License : UNLICENSE -Maintainer : xenog@protonmail.com +Maintainer : jprupp@protonmail.ch Stability : experimental Portability : POSIX diff --git a/src/Network/Haskoin/Script/SigHash.hs b/src/Network/Haskoin/Script/SigHash.hs --- a/src/Network/Haskoin/Script/SigHash.hs +++ b/src/Network/Haskoin/Script/SigHash.hs @@ -5,7 +5,7 @@ Module : Network.Haskoin.Script.SigHash Copyright : No rights reserved License : UNLICENSE -Maintainer : xenog@protonmail.com +Maintainer : jprupp@protonmail.ch Stability : experimental Portability : POSIX @@ -192,7 +192,7 @@ -- | Computes the hash that will be used for signing a transaction. txSigHash :: Network -> Tx -- ^ transaction to sign - -> Script -- ^ csript from output being spent + -> Script -- ^ script from output being spent -> Word64 -- ^ value of output being spent -> Int -- ^ index of input being signed -> SigHash -- ^ what to sign @@ -306,6 +306,7 @@ -- | Deserialize a 'TxSignature'. decodeTxSig :: Network -> ByteString -> Either String TxSignature +decodeTxSig _ bs | BS.null bs = Left "Empty signature candidate" decodeTxSig net bs = case decodeStrictSig $ BS.init bs of Just sig -> do diff --git a/src/Network/Haskoin/Script/Standard.hs b/src/Network/Haskoin/Script/Standard.hs --- a/src/Network/Haskoin/Script/Standard.hs +++ b/src/Network/Haskoin/Script/Standard.hs @@ -5,7 +5,7 @@ Module : Network.Haskoin.Script.Standard Copyright : No rights reserved License : UNLICENSE -Maintainer : xenog@protonmail.com +Maintainer : jprupp@protonmail.ch Stability : experimental Portability : POSIX @@ -97,7 +97,7 @@ -- ^ get wrapped simple input } | ScriptHashInput - { getScriptHashInput :: !SimpleInput + { getScriptHashInput :: !SimpleInput -- ^ get simple input associated with redeem script , getScriptHashRedeem :: !RedeemScript -- ^ redeem script diff --git a/src/Network/Haskoin/Test.hs b/src/Network/Haskoin/Test.hs --- a/src/Network/Haskoin/Test.hs +++ b/src/Network/Haskoin/Test.hs @@ -2,7 +2,7 @@ Module : Network.Haskoin.Test Copyright : No rights reserved License : UNLICENSE -Maintainer : xenog@protonmail.com +Maintainer : jprupp@protonmail.ch Stability : experimental Portability : POSIX diff --git a/src/Network/Haskoin/Test/Address.hs b/src/Network/Haskoin/Test/Address.hs --- a/src/Network/Haskoin/Test/Address.hs +++ b/src/Network/Haskoin/Test/Address.hs @@ -2,7 +2,7 @@ Module : Network.Haskoin.Test.Address Copyright : No rights reserved License : UNLICENSE -Maintainer : xenog@protonmail.com +Maintainer : jprupp@protonmail.ch Stability : experimental Portability : POSIX -} diff --git a/src/Network/Haskoin/Test/Block.hs b/src/Network/Haskoin/Test/Block.hs --- a/src/Network/Haskoin/Test/Block.hs +++ b/src/Network/Haskoin/Test/Block.hs @@ -2,7 +2,7 @@ Module : Network.Haskoin.Test.Block Copyright : No rights reserved License : UNLICENSE -Maintainer : xenog@protonmail.com +Maintainer : jprupp@protonmail.ch Stability : experimental Portability : POSIX -} diff --git a/src/Network/Haskoin/Test/Crypto.hs b/src/Network/Haskoin/Test/Crypto.hs --- a/src/Network/Haskoin/Test/Crypto.hs +++ b/src/Network/Haskoin/Test/Crypto.hs @@ -2,7 +2,7 @@ Module : Network.Haskoin.Test.Crypto Copyright : No rights reserved License : UNLICENSE -Maintainer : xenog@protonmail.com +Maintainer : jprupp@protonmail.ch Stability : experimental Portability : POSIX -} diff --git a/src/Network/Haskoin/Test/Keys.hs b/src/Network/Haskoin/Test/Keys.hs --- a/src/Network/Haskoin/Test/Keys.hs +++ b/src/Network/Haskoin/Test/Keys.hs @@ -2,7 +2,7 @@ Module : Network.Haskoin.Test.Keys Copyright : No rights reserved License : UNLICENSE -Maintainer : xenog@protonmail.com +Maintainer : jprupp@protonmail.ch Stability : experimental Portability : POSIX -} diff --git a/src/Network/Haskoin/Test/Message.hs b/src/Network/Haskoin/Test/Message.hs --- a/src/Network/Haskoin/Test/Message.hs +++ b/src/Network/Haskoin/Test/Message.hs @@ -2,7 +2,7 @@ Module : Network.Haskoin.Test.Message Copyright : No rights reserved License : UNLICENSE -Maintainer : xenog@protonmail.com +Maintainer : jprupp@protonmail.ch Stability : experimental Portability : POSIX -} diff --git a/src/Network/Haskoin/Test/Network.hs b/src/Network/Haskoin/Test/Network.hs --- a/src/Network/Haskoin/Test/Network.hs +++ b/src/Network/Haskoin/Test/Network.hs @@ -2,7 +2,7 @@ Module : Network.Haskoin.Test.Network Copyright : No rights reserved License : UNLICENSE -Maintainer : xenog@protonmail.com +Maintainer : jprupp@protonmail.ch Stability : experimental Portability : POSIX -} diff --git a/src/Network/Haskoin/Test/Script.hs b/src/Network/Haskoin/Test/Script.hs --- a/src/Network/Haskoin/Test/Script.hs +++ b/src/Network/Haskoin/Test/Script.hs @@ -3,7 +3,7 @@ Module : Network.Haskoin.Test.Script Copyright : No rights reserved License : UNLICENSE -Maintainer : xenog@protonmail.com +Maintainer : jprupp@protonmail.ch Stability : experimental Portability : POSIX -} diff --git a/src/Network/Haskoin/Test/Transaction.hs b/src/Network/Haskoin/Test/Transaction.hs --- a/src/Network/Haskoin/Test/Transaction.hs +++ b/src/Network/Haskoin/Test/Transaction.hs @@ -2,11 +2,12 @@ Module : Network.Haskoin.Test.Transaction Copyright : No rights reserved License : UNLICENSE -Maintainer : xenog@protonmail.com +Maintainer : jprupp@protonmail.ch Stability : experimental Portability : POSIX -} module Network.Haskoin.Test.Transaction where + import Control.Monad import qualified Data.ByteString as BS import Data.Either (fromRight) @@ -79,7 +80,7 @@ then 2 else 0 , 5 -- avoid witness case - ) + ) inps <- vectorOf ni (arbitraryTxIn net) outs <- vectorOf no (arbitraryTxOut net) let uniqueInps = nubBy (\a b -> prevOutput a == prevOutput b) inps @@ -132,10 +133,12 @@ arbitrarySigInput :: Network -> Gen (SigInput, [SecKeyI]) arbitrarySigInput net = oneof - [ arbitraryPKSigInput net >>= \(si, k) -> return (si, [k]) - , arbitraryPKHashSigInput net >>= \(si, k) -> return (si, [k]) + [ wrapKey <$> arbitraryPKSigInput net + , wrapKey <$> arbitraryPKHashSigInput net , arbitraryMSSigInput net , arbitrarySHSigInput net + , wrapKey <$> arbitraryWPKHSigInput net + , arbitraryWSHSigInput net ] -- | Arbitrary 'SigInput' with a 'ScriptOutput' of type 'PayPK'. @@ -179,15 +182,30 @@ arbitrarySHSigInput :: Network -> Gen (SigInput, [SecKeyI]) arbitrarySHSigInput net = do (SigInput rdm val op sh _, ks) <- oneof - [ f <$> arbitraryPKSigInput net - , f <$> arbitraryPKHashSigInput net + [ wrapKey <$> arbitraryPKSigInput net + , wrapKey <$> arbitraryPKHashSigInput net , arbitraryMSSigInput net ] let out = PayScriptHash $ getAddrHash160 $ payToScriptAddress rdm return (SigInput out val op sh $ Just rdm, ks) - where - f (si, k) = (si, [k]) +arbitraryWPKHSigInput :: Network -> Gen (SigInput, SecKeyI) +arbitraryWPKHSigInput net = do + (k, p) <- arbitraryKeyPair + (val, op, sh) <- arbitraryInputStuff net + let out = PayWitnessPKHash . getAddrHash160 $ pubKeyAddr p + return (SigInput out val op sh Nothing, k) + +arbitraryWSHSigInput :: Network -> Gen (SigInput, [SecKeyI]) +arbitraryWSHSigInput net = do + (SigInput rdm val op sh _, ks) <- oneof + [ wrapKey <$> arbitraryPKSigInput net + , wrapKey <$> arbitraryPKHashSigInput net + , arbitraryMSSigInput net + ] + let out = PayWitnessScriptHash . getAddrHash256 $ payToWitnessScriptAddress rdm + return (SigInput out val op sh $ Just rdm, ks) + -- | Arbitrary 'Tx' (empty 'TxIn'), 'SigInputs' and private keys that can be -- passed to 'signTx' or 'detSignTx' to fully sign the 'Tx'. arbitrarySigningData :: Network -> Gen (Tx, [SigInput], [SecKeyI]) @@ -232,7 +250,7 @@ singleSig so val rdmM tx op prv = do sh <- arbitraryValidSigHash net let sigi = SigInput so val op sh rdmM - return . fromRight (error "Colud not decode transaction") $ + return . fromRight (error "Could not decode transaction") $ signTx net tx [sigi] [prv] arbitraryData = do (m, n) <- arbitraryMSParam @@ -252,3 +270,6 @@ , m , n) ] + +wrapKey :: (SigInput, SecKeyI) -> (SigInput, [SecKeyI]) +wrapKey (s, k) = (s, [k]) diff --git a/src/Network/Haskoin/Test/Util.hs b/src/Network/Haskoin/Test/Util.hs --- a/src/Network/Haskoin/Test/Util.hs +++ b/src/Network/Haskoin/Test/Util.hs @@ -2,7 +2,7 @@ Module : Network.Haskoin.Test.Util Copyright : No rights reserved License : UNLICENSE -Maintainer : xenog@protonmail.com +Maintainer : jprupp@protonmail.ch Stability : experimental Portability : POSIX -} diff --git a/src/Network/Haskoin/Transaction.hs b/src/Network/Haskoin/Transaction.hs --- a/src/Network/Haskoin/Transaction.hs +++ b/src/Network/Haskoin/Transaction.hs @@ -2,7 +2,7 @@ Module : Network.Haskoin.Transaction Copyright : No rights reserved License : UNLICENSE -Maintainer : xenog@protonmail.com +Maintainer : jprupp@protonmail.ch Stability : experimental Portability : POSIX diff --git a/src/Network/Haskoin/Transaction/Builder.hs b/src/Network/Haskoin/Transaction/Builder.hs --- a/src/Network/Haskoin/Transaction/Builder.hs +++ b/src/Network/Haskoin/Transaction/Builder.hs @@ -1,12 +1,10 @@ -{-# LANGUAGE DeriveAnyClass #-} -{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-| Module : Network.Haskoin.Transaction.Builder Copyright : No rights reserved License : UNLICENSE -Maintainer : xenog@protonmail.com +Maintainer : jprupp@protonmail.ch Stability : experimental Portability : POSIX @@ -20,8 +18,10 @@ , buildInput , SigInput(..) , signTx + , signNestedWitnessTx , makeSignature , signInput + , signNestedInput , verifyStdTx , mergeTxs , sigKeys @@ -42,36 +42,41 @@ , guessMSSize ) where -import Control.Arrow (first) -import Control.DeepSeq -import Control.Monad (foldM, mzero, unless, when) -import Control.Monad.Identity (runIdentity) +import Control.Applicative ((<|>)) +import Control.Arrow (first) +import Control.Monad (foldM, unless) +import Control.Monad.Identity (runIdentity) import Crypto.Secp256k1 -import Data.Aeson (FromJSON, ToJSON, - Value (Object), object, - parseJSON, toJSON, (.:), - (.:?), (.=)) -import qualified Data.ByteString as B -import Data.Conduit (ConduitT, Void, await, - runConduit, (.|)) -import Data.Conduit.List (sourceList) -import Data.Hashable -import Data.List (find, nub) -import Data.Maybe (catMaybes, fromJust, - fromMaybe, isJust, - mapMaybe, maybeToList) -import Data.Serialize (encode) -import Data.String.Conversions (cs) -import Data.Text (Text) -import Data.Word (Word64) -import GHC.Generics +import qualified Data.ByteString as B +import Data.Conduit (ConduitT, Void, + await, runConduit, + (.|)) +import Data.Conduit.List (sourceList) +import Data.Either (fromRight) +import Data.List (nub) +import Data.Maybe (catMaybes, fromJust, + isJust) +import Data.Serialize (decode, encode) +import Data.String.Conversions (cs) +import Data.Text (Text) +import Data.Word (Word64) import Network.Haskoin.Address import Network.Haskoin.Constants +import Network.Haskoin.Crypto.Hash (Hash256, addressHash) import Network.Haskoin.Crypto.Signature import Network.Haskoin.Keys.Common import Network.Haskoin.Network.Common import Network.Haskoin.Script +import Network.Haskoin.Transaction.Builder.Sign (SigInput (..), + buildInput, + makeSigHash, + makeSignature, + sigKeys) +import qualified Network.Haskoin.Transaction.Builder.Sign as S import Network.Haskoin.Transaction.Common +import Network.Haskoin.Transaction.Segwit (decodeWitnessInput, + isSegwit, + viewWitnessProgram) import Network.Haskoin.Util -- | Any type can be used as a Coin if it can provide a value in Satoshi. @@ -268,149 +273,59 @@ | otherwise = Left $ "buildTx: Invalid amount " ++ show v --- | Data type used to specify the signing parameters of a transaction input. --- To sign an input, the previous output script, outpoint and sighash are --- required. When signing a pay to script hash output, an additional redeem --- script is required. -data SigInput = SigInput - { sigInputScript :: !ScriptOutput -- ^ output script to spend - , sigInputValue :: !Word64 -- ^ output script value - , sigInputOP :: !OutPoint -- ^ outpoint to spend - , sigInputSH :: !SigHash -- ^ signature type - , sigInputRedeem :: !(Maybe RedeemScript) -- ^ redeem script - } deriving (Eq, Show, Read, Generic, Hashable, NFData) - -instance ToJSON SigInput where - toJSON (SigInput so val op sh rdm) = object $ - [ "pkscript" .= so - , "value" .= val - , "outpoint" .= op - , "sighash" .= sh - ] ++ [ "redeem" .= r | r <- maybeToList rdm ] - -instance FromJSON SigInput where - parseJSON (Object o) = do - so <- o .: "pkscript" - val <- o .: "value" - op <- o .: "outpoint" - sh <- o .: "sighash" - rdm <- o .:? "redeem" - return $ SigInput so val op sh rdm - parseJSON _ = mzero - --- | Sign a transaction by providing the 'SigInput' signing parametres and a +-- | Sign a transaction by providing the 'SigInput' signing parameters and a -- list of private keys. The signature is computed deterministically as defined -- in RFC-6979. +-- +-- Example: P2SH-P2WKH +-- +-- > sigIn = SigInput (PayWitnessPKHash h) 100000 op sigHashAll Nothing +-- > signedTx = signTx btc unsignedTx [sigIn] [key] +-- +-- Example: P2SH-P2WSH multisig +-- +-- > sigIn = SigInput (PayWitnessScriptHash h) 100000 op sigHashAll (Just $ PayMulSig [p1,p2,p3] 2) +-- > signedTx = signTx btc unsignedTx [sigIn] [k1,k3] signTx :: Network -> Tx -- ^ transaction to sign -> [SigInput] -- ^ signing parameters - -> [SecKey] -- ^ private keys to sign with + -> [SecKey] -- ^ private keys to sign with -> Either String Tx -- ^ signed transaction -signTx net otx sigis allKeys - | null ti = Left "signTx: Transaction has no inputs" - | otherwise = foldM go otx $ findSigInput sigis ti - where - ti = txIn otx - go tx (sigi@(SigInput so _ _ _ rdmM), i) = do - keys <- sigKeys so rdmM allKeys - foldM (\t k -> signInput net t i sigi k) tx keys +signTx net tx si = S.signTx net tx $ notNested <$> si + where notNested s = (s, False) --- | Produce a structured representation of a deterministic (RFC-6979) signature over an input. -makeSignature :: Network -> Tx -> Int -> SigInput -> SecKeyI -> TxSignature -makeSignature net tx i (SigInput so val _ sh rdmM) key = - TxSignature (signHash (secKeyData key) m) sh +-- | This function differs from 'signTx' by assuming all segwit inputs are +-- P2SH-nested. Use the same signing parameters for segwit inputs as in 'signTx'. +signNestedWitnessTx :: Network + -> Tx -- ^ transaction to sign + -> [SigInput] -- ^ signing parameters + -> [SecKey] -- ^ private keys to sign with + -> Either String Tx -- ^ signed transaction +signNestedWitnessTx net tx si = S.signTx net tx $ nested <$> si where - m = txSigHash net tx (encodeOutput $ fromMaybe so rdmM) val i sh + -- NOTE: the nesting flag is ignored for non-segwit inputs + nested s = (s, True) + -- | Sign a single input in a transaction deterministically (RFC-6979). signInput :: Network -> Tx -> Int -> SigInput -> SecKeyI -> Either String Tx -signInput net tx i sigIn@(SigInput so val _ sh rdmM) key = do - let sig = makeSignature net tx i sigIn key - si <- buildInput net tx i so val rdmM sig $ derivePubKeyI key - let ins = updateIndex i (txIn tx) (f si) - return $ Tx (txVersion tx) ins (txOut tx) [] (txLockTime tx) - where - f si x = x {scriptInput = encodeInputBS si} +signInput net tx i si = S.signInput net tx i (si, False) +-- | Like 'signInput' but treat segwit inputs as nested +signNestedInput :: Network -> Tx -> Int -> SigInput -> SecKeyI -> Either String Tx +signNestedInput net tx i si = S.signInput net tx i (si, True) + -- | Order the 'SigInput' with respect to the transaction inputs. This allows -- the user to provide the 'SigInput' in any order. Users can also provide only -- a partial set of 'SigInput' entries. findSigInput :: [SigInput] -> [TxIn] -> [(SigInput, Int)] -findSigInput si ti = - mapMaybe g $ zip (matchTemplate si ti f) [0..] - where - f s txin = sigInputOP s == prevOutput txin - g (Just s, i) = Just (s,i) - g (Nothing, _) = Nothing - --- | Find from the list of provided private keys which one is required to sign --- the 'ScriptOutput'. -sigKeys :: - ScriptOutput - -> Maybe RedeemScript - -> [SecKey] - -> Either String [SecKeyI] -sigKeys so rdmM keys = - case (so, rdmM) of - (PayPK p, Nothing) -> - return . map fst . maybeToList $ find ((== p) . snd) zipKeys - (PayPKHash h, Nothing) -> - return . map fst . maybeToList $ - find ((== h) . getAddrHash160 . pubKeyAddr . snd) zipKeys - (PayMulSig ps r, Nothing) -> - return $ map fst $ take r $ filter ((`elem` ps) . snd) zipKeys - (PayScriptHash _, Just rdm) -> sigKeys rdm Nothing keys - _ -> Left "sigKeys: Could not decode output script" - where - zipKeys = - [ (prv, pub) - | k <- keys - , t <- [True, False] - , let prv = wrapSecKey t k - , let pub = derivePubKeyI prv - ] - --- | Construct an input for a transaction given a signature, public key and data --- about the previous output. -buildInput :: - Network - -> Tx -- ^ transaction where input will be added - -> Int -- ^ input index where signature will go - -> ScriptOutput -- ^ output script being spent - -> Word64 -- ^ amount of previous output - -> Maybe RedeemScript -- ^ redeem script if pay-to-script-hash - -> TxSignature - -> PubKeyI - -> Either String ScriptInput -buildInput net tx i so val rdmM sig pub = do - when (i >= length (txIn tx)) $ Left "buildInput: Invalid input index" - case (so, rdmM) of - (PayPK _, Nothing) -> return $ RegularInput $ SpendPK sig - (PayPKHash _, Nothing) -> return $ RegularInput $ SpendPKHash sig pub - (PayMulSig msPubs r, Nothing) -> do - let mSigs = take r $ catMaybes $ matchTemplate allSigs msPubs f - return $ RegularInput $ SpendMulSig mSigs - (PayScriptHash _, Just rdm) -> do - inp <- buildInput net tx i rdm val Nothing sig pub - return $ ScriptHashInput (getRegularInput inp) rdm - _ -> Left "buildInput: Invalid output/redeem script combination" - where - scp = scriptInput $ txIn tx !! i - allSigs = - nub $ - sig : - case decodeInputBS net scp of - Right (ScriptHashInput (SpendMulSig xs) _) -> xs - Right (RegularInput (SpendMulSig xs)) -> xs - _ -> [] - out = encodeOutput so - f (TxSignature x sh) p = - verifyHashSig (txSigHash net tx out val i sh) x (pubKeyPoint p) - f TxSignatureEmpty _ = False +findSigInput = S.findInputIndex sigInputOP {- Merge multisig transactions -} --- | Merge partially-signed multisig transactions. +-- | Merge partially-signed multisig transactions. This function does not +-- support segwit and P2SH-segwit inputs. Use PSBTs to merge transactions with +-- segwit inputs. mergeTxs :: Network -> [Tx] -> [(ScriptOutput, Word64, OutPoint)] -> Either String Tx mergeTxs net txs os | null txs = Left "Transaction list is empty" @@ -426,7 +341,8 @@ clearInput tx (_, i) = Tx (txVersion tx) (ins (txIn tx) i) (txOut tx) [] (txLockTime tx) --- | Merge input from partially-signed multisig transactions. +-- | Merge input from partially-signed multisig transactions. This function +-- does not support segwit and P2SH-segwit inputs. mergeTxInput :: Network -> [Tx] @@ -484,44 +400,57 @@ -- | Verify if a transaction input is valid and standard. verifyStdInput :: Network -> Tx -> Int -> ScriptOutput -> Word64 -> Bool -verifyStdInput net tx i = go (scriptInput $ txIn tx !! i) +verifyStdInput net tx i so0 val + | isSegwit so0 = fromRight False $ (inp == mempty &&) . verifySegwitInput so0 <$> wp so0 + | otherwise = fromRight False + $ verifyLegacyInput so0 <$> decodeInputBS net inp + <|> (nestedScriptOutput >>= \so -> verifyNestedInput so0 so <$> wp so) where - dec = decodeInputBS net - go inp so val = - case dec inp of - Right (RegularInput (SpendPK (TxSignature sig sh))) -> - case so of - PayPK pub -> - verifyHashSig - (txSigHash net tx out val i sh) - sig - (pubKeyPoint pub) - _ -> False - Right (RegularInput (SpendPKHash (TxSignature sig sh) pub)) -> - case so of - PayPKHash h -> - pubKeyAddr pub == p2pkhAddr h && - verifyHashSig - (txSigHash net tx out val i sh) - sig - (pubKeyPoint pub) - _ -> False - Right (RegularInput (SpendMulSig sigs)) -> - case so of - PayMulSig pubs r -> - countMulSig net tx out val i (map pubKeyPoint pubs) sigs == - r - _ -> False - Right (ScriptHashInput si rdm) -> - case so of - PayScriptHash h -> - payToScriptAddress rdm == p2shAddr h && - go (encodeInputBS $ RegularInput si) rdm val - _ -> False - _ -> False - where - out = encodeOutput so + verifyLegacyInput so si = case (so, si) of + (PayPK pub, RegularInput (SpendPK (TxSignature sig sh))) -> + verifyHashSig (theTxSigHash so sh Nothing) sig (pubKeyPoint pub) + (PayPKHash h, RegularInput (SpendPKHash (TxSignature sig sh) pub)) -> + pubKeyAddr pub == p2pkhAddr h && + verifyHashSig (theTxSigHash so sh Nothing) sig (pubKeyPoint pub) + (PayMulSig pubs r, RegularInput (SpendMulSig sigs)) -> + countMulSig net tx out val i (pubKeyPoint <$> pubs) sigs == r + (PayScriptHash h, ScriptHashInput si' rdm) -> + payToScriptAddress rdm == p2shAddr h && verifyLegacyInput rdm (RegularInput si') + _ -> False + where out = encodeOutput so + verifySegwitInput so (rdm, si) = case (so, rdm, si) of + (PayWitnessPKHash h, Nothing, SpendPKHash (TxSignature sig sh) pub) -> + pubKeyWitnessAddr pub == p2wpkhAddr h && + verifyHashSig (theTxSigHash so sh Nothing) sig (pubKeyPoint pub) + (PayWitnessScriptHash h, Just rdm@(PayPK pub), SpendPK (TxSignature sig sh)) -> + payToWitnessScriptAddress rdm == p2wshAddr h && + verifyHashSig (theTxSigHash so sh $ Just rdm) sig (pubKeyPoint pub) + (PayWitnessScriptHash h, Just rdm@(PayPKHash kh), SpendPKHash (TxSignature sig sh) pub) -> + payToWitnessScriptAddress rdm == p2wshAddr h && + addressHash (encode pub) == kh && + verifyHashSig (theTxSigHash so sh $ Just rdm) sig (pubKeyPoint pub) + (PayWitnessScriptHash h, Just rdm@(PayMulSig pubs r), SpendMulSig sigs) -> + payToWitnessScriptAddress rdm == p2wshAddr h && + countMulSig' (\sh -> theTxSigHash so sh $ Just rdm) (pubKeyPoint <$> pubs) sigs == r + _ -> False + where out = encodeOutput so + + verifyNestedInput so so' x = case so of + PayScriptHash h -> payToScriptAddress so' == p2shAddr h && verifySegwitInput so' x + _ -> False + + inp = scriptInput $ txIn tx !! i + theTxSigHash so = makeSigHash net tx i so val + + ws | length (txWitness tx) > i = txWitness tx !! i + | otherwise = [] + wp so = decodeWitnessInput net =<< viewWitnessProgram net so ws + + nestedScriptOutput = scriptOps <$> decode inp >>= \case + [OP_PUSHDATA bs _] -> decodeOutputBS bs + _ -> Left "nestedScriptOutput: not a nested output" + -- | Count the number of valid signatures for a multi-signature transaction. countMulSig :: Network @@ -532,11 +461,14 @@ -> [PubKey] -> [TxSignature] -> Int -countMulSig _ _ _ _ _ [] _ = 0 -countMulSig _ _ _ _ _ _ [] = 0 -countMulSig net tx out val i (_:pubs) (TxSignatureEmpty:rest) = - countMulSig net tx out val i pubs rest -countMulSig net tx out val i (pub:pubs) sigs@(TxSignature sig sh:rest) - | verifyHashSig (txSigHash net tx out val i sh) sig pub = - 1 + countMulSig net tx out val i pubs rest - | otherwise = countMulSig net tx out val i pubs sigs +countMulSig net tx out val i = countMulSig' h + where + h = txSigHash net tx out val i + +countMulSig' :: (SigHash -> Hash256) -> [PubKey] -> [TxSignature] -> Int +countMulSig' h [] _ = 0 +countMulSig' h _ [] = 0 +countMulSig' h (_:pubs) (TxSignatureEmpty:sigs) = countMulSig' h pubs sigs +countMulSig' h (pub:pubs) sigs@(TxSignature sig sh : sigs') + | verifyHashSig (h sh) sig pub = 1 + countMulSig' h pubs sigs' + | otherwise = countMulSig' h pubs sigs diff --git a/src/Network/Haskoin/Transaction/Builder/Sign.hs b/src/Network/Haskoin/Transaction/Builder/Sign.hs new file mode 100644 --- /dev/null +++ b/src/Network/Haskoin/Transaction/Builder/Sign.hs @@ -0,0 +1,271 @@ +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} +{-| +Module : Network.Haskoin.Transaction.Builder.Sign +Copyright : No rights reserved +License : UNLICENSE +Maintainer : jprupp@protonmail.ch +Stability : experimental +Portability : POSIX + +Types and logic for signing transactions. +-} +module Network.Haskoin.Transaction.Builder.Sign + ( SigInput (..) + , makeSignature + , makeSigHash + , signTx + , findInputIndex + , signInput + , buildInput + , sigKeys + ) where + +import Control.DeepSeq (NFData) +import Control.Monad (foldM, mzero, when) +import Data.Aeson (FromJSON, ToJSON, + Value (Object), object, + parseJSON, toJSON, (.:), + (.:?), (.=)) +import Data.Either (rights) +import Data.Hashable (Hashable) +import Data.List (find, nub) +import Data.Maybe (catMaybes, fromMaybe, + mapMaybe, maybeToList) +import qualified Data.Serialize as S +import Data.Word (Word64) +import GHC.Generics (Generic) + +import Network.Haskoin.Address (getAddrHash160, pubKeyAddr) +import Network.Haskoin.Constants (Network) +import Network.Haskoin.Crypto (Hash256, SecKey) +import Network.Haskoin.Crypto.Signature (signHash, verifyHashSig) +import Network.Haskoin.Keys.Common (PubKeyI (..), SecKeyI (..), + derivePubKeyI, wrapSecKey) +import Network.Haskoin.Script.Common (ScriptOutput (..), + encodeOutput, + encodeOutputBS, opPushData) +import Network.Haskoin.Script.SigHash (SigHash, TxSignature (..), + decodeTxSig, txSigHash, + txSigHashForkId) +import Network.Haskoin.Script.Standard (RedeemScript, + ScriptInput (..), + SimpleInput (..), + decodeInputBS, + encodeInputBS) +import Network.Haskoin.Transaction.Common (OutPoint, Tx (..), + TxIn (..), WitnessData) +import Network.Haskoin.Transaction.Segwit (WitnessProgram (..), + calcWitnessProgram, + isSegwit, toWitnessStack) +import Network.Haskoin.Util (matchTemplate, updateIndex) + +-- | Data type used to specify the signing parameters of a transaction input. +-- To sign an input, the previous output script, outpoint and sighash are +-- required. When signing a pay to script hash output, an additional redeem +-- script is required. +data SigInput = SigInput + { sigInputScript :: !ScriptOutput -- ^ output script to spend + , sigInputValue :: !Word64 -- ^ output script value + , sigInputOP :: !OutPoint -- ^ outpoint to spend + , sigInputSH :: !SigHash -- ^ signature type + , sigInputRedeem :: !(Maybe RedeemScript) -- ^ redeem script + } deriving (Eq, Show, Read, Generic, Hashable, NFData) + +instance ToJSON SigInput where + toJSON (SigInput so val op sh rdm) = object $ + [ "pkscript" .= so + , "value" .= val + , "outpoint" .= op + , "sighash" .= sh + ] ++ [ "redeem" .= r | r <- maybeToList rdm ] + +instance FromJSON SigInput where + parseJSON (Object o) = do + so <- o .: "pkscript" + val <- o .: "value" + op <- o .: "outpoint" + sh <- o .: "sighash" + rdm <- o .:? "redeem" + return $ SigInput so val op sh rdm + parseJSON _ = mzero + +-- | Sign a transaction by providing the 'SigInput' signing parameters and a +-- list of private keys. The signature is computed deterministically as defined +-- in RFC-6979. +signTx :: Network + -> Tx -- ^ transaction to sign + -> [(SigInput, Bool)] -- ^ signing parameters, with nesting flag + -> [SecKey] -- ^ private keys to sign with + -> Either String Tx -- ^ signed transaction +signTx net otx sigis allKeys + | null ti = Left "signTx: Transaction has no inputs" + | otherwise = foldM go otx $ findInputIndex (sigInputOP . fst) sigis ti + where + ti = txIn otx + go tx (sigi@(SigInput so _ _ _ rdmM, _), i) = do + keys <- sigKeys so rdmM allKeys + foldM (\t k -> signInput net t i sigi k) tx keys + +-- | Sign a single input in a transaction deterministically (RFC-6979). The +-- nesting flag only affects the behavior of segwit inputs. +signInput :: + Network + -> Tx + -> Int + -> (SigInput, Bool) -- ^ boolean flag: nest input + -> SecKeyI + -> Either String Tx +signInput net tx i (sigIn@(SigInput so val _ sh rdmM), nest) key = do + let sig = makeSignature net tx i sigIn key + si <- buildInput net tx i so val rdmM sig $ derivePubKeyI key + w <- updatedWitnessData tx i so si + return tx { txIn = nextTxIn so si + , txWitness = w + } + where + f si x = x {scriptInput = encodeInputBS si} + g so x = x {scriptInput = S.encode . opPushData $ encodeOutputBS so} + txis = txIn tx + nextTxIn so si + | isSegwit so && nest = updateIndex i txis (g so) + | isSegwit so = txIn tx + | otherwise = updateIndex i txis (f si) + +-- | Add the witness data of the transaction given segwit parameters for an input. +-- +-- @since 0.11.0.0 +updatedWitnessData :: Tx -> Int -> ScriptOutput -> ScriptInput -> Either String WitnessData +updatedWitnessData tx i so si + | isSegwit so = updateWitness . toWitnessStack =<< calcWitnessProgram so si + | otherwise = return $ txWitness tx + where + updateWitness w + | null $ txWitness tx = return $ updateIndex i defaultStack (const w) + | length (txWitness tx) /= n = Left "Invalid number of witness stacks" + | otherwise = return $ updateIndex i (txWitness tx) (const w) + defaultStack = replicate n $ toWitnessStack EmptyWitnessProgram + n = length $ txIn tx + +-- | Associate an input index to each value in a list +findInputIndex :: + (a -> OutPoint) -- ^ extract an outpoint + -> [a] -- ^ input list + -> [TxIn] -- ^ reference list of inputs + -> [(a, Int)] +findInputIndex getOutPoint as ti = + mapMaybe g $ zip (matchTemplate as ti f) [0..] + where + f s txin = getOutPoint s == prevOutput txin + g (Just s, i) = Just (s,i) + g (Nothing, _) = Nothing + +-- | Find from the list of provided private keys which one is required to sign +-- the 'ScriptOutput'. +sigKeys :: + ScriptOutput + -> Maybe RedeemScript + -> [SecKey] + -> Either String [SecKeyI] +sigKeys so rdmM keys = + case (so, rdmM) of + (PayPK p, Nothing) -> + return . map fst . maybeToList $ find ((== p) . snd) zipKeys + (PayPKHash h, Nothing) -> return $ keyByHash h + (PayMulSig ps r, Nothing) -> + return $ map fst $ take r $ filter ((`elem` ps) . snd) zipKeys + (PayScriptHash _, Just rdm) -> sigKeys rdm Nothing keys + (PayWitnessPKHash h, _) -> return $ keyByHash h + (PayWitnessScriptHash _, Just rdm) -> sigKeys rdm Nothing keys + _ -> Left "sigKeys: Could not decode output script" + where + zipKeys = + [ (prv, pub) + | k <- keys + , t <- [True, False] + , let prv = wrapSecKey t k + , let pub = derivePubKeyI prv + ] + keyByHash h = fmap fst . maybeToList . findKey h $ zipKeys + findKey h = find $ (== h) . getAddrHash160 . pubKeyAddr . snd + +-- | Construct an input for a transaction given a signature, public key and data +-- about the previous output. +buildInput :: + Network + -> Tx -- ^ transaction where input will be added + -> Int -- ^ input index where signature will go + -> ScriptOutput -- ^ output script being spent + -> Word64 -- ^ amount of previous output + -> Maybe RedeemScript -- ^ redeem script if pay-to-script-hash + -> TxSignature + -> PubKeyI + -> Either String ScriptInput +buildInput net tx i so val rdmM sig pub = do + when (i >= length (txIn tx)) $ Left "buildInput: Invalid input index" + case (so, rdmM) of + (PayScriptHash _, Just rdm) -> buildScriptHashInput rdm + (PayWitnessScriptHash _, Just rdm) -> buildScriptHashInput rdm + (PayWitnessPKHash _, Nothing) -> return . RegularInput $ SpendPKHash sig pub + (_, Nothing) -> buildRegularInput so + _ -> Left "buildInput: Invalid output/redeem script combination" + where + buildRegularInput = \case + PayPK _ -> return $ RegularInput $ SpendPK sig + PayPKHash _ -> return $ RegularInput $ SpendPKHash sig pub + PayMulSig msPubs r -> do + let mSigs = take r $ catMaybes $ matchTemplate allSigs msPubs f + allSigs = nub $ sig : parseExistingSigs net tx so i + return $ RegularInput $ SpendMulSig mSigs + _ -> Left "buildInput: Invalid output/redeem script combination" + buildScriptHashInput rdm = do + inp <- buildRegularInput rdm + return $ ScriptHashInput (getRegularInput inp) rdm + f (TxSignature x sh) p = + verifyHashSig (makeSigHash net tx i so val sh rdmM) x (pubKeyPoint p) + f TxSignatureEmpty _ = False + +-- | Apply heuristics to extract the signatures for a particular input that are +-- embedded in the transaction. +-- +-- @since 0.11.0.0 +parseExistingSigs :: Network -> Tx -> ScriptOutput -> Int -> [TxSignature] +parseExistingSigs net tx so i = insSigs <> witSigs + where + insSigs = case decodeInputBS net scp of + Right (ScriptHashInput (SpendMulSig xs) _) -> xs + Right (RegularInput (SpendMulSig xs)) -> xs + _ -> [] + scp = scriptInput $ txIn tx !! i + witSigs + | not $ isSegwit so = [] + | null $ txWitness tx = [] + | otherwise = rights $ decodeTxSig net <$> (txWitness tx !! i) + +-- | Produce a structured representation of a deterministic (RFC-6979) signature over an input. +makeSignature :: Network -> Tx -> Int -> SigInput -> SecKeyI -> TxSignature +makeSignature net tx i (SigInput so val _ sh rdmM) key = TxSignature (signHash (secKeyData key) m) sh + where + m = makeSigHash net tx i so val sh rdmM + +-- | A function which selects the digest algorithm and parameters as appropriate +-- +-- @since 0.11.0.0 +makeSigHash :: + Network + -> Tx + -> Int + -> ScriptOutput + -> Word64 + -> SigHash + -> Maybe RedeemScript + -> Hash256 +makeSigHash net tx i so val sh rdmM = h net tx (encodeOutput so') val i sh + where + so' = case so of + PayWitnessPKHash h -> PayPKHash h + _ -> fromMaybe so rdmM + h | isSegwit so = txSigHashForkId + | otherwise = txSigHash diff --git a/src/Network/Haskoin/Transaction/Common.hs b/src/Network/Haskoin/Transaction/Common.hs --- a/src/Network/Haskoin/Transaction/Common.hs +++ b/src/Network/Haskoin/Transaction/Common.hs @@ -5,7 +5,7 @@ Module : Network.Haskoin.Transaction.Common Copyright : No rights reserved License : UNLICENSE -Maintainer : xenog@protonmail.com +Maintainer : jprupp@protonmail.ch Stability : experimental Portability : POSIX diff --git a/src/Network/Haskoin/Transaction/Segwit.hs b/src/Network/Haskoin/Transaction/Segwit.hs new file mode 100644 --- /dev/null +++ b/src/Network/Haskoin/Transaction/Segwit.hs @@ -0,0 +1,141 @@ +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TupleSections #-} +{-| +Module : Network.Haskoin.Transaction.Segwit +Copyright : No rights reserved +License : UNLICENSE +Maintainer : jprupp@protonmail.ch +Stability : experimental +Portability : POSIX + +Types to represent segregated witness data and auxilliary functions to +manipulate it. See [BIP 141](https://github.com/bitcoin/bips/blob/master/bip-0141.mediawiki) +and [BIP 143](https://github.com/bitcoin/bips/blob/master/bip-0143.mediawiki) for +details. +-} +module Network.Haskoin.Transaction.Segwit + ( WitnessProgram (..) + , WitnessProgramPKH (..) + , WitnessProgramSH (..) + , isSegwit + + , viewWitnessProgram + , decodeWitnessInput + + , calcWitnessProgram + , simpleInputStack + , toWitnessStack + ) where + +import Data.ByteString (ByteString) +import qualified Data.Serialize as S +import Network.Haskoin.Constants (Network) +import Network.Haskoin.Keys.Common (PubKeyI) +import Network.Haskoin.Script.Common (Script (..), + ScriptOutput (..), + decodeOutput, encodeOutput) +import Network.Haskoin.Script.SigHash (TxSignature (..), + decodeTxSig, encodeTxSig) +import Network.Haskoin.Script.Standard (ScriptInput (..), + SimpleInput (..)) +import Network.Haskoin.Transaction.Common (WitnessStack) + +-- | Test if a 'ScriptOutput' is P2WPKH or P2WSH +-- +-- @since 0.11.0.0 +isSegwit :: ScriptOutput -> Bool +isSegwit = \case + PayWitnessPKHash{} -> True + PayWitnessScriptHash{} -> True + _ -> False + +-- | High level represenation of a (v0) witness program +-- +-- @since 0.11.0.0 +data WitnessProgram = P2WPKH WitnessProgramPKH | P2WSH WitnessProgramSH | EmptyWitnessProgram + deriving (Eq, Show) + +-- | Encode a witness program +-- +-- @since 0.11.0.0 +toWitnessStack :: WitnessProgram -> WitnessStack +toWitnessStack = \case + P2WPKH (WitnessProgramPKH sig key) -> [encodeTxSig sig, S.encode key] + P2WSH (WitnessProgramSH stack scr) -> stack <> [S.encode scr] + EmptyWitnessProgram -> mempty + +-- | High level representation of a P2WPKH witness +-- +-- @since 0.11.0.0 +data WitnessProgramPKH = WitnessProgramPKH + { witnessSignature :: !TxSignature + , witnessPubKey :: !PubKeyI + } deriving (Eq, Show) + +-- | High-level representation of a P2WSH witness +-- +-- @since 0.11.0.0 +data WitnessProgramSH = WitnessProgramSH + { witnessScriptHashStack :: ![ByteString] + , witnessScriptHashScript :: !Script + } deriving (Eq, Show) + +-- | Calculate the witness program from the transaction data +-- +-- @since 0.11.0.0 +viewWitnessProgram :: Network -> ScriptOutput -> WitnessStack -> Either String WitnessProgram +viewWitnessProgram net so witness = case so of + PayWitnessPKHash _ | length witness == 2 -> do + sig <- decodeTxSig net $ head witness + pubkey <- S.decode $ witness !! 1 + return . P2WPKH $ WitnessProgramPKH sig pubkey + PayWitnessScriptHash _ | not (null witness) -> do + redeemScript <- S.decode $ last witness + return . P2WSH $ WitnessProgramSH (init witness) redeemScript + _ | null witness -> return EmptyWitnessProgram + | otherwise -> Left "viewWitnessProgram: Invalid witness program" + +-- | Analyze the witness, trying to match it with standard input structures +-- +-- @since 0.11.0.0 +decodeWitnessInput :: Network -> WitnessProgram -> Either String (Maybe ScriptOutput, SimpleInput) +decodeWitnessInput net = \case + P2WPKH (WitnessProgramPKH sig key) -> return (Nothing, SpendPKHash sig key) + P2WSH (WitnessProgramSH st scr) -> do + so <- decodeOutput scr + fmap (Just so, ) $ case (so, st) of + (PayPK k, [sigBS]) -> + SpendPK <$> decodeTxSig net sigBS + (PayPKHash h, [sigBS, keyBS]) -> + SpendPKHash <$> decodeTxSig net sigBS <*> S.decode keyBS + (PayMulSig ps r, "" : sigsBS) -> + SpendMulSig <$> traverse (decodeTxSig net) sigsBS + _ -> Left "decodeWitnessInput: Non-standard script output" + EmptyWitnessProgram -> Left "decodeWitnessInput: Empty witness program" + +-- | Create the witness program for a standard input +-- +-- @since 0.11.0.0 +calcWitnessProgram :: ScriptOutput -> ScriptInput -> Either String WitnessProgram +calcWitnessProgram so si = case (so, si) of + (PayWitnessPKHash{}, RegularInput (SpendPKHash sig pk)) -> p2wpkh sig pk + (PayScriptHash{}, RegularInput (SpendPKHash sig pk)) -> p2wpkh sig pk + (PayWitnessScriptHash{}, ScriptHashInput i o) -> p2wsh i o + (PayScriptHash{}, ScriptHashInput i o) -> p2wsh i o + _ -> Left "calcWitnessProgram: Invalid segwit SigInput" + where + p2wpkh sig = return . P2WPKH . WitnessProgramPKH sig + p2wsh i o = return . P2WSH $ WitnessProgramSH (simpleInputStack i) (encodeOutput o) + +-- | Create the witness stack required to spend a standard P2WSH input +-- +-- @since 0.11.0.0 +simpleInputStack :: SimpleInput -> [ByteString] +simpleInputStack = \case + SpendPK sig -> [f sig] + SpendPKHash sig k -> [f sig, S.encode k] + SpendMulSig sigs -> "" : fmap f sigs + where + f TxSignatureEmpty = "" + f sig = encodeTxSig sig diff --git a/src/Network/Haskoin/Util.hs b/src/Network/Haskoin/Util.hs --- a/src/Network/Haskoin/Util.hs +++ b/src/Network/Haskoin/Util.hs @@ -3,7 +3,7 @@ Module : Network.Haskoin.Util Copyright : No rights reserved License : UNLICENSE -Maintainer : xenog@protonmail.com +Maintainer : jprupp@protonmail.ch Stability : experimental Portability : POSIX diff --git a/test/Network/Haskoin/Crypto/SignatureSpec.hs b/test/Network/Haskoin/Crypto/SignatureSpec.hs --- a/test/Network/Haskoin/Crypto/SignatureSpec.hs +++ b/test/Network/Haskoin/Crypto/SignatureSpec.hs @@ -1,38 +1,36 @@ {-# LANGUAGE OverloadedStrings #-} module Network.Haskoin.Crypto.SignatureSpec (spec) where -import Data.Bits (testBit) -import Data.ByteString (ByteString) -import qualified Data.ByteString as BS (index, length) -import Data.Maybe -import Data.Serialize as S -import Data.Text (Text) -import Network.Haskoin.Constants -import Network.Haskoin.Crypto -import Network.Haskoin.Keys -import Network.Haskoin.Test -import Network.Haskoin.Util -import Test.Hspec -import Test.HUnit (Assertion, assertBool) -import Test.QuickCheck +import Data.Bits (testBit) +import Data.ByteString (ByteString) +import qualified Data.ByteString as BS (index, length) +import Data.Serialize as S +import Data.Text (Text) +import Network.Haskoin.Crypto (SecKey, Sig, decodeStrictSig, + derivePubKey, exportSig, + importCompactSig, isCanonicalHalfOrder, + sha256, signHash, verifyHashSig) +import Network.Haskoin.Test (arbitrarySignature) +import Network.Haskoin.Util (decodeHex, eitherToMaybe, lst3) +import Test.Hspec (Spec, describe, it) +import Test.Hspec.QuickCheck (prop) +import Test.HUnit (Assertion, assertBool) +import Test.QuickCheck (forAll) spec :: Spec spec = do describe "signatures" $ do - it "verify signature" $ - property $ + prop "verify signature" $ forAll arbitrarySignature $ \(msg, key, sig) -> verifyHashSig msg sig (derivePubKey key) - it "s component less than half order" $ - property $ forAll arbitrarySignature $ isCanonicalHalfOrder . lst3 - it "encoded signature is canonical" $ - property $ forAll arbitrarySignature $ testIsCanonical . lst3 - it "encode signature and decode strictly" $ - property $ + prop "s component less than half order" $ + forAll arbitrarySignature $ isCanonicalHalfOrder . lst3 + prop "encoded signature is canonical" $ + forAll arbitrarySignature $ testIsCanonical . lst3 + prop "encode signature and decode strictly" $ forAll arbitrarySignature $ (\s -> decodeStrictSig (exportSig s) == Just s) . lst3 - it "encodes and decodes signature" $ - property $ + prop "encodes and decodes signature" $ forAll arbitrarySignature $ (\s -> decodeStrictSig (exportSig s) == Just s) . lst3 describe "trezor rfc6979 test vectors" $ do @@ -49,15 +47,18 @@ it "rfc6979 test vector 11" (testSigning $ detVec !! 10) it "rfc6979 test vector 12" (testSigning $ detVec !! 11) +-- No longer validating that generated signature is exactly equal to provided +-- one. Fedora includes libsecp256k1 from Bitcoin ABC that computes +-- deterministic signatures using a slightly different nonce generation +-- algorithm. testSigning :: (SecKey, ByteString, Text) -> Assertion testSigning (prv, msg, str) = do - assertBool "RFC 6979 Vector" $ res == fromJust (decodeHex str) - assertBool "valid sig" $ verifyHashSig msg' g (derivePubKey prv) + assertBool "my sig valid" $ verifyHashSig msg' g (derivePubKey prv) + assertBool "valid sig" $ verifyHashSig msg' g' (derivePubKey prv) where + Just g' = importCompactSig =<< eitherToMaybe . decode =<< decodeHex str g = signHash prv msg' msg' = sha256 msg - compact = exportCompactSig g - res = encode compact {- ECDSA Canonical -} diff --git a/test/Network/Haskoin/Keys/MnemonicSpec.hs b/test/Network/Haskoin/Keys/MnemonicSpec.hs --- a/test/Network/Haskoin/Keys/MnemonicSpec.hs +++ b/test/Network/Haskoin/Keys/MnemonicSpec.hs @@ -304,7 +304,7 @@ bs = BS.concat [encode a, encode b, encode c] l = length . - T.words . fromRight (error "Colud not decode mnemonic sentence") $ + T.words . fromRight (error "Could not decode mnemonic sentence") $ toMnemonic bs toMnemonic256 :: (Word64, Word64, Word64, Word64) -> Bool @@ -333,7 +333,7 @@ ] l = length . - T.words . fromRight (error "Colud not decode mnemoonic sentence") $ + T.words . fromRight (error "Could not decode mnemonic sentence") $ toMnemonic bs toMnemonicVar :: [Word32] -> Property @@ -356,7 +356,7 @@ bs = encode a `BS.append` encode b bs' = fromRight - (error "Colud not decode mnemonic entropy") + (error "Could not decode mnemonic entropy") (fromMnemonic =<< toMnemonic bs) fromToMnemonic160 :: (Word32, Word64, Word64) -> Bool @@ -403,7 +403,7 @@ bs = binWordsToBS ls bs' = fromRight - (error "Colud not decode mnemonic entropy") + (error "Could not decode mnemonic entropy") (fromMnemonic =<< toMnemonic bs) {- Mnemonic to seed -} @@ -434,7 +434,7 @@ bs = BS.concat [encode a, encode b, encode c, encode d] seed = fromRight - (error "Colud not decode mnemonic seed") + (error "Could not decode mnemonic seed") (mnemonicToSeed "" =<< toMnemonic bs) l = BS.length seed diff --git a/test/Network/Haskoin/ScriptSpec.hs b/test/Network/Haskoin/ScriptSpec.hs --- a/test/Network/Haskoin/ScriptSpec.hs +++ b/test/Network/Haskoin/ScriptSpec.hs @@ -126,21 +126,19 @@ "DERSIG" `isInfixOf` flags || "STRICTENC" `isInfixOf` flags || "NULLDUMMY" `isInfixOf` flags - scriptSig = parseScript siStr - scriptPubKey = parseScript soStr - decodedOutput = - fromRight (error $ "Could not decode output: " <> soStr) $ - decodeOutputBS scriptPubKey - ver = + scriptSig = parseScript siStr + scriptPubKey = parseScript soStr + decodedOutput = decodeOutputBS scriptPubKey + ver = either (const False) $ \so -> verifyStdInput net (spendTx scriptPubKey 0 scriptSig) 0 - decodedOutput + so (val * 100000000) case res of - "OK" -> assertBool desc ver - _ -> assertBool desc (not ver) + "OK" -> assertBool desc $ ver decodedOutput + _ -> assertBool desc (not $ ver decodedOutput) forkIdScriptSpec :: Network -> Spec forkIdScriptSpec net = diff --git a/test/Network/Haskoin/TransactionSpec.hs b/test/Network/Haskoin/TransactionSpec.hs --- a/test/Network/Haskoin/TransactionSpec.hs +++ b/test/Network/Haskoin/TransactionSpec.hs @@ -1,26 +1,28 @@ {-# LANGUAGE OverloadedStrings #-} + module Network.Haskoin.TransactionSpec (spec) where -import Data.Aeson as A -import qualified Data.ByteString as B +import Data.Aeson as A +import qualified Data.ByteString as B import Data.Either -import Data.Map.Strict (singleton) +import Data.Map.Strict (singleton) import Data.Maybe -import Data.Serialize as S -import Data.String (fromString) +import Data.Serialize as S +import Data.String (fromString) import Data.String.Conversions -import Data.Text (Text) -import Data.Word (Word32, Word64) +import Data.Text (Text) +import Data.Word (Word32, Word64) import Network.Haskoin.Address import Network.Haskoin.Constants import Network.Haskoin.Keys import Network.Haskoin.Script import Network.Haskoin.Test import Network.Haskoin.Transaction +import Network.Haskoin.Transaction.Segwit (isSegwit) import Network.Haskoin.Util -import Safe (readMay) +import Safe (readMay) import Test.Hspec -import Test.HUnit (Assertion, assertBool) +import Test.HUnit (Assertion, assertBool) import Test.QuickCheck spec :: Spec @@ -32,6 +34,15 @@ it "build pkhash transaction (generated from bitcoind)" $ mapM_ runPKHashVec pkHashVec it "encode satoshi core script pubkey" tEncodeSatoshiCoreScriptPubKey + -- + -- These tests depend on signatures matching exactly those in the spec. + -- Fedora includes a version of libsecp256k1 that computes signatures + -- using a slighlty different deterministic nonce algorithm. + -- + -- it "agrees with BIP143 p2wpkh example" testBip143p2wpkh + -- it "agrees with BIP143 p2sh-p2wpkh example" testBip143p2shp2wpkh + -- it "builds a p2wsh multisig transaction" testP2WSHMulsig + -- it "agrees with BIP143 p2sh-p2wsh multisig example" testBip143p2shp2wpkhMulsig describe "btc transaction" $ do it "decode and encode txid" $ property $ @@ -53,6 +64,8 @@ forAll (listOf (arbitrarySatoshi net)) . testChooseMSCoins it "sign and validate transaction" $ property $ forAll (arbitrarySigningData net) (testDetSignTx net) + it "sign and validate (nested) transaction" $ + property $ forAll (arbitrarySigningData net) (testDetSignNestedTx net) it "merge partially signed transactions" $ property $ forAll (arbitraryPartialTxs net) (testMergeTx net) describe "json serialization" $ do @@ -147,7 +160,6 @@ t1SatoshiCoreJsonScriptPubKey :: String t1SatoshiCoreJsonScriptPubKey = "1 0x41 0x04cc71eb30d653c0c3163990c47b976f3fb3f37cccdcbedb169a1dfef58bbfbfaff7d8a473e7e2e6d317b87bafe8bde97e3cf8f065dec022b51d11fcdd0d348ac4 0x41 0x0461cbdcc5409fb4b4d42b51d33381354d80e550078cb532a34bfa2fcfdeb7d76519aecc62770f5b0e4ef8551946d8a540911abe3e7854a26f39f58b25c15342af 2 OP_CHECKMULTISIG" - encodeSatoshiCoreScriptPubKey :: String -> Text encodeSatoshiCoreScriptPubKey = mconcat . map encodeSatoshiCoreScriptPiece . words @@ -162,6 +174,105 @@ Just i -> encodeHex . S.encode . intToScriptOp $ i Nothing -> error $ "encodeSatoshiCoreScriptPubKey: " ++ s +-- +-- Following tests depend on specific secp256k1 deterministic nonce computation. +-- Fedora distributes the Bitcoin ABC fork of this library, which computes nonces differently. +-- + +-- -- Reproduce the P2WPKH example from BIP 143 +-- testBip143p2wpkh :: Assertion +-- testBip143p2wpkh = assertEqual "BIP143 p2wpkh" (Right exampleSignedTx) generatedSignedTx +-- where +-- exampleSignedTx = "01000000000102fff7f7881a8099afa6940d42d1e7f6362bec38171ea3edf433541db4e4ad969f00000000494830450221008b9d1dc26ba6a9cb62127b02742fa9d754cd3bebf337f7a55d114c8e5cdd30be022040529b194ba3f9281a99f2b1c0a19c0489bc22ede944ccf4ecbab4cc618ef3ed01eeffffffef51e1b804cc89d182d279655c3aa89e815b1b309fe287d9b2b55d57b90ec68a0100000000ffffffff02202cb206000000001976a9148280b37df378db99f66f85c95a783a76ac7a6d5988ac9093510d000000001976a9143bde42dbee7e4dbe6a21b2d50ce2f0167faa815988ac000247304402203609e17b84f6a7d30c80bfa610b5b4542f32a8a0d5447a12fb1366d7f01cc44a0220573a954c4518331561406f90300e8f3358f51928d43c212a8caed02de67eebee0121025476c2e83188368da1ff3e292e7acafcdb3566bb0ad253f62fc70f07aeee635711000000" + +-- unsignedTx = "0100000002fff7f7881a8099afa6940d42d1e7f6362bec38171ea3edf433541db4e4ad969f0000000000eeffffffef51e1b804cc89d182d279655c3aa89e815b1b309fe287d9b2b55d57b90ec68a0100000000ffffffff02202cb206000000001976a9148280b37df378db99f66f85c95a783a76ac7a6d5988ac9093510d000000001976a9143bde42dbee7e4dbe6a21b2d50ce2f0167faa815988ac11000000" + +-- Just key0 = secHexKey "bbc27228ddcb9209d7fd6f36b02f7dfa6252af40bb2f1cbc7a557da8027ff866" +-- pubKey0 = toPubKey key0 + +-- Just key1 = secHexKey "619c335025c7f4012e556c2a58b2506e30b8511b53ade95ea316fd8c3286feb9" + +-- [op0, op1] = prevOutput <$> txIn unsignedTx + +-- sigIn0 = SigInput (PayPK pubKey0) 625000000 op0 sigHashAll Nothing + +-- WitnessPubKeyAddress h = pubKeyWitnessAddr $ toPubKey key1 +-- sigIn1 = SigInput (PayWitnessPKHash h) 600000000 op1 sigHashAll Nothing + +-- generatedSignedTx = signTx btc unsignedTx [sigIn0, sigIn1] [key0, key1] + +-- -- Reproduce the P2SH-P2WPKH example from BIP 143 +-- testBip143p2shp2wpkh :: Assertion +-- testBip143p2shp2wpkh = assertEqual "BIP143 p2sh-p2wpkh" (Right exampleSignedTx) generatedSignedTx +-- where +-- exampleSignedTx = "01000000000101db6b1b20aa0fd7b23880be2ecbd4a98130974cf4748fb66092ac4d3ceb1a5477010000001716001479091972186c449eb1ded22b78e40d009bdf0089feffffff02b8b4eb0b000000001976a914a457b684d7f0d539a46a45bbc043f35b59d0d96388ac0008af2f000000001976a914fd270b1ee6abcaea97fea7ad0402e8bd8ad6d77c88ac02473044022047ac8e878352d3ebbde1c94ce3a10d057c24175747116f8288e5d794d12d482f0220217f36a485cae903c713331d877c1f64677e3622ad4010726870540656fe9dcb012103ad1d8e89212f0b92c74d23bb710c00662ad1470198ac48c43f7d6f93a2a2687392040000" + +-- unsignedTx = "0100000001db6b1b20aa0fd7b23880be2ecbd4a98130974cf4748fb66092ac4d3ceb1a54770100000000feffffff02b8b4eb0b000000001976a914a457b684d7f0d539a46a45bbc043f35b59d0d96388ac0008af2f000000001976a914fd270b1ee6abcaea97fea7ad0402e8bd8ad6d77c88ac92040000" + +-- Just key0 = secHexKey "eb696a065ef48a2192da5b28b694f87544b30fae8327c4510137a922f32c6dcf" + +-- op0 = prevOutput . head $ txIn unsignedTx +-- WitnessPubKeyAddress h = pubKeyWitnessAddr $ toPubKey key0 +-- sigIn0 = SigInput (PayWitnessPKHash h) 1000000000 op0 sigHashAll Nothing + +-- generatedSignedTx = signNestedWitnessTx btc unsignedTx [sigIn0] [key0] + +-- -- P2WSH multisig example (tested against bitcoin-core 0.19.0.1) +-- testP2WSHMulsig :: Assertion +-- testP2WSHMulsig = assertEqual "p2wsh multisig" (Right exampleSignedTx) generatedSignedTx +-- where +-- exampleSignedTx = "01000000000101d2e34df5d7ee565208eddd231548916b9b0e99f4f5071f896134a448c5fb07bf0100000000ffffffff01f0b9f505000000001976a9143d5a352cab583b12fbcb26d1269b4a2c951a33ad88ac0400483045022100fad4fedd2bb4c439c64637eb8e9150d9020a7212808b8dc0578d5ff5b4ad65fe0220714640f261b37eb3106310bf853f4b706e51436fb6b64c2ab00768814eb55b9801473044022100baff4e4ceea4022b9725a2e6f6d77997a554f858165b91ac8c16c9833008bee9021f5f70ebc3f8580dc0a5e96451e3697bdf1f1f5883944f0f33ab0cfb272354040169522102ba46d3bb8db74c77c6cf082db57fc0548058fcdea811549e186526e3d10caf6721038ac8aef2dd9cea5e7d66e2f6e23f177a6c21f69ea311fa0c85d81badb6b37ceb2103d96d2bfbbc040faaf93491d69e2bfe9695e2d8e007a7f26db96c2ee42db15dc953ae00000000" + +-- unsignedTx = "0100000001d2e34df5d7ee565208eddd231548916b9b0e99f4f5071f896134a448c5fb07bf0100000000ffffffff01f0b9f505000000001976a9143d5a352cab583b12fbcb26d1269b4a2c951a33ad88ac00000000" + +-- op0 = head $ prevOutput <$> txIn unsignedTx + +-- Just keys = traverse secHexKey [ "3030303030303030303030303030303030303030303030303030303030303031" +-- , "3030303030303030303030303030303030303030303030303030303030303032" +-- , "3030303030303030303030303030303030303030303030303030303030303033" +-- ] + +-- rdm = PayMulSig (toPubKey <$> keys) 2 +-- sigIn = SigInput (toP2WSH $ encodeOutput rdm) 100000000 op0 sigHashAll (Just rdm) +-- generatedSignedTx = signTx btc unsignedTx [sigIn] (take 2 keys) + +-- -- Reproduce the P2SH-P2WSH multisig example from BIP 143 +-- testBip143p2shp2wpkhMulsig :: Assertion +-- testBip143p2shp2wpkhMulsig = +-- assertEqual "BIP143 p2sh-p2wsh multisig" (Right exampleSignedTx) generatedSignedTx +-- where +-- exampleSignedTx = "0100000000010136641869ca081e70f394c6948e8af409e18b619df2ed74aa106c1ca29787b96e0100000023220020a16b5755f7f6f96dbd65f5f0d6ab9418b89af4b1f14a1bb8a09062c35f0dcb54ffffffff0200e9a435000000001976a914389ffce9cd9ae88dcc0631e88a821ffdbe9bfe2688acc0832f05000000001976a9147480a33f950689af511e6e84c138dbbd3c3ee41588ac080047304402206ac44d672dac41f9b00e28f4df20c52eeb087207e8d758d76d92c6fab3b73e2b0220367750dbbe19290069cba53d096f44530e4f98acaa594810388cf7409a1870ce01473044022068c7946a43232757cbdf9176f009a928e1cd9a1a8c212f15c1e11ac9f2925d9002205b75f937ff2f9f3c1246e547e54f62e027f64eefa2695578cc6432cdabce271502473044022059ebf56d98010a932cf8ecfec54c48e6139ed6adb0728c09cbe1e4fa0915302e022007cd986c8fa870ff5d2b3a89139c9fe7e499259875357e20fcbb15571c76795403483045022100fbefd94bd0a488d50b79102b5dad4ab6ced30c4069f1eaa69a4b5a763414067e02203156c6a5c9cf88f91265f5a942e96213afae16d83321c8b31bb342142a14d16381483045022100a5263ea0553ba89221984bd7f0b13613db16e7a70c549a86de0cc0444141a407022005c360ef0ae5a5d4f9f2f87a56c1546cc8268cab08c73501d6b3be2e1e1a8a08824730440220525406a1482936d5a21888260dc165497a90a15669636d8edca6b9fe490d309c022032af0c646a34a44d1f4576bf6a4a74b67940f8faa84c7df9abe12a01a11e2b4783cf56210307b8ae49ac90a048e9b53357a2354b3334e9c8bee813ecb98e99a7e07e8c3ba32103b28f0c28bfab54554ae8c658ac5c3e0ce6e79ad336331f78c428dd43eea8449b21034b8113d703413d57761b8b9781957b8c0ac1dfe69f492580ca4195f50376ba4a21033400f6afecb833092a9a21cfdf1ed1376e58c5d1f47de74683123987e967a8f42103a6d48b1131e94ba04d9737d61acdaa1322008af9602b3b14862c07a1789aac162102d8b661b0b3302ee2f162b09e07a55ad5dfbe673a9f01d9f0c19617681024306b56ae00000000" + +-- unsignedTx = "010000000136641869ca081e70f394c6948e8af409e18b619df2ed74aa106c1ca29787b96e0100000000ffffffff0200e9a435000000001976a914389ffce9cd9ae88dcc0631e88a821ffdbe9bfe2688acc0832f05000000001976a9147480a33f950689af511e6e84c138dbbd3c3ee41588ac00000000" + +-- op0 = head $ prevOutput <$> txIn unsignedTx + +-- rawKeys = [ "730fff80e1413068a05b57d6a58261f07551163369787f349438ea38ca80fac6" +-- , "11fa3d25a17cbc22b29c44a484ba552b5a53149d106d3d853e22fdd05a2d8bb3" +-- , "77bf4141a87d55bdd7f3cd0bdccf6e9e642935fec45f2f30047be7b799120661" +-- , "14af36970f5025ea3e8b5542c0f8ebe7763e674838d08808896b63c3351ffe49" +-- , "fe9a95c19eef81dde2b95c1284ef39be497d128e2aa46916fb02d552485e0323" +-- , "428a7aee9f0c2af0cd19af3cf1c78149951ea528726989b2e83e4778d2c3f890" +-- ] + +-- Just keys@[key0, key1, key2, key3, key4, key5] = traverse secHexKey rawKeys + +-- rdm = PayMulSig (toPubKey <$> keys) 6 +-- sigIn sh = SigInput (toP2WSH $ encodeOutput rdm) 987654321 op0 sh (Just rdm) + +-- sigHashesA = [sigHashAll, sigHashNone, sigHashSingle] +-- sigHashesB = setAnyoneCanPayFlag <$> sigHashesA +-- sigIns = sigIn <$> (sigHashesA <> sigHashesB) + +-- generatedSignedTx = foldM addSig unsignedTx $ zip sigIns keys +-- addSig tx (sigIn, key) = signNestedWitnessTx btc tx [sigIn] [key] + +-- secHexKey :: Text -> Maybe SecKey +-- secHexKey = decodeHex >=> secKey + +-- toPubKey :: SecKey -> PubKeyI +-- toPubKey = derivePubKeyI . wrapSecKey True + {- Building Transactions -} testBuildAddrTx :: Network -> Address -> TestCoin -> Bool @@ -242,6 +353,22 @@ fromRight (error "Could not decode transaction") $ signTx net txSigP sigis [secKeyData (head prv)] verData = map (\(SigInput s v o _ _) -> (s, v, o)) sigis + +testDetSignNestedTx :: Network -> (Tx, [SigInput], [SecKeyI]) -> Bool +testDetSignNestedTx net (tx, sigis, prv) = + not (verifyStdTx net tx verData) && + not (verifyStdTx net txSigP verData) && verifyStdTx net txSigC verData + where + txSigP = + fromRight (error "Could not decode transaction") $ + signNestedWitnessTx net tx sigis (secKeyData <$> tail prv) + txSigC = + fromRight (error "Could not decode transaction") $ + signNestedWitnessTx net txSigP sigis [secKeyData (head prv)] + verData = handleSegwit <$> sigis + handleSegwit (SigInput s v o _ _) + | isSegwit s = (toP2SH $ encodeOutput s, v, o) + | otherwise = (s, v, o) testMergeTx :: Network -> ([Tx], [(ScriptOutput, Word64, OutPoint, Int, Int)]) -> Bool testMergeTx net (txs, os) = and