haskoin-core 0.10.1 → 0.12.0
raw patch · 48 files changed
+800/−299 lines, 48 filesdep ~secp256k1-haskell
Dependency ranges changed: secp256k1-haskell
Files
- CHANGELOG.md +7/−0
- README.md +1/−1
- haskoin-core.cabal +5/−3
- src/Haskoin.hs +1/−1
- src/Network/Haskoin/Address.hs +1/−1
- src/Network/Haskoin/Address/Base58.hs +1/−1
- src/Network/Haskoin/Address/Bech32.hs +1/−1
- src/Network/Haskoin/Address/CashAddr.hs +1/−1
- src/Network/Haskoin/Block.hs +1/−1
- src/Network/Haskoin/Block/Common.hs +1/−1
- src/Network/Haskoin/Block/Headers.hs +1/−1
- src/Network/Haskoin/Block/Merkle.hs +1/−1
- src/Network/Haskoin/Constants.hs +1/−1
- src/Network/Haskoin/Crypto.hs +1/−1
- src/Network/Haskoin/Crypto/Hash.hs +2/−2
- src/Network/Haskoin/Crypto/Signature.hs +1/−1
- src/Network/Haskoin/Keys.hs +1/−1
- src/Network/Haskoin/Keys/Common.hs +1/−1
- src/Network/Haskoin/Keys/Extended.hs +1/−1
- src/Network/Haskoin/Keys/Mnemonic.hs +1/−1
- src/Network/Haskoin/Network.hs +1/−1
- src/Network/Haskoin/Network/Bloom.hs +1/−1
- src/Network/Haskoin/Network/Common.hs +1/−1
- src/Network/Haskoin/Network/Message.hs +1/−1
- src/Network/Haskoin/Script.hs +1/−1
- src/Network/Haskoin/Script/Common.hs +1/−1
- src/Network/Haskoin/Script/SigHash.hs +3/−2
- src/Network/Haskoin/Script/Standard.hs +2/−2
- src/Network/Haskoin/Test.hs +1/−1
- src/Network/Haskoin/Test/Address.hs +1/−1
- src/Network/Haskoin/Test/Block.hs +1/−1
- src/Network/Haskoin/Test/Crypto.hs +1/−1
- src/Network/Haskoin/Test/Keys.hs +1/−1
- src/Network/Haskoin/Test/Message.hs +1/−1
- src/Network/Haskoin/Test/Network.hs +1/−1
- src/Network/Haskoin/Test/Script.hs +1/−1
- src/Network/Haskoin/Test/Transaction.hs +30/−9
- src/Network/Haskoin/Test/Util.hs +1/−1
- src/Network/Haskoin/Transaction.hs +1/−1
- src/Network/Haskoin/Transaction/Builder.hs +126/−194
- src/Network/Haskoin/Transaction/Builder/Sign.hs +271/−0
- src/Network/Haskoin/Transaction/Common.hs +1/−1
- src/Network/Haskoin/Transaction/Segwit.hs +141/−0
- src/Network/Haskoin/Util.hs +1/−1
- test/Network/Haskoin/Crypto/SignatureSpec.hs +29/−28
- test/Network/Haskoin/Keys/MnemonicSpec.hs +5/−5
- test/Network/Haskoin/ScriptSpec.hs +7/−9
- test/Network/Haskoin/TransactionSpec.hs +137/−10
CHANGELOG.md view
@@ -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.
README.md view
@@ -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
haskoin-core.cabal view
@@ -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
src/Haskoin.hs view
@@ -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
src/Network/Haskoin/Address.hs view
@@ -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
src/Network/Haskoin/Address/Base58.hs view
@@ -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
src/Network/Haskoin/Address/Bech32.hs view
@@ -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
src/Network/Haskoin/Address/CashAddr.hs view
@@ -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
src/Network/Haskoin/Block.hs view
@@ -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
src/Network/Haskoin/Block/Common.hs view
@@ -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
src/Network/Haskoin/Block/Headers.hs view
@@ -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
src/Network/Haskoin/Block/Merkle.hs view
@@ -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
src/Network/Haskoin/Constants.hs view
@@ -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
src/Network/Haskoin/Crypto.hs view
@@ -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
src/Network/Haskoin/Crypto/Hash.hs view
@@ -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
src/Network/Haskoin/Crypto/Signature.hs view
@@ -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
src/Network/Haskoin/Keys.hs view
@@ -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
src/Network/Haskoin/Keys/Common.hs view
@@ -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
src/Network/Haskoin/Keys/Extended.hs view
@@ -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
src/Network/Haskoin/Keys/Mnemonic.hs view
@@ -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
src/Network/Haskoin/Network.hs view
@@ -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
src/Network/Haskoin/Network/Bloom.hs view
@@ -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
src/Network/Haskoin/Network/Common.hs view
@@ -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
src/Network/Haskoin/Network/Message.hs view
@@ -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
src/Network/Haskoin/Script.hs view
@@ -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
src/Network/Haskoin/Script/Common.hs view
@@ -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
src/Network/Haskoin/Script/SigHash.hs view
@@ -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
src/Network/Haskoin/Script/Standard.hs view
@@ -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
src/Network/Haskoin/Test.hs view
@@ -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
src/Network/Haskoin/Test/Address.hs view
@@ -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 -}
src/Network/Haskoin/Test/Block.hs view
@@ -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 -}
src/Network/Haskoin/Test/Crypto.hs view
@@ -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 -}
src/Network/Haskoin/Test/Keys.hs view
@@ -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 -}
src/Network/Haskoin/Test/Message.hs view
@@ -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 -}
src/Network/Haskoin/Test/Network.hs view
@@ -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 -}
src/Network/Haskoin/Test/Script.hs view
@@ -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 -}
src/Network/Haskoin/Test/Transaction.hs view
@@ -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])
src/Network/Haskoin/Test/Util.hs view
@@ -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 -}
src/Network/Haskoin/Transaction.hs view
@@ -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
src/Network/Haskoin/Transaction/Builder.hs view
@@ -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
+ src/Network/Haskoin/Transaction/Builder/Sign.hs view
@@ -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
src/Network/Haskoin/Transaction/Common.hs view
@@ -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
+ src/Network/Haskoin/Transaction/Segwit.hs view
@@ -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
src/Network/Haskoin/Util.hs view
@@ -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
test/Network/Haskoin/Crypto/SignatureSpec.hs view
@@ -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 -}
test/Network/Haskoin/Keys/MnemonicSpec.hs view
@@ -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
test/Network/Haskoin/ScriptSpec.hs view
@@ -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 =
test/Network/Haskoin/TransactionSpec.hs view
@@ -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