haskoin-core 0.5.2 → 0.6.0
raw patch · 47 files changed
+732/−325 lines, 47 files
Files
- CHANGELOG.md +6/−0
- haskoin-core.cabal +2/−2
- src/Haskoin.hs +39/−10
- src/Network/Haskoin/Address.hs +121/−21
- src/Network/Haskoin/Address/Base58.hs +11/−0
- src/Network/Haskoin/Address/Bech32.hs +10/−1
- src/Network/Haskoin/Address/CashAddr.hs +10/−0
- src/Network/Haskoin/Block.hs +10/−0
- src/Network/Haskoin/Block/Common.hs +15/−6
- src/Network/Haskoin/Block/Headers.hs +16/−4
- src/Network/Haskoin/Block/Merkle.hs +10/−0
- src/Network/Haskoin/Constants.hs +21/−1
- src/Network/Haskoin/Crypto.hs +19/−3
- src/Network/Haskoin/Crypto/Hash.hs +11/−0
- src/Network/Haskoin/Crypto/Signature.hs +12/−4
- src/Network/Haskoin/Keys.hs +11/−0
- src/Network/Haskoin/Keys/Common.hs +12/−4
- src/Network/Haskoin/Keys/Extended.hs +38/−13
- src/Network/Haskoin/Keys/Mnemonic.hs +10/−2
- src/Network/Haskoin/Network.hs +10/−4
- src/Network/Haskoin/Network/Bloom.hs +11/−4
- src/Network/Haskoin/Network/Common.hs +11/−1
- src/Network/Haskoin/Network/Message.hs +10/−0
- src/Network/Haskoin/Script.hs +10/−3
- src/Network/Haskoin/Script/Common.hs +17/−7
- src/Network/Haskoin/Script/SigHash.hs +33/−4
- src/Network/Haskoin/Script/Standard.hs +60/−39
- src/Network/Haskoin/Test.hs +8/−1
- src/Network/Haskoin/Test/Address.hs +8/−3
- src/Network/Haskoin/Test/Block.hs +6/−1
- src/Network/Haskoin/Test/Crypto.hs +6/−1
- src/Network/Haskoin/Test/Keys.hs +13/−9
- src/Network/Haskoin/Test/Message.hs +6/−1
- src/Network/Haskoin/Test/Network.hs +6/−1
- src/Network/Haskoin/Test/Script.hs +7/−1
- src/Network/Haskoin/Test/Transaction.hs +13/−4
- src/Network/Haskoin/Test/Util.hs +8/−0
- src/Network/Haskoin/Transaction.hs +8/−2
- src/Network/Haskoin/Transaction/Builder.hs +34/−17
- src/Network/Haskoin/Transaction/Common.hs +10/−0
- src/Network/Haskoin/Util.hs +8/−2
- test/Network/Haskoin/Address/CashAddrSpec.hs +5/−9
- test/Network/Haskoin/AddressSpec.hs +1/−2
- test/Network/Haskoin/CryptoSpec.hs +5/−7
- test/Network/Haskoin/Keys/ExtendedSpec.hs +1/−3
- test/Network/Haskoin/ScriptSpec.hs +20/−85
- test/Network/Haskoin/TransactionSpec.hs +13/−43
CHANGELOG.md view
@@ -4,6 +4,12 @@ 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.6.0+### Changed+- Force initialization of addresses through smart constructor.+- Assume addresses are always valid when instantiated in code.+- Allow to provide unwrapped private keys to transaction signing functions.+ ## 0.5.2 ### Changed - Make dependencies more specific.
haskoin-core.cabal view
@@ -2,10 +2,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: ad1cee7927edceba3d2f91465b04efc75dd1e49429d6150b29670ba6f5dc9722+-- hash: 60cf3a9fd398cb3bffeaa6d67b67e5bf4d56163b98c4137d7738ace0286ec13f name: haskoin-core-version: 0.5.2+version: 0.6.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
src/Haskoin.hs view
@@ -1,13 +1,42 @@+{-|+Module : Haskoin+Description : Bitcoin (BTC/BCH) Libraries for Haskell+Copyright : No rights reserved+License : UNLICENSE+Maintainer : xenog@protonmail.com+Stability : experimental+Portability : POSIX++This module exports almost all of Haskoin Core, excluding only a few highly+specialized address and block-related functions.+-} module Haskoin- ( module X+ ( -- * Address (Base58, Bech32, CashAddr)+ module Address+ -- * Network Messages+ , module Network+ -- * Network Constants+ , module Constants+ -- * Blocks+ , module Block+ -- * Transactions+ , module Transaction+ -- * Scripts+ , module Script+ -- * Cryptographic Keys+ , module Keys+ -- * Cryptographic Primitives+ , module Crypto+ -- * Various Utilities+ , module Util ) where -import Network.Haskoin.Address as X-import Network.Haskoin.Block as X-import Network.Haskoin.Constants as X-import Network.Haskoin.Crypto as X-import Network.Haskoin.Keys as X-import Network.Haskoin.Network as X-import Network.Haskoin.Script as X-import Network.Haskoin.Transaction as X-import Network.Haskoin.Util as X+import Network.Haskoin.Address as Address+import Network.Haskoin.Block as Block+import Network.Haskoin.Constants as Constants+import Network.Haskoin.Crypto as Crypto+import Network.Haskoin.Keys as Keys+import Network.Haskoin.Network as Network+import Network.Haskoin.Script as Script+import Network.Haskoin.Transaction as Transaction+import Network.Haskoin.Util as Util
src/Network/Haskoin/Address.hs view
@@ -1,12 +1,34 @@ {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE OverloadedStrings #-}+{-|+Module : Network.Haskoin.Address+Copyright : No rights reserved+License : UNLICENSE+Maintainer : xenog@protonmail.com+Stability : experimental+Portability : POSIX++Base58, CashAddr, Bech32 address and WIF private key serialization support.+-} module Network.Haskoin.Address- ( Address(..)+ ( Address+ , getAddrHash160+ , getAddrHash256+ , getAddrNet+ , isPubKeyAddress+ , isScriptAddress+ , isWitnessPubKeyAddress+ , isWitnessScriptAddress , addrToString , stringToAddr , addrFromJSON , pubKeyAddr+ , pubKeyWitnessAddr+ , p2pkhAddr+ , p2wpkhAddr+ , p2shAddr+ , p2wshAddr -- * Private Key Wallet Import Format (WIF) , fromWif , toWif@@ -19,6 +41,7 @@ import Data.Aeson.Types import qualified Data.ByteString as B import Data.Function+import Data.Hashable import Data.List import Data.Maybe import Data.Serialize as S@@ -38,18 +61,40 @@ data Address -- | pay to public key hash (regular) = PubKeyAddress { getAddrHash160 :: !Hash160- , getAddrNet :: !Network }+ -- ^ RIPEMD160 hash of public key's SHA256 hash+ , getAddrNet :: !Network+ -- ^ address network+ } -- | pay to script hash | ScriptAddress { getAddrHash160 :: !Hash160- , getAddrNet :: !Network }+ -- ^ RIPEMD160 hash of script's SHA256 hash+ , getAddrNet :: !Network+ -- ^ address network+ } -- | pay to witness public key hash | WitnessPubKeyAddress { getAddrHash160 :: !Hash160- , getAddrNet :: !Network }+ -- ^ RIPEMD160 hash of public key's SHA256 hash+ , getAddrNet :: !Network+ -- ^ address network+ } -- | pay to witness script hash | WitnessScriptAddress { getAddrHash256 :: !Hash256- , getAddrNet :: !Network }+ -- ^ HASH256 hash of script+ , getAddrNet :: !Network+ -- ^ address network+ } deriving (Eq, G.Generic) +instance Hashable Address where+ hashWithSalt i (PubKeyAddress h _) = i `hashWithSalt` h+ hashWithSalt i (ScriptAddress h _) = i `hashWithSalt` h+ hashWithSalt i (WitnessPubKeyAddress h _) = i `hashWithSalt` h+ hashWithSalt i (WitnessScriptAddress h _) = i `hashWithSalt` h+ hash (PubKeyAddress h _) = hash h+ hash (ScriptAddress h _) = hash h+ hash (WitnessPubKeyAddress h _) = hash h+ hash (WitnessScriptAddress h _) = hash h+ instance Ord Address where compare = compare `on` f where@@ -60,6 +105,27 @@ instance NFData Address +-- | 'Address' pays to a public key hash.+isPubKeyAddress :: Address -> Bool+isPubKeyAddress PubKeyAddress {} = True+isPubKeyAddress _ = False++-- | 'Address' pays to a script hash.+isScriptAddress :: Address -> Bool+isScriptAddress ScriptAddress {} = True+isScriptAddress _ = False++-- | 'Address' pays to a witness public key hash. Only valid for SegWit+-- networks.+isWitnessPubKeyAddress :: Address -> Bool+isWitnessPubKeyAddress WitnessPubKeyAddress {} = True+isWitnessPubKeyAddress _ = False++-- | 'Address' pays to a witness script hash. Only valid for SegWit networks.+isWitnessScriptAddress :: Address -> Bool+isWitnessScriptAddress WitnessScriptAddress {} = True+isWitnessScriptAddress _ = False+ -- | Deserializer for binary 'Base58' addresses. base58get :: Network -> Get Address base58get net = do@@ -83,10 +149,7 @@ base58put _ = error "Cannot serialize this address as Base58" instance Show Address where- showsPrec _ a =- case addrToString a of- Just s -> shows s- Nothing -> fail "Cannot show this transaction"+ showsPrec _ a = shows (addrToString a) instance Read Address where readPrec = do@@ -96,7 +159,7 @@ foldl' (\a n -> a <|> stringToAddr n bs) Nothing allNets instance ToJSON Address where- toJSON = A.String . fromMaybe (error "Could not encode address") . addrToString+ toJSON = A.String . addrToString -- | JSON parsing for Bitcoin addresses. Works with 'Base58', 'CashAddr' and -- 'Bech32'.@@ -109,22 +172,33 @@ -- | Convert address to human-readable string. Uses 'Base58', 'Bech32', or -- 'CashAddr' depending on network.-addrToString :: Address -> Maybe Text+addrToString :: Address -> Text addrToString a@PubKeyAddress {getAddrHash160 = h, getAddrNet = net} | isNothing (getCashAddrPrefix net) =- return $ encodeBase58Check $ runPut $ base58put a- | otherwise = cashAddrEncode net 0 (S.encode h)+ encodeBase58Check $ runPut $ base58put a+ | otherwise =+ fromMaybe (error "Colud not encode a CashAddr") $+ cashAddrEncode net 0 (S.encode h)+ addrToString a@ScriptAddress {getAddrHash160 = h, getAddrNet = net} | isNothing (getCashAddrPrefix net) =- return $ encodeBase58Check $ runPut $ base58put a- | otherwise = cashAddrEncode net 1 (S.encode h)-addrToString WitnessPubKeyAddress {getAddrHash160 = h, getAddrNet = net} = do- hrp <- getBech32Prefix net- segwitEncode hrp 0 (B.unpack (S.encode h))-addrToString WitnessScriptAddress {getAddrHash256 = h, getAddrNet = net} = do- hrp <- getBech32Prefix net- segwitEncode hrp 0 (B.unpack (S.encode h))+ encodeBase58Check $ runPut $ base58put a+ | otherwise =+ fromMaybe (error "Could not encode a CashAddr") $+ cashAddrEncode net 1 (S.encode h) +addrToString WitnessPubKeyAddress {getAddrHash160 = h, getAddrNet = net} =+ let mt = do+ hrp <- getBech32Prefix net+ segwitEncode hrp 0 (B.unpack (S.encode h))+ in fromMaybe (error "Could not encode a Bech32 address") mt++addrToString WitnessScriptAddress {getAddrHash256 = h, getAddrNet = net} =+ let mt = do+ hrp <- getBech32Prefix net+ segwitEncode hrp 0 (B.unpack (S.encode h))+ in fromMaybe (error "Could not encode a Bech32 address") mt+ -- | Parse 'Base58', 'Bech32' or 'CashAddr' address, depending on network. stringToAddr :: Network -> Text -> Maybe Address stringToAddr net bs = cash <|> segwit <|> b58@@ -155,6 +229,32 @@ -- | Obtain a P2PKH address from a public key. pubKeyAddr :: Network -> PubKeyI -> Address pubKeyAddr net k = PubKeyAddress (addressHash (S.encode k)) net++-- | Obtain a P2PKH address from a 'Hash160'.+p2pkhAddr :: Network -> Hash160 -> Address+p2pkhAddr net h = PubKeyAddress h net++-- | Obtain a P2WPKH address from a public key. Only on SegWit networks.+pubKeyWitnessAddr :: Network -> PubKeyI -> Maybe Address+pubKeyWitnessAddr net k+ | getSegWit net = Just $ WitnessPubKeyAddress (addressHash (S.encode k)) net+ | otherwise = Nothing++-- | Obtain a P2WPKH address from a 'Hash160'.+p2wpkhAddr :: Network -> Hash160 -> Maybe Address+p2wpkhAddr net h+ | getSegWit net = Just $ WitnessPubKeyAddress h net+ | otherwise = Nothing++-- | Obtain a P2SH address from a 'Hash160'.+p2shAddr :: Network -> Hash160 -> Address+p2shAddr net h = ScriptAddress h net++-- | Obtain a P2WSH address from a 'Hash256'+p2wshAddr :: Network -> Hash256 -> Maybe Address+p2wshAddr net h+ | getSegWit net = Just $ WitnessScriptAddress h net+ | otherwise = Nothing -- | Decode private key from WIF (wallet import format) string. fromWif :: Network -> Base58 -> Maybe SecKeyI
src/Network/Haskoin/Address/Base58.hs view
@@ -1,4 +1,15 @@ {-# LANGUAGE OverloadedStrings #-}+{-|+Module : Network.Haskoin.Address.Base58+Copyright : No rights reserved+License : UNLICENSE+Maintainer : xenog@protonmail.com+Stability : experimental+Portability : POSIX++Support for legacy 'Base58' addresses. Superseded by Bech32 for Bitcoin SegWit+(BTC) and CashAddr for Bitcoin Cash (BCH).+-} module Network.Haskoin.Address.Base58 ( Base58 , encodeBase58
src/Network/Haskoin/Address/Bech32.hs view
@@ -1,6 +1,15 @@ {-# LANGUAGE OverloadedStrings #-}+{-|+Module : Network.Haskoin.Address.Base58+Copyright : No rights reserved+License : UNLICENSE+Maintainer : xenog@protonmail.com+Stability : experimental+Portability : POSIX -{- Copied from reference implementation contributed by Marko Bencun -}+Support for Bitcoin SegWit (BTC) Bech32 addresses. This module is a modified+version of Marko Bencun's reference implementation.+-} module Network.Haskoin.Address.Bech32 ( HRP , Bech32
src/Network/Haskoin/Address/CashAddr.hs view
@@ -1,4 +1,14 @@ {-# LANGUAGE OverloadedStrings #-}+{-|+Module : Network.Haskoin.Address.CashAddr+Copyright : No rights reserved+License : UNLICENSE+Maintainer : xenog@protonmail.com+Stability : experimental+Portability : POSIX++Support for Bitcoin Cash (BCH) CashAddr format.+-} module Network.Haskoin.Address.CashAddr ( CashPrefix , CashVersion
src/Network/Haskoin/Block.hs view
@@ -1,3 +1,13 @@+{-|+Module : Network.Haskoin.Block+Copyright : No rights reserved+License : UNLICENSE+Maintainer : xenog@protonmail.com+Stability : experimental+Portability : POSIX++Most functions relating to blocks are exported by this module.+-} module Network.Haskoin.Block ( module Network.Haskoin.Block.Common -- * Block Header Chain
src/Network/Haskoin/Block/Common.hs view
@@ -1,4 +1,14 @@ {-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-|+Module : Network.Haskoin.Block.Common+Copyright : No rights reserved+License : UNLICENSE+Maintainer : xenog@protonmail.com+Stability : experimental+Portability : POSIX++Common data types and functions to handle blocks from the block chain.+-} module Network.Haskoin.Block.Common ( Block(..) , BlockHeight@@ -25,8 +35,7 @@ toJSON, withText) import Data.Bits (shiftL, shiftR, (.&.), (.|.))-import Data.ByteString (ByteString)-import qualified Data.ByteString as BS+import qualified Data.ByteString as B import Data.Hashable (Hashable) import Data.Maybe (fromMaybe) import Data.Serialize (Serialize, decode, encode,@@ -43,7 +52,7 @@ import Network.Haskoin.Util import qualified Text.Read as R --- | Height of a block in the blockchain, starting at 0 for Genesis.+-- | Height of a block in the block chain, starting at 0 for Genesis. type BlockHeight = Word32 -- | Block timestamp as Unix time (seconds since 1970-01-01 00:00 UTC).@@ -97,13 +106,13 @@ -- | Block hashes are reversed with respect to the in-memory byte order in a -- block hash when displayed. blockHashToHex :: BlockHash -> Text-blockHashToHex (BlockHash h) = encodeHex (BS.reverse (encode h))+blockHashToHex (BlockHash h) = encodeHex (B.reverse (encode h)) -- | Convert a human-readable hex block hash into a 'BlockHash'. Bytes are -- reversed as normal. hexToBlockHash :: Text -> Maybe BlockHash hexToBlockHash hex = do- bs <- BS.reverse <$> decodeHex hex+ bs <- B.reverse <$> decodeHex hex h <- eitherToMaybe (decode bs) return $ BlockHash h @@ -208,7 +217,7 @@ -- only. The response to a 'GetHeaders' request is a 'Headers' message -- containing a list of block headers. A maximum of 2000 block headers can be -- returned. 'GetHeaders' is used by simplified payment verification (SPV)--- clients to exclude block contents when synchronizing the blockchain.+-- clients to exclude block contents when synchronizing the block chain. data GetHeaders = GetHeaders { -- | protocol version
src/Network/Haskoin/Block/Headers.hs view
@@ -1,6 +1,16 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE RecordWildCards #-}+{-|+Module : Network.Haskoin.Block.Headers+Copyright : No rights reserved+License : UNLICENSE+Maintainer : xenog@protonmail.com+Stability : experimental+Portability : POSIX++Block chain header synchronization and proof-of-work consensus functions.+-} module Network.Haskoin.Block.Headers ( BlockNode(..) , BlockHeaders(..)@@ -86,11 +96,11 @@ -- structure compact. type BlockMap = HashMap ShortBlockHash ShortByteString --- | Represents accumulated work in the blockchain so far.+-- | Represents accumulated work in the block chain so far. type BlockWork = Integer -- | Data structure representing a block header and its position in the--- blockchain.+-- block chain. data BlockNode -- | non-Genesis block header = BlockNode { nodeHeader :: !BlockHeader@@ -251,7 +261,7 @@ } -- | Validate a list of continuous block headers and import them to the--- blockchain. Return 'Left' on failure with error information.+-- block chain. Return 'Left' on failure with error information. connectBlocks :: BlockHeaders m => Network -> Timestamp -- ^ current time@@ -306,7 +316,7 @@ -> m (Maybe BlockNode) parentBlock bh = getBlockHeader (prevBlock bh) --- | Validate and connect single block header to the blockchain. Return 'Left' if fails+-- | Validate and connect single block header to the block chain. Return 'Left' if fails -- to be validated. connectBlock :: BlockHeaders m@@ -552,6 +562,7 @@ blockTimestamp bh > blockTimestamp (nodeHeader par) + getTargetSpacing net * 2 +-- | Compute Bitcoin Cash DAA target for a new block. computeTarget :: Network -> BlockNode -> BlockNode -> Integer computeTarget net f l = let work = (nodeWork l - nodeWork f) * fromIntegral (getTargetSpacing net)@@ -566,6 +577,7 @@ work' = work `div` fromIntegral actualTimespan' in 2 ^ (256 :: Integer) `div` work' +-- | Get suitable block for Bitcoin Cash DAA computation. getSuitableBlock :: BlockHeaders m => BlockNode -> m BlockNode getSuitableBlock par = do unless (nodeHeight par >= 3) $ error "Block height is less than three"
src/Network/Haskoin/Block/Merkle.hs view
@@ -1,3 +1,13 @@+{-|+Module : Network.Haskoin.Block.Merkle+Copyright : No rights reserved+License : UNLICENSE+Maintainer : xenog@protonmail.com+Stability : experimental+Portability : POSIX++Function to deal with Merkle trees inside blocks.+-} module Network.Haskoin.Block.Merkle ( MerkleBlock(..) , MerkleRoot
src/Network/Haskoin/Constants.hs view
@@ -1,5 +1,16 @@ {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE OverloadedStrings #-}+{-|+Module : Network.Haskoin.Constants+Copyright : No rights reserved+License : UNLICENSE+Maintainer : xenog@protonmail.com+Stability : experimental+Portability : POSIX++Network constants for various networks, including Bitcoin SegWit (BTC), Bitcoin+Cash (BCH), and corresponding public test and private regression test networks.+-} module Network.Haskoin.Constants ( Network(..) , btc@@ -14,7 +25,7 @@ ) where import Control.DeepSeq-import Data.ByteString (ByteString)+import Data.ByteString (ByteString) import Data.List import Data.Maybe import Data.String@@ -92,6 +103,8 @@ , getCashAddrPrefix :: !(Maybe Text) -- | 'Bech32' prefix (for SegWit network) , getBech32Prefix :: !(Maybe Text)+ -- | Replace-By-Fee (BIP-125)+ , getReplaceByFee :: !Bool } deriving (Eq, Generic) instance NFData Network@@ -196,6 +209,7 @@ , getSegWit = True , getCashAddrPrefix = Nothing , getBech32Prefix = Just "bc"+ , getReplaceByFee = True } -- | Testnet for Bitcoin SegWit network.@@ -251,6 +265,7 @@ , getSegWit = True , getCashAddrPrefix = Nothing , getBech32Prefix = Just "tb"+ , getReplaceByFee = True } -- | RegTest for Bitcoin SegWit network.@@ -298,6 +313,7 @@ , getSegWit = True , getCashAddrPrefix = Nothing , getBech32Prefix = Just "bcrt"+ , getReplaceByFee = True } -- | Bitcoin Cash network. Symbol: BCH.@@ -385,6 +401,7 @@ , getSegWit = False , getCashAddrPrefix = Just "bitcoincash" , getBech32Prefix = Nothing+ , getReplaceByFee = False } -- | Testnet for Bitcoin Cash network.@@ -447,6 +464,7 @@ , getSegWit = False , getCashAddrPrefix = Just "bchtest" , getBech32Prefix = Nothing+ , getReplaceByFee = False } -- | RegTest for Bitcoin Cash network.@@ -497,7 +515,9 @@ , getSegWit = False , getCashAddrPrefix = Just "bchreg" , getBech32Prefix = Nothing+ , getReplaceByFee = False } +-- | List of all networks supported by this library. allNets :: [Network] allNets = [btc, bch, btcTest, bchTest, btcRegTest, bchRegTest]
src/Network/Haskoin/Crypto.hs view
@@ -1,6 +1,22 @@+{-|+Module : Network.Haskoin.Crypto+Copyright : No rights reserved+License : UNLICENSE+Maintainer : xenog@protonmail.com+Stability : experimental+Portability : POSIX++Hashing functions and ECDSA signatures.+-} module Network.Haskoin.Crypto- ( module X+ ( -- * Hashes+ module Hash+ -- * Signatures+ , module Signature+ -- * Secp256k1 (re-exported)+ , module Secp256k1 ) where -import Network.Haskoin.Crypto.Hash as X-import Network.Haskoin.Crypto.Signature as X+import Crypto.Secp256k1 as Secp256k1+import Network.Haskoin.Crypto.Hash as Hash+import Network.Haskoin.Crypto.Signature as Signature
src/Network/Haskoin/Crypto/Hash.hs view
@@ -1,4 +1,15 @@ {-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-|+Module : Network.Haskoin.Crypto.Hash+Copyright : No rights reserved+License : UNLICENSE+Maintainer : xenog@protonmail.com+Stability : experimental+Portability : POSIX++Hashing functions and corresponding data types. Uses functions from the+cryptonite library.+-} module Network.Haskoin.Crypto.Hash ( -- * Hashes Hash512(getHash512)
src/Network/Haskoin/Crypto/Signature.hs view
@@ -1,15 +1,23 @@ {-# LANGUAGE OverloadedStrings #-}+{-|+Module : Network.Haskoin.Crypto.Signature+Copyright : No rights reserved+License : UNLICENSE+Maintainer : xenog@protonmail.com+Stability : experimental+Portability : POSIX++ECDSA signatures using secp256k1 curve. Uses functions from upstream secp256k1+library.+-} module Network.Haskoin.Crypto.Signature- ( -- * Signatures- Sig- , putSig+ ( putSig , getSig , signHash , verifyHashSig , isCanonicalHalfOrder , decodeStrictSig , exportSig- , exportCompactSig ) where import Control.Monad (guard, unless, when)
src/Network/Haskoin/Keys.hs view
@@ -1,3 +1,14 @@+{-|+Module : Network.Haskoin.Keys+Copyright : No rights reserved+License : UNLICENSE+Maintainer : xenog@protonmail.com+Stability : experimental+Portability : POSIX++ECDSA private and public keys, extended keys (BIP-32) and mnemonic sentences+(BIP-39).+-} module Network.Haskoin.Keys ( module X ) where
src/Network/Haskoin/Keys/Common.hs view
@@ -1,16 +1,23 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE OverloadedStrings #-}+{-|+Module : Network.Haskoin.Keys.Common+Copyright : No rights reserved+License : UNLICENSE+Maintainer : xenog@protonmail.com+Stability : experimental+Portability : POSIX++ECDSA private and public key functions.+-} module Network.Haskoin.Keys.Common ( -- * Public & Private Keys PubKeyI(..) , SecKeyI(..)- , PubKey- , SecKey , exportPubKey , importPubKey , wrapPubKey- , derivePubKey , derivePubKeyI , wrapSecKey , fromMiniKey@@ -115,14 +122,15 @@ wrapSecKey :: Bool -> SecKey -> SecKeyI wrapSecKey c d = SecKeyI d c +-- | Deserialize 'SecKey'. secKeyGet :: Get SecKey secKeyGet = do bs <- getByteString 32 maybe (fail "invalid private key") return (secKey bs) +-- | Serialize 'SecKey'. secKeyPut :: Putter SecKey secKeyPut = putByteString . getSecKey- -- | Decode Casascius mini private keys (22 or 30 characters). fromMiniKey :: ByteString -> Maybe SecKeyI
src/Network/Haskoin/Keys/Extended.hs view
@@ -1,11 +1,18 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE OverloadedStrings #-}+{-|+Module : Network.Haskoin.Keys.Extended+Copyright : No rights reserved+License : UNLICENSE+Maintainer : xenog@protonmail.com+Stability : experimental+Portability : POSIX++BIP-32 extended keys.+-} module Network.Haskoin.Keys.Extended (- -- * Extended Keys- -- | See BIP32 for details:- -- <https://github.com/bitcoin/bips/blob/master/bip-0032.mediawiki> XPubKey(..) , XPrvKey(..) , ChainCode@@ -84,13 +91,14 @@ import Control.DeepSeq (NFData, rnf) import Control.Exception (Exception, throw) import Control.Monad (guard, mzero, unless, (<=<))+import Crypto.Secp256k1 import Data.Aeson as A (FromJSON, ToJSON, Value (String), parseJSON, toJSON, withText) import Data.Aeson.Types (Parser) import Data.Bits (clearBit, setBit, testBit) import Data.ByteString (ByteString)-import qualified Data.ByteString as BS+import qualified Data.ByteString as B import Data.Either (fromRight) import Data.List (foldl') import Data.List.Split (splitOn)@@ -124,7 +132,10 @@ instance Exception DerivationException +-- | Chain code as specified in BIP-32. type ChainCode = Hash256++-- | Index of key as specified in BIP-32. type KeyIndex = Word32 -- | Data type representing an extended BIP32 private key. An extended key@@ -241,8 +252,8 @@ | otherwise = error "Invalid child derivation index" where pK = xPubKey $ deriveXPubKey xkey- msg = BS.append (exportPubKey True pK) (encode child)- (a, c) = split512 $ hmac512 (encode $ xPrvChain xkey) msg+ m = B.append (exportPubKey True pK) (encode child)+ (a, c) = split512 $ hmac512 (encode $ xPrvChain xkey) m k = fromMaybe err $ tweakSecKey (xPrvKey xkey) a err = throw $ DerivationException "Invalid prvSubKey derivation" @@ -256,8 +267,8 @@ XPubKey (xPubDepth xKey + 1) (xPubFP xKey) child c pK (xPubNet xKey) | otherwise = error "Invalid child derivation index" where- msg = BS.append (exportPubKey True (xPubKey xKey)) (encode child)- (a, c) = split512 $ hmac512 (encode $ xPubChain xKey) msg+ m = B.append (exportPubKey True (xPubKey xKey)) (encode child)+ (a, c) = split512 $ hmac512 (encode $ xPubChain xKey) m pK = fromMaybe err $ tweakPubKey (xPubKey xKey) a err = throw $ DerivationException "Invalid pubSubKey derivation" @@ -276,8 +287,8 @@ | otherwise = error "Invalid child derivation index" where i = setBit child 31- msg = BS.append (bsPadPrvKey $ xPrvKey xkey) (encode i)- (a, c) = split512 $ hmac512 (encode $ xPrvChain xkey) msg+ m = B.append (bsPadPrvKey $ xPrvKey xkey) (encode i)+ (a, c) = split512 $ hmac512 (encode $ xPrvChain xkey) m k = fromMaybe err $ tweakSecKey (xPrvKey xkey) a err = throw $ DerivationException "Invalid hardSubKey derivation" @@ -312,14 +323,14 @@ -- | Computes the key fingerprint of an extended private key. xPrvFP :: XPrvKey -> Word32 xPrvFP =- fromRight err . decode . BS.take 4 . encode . xPrvID+ fromRight err . decode . B.take 4 . encode . xPrvID where err = error "Could not decode xPrvFP" -- | Computes the key fingerprint of an extended public key. xPubFP :: XPubKey -> Word32 xPubFP =- fromRight err . decode . BS.take 4 . encode . xPubID+ fromRight err . decode . B.take 4 . encode . xPubID where err = error "Could not decode xPubFP" @@ -433,7 +444,7 @@ -- public, soft derivation. deriveMSAddr :: Network -> [XPubKey] -> Int -> KeyIndex -> (Address, RedeemScript) deriveMSAddr net keys m i- | all ((== net) . xPubNet) keys = (p2shAddr net rdm, rdm)+ | all ((== net) . xPubNet) keys = (payToScriptAddress net rdm, rdm) | otherwise = error "Some extended public keys on the wrong network" where rdm = sortMulSig $ PayMulSig k m@@ -459,18 +470,32 @@ {- Derivation Paths -} +-- | Phantom type signaling a hardened derivation path that can only be computed+-- from private extended key. data HardDeriv++-- | Phantom type signaling no knowledge about derivation path: can be hardened or not. data AnyDeriv++-- | Phantom type signaling derivation path including only non-hardened paths+-- that can be computed from an extended public key. data SoftDeriv +-- | Hardened derivation path. Can be computed from extended private key only. type HardPath = DerivPathI HardDeriv++-- | Any derivation path. type DerivPath = DerivPathI AnyDeriv++-- | Non-hardened derivation path can be computed from extended public key. type SoftPath = DerivPathI SoftDeriv +-- | Helper class to perform validations on a hardened derivation path. class HardOrAny a instance HardOrAny HardDeriv instance HardOrAny AnyDeriv +-- | Helper class to perform validations on a non-hardened derivation path. class AnyOrSoft a instance AnyOrSoft AnyDeriv instance AnyOrSoft SoftDeriv
src/Network/Haskoin/Keys/Mnemonic.hs view
@@ -1,5 +1,14 @@ {-# LANGUAGE OverloadedStrings #-}--- | Mnemonic keys (BIP-39). Only English dictionary.+{-|+Module : Network.Haskoin.Keys.Mnemonic+Copyright : No rights reserved+License : UNLICENSE+Maintainer : xenog@protonmail.com+Stability : experimental+Portability : POSIX++Mnemonic keys (BIP-39). Only English dictionary.+-} module Network.Haskoin.Keys.Mnemonic ( -- * Mnemonic Sentences Entropy@@ -18,7 +27,6 @@ import qualified Data.ByteArray as BA import Data.ByteString (ByteString) import qualified Data.ByteString as BS-import qualified Data.ByteString.Char8 as C (unwords, words) import Data.List import qualified Data.Map.Strict as M import Data.Maybe
src/Network/Haskoin/Network.hs view
@@ -1,8 +1,14 @@ {-|- This package provides basic types used for the Bitcoin networking protocol- together with Data.Serialize instances for efficiently serializing and- de-serializing them. More information on the bitcoin protocol is available- here: <http://en.bitcoin.it/wiki/Protocol_specification>+Module : Network.Haskoin.Network+Copyright : No rights reserved+License : UNLICENSE+Maintainer : xenog@protonmail.com+Stability : experimental+Portability : POSIX++This module provides basic types used for the Bitcoin networking protocol+together with 'Data.Serialize' instances for efficiently serializing and+de-serializing them. -} module Network.Haskoin.Network ( module Common
src/Network/Haskoin/Network/Bloom.hs view
@@ -1,8 +1,15 @@ {-|- Bloom filters are used to reduce data transfer when synchronizing thin cients.- When bloom filters are used a client will obtain filtered blocks that only- contain transactions that pass the bloom filter. Transactions announced via- inv messages also pass the filter.+Module : Network.Haskoin.Network.Bloom+Copyright : No rights reserved+License : UNLICENSE+Maintainer : xenog@protonmail.com+Stability : experimental+Portability : POSIX++Bloom filters are used to reduce data transfer when synchronizing thin cients.+When bloom filters are used a client will obtain filtered blocks that only+contain transactions that pass the bloom filter. Transactions announced via inv+messages also pass the filter. -} module Network.Haskoin.Network.Bloom ( -- * Bloom Filters
src/Network/Haskoin/Network/Common.hs view
@@ -1,5 +1,15 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-}+{-|+Module : Network.Haskoin.Network.Common+Copyright : No rights reserved+License : UNLICENSE+Maintainer : xenog@protonmail.com+Stability : experimental+Portability : POSIX++Common functions and data types related to peer-to-peer network.+-} module Network.Haskoin.Network.Common ( -- * Network Data Types Addr(..)@@ -305,7 +315,7 @@ , rejectData :: !ByteString } deriving (Eq, Show, Read) -+-- | Rejection code associated to the 'Reject' message. data RejectCode = RejectMalformed | RejectInvalid
src/Network/Haskoin/Network/Message.hs view
@@ -1,3 +1,13 @@+{-|+Module : Network.Haskoin.Network.Message+Copyright : No rights reserved+License : UNLICENSE+Maintainer : xenog@protonmail.com+Stability : experimental+Portability : POSIX++Peer-to-peer network message serialization.+-} module Network.Haskoin.Network.Message ( -- * Network Message Message(..)
src/Network/Haskoin/Script.hs view
@@ -1,7 +1,14 @@ {-|- This package provides functions for parsing and evaluating bitcoin- transaction scripts. Data types are provided for building and- deconstructing all of the standard input and output script types.+Module : Network.Haskoin.Script+Copyright : No rights reserved+License : UNLICENSE+Maintainer : xenog@protonmail.com+Stability : experimental+Portability : POSIX++This module provides functions for parsing and evaluating bitcoin+transaction scripts. Data types are provided for building and+deconstructing all of the standard input and output script types. -} module Network.Haskoin.Script ( module X
src/Network/Haskoin/Script/Common.hs view
@@ -1,4 +1,14 @@ {-# LANGUAGE OverloadedStrings #-}+{-|+Module : Network.Haskoin.Script.Common+Copyright : No rights reserved+License : UNLICENSE+Maintainer : xenog@protonmail.com+Stability : experimental+Portability : POSIX++Common script-related functions and data types.+-} module Network.Haskoin.Script.Common ( ScriptOp(..) , Script(..)@@ -32,7 +42,6 @@ isEmpty) import Data.Serialize.Put (putByteString, putWord16le, putWord32le, putWord8)-import Data.String.Conversions import Data.Word (Word8) import Network.Haskoin.Crypto.Hash import Network.Haskoin.Keys.Common@@ -604,36 +613,37 @@ rnf (PayWitnessScriptHash h) = rnf h rnf (DataCarrier a) = rnf a --- | Returns True if the script is a pay to public key output.+-- | Is script a pay-to-public-key output? isPayPK :: ScriptOutput -> Bool isPayPK (PayPK _) = True isPayPK _ = False --- | Returns True if the script is a pay to public key hash output.+-- | Is script a pay-to-pub-key-hash output? isPayPKHash :: ScriptOutput -> Bool isPayPKHash (PayPKHash _) = True isPayPKHash _ = False --- | Returns True if the script is a multisig output.+-- | Is script a pay-to-multi-sig output? isPayMulSig :: ScriptOutput -> Bool isPayMulSig (PayMulSig _ _) = True isPayMulSig _ = False --- | Returns true if the script is a pay to script hash output.+-- | Is script a pay-to-script-hash output? isPayScriptHash :: ScriptOutput -> Bool isPayScriptHash (PayScriptHash _) = True isPayScriptHash _ = False --- | Returns true if the script is a pay to witness public key hash output.+-- | Is script a pay-to-witness-pub-key-hash output? isPayWitnessPKHash :: ScriptOutput -> Bool isPayWitnessPKHash (PayWitnessPKHash _) = True isPayWitnessPKHash _ = False +-- | Is script a pay-to-witness-script-hash output? isPayWitnessScriptHash :: ScriptOutput -> Bool isPayWitnessScriptHash (PayWitnessScriptHash _) = True isPayWitnessScriptHash _ = False --- | Returns True if the script is an @OP_RETURN@ "datacarrier" output+-- | Is script a data carrier output? isDataCarrier :: ScriptOutput -> Bool isDataCarrier (DataCarrier _) = True isDataCarrier _ = False
src/Network/Haskoin/Script/SigHash.hs view
@@ -1,5 +1,15 @@ {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE OverloadedStrings #-}+{-|+Module : Network.Haskoin.Script.SigHash+Copyright : No rights reserved+License : UNLICENSE+Maintainer : xenog@protonmail.com+Stability : experimental+Portability : POSIX++Transaction signatures and related functions.+-} module Network.Haskoin.Script.SigHash ( SigHash , SigHashFlag(..)@@ -26,6 +36,7 @@ import Control.DeepSeq (NFData, rnf) import Control.Monad+import Crypto.Secp256k1 import qualified Data.Aeson as J import Data.Bits import Data.ByteString (ByteString)@@ -43,12 +54,18 @@ import Network.Haskoin.Transaction.Common import Network.Haskoin.Util +-- | Constant representing a SIGHASH flag that controls what is being signed. data SigHashFlag = SIGHASH_ALL+ -- ^ sign all outputs | SIGHASH_NONE+ -- ^ sign no outputs | SIGHASH_SINGLE+ -- ^ sign the output index corresponding to the input | SIGHASH_FORKID+ -- ^ replay protection for Bitcoin Cash transactions | SIGHASH_ANYONECANPAY+ -- ^ new inputs can be added deriving (Eq, Ord, Show) instance Enum SigHashFlag where@@ -86,57 +103,69 @@ instance J.ToJSON SigHash where toJSON = J.Number . fromIntegral +-- | SIGHASH_NONE as a byte. sigHashNone :: SigHash sigHashNone = fromIntegral $ fromEnum SIGHASH_NONE +-- | SIGHASH_ALL as a byte. sigHashAll :: SigHash sigHashAll = fromIntegral $ fromEnum SIGHASH_ALL +-- | SIGHASH_SINGLE as a byte. sigHashSingle :: SigHash sigHashSingle = fromIntegral $ fromEnum SIGHASH_SINGLE +-- | SIGHASH_FORKID as a byte. sigHashForkId :: SigHash sigHashForkId = fromIntegral $ fromEnum SIGHASH_FORKID +-- | SIGHASH_ANYONECANPAY as a byte. sigHashAnyoneCanPay :: SigHash sigHashAnyoneCanPay = fromIntegral $ fromEnum SIGHASH_ANYONECANPAY +-- | Set SIGHASH_FORKID flag. setForkIdFlag :: SigHash -> SigHash setForkIdFlag = (.|. sigHashForkId) +-- | Set SIGHASH_ANYONECANPAY flag. setAnyoneCanPayFlag :: SigHash -> SigHash setAnyoneCanPayFlag = (.|. sigHashAnyoneCanPay) +-- | Is the SIGHASH_FORKID flag set? hasForkIdFlag :: SigHash -> Bool hasForkIdFlag = (/= 0) . (.&. sigHashForkId) +-- | Is the SIGHASH_ANYONECANPAY flag set? hasAnyoneCanPayFlag :: SigHash -> Bool hasAnyoneCanPayFlag = (/= 0) . (.&. sigHashAnyoneCanPay) --- | Returns True if the 'SigHash' has the value 'SIGHASH_ALL'.+-- | Returns 'True' if the 'SigHash' has the value 'SIGHASH_ALL'. isSigHashAll :: SigHash -> Bool isSigHashAll = (== sigHashAll) . (.&. 0x1f) --- | Returns True if the 'SigHash' has the value 'SIGHASH_NONE'.+-- | Returns 'True' if the 'SigHash' has the value 'SIGHASH_NONE'. isSigHashNone :: SigHash -> Bool isSigHashNone = (== sigHashNone) . (.&. 0x1f) --- | Returns True if the 'SigHash' has the value 'SIGHASH_SINGLE'.+-- | Returns 'True' if the 'SigHash' has the value 'SIGHASH_SINGLE'. isSigHashSingle :: SigHash -> Bool isSigHashSingle = (== sigHashSingle) . (.&. 0x1f) --- | Returns True if the 'SigHash' has the value 'SIGHASH_UNKNOWN'.+-- | Returns 'True' if the 'SigHash' has the value 'SIGHASH_UNKNOWN'. isSigHashUnknown :: SigHash -> Bool isSigHashUnknown = (`notElem` [sigHashAll, sigHashNone, sigHashSingle]) . (.&. 0x1f) +-- | Add a fork id to a 'SigHash'. sigHashAddForkId :: SigHash -> Word32 -> SigHash sigHashAddForkId sh w = (fromIntegral w `shiftL` 8) .|. (sh .&. 0x000000ff) +-- | Add fork id of a particular network to a 'SigHash'. sigHashAddNetworkId :: Network -> SigHash -> SigHash sigHashAddNetworkId net = (`sigHashAddForkId` fromMaybe 0 (getSigHashForkId net)) +-- | Get fork id from 'SigHash'. sigHashGetForkId :: SigHash -> Word32 sigHashGetForkId = fromIntegral . (`shiftR` 8)
src/Network/Haskoin/Script/Standard.hs view
@@ -1,19 +1,30 @@ {-# LANGUAGE OverloadedStrings #-}+{-|+Module : Network.Haskoin.Script.Standard+Copyright : No rights reserved+License : UNLICENSE+Maintainer : xenog@protonmail.com+Stability : experimental+Portability : POSIX++Standard scripts like pay-to-public-key, pay-to-public-key-hash,+pay-to-script-hash, pay-to-multisig and corresponding SegWit variants.+-} module Network.Haskoin.Script.Standard ( ScriptInput(..) , SimpleInput(..) , RedeemScript-, p2shAddr-, p2wshAddr-, outputAddress , inputAddress+, outputAddress , encodeInput , encodeInputBS , decodeInput , decodeInputBS-, addressToOutput , addressToScript , addressToScriptBS+, addressToOutput+, payToScriptAddress+, payToWitnessScriptAddress , scriptToAddress , scriptToAddressBS , sortMulSig@@ -46,13 +57,19 @@ -- pay-to-script-hash transactions. data SimpleInput -- | spend pay-to-public-key output- = SpendPK { getInputSig :: !TxSignature }+ = SpendPK { getInputSig :: !TxSignature+ -- ^ transaction signature+ } -- | spend pay-to-public-key-hash output | SpendPKHash { getInputSig :: !TxSignature+ -- ^ embedded signature , getInputKey :: !PubKeyI- }+ -- ^ public key+ } -- | spend multisig output- | SpendMulSig { getInputMulSigKeys :: ![TxSignature] }+ | SpendMulSig { getInputMulSigKeys :: ![TxSignature]+ -- ^ list of signatures+ } deriving (Eq, Show) instance NFData SimpleInput where@@ -86,48 +103,50 @@ -- script. It must be included in inputs that spend pay-to-script-hash outputs. type RedeemScript = ScriptOutput +-- | Standard input script high-level representation. data ScriptInput- = RegularInput { getRegularInput :: SimpleInput }- | ScriptHashInput { getScriptHashInput :: SimpleInput- , getScriptHashRedeem :: RedeemScript- }+ = RegularInput {+ getRegularInput :: SimpleInput+ -- ^ get wrapped simple input+ }+ | ScriptHashInput {+ getScriptHashInput :: SimpleInput+ -- ^ get simple input associated with redeem script+ , getScriptHashRedeem :: RedeemScript+ -- ^ redeem script+ } deriving (Eq, Show) instance NFData ScriptInput where rnf (RegularInput i) = rnf i rnf (ScriptHashInput i o) = rnf i `seq` rnf o - -- | Compute a pay-to-script-hash address for an output script.-p2shAddr :: Network -> ScriptOutput -> Address-p2shAddr net out = ScriptAddress (addressHash (encodeOutputBS out)) net+payToScriptAddress :: Network -> ScriptOutput -> Address+payToScriptAddress net out = p2shAddr net (addressHash (encodeOutputBS out)) -- | Compute a pay-to-witness-script-hash address for an output script. Only on -- SegWit networks.-p2wshAddr :: Network -> ScriptOutput -> Maybe Address-p2wshAddr net out = do- guard (getSegWit net)- return $ WitnessScriptAddress (sha256 (encodeOutputBS out)) net+payToWitnessScriptAddress :: Network -> ScriptOutput -> Maybe Address+payToWitnessScriptAddress net out = p2wshAddr net (sha256 (encodeOutputBS out)) -- | Encode an output script from an address. Will fail if using a -- pay-to-witness address on a non-SegWit network.-addressToOutput :: Address -> Maybe ScriptOutput-addressToOutput (PubKeyAddress h _) = Just (PayPKHash h)-addressToOutput (ScriptAddress h _) = Just (PayScriptHash h)-addressToOutput (WitnessPubKeyAddress h n)- | getSegWit n = Just (PayWitnessPKHash h)- | otherwise = Nothing-addressToOutput (WitnessScriptAddress h n)- | getSegWit n = Just (PayWitnessScriptHash h)- | otherwise = Nothing+addressToOutput :: Address -> ScriptOutput+addressToOutput a+ | isPubKeyAddress a = PayPKHash (getAddrHash160 a)+ | isScriptAddress a = PayScriptHash (getAddrHash160 a)+ | isWitnessPubKeyAddress a = PayWitnessPKHash (getAddrHash160 a)+ | isWitnessScriptAddress a = PayWitnessScriptHash (getAddrHash256 a)+ | otherwise = undefined -- | Get output script AST for an 'Address'.-addressToScript :: Address -> Maybe Script-addressToScript a = encodeOutput <$> addressToOutput a+addressToScript :: Address -> Script+addressToScript = encodeOutput . addressToOutput -- | Encode address as output script in 'ByteString' form.-addressToScriptBS :: Address -> Maybe ByteString-addressToScriptBS a = encode <$> addressToScript a+addressToScriptBS :: Address -> ByteString+addressToScriptBS = encode . addressToScript -- | Decode an output script into an 'Address' if it has such representation. scriptToAddress :: Network -> Script -> Maybe Address@@ -141,20 +160,22 @@ outputAddress :: Network -> ScriptOutput -> Either String Address outputAddress net s = case s of- PayPKHash h -> return $ PubKeyAddress h net- PayScriptHash h -> return $ ScriptAddress h net- PayPK k -> return $ pubKeyAddr net k- PayWitnessPKHash h- | getSegWit net -> return $ WitnessPubKeyAddress h net- PayWitnessScriptHash h- | getSegWit net -> return $ WitnessScriptAddress h net+ PayPKHash h -> Right $ p2pkhAddr net h+ PayScriptHash h -> Right $ p2shAddr net h+ PayPK k -> Right $ pubKeyAddr net k+ PayWitnessPKHash h ->+ maybeToEither "outputAddress: segwit not supported in this network" $+ p2wpkhAddr net h+ PayWitnessScriptHash h ->+ maybeToEither "outputAddress: segwit not supported in this network" $+ p2wshAddr net h _ -> Left "outputAddress: bad output script type" -- | Infer the address of a 'ScriptInput' inputAddress :: Network -> ScriptInput -> Either String Address inputAddress net s = case s of RegularInput (SpendPKHash _ key) -> return $ pubKeyAddr net key- ScriptHashInput _ rdm -> return $ p2shAddr net rdm+ ScriptHashInput _ rdm -> return $ payToScriptAddress net rdm _ -> Left "inputAddress: bad input script type" -- | Heuristic to decode an input script into one of the standard types.
src/Network/Haskoin/Test.hs view
@@ -1,5 +1,12 @@ {-|- This package provides test types for Network.Haskoin+Module : Network.Haskoin.Test+Copyright : No rights reserved+License : UNLICENSE+Maintainer : xenog@protonmail.com+Stability : experimental+Portability : POSIX++Arbitrary instances for testing. -} module Network.Haskoin.Test ( module X
src/Network/Haskoin/Test/Address.hs view
@@ -1,5 +1,10 @@ {-|- Arbitrary types for Network.Haskoin.Crypto+Module : Network.Haskoin.Test.Address+Copyright : No rights reserved+License : UNLICENSE+Maintainer : xenog@protonmail.com+Stability : experimental+Portability : POSIX -} module Network.Haskoin.Test.Address where @@ -15,8 +20,8 @@ -- | Arbitrary pay-to-public-key-hash address. arbitraryPubKeyAddress :: Network -> Gen Address-arbitraryPubKeyAddress net = PubKeyAddress <$> arbitraryHash160 <*> pure net+arbitraryPubKeyAddress net = p2pkhAddr net <$> arbitraryHash160 -- | Arbitrary pay-to-script-hash address. arbitraryScriptAddress :: Network -> Gen Address-arbitraryScriptAddress net = ScriptAddress <$> arbitraryHash160 <*> pure net+arbitraryScriptAddress net = p2shAddr net <$> arbitraryHash160
src/Network/Haskoin/Test/Block.hs view
@@ -1,5 +1,10 @@ {-|- Arbitrary types for Network.Haskoin.Block+Module : Network.Haskoin.Test.Block+Copyright : No rights reserved+License : UNLICENSE+Maintainer : xenog@protonmail.com+Stability : experimental+Portability : POSIX -} module Network.Haskoin.Test.Block where
src/Network/Haskoin/Test/Crypto.hs view
@@ -1,5 +1,10 @@ {-|- Arbitrary types for Network.Haskoin.Crypto+Module : Network.Haskoin.Test.Crypto+Copyright : No rights reserved+License : UNLICENSE+Maintainer : xenog@protonmail.com+Stability : experimental+Portability : POSIX -} module Network.Haskoin.Test.Crypto where
src/Network/Haskoin/Test/Keys.hs view
@@ -1,14 +1,18 @@ {-|- Arbitrary types for Network.Haskoin.Crypto+Module : Network.Haskoin.Test.Keys+Copyright : No rights reserved+License : UNLICENSE+Maintainer : xenog@protonmail.com+Stability : experimental+Portability : POSIX -} module Network.Haskoin.Test.Keys where -import Data.Bits (clearBit)-import Data.List (foldl')-import Data.Word (Word32)+import Data.Bits (clearBit)+import Data.List (foldl')+import Data.Word (Word32) import Network.Haskoin.Constants-import Network.Haskoin.Crypto.Hash-import Network.Haskoin.Crypto.Signature+import Network.Haskoin.Crypto import Network.Haskoin.Keys.Common import Network.Haskoin.Keys.Extended import Network.Haskoin.Test.Crypto@@ -77,7 +81,7 @@ -- nonce. arbitrarySignature :: Gen (Hash256, SecKey, Sig) arbitrarySignature = do- msg <- arbitraryHash256+ m <- arbitraryHash256 key <- arbitrary- let sig = signHash key msg- return (msg, key, sig)+ let sig = signHash key m+ return (m, key, sig)
src/Network/Haskoin/Test/Message.hs view
@@ -1,5 +1,10 @@ {-|- Arbitrary types for Network.Haskoin.Node.Message+Module : Network.Haskoin.Test.Message+Copyright : No rights reserved+License : UNLICENSE+Maintainer : xenog@protonmail.com+Stability : experimental+Portability : POSIX -} module Network.Haskoin.Test.Message where
src/Network/Haskoin/Test/Network.hs view
@@ -1,5 +1,10 @@ {-|- Arbitrary types for Network.Haskoin.Network+Module : Network.Haskoin.Test.Network+Copyright : No rights reserved+License : UNLICENSE+Maintainer : xenog@protonmail.com+Stability : experimental+Portability : POSIX -} module Network.Haskoin.Test.Network where
src/Network/Haskoin/Test/Script.hs view
@@ -1,8 +1,14 @@ {-|- Arbitrary types for Network.Haskoin.Script+Module : Network.Haskoin.Test.Script+Copyright : No rights reserved+License : UNLICENSE+Maintainer : xenog@protonmail.com+Stability : experimental+Portability : POSIX -} module Network.Haskoin.Test.Script where +import Crypto.Secp256k1 import Data.Maybe import Data.Word import Network.Haskoin.Address
src/Network/Haskoin/Test/Transaction.hs view
@@ -1,5 +1,10 @@ {-|- Arbitrary types for Network.Haskoin.Transaction.+Module : Network.Haskoin.Test.Transaction+Copyright : No rights reserved+License : UNLICENSE+Maintainer : xenog@protonmail.com+Stability : experimental+Portability : POSIX -} module Network.Haskoin.Test.Transaction where import Control.Monad@@ -18,6 +23,7 @@ import Network.Haskoin.Transaction import Test.QuickCheck +-- | Wrapped coin value for testing. newtype TestCoin = TestCoin { getTestCoin :: Word64 } deriving (Eq, Show) @@ -61,6 +67,7 @@ arbitraryWitnessTx :: Network -> Gen Tx arbitraryWitnessTx net = arbitraryWLTx net True +-- | Arbitrary witness or legacy transaction. arbitraryWLTx :: Network -> Bool -> Gen Tx arbitraryWLTx net wit = do ni <- choose (0, 5)@@ -139,6 +146,7 @@ arbitraryPKHashSigInput :: Network -> Gen (SigInput, SecKeyI) arbitraryPKHashSigInput net = arbitraryAnyInput net True +-- | Arbitrary 'SigInput'. arbitraryAnyInput :: Network -> Bool -> Gen (SigInput, SecKeyI) arbitraryAnyInput net pkh = do (k, p) <- arbitraryKeyPair@@ -147,6 +155,7 @@ (val, op, sh) <- arbitraryInputStuff net return (SigInput out val op sh Nothing, k) +-- | Arbitrary value, out point and sighash for an input. arbitraryInputStuff :: Network -> Gen (Word64, OutPoint, SigHash) arbitraryInputStuff net = do val <- getTestCoin <$> arbitrarySatoshi net@@ -174,7 +183,7 @@ , f <$> arbitraryPKHashSigInput net , arbitraryMSSigInput net ]- let out = PayScriptHash $ getAddrHash160 $ p2shAddr net rdm+ let out = PayScriptHash $ getAddrHash160 $ payToScriptAddress net rdm return (SigInput out val op sh $ Just rdm, ks) where f (si, k) = (si, [k])@@ -216,7 +225,7 @@ res <- forM (map prevOutput $ txIn tx) $ \op -> do (so, val, rdmM, prvs, m, n) <- arbitraryData- txs <- mapM (singleSig so val rdmM tx op) prvs+ txs <- mapM (singleSig so val rdmM tx op . secKeyData) prvs return (txs, (so, val, op, m, n)) return (concatMap fst res, map snd res) where@@ -236,7 +245,7 @@ let so = PayMulSig pubKeys m elements [ (so, val, Nothing, prvKeys, m, n)- , ( PayScriptHash $ getAddrHash160 $ p2shAddr net so+ , ( PayScriptHash $ getAddrHash160 $ payToScriptAddress net so , val , Just so , prvKeys
src/Network/Haskoin/Test/Util.hs view
@@ -1,3 +1,11 @@+{-|+Module : Network.Haskoin.Test.Util+Copyright : No rights reserved+License : UNLICENSE+Maintainer : xenog@protonmail.com+Stability : experimental+Portability : POSIX+-} module Network.Haskoin.Test.Util where import Data.ByteString (ByteString, pack)
src/Network/Haskoin/Transaction.hs view
@@ -1,6 +1,12 @@ {-|- This package provides functions for building and signing both simple- transactions and multisignature transactions.+Module : Network.Haskoin.Transaction+Copyright : No rights reserved+License : UNLICENSE+Maintainer : xenog@protonmail.com+Stability : experimental+Portability : POSIX++Transactions and related code. -} module Network.Haskoin.Transaction ( module Common
src/Network/Haskoin/Transaction/Builder.hs view
@@ -1,5 +1,16 @@ {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-}+{-|+Module : Network.Haskoin.Transaction.Builder+Copyright : No rights reserved+License : UNLICENSE+Maintainer : xenog@protonmail.com+Stability : experimental+Portability : POSIX++Code to simplify transaction creation, signing, fee calculation and coin+selection.+-} module Network.Haskoin.Transaction.Builder ( -- * Transaction Creation & Signing buildAddrTx@@ -32,12 +43,12 @@ import Control.DeepSeq (NFData, rnf) import Control.Monad (foldM, mzero, unless, when) import Control.Monad.Identity (runIdentity)+import Crypto.Secp256k1 import Data.Aeson (FromJSON, ToJSON, Value (Object), object, parseJSON, toJSON, (.:), (.:?), (.=))-import Data.ByteString (ByteString)-import qualified Data.ByteString as BS+import qualified Data.ByteString as B import Data.Conduit (ConduitT, Void, await, runConduit, (.|)) import Data.Conduit.List (sourceList)@@ -203,8 +214,8 @@ guessTxSize pki msi pkout msout = 8 + inpLen + inp + outLen + out where- inpLen = BS.length $ encode $ VarInt $ fromIntegral $ length msi + pki- outLen = BS.length $ encode $ VarInt $ fromIntegral $ pkout + msout+ inpLen = B.length $ encode $ VarInt $ fromIntegral $ length msi + pki+ outLen = B.length $ encode $ VarInt $ fromIntegral $ pkout + msout inp = pki * 148 + sum (map guessMSSize msi) -- (20: hash160) + (5: opcodes) + -- (1: script len) + (8: Word64)@@ -218,12 +229,12 @@ guessMSSize :: (Int,Int) -> Int guessMSSize (m, n) -- OutPoint (36) + Sequence (4) + Script- = 40 + fromIntegral (BS.length $ encode $ VarInt $ fromIntegral scp) + scp+ = 40 + fromIntegral (B.length $ encode $ VarInt $ fromIntegral scp) + scp -- OP_M + n*PubKey + OP_N + OP_CHECKMULTISIG where rdm = fromIntegral $- BS.length $ encode $ opPushData $ BS.replicate (n * 34 + 3) 0+ B.length $ encode $ opPushData $ B.replicate (n * 34 + 3) 0 -- Redeem + m*sig + OP_0 scp = rdm + m * 73 + 1 @@ -237,7 +248,7 @@ f (s, v) = maybe (Left ("buildAddrTx: Invalid address " ++ cs s)) Right $ do a <- stringToAddr net s- o <- addressToOutput a+ let o = addressToOutput a return (o, v) -- | Build a transaction by providing a list of outpoints as inputs@@ -246,7 +257,7 @@ buildTx xs ys = mapM fo ys >>= \os -> return $ Tx 1 (map fi xs) os [] 0 where- fi outPoint = TxIn outPoint BS.empty maxBound+ fi outPoint = TxIn outPoint B.empty maxBound fo (o, v) | v <= 2100000000000000 = return $ TxOut v $ encodeOutputBS o | otherwise =@@ -292,7 +303,7 @@ signTx :: Network -> Tx -- ^ transaction to sign -> [SigInput] -- ^ signing parameters- -> [SecKeyI] -- ^ wrapped 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"@@ -306,13 +317,13 @@ -- | Sign a single input in a transaction deterministically (RFC-6979). signInput :: Network -> Tx -> Int -> SigInput -> SecKeyI -> Either String Tx signInput net tx i (SigInput so val _ sh rdmM) key = do- let sig = TxSignature (signHash (secKeyData key) msg) sh+ let sig = TxSignature (signHash (secKeyData key) m) sh 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}- msg = txSigHash net tx (encodeOutput $ fromMaybe so rdmM) val i sh+ m = txSigHash net tx (encodeOutput $ fromMaybe so rdmM) val i sh -- | 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@@ -331,7 +342,7 @@ Network -> ScriptOutput -> Maybe RedeemScript- -> [SecKeyI]+ -> [SecKey] -> Either String [SecKeyI] sigKeys net so rdmM keys = case (so, rdmM) of@@ -345,7 +356,13 @@ (PayScriptHash _, Just rdm) -> sigKeys net rdm Nothing keys _ -> Left "sigKeys: Could not decode output script" where- zipKeys = map (\k -> (k, derivePubKeyI k)) keys+ 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.@@ -399,7 +416,7 @@ outs = map (first $ (\(o,v,_) -> (o,v)) . fromJust) $ filter (isJust . fst) zipOp f (_, _, o) txin = o == prevOutput txin emptyTxs = map (\tx -> foldl clearInput tx outs) txs- ins is i = updateIndex i is (\ti -> ti{ scriptInput = BS.empty })+ ins is i = updateIndex i is (\ti -> ti{ scriptInput = B.empty }) clearInput tx (_, i) = Tx (txVersion tx) (ins (txIn tx) i) (txOut tx) [] (txLockTime tx) @@ -414,7 +431,7 @@ -- Ignore transactions with empty inputs = do let ins = map (scriptInput . (!! i) . txIn) txs- sigRes <- mapM extractSigs $ filter (not . BS.null) ins+ sigRes <- mapM extractSigs $ filter (not . B.null) ins let rdm = snd $ head sigRes unless (all (== rdm) $ map snd sigRes) $ Left "Redeem scripts do not match" si <- encodeInputBS <$> go (nub $ concatMap fst sigRes) so rdm@@ -477,7 +494,7 @@ Right (RegularInput (SpendPKHash (TxSignature sig sh) pub)) -> case so of PayPKHash h ->- pubKeyAddr net pub == PubKeyAddress h net &&+ pubKeyAddr net pub == p2pkhAddr net h && verifyHashSig (txSigHash net tx out val i sh) sig@@ -492,7 +509,7 @@ Right (ScriptHashInput si rdm) -> case so of PayScriptHash h ->- p2shAddr net rdm == ScriptAddress h net &&+ payToScriptAddress net rdm == p2shAddr net h && go (encodeInputBS $ RegularInput si) rdm val _ -> False _ -> False
src/Network/Haskoin/Transaction/Common.hs view
@@ -1,5 +1,15 @@ {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE OverloadedStrings #-}+{-|+Module : Network.Haskoin.Transaction.Common+Copyright : No rights reserved+License : UNLICENSE+Maintainer : xenog@protonmail.com+Stability : experimental+Portability : POSIX++Code related to transactions parsing and serialization.+-} module Network.Haskoin.Transaction.Common ( Tx(..) , TxIn(..)
src/Network/Haskoin/Util.hs view
@@ -1,7 +1,13 @@ {-# LANGUAGE MultiParamTypeClasses #-} {-|- This module defines various utility functions used across the- Network.Haskoin modules.+Module : Network.Haskoin.Util+Copyright : No rights reserved+License : UNLICENSE+Maintainer : xenog@protonmail.com+Stability : experimental+Portability : POSIX++This module defines various utility functions used across the library. -} module Network.Haskoin.Util (
test/Network/Haskoin/Address/CashAddrSpec.hs view
@@ -2,7 +2,6 @@ module Network.Haskoin.Address.CashAddrSpec (spec) where import Control.Monad-import Data.ByteString (ByteString) import qualified Data.ByteString.Char8 as C import Data.Maybe import Data.String.Conversions@@ -10,7 +9,6 @@ import Network.Haskoin.Address import Network.Haskoin.Address.CashAddr import Network.Haskoin.Constants-import Network.Haskoin.Crypto import Network.Haskoin.Util import Test.Hspec import Test.HUnit@@ -76,18 +74,18 @@ describe "cashaddr larger test vectors" $ forM_ (zip [0..] vectors) $ \(i, vec) ->- it ("cashaddr test vector " <> show i) $ testCashAddr vec+ it ("cashaddr test vector " <> show (i :: Int)) $ testCashAddr vec {- Various utilities -} base58ToCashAddr :: Text -> Maybe Text-base58ToCashAddr b58 = fromBase58 b58 >>= toCashAddr+base58ToCashAddr b58 = toCashAddr <$> fromBase58 b58 where fromBase58 = stringToAddr btc toCashAddr a = addrToString a { getAddrNet = bch } cashAddrtoBase58 :: Text -> Maybe Text-cashAddrtoBase58 c32 = fromCashAddr c32 >>= toBase58+cashAddrtoBase58 c32 = toBase58 <$> fromCashAddr c32 where fromCashAddr = stringToAddr bch toBase58 a = addrToString a { getAddrNet = btc }@@ -96,21 +94,19 @@ testCashAddr (len, typ, addr, hex) = do let mbs = decodeHex hex assertBool "Could not decode hex payload from test vector" (isJust mbs)- let Just bs = mbs let mlow = cash32decode addr assertBool "Could not decode low level address" (isJust mlow)- let Just (lpfx, lbs) = mlow+ let Just (_, lbs) = mlow assertEqual "Low-level payload size incorrect" len (C.length lbs - 1) assertEqual "Low-level payload doesn't match" bs (C.tail lbs) let mdec = cash32decodeType addr assertBool ("Could not decode test address: " <> cs addr) (isJust mdec)- let Just (pfx, ver, pay) = mdec assertEqual "Length doesn't match" len (C.length pay) assertEqual "Version doesn't match" typ ver assertEqual "Payload doesn't match" bs pay where Just bs = decodeHex hex- Just (pfx, ver, pay) = cash32decodeType addr+ Just (_, ver, pay) = cash32decodeType addr -- | All vectors starting with @pref@ had the wrong version in the spec -- document.
test/Network/Haskoin/AddressSpec.hs view
@@ -9,7 +9,6 @@ import Network.Haskoin.Address import Network.Haskoin.Address.Base58 import Network.Haskoin.Constants-import Network.Haskoin.Crypto import Network.Haskoin.Test import Test.Hspec import Test.HUnit (Assertion, assertBool)@@ -40,7 +39,7 @@ it "encodes and decodes address" $ property $ forAll (arbitraryAddress net) $ \a ->- (stringToAddr net =<< addrToString a) == Just a+ stringToAddr net (addrToString a) == Just a it "shows and reads address" $ property $ forAll (arbitraryAddress net) $ \a -> read (show a) == a
test/Network/Haskoin/CryptoSpec.hs view
@@ -1,12 +1,10 @@ {-# LANGUAGE OverloadedStrings #-} module Network.Haskoin.CryptoSpec (spec) where -import Control.Monad (forM_, replicateM_)-import Control.Monad.Trans (liftIO)+import Control.Monad import Data.ByteString (ByteString) import qualified Data.ByteString.Char8 as C (pack) import Data.Maybe (fromMaybe, isJust, isNothing)-import Data.Serialize (encode) import Data.Text (Text) import Network.Haskoin.Address import Network.Haskoin.Constants@@ -138,10 +136,10 @@ checkMatchingAddress :: Assertion checkMatchingAddress = do- assertBool "Key 1" $ Just addr1 == addrToString (pubKeyAddr btc pub1)- assertBool "Key 2" $ Just addr2 == addrToString (pubKeyAddr btc pub2)- assertBool "Key 1C" $ Just addr1C == addrToString (pubKeyAddr btc pub1C)- assertBool "Key 2C" $ Just addr2C == addrToString (pubKeyAddr btc pub2C)+ assertBool "Key 1" $ addr1 == addrToString (pubKeyAddr btc pub1)+ assertBool "Key 2" $ addr2 == addrToString (pubKeyAddr btc pub2)+ assertBool "Key 1C" $ addr1C == addrToString (pubKeyAddr btc pub1C)+ assertBool "Key 2C" $ addr2C == addrToString (pubKeyAddr btc pub2C) checkSignatures :: Hash256 -> Assertion checkSignatures h = do
test/Network/Haskoin/Keys/ExtendedSpec.hs view
@@ -4,7 +4,6 @@ import Data.Aeson as A import Data.Aeson.Types as A import Data.Bits ((.&.))-import Data.ByteString (ByteString) import qualified Data.ByteString.Lazy.Char8 as B8 import Data.Either (isLeft) import Data.Map.Strict (singleton)@@ -16,7 +15,6 @@ import Data.Word (Word32) import Network.Haskoin.Address import Network.Haskoin.Constants-import Network.Haskoin.Crypto import Network.Haskoin.Keys import Network.Haskoin.Test import Network.Haskoin.Util@@ -295,7 +293,7 @@ assertBool "xPrvID" $ encodeHex (S.encode $ xPrvID m) == head v assertBool "xPrvFP" $ encodeHex (S.encode $ xPrvFP m) == v !! 1 assertBool "xPrvAddr" $- addrToString (xPubAddr $ deriveXPubKey m) == Just (v !! 2)+ addrToString (xPubAddr $ deriveXPubKey m) == v !! 2 assertBool "prvKey" $ encodeHex (getSecKey $ xPrvKey m) == v !! 3 assertBool "xPrvWIF" $ xPrvWif m == v !! 4 assertBool "pubKey" $
test/Network/Haskoin/ScriptSpec.hs view
@@ -2,18 +2,12 @@ module Network.Haskoin.ScriptSpec (spec) where import Control.Monad-import Control.Monad.IO.Class import Data.Aeson as A import Data.ByteString (ByteString)-import qualified Data.ByteString as BS-import qualified Data.ByteString.Char8 as C-import qualified Data.ByteString.Lazy as BL-import qualified Data.ByteString.Lazy.Char8 as CL-import Data.Char (ord)+import qualified Data.ByteString as B+import qualified Data.ByteString.Lazy as L import Data.Either-import Data.Int (Int64) import Data.List-import Data.List.Split (splitOn) import Data.Map.Strict (singleton) import Data.Maybe import Data.Monoid ((<>))@@ -24,13 +18,11 @@ import Data.Word import Network.Haskoin.Address import Network.Haskoin.Constants-import Network.Haskoin.Crypto import Network.Haskoin.Keys import Network.Haskoin.Script import Network.Haskoin.Test import Network.Haskoin.Transaction import Network.Haskoin.Util-import Numeric (readHex) import Test.Hspec import Test.HUnit as HUnit import Test.QuickCheck@@ -96,7 +88,7 @@ Right (RegularInput (SpendPK TxSignatureEmpty)) let pk = derivePubKeyI $- wrapSecKey True $ fromJust $ secKey $ BS.replicate 32 1+ wrapSecKey True $ fromJust $ secKey $ B.replicate 32 1 decodeInput net (Script [OP_0, opPushData $ S.encode pk]) `shouldBe` Right (RegularInput (SpendPKHash TxSignatureEmpty pk)) decodeInput net (Script [OP_0, OP_0]) `shouldBe`@@ -130,7 +122,7 @@ -- We can disable specific tests by adding a DISABLED flag in the data -> unless ("DISABLED" `isInfixOf` flags) $ do- let strict =+ let _strict = "DERSIG" `isInfixOf` flags || "STRICTENC" `isInfixOf` flags || "NULLDUMMY" `isInfixOf` flags@@ -181,7 +173,7 @@ "OK" -> ver `shouldBe` True _ -> ver `shouldBe` False -creditTx :: BS.ByteString -> Word64 -> Tx+creditTx :: ByteString -> Word64 -> Tx creditTx scriptPubKey val = Tx 1 [txI] [txO] [] 0 where@@ -193,11 +185,11 @@ , txInSequence = maxBound } -spendTx :: BS.ByteString -> Word64 -> BS.ByteString -> Tx+spendTx :: ByteString -> Word64 -> ByteString -> Tx spendTx scriptPubKey val scriptSig = Tx 1 [txI] [txO] [] 0 where- txO = TxOut {outValue = val, scriptOutput = BS.empty}+ txO = TxOut {outValue = val, scriptOutput = B.empty} txI = TxIn { prevOutput = OutPoint (txHash $ creditTx scriptPubKey val) 0@@ -205,9 +197,9 @@ , txInSequence = maxBound } -parseScript :: String -> BS.ByteString+parseScript :: String -> ByteString parseScript str =- BS.concat $ fromMaybe err $ mapM f $ words str+ B.concat $ fromMaybe err $ mapM f $ words str where f = decodeHex . cs . dropHex . replaceToken dropHex ('0':'x':xs) = xs@@ -254,7 +246,7 @@ eitherToMaybe . S.decode =<< decodeHex (cs scpStr) sh = fromIntegral shI res =- eitherToMaybe . S.decode . BS.reverse =<<+ eitherToMaybe . S.decode . B.reverse =<< decodeHex (cs resStr) Just (txSigHash net tx s 0 i sh) `shouldBe` res @@ -285,10 +277,11 @@ it "can read . show" $ property $ forAll arbitrarySigHash $ \sh -> read (show sh) `shouldBe` sh it "can correctly show" $ do- show (0x00 :: SigHash) `shouldBe` "SigHash " <> show 0x00- show (0x01 :: SigHash) `shouldBe` "SigHash " <> show 0x01- show (0xff :: SigHash) `shouldBe` "SigHash " <> show 0xff- show (0xabac3344 :: SigHash) `shouldBe` "SigHash " <> show 0xabac3344+ show (0x00 :: SigHash) `shouldBe` "SigHash " <> show (0x00 :: Word32)+ show (0x01 :: SigHash) `shouldBe` "SigHash " <> show (0x01 :: Word32)+ show (0xff :: SigHash) `shouldBe` "SigHash " <> show (0xff :: Word32)+ show (0xabac3344 :: SigHash) `shouldBe` "SigHash " <>+ show (0xabac3344 :: Word32) it "can add a forkid" $ do 0x00 `sigHashAddForkId` 0x00 `shouldBe` 0x00 0xff `sigHashAddForkId` 0x00ffffff `shouldBe` 0xffffffff@@ -327,7 +320,7 @@ isSigHashUnknown 0x04 `shouldBe` True it "can decodeTxSig . encode a TxSignature" $ property $- forAll (arbitraryTxSignature net) $ \(_, _, ts@(TxSignature _ sh)) ->+ forAll (arbitraryTxSignature net) $ \(_, _, ts) -> decodeTxSig net (encodeTxSig ts) `shouldBe` Right ts it "can produce the sighash one" $ property $@@ -351,69 +344,11 @@ readTestFile :: A.FromJSON a => FilePath -> IO a readTestFile fp = do- bs <- BL.readFile $ "data/" <> fp <> ".json"+ bs <- L.readFile $ "data/" <> fp <> ".json" maybe (error $ "Could not read test file " <> fp) return $ A.decode bs {- Parse tests from bitcoin-qt repository -} -type ParseError = String---- | Splits the JSON test into the different parts. No processing,--- just handling the fact that comments may not be there or might have--- junk before it. Output is the tuple ( sig, pubKey, flags, comment--- ) as strings-testParts :: [String] -> Maybe (String, String, String, String)-testParts l =- let (x, r) = splitAt 3 l- comment =- if null r- then ""- else last r- in if length x < 3- then Nothing- else let [sig, pubKey, flags] = x- in Just (sig, pubKey, flags, comment)---- | Maximum value of sequence number-maxSeqNum :: Word32-maxSeqNum = 0xffffffff -- Perhaps this should be moved to constants.---- | Some of the scripts tests require transactions be built in a--- standard way. This function builds the crediting transaction.--- Quoting the top comment of script_valid.json: "It is evaluated as--- if there was a crediting coinbase transaction with two 0 pushes as--- scriptSig, and one output of 0 satoshi and given scriptPubKey,--- followed by a spending transaction which spends this output as only--- input (and correct prevout hash), using the given scriptSig. All--- nLockTimes are 0, all nSequences are max."-buildCreditTx :: ByteString -> Tx-buildCreditTx scriptPubKey =- Tx 1 [ txI ] [ txO ] [] 0- where- txO = TxOut { outValue = 0- , scriptOutput = scriptPubKey- }- txI = TxIn { prevOutput = nullOutPoint- , scriptInput = S.encode $ Script [ OP_0, OP_0 ]- , txInSequence = maxSeqNum- }---- | Build a spending transaction for the tests. Takes as input the--- crediting transaction-buildSpendTx :: ByteString -- ScriptSig- -> Tx -- Creditting Tx- -> Tx-buildSpendTx scriptSig creditTx =- Tx 1 [ txI ] [ txO ] [] 0- where- txI = TxIn { prevOutput = OutPoint { outPointHash = txHash creditTx- , outPointIndex = 0- }- , scriptInput = scriptSig- , txInSequence = maxSeqNum- }- txO = TxOut { outValue = 0, scriptOutput = BS.empty }- mapMulSigVector :: ((Text, Text), Int) -> Spec mapMulSigVector (v, i) = it name $ runMulSigVector v@@ -424,12 +359,12 @@ runMulSigVector (a, ops) = assertBool "multisig vector" $ Just a == b where s = do- s <- decodeHex ops- eitherToMaybe $ S.decode s+ s' <- decodeHex ops+ eitherToMaybe $ S.decode s' b = do o <- s d <- eitherToMaybe $ decodeOutput o- addrToString $ p2shAddr btc d+ return . addrToString $ payToScriptAddress btc d sigDecodeMap :: Network -> (Text, Int) -> Spec sigDecodeMap net (_, i) =
test/Network/Haskoin/TransactionSpec.hs view
@@ -1,30 +1,18 @@ {-# LANGUAGE OverloadedStrings #-} module Network.Haskoin.TransactionSpec (spec) where -import Control.Monad (forM_, unless, zipWithM_)-import Control.Monad.IO.Class import Data.Aeson as A-import Data.Aeson.Types as A-import Data.ByteString (ByteString)-import qualified Data.ByteString as BS-import qualified Data.ByteString.Lazy as BL-import Data.Either (fromLeft, fromRight, isLeft,- isRight)-import Data.List (groupBy)+import qualified Data.ByteString as B+import Data.Either import Data.Map.Strict (singleton) import Data.Maybe import Data.Serialize as S-import Data.Serialize.Get (getWord32le, runGet)-import Data.Serialize.Put (putWord32le, runPut) import Data.String (fromString) import Data.String.Conversions import Data.Text (Text)-import qualified Data.Vector as V import Data.Word (Word32, Word64)-import GHC.Exts (IsString (..)) import Network.Haskoin.Address import Network.Haskoin.Constants-import Network.Haskoin.Crypto import Network.Haskoin.Keys import Network.Haskoin.Script import Network.Haskoin.Test@@ -32,8 +20,7 @@ import Network.Haskoin.Util import Safe (readMay) import Test.Hspec-import Test.HUnit (Assertion, assertBool,- assertFailure)+import Test.HUnit (Assertion, assertBool) import Test.QuickCheck spec :: Spec@@ -41,9 +28,9 @@ let net = btc describe "transaction unit tests" $ do it "compute txid from tx" $- zipWithM_ (curry mapTxIDVec) txIDVec [0 ..]+ mapM_ runTxIDVec txIDVec it "build pkhash transaction (generated from bitcoind)" $- zipWithM_ (curry mapPKHashVec) pkHashVec [0 ..]+ mapM_ runPKHashVec pkHashVec it "encode satoshi core script pubkey" tEncodeSatoshiCoreScriptPubKey describe "btc transaction" $ do it "decode and encode txid" $@@ -90,9 +77,6 @@ cerealID :: (Serialize a, Eq a) => a -> Bool cerealID x = S.decode (S.encode x) == Right x -mapTxIDVec :: ((Text, Text), Int) -> Assertion-mapTxIDVec (v,i) = runTxIDVec v- runTxIDVec :: (Text, Text) -> Assertion runTxIDVec (tid, tx) = assertBool "txid" $ txHashToHex (txHash txBS) == tid where@@ -114,10 +98,6 @@ ) ] -mapPKHashVec :: (([(Text, Word32)], [(Text, Word64)], Text), Int)- -> Assertion-mapPKHashVec (v, i) = runPKHashVec v- runPKHashVec :: ([(Text, Word32)], [(Text, Word64)], Text) -> Assertion runPKHashVec (xs, ys, res) = assertBool "Build PKHash Tx" $ encodeHex (S.encode tx) == res@@ -182,25 +162,15 @@ Just i -> encodeHex . S.encode . intToScriptOp $ i Nothing -> error $ "encodeSatoshiCoreScriptPubKey: " ++ s -type TestComment = String- {- Building Transactions -} testBuildAddrTx :: Network -> Address -> TestCoin -> Bool-testBuildAddrTx net a (TestCoin v) =- case a of- PubKeyAddress h net -> Right (PayPKHash h) == out- ScriptAddress h net -> Right (PayScriptHash h) == out+testBuildAddrTx net a (TestCoin v)+ | isPubKeyAddress a = Right (PayPKHash (getAddrHash160 a)) == out+ | isScriptAddress a = Right (PayScriptHash (getAddrHash160 a)) == out+ | otherwise = undefined where- tx =- buildAddrTx- net- []- [ ( fromMaybe- (error "Could not convert address to string")- (addrToString a)- , v)- ]+ tx = buildAddrTx net [] [(addrToString a, v)] out = decodeOutputBS $ scriptOutput $@@ -214,7 +184,7 @@ where delta = pki + sum (map fst msi) guess = guessTxSize pki msi pkout msout- len = BS.length $ S.encode tx+ len = B.length $ S.encode tx ins = map f $ txIn tx f i = fromRight (error "Could not decode input") $@@ -267,10 +237,10 @@ where txSigP = fromRight (error "Could not decode transaction") $- signTx net tx sigis (tail prv)+ signTx net tx sigis (map secKeyData (tail prv)) txSigC = fromRight (error "Could not decode transaction") $- signTx net txSigP sigis [head prv]+ signTx net txSigP sigis [secKeyData (head prv)] verData = map (\(SigInput s v o _ _) -> (s, v, o)) sigis testMergeTx :: Network -> ([Tx], [(ScriptOutput, Word64, OutPoint, Int, Int)]) -> Bool