packages feed

haskoin-core 0.13.1 → 0.13.2

raw patch · 115 files changed

+15126/−15153 lines, 115 files

Files

CHANGELOG.md view
@@ -4,6 +4,11 @@ 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.13.2+### Changed+- Move all packages from Network.Haskoin namespace to Haskoin namespace.+- Expose all top-level modules directly.+ ## 0.13.1 ### Changed - Faster JSON serialization.
haskoin-core.cabal view
@@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: ad4c6376deb0bf12b7271c03f9d6602888452d75a32a16f711ef2f018b500a10+-- hash: bd9822c23e8579ff68357d7e634d820b25e23e1d6ce81b019ebb8e96bc872370  name:           haskoin-core-version:        0.13.1+version:        0.13.2 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@@ -37,38 +37,38 @@ library   exposed-modules:       Haskoin+      Haskoin.Address+      Haskoin.Block+      Haskoin.Constants+      Haskoin.Crypto+      Haskoin.Keys+      Haskoin.Network+      Haskoin.Script+      Haskoin.Transaction+      Haskoin.Util   other-modules:-      Network.Haskoin.Address-      Network.Haskoin.Address.Base58-      Network.Haskoin.Address.Bech32-      Network.Haskoin.Address.CashAddr-      Network.Haskoin.Block-      Network.Haskoin.Block.Common-      Network.Haskoin.Block.Headers-      Network.Haskoin.Block.Merkle-      Network.Haskoin.Constants-      Network.Haskoin.Crypto-      Network.Haskoin.Crypto.Hash-      Network.Haskoin.Crypto.Signature-      Network.Haskoin.Keys-      Network.Haskoin.Keys.Common-      Network.Haskoin.Keys.Extended-      Network.Haskoin.Keys.Mnemonic-      Network.Haskoin.Network-      Network.Haskoin.Network.Bloom-      Network.Haskoin.Network.Common-      Network.Haskoin.Network.Message-      Network.Haskoin.Script-      Network.Haskoin.Script.Common-      Network.Haskoin.Script.SigHash-      Network.Haskoin.Script.Standard-      Network.Haskoin.Transaction-      Network.Haskoin.Transaction.Builder-      Network.Haskoin.Transaction.Builder.Sign-      Network.Haskoin.Transaction.Common-      Network.Haskoin.Transaction.Partial-      Network.Haskoin.Transaction.Segwit-      Network.Haskoin.Util+      Haskoin.Address.Base58+      Haskoin.Address.Bech32+      Haskoin.Address.CashAddr+      Haskoin.Block.Common+      Haskoin.Block.Headers+      Haskoin.Block.Merkle+      Haskoin.Crypto.Hash+      Haskoin.Crypto.Signature+      Haskoin.Keys.Common+      Haskoin.Keys.Extended+      Haskoin.Keys.Mnemonic+      Haskoin.Network.Bloom+      Haskoin.Network.Common+      Haskoin.Network.Message+      Haskoin.Script.Common+      Haskoin.Script.SigHash+      Haskoin.Script.Standard+      Haskoin.Transaction.Builder+      Haskoin.Transaction.Builder.Sign+      Haskoin.Transaction.Common+      Haskoin.Transaction.Partial+      Haskoin.Transaction.Segwit       Paths_haskoin_core   hs-source-dirs:       src@@ -105,63 +105,63 @@   type: exitcode-stdio-1.0   main-is: Spec.hs   other-modules:-      Network.Haskoin.Address.Bech32Spec-      Network.Haskoin.Address.CashAddrSpec-      Network.Haskoin.AddressSpec-      Network.Haskoin.BlockSpec-      Network.Haskoin.Crypto.HashSpec-      Network.Haskoin.Crypto.SignatureSpec-      Network.Haskoin.CryptoSpec-      Network.Haskoin.Keys.ExtendedSpec-      Network.Haskoin.Keys.MnemonicSpec-      Network.Haskoin.KeysSpec-      Network.Haskoin.NetworkSpec-      Network.Haskoin.ScriptSpec-      Network.Haskoin.Test-      Network.Haskoin.Test.Address-      Network.Haskoin.Test.Block-      Network.Haskoin.Test.Crypto-      Network.Haskoin.Test.Keys-      Network.Haskoin.Test.Message-      Network.Haskoin.Test.Network-      Network.Haskoin.Test.Script-      Network.Haskoin.Test.Transaction-      Network.Haskoin.Test.Util-      Network.Haskoin.Transaction.PartialSpec-      Network.Haskoin.TransactionSpec-      Network.Haskoin.UtilSpec+      Haskoin.Address.Bech32Spec+      Haskoin.Address.CashAddrSpec+      Haskoin.AddressSpec+      Haskoin.BlockSpec+      Haskoin.Crypto.HashSpec+      Haskoin.Crypto.SignatureSpec+      Haskoin.CryptoSpec+      Haskoin.Keys.ExtendedSpec+      Haskoin.Keys.MnemonicSpec+      Haskoin.KeysSpec+      Haskoin.NetworkSpec+      Haskoin.ScriptSpec+      Haskoin.Test+      Haskoin.Test.Address+      Haskoin.Test.Block+      Haskoin.Test.Crypto+      Haskoin.Test.Keys+      Haskoin.Test.Message+      Haskoin.Test.Network+      Haskoin.Test.Script+      Haskoin.Test.Transaction+      Haskoin.Test.Util+      Haskoin.Transaction.PartialSpec+      Haskoin.TransactionSpec+      Haskoin.UtilSpec       Haskoin-      Network.Haskoin.Address-      Network.Haskoin.Address.Base58-      Network.Haskoin.Address.Bech32-      Network.Haskoin.Address.CashAddr-      Network.Haskoin.Block-      Network.Haskoin.Block.Common-      Network.Haskoin.Block.Headers-      Network.Haskoin.Block.Merkle-      Network.Haskoin.Constants-      Network.Haskoin.Crypto-      Network.Haskoin.Crypto.Hash-      Network.Haskoin.Crypto.Signature-      Network.Haskoin.Keys-      Network.Haskoin.Keys.Common-      Network.Haskoin.Keys.Extended-      Network.Haskoin.Keys.Mnemonic-      Network.Haskoin.Network-      Network.Haskoin.Network.Bloom-      Network.Haskoin.Network.Common-      Network.Haskoin.Network.Message-      Network.Haskoin.Script-      Network.Haskoin.Script.Common-      Network.Haskoin.Script.SigHash-      Network.Haskoin.Script.Standard-      Network.Haskoin.Transaction-      Network.Haskoin.Transaction.Builder-      Network.Haskoin.Transaction.Builder.Sign-      Network.Haskoin.Transaction.Common-      Network.Haskoin.Transaction.Partial-      Network.Haskoin.Transaction.Segwit-      Network.Haskoin.Util+      Haskoin.Address+      Haskoin.Address.Base58+      Haskoin.Address.Bech32+      Haskoin.Address.CashAddr+      Haskoin.Block+      Haskoin.Block.Common+      Haskoin.Block.Headers+      Haskoin.Block.Merkle+      Haskoin.Constants+      Haskoin.Crypto+      Haskoin.Crypto.Hash+      Haskoin.Crypto.Signature+      Haskoin.Keys+      Haskoin.Keys.Common+      Haskoin.Keys.Extended+      Haskoin.Keys.Mnemonic+      Haskoin.Network+      Haskoin.Network.Bloom+      Haskoin.Network.Common+      Haskoin.Network.Message+      Haskoin.Script+      Haskoin.Script.Common+      Haskoin.Script.SigHash+      Haskoin.Script.Standard+      Haskoin.Transaction+      Haskoin.Transaction.Builder+      Haskoin.Transaction.Builder.Sign+      Haskoin.Transaction.Common+      Haskoin.Transaction.Partial+      Haskoin.Transaction.Segwit+      Haskoin.Util       Paths_haskoin_core   hs-source-dirs:       test
src/Haskoin.hs view
@@ -33,13 +33,13 @@     , module Util     ) where -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.Transaction.Partial as Partial-import           Network.Haskoin.Util                as Util+import           Haskoin.Address             as Address+import           Haskoin.Block               as Block+import           Haskoin.Constants           as Constants+import           Haskoin.Crypto              as Crypto+import           Haskoin.Keys                as Keys+import           Haskoin.Network             as Network+import           Haskoin.Script              as Script+import           Haskoin.Transaction         as Transaction+import           Haskoin.Transaction.Partial as Partial+import           Haskoin.Util                as Util
+ src/Haskoin/Address.hs view
@@ -0,0 +1,314 @@+{-# LANGUAGE DeriveAnyClass    #-}+{-# LANGUAGE DeriveGeneric     #-}+{-# LANGUAGE FlexibleContexts  #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE OverloadedStrings #-}+{-|+Module      : Haskoin.Address+Copyright   : No rights reserved+License     : UNLICENSE+Maintainer  : jprupp@protonmail.ch+Stability   : experimental+Portability : POSIX++Base58, CashAddr, Bech32 address and WIF private key serialization support.+-}+module Haskoin.Address+    ( Address(..)+    , isPubKeyAddress+    , isScriptAddress+    , isWitnessPubKeyAddress+    , isWitnessScriptAddress+    , addrToString+    , stringToAddr+    , addrToJSON+    , addrToEncoding+    , addrFromJSON+    , pubKeyAddr+    , pubKeyWitnessAddr+    , pubKeyCompatWitnessAddr+    , p2pkhAddr+    , p2wpkhAddr+    , p2shAddr+    , p2wshAddr+    , inputAddress+    , outputAddress+    , addressToScript+    , addressToScriptBS+    , addressToOutput+    , payToScriptAddress+    , payToWitnessScriptAddress+    , payToNestedScriptAddress+    , scriptToAddress+    , scriptToAddressBS+      -- * Private Key Wallet Import Format (WIF)+    , fromWif+    , toWif+      -- * Base58+    , module Haskoin.Address.Base58+      -- * Bech32+    , module Haskoin.Address.Bech32+      -- * CashAddr+    , module Haskoin.Address.CashAddr+    ) where++import           Control.Applicative+import           Control.DeepSeq+import           Control.Monad+import           Data.Aeson               as A+import           Data.Aeson.Encoding      as A+import           Data.Aeson.Types+import           Data.ByteString          (ByteString)+import qualified Data.ByteString          as B+import           Data.Hashable+import           Data.Maybe+import           Data.Serialize           as S+import           Data.Text                (Text)+import           GHC.Generics             (Generic)+import           Haskoin.Address.Base58+import           Haskoin.Address.Bech32+import           Haskoin.Address.CashAddr+import           Haskoin.Constants+import           Haskoin.Crypto+import           Haskoin.Keys.Common+import           Haskoin.Script+import           Haskoin.Util++-- | Address format for Bitcoin and Bitcoin Cash.+data Address+    -- | pay to public key hash (regular)+    = PubKeyAddress { getAddrHash160 :: !Hash160+                      -- ^ RIPEMD160 hash of public key's SHA256 hash+                     }+    -- | pay to script hash+    | ScriptAddress { getAddrHash160 :: !Hash160+                      -- ^ RIPEMD160 hash of script's SHA256 hash+                     }+    -- | pay to witness public key hash+    | WitnessPubKeyAddress { getAddrHash160 :: !Hash160+                             -- ^ RIPEMD160 hash of public key's SHA256 hash+                            }+    -- | pay to witness script hash+    | WitnessScriptAddress { getAddrHash256 :: !Hash256+                             -- ^ HASH256 hash of script+                            }+    deriving (Eq, Ord, Generic, Show, Read, Serialize, Hashable, NFData)++-- | '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+    pfx <- getWord8+    addr <- S.get+    f pfx addr+  where+    f x a+        | x == getAddrPrefix net = return $ PubKeyAddress a+        | x == getScriptPrefix net = return $ ScriptAddress a+        | otherwise = fail "Does not recognize address prefix"++-- | Binary serializer for 'Base58' addresses.+base58put :: Network -> Putter Address+base58put net (PubKeyAddress h) = do+        putWord8 (getAddrPrefix net)+        put h+base58put net (ScriptAddress h) = do+        putWord8 (getScriptPrefix net)+        put h+base58put _ _ = error "Cannot serialize this address as Base58"++addrToJSON :: Network -> Address -> Value+addrToJSON net a = toJSON (addrToString net a)++addrToEncoding :: Network -> Address -> Encoding+addrToEncoding net a =+    case addrToString net a of+        Nothing  -> null_+        Just txt -> text txt++-- | JSON parsing for Bitcoin addresses. Works with 'Base58', 'CashAddr' and+-- 'Bech32'.+addrFromJSON :: Network -> Value -> Parser Address+addrFromJSON net =+    withText "address" $ \t ->+        case stringToAddr net t of+            Nothing -> fail "could not decode address"+            Just x  -> return x++-- | Convert address to human-readable string. Uses 'Base58', 'Bech32', or+-- 'CashAddr' depending on network.+addrToString :: Network -> Address -> Maybe Text+addrToString net a@PubKeyAddress {getAddrHash160 = h}+    | isNothing (getCashAddrPrefix net) =+        Just . encodeBase58Check . runPut $ base58put net a+    | otherwise =+        cashAddrEncode net 0 (S.encode h)+addrToString net a@ScriptAddress {getAddrHash160 = h}+    | isNothing (getCashAddrPrefix net) =+        Just . encodeBase58Check . runPut $ base58put net a+    | otherwise =+        cashAddrEncode net 1 (S.encode h)+addrToString net WitnessPubKeyAddress {getAddrHash160 = h} = do+    hrp <- getBech32Prefix net+    segwitEncode hrp 0 (B.unpack (S.encode h))+addrToString net WitnessScriptAddress {getAddrHash256 = h} = do+    hrp <- getBech32Prefix net+    segwitEncode hrp 0 (B.unpack (S.encode h))++-- | Parse 'Base58', 'Bech32' or 'CashAddr' address, depending on network.+stringToAddr :: Network -> Text -> Maybe Address+stringToAddr net bs = cash <|> segwit <|> b58+  where+    b58 = eitherToMaybe . runGet (base58get net) =<< decodeBase58Check bs+    cash = cashAddrDecode net bs >>= \(ver, bs') -> case ver of+        0 -> do+            h <- eitherToMaybe (S.decode bs')+            return $ PubKeyAddress h+        1 -> do+            h <- eitherToMaybe (S.decode bs')+            return $ ScriptAddress h+        _ -> Nothing+    segwit = do+        hrp <- getBech32Prefix net+        (ver, bs') <- segwitDecode hrp bs+        guard (ver == 0)+        let bs'' = B.pack bs'+        case B.length bs'' of+            20 -> do+                h <- eitherToMaybe (S.decode bs'')+                return $ WitnessPubKeyAddress h+            32 -> do+                h <- eitherToMaybe (S.decode bs'')+                return $ WitnessScriptAddress h+            _ -> Nothing++-- | Obtain a standard pay-to-public-key-hash address from a public key.+pubKeyAddr :: PubKeyI -> Address+pubKeyAddr = PubKeyAddress . addressHash . S.encode++-- | Obtain a standard pay-to-public-key-hash (P2PKH) address from a 'Hash160'.+p2pkhAddr :: Hash160 -> Address+p2pkhAddr = PubKeyAddress++-- | Obtain a SegWit pay-to-witness-public-key-hash (P2WPKH) address from a+-- public key.+pubKeyWitnessAddr :: PubKeyI -> Address+pubKeyWitnessAddr = WitnessPubKeyAddress . addressHash . S.encode++-- | Obtain a backwards-compatible SegWit P2SH-P2WPKH address from a public key.+pubKeyCompatWitnessAddr :: PubKeyI -> Address+pubKeyCompatWitnessAddr =+    p2shAddr .+    addressHash . encodeOutputBS . PayWitnessPKHash . addressHash . S.encode++-- | Obtain a SegWit pay-to-witness-public-key-hash (P2WPKH) address from a+-- 'Hash160'.+p2wpkhAddr :: Hash160 -> Address+p2wpkhAddr = WitnessPubKeyAddress++-- | Obtain a standard pay-to-script-hash (P2SH) address from a 'Hash160'.+p2shAddr :: Hash160 -> Address+p2shAddr = ScriptAddress++-- | Obtain a SegWit pay-to-witness-script-hash (P2WSH) address from a 'Hash256'+p2wshAddr :: Hash256 -> Address+p2wshAddr = WitnessScriptAddress++-- | Compute a standard pay-to-script-hash (P2SH) address for an output script.+payToScriptAddress :: ScriptOutput -> Address+payToScriptAddress = p2shAddr . addressHash . encodeOutputBS++-- | Compute a SegWit pay-to-witness-script-hash (P2WSH) address for an output+-- script.+payToWitnessScriptAddress :: ScriptOutput -> Address+payToWitnessScriptAddress = p2wshAddr . sha256 . encodeOutputBS++-- | Compute a backwards-compatible SegWit P2SH-P2WSH address.+payToNestedScriptAddress :: ScriptOutput -> Address+payToNestedScriptAddress =+    p2shAddr . addressHash . encodeOutputBS . toP2WSH . encodeOutput++-- | Encode an output script from an address. Will fail if using a+-- pay-to-witness address on a non-SegWit network.+addressToOutput :: Address -> ScriptOutput+addressToOutput (PubKeyAddress h)        = PayPKHash h+addressToOutput (ScriptAddress h)        = PayScriptHash h+addressToOutput (WitnessPubKeyAddress h) = PayWitnessPKHash h+addressToOutput (WitnessScriptAddress h) = PayWitnessScriptHash h++-- | Get output script AST for an 'Address'.+addressToScript :: Address -> Script+addressToScript = encodeOutput . addressToOutput++-- | Encode address as output script in 'ByteString' form.+addressToScriptBS :: Address -> ByteString+addressToScriptBS = S.encode . addressToScript++-- | Decode an output script into an 'Address' if it has such representation.+scriptToAddress :: Script -> Either String Address+scriptToAddress =+    maybeToEither "Could not decode address" . outputAddress <=< decodeOutput++-- | Decode a serialized script into an 'Address'.+scriptToAddressBS :: ByteString -> Either String Address+scriptToAddressBS =+    maybeToEither "Could not decode address" . outputAddress <=< decodeOutputBS++-- | Get the 'Address' of a 'ScriptOutput'.+outputAddress :: ScriptOutput -> Maybe Address+outputAddress (PayPKHash h)            = Just $ PubKeyAddress h+outputAddress (PayScriptHash h)        = Just $ ScriptAddress h+outputAddress (PayPK k)                = Just $ pubKeyAddr k+outputAddress (PayWitnessPKHash h)     = Just $ WitnessPubKeyAddress h+outputAddress (PayWitnessScriptHash h) = Just $ WitnessScriptAddress h+outputAddress _                        = Nothing++-- | Infer the 'Address' of a 'ScriptInput'.+inputAddress :: ScriptInput -> Maybe Address+inputAddress (RegularInput (SpendPKHash _ key)) = Just $ pubKeyAddr key+inputAddress (ScriptHashInput _ rdm) = Just $ payToScriptAddress rdm+inputAddress _ = Nothing++-- | Decode private key from WIF (wallet import format) string.+fromWif :: Network -> Base58 -> Maybe SecKeyI+fromWif net wif = do+    bs <- decodeBase58Check wif+    -- Check that this is a private key+    guard (B.head bs == getSecretPrefix net)+    case B.length bs of+        -- Uncompressed format+        33 -> wrapSecKey False <$> secKey (B.tail bs)+        -- Compressed format+        34 -> do+            guard $ B.last bs == 0x01+            wrapSecKey True <$> secKey (B.tail $ B.init bs)+        -- Bad length+        _  -> Nothing++-- | Encode private key into a WIF string.+toWif :: Network -> SecKeyI -> Base58+toWif net (SecKeyI k c) =+    encodeBase58Check . B.cons (getSecretPrefix net) $+    if c+        then getSecKey k `B.snoc` 0x01+        else getSecKey k
+ src/Haskoin/Address/Base58.hs view
@@ -0,0 +1,102 @@+{-# LANGUAGE OverloadedStrings #-}+{-|+Module      : Haskoin.Address.Base58+Copyright   : No rights reserved+License     : UNLICENSE+Maintainer  : jprupp@protonmail.ch+Stability   : experimental+Portability : POSIX++Support for legacy 'Base58' addresses. Superseded by Bech32 for Bitcoin SegWit+(BTC) and CashAddr for Bitcoin Cash (BCH).+-}+module Haskoin.Address.Base58+    ( Base58+    , encodeBase58+    , decodeBase58+    , encodeBase58Check+    , decodeBase58Check+    ) where++import           Control.Monad+import           Data.ByteString         (ByteString)+import qualified Data.ByteString         as BS+import qualified Data.ByteString.Char8   as C+import           Data.Maybe              (fromMaybe, isJust, listToMaybe)+import           Data.Serialize          as S+import           Data.String.Conversions (cs)+import           Data.Text               (Text)+import qualified Data.Text               as T+import           Haskoin.Crypto.Hash+import           Haskoin.Util+import           Numeric                 (readInt, showIntAtBase)++-- | 'Base58' classic Bitcoin address format.+type Base58 = Text++-- | Symbols for Base58 encoding.+b58Data :: ByteString+b58Data = "123456789ABCDEFGHJKLMNPQRSTUVWXYZabcdefghijkmnopqrstuvwxyz"++-- | Convert a number less than or equal to provided integer into a 'Base58'+-- character.+b58 :: Int -> Char+b58 = C.index b58Data++-- | Convert a 'Base58' character into the number it represents.+b58' :: Char -> Maybe Int+b58' = flip C.elemIndex b58Data++-- | Encode an arbitrary-length 'Integer' into a 'Base58' string. Leading zeroes+-- will not be part of the resulting string.+encodeBase58I :: Integer -> Base58+encodeBase58I i = cs $ showIntAtBase 58 b58 i ""++-- | Decode a 'Base58' string into an arbitrary-length 'Integer'.+decodeBase58I :: Base58 -> Maybe Integer+decodeBase58I s =+    case go of+        Just (r,[]) -> Just r+        _           -> Nothing+  where+    p  = isJust . b58'+    f  = fromMaybe e . b58'+    go = listToMaybe $ readInt 58 p f (cs s)+    e  = error "Could not decode base58"++-- | Encode an arbitrary 'ByteString' into a its 'Base58' representation,+-- preserving leading zeroes.+encodeBase58 :: ByteString -> Base58+encodeBase58 bs =+    l `mappend` r+  where+    (z, b) = BS.span (== 0) bs+    l = cs $ BS.replicate (BS.length z) (BS.index b58Data 0) -- preserve leading 0's+    r | BS.null b = T.empty+      | otherwise = encodeBase58I $ bsToInteger b++-- | Decode a 'Base58'-encoded 'Text' to a 'ByteString'.+decodeBase58 :: Base58 -> Maybe ByteString+decodeBase58 t =+    BS.append prefix <$> r+  where+    (z, b) = BS.span (== BS.index b58Data 0) (cs t)+    prefix = BS.replicate (BS.length z) 0 -- preserve leading 1's+    r | BS.null b = Just BS.empty+      | otherwise = integerToBS <$> decodeBase58I (cs b)++-- | Computes a checksum for the input 'ByteString' and encodes the input and+-- the checksum as 'Base58'.+encodeBase58Check :: ByteString -> Base58+encodeBase58Check bs =+    encodeBase58 $ BS.append bs $ encode $ checkSum32 bs++-- | Decode a 'Base58'-encoded string that contains a checksum. This function+-- returns 'Nothing' if the input string contains invalid 'Base58' characters or+-- if the checksum fails.+decodeBase58Check :: Base58 -> Maybe ByteString+decodeBase58Check bs = do+    rs <- decodeBase58 bs+    let (res, chk) = BS.splitAt (BS.length rs - 4) rs+    guard $ chk == encode (checkSum32 res)+    return res
+ src/Haskoin/Address/Bech32.hs view
@@ -0,0 +1,228 @@+{-# LANGUAGE OverloadedStrings #-}+{-|+Module      : Haskoin.Address.Base58+Copyright   : No rights reserved+License     : UNLICENSE+Maintainer  : jprupp@protonmail.ch+Stability   : experimental+Portability : POSIX++Support for Bitcoin SegWit (BTC) Bech32 addresses. This module is a modified+version of Marko Bencun's reference implementation.+-}+module Haskoin.Address.Bech32+    ( HRP+    , Bech32+    , Data+    , bech32Encode+    , bech32Decode+    , toBase32+    , toBase256+    , segwitEncode+    , segwitDecode+    , Word5(..)+    , word5+    , fromWord5+    ) where++import           Control.Monad         (guard)+import           Data.Array            (Array, assocs, bounds, listArray, (!),+                                        (//))+import           Data.Bits             (Bits, testBit, unsafeShiftL,+                                        unsafeShiftR, xor, (.&.), (.|.))+import qualified Data.ByteString       as B+import           Data.Char             (toUpper)+import           Data.Foldable         (foldl')+import           Data.Functor.Identity (Identity, runIdentity)+import           Data.Ix               (Ix (..))+import           Data.Text             (Text)+import qualified Data.Text             as T+import qualified Data.Text.Encoding    as E+import           Data.Word             (Word8)++-- | Bech32 human-readable string.+type Bech32 = Text++-- | Human-readable part of 'Bech32' address.+type HRP = Text++-- | Data part of 'Bech32' address.+type Data = [Word8]++(.>>.), (.<<.) :: Bits a => a -> Int -> a+(.>>.) = unsafeShiftR+(.<<.) = unsafeShiftL++-- | Five-bit word for Bech32.+newtype Word5 =+    UnsafeWord5 Word8+    deriving (Eq, Ord)++instance Ix Word5 where+    range (UnsafeWord5 m, UnsafeWord5 n) = map UnsafeWord5 $ range (m, n)+    index (UnsafeWord5 m, UnsafeWord5 n) (UnsafeWord5 i) = index (m, n) i+    inRange (m, n) i = m <= i && i <= n++-- | Convert an integer number into a five-bit word.+word5 :: Integral a => a -> Word5+word5 x = UnsafeWord5 (fromIntegral x .&. 31)+{-# INLINE word5 #-}+{-# SPECIALIZE INLINE word5 :: Word8 -> Word5 #-}++-- | Convert a five-bit word into a number.+fromWord5 :: Num a => Word5 -> a+fromWord5 (UnsafeWord5 x) = fromIntegral x+{-# INLINE fromWord5 #-}+{-# SPECIALIZE INLINE fromWord5 :: Word5 -> Word8 #-}++-- | 'Bech32' character map as array of five-bit integers to character.+charset :: Array Word5 Char+charset =+    listArray (UnsafeWord5 0, UnsafeWord5 31) "qpzry9x8gf2tvdw0s3jn54khce6mua7l"++-- | Convert a character to its five-bit value from 'Bech32' 'charset'.+charsetMap :: Char -> Maybe Word5+charsetMap c+    | inRange (bounds inv) upperC = inv ! upperC+    | otherwise = Nothing+  where+    upperC = toUpper c+    inv = listArray ('0', 'Z') (repeat Nothing) // map swap (assocs charset)+    swap (a, b) = (toUpper b, Just a)++-- | Calculate or validate 'Bech32' checksum.+bech32Polymod :: [Word5] -> Word+bech32Polymod values = foldl' go 1 values .&. 0x3fffffff+  where+    go chk value =+        foldl' xor chk' [g | (g, i) <- zip generator [25 ..], testBit chk i]+      where+        generator = [0x3b6a57b2, 0x26508e6d, 0x1ea119fa, 0x3d4233dd, 0x2a1462b3]+        chk' = chk .<<. 5 `xor` fromWord5 value++-- | Convert human-readable part of 'Bech32' string into a list of five-bit+-- words.+bech32HRPExpand :: HRP -> [Word5]+bech32HRPExpand hrp =+    map (UnsafeWord5 . (.>>. 5)) hrpBytes +++    [UnsafeWord5 0] ++ map word5 hrpBytes+  where+    hrpBytes = B.unpack $ E.encodeUtf8 hrp++-- | Calculate checksum for a string of five-bit words.+bech32CreateChecksum :: HRP -> [Word5] -> [Word5]+bech32CreateChecksum hrp dat = [word5 (polymod .>>. i) | i <- [25,20 .. 0]]+  where+    values = bech32HRPExpand hrp ++ dat+    polymod =+        bech32Polymod (values ++ map UnsafeWord5 [0, 0, 0, 0, 0, 0]) `xor` 1++-- | Verify checksum for a human-readable part and string of five-bit words.+bech32VerifyChecksum :: HRP -> [Word5] -> Bool+bech32VerifyChecksum hrp dat = bech32Polymod (bech32HRPExpand hrp ++ dat) == 1++-- | Maximum length of a Bech32 result.+maxBech32Length :: Int+maxBech32Length = 90++-- | Encode string of five-bit words into 'Bech32' using a provided+-- human-readable part. Can fail if 'HRP' is invalid or result would be longer+-- than 90 characters.+bech32Encode :: HRP -> [Word5] -> Maybe Bech32+bech32Encode hrp dat = do+    guard $ checkHRP hrp+    let dat' = dat ++ bech32CreateChecksum (T.toLower hrp) dat+        rest = map (charset !) dat'+        result = T.concat [T.toLower hrp, T.pack "1", T.pack rest]+    guard $ T.length result <= maxBech32Length+    return result++-- | Check that human-readable part is valid for a 'Bech32' string.+checkHRP :: HRP -> Bool+checkHRP hrp = not (T.null hrp) && T.all (\char -> char >= '\x21' && char <= '\x7e') hrp++-- | Decode human-readable 'Bech32' string into a human-readable part and a+-- string of five-bit words.+bech32Decode :: Bech32 -> Maybe (HRP, [Word5])+bech32Decode bech32 = do+    guard $ T.length bech32 <= maxBech32Length+    guard $ T.toUpper bech32 == bech32 || lowerBech32 == bech32+    let (hrp, dat) = T.breakOnEnd "1" lowerBech32+    guard $ T.length dat >= 6+    hrp' <- T.stripSuffix "1" hrp+    guard $ checkHRP hrp'+    dat' <- mapM charsetMap $ T.unpack dat+    guard $ bech32VerifyChecksum hrp' dat'+    return (hrp', take (T.length dat - 6) dat')+  where+    lowerBech32 = T.toLower bech32++type Pad f = Int -> Int -> Word -> [[Word]] -> f [[Word]]++yesPadding :: Pad Identity+yesPadding _ 0 _ result        = return result+yesPadding _ _ padValue result = return $ [padValue] : result+{-# INLINE yesPadding #-}++noPadding :: Pad Maybe+noPadding frombits bits padValue result = do+    guard $ bits < frombits && padValue == 0+    return result+{-# INLINE noPadding #-}++-- | Big endian conversion of a bytestring from base \(2^{frombits}\) to base+-- \(2^{tobits}\). {frombits} and {twobits} must be positive and+-- \(2^{frombits}\) and \(2^{tobits}\) must be smaller than the size of Word.+-- Every value in 'dat' must be strictly smaller than \(2^{frombits}\).+convertBits :: Functor f => [Word] -> Int -> Int -> Pad f -> f [Word]+convertBits dat frombits tobits pad = concat . reverse <$> go dat 0 0 []+  where+    go [] acc bits result =+        let padValue = (acc .<<. (tobits - bits)) .&. maxv+        in pad frombits bits padValue result+    go (value:dat') acc bits result =+        go dat' acc' (bits' `rem` tobits) (result' : result)+      where+        acc' = (acc .<<. frombits) .|. fromIntegral value+        bits' = bits + frombits+        result' =+            [ (acc' .>>. b) .&. maxv+            | b <- [bits' - tobits,bits' - 2 * tobits .. 0]+            ]+    maxv = (1 .<<. tobits) - 1+{-# INLINE convertBits #-}++-- | Convert from eight-bit to five-bit word string, adding padding as required.+toBase32 :: [Word8] -> [Word5]+toBase32 dat =+    map word5 $ runIdentity $ convertBits (map fromIntegral dat) 8 5 yesPadding++-- | Convert from five-bit word string to eight-bit word string, ignoring padding.+toBase256 :: [Word5] -> Maybe [Word8]+toBase256 dat =+    map fromIntegral <$> convertBits (map fromWord5 dat) 5 8 noPadding++-- | Check if witness version and program are valid.+segwitCheck :: Word8 -> Data -> Bool+segwitCheck witver witprog =+    witver <= 16 &&+    if witver == 0+        then length witprog == 20 || length witprog == 32+        else length witprog >= 2 && length witprog <= 40++-- | Decode SegWit 'Bech32' address from a string and expected human-readable part.+segwitDecode :: HRP -> Bech32 -> Maybe (Word8, Data)+segwitDecode hrp addr = do+    (hrp', dat) <- bech32Decode addr+    guard $ (hrp == hrp') && not (null dat)+    let (UnsafeWord5 witver:datBase32) = dat+    decoded <- toBase256 datBase32+    guard $ segwitCheck witver decoded+    return (witver, decoded)++-- | Encode 'Data' as a SegWit 'Bech32' address. Needs human-readable part and+-- witness program version.+segwitEncode :: HRP -> Word8 -> Data -> Maybe Text+segwitEncode hrp witver witprog = do+    guard $ segwitCheck witver witprog+    bech32Encode hrp $ UnsafeWord5 witver : toBase32 witprog
+ src/Haskoin/Address/CashAddr.hs view
@@ -0,0 +1,198 @@+{-# LANGUAGE OverloadedStrings #-}+{-|+Module      : Haskoin.Address.CashAddr+Copyright   : No rights reserved+License     : UNLICENSE+Maintainer  : jprupp@protonmail.ch+Stability   : experimental+Portability : POSIX++Support for Bitcoin Cash (BCH) CashAddr format.+-}+module Haskoin.Address.CashAddr+    ( CashPrefix+    , CashVersion+    , CashAddr+    , Cash32+    , cashAddrDecode+    , cashAddrEncode+    , cash32decodeType+    , cash32encodeType+    , cash32decode+    , cash32encode+    ) where++import           Control.Monad+import           Data.Bits+import           Data.ByteString       (ByteString)+import qualified Data.ByteString       as B+import qualified Data.ByteString.Char8 as C+import           Data.Char+import           Data.List+import           Data.Text             (Text)+import qualified Data.Text             as T+import qualified Data.Text.Encoding    as E+import           Data.Word+import           Haskoin.Constants+import           Haskoin.Util++-- | 'CashAddr' prefix, usually shown before the colon in addresses, but sometimes+-- omitted. It is used in the checksum calculation to avoid parsing an address+-- from the wrong network.+type CashPrefix = Text++-- | 'CashAddr' version, until new address schemes appear it will be zero.+type CashVersion = Word8++-- | High level 'CashAddr' human-reabale string, with explicit or implicit prefix.+type CashAddr = Text++-- | Low level 'Cash32' is the human-readable low-level encoding used by 'CashAddr'. It+-- need not encode a valid address but any binary data.+type Cash32 = Text++-- | Symbols for encoding 'Cash32' data in human-readable strings.+charset :: String+charset = "qpzry9x8gf2tvdw0s3jn54khce6mua7l"++-- | Get the 32-bit number associated with this 'Cash32' character.+base32char :: Char -> Maybe Word8+base32char = fmap fromIntegral . (`elemIndex` charset)++-- | High-Level: decode 'CashAddr' string if it is valid for the+-- provided 'Network'. Prefix may be omitted from the string.+cashAddrDecode :: Network -> CashAddr -> Maybe (CashVersion, ByteString)+cashAddrDecode net ca = do+    epfx <- getCashAddrPrefix net+    let (cpfx, cdat) = T.breakOnEnd ":" (T.toLower ca)+    guard (T.null cpfx || T.init cpfx == epfx)+    (dpfx, ver, bs) <- cash32decodeType (epfx <> ":" <> cdat)+    guard (dpfx == epfx)+    return (ver, bs)++-- | High-Level: encode 'CashAddr' string for the provided network and hash.+-- Fails if the 'CashVersion' or length of hash 'ByteString' is invalid.+cashAddrEncode :: Network -> CashVersion -> ByteString -> Maybe CashAddr+cashAddrEncode net cv bs = do+    pfx <- getCashAddrPrefix net+    cash32encodeType pfx cv bs++-- | Mid-Level: decode 'CashAddr' string containing arbitrary prefix, plus a+-- version byte before the 'ByteString' that encodes type and length.+cash32decodeType :: Cash32 -> Maybe (CashPrefix, CashVersion, ByteString)+cash32decodeType ca' = do+    guard (T.toUpper ca' == ca' || ca == ca')+    (dpfx, bs) <- cash32decode ca+    guard (not (B.null bs))+    let vb = B.head bs+        pay = B.tail bs+    (ver, len) <- decodeVersionByte vb+    guard (B.length pay == len)+    return (dpfx, ver, pay)+  where+    ca = T.toLower ca'++-- | Mid-Level: encode 'CashAddr' string containing arbitrary prefix and+-- 'CashVersion'. Length must be among those allowed by the standard.+cash32encodeType :: CashPrefix -> CashVersion -> ByteString -> Maybe Cash32+cash32encodeType pfx cv bs = do+    let len = B.length bs+    vb <- encodeVersionByte cv len+    let pl = vb `B.cons` bs+    return (cash32encode pfx pl)++-- | Low-Level: decode 'Cash32' string. 'CashPrefix' must be part of the string.+-- No version or hash length validation is performed.+cash32decode :: Cash32 -> Maybe (CashPrefix, ByteString)+cash32decode text = do+    let bs = C.map toLower bs'+    guard (C.map toUpper bs' == bs' || bs == bs')+    let (pfx', dat) = C.breakEnd (== ':') bs+    pfx <-+        if B.null pfx' || pfx' == C.singleton ':'+            then Nothing+            else Just (B.init pfx')+    b32 <- B.pack <$> mapM base32char (C.unpack dat)+    let px = B.map (.&. 0x1f) pfx+        pd = px <> B.singleton 0 <> b32+        cs = cash32Polymod pd+        bb = B.take (B.length b32 - 8) b32+    guard (verifyCash32Polymod cs)+    let out = toBase256 bb+    return (E.decodeUtf8 pfx, out)+  where+    bs' = E.encodeUtf8 text++-- | Low-Level: encode 'Cash32' string for 'CashPrefix' provided. Can encode+-- arbitrary data. No prefix or length validation is performed.+cash32encode :: CashPrefix -> ByteString -> Cash32+cash32encode pfx bs =+    let b32 = toBase32 bs+        px = B.map (.&. 0x1f) (E.encodeUtf8 pfx)+        pd = px <> B.singleton 0 <> b32 <> B.replicate 8 0+        cs = cash32Polymod pd+        c32 = B.map f (b32 <> cs)+        f = fromIntegral . ord . (charset !!) . fromIntegral+    in pfx <> ":" <> E.decodeUtf8 c32++-- | Convert base of 'ByteString' from eight bits per byte to five bits per+-- byte, adding padding as necessary.+toBase32 :: ByteString -> ByteString+toBase32 =+    B.pack .+    map fromIntegral . fst . convertBits True 8 5 . map fromIntegral . B.unpack++-- | Convert base of 'ByteString' from five to eight bits per byte. Ignore+-- padding to be symmetric with respect to 'toBase32' function.+toBase256 :: ByteString -> ByteString+toBase256 =+    B.pack .+    map fromIntegral . fst . convertBits False 5 8 . map fromIntegral . B.unpack++-- | Obtain 'CashVersion' and payload length from 'CashAddr' version byte.+decodeVersionByte :: Word8 -> Maybe (CashVersion, Int)+decodeVersionByte vb = do+    guard (vb .&. 0x80 == 0)+    return (ver, len)+  where+    ver = vb `shiftR` 3+    len = ls !! fromIntegral (vb .&. 0x07)+    ls = [20, 24, 28, 32, 40, 48, 56, 64]++-- | Encode 'CashVersion' and length into version byte. Fail if version is+-- larger than five bits, or length incorrect, since that is invalid.+encodeVersionByte :: CashVersion -> Int -> Maybe Word8+encodeVersionByte ver len = do+    guard (ver == ver .&. 0x0f)+    l <- case len of+        20 -> Just 0+        24 -> Just 1+        28 -> Just 2+        32 -> Just 3+        40 -> Just 4+        48 -> Just 5+        56 -> Just 6+        64 -> Just 7+        _  -> Nothing+    return ((ver `shiftL` 3) .|. l)++-- | Calculate or validate checksum from base32 'ByteString' (excluding prefix).+cash32Polymod :: ByteString -> ByteString+cash32Polymod v =+    B.pack+        [fromIntegral (polymod `shiftR` (5 * (7 - i))) .&. 0x1f | i <- [0 .. 7]]+  where+    polymod = B.foldl' outer (1 :: Word64) v `xor` 1+    outer c d =+        let c0 = (fromIntegral (c `shiftR` 35) :: Word8)+            c' = ((c .&. 0x07ffffffff) `shiftL` 5) `xor` fromIntegral d+        in foldl' (inner c0) c' (zip [0 ..] generator)+    generator =+        [0x98f2bc8e61, 0x79b76d99e2, 0xf33e5fb3c4, 0xae2eabe2a8, 0x1e4f43e470]+    inner c0 c (b, g)+        | c0 `testBit` b = c `xor` g+        | otherwise = c++-- | Validate that polymod 'ByteString' (eight bytes) is equal to zero.+verifyCash32Polymod :: ByteString -> Bool+verifyCash32Polymod = (== B.replicate 8 0)
+ src/Haskoin/Block.hs view
@@ -0,0 +1,21 @@+{-|+Module      : Haskoin.Block+Copyright   : No rights reserved+License     : UNLICENSE+Maintainer  : jprupp@protonmail.ch+Stability   : experimental+Portability : POSIX++Most functions relating to blocks are exported by this module.+-}+module Haskoin.Block+    ( module Haskoin.Block.Common+      -- * Block Header Chain+    , module Haskoin.Block.Headers+      -- * Merkle Blocks+    , module Haskoin.Block.Merkle+    ) where++import           Haskoin.Block.Common+import           Haskoin.Block.Headers+import           Haskoin.Block.Merkle
+ src/Haskoin/Block/Common.hs view
@@ -0,0 +1,345 @@+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE DeriveGeneric  #-}+{-|+Module      : Haskoin.Block.Common+Copyright   : No rights reserved+License     : UNLICENSE+Maintainer  : jprupp@protonmail.ch+Stability   : experimental+Portability : POSIX++Common data types and functions to handle blocks from the block chain.+-}+module Haskoin.Block.Common+    ( Block(..)+    , BlockHeight+    , Timestamp+    , BlockHeader(..)+    , headerHash+    , BlockLocator+    , GetBlocks(..)+    , GetHeaders(..)+    , BlockHeaderCount+    , BlockHash(..)+    , blockHashToHex+    , hexToBlockHash+    , Headers(..)+    , decodeCompact+    , encodeCompact+    ) where++import           Control.DeepSeq+import           Control.Monad              (forM_, liftM2, mzero, replicateM)+import           Data.Aeson                 (FromJSON (..), ToJSON (..),+                                             Value (String), toJSON, withText)+import           Data.Aeson.Encoding        (unsafeToEncoding)+import           Data.Bits                  (shiftL, shiftR, (.&.), (.|.))+import qualified Data.ByteString            as B+import           Data.ByteString.Builder    (char7)+import           Data.Hashable              (Hashable)+import           Data.Maybe                 (fromMaybe)+import           Data.Serialize             (Serialize, decode, encode, get,+                                             put)+import           Data.Serialize.Get         (getWord32le)+import           Data.Serialize.Put         (Put, putWord32le)+import           Data.String                (IsString, fromString)+import           Data.String.Conversions    (cs)+import           Data.Text                  (Text)+import           Data.Word                  (Word32)+import           GHC.Generics               (Generic)+import           Haskoin.Crypto.Hash+import           Haskoin.Network.Common+import           Haskoin.Transaction.Common+import           Haskoin.Util+import qualified Text.Read                  as R++-- | 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).+type Timestamp = Word32++-- | Block header and transactions.+data Block =+    Block { blockHeader :: !BlockHeader+          , blockTxns   :: ![Tx]+          } deriving (Eq, Show, Read, Generic, Hashable, NFData)++instance Serialize Block where+    get = do+        header     <- get+        (VarInt c) <- get+        txs        <- replicateM (fromIntegral c) get+        return $ Block header txs+    put (Block h txs) = do+        put h+        putVarInt $ length txs+        forM_ txs put++instance ToJSON Block where+    toJSON = String . encodeHex . encode+    toEncoding s =+        unsafeToEncoding $ char7 '"' <> hexBuilder (encode s) <> char7 '"'++instance FromJSON Block where+    parseJSON =+        withText "Block" $ \t -> do+            bin <-+                case decodeHex t of+                    Nothing  -> mzero+                    Just bin -> return bin+            case decode bin of+                Left e  -> fail e+                Right h -> return h++instance ToJSON BlockHeader where+    toJSON = String . encodeHex . encode+    toEncoding s =+        unsafeToEncoding $ char7 '"' <> hexBuilder (encode s) <> char7 '"'++instance FromJSON BlockHeader where+    parseJSON =+        withText "BlockHeader" $ \t -> do+            bin <-+                case decodeHex t of+                    Nothing  -> mzero+                    Just bin -> return bin+            case decode bin of+                Left e  -> fail e+                Right h -> return h++-- | Block header hash. To be serialized reversed for display purposes.+newtype BlockHash = BlockHash+    { getBlockHash :: Hash256 }+    deriving (Eq, Ord, Generic, Hashable, Serialize, NFData)++instance Show BlockHash where+    showsPrec _ = shows . blockHashToHex++instance Read BlockHash where+    readPrec = do+        R.String str <- R.lexP+        maybe R.pfail return $ hexToBlockHash $ cs str++instance IsString BlockHash where+    fromString s =+        let e = error "Could not read block hash from hex string"+        in fromMaybe e $ hexToBlockHash $ cs s++instance FromJSON BlockHash where+    parseJSON = withText "block hash" $+        maybe mzero return . hexToBlockHash++instance ToJSON BlockHash where+    toJSON = String . blockHashToHex+    toEncoding s =+        unsafeToEncoding $+        char7 '"' <> hexBuilder (B.reverse (encode s)) <> char7 '"'++-- | 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 (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 <- B.reverse <$> decodeHex hex+    h <- eitherToMaybe (decode bs)+    return $ BlockHash h++-- | Data type recording information of a 'Block'. The hash of a block is+-- defined as the hash of this data structure, serialized. The block mining+-- process involves finding a partial hash collision by varying the nonce in the+-- 'BlockHeader' and/or additional entropy in the coinbase 'Transaction' of this+-- 'Block'. Variations in the coinbase will result in different merkle roots in+-- the 'BlockHeader'.+data BlockHeader =+    BlockHeader { blockVersion   :: !Word32      --  4 bytes+                  -- | hash of the previous block (parent)+                , prevBlock      :: !BlockHash   -- 32 bytes+                  -- | root of the merkle tree of transactions+                , merkleRoot     :: !Hash256     -- 32 bytes+                  -- | unix timestamp+                , blockTimestamp :: !Timestamp   --  4 bytes+                  -- | difficulty target+                , blockBits      :: !Word32      --  4 bytes+                  -- | random nonce+                , bhNonce        :: !Word32      --  4 bytes+                } deriving (Eq, Ord, Show, Read, Generic, Hashable, NFData)+                                                 -- 80 bytes++-- | Compute hash of 'BlockHeader'.+headerHash :: BlockHeader -> BlockHash+headerHash = BlockHash . doubleSHA256 . encode++instance Serialize BlockHeader where+    get = do+        v <- getWord32le+        p <- get+        m <- get+        t <- getWord32le+        b <- getWord32le+        n <- getWord32le+        return BlockHeader+            { blockVersion   = v+            , prevBlock      = p+            , merkleRoot     = m+            , blockTimestamp = t+            , blockBits      = b+            , bhNonce        = n+            }++    put (BlockHeader v p m bt bb n) = do+        putWord32le v+        put         p+        put         m+        putWord32le bt+        putWord32le bb+        putWord32le n++-- | A block locator is a set of block headers, denser towards the best block+-- and sparser towards the genesis block. It starts at the highest block known.+-- It is used by a node to synchronize against the network. When the locator is+-- provided to a peer, it will send back block hashes starting from the first+-- block in the locator that it recognizes.+type BlockLocator = [BlockHash]++-- | Data type representing a getblocks message request. It is used in the+-- bitcoin protocol to retrieve blocks from a peer by providing it a+-- 'BlockLocator' object. The response to a 'GetBlocks' message is an 'Inv'+-- message containing a list of block hashes that the peer believes this node is+-- missing. The number of block hashes in that inv message will end at the stop+-- block hash, at at the tip of the chain, or after 500 entries, whichever comes+-- earlier.+data GetBlocks =+    GetBlocks { -- | protocol version.+                getBlocksVersion  :: !Word32+                -- | block locator object+              , getBlocksLocator  :: !BlockLocator+                -- | hash of the last desired block+              , getBlocksHashStop :: !BlockHash+              } deriving (Eq, Show, Generic, NFData)++instance Serialize GetBlocks where++    get = GetBlocks <$> getWord32le+                    <*> (repList =<< get)+                    <*> get+      where+        repList (VarInt c) = replicateM (fromIntegral c) get++    put (GetBlocks v xs h) = putGetBlockMsg v xs h++putGetBlockMsg :: Word32 -> BlockLocator -> BlockHash -> Put+putGetBlockMsg v xs h = do+    putWord32le v+    putVarInt $ length xs+    forM_ xs put+    put h++-- | Similar to the 'GetBlocks' message type but for retrieving block headers+-- 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 block chain.+data GetHeaders =+    GetHeaders {+                 -- | protocol version+                 getHeadersVersion  :: !Word32+                 -- | block locator object+               , getHeadersBL       :: !BlockLocator+                 -- | hash of the last desired block header+               , getHeadersHashStop :: !BlockHash+               } deriving (Eq, Show, Generic, NFData)++instance Serialize GetHeaders where++    get = GetHeaders <$> getWord32le+                     <*> (repList =<< get)+                     <*> get+      where+        repList (VarInt c) = replicateM (fromIntegral c) get++    put (GetHeaders v xs h) = putGetBlockMsg v xs h++-- | 'BlockHeader' type with a transaction count as 'VarInt'+type BlockHeaderCount = (BlockHeader, VarInt)++-- | The 'Headers' type is used to return a list of block headers in+-- response to a 'GetHeaders' message.+newtype Headers =+    Headers { -- | list of block headers with transaction count+              headersList :: [BlockHeaderCount]+            }+    deriving (Eq, Show, Generic, NFData)++instance Serialize Headers where++    get = Headers <$> (repList =<< get)+      where+        repList (VarInt c) = replicateM (fromIntegral c) action+        action = liftM2 (,) get get++    put (Headers xs) = do+        putVarInt $ length xs+        forM_ xs $ \(a,b) -> put a >> put b++-- | Decode the compact number used in the difficulty target of a block.+--+-- The compact format is a representation of a whole number \(N\) using an+-- unsigned 32-bit number similar to a floating point format. The most+-- significant 8 bits are the unsigned exponent of base 256. This exponent can+-- be thought of as the number of bytes of \(N\). The lower 23 bits are the+-- mantissa. Bit number 24 represents the sign of \(N\).+--+-- \[+-- N = -1^{sign} \times mantissa \times 256^{exponent-3}+-- \]+decodeCompact :: Word32 -> (Integer, Bool) -- ^ true means overflow+decodeCompact nCompact = (if neg then res * (-1) else res, over)+  where+    nSize :: Int+    nSize = fromIntegral nCompact `shiftR` 24+    nWord' :: Word32+    nWord' = nCompact .&. 0x007fffff+    nWord :: Word32+    nWord | nSize <= 3 = nWord' `shiftR` (8 * (3 - nSize))+          | otherwise = nWord'+    res :: Integer+    res | nSize <= 3 = fromIntegral nWord+        | otherwise = fromIntegral nWord `shiftL` (8 * (nSize - 3))+    neg = nWord /= 0 && (nCompact .&. 0x00800000) /= 0+    over = nWord /= 0 && (nSize > 34 ||+                          nWord > 0xff && nSize > 33 ||+                          nWord > 0xffff && nSize > 32)++-- | Encode an 'Integer' to the compact number format used in the difficulty+-- target of a block.+encodeCompact :: Integer+              -> Word32+encodeCompact i = nCompact+  where+    i' = abs i+    neg = i < 0+    nSize' :: Int+    nSize' = let f 0 = 0+                 f n = 1 + f (n `shiftR` 8)+             in f i'+    nCompact''' :: Word32+    nCompact'''+        | nSize' <= 3 = fromIntegral $ (low64 .&. i') `shiftL` (8 * (3 - nSize'))+        | otherwise = fromIntegral $ low64 .&. (i' `shiftR` (8 * (nSize' - 3)))+    nCompact'' :: Word32+    nSize :: Int+    (nCompact'', nSize)+        | nCompact''' .&. 0x00800000 /= 0 = (nCompact''' `shiftR` 8, nSize' + 1)+        | otherwise = (nCompact''', nSize')+    nCompact' :: Word32+    nCompact' = nCompact'' .|. (fromIntegral nSize `shiftL` 24)+    nCompact :: Word32+    nCompact | neg && (nCompact' .&. 0x007fffff /= 0) = nCompact' .|. 0x00800000+             | otherwise = nCompact'+    low64 :: Integer+    low64 = 0xffffffffffffffff
+ src/Haskoin/Block/Headers.hs view
@@ -0,0 +1,740 @@+{-# LANGUAGE DeriveAnyClass    #-}+{-# LANGUAGE DeriveGeneric     #-}+{-# LANGUAGE FlexibleContexts  #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE LambdaCase        #-}+{-# LANGUAGE RecordWildCards   #-}+{-|+Module      : Haskoin.Block.Headers+Copyright   : No rights reserved+License     : UNLICENSE+Maintainer  : jprupp@protonmail.ch+Stability   : experimental+Portability : POSIX++Block chain header synchronization and proof-of-work consensus functions.+-}+module Haskoin.Block.Headers+    ( BlockNode(..)+    , BlockHeaders(..)+    , BlockWork+    , genesisNode+    , genesisBlock+    , isGenesis+    , chooseBest+      -- * Header Chain Storage Functions+    , parentBlock+    , getParents+    , getAncestor+    , splitPoint+    , connectBlocks+    , connectBlock+    , blockLocator+      -- * In-Memory Header Chain Store+    , HeaderMemory(..)+    , ShortBlockHash+    , BlockMap+    , shortBlockHash+    , initialChain+    , genesisMap+      -- * Helper Functions+    , appendBlocks+    , validBlock+    , validCP+    , afterLastCP+    , bip34+    , validVersion+    , lastNoMinDiff+    , nextWorkRequired+    , nextEdaWorkRequired+    , nextDaaWorkRequired+    , computeTarget+    , getSuitableBlock+    , nextPowWorkRequired+    , calcNextWork+    , isValidPOW+    , blockPOW+    , headerWork+    , diffInterval+    , blockLocatorNodes+    , mineBlock+    , computeSubsidy+    , ) where++import           Control.Applicative        ((<|>))+import           Control.DeepSeq+import           Control.Monad              (guard, unless, when)+import           Control.Monad.Except       (ExceptT (..), runExceptT,+                                             throwError)+import           Control.Monad.State.Strict as State (StateT, get, gets, lift,+                                                      modify)+import           Control.Monad.Trans.Maybe+import           Data.Bits                  (shiftL, shiftR, (.&.))+import qualified Data.ByteString            as B+import           Data.ByteString.Short      (ShortByteString, fromShort,+                                             toShort)+import           Data.Function              (on)+import           Data.Hashable+import           Data.HashMap.Strict        (HashMap)+import qualified Data.HashMap.Strict        as HashMap+import           Data.List                  (sort, sortBy)+import           Data.Maybe                 (fromMaybe, listToMaybe)+import           Data.Serialize             as S (Serialize (..), decode,+                                                  encode, get, put)+import           Data.Serialize.Get         as S+import           Data.Serialize.Put         as S+import           Data.Typeable              (Typeable)+import           Data.Word                  (Word32, Word64)+import           GHC.Generics               (Generic)+import           Haskoin.Block.Common+import           Haskoin.Constants+import           Haskoin.Crypto+import           Haskoin.Transaction.Common+import           Haskoin.Util++-- | Short version of the block hash. Uses the good end of the hash (the part+-- that doesn't have a long string of zeroes).+type ShortBlockHash = Word64++-- | Memory-based map to a serialized 'BlockNode' data structure.+-- 'ShortByteString' is used to avoid memory fragmentation and make the data+-- structure compact.+type BlockMap = HashMap ShortBlockHash ShortByteString++-- | Represents accumulated work in the block chain so far.+type BlockWork = Integer++-- | Data structure representing a block header and its position in the+-- block chain.+data BlockNode+    -- | non-Genesis block header+    = BlockNode { nodeHeader :: !BlockHeader+                , nodeHeight :: !BlockHeight+        -- | accumulated work so far+                , nodeWork   :: !BlockWork+        -- | akip magic block hash+                , nodeSkip   :: !BlockHash }+    -- | Genesis block header+    | GenesisNode { nodeHeader :: !BlockHeader+                  , nodeHeight :: !BlockHeight+                  , nodeWork   :: !BlockWork }+    deriving (Show, Read, Generic, Hashable, NFData)++instance Serialize BlockNode where+    get = do+        nodeHeader <- S.get+        nodeHeight <- getWord32le+        nodeWork <- S.get+        if nodeHeight == 0+            then return GenesisNode {..}+            else do+                nodeSkip <- S.get+                return BlockNode {..}+    put bn = do+        put $ nodeHeader bn+        putWord32le $ nodeHeight bn+        put $ nodeWork bn+        case bn of+            GenesisNode {} -> return ()+            BlockNode {}   -> put $ nodeSkip bn++instance Eq BlockNode where+    (==) = (==) `on` nodeHeader++instance Ord BlockNode where+    compare = compare `on` nodeHeight++-- | Memory-based header tree.+data HeaderMemory = HeaderMemory+    { memoryHeaderMap  :: !BlockMap+    , memoryBestHeader :: !BlockNode+    } deriving (Eq, Typeable, Show, Read, Generic, Hashable, NFData)++-- | Typeclass for block header chain storage monad.+class Monad m => BlockHeaders m where+    -- | Add a new 'BlockNode' to the chain. Does not validate.+    addBlockHeader :: BlockNode -> m ()+    -- | Get a 'BlockNode' associated with a 'BlockHash'.+    getBlockHeader :: BlockHash -> m (Maybe BlockNode)+    -- | Locate the 'BlockNode' for the highest block in the chain+    getBestBlockHeader :: m BlockNode+    -- | Set the highest block in the chain.+    setBestBlockHeader :: BlockNode -> m ()+    -- | Add a continuous bunch of block headers the chain. Does not validate.+    addBlockHeaders :: [BlockNode] -> m ()+    addBlockHeaders = mapM_ addBlockHeader++instance Monad m => BlockHeaders (StateT HeaderMemory m) where+    addBlockHeader = modify . addBlockHeaderMemory+    getBlockHeader bh = getBlockHeaderMemory bh <$> State.get+    getBestBlockHeader = gets memoryBestHeader+    setBestBlockHeader bn = modify $ \s -> s { memoryBestHeader = bn }++-- | Initialize memory-based chain.+initialChain :: Network -> HeaderMemory+initialChain net = HeaderMemory+    { memoryHeaderMap = genesisMap net+    , memoryBestHeader = genesisNode net+    }++-- | Initialize map for memory-based chain.+genesisMap :: Network -> BlockMap+genesisMap net =+    HashMap.singleton+        (shortBlockHash (headerHash (getGenesisHeader net)))+        (toShort (encode (genesisNode net)))++-- | Add block header to memory block map.+addBlockHeaderMemory :: BlockNode -> HeaderMemory -> HeaderMemory+addBlockHeaderMemory bn s@HeaderMemory{..} =+    let bm' = addBlockToMap bn memoryHeaderMap+    in s { memoryHeaderMap = bm' }++-- | Get block header from memory block map.+getBlockHeaderMemory :: BlockHash -> HeaderMemory -> Maybe BlockNode+getBlockHeaderMemory bh HeaderMemory {..} = do+    bs <- shortBlockHash bh `HashMap.lookup` memoryHeaderMap+    eitherToMaybe . decode $ fromShort bs++-- | Calculate short block hash taking eight non-zero bytes from the 16-byte+-- hash. This function will take the bytes that are not on the zero-side of the+-- hash, making colissions between short block hashes difficult.+shortBlockHash :: BlockHash -> ShortBlockHash+shortBlockHash = either error id . decode . B.take 8 . encode++-- | Add a block to memory-based block map.+addBlockToMap :: BlockNode -> BlockMap -> BlockMap+addBlockToMap node =+    HashMap.insert+    (shortBlockHash $ headerHash $ nodeHeader node)+    (toShort $ encode node)++-- | Get the ancestor of the provided 'BlockNode' at the specified+-- 'BlockHeight'.+getAncestor :: BlockHeaders m+            => BlockHeight+            -> BlockNode+            -> m (Maybe BlockNode)+getAncestor height node+    | height > nodeHeight node = return Nothing+    | otherwise = go node+  where+    e1 = error "Could not get skip header"+    e2 = error "Could not get previous block header"+    go walk+        | nodeHeight walk > height =+            let heightSkip = skipHeight (nodeHeight walk)+                heightSkipPrev = skipHeight (nodeHeight walk - 1)+             in if not (isGenesis walk) &&+                   (heightSkip == height ||+                    (heightSkip > height &&+                     not+                         (heightSkipPrev < heightSkip - 2 &&+                          heightSkipPrev >= height)))+                    then do+                        walk' <- fromMaybe e1 <$> getBlockHeader (nodeSkip walk)+                        go walk'+                    else do+                        walk' <-+                            fromMaybe e2 <$>+                            getBlockHeader (prevBlock (nodeHeader walk))+                        go walk'+        | otherwise = return $ Just walk++-- | Is the provided 'BlockNode' the Genesis block?+isGenesis :: BlockNode -> Bool+isGenesis GenesisNode{} = True+isGenesis BlockNode{}   = False++-- | Build the genesis 'BlockNode' for the supplied 'Network'.+genesisNode :: Network -> BlockNode+genesisNode net =+    GenesisNode+        { nodeHeader = getGenesisHeader net+        , nodeHeight = 0+        , nodeWork = headerWork (getGenesisHeader net)+        }++-- | Validate a list of continuous block headers and import them to the+-- block chain. Return 'Left' on failure with error information.+connectBlocks :: BlockHeaders m+              => Network+              -> Timestamp       -- ^ current time+              -> [BlockHeader]+              -> m (Either String [BlockNode])+connectBlocks _ _ [] = return $ Right []+connectBlocks net t bhs@(bh:_) =+    runExceptT $ do+        unless (chained bhs) $+            throwError "Blocks to connect do not form a chain"+        par <-+            maybeToExceptT+                "Could not get parent block"+                (MaybeT (parentBlock bh))+        pars <- lift $ getParents 10 par+        bb <- lift getBestBlockHeader+        go par [] bb par pars bhs >>= \case+            bns@(bn:_) -> do+                lift $ addBlockHeaders bns+                let bb' = chooseBest bn bb+                when (bb' /= bb) $ lift $ setBestBlockHeader bb'+                return bns+            _ -> undefined+  where+    chained (h1:h2:hs) = headerHash h1 == prevBlock h2 && chained (h2 : hs)+    chained _          = True+    skipit lbh ls par+        | sh == nodeHeight lbh = return lbh+        | sh < nodeHeight lbh = do+            skM <- lift $ getAncestor sh lbh+            case skM of+                Just sk -> return sk+                Nothing ->+                    throwError $+                    "BUG: Could not get skip for block " +++                    show (headerHash $ nodeHeader par)+        | otherwise = do+            let sn = ls !! fromIntegral (nodeHeight par - sh)+            when (nodeHeight sn /= sh) $+                throwError "BUG: Node height not right in skip"+            return sn+      where+        sh = skipHeight (nodeHeight par + 1)+    go _ acc _ _ _ [] = return acc+    go lbh acc bb par pars (h:hs) = do+        sk <- skipit lbh acc par+        bn <- ExceptT . return $ validBlock net t bb par pars h sk+        go lbh (bn : acc) (chooseBest bn bb) bn (take 10 $ par : pars) hs++-- | Block's parent. If the block header is in the store, its parent must also+-- be there. No block header get deleted or pruned from the store.+parentBlock :: BlockHeaders m+            => BlockHeader+            -> m (Maybe BlockNode)+parentBlock bh = getBlockHeader (prevBlock bh)++-- | Validate and connect single block header to the block chain. Return 'Left' if fails+-- to be validated.+connectBlock ::+       BlockHeaders m+    => Network+    -> Timestamp -- ^ current time+    -> BlockHeader+    -> m (Either String BlockNode)+connectBlock net t bh =+    runExceptT $ do+        par <-+            maybeToExceptT+                "Could not get parent block"+                (MaybeT (parentBlock bh))+        pars <- lift $ getParents 10 par+        skM <- lift $ getAncestor (skipHeight (nodeHeight par + 1)) par+        sk <-+            case skM of+                Just sk -> return sk+                Nothing ->+                    throwError $+                    "BUG: Could not get skip for block " +++                    show (headerHash $ nodeHeader par)+        bb <- lift getBestBlockHeader+        bn <- ExceptT . return $ validBlock net t bb par pars bh sk+        let bb' = chooseBest bb bn+        lift $ addBlockHeader bn+        when (bb /= bb') . lift $ setBestBlockHeader bb'+        return bn++-- | Validate this block header. Build a 'BlockNode' if successful.+validBlock :: Network+           -> Timestamp     -- ^ current time+           -> BlockNode     -- ^ best block+           -> BlockNode     -- ^ immediate parent+           -> [BlockNode]   -- ^ 10 parents above+           -> BlockHeader   -- ^ header to validate+           -> BlockNode     -- ^ skip node (black magic)+           -> Either String BlockNode+validBlock net t bb par pars bh sk = do+    let mt = medianTime . map (blockTimestamp . nodeHeader) $ par : pars+        nt = blockTimestamp bh+        hh = headerHash bh+        nv = blockVersion bh+        ng = nodeHeight par + 1+        aw = nodeWork par + headerWork bh+    unless (isValidPOW net bh) $+        Left $ "Proof of work failed: " ++ show (headerHash bh)+    unless (nt <= t + 2 * 60 * 60) $+        Left $ "Invalid header timestamp: " ++ show nt+    unless (nt >= mt) $+        Left $ "Block timestamp too early: " ++ show nt+    unless (afterLastCP net (nodeHeight bb) ng) $+        Left $ "Rewriting pre-checkpoint chain: " ++ show ng+    unless (validCP net ng hh) $+        Left $ "Rejected checkpoint: " ++ show ng+    unless (bip34 net ng hh) $+        Left $ "Rejected BIP-34 block: " ++ show hh+    unless (validVersion net ng nv) $+        Left $ "Invalid block version: " ++ show nv+    return BlockNode { nodeHeader = bh+                     , nodeHeight = ng+                     , nodeWork = aw+                     , nodeSkip = headerHash $ nodeHeader sk+                     }++-- | Return the median of all provided timestamps. Can be unsorted. Error on+-- empty list.+medianTime :: [Timestamp] -> Timestamp+medianTime ts+    | null ts = error "Cannot compute median time of empty header list"+    | otherwise = sort ts !! (length ts `div` 2)++-- | Calculate the height of the skip (magic) block that corresponds to the+-- given height. The block hash of the ancestor at that height will be placed on+-- the 'BlockNode' structure to help locate ancestors at any height quickly.+skipHeight :: BlockHeight -> BlockHeight+skipHeight height+    | height < 2 = 0+    | height .&. 1 /= 0 = invertLowestOne (invertLowestOne $ height - 1) + 1+    | otherwise = invertLowestOne height++-- | Part of the skip black magic calculation.+invertLowestOne :: BlockHeight -> BlockHeight+invertLowestOne height = height .&. (height - 1)++-- | Get a number of parents for the provided block.+getParents :: BlockHeaders m+           => Int+           -> BlockNode+           -> m [BlockNode]   -- ^ starts from immediate parent+getParents = getpars []+  where+    getpars acc 0 _ = return $ reverse acc+    getpars acc _ GenesisNode{} = return $ reverse acc+    getpars acc n BlockNode{..} = do+        parM <- getBlockHeader $ prevBlock nodeHeader+        case parM of+            Just bn -> getpars (bn : acc) (n - 1) bn+            Nothing -> error "BUG: All non-genesis blocks should have a parent"++-- | Verify that checkpoint location is valid.+validCP :: Network+        -> BlockHeight  -- ^ new child height+        -> BlockHash    -- ^ new child hash+        -> Bool+validCP net height newChildHash =+    case lookup height (getCheckpoints net) of+        Just cpHash -> cpHash == newChildHash+        Nothing     -> True++-- | New block height above the last checkpoint imported. Used to prevent a+-- reorg below the highest checkpoint that was already imported.+afterLastCP :: Network+            -> BlockHeight  -- ^ best height+            -> BlockHeight  -- ^ new imported block height+            -> Bool+afterLastCP net bestHeight newChildHeight =+    case lM of+        Just l  -> l < newChildHeight+        Nothing -> True+  where+    lM =+        listToMaybe . reverse $+        [c | (c, _) <- getCheckpoints net, c <= bestHeight]++-- | This block should be at least version 2 (BIP34). Block height must be+-- included in the coinbase transaction to prevent non-unique transaction+-- hashes.+bip34 :: Network+      -> BlockHeight  -- ^ new child height+      -> BlockHash    -- ^ new child hash+      -> Bool+bip34 net height hsh+    | fst (getBip34Block net) == 0 = True+    | fst (getBip34Block net) == height = snd (getBip34Block net) == hsh+    | otherwise = True++-- | Check if the provided block height and version are valid.+validVersion :: Network+             -> BlockHeight  -- ^ new child height+             -> Word32       -- ^ new child version+             -> Bool+validVersion net height version+    | version < 2 = height < fst (getBip34Block net)+    | version < 3 = height < getBip66Height net+    | version < 4 = height < getBip65Height net+    | otherwise = True++-- | Find last block with normal, as opposed to minimum difficulty (for test+-- networks).+lastNoMinDiff :: BlockHeaders m => Network -> BlockNode -> m BlockNode+lastNoMinDiff net bn@BlockNode {..} = do+    let i = nodeHeight `mod` diffInterval net /= 0+        c = encodeCompact (getPowLimit net)+        l = blockBits nodeHeader == c+        e1 =+            error $+            "Could not get block header for parent of " +++            show (headerHash nodeHeader)+    if i && l+        then do+            bn' <- fromMaybe e1 <$> getBlockHeader (prevBlock nodeHeader)+            lastNoMinDiff net bn'+        else return bn++lastNoMinDiff _ bn@GenesisNode{} = return bn++-- | Returns the work required on a block header given the previous block. This+-- coresponds to @bitcoind@ function @GetNextWorkRequired@ in @main.cpp@.+nextWorkRequired :: BlockHeaders m+                 => Network+                 -> BlockNode+                 -> BlockHeader+                 -> m Word32+nextWorkRequired net par bh = do+    let mf = daa <|> eda <|> pow+    case mf of+        Just f -> f net par bh+        Nothing ->+            error+                "Could not get an appropriate difficulty calculation algorithm"+  where+    daa = getDaaBlockHeight net >>= \daaHeight -> do+        guard (nodeHeight par + 1 >= daaHeight)+        return nextDaaWorkRequired+    eda = getEdaBlockHeight net >>= \edaHeight -> do+        guard (nodeHeight par + 1 >= edaHeight)+        return nextEdaWorkRequired+    pow = return nextPowWorkRequired++-- | Find out the next amount of work required according to the Emergency+-- Difficulty Adjustment (EDA) algorithm from Bitcoin Cash.+nextEdaWorkRequired ::+       BlockHeaders m => Network -> BlockNode -> BlockHeader -> m Word32+nextEdaWorkRequired net par bh+    | nodeHeight par + 1 `mod` diffInterval net == 0 =+        nextWorkRequired net par bh+    | minDifficulty = return (encodeCompact (getPowLimit net))+    | blockBits (nodeHeader par) == encodeCompact (getPowLimit net) =+        return (encodeCompact (getPowLimit net))+    | otherwise = do+        par6 <- fromMaybe e1 <$> getAncestor (nodeHeight par - 6) par+        pars <- getParents 10 par+        pars6 <- getParents 10 par6+        let par6med =+                medianTime $ map (blockTimestamp . nodeHeader) (par6 : pars6)+            parmed = medianTime $ map (blockTimestamp . nodeHeader) (par : pars)+            mtp6 = parmed - par6med+        if mtp6 < 12 * 3600+            then return $ blockBits (nodeHeader par)+            else return $+                 let (diff, _) = decodeCompact (blockBits (nodeHeader par))+                     ndiff = diff + (diff `shiftR` 2)+                  in if getPowLimit net > ndiff+                         then encodeCompact (getPowLimit net)+                         else encodeCompact ndiff+  where+    minDifficulty =+        blockTimestamp bh >+        blockTimestamp (nodeHeader par) + getTargetSpacing net * 2+    e1 = error "Could not get seventh ancestor of block"++-- | Find the next amount of work required according to the Difficulty+-- Adjustment Algorithm (DAA) from Bitcoin Cash.+nextDaaWorkRequired ::+       BlockHeaders m => Network -> BlockNode -> BlockHeader -> m Word32+nextDaaWorkRequired net par bh+    | minDifficulty = return (encodeCompact (getPowLimit net))+    | otherwise = do+        let height = nodeHeight par+        unless (height >= diffInterval net) $+            error "Block height below difficulty interval"+        l <- getSuitableBlock par+        par144 <- fromMaybe e1 <$> getAncestor (height - 144) par+        f <- getSuitableBlock par144+        let nextTarget = computeTarget net f l+        if nextTarget > getPowLimit net+            then return $ encodeCompact (getPowLimit net)+            else return $ encodeCompact nextTarget+  where+    e1 = error "Cannot get ancestor at parent - 144 height"+    minDifficulty =+        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)+        actualTimespan =+            blockTimestamp (nodeHeader l) - blockTimestamp (nodeHeader f)+        actualTimespan'+            | actualTimespan > 288 * getTargetSpacing net =+                288 * getTargetSpacing net+            | actualTimespan < 72 * getTargetSpacing net =+                72 * getTargetSpacing net+            | otherwise = actualTimespan+        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"+    blocks <- (par :) <$> getParents 2 par+    return $ sortBy (compare `on` blockTimestamp . nodeHeader) blocks !! 1++-- | Returns the work required on a block header given the previous block. This+-- coresponds to bitcoind function GetNextWorkRequired in main.cpp.+nextPowWorkRequired ::+       BlockHeaders m => Network -> BlockNode -> BlockHeader -> m Word32+nextPowWorkRequired net par bh+    | nodeHeight par + 1 `mod` diffInterval net /= 0 =+        if getAllowMinDifficultyBlocks net+            then if ht > pt + delta+                     then return $ encodeCompact (getPowLimit net)+                     else do+                         d <- lastNoMinDiff net par+                         return $ blockBits $ nodeHeader d+            else return $ blockBits $ nodeHeader par+    | otherwise = do+        let rh = nodeHeight par - (diffInterval net - 1)+        a <- fromMaybe e1 <$> getAncestor rh par+        let t = blockTimestamp $ nodeHeader a+        return $ calcNextWork net (nodeHeader par) t+  where+    e1 = error "Could not get ancestor for block header"+    pt = blockTimestamp $ nodeHeader par+    ht = blockTimestamp bh+    delta = getTargetSpacing net * 2++-- | Computes the work required for the first block in a new retarget period.+calcNextWork :: Network+             -> BlockHeader  -- ^ last block in previous retarget (parent)+             -> Timestamp    -- ^ timestamp of first block in previous retarget+             -> Word32+calcNextWork net header time+    | getPowNoRetargetting net = blockBits header+    | new > getPowLimit net = encodeCompact (getPowLimit net)+    | otherwise = encodeCompact new+  where+    s = blockTimestamp header - time+    n | s < getTargetTimespan net `div` 4 = getTargetTimespan net `div` 4+      | s > getTargetTimespan net * 4 = getTargetTimespan net * 4+      | otherwise = s+    l = fst $ decodeCompact $ blockBits header+    new = l * fromIntegral n `div` fromIntegral (getTargetTimespan net)++-- | Returns True if the difficulty target (bits) of the header is valid and the+-- proof of work of the header matches the advertised difficulty target. This+-- function corresponds to the function @CheckProofOfWork@ from @bitcoind@ in+-- @main.cpp@.+isValidPOW :: Network -> BlockHeader -> Bool+isValidPOW net h+    | target <= 0 || over || target > getPowLimit net = False+    | otherwise = blockPOW (headerHash h) <= fromIntegral target+  where+    (target, over) = decodeCompact $ blockBits h++-- | Returns the proof of work of a block header hash as an 'Integer' number.+blockPOW :: BlockHash -> Integer+blockPOW =  bsToInteger . B.reverse . encode++-- | Returns the work represented by this block. Work is defined as the number+-- of tries needed to solve a block in the average case with respect to the+-- target.+headerWork :: BlockHeader -> Integer+headerWork bh = largestHash `div` (target + 1)+  where+    target      = fst $ decodeCompact $ blockBits bh+    largestHash = 1 `shiftL` 256++-- | Number of blocks on average between difficulty cycles (2016 blocks).+diffInterval :: Network -> Word32+diffInterval net = getTargetTimespan net `div` getTargetSpacing net++-- | Compare two blocks to get the best.+chooseBest :: BlockNode -> BlockNode -> BlockNode+chooseBest b1 b2 | nodeWork b1 == nodeWork b2 =+                       if nodeHeight b1 >= nodeHeight b2+                       then b1+                       else b2+                 | nodeWork b1 > nodeWork b2 = b1+                 | otherwise = b2++-- | Get list of blocks for a block locator.+blockLocatorNodes :: BlockHeaders m => BlockNode -> m [BlockNode]+blockLocatorNodes best =+    reverse <$> go [] best 1+  where+    e1 = error "Could not get ancestor"+    go loc bn n =+        let loc' = bn : loc+            n' = if length loc' > 10+                 then n * 2+                 else 1+        in if nodeHeight bn < n'+           then do a <- fromMaybe e1 <$> getAncestor 0 bn+                   return $ a : loc'+           else do let h = nodeHeight bn - n'+                   bn' <- fromMaybe e1 <$> getAncestor h bn+                   go loc' bn' n'++-- | Get block locator.+blockLocator :: BlockHeaders m => BlockNode -> m BlockLocator+blockLocator bn = map (headerHash . nodeHeader) <$> blockLocatorNodes bn++-- | Become rich beyond your wildest dreams.+mineBlock :: Network -> Word32 -> BlockHeader -> BlockHeader+mineBlock net seed h =+    head+        [ j+        | i <- (+ seed) <$> [0 .. maxBound]+        , let j = h {bhNonce = i}+        , isValidPOW net j+        ]++-- | Generate and append new blocks (mining). Only practical in regtest network.+appendBlocks ::+       Network+    -> Word32 -- ^ random seed+    -> BlockHeader+    -> Int+    -> [BlockHeader]+appendBlocks _ _ _ 0 = []+appendBlocks net seed bh i =+    bh' : appendBlocks net seed bh' (i - 1)+  where+    bh' = mineBlock net seed bh+        { prevBlock = headerHash bh+          -- Just to make it different in every header+        , merkleRoot = sha256 $ encode seed+        }++-- | Find the last common block ancestor between provided block headers.+splitPoint :: BlockHeaders m => BlockNode -> BlockNode -> m BlockNode+splitPoint l r = do+    let h = min (nodeHeight l) (nodeHeight r)+    ll <- fromMaybe e <$> getAncestor h l+    lr <- fromMaybe e <$> getAncestor h r+    f ll lr+  where+    e = error "BUG: Could not get ancestor at lowest height"+    f ll lr =+        if ll == lr+            then return lr+            else do+                let h = nodeHeight ll - 1+                pl <- fromMaybe e <$> getAncestor h ll+                pr <- fromMaybe e <$> getAncestor h lr+                f pl pr++-- | Generate the entire Genesis block for 'Network'.+genesisBlock :: Network -> Block+genesisBlock net = Block (getGenesisHeader net) [genesisTx]++-- | Compute block subsidy at particular height.+computeSubsidy :: Network -> BlockHeight -> Word64+computeSubsidy net height =+    let halvings = height `div` getHalvingInterval net+        ini = 50 * 100 * 1000 * 1000+     in if halvings >= 64+            then 0+            else ini `shiftR` fromIntegral halvings
+ src/Haskoin/Block/Merkle.hs view
@@ -0,0 +1,255 @@+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE DeriveGeneric  #-}+{-|+Module      : Haskoin.Block.Merkle+Copyright   : No rights reserved+License     : UNLICENSE+Maintainer  : jprupp@protonmail.ch+Stability   : experimental+Portability : POSIX++Function to deal with Merkle trees inside blocks.+-}+module Haskoin.Block.Merkle+    ( MerkleBlock(..)+    , MerkleRoot+    , FlagBits+    , PartialMerkleTree+    , buildMerkleRoot+    , merkleBlockTxs+    , testMerkleRoot+    -- * Helper functions+    , buildPartialMerkle+    , decodeMerkleFlags+    , encodeMerkleFlags+    , calcTreeHeight+    , calcTreeWidth+    , hash2+    , calcHash+    , traverseAndBuild+    , traverseAndExtract+    , extractMatches+    , splitIn+    , boolsToWord8+    ) where++import           Control.DeepSeq+import           Control.Monad              (forM_, replicateM, when)+import           Data.Bits+import qualified Data.ByteString            as BS+import           Data.Either                (isRight)+import           Data.Hashable+import           Data.Maybe+import           Data.Serialize             (Serialize, encode, get, put)+import           Data.Serialize.Get         (getWord32le, getWord8)+import           Data.Serialize.Put         (putWord32le, putWord8)+import           Data.Word                  (Word32, Word8)+import           GHC.Generics+import           Haskoin.Block.Common+import           Haskoin.Constants+import           Haskoin.Crypto.Hash+import           Haskoin.Network.Common+import           Haskoin.Transaction.Common++-- | Hash of the block's Merkle root.+type MerkleRoot        = Hash256++-- | Bits that are used to rebuild partial merkle tree transaction hash list.+type FlagBits          = [Bool]++-- | Partial Merkle tree for a filtered block.+type PartialMerkleTree = [Hash256]++-- | Filtered block: a block with a partial Merkle tree that only includes the+-- transactions that pass a bloom filter that was negotiated.+data MerkleBlock =+    MerkleBlock {+                -- | block header+                  merkleHeader    :: !BlockHeader+                -- | total number of transactions in block+                , merkleTotalTxns :: !Word32+                -- | hashes in depth-first order+                , mHashes         :: !PartialMerkleTree+                -- | bits to rebuild partial merkle tree+                , mFlags          :: !FlagBits+                } deriving (Eq, Show, Read, Generic, Hashable, NFData)++instance Serialize MerkleBlock where++    get = do+        header <- get+        ntx    <- getWord32le+        (VarInt matchLen) <- get+        hashes <- replicateM (fromIntegral matchLen) get+        (VarInt flagLen)  <- get+        ws <- replicateM (fromIntegral flagLen) getWord8+        return $ MerkleBlock header ntx hashes (decodeMerkleFlags ws)++    put (MerkleBlock h ntx hashes flags) = do+        put h+        putWord32le ntx+        putVarInt $ length hashes+        forM_ hashes put+        let ws = encodeMerkleFlags flags+        putVarInt $ length ws+        forM_ ws putWord8++-- | Unpack Merkle flags into 'FlagBits' structure.+decodeMerkleFlags :: [Word8] -> FlagBits+decodeMerkleFlags ws =+    [ b | p <- [ 0 .. length ws * 8 - 1 ]+        , b <- [ testBit (ws !! (p `div` 8)) (p `mod` 8) ]+    ]++-- | Pack Merkle flags from 'FlagBits'.+encodeMerkleFlags :: FlagBits -> [Word8]+encodeMerkleFlags bs = map boolsToWord8 $ splitIn 8 bs++-- | Computes the height of a Merkle tree.+calcTreeHeight :: Int -- ^ number of transactions (leaf nodes)+               -> Int -- ^ height of the merkle tree+calcTreeHeight ntx | ntx < 2 = 0+                   | even ntx  = 1 + calcTreeHeight (ntx `div` 2)+                   | otherwise = calcTreeHeight $ ntx + 1++-- | Computes the width of a Merkle tree at a specific height. The transactions+-- are at height 0.+calcTreeWidth :: Int -- ^ number of transactions (leaf nodes)+              -> Int -- ^ height at which we want to compute the width+              -> Int -- ^ width of the Merkle tree+calcTreeWidth ntx h = (ntx + (1 `shiftL` h) - 1) `shiftR` h++-- | Computes the root of a Merkle tree from a list of leaf node hashes.+buildMerkleRoot :: [TxHash]   -- ^ transaction hashes (leaf nodes)+                -> MerkleRoot -- ^ root of the Merkle tree+buildMerkleRoot txs = calcHash (calcTreeHeight $ length txs) 0 txs++-- | Concatenate and compute double SHA256.+hash2 :: Hash256 -> Hash256 -> Hash256+hash2 a b = doubleSHA256 $ encode a `BS.append` encode b++-- | Computes the hash of a specific node in a Merkle tree.+calcHash :: Int       -- ^ height of the node+         -> Int       -- ^ position of the node (0 for the leftmost node)+         -> [TxHash]  -- ^ transaction hashes (leaf nodes)+         -> Hash256   -- ^ hash of the node at the specified position+calcHash height pos txs+    | height < 0 || pos < 0 = error "calcHash: Invalid parameters"+    | height == 0 = getTxHash $ txs !! pos+    | otherwise = hash2 left right+  where+    left = calcHash (height-1) (pos*2) txs+    right | pos*2+1 < calcTreeWidth (length txs) (height-1) =+                calcHash (height-1) (pos*2+1) txs+          | otherwise = left++-- | Build a partial Merkle tree. Provide a list of tuples with all transaction+-- hashes in the block, and whether the transaction is to be included in the+-- partial tree. Returns a flag bits structure and the computed partial Merkle+-- tree.+buildPartialMerkle ::+       [(TxHash, Bool)] -- ^ transaction hash and whether to include+    -> (FlagBits, PartialMerkleTree) -- ^ flag bits and partial Merkle tree+buildPartialMerkle hs = traverseAndBuild (calcTreeHeight $ length hs) 0 hs++-- | Helper function to build partial Merkle tree. Used by 'buildPartialMerkle'+-- above.+traverseAndBuild ::+       Int -> Int -> [(TxHash, Bool)] -> (FlagBits, PartialMerkleTree)+traverseAndBuild height pos txs+    | height < 0 || pos < 0 = error "traverseAndBuild: Invalid parameters"+    | height == 0 || not match = ([match], [calcHash height pos t])+    | otherwise = (match : lb ++ rb, lh ++ rh)+  where+    t = map fst txs+    s = pos `shiftL` height+    e = min (length txs) $ (pos + 1) `shiftL` height+    match = any snd $ take (e - s) $ drop s txs+    (lb, lh) = traverseAndBuild (height - 1) (pos * 2) txs+    (rb, rh)+        | (pos * 2 + 1) < calcTreeWidth (length txs) (height - 1) =+            traverseAndBuild (height - 1) (pos * 2 + 1) txs+        | otherwise = ([], [])++-- | Helper function to extract transaction hashes from partial Merkle tree.+traverseAndExtract :: Int -> Int -> Int -> FlagBits -> PartialMerkleTree+                   -> Maybe (MerkleRoot, [TxHash], Int, Int)+traverseAndExtract height pos ntx flags hashes+    | null flags               = Nothing+    | height == 0 || not match = leafResult+    | isNothing leftM          = Nothing+    | (pos*2+1) >= calcTreeWidth ntx (height-1) =+        Just (hash2 lh lh, lm, lcf+1, lch)+    | isNothing rightM         = Nothing+    | otherwise =+        Just (hash2 lh rh, lm ++ rm, lcf+rcf+1, lch+rch)+  where+    leafResult+        | null hashes = Nothing+        | otherwise = Just (h, [ TxHash h | height == 0 && match ], 1, 1)+    (match:fs) = flags+    (h:_)     = hashes+    leftM  = traverseAndExtract (height-1) (pos*2) ntx fs hashes+    (lh,lm,lcf,lch) = fromMaybe e leftM+    rightM = traverseAndExtract (height-1) (pos*2+1) ntx+                (drop lcf fs) (drop lch hashes)+    (rh,rm,rcf,rch) = fromMaybe e rightM+    e = error "traverseAndExtract: unexpected error extracting a Maybe value"++-- | Extracts the matching hashes from a partial merkle tree. This will return+-- the list of transaction hashes that have been included (set to true) in+-- a call to 'buildPartialMerkle'.+extractMatches :: Network+               -> FlagBits+               -> PartialMerkleTree+               -> Int -- ^ number of transaction at height 0 (leaf nodes)+               -> Either String (MerkleRoot, [TxHash])+               -- ^ Merkle root and list of matching transaction hashes+extractMatches net flags hashes ntx+    | ntx == 0 = Left+        "extractMatches: number of transactions can not be 0"+    | ntx > getMaxBlockSize net `div` 60 = Left+        "extractMatches: number of transactions excessively high"+    | length hashes > ntx = Left+        "extractMatches: More hashes provided than the number of transactions"+    | length flags < length hashes = Left+        "extractMatches: At least one bit per node and one bit per hash"+    | isNothing resM = Left+        "extractMatches: traverseAndExtract failed"+    | (nBitsUsed+7) `div` 8 /= (length flags+7) `div` 8 = Left+        "extractMatches: All bits were not consumed"+    | nHashUsed /= length hashes = Left $+        "extractMatches: All hashes were not consumed: " ++ show nHashUsed+    | otherwise = return (merkRoot, matches)+  where+    resM = traverseAndExtract (calcTreeHeight ntx) 0 ntx flags hashes+    (merkRoot, matches, nBitsUsed, nHashUsed) = fromMaybe e resM+    e = error "extractMatches: unexpected error extracting a Maybe value"++-- | Helper function to split a list in chunks 'Int' length. Last chunk may be+-- smaller.+splitIn :: Int -> [a] -> [[a]]+splitIn _ [] = []+splitIn c xs = xs1 : splitIn c xs2+  where+    (xs1, xs2) = splitAt c xs++-- | Pack up to eight bools in a byte.+boolsToWord8 :: [Bool] -> Word8+boolsToWord8 [] = 0+boolsToWord8 xs = foldl setBit 0 (map snd $ filter fst $ zip xs [0..7])++-- | Get matching transactions from Merkle block.+merkleBlockTxs :: Network -> MerkleBlock -> Either String [TxHash]+merkleBlockTxs net b =+    let flags = mFlags b+        hs = mHashes b+        n = fromIntegral $ merkleTotalTxns b+        merkle = merkleRoot $ merkleHeader b+    in do (root, ths) <- extractMatches net flags hs n+          when (root /= merkle) $ Left "merkleBlockTxs: Merkle root incorrect"+          return ths++-- | Check if Merkle block root is valid against the block header.+testMerkleRoot :: Network -> MerkleBlock -> Bool+testMerkleRoot net = isRight . merkleBlockTxs net
+ src/Haskoin/Constants.hs view
@@ -0,0 +1,540 @@+{-# LANGUAGE DeriveAnyClass    #-}+{-# LANGUAGE DeriveGeneric     #-}+{-# LANGUAGE OverloadedStrings #-}+{-|+Module      : Haskoin.Constants+Copyright   : No rights reserved+License     : UNLICENSE+Maintainer  : jprupp@protonmail.ch+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 Haskoin.Constants+    ( Network(..)+    , btc+    , btcTest+    , btcRegTest+    , bch+    , bchTest+    , bchRegTest+    , allNets+    , netByName+    , netByIdent+    ) where++import           Control.DeepSeq+import           Data.ByteString      (ByteString)+import           Data.List+import           Data.Maybe+import           Data.Serialize+import           Data.String+import           Data.Text            (Text)+import           Data.Version+import           Data.Word            (Word32, Word64, Word8)+import           GHC.Generics         (Generic)+import           Haskoin.Block.Common+import           Paths_haskoin_core+import           Text.Read++-- | Version of Haskoin Core package.+versionString :: IsString a => a+versionString = fromString (showVersion version)++-- | Constants for network.+data Network = Network+    { -- | lowercase alphanumeric and dashes+      getNetworkName              :: !String+      -- | network Haskell identifier+    , getNetworkIdent             :: !String+      -- | prefix for 'Base58' P2PKH addresses+    , getAddrPrefix               :: !Word8+      -- | prefix for 'Base58' P2SH addresses+    , getScriptPrefix             :: !Word8+      -- | prefix for WIF private key+    , getSecretPrefix             :: !Word8+      -- | prefix for extended public key+    , getExtPubKeyPrefix          :: !Word32+      -- | prefix for extended private key+    , getExtSecretPrefix          :: !Word32+      -- | network magic+    , getNetworkMagic             :: !Word32+      -- | genesis block header+    , getGenesisHeader            :: !BlockHeader+      -- | maximum block size in bytes+    , getMaxBlockSize             :: !Int+      -- | maximum amount of satoshi+    , getMaxSatoshi               :: !Word64+      -- | user agent string+    , getHaskoinUserAgent         :: !ByteString+      -- | default port for P2P connections+    , getDefaultPort              :: !Int+      -- | allow min difficulty blocks (testnet)+    , getAllowMinDifficultyBlocks :: !Bool+      -- | do not retarget difficulty (regtest)+    , getPowNoRetargetting        :: !Bool+      -- | proof-of-work target higest possible value+    , getPowLimit                 :: !Integer+      -- | block at which BIP34 activates+    , getBip34Block               :: !(BlockHeight, BlockHash)+      -- | block at which BIP65 activates+    , getBip65Height              :: !BlockHeight+      -- | block at which BIP66 activates+    , getBip66Height              :: !BlockHeight+      -- | time between difficulty retargets+    , getTargetTimespan           :: !Word32+      -- | time between blocks+    , getTargetSpacing            :: !Word32+      -- | checkpoints+    , getCheckpoints              :: ![(BlockHeight, BlockHash)]+      -- | BIP44 derivation path root+    , getBip44Coin                :: !Word32+      -- | peer-to-peer network seeds+    , getSeeds                    :: ![String]+      -- | fork id for replay protection+    , getSigHashForkId            :: !(Maybe Word32)+      -- | EDA start block height+    , getEdaBlockHeight           :: !(Maybe Word32)+      -- | DAA start block height+    , getDaaBlockHeight           :: !(Maybe Word32)+      -- | segregated witness active+    , getSegWit                   :: !Bool+      -- | 'CashAddr' prefix (for Bitcoin Cash)+    , getCashAddrPrefix           :: !(Maybe Text)+      -- | 'Bech32' prefix (for SegWit network)+    , getBech32Prefix             :: !(Maybe Text)+      -- | Replace-By-Fee (BIP-125)+    , getReplaceByFee             :: !Bool+      -- | Subsidy halving interval+    , getHalvingInterval          :: !Word32+    } deriving (Eq, Generic, NFData)++instance Serialize Network where+    put net =+        putWord32be $ getNetworkMagic net+    get = do+        magic <- getWord32be+        case find ((== magic) . getNetworkMagic) allNets of+            Nothing  -> fail $ "Network magic unknown: " <> show magic+            Just net -> return net++instance Show Network where+    show = getNetworkIdent++instance Read Network where+    readPrec = do+        Ident str <- lexP+        maybe pfail return (netByIdent str)++instance IsString Network where+    fromString = fromMaybe (error "Network name invalid") . netByName++-- | Query known networks by name.+netByName :: String -> Maybe Network+netByName str = find ((== str) . getNetworkName) allNets++-- | Query known networks by Haskell identifier.+netByIdent :: String -> Maybe Network+netByIdent str = find ((== str) . getNetworkIdent) allNets++-- | Bitcoin SegWit network. Symbol: BTC.+btc :: Network+btc =+    Network+    { getNetworkName = "btc"+    , getNetworkIdent = "btc"+    , getAddrPrefix = 0+    , getScriptPrefix = 5+    , getSecretPrefix = 128+    , getExtPubKeyPrefix = 0x0488b21e+    , getExtSecretPrefix = 0x0488ade4+    , getNetworkMagic = 0xf9beb4d9+    , getGenesisHeader =+          BlockHeader+              0x01+              "0000000000000000000000000000000000000000000000000000000000000000"+              "3ba3edfd7a7b12b27ac72c3e67768f617fc81bc3888a51323a9fb8aa4b1e5e4a"+              1231006505+              0x1d00ffff+              2083236893+            -- Hash 000000000019d6689c085ae165831e934ff763ae46a2a6c172b3f1b60a8ce26f+    , getMaxBlockSize = 1000000+    , getMaxSatoshi = 2100000000000000+    , getHaskoinUserAgent =+          "/haskoin-btc:" <> versionString <> "/"+    , getDefaultPort = 8333+    , getAllowMinDifficultyBlocks = False+    , getPowNoRetargetting = False+    , getPowLimit =+          0x00000000ffffffffffffffffffffffffffffffffffffffffffffffffffffffff+    , getBip34Block =+          ( 227931+          , "000000000000024b89b42a942fe0d9fea3bb44ab7bd1b19115dd6a759c0808b8")+    , getBip65Height = 388381+    , getBip66Height = 363725+    , getTargetTimespan = 14 * 24 * 60 * 60+    , getTargetSpacing = 10 * 60+    , getCheckpoints =+          [ ( 11111+            , "0000000069e244f73d78e8fd29ba2fd2ed618bd6fa2ee92559f542fdb26e7c1d")+          , ( 33333+            , "000000002dd5588a74784eaa7ab0507a18ad16a236e7b1ce69f00d7ddfb5d0a6")+          , ( 74000+            , "0000000000573993a3c9e41ce34471c079dcf5f52a0e824a81e7f953b8661a20")+          , ( 105000+            , "00000000000291ce28027faea320c8d2b054b2e0fe44a773f3eefb151d6bdc97")+          , ( 134444+            , "00000000000005b12ffd4cd315cd34ffd4a594f430ac814c91184a0d42d2b0fe")+          , ( 168000+            , "000000000000099e61ea72015e79632f216fe6cb33d7899acb35b75c8303b763")+          , ( 193000+            , "000000000000059f452a5f7340de6682a977387c17010ff6e6c3bd83ca8b1317")+          , ( 210000+            , "000000000000048b95347e83192f69cf0366076336c639f9b7228e9ba171342e")+          , ( 216116+            , "00000000000001b4f4b433e81ee46494af945cf96014816a4e2370f11b23df4e")+          , ( 225430+            , "00000000000001c108384350f74090433e7fcf79a606b8e797f065b130575932")+          , ( 250000+            , "000000000000003887df1f29024b06fc2200b55f8af8f35453d7be294df2d214")+          , ( 279000+            , "0000000000000001ae8c72a0b0c301f67e3afca10e819efa9041e458e9bd7e40")+          , ( 295000+            , "00000000000000004d9b4ef50f0f9d686fd69db2e03af35a100370c64632a983")+          ]+    , getSeeds =+          [ "seed.bitcoin.sipa.be" -- Pieter Wuille+          , "dnsseed.bluematt.me" -- Matt Corallo+          , "dnsseed.bitcoin.dashjr.org" -- Luke Dashjr+          , "seed.bitcoinstats.com" -- Chris Decker+          , "seed.bitcoin.jonasschnelli.ch" -- Jonas Schnelli+          , "seed.btc.petertodd.org" -- Peter Todd+          , "seed.bitcoin.sprovoost.nl" -- Sjors Provoost+          ]+    , getBip44Coin = 0+    , getSigHashForkId = Nothing+    , getEdaBlockHeight = Nothing+    , getDaaBlockHeight = Nothing+    , getSegWit = True+    , getCashAddrPrefix = Nothing+    , getBech32Prefix = Just "bc"+    , getReplaceByFee = True+    , getHalvingInterval = 210000+    }++-- | Testnet for Bitcoin SegWit network.+btcTest :: Network+btcTest =+    Network+    { getNetworkName = "btctest"+    , getNetworkIdent = "btcTest"+    , getAddrPrefix = 111+    , getScriptPrefix = 196+    , getSecretPrefix = 239+    , getExtPubKeyPrefix = 0x043587cf+    , getExtSecretPrefix = 0x04358394+    , getNetworkMagic = 0x0b110907+    , getGenesisHeader =+          BlockHeader+              0x01+              "0000000000000000000000000000000000000000000000000000000000000000"+              "3ba3edfd7a7b12b27ac72c3e67768f617fc81bc3888a51323a9fb8aa4b1e5e4a"+              1296688602+              486604799+              414098458+            -- Hash 000000000933ea01ad0ee984209779baaec3ced90fa3f408719526f8d77f4943+    , getMaxBlockSize = 1000000+    , getMaxSatoshi = 2100000000000000+    , getHaskoinUserAgent = "/haskoin-btc-test:" <> versionString <> "/"+    , getDefaultPort = 18333+    , getAllowMinDifficultyBlocks = True+    , getPowNoRetargetting = False+    , getPowLimit =+          0x00000000ffffffffffffffffffffffffffffffffffffffffffffffffffffffff+    , getBip34Block =+          ( 21111+          , "0000000023b3a96d3484e5abb3755c413e7d41500f8e2a5c3f0dd01299cd8ef8")+    , getBip65Height = 581885+    , getBip66Height = 330776+    , getTargetTimespan = 14 * 24 * 60 * 60+    , getTargetSpacing = 10 * 60+    , getCheckpoints =+          [ ( 546+            , "000000002a936ca763904c3c35fce2f3556c559c0214345d31b1bcebf76acb70")+          ]+    , getSeeds =+          [ "testnet-seed.bitcoin.jonasschnelli.ch"+          , "seed.tbtc.petertodd.org"+          , "seed.testnet.bitcoin.sprovoost.nl"+          , "testnet-seed.bluematt.me"+          ]+    , getBip44Coin = 1+    , getSigHashForkId = Nothing+    , getEdaBlockHeight = Nothing+    , getDaaBlockHeight = Nothing+    , getSegWit = True+    , getCashAddrPrefix = Nothing+    , getBech32Prefix = Just "tb"+    , getReplaceByFee = True+    , getHalvingInterval = 210000+    }++-- | RegTest for Bitcoin SegWit network.+btcRegTest :: Network+btcRegTest =+    Network+    { getNetworkName = "btcreg"+    , getNetworkIdent = "btcRegTest"+    , getAddrPrefix = 111+    , getScriptPrefix = 196+    , getSecretPrefix = 239+    , getExtPubKeyPrefix = 0x043587cf+    , getExtSecretPrefix = 0x04358394+    , getNetworkMagic = 0xfabfb5da+    , getGenesisHeader =+          BlockHeader+           -- 0f9188f13cb7b2c71f2a335e3a4fc328bf5beb436012afca590b1a11466e2206+              0x01+              "0000000000000000000000000000000000000000000000000000000000000000"+              "3ba3edfd7a7b12b27ac72c3e67768f617fc81bc3888a51323a9fb8aa4b1e5e4a"+              1296688602+              0x207fffff+              2+    , getMaxBlockSize = 1000000+    , getMaxSatoshi = 2100000000000000+    , getHaskoinUserAgent = "/haskoin-btc-regtest:" <> versionString <> "/"+    , getDefaultPort = 18444+    , getAllowMinDifficultyBlocks = True+    , getPowNoRetargetting = True+    , getPowLimit =+          0x7fffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff+    , getBip34Block =+          ( 100000000+          , "0000000000000000000000000000000000000000000000000000000000000000")+    , getBip65Height = 1351+    , getBip66Height = 1251+    , getTargetTimespan = 14 * 24 * 60 * 60+    , getTargetSpacing = 10 * 60+    , getCheckpoints = []+    , getSeeds = ["localhost"]+    , getBip44Coin = 1+    , getSigHashForkId = Nothing+    , getEdaBlockHeight = Nothing+    , getDaaBlockHeight = Nothing+    , getSegWit = True+    , getCashAddrPrefix = Nothing+    , getBech32Prefix = Just "bcrt"+    , getReplaceByFee = True+    , getHalvingInterval = 150+    }++-- | Bitcoin Cash network. Symbol: BCH.+bch :: Network+bch =+    Network+    { getNetworkName = "bch"+    , getNetworkIdent = "bch"+    , getAddrPrefix = 0+    , getScriptPrefix = 5+    , getSecretPrefix = 128+    , getExtPubKeyPrefix = 0x0488b21e+    , getExtSecretPrefix = 0x0488ade4+    , getNetworkMagic = 0xe3e1f3e8+    , getGenesisHeader =+          BlockHeader+              0x01+              "0000000000000000000000000000000000000000000000000000000000000000"+              "3ba3edfd7a7b12b27ac72c3e67768f617fc81bc3888a51323a9fb8aa4b1e5e4a"+              1231006505+              0x1d00ffff+              2083236893+            -- Hash 000000000019d6689c085ae165831e934ff763ae46a2a6c172b3f1b60a8ce26f+    , getMaxBlockSize = 32000000+    , getMaxSatoshi = 2100000000000000+    , getHaskoinUserAgent = "/haskoin-bch:" <> versionString <> "/"+    , getDefaultPort = 8333+    , getAllowMinDifficultyBlocks = False+    , getPowNoRetargetting = False+    , getPowLimit =+          0x00000000ffffffffffffffffffffffffffffffffffffffffffffffffffffffff+    , getBip34Block =+          ( 227931+          , "000000000000024b89b42a942fe0d9fea3bb44ab7bd1b19115dd6a759c0808b8")+    , getBip65Height = 388381+    , getBip66Height = 363725+    , getTargetTimespan = 14 * 24 * 60 * 60+    , getTargetSpacing = 10 * 60+    , getCheckpoints =+          [ ( 11111+            , "0000000069e244f73d78e8fd29ba2fd2ed618bd6fa2ee92559f542fdb26e7c1d")+          , ( 33333+            , "000000002dd5588a74784eaa7ab0507a18ad16a236e7b1ce69f00d7ddfb5d0a6")+          , ( 74000+            , "0000000000573993a3c9e41ce34471c079dcf5f52a0e824a81e7f953b8661a20")+          , ( 105000+            , "00000000000291ce28027faea320c8d2b054b2e0fe44a773f3eefb151d6bdc97")+          , ( 134444+            , "00000000000005b12ffd4cd315cd34ffd4a594f430ac814c91184a0d42d2b0fe")+          , ( 168000+            , "000000000000099e61ea72015e79632f216fe6cb33d7899acb35b75c8303b763")+          , ( 193000+            , "000000000000059f452a5f7340de6682a977387c17010ff6e6c3bd83ca8b1317")+          , ( 210000+            , "000000000000048b95347e83192f69cf0366076336c639f9b7228e9ba171342e")+          , ( 216116+            , "00000000000001b4f4b433e81ee46494af945cf96014816a4e2370f11b23df4e")+          , ( 225430+            , "00000000000001c108384350f74090433e7fcf79a606b8e797f065b130575932")+          , ( 250000+            , "000000000000003887df1f29024b06fc2200b55f8af8f35453d7be294df2d214")+          , ( 279000+            , "0000000000000001ae8c72a0b0c301f67e3afca10e819efa9041e458e9bd7e40")+          , ( 295000+            , "00000000000000004d9b4ef50f0f9d686fd69db2e03af35a100370c64632a983")+            -- UAHF fork block.+          , ( 478559+            , "000000000000000000651ef99cb9fcbe0dadde1d424bd9f15ff20136191a5eec")+            -- Nov, 13 DAA activation block.+          , ( 504031+            , "0000000000000000011ebf65b60d0a3de80b8175be709d653b4c1a1beeb6ab9c")+          ]+    , getSeeds =+          [ "seed.bitcoinabc.org"+          , "seed-abc.bitcoinforks.org"+          , "btccash-seeder.bitcoinunlimited.info"+          , "seed.bitprim.org"+          , "seed.deadalnix.me"+          , "seeder.criptolayer.net"+          ]+    , getBip44Coin = 145+    , getSigHashForkId = Just 0+    , getEdaBlockHeight = Just 478559+    , getDaaBlockHeight = Just 404031+    , getSegWit = False+    , getCashAddrPrefix = Just "bitcoincash"+    , getBech32Prefix = Nothing+    , getReplaceByFee = False+    , getHalvingInterval = 210000+    }++-- | Testnet for Bitcoin Cash network.+bchTest :: Network+bchTest =+    Network+    { getNetworkName = "bchtest"+    , getNetworkIdent = "bchTest"+    , getAddrPrefix = 111+    , getScriptPrefix = 196+    , getSecretPrefix = 239+    , getExtPubKeyPrefix = 0x043587cf+    , getExtSecretPrefix = 0x04358394+    , getNetworkMagic = 0xf4e5f3f4+    , getGenesisHeader =+          BlockHeader+              0x01+              "0000000000000000000000000000000000000000000000000000000000000000"+              "3ba3edfd7a7b12b27ac72c3e67768f617fc81bc3888a51323a9fb8aa4b1e5e4a"+              1296688602+              486604799+              414098458+            -- Hash 000000000933ea01ad0ee984209779baaec3ced90fa3f408719526f8d77f4943+    , getMaxBlockSize = 32000000+    , getMaxSatoshi = 2100000000000000+    , getHaskoinUserAgent = "/haskoin-bch-test:" <> versionString <> "/"+    , getDefaultPort = 18333+    , getAllowMinDifficultyBlocks = True+    , getPowNoRetargetting = False+    , getPowLimit =+          0x00000000ffffffffffffffffffffffffffffffffffffffffffffffffffffffff+    , getBip34Block =+          ( 21111+          , "0000000023b3a96d3484e5abb3755c413e7d41500f8e2a5c3f0dd01299cd8ef8")+    , getBip65Height = 581885+    , getBip66Height = 330776+    , getTargetTimespan = 14 * 24 * 60 * 60+    , getTargetSpacing = 10 * 60+    , getCheckpoints =+          [ ( 546+            , "000000002a936ca763904c3c35fce2f3556c559c0214345d31b1bcebf76acb70")+            -- UAHF fork block.+          , ( 1155876+            , "00000000000e38fef93ed9582a7df43815d5c2ba9fd37ef70c9a0ea4a285b8f5")+            -- Nov, 13. DAA activation block.+          , ( 1188697+            , "0000000000170ed0918077bde7b4d36cc4c91be69fa09211f748240dabe047fb")+          ]+    , getSeeds =+          [ "testnet-seed.bitcoinabc.org"+          , "testnet-seed-abc.bitcoinforks.org"+          , "testnet-seed.bitprim.org"+          , "testnet-seed.deadalnix.me"+          , "testnet-seeder.criptolayer.net"+          ]+    , getBip44Coin = 1+    , getSigHashForkId = Just 0+    , getEdaBlockHeight = Just 1155876+    , getDaaBlockHeight = Just 1188697+    , getSegWit = False+    , getCashAddrPrefix = Just "bchtest"+    , getBech32Prefix = Nothing+    , getReplaceByFee = False+    , getHalvingInterval = 210000+    }++-- | RegTest for Bitcoin Cash network.+bchRegTest :: Network+bchRegTest =+    Network+    { getNetworkName = "bchreg"+    , getNetworkIdent = "bchRegTest"+    , getAddrPrefix = 111+    , getScriptPrefix = 196+    , getSecretPrefix = 239+    , getExtPubKeyPrefix = 0x043587cf+    , getExtSecretPrefix = 0x04358394+    , getNetworkMagic = 0xdab5bffa+    , getGenesisHeader =+          BlockHeader+           -- 0f9188f13cb7b2c71f2a335e3a4fc328bf5beb436012afca590b1a11466e2206+              0x01+              "0000000000000000000000000000000000000000000000000000000000000000"+              "3ba3edfd7a7b12b27ac72c3e67768f617fc81bc3888a51323a9fb8aa4b1e5e4a"+              1296688602+              0x207fffff+              2+    , getMaxBlockSize = 1000000+    , getMaxSatoshi = 2100000000000000+    , getHaskoinUserAgent = "/haskoin-bch-regtest:" <> versionString <> "/"+    , getDefaultPort = 18444+    , getAllowMinDifficultyBlocks = True+    , getPowNoRetargetting = True+    , getPowLimit =+          0x7fffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff+    , getBip34Block =+          ( 100000000+          , "0000000000000000000000000000000000000000000000000000000000000000")+    , getBip65Height = 1351+    , getBip66Height = 1251+    , getTargetTimespan = 14 * 24 * 60 * 60+    , getTargetSpacing = 10 * 60+    , getCheckpoints =+          [ ( 0+            , "0f9188f13cb7b2c71f2a335e3a4fc328bf5beb436012afca590b1a11466e2206")+          ]+    , getSeeds = ["localhost"]+    , getBip44Coin = 1+    , getSigHashForkId = Just 0+    , getEdaBlockHeight = Nothing+    , getDaaBlockHeight = Just 0+    , getSegWit = False+    , getCashAddrPrefix = Just "bchreg"+    , getBech32Prefix = Nothing+    , getReplaceByFee = False+    , getHalvingInterval = 150+    }++-- | List of all networks supported by this library.+allNets :: [Network]+allNets = [btc, bch, btcTest, bchTest, btcRegTest, bchRegTest]
+ src/Haskoin/Crypto.hs view
@@ -0,0 +1,22 @@+{-|+Module      : Haskoin.Crypto+Copyright   : No rights reserved+License     : UNLICENSE+Maintainer  : jprupp@protonmail.ch+Stability   : experimental+Portability : POSIX++Hashing functions and ECDSA signatures.+-}+module Haskoin.Crypto+    ( -- * Hashes+      module Hash+      -- * Signatures+    , module Signature+      -- * Secp256k1 (re-exported)+    , module Secp256k1+    ) where++import           Crypto.Secp256k1         as Secp256k1+import           Haskoin.Crypto.Hash      as Hash+import           Haskoin.Crypto.Signature as Signature
+ src/Haskoin/Crypto/Hash.hs view
@@ -0,0 +1,202 @@+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE DeriveGeneric  #-}+{-|+Module      : Haskoin.Crypto.Hash+Copyright   : No rights reserved+License     : UNLICENSE+Maintainer  : jprupp@protonmail.ch+Stability   : experimental+Portability : POSIX++Hashing functions and corresponding data types. Uses functions from the+cryptonite library.+-}+module Haskoin.Crypto.Hash+    ( -- * Hashes+      Hash512(getHash512)+    , Hash256(getHash256)+    , Hash160(getHash160)+    , CheckSum32(getCheckSum32)+    , sha512+    , sha256+    , ripemd160+    , sha1+    , doubleSHA256+    , addressHash+    , checkSum32+    , hmac512+    , hmac256+    , split512+    , join512+    ) where++import           Control.DeepSeq+import           Crypto.Hash             (RIPEMD160 (..), SHA1 (..),+                                          SHA256 (..), SHA512 (..), hashWith)+import           Crypto.MAC.HMAC         (HMAC, hmac)+import           Data.ByteArray          (ByteArrayAccess)+import qualified Data.ByteArray          as BA+import           Data.ByteString         (ByteString)+import qualified Data.ByteString         as BS+import           Data.ByteString.Short   (ShortByteString)+import qualified Data.ByteString.Short   as BSS+import           Data.Either             (fromRight)+import           Data.Hashable           (Hashable)+import           Data.Serialize          (Serialize (..), decode)+import qualified Data.Serialize.Get      as Get+import qualified Data.Serialize.Put      as Put+import           Data.String             (IsString, fromString)+import           Data.String.Conversions (cs)+import           Data.Word               (Word32)+import           GHC.Generics            (Generic)+import           Haskoin.Util+import           Text.Read               as R++-- | 'Word32' wrapped for type-safe 32-bit checksums.+newtype CheckSum32 = CheckSum32+    { getCheckSum32 :: Word32+    } deriving (Eq, Ord, Serialize, Show, Read, Hashable, Generic, NFData)++-- | Type for 512-bit hashes.+newtype Hash512 = Hash512 { getHash512 :: ShortByteString }+    deriving (Eq, Ord, Hashable, Generic, NFData)++-- | Type for 256-bit hashes.+newtype Hash256 = Hash256 { getHash256 :: ShortByteString }+    deriving (Eq, Ord, Hashable, Generic, NFData)++-- | Type for 160-bit hashes.+newtype Hash160 = Hash160 { getHash160 :: ShortByteString }+    deriving (Eq, Ord, Hashable, Generic, NFData)++instance Show Hash512 where+    showsPrec _ = shows . encodeHex . BSS.fromShort . getHash512++instance Read Hash512 where+    readPrec = do+        R.String str <- lexP+        maybe pfail return $ Hash512 . BSS.toShort <$> decodeHex (cs str)++instance Show Hash256 where+    showsPrec _ = shows . encodeHex . BSS.fromShort . getHash256++instance Read Hash256 where+    readPrec = do+        R.String str <- lexP+        maybe pfail return $ Hash256 . BSS.toShort <$> decodeHex (cs str)++instance Show Hash160 where+    showsPrec _ = shows . encodeHex . BSS.fromShort . getHash160++instance Read Hash160 where+    readPrec = do+        R.String str <- lexP+        maybe pfail return $ Hash160 . BSS.toShort <$> decodeHex (cs str)++instance IsString Hash512 where+    fromString str =+        case decodeHex $ cs str of+            Nothing -> e+            Just bs ->+                case BS.length bs of+                    64 -> Hash512 (BSS.toShort bs)+                    _  -> e+      where+        e = error "Could not decode hash from hex string"++instance Serialize Hash512 where+    get = Hash512 <$> Get.getShortByteString 64+    put = Put.putShortByteString . getHash512++instance IsString Hash256 where+    fromString str =+        case decodeHex $ cs str of+            Nothing -> e+            Just bs ->+                case BS.length bs of+                    32 -> Hash256 (BSS.toShort bs)+                    _  -> e+      where+        e = error "Could not decode hash from hex string"++instance Serialize Hash256 where+    get = Hash256 <$> Get.getShortByteString 32+    put = Put.putShortByteString . getHash256++instance IsString Hash160 where+    fromString str =+        case decodeHex $ cs str of+            Nothing -> e+            Just bs ->+                case BS.length bs of+                    20 -> Hash160 (BSS.toShort bs)+                    _  -> e+      where+        e = error "Could not decode hash from hex string"++instance Serialize Hash160 where+    get = Hash160 <$> Get.getShortByteString 20+    put = Put.putShortByteString . getHash160++-- | Calculate SHA512 hash.+sha512 :: ByteArrayAccess b => b -> Hash512+sha512 = Hash512 . BSS.toShort . BA.convert . hashWith SHA512++-- | Calculate SHA256 hash.+sha256 :: ByteArrayAccess b => b -> Hash256+sha256 = Hash256 . BSS.toShort . BA.convert . hashWith SHA256++-- | Calculate RIPEMD160 hash.+ripemd160 :: ByteArrayAccess b => b -> Hash160+ripemd160 = Hash160 . BSS.toShort . BA.convert . hashWith RIPEMD160++-- | Claculate SHA1 hash.+sha1 :: ByteArrayAccess b => b -> Hash160+sha1 = Hash160 . BSS.toShort . BA.convert . hashWith SHA1++-- | Compute two rounds of SHA-256.+doubleSHA256 :: ByteArrayAccess b => b -> Hash256+doubleSHA256 =+    Hash256 . BSS.toShort . BA.convert . hashWith SHA256 . hashWith SHA256++-- | Compute SHA-256 followed by RIPMED-160.+addressHash :: ByteArrayAccess b => b -> Hash160+addressHash =+    Hash160 . BSS.toShort . BA.convert . hashWith RIPEMD160 . hashWith SHA256++{- CheckSum -}++-- | Computes a 32 bit checksum.+checkSum32 :: ByteArrayAccess b => b -> CheckSum32+checkSum32 = fromRight (error "Could not decode bytes as CheckSum32")+             . decode+             . BS.take 4+             . BA.convert+             . hashWith SHA256+             . hashWith SHA256++{- HMAC -}++-- | Computes HMAC over SHA-512.+hmac512 :: ByteString -> ByteString -> Hash512+hmac512 key msg =+    Hash512 $ BSS.toShort $ BA.convert (hmac key msg :: HMAC SHA512)++-- | Computes HMAC over SHA-256.+hmac256 :: (ByteArrayAccess k, ByteArrayAccess m) => k -> m -> Hash256+hmac256 key msg =+    Hash256 $ BSS.toShort $ BA.convert (hmac key msg :: HMAC SHA256)++-- | Split a 'Hash512' into a pair of 'Hash256'.+split512 :: Hash512 -> (Hash256, Hash256)+split512 h =+    (Hash256 (BSS.toShort a), Hash256 (BSS.toShort b))+  where+    (a, b) = BS.splitAt 32 . BSS.fromShort $ getHash512 h++-- | Join a pair of 'Hash256' into a 'Hash512'.+join512 :: (Hash256, Hash256) -> Hash512+join512 (a, b) =+    Hash512 .+    BSS.toShort $+        BSS.fromShort (getHash256 a) `BS.append` BSS.fromShort (getHash256 b)
+ src/Haskoin/Crypto/Signature.hs view
@@ -0,0 +1,90 @@+{-# LANGUAGE OverloadedStrings #-}+{-|+Module      : Haskoin.Crypto.Signature+Copyright   : No rights reserved+License     : UNLICENSE+Maintainer  : jprupp@protonmail.ch+Stability   : experimental+Portability : POSIX++ECDSA signatures using secp256k1 curve. Uses functions from upstream secp256k1+library.+-}+module Haskoin.Crypto.Signature+    ( putSig+    , getSig+    , signHash+    , verifyHashSig+    , isCanonicalHalfOrder+    , decodeStrictSig+    , exportSig+    ) where++import           Control.Monad         (guard, unless, when)+import           Crypto.Secp256k1+import           Data.ByteString       (ByteString)+import qualified Data.ByteString       as BS+import           Data.ByteString.Short (toShort)+import           Data.Maybe            (fromMaybe)+import           Data.Serialize        as S+import           Data.Serialize.Put    (Putter, putByteString)+import           Haskoin.Crypto.Hash+import           Numeric               (showHex)++-- | Convert 256-bit hash into a 'Msg' for signing or verification.+hashToMsg :: Hash256 -> Msg+hashToMsg =+    fromMaybe e . msg . encode+  where+    e = error "Could not convert 32-byte hash to secp256k1 message"++-- | Sign a 256-bit hash using secp256k1 elliptic curve.+signHash :: SecKey -> Hash256 -> Sig+signHash k = signMsg k . hashToMsg++-- | Verify an ECDSA signature for a 256-bit hash.+verifyHashSig :: Hash256 -> Sig -> PubKey -> Bool+verifyHashSig h s p =+    verifySig p g m+  where+    (g, _) = normalizeSig s+    m = hashToMsg h++-- | Deserialize an ECDSA signature as commonly encoded in Bitcoin.+getSig :: Get Sig+getSig = do+        l <- lookAhead $ do+            t <- getWord8+            -- 0x30 is DER sequence type+            unless (t == 0x30) $ fail $+                "Bad DER identifier byte 0x" ++ showHex t ". Expecting 0x30"+            l <- getWord8+            when (l == 0x00) $ fail "Indeterminate form unsupported"+            when (l >= 0x80) $ fail "Multi-octect length not supported"+            return $ fromIntegral l+        bs <- getByteString $ l + 2+        case decodeStrictSig bs of+            Just s  -> return s+            Nothing -> fail "Invalid signature"++-- | Serialize an ECDSA signature for Bitcoin use.+putSig :: Putter Sig+putSig s = putByteString $ exportSig s++-- | Is canonical half order.+isCanonicalHalfOrder :: Sig -> Bool+isCanonicalHalfOrder = not . snd . normalizeSig++-- | Decode signature strictly.+decodeStrictSig :: ByteString -> Maybe Sig+decodeStrictSig bs = do+    g <- importSig bs+    let compact = exportCompactSig g+    -- <http://www.secg.org/sec1-v2.pdf Section 4.1.4>+    -- 4.1.4.1 (r and s can not be zero)+    guard $ getCompactSigR compact /= zero+    guard $ getCompactSigS compact /= zero+    guard $ isCanonicalHalfOrder g+    return g+  where+    zero = toShort $ BS.replicate 32 0
+ src/Haskoin/Keys.hs view
@@ -0,0 +1,22 @@+{-|+Module      : Haskoin.Keys+Copyright   : No rights reserved+License     : UNLICENSE+Maintainer  : jprupp@protonmail.ch+Stability   : experimental+Portability : POSIX++ECDSA private and public keys, extended keys (BIP-32) and mnemonic sentences+(BIP-39).+-}+module Haskoin.Keys+    ( module Haskoin.Keys.Common+    -- * Extended Keys+    , module Haskoin.Keys.Extended+    -- * Mnemonic+    , module Haskoin.Keys.Mnemonic+    ) where++import           Haskoin.Keys.Common+import           Haskoin.Keys.Extended+import           Haskoin.Keys.Mnemonic
+ src/Haskoin/Keys/Common.hs view
@@ -0,0 +1,136 @@+{-# LANGUAGE DeriveAnyClass    #-}+{-# LANGUAGE DeriveGeneric     #-}+{-# LANGUAGE FlexibleContexts  #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE OverloadedStrings #-}+{-|+Module      : Haskoin.Keys.Common+Copyright   : No rights reserved+License     : UNLICENSE+Maintainer  : jprupp@protonmail.ch+Stability   : experimental+Portability : POSIX++ECDSA private and public key functions.+-}+module Haskoin.Keys.Common+    ( -- * Public & Private Keys+      PubKeyI(..)+    , SecKeyI(..)+    , exportPubKey+    , importPubKey+    , wrapPubKey+    , derivePubKeyI+    , wrapSecKey+    , fromMiniKey+    , tweakPubKey+    , tweakSecKey+    , secKeyPut+    , secKeyGet+    , getSecKey+    , secKey+    ) where++import           Control.Applicative     ((<|>))+import           Control.DeepSeq+import           Control.Monad           (guard, mzero, (<=<))+import           Crypto.Secp256k1+import           Data.Aeson              (FromJSON, ToJSON (..), Value (String),+                                          parseJSON, withText)+import           Data.Aeson.Encoding     (unsafeToEncoding)+import           Data.ByteString         (ByteString)+import qualified Data.ByteString         as BS+import           Data.ByteString.Builder (char7)+import           Data.Hashable+import           Data.Maybe              (fromMaybe)+import           Data.Serialize          (Serialize, decode, encode, get, put)+import           Data.Serialize.Get      (Get, getByteString)+import           Data.Serialize.Put      (Putter, putByteString)+import           Data.String             (IsString, fromString)+import           Data.String.Conversions (cs)+import           GHC.Generics            (Generic)+import           Haskoin.Crypto.Hash+import           Haskoin.Util++-- | Elliptic curve public key type with expected serialized compression flag.+data PubKeyI = PubKeyI+    { pubKeyPoint      :: !PubKey+    , pubKeyCompressed :: !Bool+    } deriving (Generic, Eq, Show, Read, Hashable, NFData)++instance IsString PubKeyI where+    fromString str =+        fromMaybe e $ eitherToMaybe . decode <=< decodeHex $ cs str+      where+        e = error "Could not decode public key"++instance ToJSON PubKeyI where+    toJSON = String . encodeHex . encode+    toEncoding s = unsafeToEncoding $ char7 '"' <> hexBuilder (encode s) <> char7 '"'++instance FromJSON PubKeyI where+    parseJSON = withText "PubKeyI" $+        maybe mzero return . (eitherToMaybe . decode =<<) . decodeHex++instance Serialize PubKeyI where+    get = c <|> u+      where+        c = do+            bs <- getByteString 33+            guard $ BS.head bs `BS.elem` BS.pack [0x02, 0x03]+            maybe mzero return $ PubKeyI <$> importPubKey bs <*> pure True+        u = do+            bs <- getByteString 65+            guard $ BS.head bs == 0x04+            maybe mzero return $ PubKeyI <$> importPubKey bs <*> pure False++    put pk = putByteString $ exportPubKey (pubKeyCompressed pk) (pubKeyPoint pk)++-- | Wrap a public key from secp256k1 library adding information about compression.+wrapPubKey :: Bool -> PubKey -> PubKeyI+wrapPubKey c p = PubKeyI p c++-- | Derives a public key from a private key. This function will preserve+-- compression flag.+derivePubKeyI :: SecKeyI -> PubKeyI+derivePubKeyI (SecKeyI d c) = PubKeyI (derivePubKey d) c++-- | Tweak a public key.+tweakPubKey :: PubKey -> Hash256 -> Maybe PubKey+tweakPubKey p h = tweakAddPubKey p =<< tweak (encode h)++-- | Elliptic curve private key type with expected public key compression+-- information. Compression information is stored in private key WIF formats and+-- needs to be preserved to generate the correct address from the corresponding+-- public key.+data SecKeyI = SecKeyI+    { secKeyData       :: !SecKey+    , secKeyCompressed :: !Bool+    } deriving (Eq, Show, Read, Generic, NFData)++-- | Wrap private key with corresponding public key compression flag.+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+fromMiniKey bs = do+    guard checkShortKey+    wrapSecKey False <$> secKey (encode (sha256 bs))+  where+    checkHash = encode $ sha256 $ bs `BS.append` "?"+    checkShortKey = BS.length bs `elem` [22, 30] && BS.head checkHash == 0x00++-- | Tweak a private key.+tweakSecKey :: SecKey -> Hash256 -> Maybe SecKey+tweakSecKey key h = tweakAddSecKey key =<< tweak (encode h)
+ src/Haskoin/Keys/Extended.hs view
@@ -0,0 +1,918 @@+{-# LANGUAGE DeriveAnyClass    #-}+{-# LANGUAGE DeriveGeneric     #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GADTs             #-}+{-# LANGUAGE OverloadedStrings #-}+{-|+Module      : Haskoin.Keys.Extended+Copyright   : No rights reserved+License     : UNLICENSE+Maintainer  : jprupp@protonmail.ch+Stability   : experimental+Portability : POSIX++BIP-32 extended keys.+-}+module Haskoin.Keys.Extended+    (+      -- * Extended Keys+      XPubKey(..)+    , XPrvKey(..)+    , ChainCode+    , KeyIndex+    , Fingerprint+    , DerivationException(..)+    , makeXPrvKey+    , deriveXPubKey+    , prvSubKey+    , pubSubKey+    , hardSubKey+    , xPrvIsHard+    , xPubIsHard+    , xPrvChild+    , xPubChild+    , xPubID+    , xPrvID+    , xPubFP+    , xPrvFP+    , xPubAddr+    , xPubWitnessAddr+    , xPubCompatWitnessAddr+    , xPubExport+    , xPubToJSON+    , xPubToEncoding+    , xPubFromJSON+    , xPrvExport+    , xPrvToJSON+    , xPrvToEncoding+    , xPrvFromJSON+    , xPubImport+    , xPrvImport+    , xPrvWif+    , putXPrvKey+    , putXPubKey+    , getXPrvKey+    , getXPubKey++      -- ** Helper Functions+    , prvSubKeys+    , pubSubKeys+    , hardSubKeys+    , deriveAddr+    , deriveWitnessAddr+    , deriveCompatWitnessAddr+    , deriveAddrs+    , deriveWitnessAddrs+    , deriveCompatWitnessAddrs+    , deriveMSAddr+    , deriveMSAddrs+    , cycleIndex++      -- ** Derivation Paths+    , DerivPathI(..)+    , AnyDeriv, HardDeriv, SoftDeriv+    , HardOrAny+    , AnyOrSoft+    , DerivPath+    , HardPath+    , SoftPath+    , Bip32PathIndex (..)+    , derivePath+    , derivePubPath+    , toHard+    , toSoft+    , toGeneric+    , (++/)+    , pathToStr+    , listToPath+    , pathToList++      -- *** Derivation Path Parser+    , XKey(..)+    , ParsedPath(..)+    , parsePath+    , parseHard+    , parseSoft+    , applyPath+    , derivePathAddr+    , derivePathAddrs+    , derivePathMSAddr+    , derivePathMSAddrs+    , concatBip32Segments+    ) where++import           Control.Applicative+import           Control.DeepSeq+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.Encoding     (Encoding, text)+import           Data.Aeson.Types        (Parser)+import           Data.Bits               (clearBit, setBit, testBit)+import           Data.ByteString         (ByteString)+import qualified Data.ByteString         as B+import           Data.Either             (fromRight)+import           Data.List               (foldl')+import           Data.List.Split         (splitOn)+import           Data.Maybe              (fromMaybe)+import           Data.Serialize          as S (Serialize, decode, encode, get,+                                               put)+import           Data.Serialize.Get      (Get, getWord32be, getWord8, runGet)+import           Data.Serialize.Put      (Putter, putWord32be, putWord8, runPut)+import           Data.String             (IsString, fromString)+import           Data.String.Conversions (cs)+import           Data.Typeable           (Typeable)+import           Data.Word               (Word32, Word8)+import           GHC.Generics            (Generic)+import           Haskoin.Address+import           Haskoin.Constants+import           Haskoin.Crypto.Hash+import           Haskoin.Keys.Common+import           Haskoin.Script+import           Haskoin.Util+import           Text.Read               as R+import           Text.Read.Lex+++-- | A derivation exception is thrown in the very unlikely event that a+-- derivation is invalid.+newtype DerivationException = DerivationException String+    deriving (Eq, Read, Show, Typeable, Generic, NFData)++instance Exception DerivationException++-- | Chain code as specified in BIP-32.+type ChainCode = Hash256++-- | Index of key as specified in BIP-32.+type KeyIndex = Word32++-- | Fingerprint of parent+type Fingerprint = Word32++-- | Data type representing an extended BIP32 private key. An extended key+-- is a node in a tree of key derivations. It has a depth in the tree, a+-- parent node and an index to differentiate it from other siblings.+data XPrvKey = XPrvKey+    { xPrvDepth  :: !Word8       -- ^ depth in the tree+    , xPrvParent :: !Fingerprint -- ^ fingerprint of parent+    , xPrvIndex  :: !KeyIndex    -- ^ derivation index+    , xPrvChain  :: !ChainCode   -- ^ chain code+    , xPrvKey    :: !SecKey      -- ^ private key of this node+    } deriving (Generic, Eq, Show, Read, NFData)++xPrvToJSON :: Network -> XPrvKey -> Value+xPrvToJSON net = A.String . xPrvExport net++xPrvToEncoding :: Network -> XPrvKey -> Encoding+xPrvToEncoding net = text . xPrvExport net++-- | Data type representing an extended BIP32 public key.+data XPubKey = XPubKey+    { xPubDepth  :: !Word8     -- ^ depth in the tree+    , xPubParent :: !Fingerprint    -- ^ fingerprint of parent+    , xPubIndex  :: !KeyIndex  -- ^ derivation index+    , xPubChain  :: !ChainCode -- ^ chain code+    , xPubKey    :: !PubKey    -- ^ public key of this node+    } deriving (Generic, Eq, Show, Read, NFData)+++-- | Decode an extended public key from a JSON string+xPubFromJSON :: Network -> Value -> Parser XPubKey+xPubFromJSON net =+    withText "xpub" $ \t ->+        case xPubImport net t of+            Nothing -> fail "could not read xpub"+            Just x  -> return x++-- | Get JSON 'Value' from 'XPubKey'.+xPubToJSON :: Network -> XPubKey -> Value+xPubToJSON net = A.String . xPubExport net++xPubToEncoding :: Network -> XPubKey -> Encoding+xPubToEncoding net = text . xPubExport net++-- | Decode an extended private key from a JSON string+xPrvFromJSON :: Network -> Value -> Parser XPrvKey+xPrvFromJSON net =+    withText "xprv" $ \t ->+        case xPrvImport net t of+            Nothing -> fail "could not read xprv"+            Just x  -> return x++-- | Build a BIP32 compatible extended private key from a bytestring. This will+-- produce a root node (@depth=0@ and @parent=0@).+makeXPrvKey :: ByteString -> XPrvKey+makeXPrvKey bs =+    XPrvKey 0 0 0 c k+  where+    (p, c) = split512 $ hmac512 "Bitcoin seed" bs+    k     = fromMaybe err (secKey (encode p))+    err   = throw $ DerivationException "Invalid seed"++-- | Derive an extended public key from an extended private key. This function+-- will preserve the depth, parent, index and chaincode fields of the extended+-- private keys.+deriveXPubKey :: XPrvKey -> XPubKey+deriveXPubKey (XPrvKey d p i c k) = XPubKey d p i c (derivePubKey k)++-- | Compute a private, soft child key derivation. A private soft derivation+-- will allow the equivalent extended public key to derive the public key for+-- this child. Given a parent key /m/ and a derivation index /i/, this function+-- will compute /m\/i/.+--+-- Soft derivations allow for more flexibility such as read-only wallets.+-- However, care must be taken not the leak both the parent extended public key+-- and one of the extended child private keys as this would compromise the+-- extended parent private key.+prvSubKey :: XPrvKey  -- ^ extended parent private key+          -> KeyIndex -- ^ child derivation index+          -> XPrvKey  -- ^ extended child private key+prvSubKey xkey child+    | child >= 0 && child < 0x80000000 =+        XPrvKey (xPrvDepth xkey + 1) (xPrvFP xkey) child c k+    | otherwise = error "Invalid child derivation index"+  where+    pK = xPubKey $ deriveXPubKey xkey+    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"++-- | Compute a public, soft child key derivation. Given a parent key /M/+-- and a derivation index /i/, this function will compute /M\/i/.+pubSubKey :: XPubKey  -- ^ extended parent public key+          -> KeyIndex -- ^ child derivation index+          -> XPubKey  -- ^ extended child public key+pubSubKey xKey child+    | child >= 0 && child < 0x80000000 =+        XPubKey (xPubDepth xKey + 1) (xPubFP xKey) child c pK+    | otherwise = error "Invalid child derivation index"+  where+    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"++-- | Compute a hard child key derivation. Hard derivations can only be computed+-- for private keys. Hard derivations do not allow the parent public key to+-- derive the child public keys. However, they are safer as a breach of the+-- parent public key and child private keys does not lead to a breach of the+-- parent private key. Given a parent key /m/ and a derivation index /i/, this+-- function will compute /m\/i'/.+hardSubKey :: XPrvKey  -- ^ extended parent private key+           -> KeyIndex -- ^ child derivation index+           -> XPrvKey  -- ^ extended child private key+hardSubKey xkey child+    | child >= 0 && child < 0x80000000 =+        XPrvKey (xPrvDepth xkey + 1) (xPrvFP xkey) i c k+    | otherwise = error "Invalid child derivation index"+  where+    i      = setBit child 31+    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"++-- | Returns true if the extended private key was derived through a hard+-- derivation.+xPrvIsHard :: XPrvKey -> Bool+xPrvIsHard k = testBit (xPrvIndex k) 31++-- | Returns true if the extended public key was derived through a hard+-- derivation.+xPubIsHard :: XPubKey -> Bool+xPubIsHard k = testBit (xPubIndex k) 31++-- | Returns the derivation index of this extended private key without the hard+-- bit set.+xPrvChild :: XPrvKey -> KeyIndex+xPrvChild k = clearBit (xPrvIndex k) 31++-- | Returns the derivation index of this extended public key without the hard+-- bit set.+xPubChild :: XPubKey -> KeyIndex+xPubChild k = clearBit (xPubIndex k) 31++-- | Computes the key identifier of an extended private key.+xPrvID :: XPrvKey -> Hash160+xPrvID = xPubID . deriveXPubKey++-- | Computes the key identifier of an extended public key.+xPubID :: XPubKey -> Hash160+xPubID = ripemd160 . encode . sha256 . exportPubKey True . xPubKey++-- | Computes the key fingerprint of an extended private key.+xPrvFP :: XPrvKey -> Fingerprint+xPrvFP =+    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 -> Fingerprint+xPubFP =+    fromRight err . decode . B.take 4 . encode . xPubID+  where+    err = error "Could not decode xPubFP"++-- | Compute a standard P2PKH address for an extended public key.+xPubAddr :: XPubKey -> Address+xPubAddr xkey = pubKeyAddr (wrapPubKey True (xPubKey xkey))++-- | Compute a SegWit P2WPKH address for an extended public key.+xPubWitnessAddr :: XPubKey -> Address+xPubWitnessAddr xkey = pubKeyWitnessAddr (wrapPubKey True (xPubKey xkey))++-- | Compute a backwards-compatible SegWit P2SH-P2WPKH address for an extended+-- public key.+xPubCompatWitnessAddr :: XPubKey -> Address+xPubCompatWitnessAddr xkey =+    pubKeyCompatWitnessAddr (wrapPubKey True (xPubKey xkey))++-- | Exports an extended private key to the BIP32 key export format ('Base58').+xPrvExport :: Network -> XPrvKey -> Base58+xPrvExport net = encodeBase58Check . runPut . putXPrvKey net++-- | Exports an extended public key to the BIP32 key export format ('Base58').+xPubExport :: Network -> XPubKey -> Base58+xPubExport net = encodeBase58Check . runPut . putXPubKey net++-- | Decodes a BIP32 encoded extended private key. This function will fail if+-- invalid base 58 characters are detected or if the checksum fails.+xPrvImport :: Network -> Base58 -> Maybe XPrvKey+xPrvImport net = eitherToMaybe . runGet (getXPrvKey net) <=< decodeBase58Check++-- | Decodes a BIP32 encoded extended public key. This function will fail if+-- invalid base 58 characters are detected or if the checksum fails.+xPubImport :: Network -> Base58 -> Maybe XPubKey+xPubImport net = eitherToMaybe . runGet (getXPubKey net) <=< decodeBase58Check++-- | Export an extended private key to WIF (Wallet Import Format).+xPrvWif :: Network -> XPrvKey -> Base58+xPrvWif net xkey = toWif net (wrapSecKey True (xPrvKey xkey))++-- | Parse a binary extended private key.+getXPrvKey :: Network -> Get XPrvKey+getXPrvKey net = do+        ver <- getWord32be+        unless (ver == getExtSecretPrefix net) $ fail+            "Get: Invalid version for extended private key"+        XPrvKey <$> getWord8+                <*> getWord32be+                <*> getWord32be+                <*> S.get+                <*> getPadPrvKey++-- | Serialize an extended private key.+putXPrvKey :: Network -> Putter XPrvKey+putXPrvKey net k = do+        putWord32be  $ getExtSecretPrefix net+        putWord8     $ xPrvDepth k+        putWord32be  $ xPrvParent k+        putWord32be  $ xPrvIndex k+        put          $ xPrvChain k+        putPadPrvKey $ xPrvKey k++-- | Parse a binary extended public key.+getXPubKey :: Network -> Get XPubKey+getXPubKey net = do+        ver <- getWord32be+        unless (ver == getExtPubKeyPrefix net) $ fail+            "Get: Invalid version for extended public key"+        XPubKey <$> getWord8+                <*> getWord32be+                <*> getWord32be+                <*> S.get+                <*> (pubKeyPoint <$> S.get)++-- | Serialize an extended public key.+putXPubKey :: Network -> Putter XPubKey+putXPubKey net k = do+        putWord32be $ getExtPubKeyPrefix net+        putWord8    $ xPubDepth k+        putWord32be $ xPubParent k+        putWord32be $ xPubIndex k+        put         $ xPubChain k+        put         $ wrapPubKey True (xPubKey k)++{- Derivation helpers -}++-- | Cyclic list of all private soft child key derivations of a parent key+-- starting from an offset index.+prvSubKeys :: XPrvKey -> KeyIndex -> [(XPrvKey, KeyIndex)]+prvSubKeys k = map (\i -> (prvSubKey k i, i)) . cycleIndex++-- | Cyclic list of all public soft child key derivations of a parent key+-- starting from an offset index.+pubSubKeys :: XPubKey -> KeyIndex -> [(XPubKey, KeyIndex)]+pubSubKeys k = map (\i -> (pubSubKey k i, i)) . cycleIndex++-- | Cyclic list of all hard child key derivations of a parent key starting+-- from an offset index.+hardSubKeys :: XPrvKey -> KeyIndex -> [(XPrvKey, KeyIndex)]+hardSubKeys k = map (\i -> (hardSubKey k i, i)) . cycleIndex++-- | Derive a standard address from an extended public key and an index.+deriveAddr :: XPubKey -> KeyIndex -> (Address, PubKey)+deriveAddr k i =+    (xPubAddr key, xPubKey key)+  where+    key = pubSubKey k i++-- | Derive a SegWit P2WPKH address from an extended public key and an index.+deriveWitnessAddr :: XPubKey -> KeyIndex -> (Address, PubKey)+deriveWitnessAddr k i =+    (xPubWitnessAddr key, xPubKey key)+  where+    key = pubSubKey k i++-- | Derive a backwards-compatible SegWit P2SH-P2WPKH address from an extended+-- public key and an index.+deriveCompatWitnessAddr :: XPubKey -> KeyIndex -> (Address, PubKey)+deriveCompatWitnessAddr k i =+    (xPubCompatWitnessAddr key, xPubKey key)+  where+    key = pubSubKey k i++-- | Cyclic list of all addresses derived from a public key starting from an+-- offset index.+deriveAddrs :: XPubKey -> KeyIndex -> [(Address, PubKey, KeyIndex)]+deriveAddrs k =+    map f . cycleIndex+  where+    f i = let (a, key) = deriveAddr k i in (a, key, i)++-- | Cyclic list of all SegWit P2WPKH addresses derived from a public key+-- starting from an offset index.+deriveWitnessAddrs :: XPubKey -> KeyIndex -> [(Address, PubKey, KeyIndex)]+deriveWitnessAddrs k =+    map f . cycleIndex+  where+    f i = let (a, key) = deriveWitnessAddr k i in (a, key, i)++-- | Cyclic list of all backwards-compatible SegWit P2SH-P2WPKH addresses+-- derived from a public key starting from an offset index.+deriveCompatWitnessAddrs :: XPubKey -> KeyIndex -> [(Address, PubKey, KeyIndex)]+deriveCompatWitnessAddrs k =+    map f . cycleIndex+  where+    f i = let (a, key) = deriveCompatWitnessAddr k i in (a, key, i)++-- | Derive a multisig address from a list of public keys, the number of+-- required signatures /m/ and a derivation index. The derivation type is a+-- public, soft derivation.+deriveMSAddr :: [XPubKey] -> Int -> KeyIndex -> (Address, RedeemScript)+deriveMSAddr keys m i = (payToScriptAddress rdm, rdm)+  where+    rdm = sortMulSig $ PayMulSig k m+    k = map (wrapPubKey True . xPubKey . flip pubSubKey i) keys++-- | Cyclic list of all multisig addresses derived from a list of public keys,+-- a number of required signatures /m/ and starting from an offset index. The+-- derivation type is a public, soft derivation.+deriveMSAddrs :: [XPubKey] -> Int -> KeyIndex+              -> [(Address, RedeemScript, KeyIndex)]+deriveMSAddrs keys m = map f . cycleIndex+  where+    f i =+        let (a, rdm) = deriveMSAddr keys m i+         in (a, rdm, i)++-- | Helper function to go through derivation indices.+cycleIndex :: KeyIndex -> [KeyIndex]+cycleIndex i+    | i == 0         = cycle [0..0x7fffffff]+    | i < 0x80000000 = cycle $ [i..0x7fffffff] ++ [0..(i-1)]+    | otherwise      = error $ "cycleIndex: invalid index " ++ show i++{- Derivation Paths -}++-- | Phantom type signaling a hardened derivation path that can only be computed+-- from private extended key.+data HardDeriv deriving (Generic, NFData)++-- | Phantom type signaling no knowledge about derivation path: can be hardened or not.+data AnyDeriv deriving (Generic, NFData)++-- | Phantom type signaling derivation path including only non-hardened paths+-- that can be computed from an extended public key.+data SoftDeriv deriving (Generic, NFData)++-- | 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++-- | Data type representing a derivation path. Two constructors are provided+-- for specifying soft or hard derivations. The path /\/0\/1'\/2/ for example can be+-- expressed as @'Deriv' :\/ 0 :| 1 :\/ 2@. The 'HardOrAny' and 'AnyOrSoft' type+-- classes are used to constrain the valid values for the phantom type /t/. If+-- you mix hard '(:|)' and soft '(:\/)' paths, the only valid type for /t/ is 'AnyDeriv'.+-- Otherwise, /t/ can be 'HardDeriv' if you only have hard derivation or 'SoftDeriv'+-- if you only have soft derivations.+--+-- Using this type is as easy as writing the required derivation like in these+-- example:+--+-- > Deriv :/ 0 :/ 1 :/ 2 :: SoftPath+-- > Deriv :| 0 :| 1 :| 2 :: HardPath+-- > Deriv :| 0 :/ 1 :/ 2 :: DerivPath+data DerivPathI t where+    (:|)  :: HardOrAny t => !(DerivPathI t) -> !KeyIndex -> DerivPathI t+    (:/)  :: AnyOrSoft t => !(DerivPathI t) -> !KeyIndex -> DerivPathI t+    Deriv :: DerivPathI t++instance NFData (DerivPathI t) where+    rnf (a :| b) = rnf a `seq` rnf b `seq` ()+    rnf (a :/ b) = rnf a `seq` rnf b `seq` ()+    rnf Deriv    = ()++instance Eq (DerivPathI t) where+    (nextA :| iA) == (nextB :| iB) = iA == iB && nextA == nextB+    (nextA :/ iA) == (nextB :/ iB) = iA == iB && nextA == nextB+    Deriv         == Deriv         = True+    _             == _             = False++instance Ord (DerivPathI t) where+    -- Same hardness on each side+    (nextA :| iA) `compare` (nextB :| iB) =+        if nextA == nextB then iA `compare` iB else nextA `compare` nextB+    (nextA :/ iA) `compare` (nextB :/ iB) =+        if nextA == nextB then iA `compare` iB else nextA `compare` nextB++    -- Different hardness: hard paths are LT soft paths+    (nextA :/ _iA) `compare` (nextB :| _iB) =+        if nextA == nextB then LT else nextA `compare` nextB+    (nextA :| _iA) `compare` (nextB :/ _iB) =+        if nextA == nextB then GT else nextA `compare` nextB++    Deriv `compare` Deriv  = EQ+    Deriv `compare` _      = LT+    _     `compare` Deriv  = GT+++instance Serialize DerivPath where+    get = listToPath <$> S.get+    put = put . pathToList++-- | Get a list of derivation indices from a derivation path.+pathToList :: DerivPathI t -> [KeyIndex]+pathToList =+    reverse . go+  where+    go (next :| i) = setBit i 31 : go next+    go (next :/ i) = i : go next+    go _           = []++-- | Convert a list of derivation indices to a derivation path.+listToPath :: [KeyIndex] -> DerivPath+listToPath =+    go . reverse+  where+    go (i:is)+        | testBit i 31 = go is :| clearBit i 31+        | otherwise    = go is :/ i+    go [] = Deriv++-- | Convert a derivation path to a human-readable string.+pathToStr :: DerivPathI t -> String+pathToStr p =+    case p of+        next :| i -> concat [ pathToStr next, "/", show i, "'" ]+        next :/ i -> concat [ pathToStr next, "/", show i ]+        Deriv     -> ""++-- | Turn a derivation path into a hard derivation path. Will fail if the path+-- contains soft derivations.+toHard :: DerivPathI t -> Maybe HardPath+toHard p = case p of+    next :| i -> (:| i) <$> toHard next+    Deriv     -> Just Deriv+    _         -> Nothing++-- | Turn a derivation path into a soft derivation path. Will fail if the path+-- has hard derivations.+toSoft :: DerivPathI t -> Maybe SoftPath+toSoft p = case p of+    next :/ i -> (:/ i) <$> toSoft next+    Deriv     -> Just Deriv+    _         -> Nothing++-- | Make a derivation path generic.+toGeneric :: DerivPathI t -> DerivPath+toGeneric p = case p of+    next :/ i -> toGeneric next :/ i+    next :| i -> toGeneric next :| i+    Deriv     -> Deriv++-- | Append two derivation paths together. The result will be a mixed+-- derivation path.+(++/) :: DerivPathI t1 -> DerivPathI t2 -> DerivPath+(++/) p1 p2 =+    go id (toGeneric p2) $ toGeneric p1+  where+    go f p = case p of+        next :/ i -> go (f . (:/ i)) $ toGeneric next+        next :| i -> go (f . (:| i)) $ toGeneric next+        _         -> f++-- | Derive a private key from a derivation path+derivePath :: DerivPathI t -> XPrvKey -> XPrvKey+derivePath = go id+  where+    -- Build the full derivation function starting from the end+    go f p = case p of+        next :| i -> go (f . flip hardSubKey i) next+        next :/ i -> go (f . flip prvSubKey i) next+        _         -> f++-- | Derive a public key from a soft derivation path+derivePubPath :: SoftPath -> XPubKey -> XPubKey+derivePubPath = go id+  where+    -- Build the full derivation function starting from the end+    go f p = case p of+        next :/ i -> go (f . flip pubSubKey i) next+        _         -> f++instance Show DerivPath where+    showsPrec d p = showParen (d > 10) $+        showString "DerivPath " . shows (pathToStr p)++instance Read DerivPath where+    readPrec = parens $ do+        R.Ident "DerivPath" <- lexP+        R.String str <- lexP+        maybe pfail return $ getParsedPath <$> parsePath str++instance Show HardPath where+    showsPrec d p = showParen (d > 10) $+        showString "HardPath " . shows (pathToStr p)++instance Read HardPath where+    readPrec = parens $ do+        R.Ident "HardPath" <- lexP+        R.String str <- lexP+        maybe pfail return $ parseHard str++instance Show SoftPath where+    showsPrec d p = showParen (d > 10) $+        showString "SoftPath " . shows (pathToStr p)++instance Read SoftPath where+    readPrec = parens $ do+        R.Ident "SoftPath" <- lexP+        R.String str <- lexP+        maybe pfail return $ parseSoft str++instance IsString ParsedPath where+    fromString =+        fromMaybe e . parsePath+      where+        e = error "Could not parse derivation path"++instance IsString DerivPath where+    fromString =+        getParsedPath . fromMaybe e . parsePath+      where+        e = error "Could not parse derivation path"++instance IsString HardPath where+    fromString =+        fromMaybe e . parseHard+      where+        e = error "Could not parse hard derivation path"++instance IsString SoftPath where+    fromString =+        fromMaybe e . parseSoft+      where+        e = error "Could not parse soft derivation path"++instance FromJSON ParsedPath where+    parseJSON = withText "ParsedPath" $ \str -> case parsePath $ cs str of+        Just p -> return p+        _      -> mzero++instance FromJSON DerivPath where+    parseJSON = withText "DerivPath" $ \str -> case parsePath $ cs str of+        Just p -> return $ getParsedPath p+        _      -> mzero++instance FromJSON HardPath where+    parseJSON = withText "HardPath" $ \str -> case parseHard $ cs str of+        Just p -> return p+        _      -> mzero++instance FromJSON SoftPath where+    parseJSON = withText "SoftPath" $ \str -> case parseSoft $ cs str of+        Just p -> return p+        _      -> mzero++instance ToJSON (DerivPathI t) where+    toJSON = A.String . cs . pathToStr++instance ToJSON ParsedPath where+    toJSON (ParsedPrv p)   = A.String . cs . ("m" ++) . pathToStr $ p+    toJSON (ParsedPub p)   = A.String . cs . ("M" ++) . pathToStr $ p+    toJSON (ParsedEmpty p) = A.String . cs . ("" ++) . pathToStr $ p++{- Parsing derivation paths of the form m/1/2'/3 or M/1/2'/3 -}++-- | Type for parsing derivation paths of the form /m\/1\/2'\/3/ or+-- /M\/1\/2'\/3/.+data ParsedPath = ParsedPrv   { getParsedPath :: !DerivPath }+                | ParsedPub   { getParsedPath :: !DerivPath }+                | ParsedEmpty { getParsedPath :: !DerivPath }+  deriving (Eq, Generic, NFData)++instance Show ParsedPath where+    showsPrec d p = showParen (d > 10) $ showString "ParsedPath " . shows f+      where+        f =+            case p of+                ParsedPrv d'   -> "m" <> pathToStr d'+                ParsedPub d'   -> "M" <> pathToStr d'+                ParsedEmpty d' -> pathToStr d'++instance Read ParsedPath where+    readPrec = parens $ do+        R.Ident "ParsedPath" <- lexP+        R.String str <- lexP+        maybe pfail return $ parsePath str++-- | Parse derivation path string for extended key.+-- Forms: /m\/0'\/2/, /M\/2\/3\/4/.+parsePath :: String -> Maybe ParsedPath+parsePath str = do+    res <- concatBip32Segments <$> mapM parseBip32PathIndex xs+    case x of+        "m" -> Just $ ParsedPrv res+        "M" -> Just $ ParsedPub res+        ""  -> Just $ ParsedEmpty res+        _   -> Nothing+  where+    (x : xs) = splitOn "/" str++-- | Concatenate derivation path indices into a derivation path.+concatBip32Segments :: [Bip32PathIndex] -> DerivPath+concatBip32Segments = foldl' appendBip32Segment Deriv++-- | Append an extra derivation path index element into an existing path.+appendBip32Segment :: DerivPath -> Bip32PathIndex  -> DerivPath+appendBip32Segment d (Bip32SoftIndex i) = d :/ i+appendBip32Segment d (Bip32HardIndex i) = d :| i++-- | Parse a BIP32 derivation path index element from a string.+parseBip32PathIndex :: String -> Maybe Bip32PathIndex+parseBip32PathIndex segment = case reads segment of+    [(i, "" )] -> guard (is31Bit i) >> return (Bip32SoftIndex i)+    [(i, "'")] -> guard (is31Bit i) >> return (Bip32HardIndex i)+    _          -> Nothing++-- | Type for BIP32 path index element.+data Bip32PathIndex = Bip32HardIndex KeyIndex+                    | Bip32SoftIndex KeyIndex+  deriving (Eq, Generic, NFData)++instance Show Bip32PathIndex where+    showsPrec d (Bip32HardIndex i) = showParen (d > 10) $+        showString "Bip32HardIndex " . shows i+    showsPrec d (Bip32SoftIndex i) = showParen (d > 10) $+        showString "Bip32SoftIndex " . shows i++instance Read Bip32PathIndex where+    readPrec = h <|> s+      where+        h =+            parens $ do+                R.Ident "Bip32HardIndex" <- lexP+                R.Number n <- lexP+                maybe pfail return $+                    Bip32HardIndex . fromIntegral <$> numberToInteger n+        s =+            parens $ do+                R.Ident "Bip32SoftIndex" <- lexP+                R.Number n <- lexP+                maybe pfail return $+                    Bip32SoftIndex . fromIntegral <$> numberToInteger n++-- | Test whether the number could be a valid BIP32 derivation index.+is31Bit :: (Integral a) => a -> Bool+is31Bit i = i >= 0 && i < 0x80000000++-- | Helper function to parse a hard path.+parseHard :: String -> Maybe HardPath+parseHard = toHard . getParsedPath <=< parsePath++-- | Helper function to parse a soft path.+parseSoft :: String -> Maybe SoftPath+parseSoft = toSoft . getParsedPath <=< parsePath++-- | Data type representing a private or public key with its respective network.+data XKey+    = XPrv { getXKeyPrv :: !XPrvKey+           , getXKeyNet :: !Network }+    | XPub { getXKeyPub :: !XPubKey+           , getXKeyNet :: !Network }+    deriving (Eq, Show, Generic, NFData)++-- | Apply a parsed path to an extended key to derive the new key defined in the+-- path. If the path starts with /m/, a private key will be returned and if the+-- path starts with /M/, a public key will be returned. Private derivations on a+-- public key, and public derivations with a hard segment, return an error+-- value.+applyPath :: ParsedPath -> XKey -> Either String XKey+applyPath path key =+    case (path, key) of+        (ParsedPrv _, XPrv k n) -> return $ XPrv (derivPrvF k) n+        (ParsedPrv _, XPub {}) -> Left "applyPath: Invalid public key"+        (ParsedPub _, XPrv k n) -> return $ XPub (deriveXPubKey (derivPrvF k)) n+        (ParsedPub _, XPub k n) -> derivPubFE >>= \f -> return $ XPub (f k) n+    -- For empty parsed paths, we take a hint from the provided key+        (ParsedEmpty _, XPrv k n) -> return $ XPrv (derivPrvF k) n+        (ParsedEmpty _, XPub k n) -> derivPubFE >>= \f -> return $ XPub (f k) n+  where+    derivPrvF = goPrv id $ getParsedPath path+    derivPubFE = goPubE id $ getParsedPath path+    -- Build the full private derivation function starting from the end+    goPrv f p =+        case p of+            next :| i -> goPrv (f . flip hardSubKey i) next+            next :/ i -> goPrv (f . flip prvSubKey i) next+            Deriv     -> f+    -- Build the full public derivation function starting from the end+    goPubE f p =+        case p of+            next :/ i -> goPubE (f . flip pubSubKey i) next+            Deriv     -> Right f+            _         -> Left "applyPath: Invalid hard derivation"++{- Helpers for derivation paths and addresses -}++-- | Derive an address from a given parent path.+derivePathAddr :: XPubKey -> SoftPath -> KeyIndex -> (Address, PubKey)+derivePathAddr key path = deriveAddr (derivePubPath path key)++-- | Cyclic list of all addresses derived from a given parent path and starting+-- from the given offset index.+derivePathAddrs ::+       XPubKey -> SoftPath -> KeyIndex -> [(Address, PubKey, KeyIndex)]+derivePathAddrs key path = deriveAddrs (derivePubPath path key)++-- | Derive a multisig address from a given parent path. The number of required+-- signatures (m in m of n) is also needed.+derivePathMSAddr ::+       [XPubKey]+    -> SoftPath+    -> Int+    -> KeyIndex+    -> (Address, RedeemScript)+derivePathMSAddr keys path =+    deriveMSAddr $ map (derivePubPath path) keys++-- | Cyclic list of all multisig addresses derived from a given parent path and+-- starting from the given offset index. The number of required signatures+-- (m in m of n) is also needed.+derivePathMSAddrs ::+       [XPubKey]+    -> SoftPath+    -> Int+    -> KeyIndex+    -> [(Address, RedeemScript, KeyIndex)]+derivePathMSAddrs keys path =+    deriveMSAddrs $ map (derivePubPath path) keys++{- Utilities for extended keys -}++-- | De-serialize HDW-specific private key.+getPadPrvKey :: Get SecKey+getPadPrvKey = do+    pad <- getWord8+    unless (pad == 0x00) $ fail "Private key must be padded with 0x00"+    secKeyGet++-- | Serialize HDW-specific private key.+putPadPrvKey :: Putter SecKey+putPadPrvKey p = putWord8 0x00 >> secKeyPut p++bsPadPrvKey :: SecKey -> ByteString+bsPadPrvKey = runPut . putPadPrvKey
+ src/Haskoin/Keys/Mnemonic.hs view
@@ -0,0 +1,516 @@+{-# LANGUAGE OverloadedStrings #-}+{-|+Module      : Haskoin.Keys.Mnemonic+Copyright   : No rights reserved+License     : UNLICENSE+Maintainer  : jprupp@protonmail.ch+Stability   : experimental+Portability : POSIX++Mnemonic keys (BIP-39). Only English dictionary.+-}+module Haskoin.Keys.Mnemonic+    ( -- * Mnemonic Sentences+      Entropy+    , Mnemonic+    , Passphrase+    , Seed+    , toMnemonic+    , fromMnemonic+    , mnemonicToSeed+    ) where++import           Control.Monad           (when)+import           Crypto.Hash             (SHA256 (..), hashWith)+import           Crypto.KDF.PBKDF2       (Parameters (..), fastPBKDF2_SHA512)+import           Data.Bits               (shiftL, shiftR)+import qualified Data.ByteArray          as BA+import           Data.ByteString         (ByteString)+import qualified Data.ByteString         as BS+import           Data.List+import qualified Data.Map.Strict         as M+import           Data.Maybe+import           Data.String.Conversions (cs)+import           Data.Text               (Text)+import qualified Data.Text               as T+import qualified Data.Text.Encoding      as E+import           Data.Vector             (Vector, (!))+import qualified Data.Vector             as V+import           Haskoin.Util++-- | Random data used to create a mnemonic sentence. Use a good entropy source.+-- You will get your coins stolen if you don't. You have been warned.+type Entropy = ByteString++-- | Human-readable mnemonic sentence.+type Mnemonic = Text++-- | Optional passphrase for mnemnoic sentence.+type Passphrase = ByteString++-- | Seed for a private key from a mnemonic sentence.+type Seed = ByteString++-- | Mnemonic key checksum.+type Checksum = ByteString++-- | Paremeters for PBKDF2 function.+pbkdfParams :: Parameters+pbkdfParams = Parameters {iterCounts = 2048, outputLength = 64}++-- | Provide intial 'Entropy' as a 'ByteString' of length multiple of 4 bytes.+-- Output a 'Mnemonic' sentence.+toMnemonic :: Entropy -> Either String Mnemonic+toMnemonic ent = do+    when (BS.null ent) $+        Left "toMnemonic: entropy can not be empty"+    when (remainder /= 0) $+        Left "toMnemonic: entropy must be multiples of 4 bytes"+    when (cs_len > 16) $+        Left "toMnemonic: maximum entropy is 64 bytes (512 bits)"+    return ms+  where+    (cs_len, remainder) = BS.length ent `quotRem` 4+    c = calcCS cs_len ent+    indices = bsToIndices $ ent `BS.append` c+    ms = T.unwords $ map (wl!) indices++-- | Revert 'toMnemonic'. Do not use this to generate a 'Seed'. Instead use+-- 'mnemonicToSeed'. This outputs the original 'Entropy' used to generate a+-- 'Mnemonic' sentence.+fromMnemonic :: Mnemonic -> Either String Entropy+fromMnemonic ms = do+    when (T.null ms) $+        Left "fromMnemonic: empty mnemonic"+    when (word_count > 48) $+        Left $ "fromMnemonic: too many words: " ++ show word_count+    when (word_count `mod` 3 /= 0) $+        Left $ "fromMnemonic: wrong number of words:" ++ show word_count+    ms_bs <- indicesToBS =<< getIndices ms_words+    let (ms_ent, ms_cs) = BS.splitAt (ent_len * 4) ms_bs+        ms_cs_num = numCS cs_len ms_cs+        ent_cs_num = numCS cs_len $ calcCS cs_len ms_ent+    when (ent_cs_num /= ms_cs_num) $+        Left $ "fromMnemonic: checksum failed: " ++ sh ent_cs_num ms_cs_num+    return ms_ent+  where+    ms_words = T.words ms+    word_count = length ms_words+    (ent_len, cs_len) = (word_count * 11) `quotRem` 32+    sh cs_a cs_b = show cs_a ++ " /= " ++ show cs_b++-- | Compute 'Checksum'.+calcCS :: Int -> Entropy -> Checksum+calcCS len = getBits len . BA.convert . hashWith SHA256++numCS :: Int -> Entropy -> Integer+numCS len =+    shiftCS . bsToInteger+  where+    shiftCS = case 8 - len `mod` 8 of+        8 -> id+        x -> flip shiftR x++-- | Turn an arbitrary sequence of characters into a 512-bit 'Seed'. Use+-- 'mnemonicToSeed' to get a seed from a 'Mnemonic' sentence. Warning: Does not+-- perform NFKD normalization.+anyToSeed :: Passphrase -> Mnemonic -> Seed+anyToSeed pf ms =+    fastPBKDF2_SHA512 pbkdfParams (E.encodeUtf8 ms) ("mnemonic" `mappend` pf)++-- | Get a 512-bit 'Seed' from a 'Mnemonic' sentence. Will validate checksum.+-- 'Passphrase' can be used to protect the 'Mnemonic'. Use an empty string as+-- 'Passphrase' if none is required.+mnemonicToSeed :: Passphrase -> Mnemonic -> Either String Seed+mnemonicToSeed pf ms = do+    ent <- fromMnemonic ms+    mnm <- toMnemonic ent+    return $ anyToSeed pf mnm++-- | Get indices of words in word list.+getIndices :: [Text] -> Either String [Int]+getIndices ws+    | null n = return $ catMaybes i+    | otherwise = Left $ "getIndices: words not found: " ++ cs w+  where+    i = map (`M.lookup` wl') ws+    n = elemIndices Nothing i+    w = T.unwords $ map (ws !!) n++-- | Turn a list of 11-bit numbers into a 'ByteString'+indicesToBS :: [Int] -> Either String ByteString+indicesToBS is = do+    when lrg $ Left "indicesToBS: index larger or equal than 2048"+    return . pad . integerToBS $ foldl' f 0 is `shiftL` shift_width+  where+    lrg = isJust $ find (>= 2048) is+    (q, r) = (length is * 11) `quotRem` 8+    shift_width =+        if r == 0+            then 0+            else 8 - r+    bl =+        if r == 0+            then q+            else q + 1 -- length of resulting ByteString+    pad bs = BS.append (BS.replicate (bl - BS.length bs) 0x00) bs+    f acc x = (acc `shiftL` 11) + fromIntegral x++-- | Turn a 'ByteString' into a list of 11-bit numbers.+bsToIndices :: ByteString -> [Int]+bsToIndices bs =+    reverse . go q $ bsToInteger bs `shiftR` r+  where+    (q, r) = (BS.length bs * 8) `quotRem` 11+    go 0 _ = []+    go n i = fromIntegral (i `mod` 2048) : go (n - 1) (i `shiftR` 11)++wl' :: M.Map Text Int+wl' = V.ifoldr' (\i w m -> M.insert w i m) M.empty wl++-- | Standard English dictionary from BIP-39 specification.+wl :: Vector Text+wl = V.fromListN 2048+    [ "abandon", "ability", "able", "about", "above", "absent"+    , "absorb", "abstract", "absurd", "abuse", "access", "accident"+    , "account", "accuse", "achieve", "acid", "acoustic", "acquire"+    , "across", "act", "action", "actor", "actress", "actual"+    , "adapt", "add", "addict", "address", "adjust", "admit"+    , "adult", "advance", "advice", "aerobic", "affair", "afford"+    , "afraid", "again", "age", "agent", "agree", "ahead"+    , "aim", "air", "airport", "aisle", "alarm", "album"+    , "alcohol", "alert", "alien", "all", "alley", "allow"+    , "almost", "alone", "alpha", "already", "also", "alter"+    , "always", "amateur", "amazing", "among", "amount", "amused"+    , "analyst", "anchor", "ancient", "anger", "angle", "angry"+    , "animal", "ankle", "announce", "annual", "another", "answer"+    , "antenna", "antique", "anxiety", "any", "apart", "apology"+    , "appear", "apple", "approve", "april", "arch", "arctic"+    , "area", "arena", "argue", "arm", "armed", "armor"+    , "army", "around", "arrange", "arrest", "arrive", "arrow"+    , "art", "artefact", "artist", "artwork", "ask", "aspect"+    , "assault", "asset", "assist", "assume", "asthma", "athlete"+    , "atom", "attack", "attend", "attitude", "attract", "auction"+    , "audit", "august", "aunt", "author", "auto", "autumn"+    , "average", "avocado", "avoid", "awake", "aware", "away"+    , "awesome", "awful", "awkward", "axis", "baby", "bachelor"+    , "bacon", "badge", "bag", "balance", "balcony", "ball"+    , "bamboo", "banana", "banner", "bar", "barely", "bargain"+    , "barrel", "base", "basic", "basket", "battle", "beach"+    , "bean", "beauty", "because", "become", "beef", "before"+    , "begin", "behave", "behind", "believe", "below", "belt"+    , "bench", "benefit", "best", "betray", "better", "between"+    , "beyond", "bicycle", "bid", "bike", "bind", "biology"+    , "bird", "birth", "bitter", "black", "blade", "blame"+    , "blanket", "blast", "bleak", "bless", "blind", "blood"+    , "blossom", "blouse", "blue", "blur", "blush", "board"+    , "boat", "body", "boil", "bomb", "bone", "bonus"+    , "book", "boost", "border", "boring", "borrow", "boss"+    , "bottom", "bounce", "box", "boy", "bracket", "brain"+    , "brand", "brass", "brave", "bread", "breeze", "brick"+    , "bridge", "brief", "bright", "bring", "brisk", "broccoli"+    , "broken", "bronze", "broom", "brother", "brown", "brush"+    , "bubble", "buddy", "budget", "buffalo", "build", "bulb"+    , "bulk", "bullet", "bundle", "bunker", "burden", "burger"+    , "burst", "bus", "business", "busy", "butter", "buyer"+    , "buzz", "cabbage", "cabin", "cable", "cactus", "cage"+    , "cake", "call", "calm", "camera", "camp", "can"+    , "canal", "cancel", "candy", "cannon", "canoe", "canvas"+    , "canyon", "capable", "capital", "captain", "car", "carbon"+    , "card", "cargo", "carpet", "carry", "cart", "case"+    , "cash", "casino", "castle", "casual", "cat", "catalog"+    , "catch", "category", "cattle", "caught", "cause", "caution"+    , "cave", "ceiling", "celery", "cement", "census", "century"+    , "cereal", "certain", "chair", "chalk", "champion", "change"+    , "chaos", "chapter", "charge", "chase", "chat", "cheap"+    , "check", "cheese", "chef", "cherry", "chest", "chicken"+    , "chief", "child", "chimney", "choice", "choose", "chronic"+    , "chuckle", "chunk", "churn", "cigar", "cinnamon", "circle"+    , "citizen", "city", "civil", "claim", "clap", "clarify"+    , "claw", "clay", "clean", "clerk", "clever", "click"+    , "client", "cliff", "climb", "clinic", "clip", "clock"+    , "clog", "close", "cloth", "cloud", "clown", "club"+    , "clump", "cluster", "clutch", "coach", "coast", "coconut"+    , "code", "coffee", "coil", "coin", "collect", "color"+    , "column", "combine", "come", "comfort", "comic", "common"+    , "company", "concert", "conduct", "confirm", "congress", "connect"+    , "consider", "control", "convince", "cook", "cool", "copper"+    , "copy", "coral", "core", "corn", "correct", "cost"+    , "cotton", "couch", "country", "couple", "course", "cousin"+    , "cover", "coyote", "crack", "cradle", "craft", "cram"+    , "crane", "crash", "crater", "crawl", "crazy", "cream"+    , "credit", "creek", "crew", "cricket", "crime", "crisp"+    , "critic", "crop", "cross", "crouch", "crowd", "crucial"+    , "cruel", "cruise", "crumble", "crunch", "crush", "cry"+    , "crystal", "cube", "culture", "cup", "cupboard", "curious"+    , "current", "curtain", "curve", "cushion", "custom", "cute"+    , "cycle", "dad", "damage", "damp", "dance", "danger"+    , "daring", "dash", "daughter", "dawn", "day", "deal"+    , "debate", "debris", "decade", "december", "decide", "decline"+    , "decorate", "decrease", "deer", "defense", "define", "defy"+    , "degree", "delay", "deliver", "demand", "demise", "denial"+    , "dentist", "deny", "depart", "depend", "deposit", "depth"+    , "deputy", "derive", "describe", "desert", "design", "desk"+    , "despair", "destroy", "detail", "detect", "develop", "device"+    , "devote", "diagram", "dial", "diamond", "diary", "dice"+    , "diesel", "diet", "differ", "digital", "dignity", "dilemma"+    , "dinner", "dinosaur", "direct", "dirt", "disagree", "discover"+    , "disease", "dish", "dismiss", "disorder", "display", "distance"+    , "divert", "divide", "divorce", "dizzy", "doctor", "document"+    , "dog", "doll", "dolphin", "domain", "donate", "donkey"+    , "donor", "door", "dose", "double", "dove", "draft"+    , "dragon", "drama", "drastic", "draw", "dream", "dress"+    , "drift", "drill", "drink", "drip", "drive", "drop"+    , "drum", "dry", "duck", "dumb", "dune", "during"+    , "dust", "dutch", "duty", "dwarf", "dynamic", "eager"+    , "eagle", "early", "earn", "earth", "easily", "east"+    , "easy", "echo", "ecology", "economy", "edge", "edit"+    , "educate", "effort", "egg", "eight", "either", "elbow"+    , "elder", "electric", "elegant", "element", "elephant", "elevator"+    , "elite", "else", "embark", "embody", "embrace", "emerge"+    , "emotion", "employ", "empower", "empty", "enable", "enact"+    , "end", "endless", "endorse", "enemy", "energy", "enforce"+    , "engage", "engine", "enhance", "enjoy", "enlist", "enough"+    , "enrich", "enroll", "ensure", "enter", "entire", "entry"+    , "envelope", "episode", "equal", "equip", "era", "erase"+    , "erode", "erosion", "error", "erupt", "escape", "essay"+    , "essence", "estate", "eternal", "ethics", "evidence", "evil"+    , "evoke", "evolve", "exact", "example", "excess", "exchange"+    , "excite", "exclude", "excuse", "execute", "exercise", "exhaust"+    , "exhibit", "exile", "exist", "exit", "exotic", "expand"+    , "expect", "expire", "explain", "expose", "express", "extend"+    , "extra", "eye", "eyebrow", "fabric", "face", "faculty"+    , "fade", "faint", "faith", "fall", "false", "fame"+    , "family", "famous", "fan", "fancy", "fantasy", "farm"+    , "fashion", "fat", "fatal", "father", "fatigue", "fault"+    , "favorite", "feature", "february", "federal", "fee", "feed"+    , "feel", "female", "fence", "festival", "fetch", "fever"+    , "few", "fiber", "fiction", "field", "figure", "file"+    , "film", "filter", "final", "find", "fine", "finger"+    , "finish", "fire", "firm", "first", "fiscal", "fish"+    , "fit", "fitness", "fix", "flag", "flame", "flash"+    , "flat", "flavor", "flee", "flight", "flip", "float"+    , "flock", "floor", "flower", "fluid", "flush", "fly"+    , "foam", "focus", "fog", "foil", "fold", "follow"+    , "food", "foot", "force", "forest", "forget", "fork"+    , "fortune", "forum", "forward", "fossil", "foster", "found"+    , "fox", "fragile", "frame", "frequent", "fresh", "friend"+    , "fringe", "frog", "front", "frost", "frown", "frozen"+    , "fruit", "fuel", "fun", "funny", "furnace", "fury"+    , "future", "gadget", "gain", "galaxy", "gallery", "game"+    , "gap", "garage", "garbage", "garden", "garlic", "garment"+    , "gas", "gasp", "gate", "gather", "gauge", "gaze"+    , "general", "genius", "genre", "gentle", "genuine", "gesture"+    , "ghost", "giant", "gift", "giggle", "ginger", "giraffe"+    , "girl", "give", "glad", "glance", "glare", "glass"+    , "glide", "glimpse", "globe", "gloom", "glory", "glove"+    , "glow", "glue", "goat", "goddess", "gold", "good"+    , "goose", "gorilla", "gospel", "gossip", "govern", "gown"+    , "grab", "grace", "grain", "grant", "grape", "grass"+    , "gravity", "great", "green", "grid", "grief", "grit"+    , "grocery", "group", "grow", "grunt", "guard", "guess"+    , "guide", "guilt", "guitar", "gun", "gym", "habit"+    , "hair", "half", "hammer", "hamster", "hand", "happy"+    , "harbor", "hard", "harsh", "harvest", "hat", "have"+    , "hawk", "hazard", "head", "health", "heart", "heavy"+    , "hedgehog", "height", "hello", "helmet", "help", "hen"+    , "hero", "hidden", "high", "hill", "hint", "hip"+    , "hire", "history", "hobby", "hockey", "hold", "hole"+    , "holiday", "hollow", "home", "honey", "hood", "hope"+    , "horn", "horror", "horse", "hospital", "host", "hotel"+    , "hour", "hover", "hub", "huge", "human", "humble"+    , "humor", "hundred", "hungry", "hunt", "hurdle", "hurry"+    , "hurt", "husband", "hybrid", "ice", "icon", "idea"+    , "identify", "idle", "ignore", "ill", "illegal", "illness"+    , "image", "imitate", "immense", "immune", "impact", "impose"+    , "improve", "impulse", "inch", "include", "income", "increase"+    , "index", "indicate", "indoor", "industry", "infant", "inflict"+    , "inform", "inhale", "inherit", "initial", "inject", "injury"+    , "inmate", "inner", "innocent", "input", "inquiry", "insane"+    , "insect", "inside", "inspire", "install", "intact", "interest"+    , "into", "invest", "invite", "involve", "iron", "island"+    , "isolate", "issue", "item", "ivory", "jacket", "jaguar"+    , "jar", "jazz", "jealous", "jeans", "jelly", "jewel"+    , "job", "join", "joke", "journey", "joy", "judge"+    , "juice", "jump", "jungle", "junior", "junk", "just"+    , "kangaroo", "keen", "keep", "ketchup", "key", "kick"+    , "kid", "kidney", "kind", "kingdom", "kiss", "kit"+    , "kitchen", "kite", "kitten", "kiwi", "knee", "knife"+    , "knock", "know", "lab", "label", "labor", "ladder"+    , "lady", "lake", "lamp", "language", "laptop", "large"+    , "later", "latin", "laugh", "laundry", "lava", "law"+    , "lawn", "lawsuit", "layer", "lazy", "leader", "leaf"+    , "learn", "leave", "lecture", "left", "leg", "legal"+    , "legend", "leisure", "lemon", "lend", "length", "lens"+    , "leopard", "lesson", "letter", "level", "liar", "liberty"+    , "library", "license", "life", "lift", "light", "like"+    , "limb", "limit", "link", "lion", "liquid", "list"+    , "little", "live", "lizard", "load", "loan", "lobster"+    , "local", "lock", "logic", "lonely", "long", "loop"+    , "lottery", "loud", "lounge", "love", "loyal", "lucky"+    , "luggage", "lumber", "lunar", "lunch", "luxury", "lyrics"+    , "machine", "mad", "magic", "magnet", "maid", "mail"+    , "main", "major", "make", "mammal", "man", "manage"+    , "mandate", "mango", "mansion", "manual", "maple", "marble"+    , "march", "margin", "marine", "market", "marriage", "mask"+    , "mass", "master", "match", "material", "math", "matrix"+    , "matter", "maximum", "maze", "meadow", "mean", "measure"+    , "meat", "mechanic", "medal", "media", "melody", "melt"+    , "member", "memory", "mention", "menu", "mercy", "merge"+    , "merit", "merry", "mesh", "message", "metal", "method"+    , "middle", "midnight", "milk", "million", "mimic", "mind"+    , "minimum", "minor", "minute", "miracle", "mirror", "misery"+    , "miss", "mistake", "mix", "mixed", "mixture", "mobile"+    , "model", "modify", "mom", "moment", "monitor", "monkey"+    , "monster", "month", "moon", "moral", "more", "morning"+    , "mosquito", "mother", "motion", "motor", "mountain", "mouse"+    , "move", "movie", "much", "muffin", "mule", "multiply"+    , "muscle", "museum", "mushroom", "music", "must", "mutual"+    , "myself", "mystery", "myth", "naive", "name", "napkin"+    , "narrow", "nasty", "nation", "nature", "near", "neck"+    , "need", "negative", "neglect", "neither", "nephew", "nerve"+    , "nest", "net", "network", "neutral", "never", "news"+    , "next", "nice", "night", "noble", "noise", "nominee"+    , "noodle", "normal", "north", "nose", "notable", "note"+    , "nothing", "notice", "novel", "now", "nuclear", "number"+    , "nurse", "nut", "oak", "obey", "object", "oblige"+    , "obscure", "observe", "obtain", "obvious", "occur", "ocean"+    , "october", "odor", "off", "offer", "office", "often"+    , "oil", "okay", "old", "olive", "olympic", "omit"+    , "once", "one", "onion", "online", "only", "open"+    , "opera", "opinion", "oppose", "option", "orange", "orbit"+    , "orchard", "order", "ordinary", "organ", "orient", "original"+    , "orphan", "ostrich", "other", "outdoor", "outer", "output"+    , "outside", "oval", "oven", "over", "own", "owner"+    , "oxygen", "oyster", "ozone", "pact", "paddle", "page"+    , "pair", "palace", "palm", "panda", "panel", "panic"+    , "panther", "paper", "parade", "parent", "park", "parrot"+    , "party", "pass", "patch", "path", "patient", "patrol"+    , "pattern", "pause", "pave", "payment", "peace", "peanut"+    , "pear", "peasant", "pelican", "pen", "penalty", "pencil"+    , "people", "pepper", "perfect", "permit", "person", "pet"+    , "phone", "photo", "phrase", "physical", "piano", "picnic"+    , "picture", "piece", "pig", "pigeon", "pill", "pilot"+    , "pink", "pioneer", "pipe", "pistol", "pitch", "pizza"+    , "place", "planet", "plastic", "plate", "play", "please"+    , "pledge", "pluck", "plug", "plunge", "poem", "poet"+    , "point", "polar", "pole", "police", "pond", "pony"+    , "pool", "popular", "portion", "position", "possible", "post"+    , "potato", "pottery", "poverty", "powder", "power", "practice"+    , "praise", "predict", "prefer", "prepare", "present", "pretty"+    , "prevent", "price", "pride", "primary", "print", "priority"+    , "prison", "private", "prize", "problem", "process", "produce"+    , "profit", "program", "project", "promote", "proof", "property"+    , "prosper", "protect", "proud", "provide", "public", "pudding"+    , "pull", "pulp", "pulse", "pumpkin", "punch", "pupil"+    , "puppy", "purchase", "purity", "purpose", "purse", "push"+    , "put", "puzzle", "pyramid", "quality", "quantum", "quarter"+    , "question", "quick", "quit", "quiz", "quote", "rabbit"+    , "raccoon", "race", "rack", "radar", "radio", "rail"+    , "rain", "raise", "rally", "ramp", "ranch", "random"+    , "range", "rapid", "rare", "rate", "rather", "raven"+    , "raw", "razor", "ready", "real", "reason", "rebel"+    , "rebuild", "recall", "receive", "recipe", "record", "recycle"+    , "reduce", "reflect", "reform", "refuse", "region", "regret"+    , "regular", "reject", "relax", "release", "relief", "rely"+    , "remain", "remember", "remind", "remove", "render", "renew"+    , "rent", "reopen", "repair", "repeat", "replace", "report"+    , "require", "rescue", "resemble", "resist", "resource", "response"+    , "result", "retire", "retreat", "return", "reunion", "reveal"+    , "review", "reward", "rhythm", "rib", "ribbon", "rice"+    , "rich", "ride", "ridge", "rifle", "right", "rigid"+    , "ring", "riot", "ripple", "risk", "ritual", "rival"+    , "river", "road", "roast", "robot", "robust", "rocket"+    , "romance", "roof", "rookie", "room", "rose", "rotate"+    , "rough", "round", "route", "royal", "rubber", "rude"+    , "rug", "rule", "run", "runway", "rural", "sad"+    , "saddle", "sadness", "safe", "sail", "salad", "salmon"+    , "salon", "salt", "salute", "same", "sample", "sand"+    , "satisfy", "satoshi", "sauce", "sausage", "save", "say"+    , "scale", "scan", "scare", "scatter", "scene", "scheme"+    , "school", "science", "scissors", "scorpion", "scout", "scrap"+    , "screen", "script", "scrub", "sea", "search", "season"+    , "seat", "second", "secret", "section", "security", "seed"+    , "seek", "segment", "select", "sell", "seminar", "senior"+    , "sense", "sentence", "series", "service", "session", "settle"+    , "setup", "seven", "shadow", "shaft", "shallow", "share"+    , "shed", "shell", "sheriff", "shield", "shift", "shine"+    , "ship", "shiver", "shock", "shoe", "shoot", "shop"+    , "short", "shoulder", "shove", "shrimp", "shrug", "shuffle"+    , "shy", "sibling", "sick", "side", "siege", "sight"+    , "sign", "silent", "silk", "silly", "silver", "similar"+    , "simple", "since", "sing", "siren", "sister", "situate"+    , "six", "size", "skate", "sketch", "ski", "skill"+    , "skin", "skirt", "skull", "slab", "slam", "sleep"+    , "slender", "slice", "slide", "slight", "slim", "slogan"+    , "slot", "slow", "slush", "small", "smart", "smile"+    , "smoke", "smooth", "snack", "snake", "snap", "sniff"+    , "snow", "soap", "soccer", "social", "sock", "soda"+    , "soft", "solar", "soldier", "solid", "solution", "solve"+    , "someone", "song", "soon", "sorry", "sort", "soul"+    , "sound", "soup", "source", "south", "space", "spare"+    , "spatial", "spawn", "speak", "special", "speed", "spell"+    , "spend", "sphere", "spice", "spider", "spike", "spin"+    , "spirit", "split", "spoil", "sponsor", "spoon", "sport"+    , "spot", "spray", "spread", "spring", "spy", "square"+    , "squeeze", "squirrel", "stable", "stadium", "staff", "stage"+    , "stairs", "stamp", "stand", "start", "state", "stay"+    , "steak", "steel", "stem", "step", "stereo", "stick"+    , "still", "sting", "stock", "stomach", "stone", "stool"+    , "story", "stove", "strategy", "street", "strike", "strong"+    , "struggle", "student", "stuff", "stumble", "style", "subject"+    , "submit", "subway", "success", "such", "sudden", "suffer"+    , "sugar", "suggest", "suit", "summer", "sun", "sunny"+    , "sunset", "super", "supply", "supreme", "sure", "surface"+    , "surge", "surprise", "surround", "survey", "suspect", "sustain"+    , "swallow", "swamp", "swap", "swarm", "swear", "sweet"+    , "swift", "swim", "swing", "switch", "sword", "symbol"+    , "symptom", "syrup", "system", "table", "tackle", "tag"+    , "tail", "talent", "talk", "tank", "tape", "target"+    , "task", "taste", "tattoo", "taxi", "teach", "team"+    , "tell", "ten", "tenant", "tennis", "tent", "term"+    , "test", "text", "thank", "that", "theme", "then"+    , "theory", "there", "they", "thing", "this", "thought"+    , "three", "thrive", "throw", "thumb", "thunder", "ticket"+    , "tide", "tiger", "tilt", "timber", "time", "tiny"+    , "tip", "tired", "tissue", "title", "toast", "tobacco"+    , "today", "toddler", "toe", "together", "toilet", "token"+    , "tomato", "tomorrow", "tone", "tongue", "tonight", "tool"+    , "tooth", "top", "topic", "topple", "torch", "tornado"+    , "tortoise", "toss", "total", "tourist", "toward", "tower"+    , "town", "toy", "track", "trade", "traffic", "tragic"+    , "train", "transfer", "trap", "trash", "travel", "tray"+    , "treat", "tree", "trend", "trial", "tribe", "trick"+    , "trigger", "trim", "trip", "trophy", "trouble", "truck"+    , "true", "truly", "trumpet", "trust", "truth", "try"+    , "tube", "tuition", "tumble", "tuna", "tunnel", "turkey"+    , "turn", "turtle", "twelve", "twenty", "twice", "twin"+    , "twist", "two", "type", "typical", "ugly", "umbrella"+    , "unable", "unaware", "uncle", "uncover", "under", "undo"+    , "unfair", "unfold", "unhappy", "uniform", "unique", "unit"+    , "universe", "unknown", "unlock", "until", "unusual", "unveil"+    , "update", "upgrade", "uphold", "upon", "upper", "upset"+    , "urban", "urge", "usage", "use", "used", "useful"+    , "useless", "usual", "utility", "vacant", "vacuum", "vague"+    , "valid", "valley", "valve", "van", "vanish", "vapor"+    , "various", "vast", "vault", "vehicle", "velvet", "vendor"+    , "venture", "venue", "verb", "verify", "version", "very"+    , "vessel", "veteran", "viable", "vibrant", "vicious", "victory"+    , "video", "view", "village", "vintage", "violin", "virtual"+    , "virus", "visa", "visit", "visual", "vital", "vivid"+    , "vocal", "voice", "void", "volcano", "volume", "vote"+    , "voyage", "wage", "wagon", "wait", "walk", "wall"+    , "walnut", "want", "warfare", "warm", "warrior", "wash"+    , "wasp", "waste", "water", "wave", "way", "wealth"+    , "weapon", "wear", "weasel", "weather", "web", "wedding"+    , "weekend", "weird", "welcome", "west", "wet", "whale"+    , "what", "wheat", "wheel", "when", "where", "whip"+    , "whisper", "wide", "width", "wife", "wild", "will"+    , "win", "window", "wine", "wing", "wink", "winner"+    , "winter", "wire", "wisdom", "wise", "wish", "witness"+    , "wolf", "woman", "wonder", "wood", "wool", "word"+    , "work", "world", "worry", "worth", "wrap", "wreck"+    , "wrestle", "wrist", "write", "wrong", "yard", "year"+    , "yellow", "you", "young", "youth", "zebra", "zero"+    , "zone", "zoo"+    ]
+ src/Haskoin/Network.hs view
@@ -0,0 +1,21 @@+{-|+Module      : Haskoin.Network+Copyright   : No rights reserved+License     : UNLICENSE+Maintainer  : jprupp@protonmail.ch+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 Haskoin.Network+    ( module Common+    , module Message+    , module Bloom+    ) where++import           Haskoin.Network.Bloom   as Bloom+import           Haskoin.Network.Common  as Common+import           Haskoin.Network.Message as Message
+ src/Haskoin/Network/Bloom.hs view
@@ -0,0 +1,262 @@+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE DeriveGeneric  #-}+{-|+Module      : Haskoin.Network.Bloom+Copyright   : No rights reserved+License     : UNLICENSE+Maintainer  : jprupp@protonmail.ch+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 Haskoin.Network.Bloom+    ( -- * Bloom Filters+      BloomFlags(..)+    , BloomFilter(..)+    , FilterLoad(..)+    , FilterAdd(..)+    , bloomCreate+    , bloomInsert+    , bloomContains+    , isBloomValid+    , isBloomEmpty+    , isBloomFull+    , acceptsFilters+    , bloomRelevantUpdate+    ) where++import           Control.DeepSeq+import           Control.Monad              (forM_, replicateM)+import           Data.Bits+import           Data.ByteString            (ByteString)+import qualified Data.ByteString            as BS+import qualified Data.Foldable              as F+import           Data.Hash.Murmur           (murmur3)+import           Data.List                  (foldl')+import qualified Data.Sequence              as S+import           Data.Serialize             (Serialize, encode, get, put)+import           Data.Serialize.Get         (getByteString, getWord32le,+                                             getWord8)+import           Data.Serialize.Put         (putByteString, putWord32le,+                                             putWord8)+import           Data.Word+import           GHC.Generics               (Generic)+import           Haskoin.Network.Common+import           Haskoin.Script.Common+import           Haskoin.Transaction.Common+-- | 20,000 items with fp rate < 0.1% or 10,000 items and <0.0001%+maxBloomSize :: Int+maxBloomSize = 36000++maxHashFuncs :: Word32+maxHashFuncs = 50++ln2Squared :: Double+ln2Squared = 0.4804530139182014246671025263266649717305529515945455++ln2 :: Double+ln2 = 0.6931471805599453094172321214581765680755001343602552++bitMask :: [Word8]+bitMask = [0x01, 0x02, 0x04, 0x08, 0x10, 0x20, 0x40, 0x80]++-- | The bloom flags are used to tell the remote peer how to auto-update+-- the provided bloom filter.+data BloomFlags+    = BloomUpdateNone -- ^ never update+    | BloomUpdateAll -- ^ auto-update on all outputs+    | BloomUpdateP2PubKeyOnly+    -- ^ auto-update on pay-to-pubkey or pay-to-multisig (default)+    deriving (Eq, Show, Read, Generic, NFData)++instance Serialize BloomFlags where+    get = go =<< getWord8+      where+        go 0 = return BloomUpdateNone+        go 1 = return BloomUpdateAll+        go 2 = return BloomUpdateP2PubKeyOnly+        go _ = fail "BloomFlags get: Invalid bloom flag"++    put f = putWord8 $ case f of+        BloomUpdateNone         -> 0+        BloomUpdateAll          -> 1+        BloomUpdateP2PubKeyOnly -> 2++-- | A bloom filter is a probabilistic data structure that SPV clients send to+-- other peers to filter the set of transactions received from them. Bloom+-- filters can have false positives but not false negatives. Some transactions+-- that pass the filter may not be relevant to the receiving peer. By+-- controlling the false positive rate, SPV nodes can trade off bandwidth+-- versus privacy.+data BloomFilter = BloomFilter+    { bloomData      :: !(S.Seq Word8)+    -- ^ bloom filter data+    , bloomHashFuncs :: !Word32+    -- ^ number of hash functions for this filter+    , bloomTweak     :: !Word32+    -- ^ hash function random nonce+    , bloomFlags     :: !BloomFlags+    -- ^ bloom filter auto-update flags+    }+    deriving (Eq, Show, Read, Generic, NFData)++instance Serialize BloomFilter where++    get = BloomFilter <$> (S.fromList <$> (readDat =<< get))+                      <*> getWord32le <*> getWord32le+                      <*> get+      where+        readDat (VarInt len) = replicateM (fromIntegral len) getWord8++    put (BloomFilter dat hashFuncs tweak flags) = do+        putVarInt $ S.length dat+        forM_ (F.toList dat) putWord8+        putWord32le hashFuncs+        putWord32le tweak+        put flags++-- | Set a new bloom filter on the peer connection.+newtype FilterLoad = FilterLoad { filterLoadBloomFilter :: BloomFilter }+    deriving (Eq, Show, Read, Generic, NFData)++instance Serialize FilterLoad where+    get = FilterLoad <$> get+    put (FilterLoad f) = put f++-- | Add the given data element to the connections current filter without+-- requiring a completely new one to be set.+newtype FilterAdd = FilterAdd { getFilterData :: ByteString }+    deriving (Eq, Show, Read, Generic, NFData)++instance Serialize FilterAdd where+    get = do+        (VarInt len) <- get+        dat <- getByteString $ fromIntegral len+        return $ FilterAdd dat++    put (FilterAdd bs) = do+        putVarInt $ BS.length bs+        putByteString bs+++-- | Build a bloom filter that will provide the given false positive rate when+-- the given number of elements have been inserted.+bloomCreate :: Int          -- ^ number of elements+            -> Double       -- ^ false positive rate+            -> Word32       -- ^ random nonce (tweak) for the hash function+            -> BloomFlags   -- ^ bloom filter flags+            -> BloomFilter  -- ^ bloom filter+bloomCreate numElem fpRate =+    BloomFilter (S.replicate bloomSize 0) numHashF+  where+    -- Bloom filter size in bytes+    bloomSize = truncate $ min a b / 8+    -- Suggested size in bits+    a         = -1 / ln2Squared * fromIntegral numElem * log fpRate+    -- Maximum size in bits+    b         = fromIntegral $ maxBloomSize * 8+    numHashF  = truncate $ min c (fromIntegral maxHashFuncs)+    -- Suggested number of hash functions+    c         = fromIntegral bloomSize * 8 / fromIntegral numElem * ln2++bloomHash :: BloomFilter -> Word32 -> ByteString -> Word32+bloomHash bfilter hashNum bs =+    murmur3 seed bs `mod` (fromIntegral (S.length (bloomData bfilter)) * 8)+  where+    seed = hashNum * 0xfba4c795 + bloomTweak bfilter++-- | Insert arbitrary data into a bloom filter. Returns the new bloom filter+-- containing the new data.+bloomInsert :: BloomFilter    -- ^ Original bloom filter+            -> ByteString     -- ^ New data to insert+            -> BloomFilter    -- ^ Bloom filter containing the new data+bloomInsert bfilter bs+    | isBloomFull bfilter = bfilter+    | otherwise = bfilter { bloomData = newData }+  where+    idxs    = map (\i -> bloomHash bfilter i bs) [0..bloomHashFuncs bfilter - 1]+    upd s i = S.adjust (.|. bitMask !! fromIntegral (7 .&. i))+                       (fromIntegral $ i `shiftR` 3) s+    newData = foldl upd (bloomData bfilter) idxs++-- | Tests if some arbitrary data matches the filter. This can be either because+-- the data was inserted into the filter or because it is a false positive.+bloomContains :: BloomFilter    -- ^ Bloom filter+              -> ByteString+              -- ^ Data that will be checked against the given bloom filter+              -> Bool+              -- ^ Returns True if the data matches the filter+bloomContains bfilter bs+    | isBloomFull bfilter  = True+    | isBloomEmpty bfilter = False+    | otherwise            = all isSet idxs+  where+    s       = bloomData bfilter+    idxs    = map (\i -> bloomHash bfilter i bs) [0..bloomHashFuncs bfilter - 1]+    isSet i = S.index s (fromIntegral $ i `shiftR` 3)+          .&. (bitMask !! fromIntegral (7 .&. i)) /= 0++-- | Checks if any of the outputs of a tx is in the current bloom filter.+-- If it is, add the txid and vout as an outpoint (i.e. so that+-- a future tx that spends the output won't be missed).+bloomRelevantUpdate :: BloomFilter+                    -- ^ Bloom filter+                    -> Tx+                    -- ^ Tx that may (or may not) have relevant outputs+                    -> Maybe BloomFilter+                    -- ^ Returns an updated bloom filter adding relevant output+bloomRelevantUpdate bfilter tx+    | isBloomFull bfilter || isBloomEmpty bfilter = Nothing+    | bloomFlags bfilter == BloomUpdateNone = Nothing+    | length matchOuts > 0 = Just $ foldl' (addRelevant) bfilter matchOuts+    | otherwise = Nothing+    where+        -- TxHash if we end up inserting an outpoint+        h = txHash tx+        -- Decode the scriptOutpus and add vOuts in case we make them outpoints+        decodedOutputScripts = traverse (decodeOutputBS . scriptOutput) $ txOut tx+        err = error $ "Error Decoding output script"+        idxOutputScripts = either (const err) (zip [0..]) decodedOutputScripts+        -- Check if any txOuts were contained in the bloom filter+        matchFilter = filter (\(_,op) -> bloomContains bfilter $ encodeScriptOut op)+        matchOuts = matchFilter idxOutputScripts++        addRelevant :: BloomFilter -> (Word32,ScriptOutput) -> BloomFilter+        addRelevant bfilter (id,scriptOut) = case (bloomFlags bfilter,scriptType) of+            -- We filtered out BloomUpdateNone so we insert any PayPk or PayMulSig+            (_, True) -> bloomInsert bfilter outpoint+            (BloomUpdateAll, _ ) -> bloomInsert bfilter outpoint+            _ ->  error "Error Updating Bloom Filter with relevant outpoint"+            where+                outpoint = encode $ OutPoint{ outPointHash = h, outPointIndex = id}+                scriptType = (\s -> isPayPK s ||isPayMulSig s) scriptOut++        -- Encodes a scriptOutput so it can be checked agains the Bloom Filter+        encodeScriptOut :: ScriptOutput -> ByteString+        encodeScriptOut (PayMulSig outputMuSig _) = encode outputMuSig+        encodeScriptOut (PayWitnessScriptHash scriptHash) = encode scriptHash+        encodeScriptOut (DataCarrier getOutputData) = encode getOutputData+        encodeScriptOut outputHash = (encode . getOutputHash) outputHash++-- | Returns True if the filter is empty (all bytes set to 0x00)+isBloomEmpty :: BloomFilter -> Bool+isBloomEmpty bfilter = all (== 0x00) $ F.toList $ bloomData bfilter++-- | Returns True if the filter is full (all bytes set to 0xff)+isBloomFull :: BloomFilter -> Bool+isBloomFull bfilter = all (== 0xff) $ F.toList $ bloomData bfilter++-- | Tests if a given bloom filter is valid.+isBloomValid :: BloomFilter -- ^ Bloom filter to test+             -> Bool        -- ^ True if the given filter is valid+isBloomValid bfilter =+    S.length (bloomData bfilter) <= maxBloomSize &&+    bloomHashFuncs bfilter <= maxHashFuncs++-- | Does the peer with these version services accept bloom filters?+acceptsFilters :: Word64 -> Bool+acceptsFilters srv = srv .&. (1 `shiftL` 2) /= 0
+ src/Haskoin/Network/Common.hs view
@@ -0,0 +1,613 @@+{-# LANGUAGE DeriveAnyClass    #-}+{-# LANGUAGE DeriveGeneric     #-}+{-# LANGUAGE LambdaCase        #-}+{-# LANGUAGE OverloadedStrings #-}+{-|+Module      : Haskoin.Network.Common+Copyright   : No rights reserved+License     : UNLICENSE+Maintainer  : jprupp@protonmail.ch+Stability   : experimental+Portability : POSIX++Common functions and data types related to peer-to-peer network.+-}+module Haskoin.Network.Common+    ( -- * Network Data Types+      Addr(..)+    , NetworkAddressTime+    , Alert(..)+    , GetData(..)+    , Inv(..)+    , InvVector(..)+    , InvType(..)+    , HostAddress+    , hostToSockAddr+    , sockToHostAddress+    , NetworkAddress(..)+    , NotFound(..)+    , Ping(..)+    , Pong(..)+    , Reject(..)+    , RejectCode(..)+    , VarInt(..)+    , VarString(..)+    , Version(..)+    , MessageCommand(..)+      -- ** Useful Functions+    , reject+    , nodeNone+    , nodeNetwork+    , nodeGetUTXO+    , nodeBloom+    , nodeWitness+    , nodeXThin+    , commandToString+    , stringToCommand+    , putVarInt+    ) where++import           Control.DeepSeq+import           Control.Monad           (forM_, liftM2, replicateM, unless)+import           Data.Bits               (shiftL)+import           Data.ByteString         (ByteString)+import qualified Data.ByteString         as B+import           Data.ByteString.Char8   as C (replicate)+import           Data.Serialize          as S+import           Data.String+import           Data.String.Conversions (cs)+import           Data.Word               (Word32, Word64)+import           GHC.Generics            (Generic)+import           Haskoin.Crypto.Hash+import           Network.Socket          (SockAddr (..))+import           Text.Read               as R++-- | Network address with a timestamp.+type NetworkAddressTime = (Word32, NetworkAddress)++-- | Provides information about known nodes in the bitcoin network. An 'Addr'+-- type is sent inside a 'Message' as a response to a 'GetAddr' message.+newtype Addr =+    Addr { -- List of addresses of other nodes on the network with timestamps.+           addrList :: [NetworkAddressTime]+         }+    deriving (Eq, Show, Generic, NFData)++instance Serialize Addr where++    get = Addr <$> (repList =<< S.get)+      where+        repList (VarInt c) = replicateM (fromIntegral c) action+        action             = liftM2 (,) getWord32le S.get++    put (Addr xs) = do+        putVarInt $ length xs+        forM_ xs $ \(a,b) -> putWord32le a >> put b++-- | Data type describing signed messages that can be sent between bitcoin+-- nodes to display important notifications to end users about the health of+-- the network.+data Alert =+    Alert {+          -- | Alert payload.+            alertPayload   :: !VarString+          -- | ECDSA signature of the payload+          , alertSignature :: !VarString+          } deriving (Eq, Show, Read, Generic, NFData)++instance Serialize Alert where+    get = Alert <$> S.get <*> S.get+    put (Alert p s) = put p >> put s++-- | The 'GetData' type is used to retrieve information on a specific object+-- ('Block' or 'Tx') identified by the objects hash. The payload of a 'GetData'+-- request is a list of 'InvVector' which represent all the hashes of objects+-- that a node wants. The response to a 'GetBlock' message will be either a+-- 'Block' or a 'Tx' message depending on the type of the object referenced by+-- the hash. Usually, 'GetData' messages are sent after a node receives an 'Inv'+-- message that contains unknown object hashes.+newtype GetData =+    GetData { -- | list of object hashes+              getDataList :: [InvVector]+            } deriving (Eq, Show, Generic, NFData)++instance Serialize GetData where++    get = GetData <$> (repList =<< S.get)+      where+        repList (VarInt c) = replicateM (fromIntegral c) S.get++    put (GetData xs) = do+        putVarInt $ length xs+        forM_ xs put++-- | 'Inv' messages are used by nodes to advertise their knowledge of new+-- objects by publishing a list of hashes to a peer. 'Inv' messages can be sent+-- unsolicited or in response to a 'GetBlocks' message.+newtype Inv =+    Inv {+        -- | inventory+          invList :: [InvVector]+        } deriving (Eq, Show, Generic, NFData)++instance Serialize Inv where++    get = Inv <$> (repList =<< S.get)+      where+        repList (VarInt c) = replicateM (fromIntegral c) S.get++    put (Inv xs) = do+        putVarInt $ length xs+        forM_ xs put++-- | Data type identifying the type of an inventory vector. SegWit types are+-- only used in 'GetData' messages, not 'Inv'.+data InvType+    = InvError -- ^ error+    | InvTx -- ^ transaction+    | InvBlock -- ^ block+    | InvMerkleBlock -- ^ filtered block+    | InvWitnessTx -- ^ segwit transaction+    | InvWitnessBlock -- ^ segwit block+    | InvWitnessMerkleBlock -- ^ segwit filtere block+    deriving (Eq, Show, Read, Generic, NFData)++instance Serialize InvType where+    get = go =<< getWord32le+      where+        go x =+            case x of+                0 -> return InvError+                1 -> return InvTx+                2 -> return InvBlock+                3 -> return InvMerkleBlock+                _+                    | x == 1 `shiftL` 30 + 1 -> return InvWitnessTx+                    | x == 1 `shiftL` 30 + 2 -> return InvWitnessBlock+                    | x == 1 `shiftL` 30 + 3 -> return InvWitnessMerkleBlock+                    | otherwise -> fail "bitcoinGet InvType: Invalid Type"+    put x =+        putWord32le $+        case x of+            InvError              -> 0+            InvTx                 -> 1+            InvBlock              -> 2+            InvMerkleBlock        -> 3+            InvWitnessTx          -> 1 `shiftL` 30 + 1+            InvWitnessBlock       -> 1 `shiftL` 30 + 2+            InvWitnessMerkleBlock -> 1 `shiftL` 30 + 3++-- | Invectory vectors represent hashes identifying objects such as a 'Block' or+-- a 'Tx'. They notify other peers about new data or data they have otherwise+-- requested.+data InvVector =+    InvVector {+                -- | type of object+                invType :: !InvType+                -- | 256-bit hash of object+              , invHash :: !Hash256+              } deriving (Eq, Show, Generic, NFData)++instance Serialize InvVector where+    get = InvVector <$> S.get <*> S.get+    put (InvVector t h) = put t >> put h++newtype HostAddress =+    HostAddress ByteString+    deriving (Eq, Show, Ord, Generic, NFData)++instance Serialize HostAddress where+    put (HostAddress bs) = putByteString bs+    get = HostAddress <$> getByteString 18++-- | Data type describing a bitcoin network address. Addresses are stored in+-- IPv6 format. IPv4 addresses are mapped to IPv6 using IPv4 mapped IPv6+-- addresses: <http://en.wikipedia.org/wiki/IPv6#IPv4-mapped_IPv6_addresses>.+data NetworkAddress =+    NetworkAddress { -- | bitmask of services available for this address+                     naServices :: !Word64+                     -- | address and port information+                   , naAddress  :: !HostAddress+                   } deriving (Eq, Show, Generic, NFData)++hostToSockAddr :: HostAddress -> SockAddr+hostToSockAddr (HostAddress bs) =+    case runGet getSockAddr bs of+        Left e  -> error e+        Right x -> x++sockToHostAddress :: SockAddr -> HostAddress+sockToHostAddress = HostAddress . runPut . putSockAddr++putSockAddr :: SockAddr -> Put+putSockAddr (SockAddrInet6 p _ (a, b, c, d) _) = do+    putWord32be a+    putWord32be b+    putWord32be c+    putWord32be d+    putWord16be (fromIntegral p)++putSockAddr (SockAddrInet p a) = do+    putWord32be 0x00000000+    putWord32be 0x00000000+    putWord32be 0x0000ffff+    putWord32host a+    putWord16be (fromIntegral p)++putSockAddr _ = error "Invalid address type"++getSockAddr :: Get SockAddr+getSockAddr = do+    a <- getWord32be+    b <- getWord32be+    c <- getWord32be+    if a == 0x00000000 && b == 0x00000000 && c == 0x0000ffff+        then do+            d <- getWord32host+            p <- getWord16be+            return $ SockAddrInet (fromIntegral p) d+        else do+            d <- getWord32be+            p <- getWord16be+            return $ SockAddrInet6 (fromIntegral p) 0 (a, b, c, d) 0++instance Serialize NetworkAddress where+    get = NetworkAddress <$> getWord64le <*> S.get+    put (NetworkAddress s a) = putWord64le s >> put a++-- | A 'NotFound' message is returned as a response to a 'GetData' message+-- whe one of the requested objects could not be retrieved. This could happen,+-- for example, if a tranasaction was requested and was not available in the+-- memory pool of the receiving node.+newtype NotFound =+    NotFound { -- | Inventory vectors related to this request+               notFoundList :: [InvVector]+             } deriving (Eq, Show, Generic, NFData)++instance Serialize NotFound where++    get = NotFound <$> (repList =<< S.get)+      where+        repList (VarInt c) = replicateM (fromIntegral c) S.get++    put (NotFound xs) = do+        putVarInt $ length xs+        forM_ xs put++-- | A 'Ping' message is sent to bitcoin peers to check if a connection is still+-- open.+newtype Ping =+    Ping { -- | A random nonce used to identify the recipient of the ping+           -- request once a Pong response is received.+           pingNonce :: Word64+         } deriving (Eq, Show, Read, Generic, NFData)++-- | A Pong message is sent as a response to a ping message.+newtype Pong =+    Pong {+           -- | nonce from corresponding 'Ping'+           pongNonce :: Word64+         } deriving (Eq, Show, Read, Generic, NFData)++instance Serialize Ping where+    get = Ping <$> getWord64le+    put (Ping n) = putWord64le n++instance Serialize Pong where+    get = Pong <$> getWord64le+    put (Pong n) = putWord64le n++-- | The 'Reject' message is sent when messages are rejected by a peer.+data Reject =+    Reject {+             -- | type of message rejected+             rejectMessage :: !MessageCommand+             -- | rejection code+           , rejectCode    :: !RejectCode+             -- | text reason for rejection+           , rejectReason  :: !VarString+             -- | extra data such as block or tx hash+           , rejectData    :: !ByteString+           } deriving (Eq, Show, Read, Generic, NFData)++-- | Rejection code associated to the 'Reject' message.+data RejectCode+    = RejectMalformed+    | RejectInvalid+    | RejectObsolete+    | RejectDuplicate+    | RejectNonStandard+    | RejectDust+    | RejectInsufficientFee+    | RejectCheckpoint+    deriving (Eq, Show, Read, Generic, NFData)++instance Serialize RejectCode where++    get = getWord8 >>= \code -> case code of+        0x01 -> return RejectMalformed+        0x10 -> return RejectInvalid+        0x11 -> return RejectObsolete+        0x12 -> return RejectDuplicate+        0x40 -> return RejectNonStandard+        0x41 -> return RejectDust+        0x42 -> return RejectInsufficientFee+        0x43 -> return RejectCheckpoint+        _    -> fail $ unwords+            [ "Reject get: Invalid code"+            , show code+            ]++    put code = putWord8 $ case code of+        RejectMalformed       -> 0x01+        RejectInvalid         -> 0x10+        RejectObsolete        -> 0x11+        RejectDuplicate       -> 0x12+        RejectNonStandard     -> 0x40+        RejectDust            -> 0x41+        RejectInsufficientFee -> 0x42+        RejectCheckpoint      -> 0x43++-- | Convenience function to build a 'Reject' message.+reject :: MessageCommand -> RejectCode -> ByteString -> Reject+reject cmd code reason =+    Reject cmd code (VarString reason) B.empty++instance Serialize Reject where+    get =+        S.get >>= \(VarString bs) ->+            Reject (stringToCommand bs) <$> S.get <*> S.get <*> maybeData+      where+        maybeData =+            isEmpty >>= \done ->+                if done+                    then return B.empty+                    else getByteString 32+    put (Reject cmd code reason dat) = do+        put $ VarString $ commandToString cmd+        put code+        put reason+        unless (B.null dat) $ putByteString dat++-- | Data type representing a variable-length integer. The 'VarInt' type+-- usually precedes an array or a string that can vary in length.+newtype VarInt = VarInt { getVarInt :: Word64 }+    deriving (Eq, Show, Read, Generic, NFData)++instance Serialize VarInt where++    get = VarInt <$> ( getWord8 >>= go )+      where+        go 0xff = getWord64le+        go 0xfe = fromIntegral <$> getWord32le+        go 0xfd = fromIntegral <$> getWord16le+        go x    = fromIntegral <$> return x++    put (VarInt x)+        | x < 0xfd =+            putWord8 $ fromIntegral x+        | x <= 0xffff = do+            putWord8 0xfd+            putWord16le $ fromIntegral x+        | x <= 0xffffffff = do+            putWord8 0xfe+            putWord32le $ fromIntegral x+        | otherwise = do+            putWord8 0xff+            putWord64le x++putVarInt :: Integral a => a -> Put+putVarInt = put . VarInt . fromIntegral++-- | Data type for serialization of variable-length strings.+newtype VarString = VarString { getVarString :: ByteString }+    deriving (Eq, Show, Read, Generic, NFData)++instance Serialize VarString where++    get = VarString <$> (readBS =<< S.get)+      where+        readBS (VarInt len) = getByteString (fromIntegral len)++    put (VarString bs) = do+        putVarInt $ B.length bs+        putByteString bs++-- | When a bitcoin node creates an outgoing connection to another node,+-- the first message it will send is a 'Version' message. The other node+-- will similarly respond with it's own 'Version' message.+data Version =+    Version {+              -- | protocol version+              version     :: !Word32+              -- | features supported by this connection+            , services    :: !Word64+              -- | unix timestamp+            , timestamp   :: !Word64+              -- | network address of remote node+            , addrRecv    :: !NetworkAddress+              -- | network address of sending node+            , addrSend    :: !NetworkAddress+              -- | random nonce to detect connection to self+            , verNonce    :: !Word64+              -- | user agent string+            , userAgent   :: !VarString+              -- | height of the last block in sending node+            , startHeight :: !Word32+              -- | relay transactions flag (BIP-37)+            , relay       :: !Bool+            } deriving (Eq, Show, Generic, NFData)++instance Serialize Version where++    get = Version <$> getWord32le+                  <*> getWord64le+                  <*> getWord64le+                  <*> S.get+                  <*> S.get+                  <*> getWord64le+                  <*> S.get+                  <*> getWord32le+                  <*> (go =<< isEmpty)+      where+        go True  = return True+        go False = getBool++    put (Version v s t ar as n ua sh r) = do+        putWord32le v+        putWord64le s+        putWord64le t+        put         ar+        put         as+        putWord64le n+        put         ua+        putWord32le sh+        putBool     r++-- | 0x00 is 'False', anything else is 'True'.+getBool :: Get Bool+getBool = go =<< getWord8+  where+    go 0 = return False+    go _ = return True++putBool :: Bool -> Put+putBool True  = putWord8 1+putBool False = putWord8 0++-- | A 'MessageCommand' is included in a 'MessageHeader' in order to identify+-- the type of message present in the payload. This allows the message+-- de-serialization code to know how to decode a particular message payload.+-- Every valid 'Message' constructor has a corresponding 'MessageCommand'+-- constructor.+data MessageCommand+    = MCVersion+    | MCVerAck+    | MCAddr+    | MCInv+    | MCGetData+    | MCNotFound+    | MCGetBlocks+    | MCGetHeaders+    | MCTx+    | MCBlock+    | MCMerkleBlock+    | MCHeaders+    | MCGetAddr+    | MCFilterLoad+    | MCFilterAdd+    | MCFilterClear+    | MCPing+    | MCPong+    | MCAlert+    | MCMempool+    | MCReject+    | MCSendHeaders+    | MCOther ByteString+    deriving (Eq, Generic, NFData)++instance Show MessageCommand where+    showsPrec _ = shows . commandToString++instance Read MessageCommand where+    readPrec = do+        String str <- lexP+        return (stringToCommand (cs str))++instance Serialize MessageCommand where+    get = go <$> getByteString 12+      where+        go bs =+            let str = unpackCommand bs+             in stringToCommand str+    put mc = putByteString $ packCommand $ commandToString mc++instance IsString MessageCommand where+    fromString str = stringToCommand (cs str)++-- | Read a 'MessageCommand' from its string representation.+stringToCommand :: ByteString -> MessageCommand+stringToCommand str = case str of+    "version"     -> MCVersion+    "verack"      -> MCVerAck+    "addr"        -> MCAddr+    "inv"         -> MCInv+    "getdata"     -> MCGetData+    "notfound"    -> MCNotFound+    "getblocks"   -> MCGetBlocks+    "getheaders"  -> MCGetHeaders+    "tx"          -> MCTx+    "block"       -> MCBlock+    "merkleblock" -> MCMerkleBlock+    "headers"     -> MCHeaders+    "getaddr"     -> MCGetAddr+    "filterload"  -> MCFilterLoad+    "filteradd"   -> MCFilterAdd+    "filterclear" -> MCFilterClear+    "ping"        -> MCPing+    "pong"        -> MCPong+    "alert"       -> MCAlert+    "mempool"     -> MCMempool+    "reject"      -> MCReject+    "sendheaders" -> MCSendHeaders+    _             -> MCOther str++-- | Convert a 'MessageCommand' to its string representation.+commandToString :: MessageCommand -> ByteString+commandToString mc = case mc of+    MCVersion     -> "version"+    MCVerAck      -> "verack"+    MCAddr        -> "addr"+    MCInv         -> "inv"+    MCGetData     -> "getdata"+    MCNotFound    -> "notfound"+    MCGetBlocks   -> "getblocks"+    MCGetHeaders  -> "getheaders"+    MCTx          -> "tx"+    MCBlock       -> "block"+    MCMerkleBlock -> "merkleblock"+    MCHeaders     -> "headers"+    MCGetAddr     -> "getaddr"+    MCFilterLoad  -> "filterload"+    MCFilterAdd   -> "filteradd"+    MCFilterClear -> "filterclear"+    MCPing        -> "ping"+    MCPong        -> "pong"+    MCAlert       -> "alert"+    MCMempool     -> "mempool"+    MCReject      -> "reject"+    MCSendHeaders -> "sendheaders"+    MCOther c     -> c++-- | Pack a string 'MessageCommand' so that it is exactly 12-bytes long.+packCommand :: ByteString -> ByteString+packCommand s = B.take 12 $+    s `mappend` C.replicate 12 '\NUL'++-- | Undo packing done by 'packCommand'.+unpackCommand :: ByteString -> ByteString+unpackCommand = B.takeWhile (/= 0)++-- | Node offers no services.+nodeNone :: Word64+nodeNone = 0++-- | Services indicate node is a full node that can serve full blocks.+nodeNetwork :: Word64+nodeNetwork = 1++-- | Services indicate node allows to request 'UTXO' set.+nodeGetUTXO :: Word64+nodeGetUTXO = 1 `shiftL` 1++-- | Services indicate node accepts bloom filters.+nodeBloom :: Word64+nodeBloom = 1 `shiftL` 2++-- | Services indicate SegWit-capable node.+nodeWitness :: Word64+nodeWitness = 1 `shiftL` 3++-- | Services indicate Xtreme Thinblocks compatibility.+nodeXThin :: Word64+nodeXThin = 1 `shiftL` 4
+ src/Haskoin/Network/Message.hs view
@@ -0,0 +1,201 @@+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE DeriveGeneric  #-}+{-|+Module      : Haskoin.Network.Message+Copyright   : No rights reserved+License     : UNLICENSE+Maintainer  : jprupp@protonmail.ch+Stability   : experimental+Portability : POSIX++Peer-to-peer network message serialization.+-}+module Haskoin.Network.Message+    ( -- * Network Message+      Message(..)+    , MessageHeader(..)+    , msgType+    , putMessage+    , getMessage+    ) where++import           Control.DeepSeq+import           Control.Monad              (unless)+import           Data.ByteString            (ByteString)+import qualified Data.ByteString            as BS+import           Data.Serialize             (Serialize, encode, get, put)+import           Data.Serialize.Get         (Get, getByteString, getWord32be,+                                             getWord32le, isolate, lookAhead)+import           Data.Serialize.Put         (Putter, putByteString, putWord32be,+                                             putWord32le)+import           Data.Word                  (Word32)+import           GHC.Generics               (Generic)+import           Haskoin.Block.Common+import           Haskoin.Block.Merkle+import           Haskoin.Constants+import           Haskoin.Crypto.Hash+import           Haskoin.Network.Bloom+import           Haskoin.Network.Common+import           Haskoin.Transaction.Common++-- | Data type representing the header of a 'Message'. All messages sent between+-- nodes contain a message header.+data MessageHeader = MessageHeader+    { -- | magic bytes identify network+      headMagic       :: !Word32+      -- | message type+    , headCmd         :: !MessageCommand+      -- | length of payload+    , headPayloadSize :: !Word32+      -- | checksum of payload+    , headChecksum    :: !CheckSum32+    } deriving (Eq, Show, Generic, NFData)++instance Serialize MessageHeader where++    get = MessageHeader <$> getWord32be+                        <*> get+                        <*> getWord32le+                        <*> get++    put (MessageHeader m c l chk) = do+        putWord32be m+        put         c+        putWord32le l+        put         chk++-- | The 'Message' type is used to identify all the valid messages that can be+-- sent between bitcoin peers. Only values of type 'Message' will be accepted+-- by other bitcoin peers as bitcoin protocol messages need to be correctly+-- serialized with message headers. Serializing a 'Message' value will+-- include the 'MessageHeader' with the correct checksum value automatically.+-- No need to add the 'MessageHeader' separately.+data Message+    = MVersion !Version+    | MVerAck+    | MAddr !Addr+    | MInv !Inv+    | MGetData !GetData+    | MNotFound !NotFound+    | MGetBlocks !GetBlocks+    | MGetHeaders !GetHeaders+    | MTx !Tx+    | MBlock !Block+    | MMerkleBlock !MerkleBlock+    | MHeaders !Headers+    | MGetAddr+    | MFilterLoad !FilterLoad+    | MFilterAdd !FilterAdd+    | MFilterClear+    | MPing !Ping+    | MPong !Pong+    | MAlert !Alert+    | MMempool+    | MReject !Reject+    | MSendHeaders+    | MOther !ByteString !ByteString+    deriving (Eq, Show, Generic, NFData)++-- | Get 'MessageCommand' assocated with a message.+msgType :: Message -> MessageCommand+msgType (MVersion _)     = MCVersion+msgType MVerAck          = MCVerAck+msgType (MAddr _)        = MCAddr+msgType (MInv _)         = MCInv+msgType (MGetData _)     = MCGetData+msgType (MNotFound _)    = MCNotFound+msgType (MGetBlocks _)   = MCGetBlocks+msgType (MGetHeaders _)  = MCGetHeaders+msgType (MTx _)          = MCTx+msgType (MBlock _)       = MCBlock+msgType (MMerkleBlock _) = MCMerkleBlock+msgType (MHeaders _)     = MCHeaders++msgType (MFilterLoad _)  = MCFilterLoad+msgType (MFilterAdd _)   = MCFilterAdd+msgType MFilterClear     = MCFilterClear+msgType (MPing _)        = MCPing+msgType (MPong _)        = MCPong+msgType (MAlert _)       = MCAlert+msgType MMempool         = MCMempool+msgType (MReject _)      = MCReject+msgType MSendHeaders     = MCSendHeaders+msgType MGetAddr         = MCGetAddr+msgType (MOther c _)     = MCOther c++-- | Deserializer for network messages.+getMessage :: Network -> Get Message+getMessage net = do+    (MessageHeader mgc cmd len chk) <- get+    bs <- lookAhead $ getByteString $ fromIntegral len+    unless+        (mgc == getNetworkMagic net)+        (fail $ "get: Invalid network magic bytes: " ++ show mgc)+    unless+        (checkSum32 bs == chk)+        (fail $ "get: Invalid message checksum: " ++ show chk)+    if len > 0+        then isolate (fromIntegral len) $+             case cmd of+                 MCVersion     -> MVersion <$> get+                 MCAddr        -> MAddr <$> get+                 MCInv         -> MInv <$> get+                 MCGetData     -> MGetData <$> get+                 MCNotFound    -> MNotFound <$> get+                 MCGetBlocks   -> MGetBlocks <$> get+                 MCGetHeaders  -> MGetHeaders <$> get+                 MCTx          -> MTx <$> get+                 MCBlock       -> MBlock <$> get+                 MCMerkleBlock -> MMerkleBlock <$> get+                 MCHeaders     -> MHeaders <$> get+                 MCFilterLoad  -> MFilterLoad <$> get+                 MCFilterAdd   -> MFilterAdd <$> get+                 MCPing        -> MPing <$> get+                 MCPong        -> MPong <$> get+                 MCAlert       -> MAlert <$> get+                 MCReject      -> MReject <$> get+                 MCOther c     -> MOther c <$> getByteString (fromIntegral len)+                 _             -> fail $ "get: command " ++ show cmd +++                                         " should not carry a payload"+        else case cmd of+                 MCGetAddr     -> return MGetAddr+                 MCVerAck      -> return MVerAck+                 MCFilterClear -> return MFilterClear+                 MCMempool     -> return MMempool+                 MCSendHeaders -> return MSendHeaders+                 _             -> fail $ "get: command " ++ show cmd +++                                         " is expected to carry a payload"++-- | Serializer for network messages.+putMessage :: Network -> Putter Message+putMessage net msg = do+    let (cmd, payload) =+            case msg of+                MVersion m     -> (MCVersion, encode m)+                MVerAck        -> (MCVerAck, BS.empty)+                MAddr m        -> (MCAddr, encode m)+                MInv m         -> (MCInv, encode m)+                MGetData m     -> (MCGetData, encode m)+                MNotFound m    -> (MCNotFound, encode m)+                MGetBlocks m   -> (MCGetBlocks, encode m)+                MGetHeaders m  -> (MCGetHeaders, encode m)+                MTx m          -> (MCTx, encode m)+                MBlock m       -> (MCBlock, encode m)+                MMerkleBlock m -> (MCMerkleBlock, encode m)+                MHeaders m     -> (MCHeaders, encode m)+                MGetAddr       -> (MCGetAddr, BS.empty)+                MFilterLoad m  -> (MCFilterLoad, encode m)+                MFilterAdd m   -> (MCFilterAdd, encode m)+                MFilterClear   -> (MCFilterClear, BS.empty)+                MPing m        -> (MCPing, encode m)+                MPong m        -> (MCPong, encode m)+                MAlert m       -> (MCAlert, encode m)+                MMempool       -> (MCMempool, BS.empty)+                MReject m      -> (MCReject, encode m)+                MSendHeaders   -> (MCSendHeaders, BS.empty)+                MOther c p     -> (MCOther c, p)+        chk = checkSum32 payload+        len = fromIntegral $ BS.length payload+        header = MessageHeader (getNetworkMagic net) cmd len chk+    put header+    putByteString payload
+ src/Haskoin/Script.hs view
@@ -0,0 +1,19 @@+{-|+Module      : Haskoin.Script+Copyright   : No rights reserved+License     : UNLICENSE+Maintainer  : jprupp@protonmail.ch+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 Haskoin.Script+    ( module X+    ) where++import           Haskoin.Script.Common   as X+import           Haskoin.Script.SigHash  as X+import           Haskoin.Script.Standard as X
+ src/Haskoin/Script/Common.hs view
@@ -0,0 +1,731 @@+{-# LANGUAGE DeriveAnyClass    #-}+{-# LANGUAGE DeriveGeneric     #-}+{-# LANGUAGE OverloadedStrings #-}+{-|+Module      : Haskoin.Script.Common+Copyright   : No rights reserved+License     : UNLICENSE+Maintainer  : jprupp@protonmail.ch+Stability   : experimental+Portability : POSIX++Common script-related functions and data types.+-}+module Haskoin.Script.Common+    ( ScriptOp(..)+    , Script(..)+    , PushDataType(..)+    , ScriptOutput(..)+    , isPayPK+    , isPayPKHash+    , isPayMulSig+    , isPayScriptHash+    , isPayWitnessPKHash+    , isPayWitnessScriptHash+    , isDataCarrier+    , encodeOutput+    , encodeOutputBS+    , decodeOutput+    , decodeOutputBS+    , toP2SH+    , toP2WSH+    , isPushOp+    , opPushData+    , intToScriptOp+    , scriptOpToInt+    ) where++import           Control.DeepSeq+import           Control.Monad+import           Data.Aeson          as A+import           Data.Aeson.Encoding (text)+import           Data.ByteString     (ByteString)+import qualified Data.ByteString     as B+import           Data.Hashable+import           Data.Serialize      as S+import           Data.Word           (Word8)+import           GHC.Generics        (Generic)+import           Haskoin.Crypto.Hash+import           Haskoin.Keys.Common+import           Haskoin.Util++-- | Data type representing a transaction script. Scripts are defined as lists+-- of script operators 'ScriptOp'. Scripts are used to:+--+-- * Define the spending conditions in the output of a transaction.+-- * Provide signatures in the input of a transaction (except SegWit).+--+-- SigWit only: the segregated witness data structure, and not the input script,+-- contains signatures and redeem script for pay-to-witness-script and+-- pay-to-witness-public-key-hash transactions.+newtype Script =+    Script {+             -- | script operators defining this script+             scriptOps :: [ScriptOp]+           }+    deriving (Eq, Show, Read, Generic, Hashable, NFData)++instance Serialize Script where+    get =+        Script <$> getScriptOps+      where+        getScriptOps = do+            empty <- isEmpty+            if empty+                then return []+                else (:) <$> get <*> getScriptOps++    put (Script ops) = forM_ ops put++-- | Data type representing the type of an OP_PUSHDATA opcode.+data PushDataType+    =+      -- | next opcode bytes is data to be pushed+      OPCODE+      -- | next byte contains number of bytes of data to be pushed+    | OPDATA1+      -- | next two bytes contains number of bytes to be pushed+    | OPDATA2+      -- | next four bytes contains the number of bytes to be pushed+    | OPDATA4+    deriving (Show, Read, Eq, Generic, Hashable, NFData)++-- | Data type representing an operator allowed inside a 'Script'.+data ScriptOp+      -- Pushing Data+    = OP_PUSHDATA !ByteString+                  !PushDataType+    | OP_0+    | OP_1NEGATE+    | OP_RESERVED+    | OP_1+    | OP_2+    | OP_3+    | OP_4+    | OP_5+    | OP_6+    | OP_7+    | OP_8+    | OP_9+    | OP_10+    | OP_11+    | OP_12+    | OP_13+    | OP_14+    | OP_15+    | OP_16+      -- Flow control+    | OP_NOP+    | OP_VER -- reserved+    | OP_IF+    | OP_NOTIF+    | OP_VERIF -- resreved+    | OP_VERNOTIF -- reserved+    | OP_ELSE+    | OP_ENDIF+    | OP_VERIFY+    | OP_RETURN+      -- Stack operations+    | OP_TOALTSTACK+    | OP_FROMALTSTACK+    | OP_IFDUP+    | OP_DEPTH+    | OP_DROP+    | OP_DUP+    | OP_NIP+    | OP_OVER+    | OP_PICK+    | OP_ROLL+    | OP_ROT+    | OP_SWAP+    | OP_TUCK+    | OP_2DROP+    | OP_2DUP+    | OP_3DUP+    | OP_2OVER+    | OP_2ROT+    | OP_2SWAP+      -- Splice+    | OP_CAT+    | OP_SUBSTR+    | OP_LEFT+    | OP_RIGHT+    | OP_SIZE+      -- Bitwise logic+    | OP_INVERT+    | OP_AND+    | OP_OR+    | OP_XOR+    | OP_EQUAL+    | OP_EQUALVERIFY+    | OP_RESERVED1+    | OP_RESERVED2+      -- Arithmetic+    | OP_1ADD+    | OP_1SUB+    | OP_2MUL+    | OP_2DIV+    | OP_NEGATE+    | OP_ABS+    | OP_NOT+    | OP_0NOTEQUAL+    | OP_ADD+    | OP_SUB+    | OP_MUL+    | OP_DIV+    | OP_MOD+    | OP_LSHIFT+    | OP_RSHIFT+    | OP_BOOLAND+    | OP_BOOLOR+    | OP_NUMEQUAL+    | OP_NUMEQUALVERIFY+    | OP_NUMNOTEQUAL+    | OP_LESSTHAN+    | OP_GREATERTHAN+    | OP_LESSTHANOREQUAL+    | OP_GREATERTHANOREQUAL+    | OP_MIN+    | OP_MAX+    | OP_WITHIN+      -- Crypto+    | OP_RIPEMD160+    | OP_SHA1+    | OP_SHA256+    | OP_HASH160+    | OP_HASH256+    | OP_CODESEPARATOR+    | OP_CHECKSIG+    | OP_CHECKSIGVERIFY+    | OP_CHECKMULTISIG+    | OP_CHECKMULTISIGVERIFY+      -- Expansion+    | OP_NOP1+    | OP_NOP2+    | OP_NOP3+    | OP_NOP4+    | OP_NOP5+    | OP_NOP6+    | OP_NOP7+    | OP_NOP8+    | OP_NOP9+    | OP_NOP10+      -- Bitcoin Cash Nov 2018 hard fork+    | OP_CHECKDATASIG+    | OP_CHECKDATASIGVERIFY+      -- Other+    | OP_PUBKEYHASH+    | OP_PUBKEY+    | OP_INVALIDOPCODE !Word8+    deriving (Show, Read, Eq, Generic, Hashable, NFData)++instance Serialize ScriptOp where+    get = go =<< (fromIntegral <$> getWord8)+      where+        go op+            | op == 0x00 = return OP_0+            | op <= 0x4b = do+                payload <- getByteString (fromIntegral op)+                return $ OP_PUSHDATA payload OPCODE+            | op == 0x4c = do+                len  <- getWord8+                payload <- getByteString (fromIntegral len)+                return $ OP_PUSHDATA payload OPDATA1+            | op == 0x4d = do+                len  <- getWord16le+                payload <- getByteString (fromIntegral len)+                return $ OP_PUSHDATA payload OPDATA2+            | op == 0x4e = do+                len  <- getWord32le+                payload <- getByteString (fromIntegral len)+                return $ OP_PUSHDATA payload OPDATA4++            | op == 0x4f = return OP_1NEGATE+            | op == 0x50 = return OP_RESERVED+            | op == 0x51 = return OP_1+            | op == 0x52 = return OP_2+            | op == 0x53 = return OP_3+            | op == 0x54 = return OP_4+            | op == 0x55 = return OP_5+            | op == 0x56 = return OP_6+            | op == 0x57 = return OP_7+            | op == 0x58 = return OP_8+            | op == 0x59 = return OP_9+            | op == 0x5a = return OP_10+            | op == 0x5b = return OP_11+            | op == 0x5c = return OP_12+            | op == 0x5d = return OP_13+            | op == 0x5e = return OP_14+            | op == 0x5f = return OP_15+            | op == 0x60 = return OP_16++            -- Flow control+            | op == 0x61 = return OP_NOP+            | op == 0x62 = return OP_VER        -- reserved+            | op == 0x63 = return OP_IF+            | op == 0x64 = return OP_NOTIF+            | op == 0x65 = return OP_VERIF      -- reserved+            | op == 0x66 = return OP_VERNOTIF   -- reserved+            | op == 0x67 = return OP_ELSE+            | op == 0x68 = return OP_ENDIF+            | op == 0x69 = return OP_VERIFY+            | op == 0x6a = return OP_RETURN++            -- Stack+            | op == 0x6b = return OP_TOALTSTACK+            | op == 0x6c = return OP_FROMALTSTACK+            | op == 0x6d = return OP_2DROP+            | op == 0x6e = return OP_2DUP+            | op == 0x6f = return OP_3DUP+            | op == 0x70 = return OP_2OVER+            | op == 0x71 = return OP_2ROT+            | op == 0x72 = return OP_2SWAP+            | op == 0x73 = return OP_IFDUP+            | op == 0x74 = return OP_DEPTH+            | op == 0x75 = return OP_DROP+            | op == 0x76 = return OP_DUP+            | op == 0x77 = return OP_NIP+            | op == 0x78 = return OP_OVER+            | op == 0x79 = return OP_PICK+            | op == 0x7a = return OP_ROLL+            | op == 0x7b = return OP_ROT+            | op == 0x7c = return OP_SWAP+            | op == 0x7d = return OP_TUCK++            -- Splice+            | op == 0x7e = return OP_CAT+            | op == 0x7f = return OP_SUBSTR+            | op == 0x80 = return OP_LEFT+            | op == 0x81 = return OP_RIGHT+            | op == 0x82 = return OP_SIZE++            -- Bitwise logic+            | op == 0x83 = return OP_INVERT+            | op == 0x84 = return OP_AND+            | op == 0x85 = return OP_OR+            | op == 0x86 = return OP_XOR+            | op == 0x87 = return OP_EQUAL+            | op == 0x88 = return OP_EQUALVERIFY+            | op == 0x89 = return OP_RESERVED1+            | op == 0x8a = return OP_RESERVED2++            -- Arithmetic+            | op == 0x8b = return OP_1ADD+            | op == 0x8c = return OP_1SUB+            | op == 0x8d = return OP_2MUL+            | op == 0x8e = return OP_2DIV+            | op == 0x8f = return OP_NEGATE+            | op == 0x90 = return OP_ABS+            | op == 0x91 = return OP_NOT+            | op == 0x92 = return OP_0NOTEQUAL+            | op == 0x93 = return OP_ADD+            | op == 0x94 = return OP_SUB+            | op == 0x95 = return OP_MUL+            | op == 0x96 = return OP_DIV+            | op == 0x97 = return OP_MOD+            | op == 0x98 = return OP_LSHIFT+            | op == 0x99 = return OP_RSHIFT+            | op == 0x9a = return OP_BOOLAND+            | op == 0x9b = return OP_BOOLOR+            | op == 0x9c = return OP_NUMEQUAL+            | op == 0x9d = return OP_NUMEQUALVERIFY+            | op == 0x9e = return OP_NUMNOTEQUAL+            | op == 0x9f = return OP_LESSTHAN+            | op == 0xa0 = return OP_GREATERTHAN+            | op == 0xa1 = return OP_LESSTHANOREQUAL+            | op == 0xa2 = return OP_GREATERTHANOREQUAL+            | op == 0xa3 = return OP_MIN+            | op == 0xa4 = return OP_MAX+            | op == 0xa5 = return OP_WITHIN++            -- Crypto+            | op == 0xa6 = return OP_RIPEMD160+            | op == 0xa7 = return OP_SHA1+            | op == 0xa8 = return OP_SHA256+            | op == 0xa9 = return OP_HASH160+            | op == 0xaa = return OP_HASH256+            | op == 0xab = return OP_CODESEPARATOR+            | op == 0xac = return OP_CHECKSIG+            | op == 0xad = return OP_CHECKSIGVERIFY+            | op == 0xae = return OP_CHECKMULTISIG+            | op == 0xaf = return OP_CHECKMULTISIGVERIFY++            -- More NOPs+            | op == 0xb0 = return OP_NOP1+            | op == 0xb1 = return OP_NOP2+            | op == 0xb2 = return OP_NOP3+            | op == 0xb3 = return OP_NOP4+            | op == 0xb4 = return OP_NOP5+            | op == 0xb5 = return OP_NOP6+            | op == 0xb6 = return OP_NOP7+            | op == 0xb7 = return OP_NOP8+            | op == 0xb8 = return OP_NOP9+            | op == 0xb9 = return OP_NOP10++            -- Bitcoin Cash Nov 2018 hard fork+            | op == 0xba = return OP_CHECKDATASIG+            | op == 0xbb = return OP_CHECKDATASIGVERIFY++            -- Constants+            | op == 0xfd = return OP_PUBKEYHASH+            | op == 0xfe = return OP_PUBKEY++            | otherwise = return $ OP_INVALIDOPCODE op++    put op = case op of++        (OP_PUSHDATA payload optype)-> do+            let len = B.length payload+            case optype of+                OPCODE -> do+                    unless (len <= 0x4b) $+                        error "OP_PUSHDATA OPCODE: Payload size too big"+                    putWord8 $ fromIntegral len+                OPDATA1 -> do+                    unless (len <= 0xff) $+                        error "OP_PUSHDATA OPDATA1: Payload size too big"+                    putWord8 0x4c+                    putWord8 $ fromIntegral len+                OPDATA2 -> do+                    unless (len <= 0xffff) $+                        error "OP_PUSHDATA OPDATA2: Payload size too big"+                    putWord8 0x4d+                    putWord16le $ fromIntegral len+                OPDATA4 -> do+                    unless (len <= 0x7fffffff) $+                        error "OP_PUSHDATA OPDATA4: Payload size too big"+                    putWord8 0x4e+                    putWord32le $ fromIntegral len+            putByteString payload++        -- Constants+        OP_0                 -> putWord8 0x00+        OP_1NEGATE           -> putWord8 0x4f+        OP_RESERVED          -> putWord8 0x50+        OP_1                 -> putWord8 0x51+        OP_2                 -> putWord8 0x52+        OP_3                 -> putWord8 0x53+        OP_4                 -> putWord8 0x54+        OP_5                 -> putWord8 0x55+        OP_6                 -> putWord8 0x56+        OP_7                 -> putWord8 0x57+        OP_8                 -> putWord8 0x58+        OP_9                 -> putWord8 0x59+        OP_10                -> putWord8 0x5a+        OP_11                -> putWord8 0x5b+        OP_12                -> putWord8 0x5c+        OP_13                -> putWord8 0x5d+        OP_14                -> putWord8 0x5e+        OP_15                -> putWord8 0x5f+        OP_16                -> putWord8 0x60++        -- Crypto Constants+        OP_PUBKEY            -> putWord8 0xfe+        OP_PUBKEYHASH        -> putWord8 0xfd++        -- Invalid Opcodes+        (OP_INVALIDOPCODE x) -> putWord8 x++        -- Flow Control+        OP_NOP               -> putWord8 0x61+        OP_VER               -> putWord8 0x62+        OP_IF                -> putWord8 0x63+        OP_NOTIF             -> putWord8 0x64+        OP_VERIF             -> putWord8 0x65+        OP_VERNOTIF          -> putWord8 0x66+        OP_ELSE              -> putWord8 0x67+        OP_ENDIF             -> putWord8 0x68+        OP_VERIFY            -> putWord8 0x69+        OP_RETURN            -> putWord8 0x6a++        -- Stack Operations+        OP_TOALTSTACK        -> putWord8 0x6b+        OP_FROMALTSTACK      -> putWord8 0x6c+        OP_2DROP             -> putWord8 0x6d+        OP_2DUP              -> putWord8 0x6e+        OP_3DUP              -> putWord8 0x6f+        OP_2OVER             -> putWord8 0x70+        OP_2ROT              -> putWord8 0x71+        OP_2SWAP             -> putWord8 0x72+        OP_IFDUP             -> putWord8 0x73+        OP_DEPTH             -> putWord8 0x74+        OP_DROP              -> putWord8 0x75+        OP_DUP               -> putWord8 0x76+        OP_NIP               -> putWord8 0x77+        OP_OVER              -> putWord8 0x78+        OP_PICK              -> putWord8 0x79+        OP_ROLL              -> putWord8 0x7a+        OP_ROT               -> putWord8 0x7b+        OP_SWAP              -> putWord8 0x7c+        OP_TUCK              -> putWord8 0x7d++        -- Splice+        OP_CAT               -> putWord8 0x7e+        OP_SUBSTR            -> putWord8 0x7f+        OP_LEFT              -> putWord8 0x80+        OP_RIGHT             -> putWord8 0x81+        OP_SIZE              -> putWord8 0x82++        -- Bitwise Logic+        OP_INVERT            -> putWord8 0x83+        OP_AND               -> putWord8 0x84+        OP_OR                -> putWord8 0x85+        OP_XOR               -> putWord8 0x86+        OP_EQUAL             -> putWord8 0x87+        OP_EQUALVERIFY       -> putWord8 0x88+        OP_RESERVED1         -> putWord8 0x89+        OP_RESERVED2         -> putWord8 0x8a++        -- Arithmetic+        OP_1ADD              -> putWord8 0x8b+        OP_1SUB              -> putWord8 0x8c+        OP_2MUL              -> putWord8 0x8d+        OP_2DIV              -> putWord8 0x8e+        OP_NEGATE            -> putWord8 0x8f+        OP_ABS               -> putWord8 0x90+        OP_NOT               -> putWord8 0x91+        OP_0NOTEQUAL         -> putWord8 0x92+        OP_ADD               -> putWord8 0x93+        OP_SUB               -> putWord8 0x94+        OP_MUL               -> putWord8 0x95+        OP_DIV               -> putWord8 0x96+        OP_MOD               -> putWord8 0x97+        OP_LSHIFT            -> putWord8 0x98+        OP_RSHIFT            -> putWord8 0x99+        OP_BOOLAND           -> putWord8 0x9a+        OP_BOOLOR            -> putWord8 0x9b+        OP_NUMEQUAL          -> putWord8 0x9c+        OP_NUMEQUALVERIFY    -> putWord8 0x9d+        OP_NUMNOTEQUAL       -> putWord8 0x9e+        OP_LESSTHAN          -> putWord8 0x9f+        OP_GREATERTHAN       -> putWord8 0xa0+        OP_LESSTHANOREQUAL   -> putWord8 0xa1+        OP_GREATERTHANOREQUAL-> putWord8 0xa2+        OP_MIN               -> putWord8 0xa3+        OP_MAX               -> putWord8 0xa4+        OP_WITHIN            -> putWord8 0xa5++        -- Crypto+        OP_RIPEMD160         -> putWord8 0xa6+        OP_SHA1              -> putWord8 0xa7+        OP_SHA256            -> putWord8 0xa8+        OP_HASH160           -> putWord8 0xa9+        OP_HASH256           -> putWord8 0xaa+        OP_CODESEPARATOR     -> putWord8 0xab+        OP_CHECKSIG          -> putWord8 0xac+        OP_CHECKSIGVERIFY    -> putWord8 0xad+        OP_CHECKMULTISIG     -> putWord8 0xae+        OP_CHECKMULTISIGVERIFY -> putWord8 0xaf++        -- More NOPs+        OP_NOP1              -> putWord8 0xb0+        OP_NOP2              -> putWord8 0xb1+        OP_NOP3              -> putWord8 0xb2+        OP_NOP4              -> putWord8 0xb3+        OP_NOP5              -> putWord8 0xb4+        OP_NOP6              -> putWord8 0xb5+        OP_NOP7              -> putWord8 0xb6+        OP_NOP8              -> putWord8 0xb7+        OP_NOP9              -> putWord8 0xb8+        OP_NOP10             -> putWord8 0xb9++        -- Bitcoin Cash Nov 2018 hard fork+        OP_CHECKDATASIG      -> putWord8 0xba+        OP_CHECKDATASIGVERIFY -> putWord8 0xbb+++-- | Check whether opcode is only data.+isPushOp :: ScriptOp -> Bool+isPushOp op = case op of+    OP_PUSHDATA _ _ -> True+    OP_0            -> True+    OP_1NEGATE      -> True+    OP_1            -> True+    OP_2            -> True+    OP_3            -> True+    OP_4            -> True+    OP_5            -> True+    OP_6            -> True+    OP_7            -> True+    OP_8            -> True+    OP_9            -> True+    OP_10           -> True+    OP_11           -> True+    OP_12           -> True+    OP_13           -> True+    OP_14           -> True+    OP_15           -> True+    OP_16           -> True+    _               -> False++-- | Optimally encode data using one of the 4 types of data pushing opcodes.+opPushData :: ByteString -> ScriptOp+opPushData bs+    | len <= 0x4b       = OP_PUSHDATA bs OPCODE+    | len <= 0xff       = OP_PUSHDATA bs OPDATA1+    | len <= 0xffff     = OP_PUSHDATA bs OPDATA2+    | len <= 0xffffffff = OP_PUSHDATA bs OPDATA4+    | otherwise         = error "opPushData: payload size too big"+  where+    len = B.length bs++-- | Transforms integers @[1 .. 16]@ to 'ScriptOp' @[OP_1 .. OP_16]@.+intToScriptOp :: Int -> ScriptOp+intToScriptOp i+    | i `elem` [1 .. 16] = op+    | otherwise = err+  where+    op = either (const err) id . S.decode . B.singleton . fromIntegral $ i + 0x50+    err = error $ "intToScriptOp: Invalid integer " ++ show i++-- | Decode 'ScriptOp' @[OP_1 .. OP_16]@ to integers @[1 .. 16]@. This functions+-- fails for other values of 'ScriptOp'+scriptOpToInt :: ScriptOp -> Either String Int+scriptOpToInt s+    | res `elem` [1..16] = return res+    | otherwise          = Left $ "scriptOpToInt: invalid opcode " ++ show s+  where+    res = fromIntegral (B.head $ S.encode s) - 0x50++-- | Data type describing standard transaction output scripts. Output scripts+-- provide the conditions that must be fulfilled for someone to spend the funds+-- in a transaction output.+data ScriptOutput+      -- | pay to public key+    = PayPK { getOutputPubKey :: !PubKeyI }+      -- | pay to public key hash+    | PayPKHash { getOutputHash :: !Hash160 }+      -- | multisig+    | PayMulSig { getOutputMulSigKeys     :: ![PubKeyI]+                , getOutputMulSigRequired :: !Int }+      -- | pay to a script hash+    | PayScriptHash { getOutputHash :: !Hash160 }+      -- | pay to witness public key hash+    | PayWitnessPKHash { getOutputHash :: !Hash160 }+      -- | pay to witness script hash+    | PayWitnessScriptHash { getScriptHash :: !Hash256 }+      -- | provably unspendable data carrier+    | DataCarrier { getOutputData :: !ByteString }+    deriving (Eq, Show, Read, Generic, Hashable, NFData)++instance FromJSON ScriptOutput where+    parseJSON = withText "scriptoutput" $ \t -> either fail return $+        maybeToEither "scriptoutput not hex" (decodeHex t) >>=+        decodeOutputBS++instance ToJSON ScriptOutput where+    toJSON = String . encodeHex . encodeOutputBS+    toEncoding = text . encodeHex . encodeOutputBS++-- | Is script a pay-to-public-key output?+isPayPK :: ScriptOutput -> Bool+isPayPK (PayPK _) = True+isPayPK _         = False++-- | Is script a pay-to-pub-key-hash output?+isPayPKHash :: ScriptOutput -> Bool+isPayPKHash (PayPKHash _) = True+isPayPKHash _             = False++-- | Is script a pay-to-multi-sig output?+isPayMulSig :: ScriptOutput -> Bool+isPayMulSig (PayMulSig _ _) = True+isPayMulSig _               = False++-- | Is script a pay-to-script-hash output?+isPayScriptHash :: ScriptOutput -> Bool+isPayScriptHash (PayScriptHash _) = True+isPayScriptHash _                 = False++-- | 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++-- | Is script a data carrier output?+isDataCarrier :: ScriptOutput -> Bool+isDataCarrier (DataCarrier _) = True+isDataCarrier _               = False++-- | Tries to decode a 'ScriptOutput' from a 'Script'. This can fail if the+-- script is not recognized as any of the standard output types.+decodeOutput :: Script -> Either String ScriptOutput+decodeOutput s = case scriptOps s of+    -- Pay to PubKey+    [OP_PUSHDATA bs _, OP_CHECKSIG] -> PayPK <$> S.decode bs+    -- Pay to PubKey Hash+    [OP_DUP, OP_HASH160, OP_PUSHDATA bs _, OP_EQUALVERIFY, OP_CHECKSIG] ->+        PayPKHash <$> S.decode bs+    -- Pay to Script Hash+    [OP_HASH160, OP_PUSHDATA bs _, OP_EQUAL] ->+        PayScriptHash <$> S.decode  bs+    -- Pay to Witness+    [OP_0, OP_PUSHDATA bs OPCODE]+      | B.length bs == 20 -> PayWitnessPKHash     <$> S.decode bs+      | B.length bs == 32 -> PayWitnessScriptHash <$> S.decode bs+    -- Provably unspendable data carrier output+    [OP_RETURN, OP_PUSHDATA bs _] -> Right $ DataCarrier bs+    -- Pay to MultiSig Keys+    _ -> matchPayMulSig s++-- | Similar to 'decodeOutput' but decodes from a 'ByteString'.+decodeOutputBS :: ByteString -> Either String ScriptOutput+decodeOutputBS = decodeOutput <=< S.decode++-- | Computes a 'Script' from a standard 'ScriptOutput'.+encodeOutput :: ScriptOutput -> Script+encodeOutput s = Script $ case s of+    -- Pay to PubKey+    (PayPK k) -> [opPushData $ S.encode k, OP_CHECKSIG]+    -- Pay to PubKey Hash Address+    (PayPKHash h) ->+        [ OP_DUP, OP_HASH160, opPushData $ S.encode h, OP_EQUALVERIFY, OP_CHECKSIG]+    -- Pay to MultiSig Keys+    (PayMulSig ps r)+      | r <= length ps ->+        let opM = intToScriptOp r+            opN = intToScriptOp $ length ps+            keys = map (opPushData . S.encode) ps+            in opM : keys ++ [opN, OP_CHECKMULTISIG]+      | otherwise -> error "encodeOutput: PayMulSig r must be <= than pkeys"+    -- Pay to Script Hash Address+    (PayScriptHash h) ->+        [ OP_HASH160, opPushData $ S.encode h, OP_EQUAL]+    -- Pay to Witness PubKey Hash Address+    (PayWitnessPKHash h) ->+        [ OP_0, opPushData $ S.encode h ]+    (PayWitnessScriptHash h) ->+        [ OP_0, opPushData $ S.encode h ]+    -- Provably unspendable output+    (DataCarrier d) -> [OP_RETURN, opPushData d]++-- | Similar to 'encodeOutput' but encodes to a ByteString+encodeOutputBS :: ScriptOutput -> ByteString+encodeOutputBS = S.encode . encodeOutput++-- | Encode script as pay-to-script-hash script+toP2SH :: Script -> ScriptOutput+toP2SH = PayScriptHash . addressHash . S.encode++-- | Encode script as a pay-to-witness-script-hash script+toP2WSH :: Script -> ScriptOutput+toP2WSH = PayWitnessScriptHash . sha256 . S.encode++-- | Match @[OP_N, PubKey1, ..., PubKeyM, OP_M, OP_CHECKMULTISIG]@+matchPayMulSig :: Script -> Either String ScriptOutput+matchPayMulSig (Script ops) = case splitAt (length ops - 2) ops of+    (m:xs,[n,OP_CHECKMULTISIG]) -> do+        (intM,intN) <- liftM2 (,) (scriptOpToInt m) (scriptOpToInt n)+        if intM <= intN && length xs == intN+            then liftM2 PayMulSig (go xs) (return intM)+            else Left "matchPayMulSig: Invalid M or N parameters"+    _ -> Left "matchPayMulSig: script did not match output template"+  where+    go (OP_PUSHDATA bs _:xs) = liftM2 (:) (S.decode bs) (go xs)+    go []                    = return []+    go  _                    = Left "matchPayMulSig: invalid multisig opcode"
+ src/Haskoin/Script/SigHash.hs view
@@ -0,0 +1,319 @@+{-# LANGUAGE DeriveGeneric              #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE OverloadedStrings          #-}+{-|+Module      : Haskoin.Script.SigHash+Copyright   : No rights reserved+License     : UNLICENSE+Maintainer  : jprupp@protonmail.ch+Stability   : experimental+Portability : POSIX++Transaction signatures and related functions.+-}+module Haskoin.Script.SigHash+( SigHash+, SigHashFlag(..)+, sigHashAll+, sigHashNone+, sigHashSingle+, hasAnyoneCanPayFlag+, hasForkIdFlag+, setAnyoneCanPayFlag+, setForkIdFlag+, isSigHashAll+, isSigHashNone+, isSigHashSingle+, isSigHashUnknown+, sigHashAddForkId+, sigHashGetForkId+, sigHashAddNetworkId+, txSigHash+, txSigHashForkId+, TxSignature(..)+, encodeTxSig+, decodeTxSig+) where++import           Control.DeepSeq+import           Control.Monad+import           Crypto.Secp256k1+import qualified Data.Aeson                 as J+import           Data.Bits+import           Data.ByteString            (ByteString)+import qualified Data.ByteString            as BS+import           Data.Hashable+import           Data.Maybe+import           Data.Scientific+import           Data.Serialize+import           Data.Word+import           GHC.Generics               (Generic)+import           Haskoin.Constants+import           Haskoin.Crypto.Hash+import           Haskoin.Crypto.Signature+import           Haskoin.Network+import           Haskoin.Script.Common+import           Haskoin.Transaction.Common+import           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, Read, Generic)++instance NFData SigHashFlag++instance Hashable SigHashFlag++instance Enum SigHashFlag where+    fromEnum SIGHASH_ALL          = 0x01+    fromEnum SIGHASH_NONE         = 0x02+    fromEnum SIGHASH_SINGLE       = 0x03+    fromEnum SIGHASH_FORKID       = 0x40+    fromEnum SIGHASH_ANYONECANPAY = 0x80+    toEnum 0x01 = SIGHASH_ALL+    toEnum 0x02 = SIGHASH_NONE+    toEnum 0x03 = SIGHASH_SINGLE+    toEnum 0x40 = SIGHASH_FORKID+    toEnum 0x80 = SIGHASH_ANYONECANPAY+    toEnum _    = error "Not a valid sighash flag"++-- | Data type representing the different ways a transaction can be signed.+-- When producing a signature, a hash of the transaction is used as the message+-- to be signed. The 'SigHash' parameter controls which parts of the+-- transaction are used or ignored to produce the transaction hash. The idea is+-- that if some part of a transaction is not used to produce the transaction+-- hash, then you can change that part of the transaction after producing a+-- signature without invalidating that signature.+--+-- If the 'SIGHASH_ANYONECANPAY' flag is set (true), then only the current input+-- is signed. Otherwise, all of the inputs of a transaction are signed. The+-- default value for 'SIGHASH_ANYONECANPAY' is unset (false).+newtype SigHash =+    SigHash Word32+    deriving ( Eq+             , Ord+             , Bits+             , Enum+             , Integral+             , Num+             , Real+             , Show+             , Read+             , Generic+             , Hashable+             , NFData+             )++instance J.FromJSON SigHash where+    parseJSON =+        J.withScientific "sighash" $+        maybe mzero (return . SigHash) . toBoundedInteger++instance J.ToJSON SigHash where+    toJSON = J.Number . fromIntegral+    toEncoding (SigHash n) = J.toEncoding n++-- | 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'.+isSigHashAll :: SigHash -> Bool+isSigHashAll = (== sigHashAll) . (.&. 0x1f)++-- | 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'.+isSigHashSingle :: SigHash -> Bool+isSigHashSingle = (== sigHashSingle) . (.&. 0x1f)++-- | 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 (SigHash n) = fromIntegral $ n `shiftR` 8++-- | Computes the hash that will be used for signing a transaction.+txSigHash :: Network+          -> Tx      -- ^ transaction to sign+          -> Script  -- ^ script from output being spent+          -> Word64  -- ^ value of output being spent+          -> Int     -- ^ index of input being signed+          -> SigHash -- ^ what to sign+          -> Hash256 -- ^ hash to be signed+txSigHash net tx out v i sh+    | hasForkIdFlag sh && isJust (getSigHashForkId net) =+        txSigHashForkId net tx out v i sh+    | otherwise = do+        let newIn = buildInputs (txIn tx) fout i sh+        -- When SigSingle and input index > outputs, then sign integer 1+        fromMaybe one $ do+            newOut <- buildOutputs (txOut tx) i sh+            let newTx = Tx (txVersion tx) newIn newOut [] (txLockTime tx)+            return $+                doubleSHA256 $+                runPut $ do+                    put newTx+                    putWord32le $ fromIntegral sh+  where+    fout = Script $ filter (/= OP_CODESEPARATOR) $ scriptOps out+    one = "0100000000000000000000000000000000000000000000000000000000000000"++-- | Build transaction inputs for computing sighashes.+buildInputs :: [TxIn] -> Script -> Int -> SigHash -> [TxIn]+buildInputs txins out i sh+    | hasAnyoneCanPayFlag sh =+        [ (txins !! i) { scriptInput = encode out } ]+    | isSigHashAll sh || isSigHashUnknown sh = single+    | otherwise = zipWith noSeq single [0 ..]+  where+    emptyIn = map (\ti -> ti { scriptInput = BS.empty }) txins+    single =+        updateIndex i emptyIn $ \ti -> ti { scriptInput = encode out }+    noSeq ti j =+        if i == j+        then ti+        else ti { txInSequence = 0 }++-- | Build transaction outputs for computing sighashes.+buildOutputs :: [TxOut] -> Int -> SigHash -> Maybe [TxOut]+buildOutputs txos i sh+    | isSigHashAll sh || isSigHashUnknown sh = return txos+    | isSigHashNone sh = return []+    | i >= length txos = Nothing+    | otherwise = return $ buffer ++ [txos !! i]+  where+    buffer = replicate i $ TxOut maxBound BS.empty++-- | Compute the hash that will be used for signing a transaction. This+-- function is used when the 'SIGHASH_FORKID' flag is set.+txSigHashForkId+    :: Network+    -> Tx      -- ^ transaction to sign+    -> Script  -- ^ script from output being spent+    -> Word64  -- ^ value of output being spent+    -> Int     -- ^ index of input being signed+    -> SigHash -- ^ what to sign+    -> Hash256 -- ^ hash to be signed+txSigHashForkId net tx out v i sh =+    doubleSHA256 . runPut $ do+        putWord32le $ txVersion tx+        put hashPrevouts+        put hashSequence+        put $ prevOutput $ txIn tx !! i+        putScript out+        putWord64le v+        putWord32le $ txInSequence $ txIn tx !! i+        put hashOutputs+        putWord32le $ txLockTime tx+        putWord32le $ fromIntegral $ sigHashAddNetworkId net sh+  where+    hashPrevouts+        | not $ hasAnyoneCanPayFlag sh =+            doubleSHA256 $ runPut $ mapM_ (put . prevOutput) $ txIn tx+        | otherwise = zeros+    hashSequence+        | not (hasAnyoneCanPayFlag sh) &&+              not (isSigHashSingle sh) && not (isSigHashNone sh) =+            doubleSHA256 $ runPut $ mapM_ (putWord32le . txInSequence) $ txIn tx+        | otherwise = zeros+    hashOutputs+        | not (isSigHashSingle sh) && not (isSigHashNone sh) =+            doubleSHA256 $ runPut $ mapM_ put $ txOut tx+        | isSigHashSingle sh && i < length (txOut tx) =+            doubleSHA256 $ encode $ txOut tx !! i+        | otherwise = zeros+    putScript s = do+        let encodedScript = encode s+        putVarInt $ BS.length encodedScript+        putByteString encodedScript+    zeros :: Hash256+    zeros = "0000000000000000000000000000000000000000000000000000000000000000"++-- | Data type representing a signature together with a 'SigHash'. The 'SigHash'+-- is serialized as one byte at the end of an ECDSA 'Sig'. All signatures in+-- transaction inputs are of type 'TxSignature'.+data TxSignature+    = TxSignature { txSignature        :: !Sig+                  , txSignatureSigHash :: !SigHash+                  }+    | TxSignatureEmpty+    deriving (Eq, Show, Generic)++instance NFData TxSignature++-- | Serialize a 'TxSignature'.+encodeTxSig :: TxSignature -> ByteString+encodeTxSig TxSignatureEmpty = error "Can not encode an empty signature"+encodeTxSig (TxSignature sig (SigHash n)) =+    runPut $ putSig sig >> putWord8 (fromIntegral n)++-- | 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+            let sh = fromIntegral $ BS.last bs+            when (isSigHashUnknown sh) $+                Left "Non-canonical signature: unknown hashtype byte"+            when (isNothing (getSigHashForkId net) && hasForkIdFlag sh) $+                Left "Non-canonical signature: invalid network for forkId"+            return $ TxSignature sig sh+        Nothing -> Left "Non-canonical signature: could not parse signature"
+ src/Haskoin/Script/Standard.hs view
@@ -0,0 +1,178 @@+{-# LANGUAGE DeriveAnyClass    #-}+{-# LANGUAGE DeriveGeneric     #-}+{-# LANGUAGE OverloadedStrings #-}+{-|+Module      : Haskoin.Script.Standard+Copyright   : No rights reserved+License     : UNLICENSE+Maintainer  : jprupp@protonmail.ch+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 Haskoin.Script.Standard+    ( ScriptInput(..)+    , SimpleInput(..)+    , RedeemScript+    , encodeInput+    , encodeInputBS+    , decodeInput+    , decodeInputBS+    , sortMulSig+    , scriptOpToInt+    , isSpendPK+    , isSpendPKHash+    , isSpendMulSig+    , isScriptHashInput+    ) where++import           Control.Applicative    ((<|>))+import           Control.DeepSeq+import           Control.Monad          (guard, (<=<))+import           Data.ByteString        (ByteString)+import           Data.Function          (on)+import           Data.List              (sortBy)+import           Data.Serialize         (decode, encode)+import           GHC.Generics           (Generic)+import           Haskoin.Constants+import           Haskoin.Keys.Common+import           Haskoin.Script.Common+import           Haskoin.Script.SigHash+import           Haskoin.Util+++-- | Data type describing standard transaction input scripts. Input scripts+-- provide the signing data required to unlock the coins of the output they are+-- trying to spend, except in pay-to-witness-public-key-hash and+-- pay-to-script-hash transactions.+data SimpleInput+      -- | spend pay-to-public-key output+    = 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]+                      -- ^ list of signatures+                   }+    deriving (Eq, Show, Generic, NFData)++-- | Returns true if the input script is spending from a pay-to-public-key+-- output.+isSpendPK :: ScriptInput -> Bool+isSpendPK (RegularInput (SpendPK _)) = True+isSpendPK _                          = False++-- | Returns true if the input script is spending from a pay-to-public-key-hash+-- output.+isSpendPKHash :: ScriptInput -> Bool+isSpendPKHash (RegularInput (SpendPKHash _ _)) = True+isSpendPKHash _                                = False++-- | Returns true if the input script is spending a multisig output.+isSpendMulSig :: ScriptInput -> Bool+isSpendMulSig (RegularInput (SpendMulSig _)) = True+isSpendMulSig _                              = False++-- | Returns true if the input script is spending a pay-to-script-hash output.+isScriptHashInput :: ScriptInput -> Bool+isScriptHashInput (ScriptHashInput _ _) = True+isScriptHashInput _                     = False++-- | A redeem script is the output script serialized into the spending input+-- 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+            -- ^ get wrapped simple input+          }+    | ScriptHashInput+          { getScriptHashInput  :: !SimpleInput+            -- ^ get simple input associated with redeem script+          , getScriptHashRedeem :: !RedeemScript+            -- ^ redeem script+          }+    deriving (Eq, Show, Generic, NFData)++-- | Heuristic to decode an input script into one of the standard types.+decodeSimpleInput :: Network -> Script -> Either String SimpleInput+decodeSimpleInput net (Script ops) =+    maybeToEither errMsg $ matchPK ops <|> matchPKHash ops <|> matchMulSig ops+  where+    matchPK [op] = SpendPK <$> f op+    matchPK _    = Nothing+    matchPKHash [op, OP_PUSHDATA pub _] =+        SpendPKHash <$> f op <*> eitherToMaybe (decode pub)+    matchPKHash _ = Nothing+    matchMulSig (x:xs) = do+        guard $ x == OP_0+        SpendMulSig <$> mapM f xs+    matchMulSig _ = Nothing+    f OP_0                    = return TxSignatureEmpty+    f (OP_PUSHDATA "" OPCODE) = f OP_0+    f (OP_PUSHDATA bs _)      = eitherToMaybe $ decodeTxSig net bs+    f _                       = Nothing+    errMsg = "decodeInput: Could not decode script input"++-- | Heuristic to decode a 'ScriptInput' from a 'Script'. This function fails if+-- the script can not be parsed as a standard script input.+decodeInput :: Network -> Script -> Either String ScriptInput+decodeInput net s@(Script ops) =+    maybeToEither errMsg $ matchSimpleInput <|> matchPayScriptHash+  where+    matchSimpleInput =+        RegularInput <$> eitherToMaybe (decodeSimpleInput net s)+    matchPayScriptHash =+        case splitAt (length (scriptOps s) - 1) ops of+            (is, [OP_PUSHDATA bs _]) -> do+                rdm <- eitherToMaybe $ decodeOutputBS bs+                inp <- eitherToMaybe $ decodeSimpleInput net $ Script is+                return $ ScriptHashInput inp rdm+            _ -> Nothing+    errMsg = "decodeInput: Could not decode script input"++-- | Like 'decodeInput' but decodes directly from a serialized script+-- 'ByteString'.+decodeInputBS :: Network -> ByteString -> Either String ScriptInput+decodeInputBS net = decodeInput net <=< decode++-- | Encode a standard input into a script.+encodeInput :: ScriptInput -> Script+encodeInput s = case s of+    RegularInput ri -> encodeSimpleInput ri+    ScriptHashInput i o -> Script $+        scriptOps (encodeSimpleInput i) ++ [opPushData $ encodeOutputBS o]++-- | Similar to 'encodeInput' but encodes directly to a serialized script+-- 'ByteString'.+encodeInputBS :: ScriptInput -> ByteString+encodeInputBS = encode . encodeInput++-- | Encode a standard 'SimpleInput' into opcodes as an input 'Script'.+encodeSimpleInput :: SimpleInput -> Script+encodeSimpleInput s =+    Script $+    case s of+        SpendPK ts       -> [f ts]+        SpendPKHash ts p -> [f ts, opPushData $ encode p]+        SpendMulSig xs   -> OP_0 : map f xs+  where+    f TxSignatureEmpty = OP_0+    f ts               = opPushData $ encodeTxSig ts++-- | Sort the public keys of a multisig output in ascending order by comparing+-- their compressed serialized representations. Refer to BIP-67.+sortMulSig :: ScriptOutput -> ScriptOutput+sortMulSig out = case out of+    PayMulSig keys r -> PayMulSig (sortBy (compare `on` encode) keys) r+    _ -> error "Can only call orderMulSig on PayMulSig scripts"
+ src/Haskoin/Transaction.hs view
@@ -0,0 +1,24 @@+{-|+Module      : Haskoin.Transaction+Copyright   : No rights reserved+License     : UNLICENSE+Maintainer  : jprupp@protonmail.ch+Stability   : experimental+Portability : POSIX++Transactions and related code.+-}+module Haskoin.Transaction+    ( module Common+    -- * Builder+    , module Builder+    -- * Segwit+    , module Segwit+    -- * Partial+    , module Partial+    ) where++import           Haskoin.Transaction.Builder as Builder+import           Haskoin.Transaction.Common  as Common+import           Haskoin.Transaction.Partial as Partial+import           Haskoin.Transaction.Segwit  as Segwit
+ src/Haskoin/Transaction/Builder.hs view
@@ -0,0 +1,467 @@+{-# LANGUAGE LambdaCase        #-}+{-# LANGUAGE OverloadedStrings #-}+{-|+Module      : Haskoin.Transaction.Builder+Copyright   : No rights reserved+License     : UNLICENSE+Maintainer  : jprupp@protonmail.ch+Stability   : experimental+Portability : POSIX++Code to simplify transaction creation, signing, fee calculation and coin+selection.+-}+module Haskoin.Transaction.Builder+    ( -- * Transaction Creation & Signing+      buildAddrTx+    , buildTx+    , buildInput+    , SigInput(..)+    , signTx+    , signNestedWitnessTx+    , makeSignature+    , signInput+    , signNestedInput+    , verifyStdTx+    , mergeTxs+    , sigKeys+    , mergeTxInput+    , findSigInput+    , verifyStdInput+      -- * Coin Selection+    , Coin(..)+    , chooseCoins+    , chooseCoinsSink+    , chooseMSCoins+    , chooseMSCoinsSink+    , countMulSig+    , greedyAddSink+    , guessTxFee+    , guessMSTxFee+    , guessTxSize+    , guessMSSize+    ) where++import           Control.Applicative              ((<|>))+import           Control.Arrow                    (first)+import           Control.Monad                    (foldM, unless)+import           Control.Monad.Identity           (runIdentity)+import           Crypto.Secp256k1+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           Haskoin.Address+import           Haskoin.Constants+import           Haskoin.Crypto.Hash              (Hash256, addressHash)+import           Haskoin.Crypto.Signature+import           Haskoin.Keys.Common+import           Haskoin.Network.Common+import           Haskoin.Script+import           Haskoin.Transaction.Builder.Sign (SigInput (..), buildInput,+                                                   makeSignature, sigKeys)+import qualified Haskoin.Transaction.Builder.Sign as S+import           Haskoin.Transaction.Common+import           Haskoin.Transaction.Segwit       (decodeWitnessInput, isSegwit,+                                                   viewWitnessProgram)+import           Haskoin.Util++-- | Any type can be used as a Coin if it can provide a value in Satoshi.+-- The value is used in coin selection algorithms.+class Coin c where+    coinValue :: c -> Word64++-- | Coin selection algorithm for normal (non-multisig) transactions. This+-- function returns the selected coins together with the amount of change to+-- send back to yourself, taking the fee into account.+chooseCoins :: Coin c+            => Word64 -- ^ value to send+            -> Word64 -- ^ fee per byte+            -> Int    -- ^ number of outputs (including change)+            -> Bool   -- ^ try to find better solutions+            -> [c]    -- ^ list of ordered coins to choose from+            -> Either String ([c], Word64)+            -- ^ coin selection and change+chooseCoins target fee nOut continue coins =+    runIdentity . runConduit $+    sourceList coins .| chooseCoinsSink target fee nOut continue++-- | Coin selection algorithm for normal (non-multisig) transactions. This+-- function returns the selected coins together with the amount of change to+-- send back to yourself, taking the fee into account. This version uses a Sink+-- for conduit-based coin selection.+chooseCoinsSink :: (Monad m, Coin c)+                => Word64 -- ^ value to send+                -> Word64 -- ^ fee per byte+                -> Int    -- ^ number of outputs (including change)+                -> Bool   -- ^ try to find better solution+                -> ConduitT c Void m (Either String ([c], Word64))+                -- ^ coin selection and change+chooseCoinsSink target fee nOut continue+    | target > 0 =+        maybeToEither err <$>+            greedyAddSink target (guessTxFee fee nOut) continue+    | otherwise = return $ Left "chooseCoins: Target must be > 0"+  where+    err = "chooseCoins: No solution found"++-- | Coin selection algorithm for multisig transactions. This function returns+-- the selected coins together with the amount of change to send back to+-- yourself, taking the fee into account. This function assumes all the coins+-- are script hash outputs that send funds to a multisignature address.+chooseMSCoins :: Coin c+              => Word64     -- ^ value to send+              -> Word64     -- ^ fee per byte+              -> (Int, Int) -- ^ m of n multisig+              -> Int        -- ^ number of outputs (including change)+              -> Bool       -- ^ try to find better solution+              -> [c]+              -> Either String ([c], Word64)+              -- ^ coin selection change amount+chooseMSCoins target fee ms nOut continue coins =+    runIdentity . runConduit $+        sourceList coins .| chooseMSCoinsSink target fee ms nOut continue++-- | Coin selection algorithm for multisig transactions. This function returns+-- the selected coins together with the amount of change to send back to+-- yourself, taking the fee into account. This function assumes all the coins+-- are script hash outputs that send funds to a multisignature address. This+-- version uses a Sink if you need conduit-based coin selection.+chooseMSCoinsSink :: (Monad m, Coin c)+                  => Word64     -- ^ value to send+                  -> Word64     -- ^ fee per byte+                  -> (Int, Int) -- ^ m of n multisig+                  -> Int        -- ^ number of outputs (including change)+                  -> Bool       -- ^ try to find better solution+                  -> ConduitT c Void m (Either String ([c], Word64))+                  -- ^ coin selection and change+chooseMSCoinsSink target fee ms nOut continue+    | target > 0 =+        maybeToEither err <$>+            greedyAddSink target (guessMSTxFee fee ms nOut) continue+    | otherwise = return $ Left "chooseMSCoins: Target must be > 0"+  where+    err = "chooseMSCoins: No solution found"++-- | Select coins greedily by starting from an empty solution. If the 'continue'+-- flag is set, the algorithm will try to find a better solution in the stream+-- after a solution is found. If the next solution found is not strictly better+-- than the previously found solution, the algorithm stops and returns the+-- previous solution. If the continue flag is not set, the algorithm will return+-- the first solution it finds in the stream.+greedyAddSink :: (Monad m, Coin c)+              => Word64          -- ^ value to send+              -> (Int -> Word64) -- ^ coin count to fee function+              -> Bool            -- ^ try to find better solutions+              -> ConduitT c Void m (Maybe ([c], Word64))+              -- ^ coin selection and change+greedyAddSink target guessFee continue =+    go [] 0 [] 0+  where+    -- The goal is the value we must reach (including the fee) for a certain+    -- amount of selected coins.+    goal c = target + guessFee c+    go acc aTot ps pTot = await >>= \case+        -- A coin is available in the stream+        Just coin -> do+            let val = coinValue coin+            -- We have reached the goal using this coin+            if val + aTot >= goal (length acc + 1)+                -- If we want to continue searching for better solutions+                then if continue+                    -- This solution is the first one or+                    -- This solution is better than the previous one+                    then if pTot == 0 || val + aTot < pTot+                        -- Continue searching for better solutions in the stream+                        then go [] 0 (coin:acc) (val + aTot)+                        -- Otherwise, we stop here and return the previous+                        -- solution+                        else return $ Just (ps, pTot - goal (length ps))+                    -- Otherwise, return this solution+                    else return $+                        Just (coin : acc, val + aTot - goal (length acc + 1))+                -- We have not yet reached the goal. Add the coin to the+                -- accumulator+                else go (coin:acc) (val + aTot) ps pTot+        -- We reached the end of the stream+        Nothing ->+            return $ if null ps+                -- If no solution was found, return Nothing+                then Nothing+                -- If we have a solution, return it+                else Just (ps, pTot - goal (length ps))++-- | Estimate tranasction fee to pay based on transaction size estimation.+guessTxFee :: Word64 -> Int -> Int -> Word64+guessTxFee byteFee nOut nIn =+    byteFee * fromIntegral (guessTxSize nIn [] nOut 0)++-- | Same as 'guessTxFee' but for multisig transactions.+guessMSTxFee :: Word64 -> (Int, Int) -> Int -> Int -> Word64+guessMSTxFee byteFee ms nOut nIn =+    byteFee * fromIntegral (guessTxSize 0 (replicate nIn ms) nOut 0)++-- | Computes an upper bound on the size of a transaction based on some known+-- properties of the transaction.+guessTxSize :: Int         -- ^ number of regular transaction inputs+            -> [(Int,Int)] -- ^ multisig m of n for each input+            -> Int         -- ^ number of P2PKH outputs+            -> Int         -- ^ number of P2SH outputs+            -> Int         -- ^ upper bound on transaction size+guessTxSize pki msi pkout msout =+    8 + inpLen + inp + outLen + out+  where+    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)+    out =+        pkout * 34 ++             -- (20: hash160) + (3: opcodes) ++             -- (1: script len) + (8: Word64)+        msout * 32++-- | Size of a multisig P2SH input.+guessMSSize :: (Int,Int) -> Int+guessMSSize (m, n)+    -- OutPoint (36) + Sequence (4) + Script+ = 40 + fromIntegral (B.length $ encode $ VarInt $ fromIntegral scp) + scp+    -- OP_M + n*PubKey + OP_N + OP_CHECKMULTISIG+  where+    rdm =+        fromIntegral $+        B.length $ encode $ opPushData $ B.replicate (n * 34 + 3) 0+    -- Redeem + m*sig + OP_0+    scp = rdm + m * 73 + 1++{- Build a new Tx -}++-- | Build a transaction by providing a list of outpoints as inputs+-- and a list of recipient addresses and amounts as outputs.+buildAddrTx :: Network -> [OutPoint] -> [(Text, Word64)] -> Either String Tx+buildAddrTx net xs ys = buildTx xs =<< mapM f ys+  where+    f (s, v) =+        maybe (Left ("buildAddrTx: Invalid address " ++ cs s)) Right $ do+            a <- stringToAddr net s+            let o = addressToOutput a+            return (o, v)++-- | Build a transaction by providing a list of outpoints as inputs+-- and a list of 'ScriptOutput' and amounts as outputs.+buildTx :: [OutPoint] -> [(ScriptOutput, Word64)] -> Either String Tx+buildTx xs ys =+    mapM fo ys >>= \os -> return $ Tx 1 (map fi xs) os [] 0+  where+    fi outPoint = TxIn outPoint B.empty maxBound+    fo (o, v)+        | v <= 2100000000000000 = return $ TxOut v $ encodeOutputBS o+        | otherwise =+            Left $ "buildTx: Invalid amount " ++ show v++-- | 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+       -> Either String Tx -- ^ signed transaction+signTx net tx si = S.signTx net tx $ notNested <$> si+  where notNested s = (s, False)++-- | 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+    -- 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 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 = S.findInputIndex sigInputOP++{- Merge 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"+    | length (nub emptyTxs) /= 1 = Left "Transactions do not match"+    | length txs == 1 = return $ head txs+    | otherwise = foldM (mergeTxInput net txs) (head emptyTxs) outs+  where+    zipOp = zip (matchTemplate os (txIn $ head txs) f) [0..]+    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 = B.empty })+    clearInput tx (_, i) =+        Tx (txVersion tx) (ins (txIn tx) i) (txOut tx) [] (txLockTime tx)++-- | Merge input from partially-signed multisig transactions.  This function+-- does not support segwit and P2SH-segwit inputs.+mergeTxInput ::+       Network+    -> [Tx]+    -> Tx+    -> ((ScriptOutput, Word64), Int)+    -> Either String Tx+mergeTxInput net txs tx ((so, val), i)+    -- Ignore transactions with empty inputs+ = do+    let ins = map (scriptInput . (!! i) . txIn) txs+    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+    let ins' = updateIndex i (txIn tx) (\ti -> ti {scriptInput = si})+    return $ Tx (txVersion tx) ins' (txOut tx) [] (txLockTime tx)+  where+    go allSigs out rdmM =+        case out of+            PayMulSig msPubs r ->+                let sigs =+                        take r $+                        catMaybes $ matchTemplate allSigs msPubs $ f out+                 in return $ RegularInput $ SpendMulSig sigs+            PayScriptHash _ ->+                case rdmM of+                    Just rdm -> do+                        si <- go allSigs rdm Nothing+                        return $ ScriptHashInput (getRegularInput si) rdm+                    _ -> Left "Invalid output script type"+            _ -> Left "Invalid output script type"+    extractSigs si =+        case decodeInputBS net si of+            Right (RegularInput (SpendMulSig sigs)) -> Right (sigs, Nothing)+            Right (ScriptHashInput (SpendMulSig sigs) rdm) ->+                Right (sigs, Just rdm)+            _ -> Left "Invalid script input type"+    f out (TxSignature x sh) p =+        verifyHashSig+            (txSigHash net tx (encodeOutput out) val i sh)+            x+            (pubKeyPoint p)+    f _ TxSignatureEmpty _ = False++{- Tx verification -}++-- | Verify if a transaction is valid and all of its inputs are standard.+verifyStdTx :: Network -> Tx -> [(ScriptOutput, Word64, OutPoint)] -> Bool+verifyStdTx net tx xs =+    not (null (txIn tx)) && all go (zip (matchTemplate xs (txIn tx) f) [0 ..])+  where+    f (_, _, o) txin = o == prevOutput txin+    go (Just (so, val, _), i) = verifyStdInput net tx i so val+    go _                      = False++-- | Verify if a transaction input is valid and standard.+verifyStdInput :: Network -> Tx -> Int -> ScriptOutput -> Word64 -> Bool+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+    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++    verifyNestedInput so so' x = case so of+        PayScriptHash h -> payToScriptAddress so' == p2shAddr h && verifySegwitInput so' x+        _               -> False++    inp             = scriptInput $ txIn tx !! i+    theTxSigHash so = S.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+    -> Tx+    -> Script+    -> Word64+    -> Int+    -> [PubKey]+    -> [TxSignature]+    -> Int+countMulSig net tx out val i = countMulSig' h+  where+    h = txSigHash net tx out val i++countMulSig' :: (SigHash -> Hash256) -> [PubKey] -> [TxSignature] -> Int+countMulSig' _ [] _ = 0+countMulSig' _ _ [] = 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/Haskoin/Transaction/Builder/Sign.hs view
@@ -0,0 +1,275 @@+{-# LANGUAGE DeriveAnyClass    #-}+{-# LANGUAGE DeriveGeneric     #-}+{-# LANGUAGE LambdaCase        #-}+{-# LANGUAGE OverloadedStrings #-}+{-|+Module      : 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 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, pairs,+                                             parseJSON, (.:), (.:?), (.=))+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           Haskoin.Address            (getAddrHash160, pubKeyAddr)+import           Haskoin.Constants          (Network)+import           Haskoin.Crypto             (Hash256, SecKey)+import           Haskoin.Crypto.Signature   (signHash, verifyHashSig)+import           Haskoin.Keys.Common        (PubKeyI (..), SecKeyI (..),+                                             derivePubKeyI, wrapSecKey)+import           Haskoin.Script.Common      (ScriptOutput (..), encodeOutput,+                                             encodeOutputBS, opPushData)+import           Haskoin.Script.SigHash     (SigHash, TxSignature (..),+                                             decodeTxSig, txSigHash,+                                             txSigHashForkId)+import           Haskoin.Script.Standard    (RedeemScript, ScriptInput (..),+                                             SimpleInput (..), decodeInputBS,+                                             encodeInputBS)+import           Haskoin.Transaction.Common (OutPoint, Tx (..), TxIn (..),+                                             WitnessData)+import           Haskoin.Transaction.Segwit (WitnessProgram (..),+                                             calcWitnessProgram, isSegwit,+                                             toWitnessStack)+import           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 ]+    toEncoding (SigInput so val op sh rdm) = pairs $+        "pkscript" .= so+        <> "value"    .= val+        <> "outpoint" .= op+        <> "sighash"  .= sh+        <> (case rdm of Nothing -> mempty+                        Just r  -> "redeem" .= r)++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 _ _ 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/Haskoin/Transaction/Common.hs view
@@ -0,0 +1,312 @@+{-# LANGUAGE DeriveAnyClass    #-}+{-# LANGUAGE DeriveGeneric     #-}+{-# LANGUAGE OverloadedStrings #-}+{-|+Module      : Haskoin.Transaction.Common+Copyright   : No rights reserved+License     : UNLICENSE+Maintainer  : jprupp@protonmail.ch+Stability   : experimental+Portability : POSIX++Code related to transactions parsing and serialization.+-}+module Haskoin.Transaction.Common+    ( Tx(..)+    , TxIn(..)+    , TxOut(..)+    , OutPoint(..)+    , TxHash(..)+    , WitnessData+    , WitnessStack+    , WitnessStackItem+    , txHash+    , hexToTxHash+    , txHashToHex+    , nosigTxHash+    , nullOutPoint+    , genesisTx+    ) where++import           Control.Applicative     ((<|>))+import           Control.DeepSeq+import           Control.Monad           (forM_, guard, liftM2, mzero,+                                          replicateM, (<=<))+import           Data.Aeson              as A+import           Data.Aeson.Encoding     (unsafeToEncoding)+import           Data.ByteString         (ByteString)+import qualified Data.ByteString         as B+import           Data.ByteString.Builder (char7)+import           Data.Hashable           (Hashable)+import           Data.Maybe              (fromMaybe)+import           Data.Serialize          as S+import           Data.String             (IsString, fromString)+import           Data.String.Conversions (cs)+import           Data.Text               (Text)+import           Data.Word               (Word32, Word64)+import           GHC.Generics            (Generic)+import           Haskoin.Crypto.Hash+import           Haskoin.Network.Common+import           Haskoin.Script.Common+import           Haskoin.Util+import           Text.Read               as R++-- | Transaction id: hash of transaction excluding witness data.+newtype TxHash = TxHash { getTxHash :: Hash256 }+    deriving (Eq, Ord, Generic, Hashable, Serialize, NFData)++instance Show TxHash where+    showsPrec _ = shows . txHashToHex++instance Read TxHash where+    readPrec = do+        R.String str <- R.lexP+        maybe R.pfail return $ hexToTxHash $ cs str++instance IsString TxHash where+    fromString s =+        let e = error "Could not read transaction hash from hex string"+        in fromMaybe e $ hexToTxHash $ cs s++instance FromJSON TxHash where+    parseJSON = withText "txid" $+        maybe mzero return . hexToTxHash++instance ToJSON TxHash where+    toJSON = A.String . txHashToHex+    toEncoding (TxHash h) =+        unsafeToEncoding $+        char7 '"' <> hexBuilder (B.reverse (S.encode h)) <> char7 '"'++-- | Transaction hash excluding signatures.+nosigTxHash :: Tx -> TxHash+nosigTxHash tx =+    TxHash $ doubleSHA256 $ S.encode tx { txIn = map clearInput $ txIn tx }+  where+    clearInput ti = ti { scriptInput = B.empty }++-- | Convert transaction hash to hex form, reversing bytes.+txHashToHex :: TxHash -> Text+txHashToHex (TxHash h) = encodeHex (B.reverse (S.encode h))++-- | Convert transaction hash from hex, reversing bytes.+hexToTxHash :: Text -> Maybe TxHash+hexToTxHash hex = do+    bs <- B.reverse <$> decodeHex hex+    h <- either (const Nothing) Just (S.decode bs)+    return $ TxHash h++-- | Witness stack for SegWit transactions.+type WitnessData = [WitnessStack]+-- | Witness stack for SegWit transactions.+type WitnessStack = [WitnessStackItem]+-- | Witness stack item for SegWit transactions.+type WitnessStackItem = ByteString++-- | Data type representing a transaction.+data Tx = Tx+    { -- | transaction data format version+      txVersion  :: !Word32+      -- | list of transaction inputs+    , txIn       :: ![TxIn]+      -- | list of transaction outputs+    , txOut      :: ![TxOut]+      -- | witness data for the transaction+    , txWitness  :: !WitnessData+      -- | earliest mining height or time+    , txLockTime :: !Word32+    } deriving (Show, Read, Eq, Ord, Generic, Hashable, NFData)++-- | Compute transaction hash.+txHash :: Tx -> TxHash+txHash tx = TxHash (doubleSHA256 (S.encode tx {txWitness = []}))++instance IsString Tx where+    fromString =+        fromMaybe e . (eitherToMaybe . S.decode <=< decodeHex) . cs+      where+        e = error "Could not read transaction from hex string"++instance Serialize Tx where+    get = parseWitnessTx <|> parseLegacyTx+    put tx+        | null (txWitness tx) = putLegacyTx tx+        | otherwise = putWitnessTx tx++putInOut :: Tx -> Put+putInOut tx = do+    putVarInt $ length (txIn tx)+    forM_ (txIn tx) put+    putVarInt $ length (txOut tx)+    forM_ (txOut tx) put++-- | Non-SegWit transaction serializer.+putLegacyTx :: Tx -> Put+putLegacyTx tx = do+    putWord32le (txVersion tx)+    putInOut tx+    putWord32le (txLockTime tx)++-- | Witness transaciton serializer.+putWitnessTx :: Tx -> Put+putWitnessTx tx = do+    putWord32le (txVersion tx)+    putWord8 0x00+    putWord8 0x01+    putInOut tx+    putWitnessData (txWitness tx)+    putWord32le (txLockTime tx)++-- | Non-SegWit transaction deseralizer.+parseLegacyTx :: Get Tx+parseLegacyTx = do+    v <- getWord32le+    is <- replicateList =<< S.get+    os <- replicateList =<< S.get+    l <- getWord32le+    return+        Tx+        {txVersion = v, txIn = is, txOut = os, txWitness = [], txLockTime = l}+  where+    replicateList (VarInt c) = replicateM (fromIntegral c) S.get++-- | Witness transaction deserializer.+parseWitnessTx :: Get Tx+parseWitnessTx = do+    v <- getWord32le+    m <- getWord8+    f <- getWord8+    guard $ m == 0x00+    guard $ f == 0x01+    is <- replicateList =<< S.get+    os <- replicateList =<< S.get+    w <- parseWitnessData $ length is+    l <- getWord32le+    return+        Tx {txVersion = v, txIn = is, txOut = os, txWitness = w, txLockTime = l}+  where+    replicateList (VarInt c) = replicateM (fromIntegral c) S.get++-- | Witness data deserializer. Requires count of inputs.+parseWitnessData :: Int -> Get WitnessData+parseWitnessData n = replicateM n parseWitnessStack+  where+    parseWitnessStack = do+        VarInt i <- S.get+        replicateM (fromIntegral i) parseWitnessStackItem+    parseWitnessStackItem = do+        VarInt i <- S.get+        getByteString $ fromIntegral i++-- | Witness data serializer.+putWitnessData :: WitnessData -> Put+putWitnessData = mapM_ putWitnessStack+  where+    putWitnessStack ws = do+        putVarInt $ length ws+        mapM_ putWitnessStackItem ws+    putWitnessStackItem bs = do+        putVarInt $ B.length bs+        putByteString bs++instance FromJSON Tx where+    parseJSON = withText "Tx" $+        maybe mzero return . (eitherToMaybe . S.decode <=< decodeHex)++instance ToJSON Tx where+    toJSON = A.String . encodeHex . S.encode+    toEncoding tx =+        unsafeToEncoding $ char7 '"' <> hexBuilder (S.encode tx) <> char7 '"'++-- | Data type representing a transaction input.+data TxIn =+    TxIn {+           -- | output being spent+           prevOutput   :: !OutPoint+           -- | signatures and redeem script+         , scriptInput  :: !ByteString+           -- | lock-time using sequence numbers (BIP-68)+         , txInSequence :: !Word32+         } deriving (Eq, Show, Read, Ord, Generic, Hashable, NFData)++instance Serialize TxIn where+    get =+        TxIn <$> S.get <*> (readBS =<< S.get) <*> getWord32le+      where+        readBS (VarInt len) = getByteString $ fromIntegral len++    put (TxIn o s q) = do+        put o+        putVarInt $ B.length s+        putByteString s+        putWord32le q++-- | Data type representing a transaction output.+data TxOut =+    TxOut {+            -- | value of output is satoshi+            outValue     :: !Word64+            -- | pubkey script+          , scriptOutput :: !ByteString+          } deriving (Eq, Show, Read, Ord, Generic, Hashable, NFData)++instance Serialize TxOut where+    get = do+        val <- getWord64le+        (VarInt len) <- S.get+        TxOut val <$> getByteString (fromIntegral len)++    put (TxOut o s) = do+        putWord64le o+        putVarInt $ B.length s+        putByteString s++-- | The 'OutPoint' refers to a transaction output being spent.+data OutPoint = OutPoint+    { -- | hash of previous transaction+      outPointHash  :: !TxHash+      -- | position of output in previous transaction+    , outPointIndex :: !Word32+    } deriving (Show, Read, Eq, Ord, Generic, Hashable, NFData)++instance FromJSON OutPoint where+    parseJSON = withText "OutPoint" $+        maybe mzero return . (eitherToMaybe . S.decode <=< decodeHex)++instance ToJSON OutPoint where+    toJSON = A.String . encodeHex . S.encode+    toEncoding op =+        unsafeToEncoding $ char7 '"' <> hexBuilder (S.encode op) <> char7 '"'++instance Serialize OutPoint where+    get = do+        (h,i) <- liftM2 (,) S.get getWord32le+        return $ OutPoint h i+    put (OutPoint h i) = put h >> putWord32le i++-- | Outpoint used in coinbase transactions.+nullOutPoint :: OutPoint+nullOutPoint =+    OutPoint+    { outPointHash =+          "0000000000000000000000000000000000000000000000000000000000000000"+    , outPointIndex = maxBound+    }++-- | Transaction from Genesis block.+genesisTx :: Tx+genesisTx =+    Tx 1 [txin] [txout] [] locktime+  where+    txin = TxIn outpoint inputBS maxBound+    txout = TxOut 5000000000 (encodeOutputBS output)+    locktime = 0+    outpoint = OutPoint z maxBound+    Just inputBS = decodeHex $ fromString $+        "04ffff001d0104455468652054696d65732030332f4a616e2f323030392043686" +++        "16e63656c6c6f72206f6e206272696e6b206f66207365636f6e64206261696c6f" +++        "757420666f722062616e6b73"+    output = PayPK $ fromString $+        "04678afdb0fe5548271967f1a67130b7105cd6a828e03909a67962e0ea1f61deb" +++        "649f6bc3f4cef38c4f35504e51ec112de5c384df7ba0b8d578a4c702b6bf11d5f"+    z = "0000000000000000000000000000000000000000000000000000000000000000"
+ src/Haskoin/Transaction/Partial.hs view
@@ -0,0 +1,500 @@+{-# LANGUAGE DeriveGeneric              #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE NamedFieldPuns             #-}+{-# LANGUAGE OverloadedStrings          #-}+{-# LANGUAGE ScopedTypeVariables        #-}+{-|+Module      : Haskoin.Transaction.Partial+Copyright   : No rights reserved+License     : UNLICENSE+Maintainer  : matt@bitnomial.com+Stability   : experimental+Portability : POSIX++Code related to PSBT parsing and serialization.+-}+module Haskoin.Transaction.Partial+    ( PartiallySignedTransaction (..)+    , Input (..)+    , Output (..)+    , UnknownMap (..)+    , Key (..)+    , merge+    , mergeInput+    , mergeOutput+    , complete+    , finalTransaction+    , emptyPSBT+    , emptyInput+    , emptyOutput+    ) where++import           Control.Applicative        ((<|>))+import           Control.DeepSeq+import           Control.Monad              (guard, replicateM, void)+import           Data.ByteString            (ByteString)+import qualified Data.ByteString            as B+import           Data.Hashable              (Hashable)+import           Data.HashMap.Strict        (HashMap)+import qualified Data.HashMap.Strict        as HashMap+import           Data.List                  (foldl')+import           Data.Maybe                 (fromMaybe, isJust)+import           Data.Serialize             as S+import           GHC.Generics               (Generic)+import           GHC.Word                   (Word32, Word8)+import           Haskoin.Address            (Address (..), pubKeyAddr)+import           Haskoin.Keys               (Fingerprint, KeyIndex, PubKeyI)+import           Haskoin.Network            (VarInt (..), VarString (..),+                                             putVarInt)+import           Haskoin.Script             (Script (..), ScriptOp (..),+                                             ScriptOutput (..), SigHash,+                                             decodeOutput, decodeOutputBS,+                                             encodeOutputBS, isPayScriptHash,+                                             opPushData, toP2SH, toP2WSH)+import           Haskoin.Transaction.Common (Tx (..), TxOut, WitnessStack,+                                             outPointIndex, prevOutput,+                                             scriptInput, scriptOutput)+import           Haskoin.Util               (eitherToMaybe)++-- | PSBT data type as specified in+-- [BIP-174](https://github.com/bitcoin/bips/blob/master/bip-0174.mediawiki).+-- This contains an unsigned transaction, inputs and outputs, and unspecified+-- extra data. There is one input per input in the unsigned transaction, and one+-- output per output in the unsigned transaction. The inputs and outputs in the+-- 'PartiallySignedTransaction' line up by index with the inputs and outputs in+-- the unsigned transaction.+data PartiallySignedTransaction = PartiallySignedTransaction+    { unsignedTransaction :: Tx+    , globalUnknown       :: UnknownMap+    , inputs              :: [Input]+    , outputs             :: [Output]+    } deriving (Show, Eq, Generic)++instance NFData PartiallySignedTransaction++-- | Inputs contain all of the data needed to sign a transaction and all of the+-- resulting signature data after signing.+data Input = Input+    { nonWitnessUtxo     :: Maybe Tx+    , witnessUtxo        :: Maybe TxOut+    , partialSigs        :: HashMap PubKeyI ByteString+    , sigHashType        :: Maybe SigHash+    , inputRedeemScript  :: Maybe Script+    , inputWitnessScript :: Maybe Script+    , inputHDKeypaths    :: HashMap PubKeyI (Fingerprint, [KeyIndex])+    , finalScriptSig     :: Maybe Script+    , finalScriptWitness :: Maybe WitnessStack+    , inputUnknown       :: UnknownMap+    } deriving (Show, Eq, Generic)++instance NFData Input++-- | Outputs can contain information needed to spend the output at a later date.+data Output = Output+    { outputRedeemScript  :: Maybe Script+    , outputWitnessScript :: Maybe Script+    , outputHDKeypaths    :: HashMap PubKeyI (Fingerprint, [KeyIndex])+    , outputUnknown       :: UnknownMap+    } deriving (Show, Eq, Generic)++instance NFData Output++-- | A map of raw PSBT keys to byte strings for extra data. The 'keyType' field cannot overlap with any of the reserved+-- 'keyType' fields specified in the PSBT specification.+newtype UnknownMap = UnknownMap { unknownMap :: HashMap Key ByteString }+    deriving (Show, Eq, Semigroup, Monoid, Generic)++instance NFData UnknownMap++-- | Raw keys for the map type used in PSBTs.+data Key = Key+    { keyType :: Word8+    , key     :: ByteString+    } deriving (Show, Eq, Generic)++instance NFData Key++instance Hashable Key++-- | Take two 'PartiallySignedTransaction's and merge them. The 'unsignedTransaction' field in both must be the same.+merge :: PartiallySignedTransaction -> PartiallySignedTransaction -> Maybe PartiallySignedTransaction+merge psbt1 psbt2+    | unsignedTransaction psbt1 == unsignedTransaction psbt2+    = Just $ psbt1+        { globalUnknown = globalUnknown psbt1 <> globalUnknown psbt2+        , inputs = zipWith mergeInput (inputs psbt1) (inputs psbt2)+        , outputs = zipWith mergeOutput (outputs psbt1) (outputs psbt2)+        }+merge _ _ = Nothing++mergeInput :: Input -> Input -> Input+mergeInput a b = Input+    { nonWitnessUtxo = if isJust witUtx then Nothing else nonWitnessUtxo a <|> nonWitnessUtxo b+    , witnessUtxo = witUtx+    , sigHashType = sigHashType a <|> sigHashType b+    , partialSigs = partialSigs a <> partialSigs b+    , inputHDKeypaths = inputHDKeypaths a <> inputHDKeypaths b+    , inputUnknown = inputUnknown a <> inputUnknown b+    , inputRedeemScript = inputRedeemScript a <|> inputRedeemScript b+    , inputWitnessScript = inputWitnessScript a <|> inputWitnessScript b+    , finalScriptSig = finalScriptSig a <|> finalScriptSig b+    , finalScriptWitness = finalScriptWitness a <|> finalScriptWitness b+    }+  where+    witUtx = witnessUtxo a <|> witnessUtxo b++mergeOutput :: Output -> Output -> Output+mergeOutput a b = Output+    { outputRedeemScript = outputRedeemScript a <|> outputRedeemScript b+    , outputWitnessScript = outputWitnessScript a <|> outputWitnessScript b+    , outputHDKeypaths = outputHDKeypaths a <> outputHDKeypaths b+    , outputUnknown = outputUnknown a <> outputUnknown b+    }++-- | Take partial signatures from all of the 'Input's and finalize the signature.+complete :: PartiallySignedTransaction -> PartiallySignedTransaction+complete psbt = psbt { inputs = map (completeInput . analyzeInputs) (indexed $ inputs psbt) }+  where+    analyzeInputs (i, input) = (outputScript =<< witnessUtxo input <|> nonWitScript, input)+      where+        nonWitScript = getPrevOut i =<< nonWitnessUtxo input++    getPrevOut i tx =+       (txOut tx !!?) . fromIntegral . outPointIndex . prevOutput =<< txIn (unsignedTransaction psbt) !!? i+    xs !!? i = lookup i $ indexed xs++    outputScript = eitherToMaybe . decodeOutputBS . scriptOutput++    completeInput (Nothing, input)     = input+    completeInput (Just script, input) = completeSig input script++    indexed :: [a] -> [(Word32, a)]+    indexed = zip [0..]++completeSig :: Input -> ScriptOutput -> Input+completeSig input (PayPK k) =+    input { finalScriptSig = eitherToMaybe . S.decode =<< HashMap.lookup k (partialSigs input) }+completeSig input (PayPKHash h)+    | [(k, sig)] <- HashMap.toList $ partialSigs input+    , PubKeyAddress h == pubKeyAddr k+    = input { finalScriptSig = Just $ Script [opPushData sig, opPushData (S.encode k)] }+completeSig input (PayMulSig pubKeys m) | length sigs >= m = input { finalScriptSig = finalSig }+  where+    sigs = collectSigs m pubKeys input+    finalSig = Script . (OP_0 :) . (map opPushData sigs <>) . pure . opPushData . S.encode <$> inputRedeemScript input+completeSig input (PayScriptHash h)+    | Just rdmScript <- inputRedeemScript input+    , PayScriptHash h == toP2SH rdmScript+    , Right decodedScript <- decodeOutput rdmScript+    , not (isPayScriptHash decodedScript)+    = completeSig input decodedScript+completeSig input (PayWitnessPKHash h)+    | [(k, sig)] <- HashMap.toList $ partialSigs input+    , PubKeyAddress h == pubKeyAddr k+    = input { finalScriptWitness = Just [sig, S.encode k]+            , finalScriptSig = Script . pure . opPushData . S.encode <$> inputRedeemScript input+            }+completeSig input (PayWitnessScriptHash h)+    | Just witScript <- inputWitnessScript input+    , PayWitnessScriptHash h == toP2WSH witScript+    , Right decodedScript <- decodeOutput witScript+    = completeWitnessSig input decodedScript+completeSig input _ = input++completeWitnessSig :: Input -> ScriptOutput -> Input+completeWitnessSig input script@(PayMulSig pubKeys m) | length sigs >= m = input+    { finalScriptWitness = Just finalWit+    , finalScriptSig = finalSig+    }+  where+    sigs = collectSigs m pubKeys input+    finalSig = Script . pure . opPushData . S.encode <$> inputRedeemScript input+    finalWit = mempty : sigs <> [encodeOutputBS script]+completeWitnessSig input _ = input++collectSigs :: Int -> [PubKeyI] -> Input -> [ByteString]+collectSigs m pubKeys input = take m . reverse $ foldl' lookupKey [] pubKeys+  where+    lookupKey sigs key = maybe sigs (:sigs) $ HashMap.lookup key (partialSigs input)++-- | Take a finalized 'PartiallySignedTransaction' and produce the signed final transaction.  You may need to call+-- 'complete' on the 'PartiallySignedTransaction' before producing the final transaction.+finalTransaction :: PartiallySignedTransaction -> Tx+finalTransaction psbt = setInputs . foldl' finalizeInput ([], []) $ zip (txIn tx) (inputs psbt)+  where+    tx = unsignedTransaction psbt+    hasWitness = any (isJust . finalScriptWitness) (inputs psbt)+    setInputs (ins, witData) = tx { txIn = reverse ins, txWitness = if hasWitness then reverse witData else [] }+    finalizeInput (ins, witData) (txInput, psbtInput) = maybe finalWitness finalScript $ finalScriptSig psbtInput+      where+        finalScript script = (txInput { scriptInput = encode script }:ins, []:witData)+        finalWitness = (ins, fromMaybe [] (finalScriptWitness psbtInput):witData)++-- | Take an unsigned transaction and produce an empty 'PartiallySignedTransaction'+emptyPSBT :: Tx -> PartiallySignedTransaction+emptyPSBT tx = PartiallySignedTransaction+    { unsignedTransaction = tx+    , globalUnknown = mempty+    , inputs = replicate (length (txIn tx)) emptyInput+    , outputs = replicate (length (txOut tx)) emptyOutput+    }++emptyInput :: Input+emptyInput = Input+    Nothing Nothing HashMap.empty Nothing+    Nothing Nothing HashMap.empty+    Nothing Nothing (UnknownMap HashMap.empty)++emptyOutput :: Output+emptyOutput = Output Nothing Nothing HashMap.empty (UnknownMap HashMap.empty)++instance Serialize PartiallySignedTransaction where+    get = do+        magic <- getBytes 4+        guard $ magic == "psbt"+        headerSep <- getWord8+        guard $ headerSep == 0xff++        keySize <- getWord8+        guard $ keySize == 1+        globalUnsignedTxType <- getWord8+        guard $ globalUnsignedTxType == 0x00+        unsignedTransaction <- getSizedBytes+        guard $ all (B.null . scriptInput) (txIn unsignedTransaction)+        guard $ null (txWitness unsignedTransaction)++        globalUnknown <- get+        globalEnd <- getWord8+        guard $ globalEnd == 0x00++        inputs <- replicateM (length $ txIn unsignedTransaction) get+        outputs <- replicateM (length $ txOut unsignedTransaction) get++        return PartiallySignedTransaction { unsignedTransaction, globalUnknown, inputs, outputs }++    put PartiallySignedTransaction{ unsignedTransaction, globalUnknown, inputs, outputs } = do+        putByteString "psbt"+        putWord8 0xff -- Header separator++        putWord8 0x01 -- Key size+        putWord8 0x00 -- Unsigned Transaction type+        putSizedBytes unsignedTransaction+        put globalUnknown+        putWord8 0x00 -- Global end++        mapM_ put inputs+        mapM_ put outputs++instance Serialize Key where+    get = do+        VarInt keySize <- get+        guard $ keySize > 0+        t <- getWord8+        k <- getBytes (fromIntegral keySize - 1)+        return (Key t k)++    put (Key t k) = do+        putVarInt $ 1 + B.length k+        putWord8 t+        putByteString k++instance Serialize UnknownMap where+    get = go HashMap.empty+      where+        getItem m = do+            k <- get+            VarString v <- get+            go $ HashMap.insert k v m+        go m = do+            isEnd <- lookAhead getWord8+            if isEnd == 0x00+                then return (UnknownMap m)+                else getItem m++    put (UnknownMap m) = void $ HashMap.traverseWithKey (\k v -> put k >> put (VarString v)) m++instance Serialize Input where+    get = getMap getInputItem setInputUnknown emptyInput+      where+        setInputUnknown f input = input { inputUnknown = UnknownMap $ f (unknownMap $ inputUnknown input) }++    put Input { nonWitnessUtxo, witnessUtxo, partialSigs, sigHashType+                  , inputRedeemScript, inputWitnessScript, inputHDKeypaths+                  , finalScriptSig, finalScriptWitness, inputUnknown+                  } = do+        whenJust (putKeyValue InNonWitnessUtxo) nonWitnessUtxo+        whenJust (putKeyValue InWitnessUtxo) witnessUtxo+        putPartialSig partialSigs+        whenJust putSigHash sigHashType+        whenJust (putKeyValue InRedeemScript) inputRedeemScript+        whenJust (putKeyValue InWitnessScript) inputWitnessScript+        putHDPath InBIP32Derivation inputHDKeypaths+        whenJust (putKeyValue InFinalScriptSig) finalScriptSig+        whenJust (putKeyValue InFinalScriptWitness) finalScriptWitness+        put inputUnknown+        putWord8 0x00+      where+        putPartialSig = putPubKeyMap InPartialSig . fmap VarString+        putSigHash sigHash = do+            putKey InSigHashType+            putWord8 0x04+            putWord32le (fromIntegral sigHash)++instance Serialize Output where+    get = getMap getOutputItem setOutputUnknown emptyOutput+      where+        setOutputUnknown f output = output { outputUnknown = UnknownMap $ f (unknownMap $ outputUnknown output) }++    put Output{ outputRedeemScript, outputWitnessScript, outputHDKeypaths, outputUnknown } = do+        whenJust (putKeyValue OutRedeemScript) outputRedeemScript+        whenJust (putKeyValue OutWitnessScript) outputWitnessScript+        putHDPath OutBIP32Derivation outputHDKeypaths+        put outputUnknown+        putWord8 0x00++putSizedBytes :: Serialize a => a -> Put+putSizedBytes a = putVarInt (B.length bs) >> putByteString bs+  where bs = encode a++getSizedBytes :: Serialize a => Get a+getSizedBytes = getNested (fromIntegral . getVarInt <$> get) get++putKeyValue :: (Enum t, Serialize v) => t -> v -> Put+putKeyValue t v = putKey t >> putSizedBytes v++putKey :: Enum t => t -> Put+putKey t = putVarInt (1 :: Word8) >> putWord8 (enumWord8 t)++getMap :: (Bounded t, Enum t)+       => (Int -> a -> t -> Get a)+       -> ((HashMap Key ByteString -> HashMap Key ByteString) -> a -> a)+       -> a -> Get a+getMap getMapItem setUnknown = go+  where+    getItem keySize m (Right t) = getMapItem (fromIntegral keySize - 1) m t >>= go+    getItem keySize m (Left t)  = do+        k <- getBytes (fromIntegral keySize - 1)+        VarString v <- get+        go $ setUnknown (HashMap.insert (Key t k) v) m+    go m = do+        keySize <- getVarInt <$> get+        if keySize == 0+            then return m+            else getItem keySize m =<< (word8Enum <$> getWord8)++data InputType+    = InNonWitnessUtxo+    | InWitnessUtxo+    | InPartialSig+    | InSigHashType+    | InRedeemScript+    | InWitnessScript+    | InBIP32Derivation+    | InFinalScriptSig+    | InFinalScriptWitness+    deriving (Show, Eq, Enum, Bounded, Generic)++instance NFData InputType++data OutputType+    = OutRedeemScript+    | OutWitnessScript+    | OutBIP32Derivation+    deriving (Show, Eq, Enum, Bounded, Generic)++instance NFData OutputType++getInputItem :: Int -> Input -> InputType -> Get Input+getInputItem 0 input@Input{nonWitnessUtxo = Nothing} InNonWitnessUtxo = do+    utxo <- getSizedBytes+    return $ input { nonWitnessUtxo = Just utxo }+getInputItem 0 input@Input{witnessUtxo = Nothing} InWitnessUtxo = do+    utxo <- getSizedBytes+    return $ input { witnessUtxo = Just utxo }+getInputItem keySize input InPartialSig = do+    (k, v) <- getPartialSig+    return $ input { partialSigs = HashMap.insert k v (partialSigs input) }+  where+    getPartialSig = (,) <$> isolate keySize get <*> (getVarString <$> get)+getInputItem 0 input@Input{sigHashType = Nothing} InSigHashType = do+    VarInt size <- get+    guard $ size == 0x04+    sigHash <- fromIntegral <$> getWord32le+    return $ input { sigHashType = Just sigHash }+getInputItem 0 input@Input{inputRedeemScript = Nothing} InRedeemScript = do+    script <- getSizedBytes+    return $ input { inputRedeemScript = Just script }+getInputItem 0 input@Input{inputWitnessScript = Nothing} InWitnessScript = do+    script <- getSizedBytes+    return $ input { inputWitnessScript = Just script }+getInputItem keySize input InBIP32Derivation = do+    (k, v) <- getHDPath keySize+    return $ input { inputHDKeypaths = HashMap.insert k v (inputHDKeypaths input) }+getInputItem 0 input@Input{finalScriptSig = Nothing} InFinalScriptSig = do+    script <- getSizedBytes+    return $ input { finalScriptSig = Just script }+getInputItem 0 input@Input{finalScriptWitness = Nothing} InFinalScriptWitness = do+    scripts <- map getVarString <$> getVarIntList+    return $ input { finalScriptWitness = Just scripts }+  where+    getVarIntList = do+        VarInt n <- get+        replicateM (fromIntegral n) get+getInputItem keySize input inputType = fail $+    "Incorrect key size for input item or item already existed: " <>+    show (keySize, input, inputType)++getOutputItem :: Int -> Output -> OutputType -> Get Output+getOutputItem 0 output@Output{outputRedeemScript = Nothing} OutRedeemScript = do+    script <- getSizedBytes+    return $ output { outputRedeemScript = Just script }+getOutputItem 0 output@Output{outputWitnessScript = Nothing} OutWitnessScript = do+    script <- getSizedBytes+    return $ output { outputWitnessScript = Just script }+getOutputItem keySize output OutBIP32Derivation = do+    (k, v) <- getHDPath keySize+    return $ output { outputHDKeypaths = HashMap.insert k v (outputHDKeypaths output) }+getOutputItem keySize output outputType = fail $+    "Incorrect key size for output item or item already existed: " <>+    show (keySize, output, outputType)++getHDPath :: Int -> Get (PubKeyI, (Fingerprint, [KeyIndex]))+getHDPath keySize = (,) <$> isolate keySize get <*> (unPSBTHDPath <$> get)++putHDPath :: Enum t => t -> HashMap PubKeyI (Fingerprint, [KeyIndex]) -> Put+putHDPath t = putPubKeyMap t . fmap PSBTHDPath++newtype PSBTHDPath = PSBTHDPath { unPSBTHDPath :: (Fingerprint, [KeyIndex]) }+    deriving (Show, Eq, Generic)++instance NFData PSBTHDPath++instance Serialize PSBTHDPath where+    get = do+        VarInt valueSize <- get+        guard $ valueSize `mod` 4 == 0+        let numIndices = (fromIntegral valueSize - 4) `div` 4+        PSBTHDPath <$>+            isolate+                (fromIntegral valueSize)+                ((,) <$> getWord32le <*> getKeyIndexList numIndices)+      where+        getKeyIndexList n = replicateM n getWord32le+    put (PSBTHDPath (fp, kis)) = putVarInt (B.length bs) >> putByteString bs+      where+        bs = runPut $ putWord32le fp >> mapM_ putWord32le kis++putPubKeyMap :: (Serialize a, Enum t) => t -> HashMap PubKeyI a -> Put+putPubKeyMap t = void . HashMap.traverseWithKey putItem+  where+    putItem k v = put (Key (enumWord8 t) (encode k)) >> put v++enumWord8 :: Enum a => a -> Word8+enumWord8 = fromIntegral . fromEnum++word8Enum :: forall a. (Bounded a, Enum a) => Word8 -> Either Word8 a+word8Enum n | n <= enumWord8 (maxBound :: a) = Right . toEnum $ fromIntegral n+word8Enum n = Left n++whenJust :: Monad m => (a -> m ()) -> Maybe a -> m ()+whenJust = maybe (return ())
+ src/Haskoin/Transaction/Segwit.hs view
@@ -0,0 +1,139 @@+{-# LANGUAGE LambdaCase        #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TupleSections     #-}+{-|+Module      : 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 Haskoin.Transaction.Segwit+    ( WitnessProgram (..)+    , WitnessProgramPKH (..)+    , WitnessProgramSH (..)+    , isSegwit++    , viewWitnessProgram+    , decodeWitnessInput++    , calcWitnessProgram+    , simpleInputStack+    , toWitnessStack+    ) where++import           Data.ByteString            (ByteString)+import qualified Data.Serialize             as S+import           Haskoin.Constants          (Network)+import           Haskoin.Keys.Common        (PubKeyI)+import           Haskoin.Script.Common      (Script (..), ScriptOutput (..),+                                             decodeOutput, encodeOutput)+import           Haskoin.Script.SigHash     (TxSignature (..), decodeTxSig,+                                             encodeTxSig)+import           Haskoin.Script.Standard    (ScriptInput (..), SimpleInput (..))+import           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 _, [sigBS]) ->+                SpendPK <$> decodeTxSig net sigBS+            (PayPKHash _, [sigBS, keyBS]) ->+                SpendPKHash <$> decodeTxSig net sigBS <*> S.decode keyBS+            (PayMulSig _ _, "" : 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/Haskoin/Util.hs view
@@ -0,0 +1,202 @@+{-# LANGUAGE MultiParamTypeClasses #-}+{-|+Module      : Haskoin.Util+Copyright   : No rights reserved+License     : UNLICENSE+Maintainer  : jprupp@protonmail.ch+Stability   : experimental+Portability : POSIX++This module defines various utility functions used across the library.+-}+module Haskoin.Util+    (+      -- * ByteString Helpers+      bsToInteger+    , integerToBS+    , hexBuilder+    , encodeHex+    , decodeHex+    , getBits++      -- * Maybe & Either Helpers+    , eitherToMaybe+    , maybeToEither+    , liftEither+    , liftMaybe++      -- * Other Helpers+    , updateIndex+    , matchTemplate+    , convertBits++      -- * Triples+    , fst3+    , snd3+    , lst3++      -- * JSON Utilities+    , dropFieldLabel+    , dropSumLabels++    ) where++import           Control.Monad           (guard)+import           Control.Monad.Except    (ExceptT (..), liftEither)+import           Data.Aeson.Types        (Options (..), SumEncoding (..),+                                          defaultOptions, defaultTaggedObject)+import           Data.Bits+import           Data.ByteString         (ByteString)+import qualified Data.ByteString         as BS+import qualified Data.ByteString.Base16  as B16+import           Data.ByteString.Builder+import qualified Data.ByteString.Lazy    as BL+import           Data.Char               (toLower)+import           Data.List+import           Data.Text               (Text)+import qualified Data.Text.Encoding      as E+import           Data.Word               (Word8)++-- ByteString helpers++-- | Decode a big endian 'Integer' from a 'ByteString'.+bsToInteger :: ByteString -> Integer+bsToInteger = BS.foldr f 0 . BS.reverse+  where+    f w n = toInteger w .|. shiftL n 8++-- | Encode an 'Integer' to a 'ByteString' as big endian.+integerToBS :: Integer -> ByteString+integerToBS 0 = BS.pack [0]+integerToBS i+    | i > 0     = BS.reverse $ BS.unfoldr f i+    | otherwise = error "integerToBS not defined for negative values"+  where+    f 0 = Nothing+    f x = Just (fromInteger x :: Word8, x `shiftR` 8)++hexBuilder :: ByteString -> Builder+hexBuilder = byteStringHex++-- | Encode as string of human-readable hex characters.+encodeHex :: ByteString -> Text+encodeHex = E.decodeUtf8 . BL.toStrict . toLazyByteString . byteStringHex++-- | Decode string of human-readable hex characters.+decodeHex :: Text -> Maybe ByteString+decodeHex text =+    let (x, b) = B16.decode (E.encodeUtf8 text)+    in guard (b == BS.empty) >> return x++-- | Obtain 'Int' bits from beginning of 'ByteString'. Resulting 'ByteString'+-- will be smallest required to hold that many bits, padded with zeroes to the+-- right.+getBits :: Int -> ByteString -> ByteString+getBits b bs+    | r == 0 = BS.take q bs+    | otherwise = i `BS.snoc` l+  where+    (q, r) = b `quotRem` 8+    s = BS.take (q + 1) bs+    i = BS.init s+    l = BS.last s .&. (0xff `shiftL` (8 - r)) -- zero unneeded bits++-- Maybe and Either monad helpers++-- | Transform an 'Either' value into a 'Maybe' value. 'Right' is mapped to+-- 'Just' and 'Left' is mapped to 'Nothing'. The value inside 'Left' is lost.+eitherToMaybe :: Either a b -> Maybe b+eitherToMaybe (Right b) = Just b+eitherToMaybe _         = Nothing++-- | Transform a 'Maybe' value into an 'Either' value. 'Just' is mapped to+-- 'Right' and 'Nothing' is mapped to 'Left'. Default 'Left' required.+maybeToEither :: b -> Maybe a -> Either b a+maybeToEither err = maybe (Left err) Right++-- | Lift a 'Maybe' computation into the 'ExceptT' monad.+liftMaybe :: Monad m => b -> Maybe a -> ExceptT b m a+liftMaybe err = liftEither . maybeToEither err++-- Various helpers++-- | Applies a function to only one element of a list defined by its index.  If+-- the index is out of the bounds of the list, the original list is returned.+updateIndex :: Int      -- ^ index of the element to change+            -> [a]      -- ^ list of elements+            -> (a -> a) -- ^ function to apply+            -> [a]      -- ^ result with one element changed+updateIndex i xs f+    | i < 0 || i >= length xs = xs+    | otherwise = l ++ (f h : r)+  where+    (l,h:r) = splitAt i xs++-- | Use the list @[b]@ as a template and try to match the elements of @[a]@+-- against it. For each element of @[b]@ return the (first) matching element of+-- @[a]@, or 'Nothing'. Output list has same size as @[b]@ and contains results+-- in same order. Elements of @[a]@ can only appear once.+matchTemplate :: [a]              -- ^ input list+              -> [b]              -- ^ list to serve as a template+              -> (a -> b -> Bool) -- ^ comparison function+              -> [Maybe a]+matchTemplate [] bs _ = replicate (length bs) Nothing+matchTemplate _  [] _ = []+matchTemplate as (b:bs) f = case break (`f` b) as of+    (l,r:rs) -> Just r  : matchTemplate (l ++ rs) bs f+    _        -> Nothing : matchTemplate as bs f++-- | Returns the first value of a triple.+fst3 :: (a,b,c) -> a+fst3 (a,_,_) = a++-- | Returns the second value of a triple.+snd3 :: (a,b,c) -> b+snd3 (_,b,_) = b++-- | Returns the last value of a triple.+lst3 :: (a,b,c) -> c+lst3 (_,_,c) = c++-- | Field label goes lowercase and first @n@ characters get removed.+dropFieldLabel :: Int -> Options+dropFieldLabel n = defaultOptions+    { fieldLabelModifier = map toLower . drop n+    }++-- | Transformation from 'dropFieldLabel' is applied with argument @f@, plus+-- constructor tags are lowercased and first @c@ characters removed. @tag@ is+-- used as the name of the object field name that will hold the transformed+-- constructor tag as its value.+dropSumLabels :: Int -> Int -> String -> Options+dropSumLabels c f tag = (dropFieldLabel f)+    { constructorTagModifier = map toLower . drop c+    , sumEncoding = defaultTaggedObject { tagFieldName = tag }+    }++-- | Convert from one power-of-two base to another, as long as it fits in a+-- 'Word'.+convertBits :: Bool -> Int -> Int -> [Word] -> ([Word], Bool)+convertBits pad frombits tobits i = (reverse yout, rem')+  where+    (xacc, xbits, xout) = foldl' outer (0, 0, []) i+    (yout, rem')+        | pad && xbits /= 0 =+            let xout' = (xacc `shiftL` (tobits - xbits)) .&. maxv : xout+            in (xout', False)+        | pad = (xout, False)+        | xbits /= 0 = (xout, True)+        | otherwise = (xout, False)+    maxv = 1 `shiftL` tobits - 1+    max_acc = 1 `shiftL` (frombits + tobits - 1) - 1+    outer (acc, bits, out) it =+        let acc' = ((acc `shiftL` frombits) .|. it) .&. max_acc+            bits' = bits + frombits+            (out', bits'') = inner acc' out bits'+        in (acc', bits'', out')+    inner acc out bits+        | bits >= tobits =+            let bits' = bits - tobits+                out' = ((acc `shiftR` bits') .&. maxv) : out+            in inner acc out' bits'+        | otherwise = (out, bits)
− src/Network/Haskoin/Address.hs 
@@ -1,314 +0,0 @@-{-# LANGUAGE DeriveAnyClass    #-}-{-# LANGUAGE DeriveGeneric     #-}-{-# LANGUAGE FlexibleContexts  #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE OverloadedStrings #-}-{-|-Module      : Network.Haskoin.Address-Copyright   : No rights reserved-License     : UNLICENSE-Maintainer  : jprupp@protonmail.ch-Stability   : experimental-Portability : POSIX--Base58, CashAddr, Bech32 address and WIF private key serialization support.--}-module Network.Haskoin.Address-    ( Address(..)-    , isPubKeyAddress-    , isScriptAddress-    , isWitnessPubKeyAddress-    , isWitnessScriptAddress-    , addrToString-    , stringToAddr-    , addrToJSON-    , addrToEncoding-    , addrFromJSON-    , pubKeyAddr-    , pubKeyWitnessAddr-    , pubKeyCompatWitnessAddr-    , p2pkhAddr-    , p2wpkhAddr-    , p2shAddr-    , p2wshAddr-    , inputAddress-    , outputAddress-    , addressToScript-    , addressToScriptBS-    , addressToOutput-    , payToScriptAddress-    , payToWitnessScriptAddress-    , payToNestedScriptAddress-    , scriptToAddress-    , scriptToAddressBS-      -- * Private Key Wallet Import Format (WIF)-    , fromWif-    , toWif-      -- * Base58-    , module Network.Haskoin.Address.Base58-      -- * Bech32-    , module Network.Haskoin.Address.Bech32-      -- * CashAddr-    , module Network.Haskoin.Address.CashAddr-    ) where--import           Control.Applicative-import           Control.DeepSeq-import           Control.Monad-import           Data.Aeson                       as A-import           Data.Aeson.Encoding              as A-import           Data.Aeson.Types-import           Data.ByteString                  (ByteString)-import qualified Data.ByteString                  as B-import           Data.Hashable-import           Data.Maybe-import           Data.Serialize                   as S-import           Data.Text                        (Text)-import           GHC.Generics                     (Generic)-import           Network.Haskoin.Address.Base58-import           Network.Haskoin.Address.Bech32-import           Network.Haskoin.Address.CashAddr-import           Network.Haskoin.Constants-import           Network.Haskoin.Crypto-import           Network.Haskoin.Keys.Common-import           Network.Haskoin.Script-import           Network.Haskoin.Util---- | Address format for Bitcoin and Bitcoin Cash.-data Address-    -- | pay to public key hash (regular)-    = PubKeyAddress { getAddrHash160 :: !Hash160-                      -- ^ RIPEMD160 hash of public key's SHA256 hash-                     }-    -- | pay to script hash-    | ScriptAddress { getAddrHash160 :: !Hash160-                      -- ^ RIPEMD160 hash of script's SHA256 hash-                     }-    -- | pay to witness public key hash-    | WitnessPubKeyAddress { getAddrHash160 :: !Hash160-                             -- ^ RIPEMD160 hash of public key's SHA256 hash-                            }-    -- | pay to witness script hash-    | WitnessScriptAddress { getAddrHash256 :: !Hash256-                             -- ^ HASH256 hash of script-                            }-    deriving (Eq, Ord, Generic, Show, Read, Serialize, Hashable, NFData)---- | '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-    pfx <- getWord8-    addr <- S.get-    f pfx addr-  where-    f x a-        | x == getAddrPrefix net = return $ PubKeyAddress a-        | x == getScriptPrefix net = return $ ScriptAddress a-        | otherwise = fail "Does not recognize address prefix"---- | Binary serializer for 'Base58' addresses.-base58put :: Network -> Putter Address-base58put net (PubKeyAddress h) = do-        putWord8 (getAddrPrefix net)-        put h-base58put net (ScriptAddress h) = do-        putWord8 (getScriptPrefix net)-        put h-base58put _ _ = error "Cannot serialize this address as Base58"--addrToJSON :: Network -> Address -> Value-addrToJSON net a = toJSON (addrToString net a)--addrToEncoding :: Network -> Address -> Encoding-addrToEncoding net a =-    case addrToString net a of-        Nothing  -> null_-        Just txt -> text txt---- | JSON parsing for Bitcoin addresses. Works with 'Base58', 'CashAddr' and--- 'Bech32'.-addrFromJSON :: Network -> Value -> Parser Address-addrFromJSON net =-    withText "address" $ \t ->-        case stringToAddr net t of-            Nothing -> fail "could not decode address"-            Just x  -> return x---- | Convert address to human-readable string. Uses 'Base58', 'Bech32', or--- 'CashAddr' depending on network.-addrToString :: Network -> Address -> Maybe Text-addrToString net a@PubKeyAddress {getAddrHash160 = h}-    | isNothing (getCashAddrPrefix net) =-        Just . encodeBase58Check . runPut $ base58put net a-    | otherwise =-        cashAddrEncode net 0 (S.encode h)-addrToString net a@ScriptAddress {getAddrHash160 = h}-    | isNothing (getCashAddrPrefix net) =-        Just . encodeBase58Check . runPut $ base58put net a-    | otherwise =-        cashAddrEncode net 1 (S.encode h)-addrToString net WitnessPubKeyAddress {getAddrHash160 = h} = do-    hrp <- getBech32Prefix net-    segwitEncode hrp 0 (B.unpack (S.encode h))-addrToString net WitnessScriptAddress {getAddrHash256 = h} = do-    hrp <- getBech32Prefix net-    segwitEncode hrp 0 (B.unpack (S.encode h))---- | Parse 'Base58', 'Bech32' or 'CashAddr' address, depending on network.-stringToAddr :: Network -> Text -> Maybe Address-stringToAddr net bs = cash <|> segwit <|> b58-  where-    b58 = eitherToMaybe . runGet (base58get net) =<< decodeBase58Check bs-    cash = cashAddrDecode net bs >>= \(ver, bs') -> case ver of-        0 -> do-            h <- eitherToMaybe (S.decode bs')-            return $ PubKeyAddress h-        1 -> do-            h <- eitherToMaybe (S.decode bs')-            return $ ScriptAddress h-        _ -> Nothing-    segwit = do-        hrp <- getBech32Prefix net-        (ver, bs') <- segwitDecode hrp bs-        guard (ver == 0)-        let bs'' = B.pack bs'-        case B.length bs'' of-            20 -> do-                h <- eitherToMaybe (S.decode bs'')-                return $ WitnessPubKeyAddress h-            32 -> do-                h <- eitherToMaybe (S.decode bs'')-                return $ WitnessScriptAddress h-            _ -> Nothing---- | Obtain a standard pay-to-public-key-hash address from a public key.-pubKeyAddr :: PubKeyI -> Address-pubKeyAddr = PubKeyAddress . addressHash . S.encode---- | Obtain a standard pay-to-public-key-hash (P2PKH) address from a 'Hash160'.-p2pkhAddr :: Hash160 -> Address-p2pkhAddr = PubKeyAddress---- | Obtain a SegWit pay-to-witness-public-key-hash (P2WPKH) address from a--- public key.-pubKeyWitnessAddr :: PubKeyI -> Address-pubKeyWitnessAddr = WitnessPubKeyAddress . addressHash . S.encode---- | Obtain a backwards-compatible SegWit P2SH-P2WPKH address from a public key.-pubKeyCompatWitnessAddr :: PubKeyI -> Address-pubKeyCompatWitnessAddr =-    p2shAddr .-    addressHash . encodeOutputBS . PayWitnessPKHash . addressHash . S.encode---- | Obtain a SegWit pay-to-witness-public-key-hash (P2WPKH) address from a--- 'Hash160'.-p2wpkhAddr :: Hash160 -> Address-p2wpkhAddr = WitnessPubKeyAddress---- | Obtain a standard pay-to-script-hash (P2SH) address from a 'Hash160'.-p2shAddr :: Hash160 -> Address-p2shAddr = ScriptAddress---- | Obtain a SegWit pay-to-witness-script-hash (P2WSH) address from a 'Hash256'-p2wshAddr :: Hash256 -> Address-p2wshAddr = WitnessScriptAddress---- | Compute a standard pay-to-script-hash (P2SH) address for an output script.-payToScriptAddress :: ScriptOutput -> Address-payToScriptAddress = p2shAddr . addressHash . encodeOutputBS---- | Compute a SegWit pay-to-witness-script-hash (P2WSH) address for an output--- script.-payToWitnessScriptAddress :: ScriptOutput -> Address-payToWitnessScriptAddress = p2wshAddr . sha256 . encodeOutputBS---- | Compute a backwards-compatible SegWit P2SH-P2WSH address.-payToNestedScriptAddress :: ScriptOutput -> Address-payToNestedScriptAddress =-    p2shAddr . addressHash . encodeOutputBS . toP2WSH . encodeOutput---- | Encode an output script from an address. Will fail if using a--- pay-to-witness address on a non-SegWit network.-addressToOutput :: Address -> ScriptOutput-addressToOutput (PubKeyAddress h)        = PayPKHash h-addressToOutput (ScriptAddress h)        = PayScriptHash h-addressToOutput (WitnessPubKeyAddress h) = PayWitnessPKHash h-addressToOutput (WitnessScriptAddress h) = PayWitnessScriptHash h---- | Get output script AST for an 'Address'.-addressToScript :: Address -> Script-addressToScript = encodeOutput . addressToOutput---- | Encode address as output script in 'ByteString' form.-addressToScriptBS :: Address -> ByteString-addressToScriptBS = S.encode . addressToScript---- | Decode an output script into an 'Address' if it has such representation.-scriptToAddress :: Script -> Either String Address-scriptToAddress =-    maybeToEither "Could not decode address" . outputAddress <=< decodeOutput---- | Decode a serialized script into an 'Address'.-scriptToAddressBS :: ByteString -> Either String Address-scriptToAddressBS =-    maybeToEither "Could not decode address" . outputAddress <=< decodeOutputBS---- | Get the 'Address' of a 'ScriptOutput'.-outputAddress :: ScriptOutput -> Maybe Address-outputAddress (PayPKHash h)            = Just $ PubKeyAddress h-outputAddress (PayScriptHash h)        = Just $ ScriptAddress h-outputAddress (PayPK k)                = Just $ pubKeyAddr k-outputAddress (PayWitnessPKHash h)     = Just $ WitnessPubKeyAddress h-outputAddress (PayWitnessScriptHash h) = Just $ WitnessScriptAddress h-outputAddress _                        = Nothing---- | Infer the 'Address' of a 'ScriptInput'.-inputAddress :: ScriptInput -> Maybe Address-inputAddress (RegularInput (SpendPKHash _ key)) = Just $ pubKeyAddr key-inputAddress (ScriptHashInput _ rdm) = Just $ payToScriptAddress rdm-inputAddress _ = Nothing---- | Decode private key from WIF (wallet import format) string.-fromWif :: Network -> Base58 -> Maybe SecKeyI-fromWif net wif = do-    bs <- decodeBase58Check wif-    -- Check that this is a private key-    guard (B.head bs == getSecretPrefix net)-    case B.length bs of-        -- Uncompressed format-        33 -> wrapSecKey False <$> secKey (B.tail bs)-        -- Compressed format-        34 -> do-            guard $ B.last bs == 0x01-            wrapSecKey True <$> secKey (B.tail $ B.init bs)-        -- Bad length-        _  -> Nothing---- | Encode private key into a WIF string.-toWif :: Network -> SecKeyI -> Base58-toWif net (SecKeyI k c) =-    encodeBase58Check . B.cons (getSecretPrefix net) $-    if c-        then getSecKey k `B.snoc` 0x01-        else getSecKey k
− src/Network/Haskoin/Address/Base58.hs 
@@ -1,102 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}-{-|-Module      : Network.Haskoin.Address.Base58-Copyright   : No rights reserved-License     : UNLICENSE-Maintainer  : jprupp@protonmail.ch-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-    , decodeBase58-    , encodeBase58Check-    , decodeBase58Check-    ) where--import           Control.Monad-import           Data.ByteString             (ByteString)-import qualified Data.ByteString             as BS-import qualified Data.ByteString.Char8       as C-import           Data.Maybe                  (fromMaybe, isJust, listToMaybe)-import           Data.Serialize              as S-import           Data.String.Conversions     (cs)-import           Data.Text                   (Text)-import qualified Data.Text                   as T-import           Network.Haskoin.Crypto.Hash-import           Network.Haskoin.Util-import           Numeric                     (readInt, showIntAtBase)---- | 'Base58' classic Bitcoin address format.-type Base58 = Text---- | Symbols for Base58 encoding.-b58Data :: ByteString-b58Data = "123456789ABCDEFGHJKLMNPQRSTUVWXYZabcdefghijkmnopqrstuvwxyz"---- | Convert a number less than or equal to provided integer into a 'Base58'--- character.-b58 :: Int -> Char-b58 = C.index b58Data---- | Convert a 'Base58' character into the number it represents.-b58' :: Char -> Maybe Int-b58' = flip C.elemIndex b58Data---- | Encode an arbitrary-length 'Integer' into a 'Base58' string. Leading zeroes--- will not be part of the resulting string.-encodeBase58I :: Integer -> Base58-encodeBase58I i = cs $ showIntAtBase 58 b58 i ""---- | Decode a 'Base58' string into an arbitrary-length 'Integer'.-decodeBase58I :: Base58 -> Maybe Integer-decodeBase58I s =-    case go of-        Just (r,[]) -> Just r-        _           -> Nothing-  where-    p  = isJust . b58'-    f  = fromMaybe e . b58'-    go = listToMaybe $ readInt 58 p f (cs s)-    e  = error "Could not decode base58"---- | Encode an arbitrary 'ByteString' into a its 'Base58' representation,--- preserving leading zeroes.-encodeBase58 :: ByteString -> Base58-encodeBase58 bs =-    l `mappend` r-  where-    (z, b) = BS.span (== 0) bs-    l = cs $ BS.replicate (BS.length z) (BS.index b58Data 0) -- preserve leading 0's-    r | BS.null b = T.empty-      | otherwise = encodeBase58I $ bsToInteger b---- | Decode a 'Base58'-encoded 'Text' to a 'ByteString'.-decodeBase58 :: Base58 -> Maybe ByteString-decodeBase58 t =-    BS.append prefix <$> r-  where-    (z, b) = BS.span (== BS.index b58Data 0) (cs t)-    prefix = BS.replicate (BS.length z) 0 -- preserve leading 1's-    r | BS.null b = Just BS.empty-      | otherwise = integerToBS <$> decodeBase58I (cs b)---- | Computes a checksum for the input 'ByteString' and encodes the input and--- the checksum as 'Base58'.-encodeBase58Check :: ByteString -> Base58-encodeBase58Check bs =-    encodeBase58 $ BS.append bs $ encode $ checkSum32 bs---- | Decode a 'Base58'-encoded string that contains a checksum. This function--- returns 'Nothing' if the input string contains invalid 'Base58' characters or--- if the checksum fails.-decodeBase58Check :: Base58 -> Maybe ByteString-decodeBase58Check bs = do-    rs <- decodeBase58 bs-    let (res, chk) = BS.splitAt (BS.length rs - 4) rs-    guard $ chk == encode (checkSum32 res)-    return res
− src/Network/Haskoin/Address/Bech32.hs 
@@ -1,228 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}-{-|-Module      : Network.Haskoin.Address.Base58-Copyright   : No rights reserved-License     : UNLICENSE-Maintainer  : jprupp@protonmail.ch-Stability   : experimental-Portability : POSIX--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-    , Data-    , bech32Encode-    , bech32Decode-    , toBase32-    , toBase256-    , segwitEncode-    , segwitDecode-    , Word5(..)-    , word5-    , fromWord5-    ) where--import           Control.Monad         (guard)-import           Data.Array            (Array, assocs, bounds, listArray, (!),-                                        (//))-import           Data.Bits             (Bits, testBit, unsafeShiftL,-                                        unsafeShiftR, xor, (.&.), (.|.))-import qualified Data.ByteString       as B-import           Data.Char             (toUpper)-import           Data.Foldable         (foldl')-import           Data.Functor.Identity (Identity, runIdentity)-import           Data.Ix               (Ix (..))-import           Data.Text             (Text)-import qualified Data.Text             as T-import qualified Data.Text.Encoding    as E-import           Data.Word             (Word8)---- | Bech32 human-readable string.-type Bech32 = Text---- | Human-readable part of 'Bech32' address.-type HRP = Text---- | Data part of 'Bech32' address.-type Data = [Word8]--(.>>.), (.<<.) :: Bits a => a -> Int -> a-(.>>.) = unsafeShiftR-(.<<.) = unsafeShiftL---- | Five-bit word for Bech32.-newtype Word5 =-    UnsafeWord5 Word8-    deriving (Eq, Ord)--instance Ix Word5 where-    range (UnsafeWord5 m, UnsafeWord5 n) = map UnsafeWord5 $ range (m, n)-    index (UnsafeWord5 m, UnsafeWord5 n) (UnsafeWord5 i) = index (m, n) i-    inRange (m, n) i = m <= i && i <= n---- | Convert an integer number into a five-bit word.-word5 :: Integral a => a -> Word5-word5 x = UnsafeWord5 (fromIntegral x .&. 31)-{-# INLINE word5 #-}-{-# SPECIALIZE INLINE word5 :: Word8 -> Word5 #-}---- | Convert a five-bit word into a number.-fromWord5 :: Num a => Word5 -> a-fromWord5 (UnsafeWord5 x) = fromIntegral x-{-# INLINE fromWord5 #-}-{-# SPECIALIZE INLINE fromWord5 :: Word5 -> Word8 #-}---- | 'Bech32' character map as array of five-bit integers to character.-charset :: Array Word5 Char-charset =-    listArray (UnsafeWord5 0, UnsafeWord5 31) "qpzry9x8gf2tvdw0s3jn54khce6mua7l"---- | Convert a character to its five-bit value from 'Bech32' 'charset'.-charsetMap :: Char -> Maybe Word5-charsetMap c-    | inRange (bounds inv) upperC = inv ! upperC-    | otherwise = Nothing-  where-    upperC = toUpper c-    inv = listArray ('0', 'Z') (repeat Nothing) // map swap (assocs charset)-    swap (a, b) = (toUpper b, Just a)---- | Calculate or validate 'Bech32' checksum.-bech32Polymod :: [Word5] -> Word-bech32Polymod values = foldl' go 1 values .&. 0x3fffffff-  where-    go chk value =-        foldl' xor chk' [g | (g, i) <- zip generator [25 ..], testBit chk i]-      where-        generator = [0x3b6a57b2, 0x26508e6d, 0x1ea119fa, 0x3d4233dd, 0x2a1462b3]-        chk' = chk .<<. 5 `xor` fromWord5 value---- | Convert human-readable part of 'Bech32' string into a list of five-bit--- words.-bech32HRPExpand :: HRP -> [Word5]-bech32HRPExpand hrp =-    map (UnsafeWord5 . (.>>. 5)) hrpBytes ++-    [UnsafeWord5 0] ++ map word5 hrpBytes-  where-    hrpBytes = B.unpack $ E.encodeUtf8 hrp---- | Calculate checksum for a string of five-bit words.-bech32CreateChecksum :: HRP -> [Word5] -> [Word5]-bech32CreateChecksum hrp dat = [word5 (polymod .>>. i) | i <- [25,20 .. 0]]-  where-    values = bech32HRPExpand hrp ++ dat-    polymod =-        bech32Polymod (values ++ map UnsafeWord5 [0, 0, 0, 0, 0, 0]) `xor` 1---- | Verify checksum for a human-readable part and string of five-bit words.-bech32VerifyChecksum :: HRP -> [Word5] -> Bool-bech32VerifyChecksum hrp dat = bech32Polymod (bech32HRPExpand hrp ++ dat) == 1---- | Maximum length of a Bech32 result.-maxBech32Length :: Int-maxBech32Length = 90---- | Encode string of five-bit words into 'Bech32' using a provided--- human-readable part. Can fail if 'HRP' is invalid or result would be longer--- than 90 characters.-bech32Encode :: HRP -> [Word5] -> Maybe Bech32-bech32Encode hrp dat = do-    guard $ checkHRP hrp-    let dat' = dat ++ bech32CreateChecksum (T.toLower hrp) dat-        rest = map (charset !) dat'-        result = T.concat [T.toLower hrp, T.pack "1", T.pack rest]-    guard $ T.length result <= maxBech32Length-    return result---- | Check that human-readable part is valid for a 'Bech32' string.-checkHRP :: HRP -> Bool-checkHRP hrp = not (T.null hrp) && T.all (\char -> char >= '\x21' && char <= '\x7e') hrp---- | Decode human-readable 'Bech32' string into a human-readable part and a--- string of five-bit words.-bech32Decode :: Bech32 -> Maybe (HRP, [Word5])-bech32Decode bech32 = do-    guard $ T.length bech32 <= maxBech32Length-    guard $ T.toUpper bech32 == bech32 || lowerBech32 == bech32-    let (hrp, dat) = T.breakOnEnd "1" lowerBech32-    guard $ T.length dat >= 6-    hrp' <- T.stripSuffix "1" hrp-    guard $ checkHRP hrp'-    dat' <- mapM charsetMap $ T.unpack dat-    guard $ bech32VerifyChecksum hrp' dat'-    return (hrp', take (T.length dat - 6) dat')-  where-    lowerBech32 = T.toLower bech32--type Pad f = Int -> Int -> Word -> [[Word]] -> f [[Word]]--yesPadding :: Pad Identity-yesPadding _ 0 _ result        = return result-yesPadding _ _ padValue result = return $ [padValue] : result-{-# INLINE yesPadding #-}--noPadding :: Pad Maybe-noPadding frombits bits padValue result = do-    guard $ bits < frombits && padValue == 0-    return result-{-# INLINE noPadding #-}---- | Big endian conversion of a bytestring from base \(2^{frombits}\) to base--- \(2^{tobits}\). {frombits} and {twobits} must be positive and--- \(2^{frombits}\) and \(2^{tobits}\) must be smaller than the size of Word.--- Every value in 'dat' must be strictly smaller than \(2^{frombits}\).-convertBits :: Functor f => [Word] -> Int -> Int -> Pad f -> f [Word]-convertBits dat frombits tobits pad = concat . reverse <$> go dat 0 0 []-  where-    go [] acc bits result =-        let padValue = (acc .<<. (tobits - bits)) .&. maxv-        in pad frombits bits padValue result-    go (value:dat') acc bits result =-        go dat' acc' (bits' `rem` tobits) (result' : result)-      where-        acc' = (acc .<<. frombits) .|. fromIntegral value-        bits' = bits + frombits-        result' =-            [ (acc' .>>. b) .&. maxv-            | b <- [bits' - tobits,bits' - 2 * tobits .. 0]-            ]-    maxv = (1 .<<. tobits) - 1-{-# INLINE convertBits #-}---- | Convert from eight-bit to five-bit word string, adding padding as required.-toBase32 :: [Word8] -> [Word5]-toBase32 dat =-    map word5 $ runIdentity $ convertBits (map fromIntegral dat) 8 5 yesPadding---- | Convert from five-bit word string to eight-bit word string, ignoring padding.-toBase256 :: [Word5] -> Maybe [Word8]-toBase256 dat =-    map fromIntegral <$> convertBits (map fromWord5 dat) 5 8 noPadding---- | Check if witness version and program are valid.-segwitCheck :: Word8 -> Data -> Bool-segwitCheck witver witprog =-    witver <= 16 &&-    if witver == 0-        then length witprog == 20 || length witprog == 32-        else length witprog >= 2 && length witprog <= 40---- | Decode SegWit 'Bech32' address from a string and expected human-readable part.-segwitDecode :: HRP -> Bech32 -> Maybe (Word8, Data)-segwitDecode hrp addr = do-    (hrp', dat) <- bech32Decode addr-    guard $ (hrp == hrp') && not (null dat)-    let (UnsafeWord5 witver:datBase32) = dat-    decoded <- toBase256 datBase32-    guard $ segwitCheck witver decoded-    return (witver, decoded)---- | Encode 'Data' as a SegWit 'Bech32' address. Needs human-readable part and--- witness program version.-segwitEncode :: HRP -> Word8 -> Data -> Maybe Text-segwitEncode hrp witver witprog = do-    guard $ segwitCheck witver witprog-    bech32Encode hrp $ UnsafeWord5 witver : toBase32 witprog
− src/Network/Haskoin/Address/CashAddr.hs 
@@ -1,198 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}-{-|-Module      : Network.Haskoin.Address.CashAddr-Copyright   : No rights reserved-License     : UNLICENSE-Maintainer  : jprupp@protonmail.ch-Stability   : experimental-Portability : POSIX--Support for Bitcoin Cash (BCH) CashAddr format.--}-module Network.Haskoin.Address.CashAddr-    ( CashPrefix-    , CashVersion-    , CashAddr-    , Cash32-    , cashAddrDecode-    , cashAddrEncode-    , cash32decodeType-    , cash32encodeType-    , cash32decode-    , cash32encode-    ) where--import           Control.Monad-import           Data.Bits-import           Data.ByteString            (ByteString)-import qualified Data.ByteString            as B-import qualified Data.ByteString.Char8      as C-import           Data.Char-import           Data.List-import           Data.Text                  (Text)-import qualified Data.Text                  as T-import qualified Data.Text.Encoding         as E-import           Data.Word-import           Network.Haskoin.Constants-import           Network.Haskoin.Util---- | 'CashAddr' prefix, usually shown before the colon in addresses, but sometimes--- omitted. It is used in the checksum calculation to avoid parsing an address--- from the wrong network.-type CashPrefix = Text---- | 'CashAddr' version, until new address schemes appear it will be zero.-type CashVersion = Word8---- | High level 'CashAddr' human-reabale string, with explicit or implicit prefix.-type CashAddr = Text---- | Low level 'Cash32' is the human-readable low-level encoding used by 'CashAddr'. It--- need not encode a valid address but any binary data.-type Cash32 = Text---- | Symbols for encoding 'Cash32' data in human-readable strings.-charset :: String-charset = "qpzry9x8gf2tvdw0s3jn54khce6mua7l"---- | Get the 32-bit number associated with this 'Cash32' character.-base32char :: Char -> Maybe Word8-base32char = fmap fromIntegral . (`elemIndex` charset)---- | High-Level: decode 'CashAddr' string if it is valid for the--- provided 'Network'. Prefix may be omitted from the string.-cashAddrDecode :: Network -> CashAddr -> Maybe (CashVersion, ByteString)-cashAddrDecode net ca = do-    epfx <- getCashAddrPrefix net-    let (cpfx, cdat) = T.breakOnEnd ":" (T.toLower ca)-    guard (T.null cpfx || T.init cpfx == epfx)-    (dpfx, ver, bs) <- cash32decodeType (epfx <> ":" <> cdat)-    guard (dpfx == epfx)-    return (ver, bs)---- | High-Level: encode 'CashAddr' string for the provided network and hash.--- Fails if the 'CashVersion' or length of hash 'ByteString' is invalid.-cashAddrEncode :: Network -> CashVersion -> ByteString -> Maybe CashAddr-cashAddrEncode net cv bs = do-    pfx <- getCashAddrPrefix net-    cash32encodeType pfx cv bs---- | Mid-Level: decode 'CashAddr' string containing arbitrary prefix, plus a--- version byte before the 'ByteString' that encodes type and length.-cash32decodeType :: Cash32 -> Maybe (CashPrefix, CashVersion, ByteString)-cash32decodeType ca' = do-    guard (T.toUpper ca' == ca' || ca == ca')-    (dpfx, bs) <- cash32decode ca-    guard (not (B.null bs))-    let vb = B.head bs-        pay = B.tail bs-    (ver, len) <- decodeVersionByte vb-    guard (B.length pay == len)-    return (dpfx, ver, pay)-  where-    ca = T.toLower ca'---- | Mid-Level: encode 'CashAddr' string containing arbitrary prefix and--- 'CashVersion'. Length must be among those allowed by the standard.-cash32encodeType :: CashPrefix -> CashVersion -> ByteString -> Maybe Cash32-cash32encodeType pfx cv bs = do-    let len = B.length bs-    vb <- encodeVersionByte cv len-    let pl = vb `B.cons` bs-    return (cash32encode pfx pl)---- | Low-Level: decode 'Cash32' string. 'CashPrefix' must be part of the string.--- No version or hash length validation is performed.-cash32decode :: Cash32 -> Maybe (CashPrefix, ByteString)-cash32decode text = do-    let bs = C.map toLower bs'-    guard (C.map toUpper bs' == bs' || bs == bs')-    let (pfx', dat) = C.breakEnd (== ':') bs-    pfx <--        if B.null pfx' || pfx' == C.singleton ':'-            then Nothing-            else Just (B.init pfx')-    b32 <- B.pack <$> mapM base32char (C.unpack dat)-    let px = B.map (.&. 0x1f) pfx-        pd = px <> B.singleton 0 <> b32-        cs = cash32Polymod pd-        bb = B.take (B.length b32 - 8) b32-    guard (verifyCash32Polymod cs)-    let out = toBase256 bb-    return (E.decodeUtf8 pfx, out)-  where-    bs' = E.encodeUtf8 text---- | Low-Level: encode 'Cash32' string for 'CashPrefix' provided. Can encode--- arbitrary data. No prefix or length validation is performed.-cash32encode :: CashPrefix -> ByteString -> Cash32-cash32encode pfx bs =-    let b32 = toBase32 bs-        px = B.map (.&. 0x1f) (E.encodeUtf8 pfx)-        pd = px <> B.singleton 0 <> b32 <> B.replicate 8 0-        cs = cash32Polymod pd-        c32 = B.map f (b32 <> cs)-        f = fromIntegral . ord . (charset !!) . fromIntegral-    in pfx <> ":" <> E.decodeUtf8 c32---- | Convert base of 'ByteString' from eight bits per byte to five bits per--- byte, adding padding as necessary.-toBase32 :: ByteString -> ByteString-toBase32 =-    B.pack .-    map fromIntegral . fst . convertBits True 8 5 . map fromIntegral . B.unpack---- | Convert base of 'ByteString' from five to eight bits per byte. Ignore--- padding to be symmetric with respect to 'toBase32' function.-toBase256 :: ByteString -> ByteString-toBase256 =-    B.pack .-    map fromIntegral . fst . convertBits False 5 8 . map fromIntegral . B.unpack---- | Obtain 'CashVersion' and payload length from 'CashAddr' version byte.-decodeVersionByte :: Word8 -> Maybe (CashVersion, Int)-decodeVersionByte vb = do-    guard (vb .&. 0x80 == 0)-    return (ver, len)-  where-    ver = vb `shiftR` 3-    len = ls !! fromIntegral (vb .&. 0x07)-    ls = [20, 24, 28, 32, 40, 48, 56, 64]---- | Encode 'CashVersion' and length into version byte. Fail if version is--- larger than five bits, or length incorrect, since that is invalid.-encodeVersionByte :: CashVersion -> Int -> Maybe Word8-encodeVersionByte ver len = do-    guard (ver == ver .&. 0x0f)-    l <- case len of-        20 -> Just 0-        24 -> Just 1-        28 -> Just 2-        32 -> Just 3-        40 -> Just 4-        48 -> Just 5-        56 -> Just 6-        64 -> Just 7-        _  -> Nothing-    return ((ver `shiftL` 3) .|. l)---- | Calculate or validate checksum from base32 'ByteString' (excluding prefix).-cash32Polymod :: ByteString -> ByteString-cash32Polymod v =-    B.pack-        [fromIntegral (polymod `shiftR` (5 * (7 - i))) .&. 0x1f | i <- [0 .. 7]]-  where-    polymod = B.foldl' outer (1 :: Word64) v `xor` 1-    outer c d =-        let c0 = (fromIntegral (c `shiftR` 35) :: Word8)-            c' = ((c .&. 0x07ffffffff) `shiftL` 5) `xor` fromIntegral d-        in foldl' (inner c0) c' (zip [0 ..] generator)-    generator =-        [0x98f2bc8e61, 0x79b76d99e2, 0xf33e5fb3c4, 0xae2eabe2a8, 0x1e4f43e470]-    inner c0 c (b, g)-        | c0 `testBit` b = c `xor` g-        | otherwise = c---- | Validate that polymod 'ByteString' (eight bytes) is equal to zero.-verifyCash32Polymod :: ByteString -> Bool-verifyCash32Polymod = (== B.replicate 8 0)
− src/Network/Haskoin/Block.hs 
@@ -1,21 +0,0 @@-{-|-Module      : Network.Haskoin.Block-Copyright   : No rights reserved-License     : UNLICENSE-Maintainer  : jprupp@protonmail.ch-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-    , module Network.Haskoin.Block.Headers-      -- * Merkle Blocks-    , module Network.Haskoin.Block.Merkle-    ) where--import           Network.Haskoin.Block.Headers-import           Network.Haskoin.Block.Merkle-import           Network.Haskoin.Block.Common
− src/Network/Haskoin/Block/Common.hs 
@@ -1,348 +0,0 @@-{-# LANGUAGE DeriveAnyClass #-}-{-# LANGUAGE DeriveGeneric  #-}-{-|-Module      : Network.Haskoin.Block.Common-Copyright   : No rights reserved-License     : UNLICENSE-Maintainer  : jprupp@protonmail.ch-Stability   : experimental-Portability : POSIX--Common data types and functions to handle blocks from the block chain.--}-module Network.Haskoin.Block.Common-    ( Block(..)-    , BlockHeight-    , Timestamp-    , BlockHeader(..)-    , headerHash-    , BlockLocator-    , GetBlocks(..)-    , GetHeaders(..)-    , BlockHeaderCount-    , BlockHash(..)-    , blockHashToHex-    , hexToBlockHash-    , Headers(..)-    , decodeCompact-    , encodeCompact-    ) where--import           Control.DeepSeq-import           Control.Monad                      (forM_, liftM2, mzero,-                                                     replicateM)-import           Data.Aeson                         (FromJSON (..), ToJSON (..),-                                                     Value (String), toJSON,-                                                     withText)-import           Data.Aeson.Encoding                (unsafeToEncoding)-import           Data.Bits                          (shiftL, shiftR, (.&.),-                                                     (.|.))-import qualified Data.ByteString                    as B-import           Data.ByteString.Builder            (char7)-import           Data.Hashable                      (Hashable)-import           Data.Maybe                         (fromMaybe)-import           Data.Serialize                     (Serialize, decode, encode,-                                                     get, put)-import           Data.Serialize.Get                 (getWord32le)-import           Data.Serialize.Put                 (Put, putWord32le)-import           Data.String                        (IsString, fromString)-import           Data.String.Conversions            (cs)-import           Data.Text                          (Text)-import           Data.Word                          (Word32)-import           GHC.Generics                       (Generic)-import           Network.Haskoin.Crypto.Hash-import           Network.Haskoin.Network.Common-import           Network.Haskoin.Transaction.Common-import           Network.Haskoin.Util-import qualified Text.Read                          as R---- | 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).-type Timestamp = Word32---- | Block header and transactions.-data Block =-    Block { blockHeader :: !BlockHeader-          , blockTxns   :: ![Tx]-          } deriving (Eq, Show, Read, Generic, Hashable, NFData)--instance Serialize Block where-    get = do-        header     <- get-        (VarInt c) <- get-        txs        <- replicateM (fromIntegral c) get-        return $ Block header txs-    put (Block h txs) = do-        put h-        putVarInt $ length txs-        forM_ txs put--instance ToJSON Block where-    toJSON = String . encodeHex . encode-    toEncoding s =-        unsafeToEncoding $ char7 '"' <> hexBuilder (encode s) <> char7 '"'--instance FromJSON Block where-    parseJSON =-        withText "Block" $ \t -> do-            bin <--                case decodeHex t of-                    Nothing  -> mzero-                    Just bin -> return bin-            case decode bin of-                Left e  -> fail e-                Right h -> return h--instance ToJSON BlockHeader where-    toJSON = String . encodeHex . encode-    toEncoding s =-        unsafeToEncoding $ char7 '"' <> hexBuilder (encode s) <> char7 '"'--instance FromJSON BlockHeader where-    parseJSON =-        withText "BlockHeader" $ \t -> do-            bin <--                case decodeHex t of-                    Nothing  -> mzero-                    Just bin -> return bin-            case decode bin of-                Left e  -> fail e-                Right h -> return h---- | Block header hash. To be serialized reversed for display purposes.-newtype BlockHash = BlockHash-    { getBlockHash :: Hash256 }-    deriving (Eq, Ord, Generic, Hashable, Serialize, NFData)--instance Show BlockHash where-    showsPrec _ = shows . blockHashToHex--instance Read BlockHash where-    readPrec = do-        R.String str <- R.lexP-        maybe R.pfail return $ hexToBlockHash $ cs str--instance IsString BlockHash where-    fromString s =-        let e = error "Could not read block hash from hex string"-        in fromMaybe e $ hexToBlockHash $ cs s--instance FromJSON BlockHash where-    parseJSON = withText "block hash" $-        maybe mzero return . hexToBlockHash--instance ToJSON BlockHash where-    toJSON = String . blockHashToHex-    toEncoding s =-        unsafeToEncoding $-        char7 '"' <> hexBuilder (B.reverse (encode s)) <> char7 '"'---- | 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 (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 <- B.reverse <$> decodeHex hex-    h <- eitherToMaybe (decode bs)-    return $ BlockHash h---- | Data type recording information of a 'Block'. The hash of a block is--- defined as the hash of this data structure, serialized. The block mining--- process involves finding a partial hash collision by varying the nonce in the--- 'BlockHeader' and/or additional entropy in the coinbase 'Transaction' of this--- 'Block'. Variations in the coinbase will result in different merkle roots in--- the 'BlockHeader'.-data BlockHeader =-    BlockHeader { blockVersion   :: !Word32      --  4 bytes-                  -- | hash of the previous block (parent)-                , prevBlock      :: !BlockHash   -- 32 bytes-                  -- | root of the merkle tree of transactions-                , merkleRoot     :: !Hash256     -- 32 bytes-                  -- | unix timestamp-                , blockTimestamp :: !Timestamp   --  4 bytes-                  -- | difficulty target-                , blockBits      :: !Word32      --  4 bytes-                  -- | random nonce-                , bhNonce        :: !Word32      --  4 bytes-                } deriving (Eq, Ord, Show, Read, Generic, Hashable, NFData)-                                                 -- 80 bytes---- | Compute hash of 'BlockHeader'.-headerHash :: BlockHeader -> BlockHash-headerHash = BlockHash . doubleSHA256 . encode--instance Serialize BlockHeader where-    get = do-        v <- getWord32le-        p <- get-        m <- get-        t <- getWord32le-        b <- getWord32le-        n <- getWord32le-        return BlockHeader-            { blockVersion   = v-            , prevBlock      = p-            , merkleRoot     = m-            , blockTimestamp = t-            , blockBits      = b-            , bhNonce        = n-            }--    put (BlockHeader v p m bt bb n) = do-        putWord32le v-        put         p-        put         m-        putWord32le bt-        putWord32le bb-        putWord32le n---- | A block locator is a set of block headers, denser towards the best block--- and sparser towards the genesis block. It starts at the highest block known.--- It is used by a node to synchronize against the network. When the locator is--- provided to a peer, it will send back block hashes starting from the first--- block in the locator that it recognizes.-type BlockLocator = [BlockHash]---- | Data type representing a getblocks message request. It is used in the--- bitcoin protocol to retrieve blocks from a peer by providing it a--- 'BlockLocator' object. The response to a 'GetBlocks' message is an 'Inv'--- message containing a list of block hashes that the peer believes this node is--- missing. The number of block hashes in that inv message will end at the stop--- block hash, at at the tip of the chain, or after 500 entries, whichever comes--- earlier.-data GetBlocks =-    GetBlocks { -- | protocol version.-                getBlocksVersion  :: !Word32-                -- | block locator object-              , getBlocksLocator  :: !BlockLocator-                -- | hash of the last desired block-              , getBlocksHashStop :: !BlockHash-              } deriving (Eq, Show, Generic, NFData)--instance Serialize GetBlocks where--    get = GetBlocks <$> getWord32le-                    <*> (repList =<< get)-                    <*> get-      where-        repList (VarInt c) = replicateM (fromIntegral c) get--    put (GetBlocks v xs h) = putGetBlockMsg v xs h--putGetBlockMsg :: Word32 -> BlockLocator -> BlockHash -> Put-putGetBlockMsg v xs h = do-    putWord32le v-    putVarInt $ length xs-    forM_ xs put-    put h---- | Similar to the 'GetBlocks' message type but for retrieving block headers--- 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 block chain.-data GetHeaders =-    GetHeaders {-                 -- | protocol version-                 getHeadersVersion  :: !Word32-                 -- | block locator object-               , getHeadersBL       :: !BlockLocator-                 -- | hash of the last desired block header-               , getHeadersHashStop :: !BlockHash-               } deriving (Eq, Show, Generic, NFData)--instance Serialize GetHeaders where--    get = GetHeaders <$> getWord32le-                     <*> (repList =<< get)-                     <*> get-      where-        repList (VarInt c) = replicateM (fromIntegral c) get--    put (GetHeaders v xs h) = putGetBlockMsg v xs h---- | 'BlockHeader' type with a transaction count as 'VarInt'-type BlockHeaderCount = (BlockHeader, VarInt)---- | The 'Headers' type is used to return a list of block headers in--- response to a 'GetHeaders' message.-newtype Headers =-    Headers { -- | list of block headers with transaction count-              headersList :: [BlockHeaderCount]-            }-    deriving (Eq, Show, Generic, NFData)--instance Serialize Headers where--    get = Headers <$> (repList =<< get)-      where-        repList (VarInt c) = replicateM (fromIntegral c) action-        action = liftM2 (,) get get--    put (Headers xs) = do-        putVarInt $ length xs-        forM_ xs $ \(a,b) -> put a >> put b---- | Decode the compact number used in the difficulty target of a block.------ The compact format is a representation of a whole number \(N\) using an--- unsigned 32-bit number similar to a floating point format. The most--- significant 8 bits are the unsigned exponent of base 256. This exponent can--- be thought of as the number of bytes of \(N\). The lower 23 bits are the--- mantissa. Bit number 24 represents the sign of \(N\).------ \[--- N = -1^{sign} \times mantissa \times 256^{exponent-3}--- \]-decodeCompact :: Word32 -> (Integer, Bool) -- ^ true means overflow-decodeCompact nCompact = (if neg then res * (-1) else res, over)-  where-    nSize :: Int-    nSize = fromIntegral nCompact `shiftR` 24-    nWord' :: Word32-    nWord' = nCompact .&. 0x007fffff-    nWord :: Word32-    nWord | nSize <= 3 = nWord' `shiftR` (8 * (3 - nSize))-          | otherwise = nWord'-    res :: Integer-    res | nSize <= 3 = fromIntegral nWord-        | otherwise = fromIntegral nWord `shiftL` (8 * (nSize - 3))-    neg = nWord /= 0 && (nCompact .&. 0x00800000) /= 0-    over = nWord /= 0 && (nSize > 34 ||-                          nWord > 0xff && nSize > 33 ||-                          nWord > 0xffff && nSize > 32)---- | Encode an 'Integer' to the compact number format used in the difficulty--- target of a block.-encodeCompact :: Integer-              -> Word32-encodeCompact i = nCompact-  where-    i' = abs i-    neg = i < 0-    nSize' :: Int-    nSize' = let f 0 = 0-                 f n = 1 + f (n `shiftR` 8)-             in f i'-    nCompact''' :: Word32-    nCompact'''-        | nSize' <= 3 = fromIntegral $ (low64 .&. i') `shiftL` (8 * (3 - nSize'))-        | otherwise = fromIntegral $ low64 .&. (i' `shiftR` (8 * (nSize' - 3)))-    nCompact'' :: Word32-    nSize :: Int-    (nCompact'', nSize)-        | nCompact''' .&. 0x00800000 /= 0 = (nCompact''' `shiftR` 8, nSize' + 1)-        | otherwise = (nCompact''', nSize')-    nCompact' :: Word32-    nCompact' = nCompact'' .|. (fromIntegral nSize `shiftL` 24)-    nCompact :: Word32-    nCompact | neg && (nCompact' .&. 0x007fffff /= 0) = nCompact' .|. 0x00800000-             | otherwise = nCompact'-    low64 :: Integer-    low64 = 0xffffffffffffffff
− src/Network/Haskoin/Block/Headers.hs 
@@ -1,741 +0,0 @@-{-# LANGUAGE DeriveAnyClass    #-}-{-# LANGUAGE DeriveGeneric     #-}-{-# LANGUAGE FlexibleContexts  #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE LambdaCase        #-}-{-# LANGUAGE RecordWildCards   #-}-{-|-Module      : Network.Haskoin.Block.Headers-Copyright   : No rights reserved-License     : UNLICENSE-Maintainer  : jprupp@protonmail.ch-Stability   : experimental-Portability : POSIX--Block chain header synchronization and proof-of-work consensus functions.--}-module Network.Haskoin.Block.Headers-    ( BlockNode(..)-    , BlockHeaders(..)-    , BlockWork-    , genesisNode-    , genesisBlock-    , isGenesis-    , chooseBest-      -- * Header Chain Storage Functions-    , parentBlock-    , getParents-    , getAncestor-    , splitPoint-    , connectBlocks-    , connectBlock-    , blockLocator-      -- * In-Memory Header Chain Store-    , HeaderMemory(..)-    , ShortBlockHash-    , BlockMap-    , shortBlockHash-    , initialChain-    , genesisMap-      -- * Helper Functions-    , appendBlocks-    , validBlock-    , validCP-    , afterLastCP-    , bip34-    , validVersion-    , lastNoMinDiff-    , nextWorkRequired-    , nextEdaWorkRequired-    , nextDaaWorkRequired-    , computeTarget-    , getSuitableBlock-    , nextPowWorkRequired-    , calcNextWork-    , isValidPOW-    , blockPOW-    , headerWork-    , diffInterval-    , blockLocatorNodes-    , mineBlock-    , computeSubsidy-    , ) where--import           Control.Applicative                ((<|>))-import           Control.DeepSeq-import           Control.Monad                      (guard, unless, when)-import           Control.Monad.Except               (ExceptT (..), runExceptT,-                                                     throwError)-import           Control.Monad.State.Strict         as State (StateT, get, gets,-                                                              lift, modify)-import           Control.Monad.Trans.Maybe-import           Data.Bits                          (shiftL, shiftR, (.&.))-import qualified Data.ByteString                    as B-import           Data.ByteString.Short              (ShortByteString, fromShort,-                                                     toShort)-import           Data.Function                      (on)-import           Data.Hashable-import           Data.HashMap.Strict                (HashMap)-import qualified Data.HashMap.Strict                as HashMap-import           Data.List                          (sort, sortBy)-import           Data.Maybe                         (fromMaybe, listToMaybe)-import           Data.Serialize                     as S (Serialize (..),-                                                          decode, encode, get,-                                                          put)-import           Data.Serialize.Get                 as S-import           Data.Serialize.Put                 as S-import           Data.Typeable                      (Typeable)-import           Data.Word                          (Word32, Word64)-import           GHC.Generics                       (Generic)-import           Network.Haskoin.Block.Common-import           Network.Haskoin.Constants-import           Network.Haskoin.Crypto-import           Network.Haskoin.Transaction.Common-import           Network.Haskoin.Util---- | Short version of the block hash. Uses the good end of the hash (the part--- that doesn't have a long string of zeroes).-type ShortBlockHash = Word64---- | Memory-based map to a serialized 'BlockNode' data structure.--- 'ShortByteString' is used to avoid memory fragmentation and make the data--- structure compact.-type BlockMap = HashMap ShortBlockHash ShortByteString---- | Represents accumulated work in the block chain so far.-type BlockWork = Integer---- | Data structure representing a block header and its position in the--- block chain.-data BlockNode-    -- | non-Genesis block header-    = BlockNode { nodeHeader :: !BlockHeader-                , nodeHeight :: !BlockHeight-        -- | accumulated work so far-                , nodeWork   :: !BlockWork-        -- | akip magic block hash-                , nodeSkip   :: !BlockHash }-    -- | Genesis block header-    | GenesisNode { nodeHeader :: !BlockHeader-                  , nodeHeight :: !BlockHeight-                  , nodeWork   :: !BlockWork }-    deriving (Show, Read, Generic, Hashable, NFData)--instance Serialize BlockNode where-    get = do-        nodeHeader <- S.get-        nodeHeight <- getWord32le-        nodeWork <- S.get-        if nodeHeight == 0-            then return GenesisNode {..}-            else do-                nodeSkip <- S.get-                return BlockNode {..}-    put bn = do-        put $ nodeHeader bn-        putWord32le $ nodeHeight bn-        put $ nodeWork bn-        case bn of-            GenesisNode {} -> return ()-            BlockNode {}   -> put $ nodeSkip bn--instance Eq BlockNode where-    (==) = (==) `on` nodeHeader--instance Ord BlockNode where-    compare = compare `on` nodeHeight---- | Memory-based header tree.-data HeaderMemory = HeaderMemory-    { memoryHeaderMap  :: !BlockMap-    , memoryBestHeader :: !BlockNode-    } deriving (Eq, Typeable, Show, Read, Generic, Hashable, NFData)---- | Typeclass for block header chain storage monad.-class Monad m => BlockHeaders m where-    -- | Add a new 'BlockNode' to the chain. Does not validate.-    addBlockHeader :: BlockNode -> m ()-    -- | Get a 'BlockNode' associated with a 'BlockHash'.-    getBlockHeader :: BlockHash -> m (Maybe BlockNode)-    -- | Locate the 'BlockNode' for the highest block in the chain-    getBestBlockHeader :: m BlockNode-    -- | Set the highest block in the chain.-    setBestBlockHeader :: BlockNode -> m ()-    -- | Add a continuous bunch of block headers the chain. Does not validate.-    addBlockHeaders :: [BlockNode] -> m ()-    addBlockHeaders = mapM_ addBlockHeader--instance Monad m => BlockHeaders (StateT HeaderMemory m) where-    addBlockHeader = modify . addBlockHeaderMemory-    getBlockHeader bh = getBlockHeaderMemory bh <$> State.get-    getBestBlockHeader = gets memoryBestHeader-    setBestBlockHeader bn = modify $ \s -> s { memoryBestHeader = bn }---- | Initialize memory-based chain.-initialChain :: Network -> HeaderMemory-initialChain net = HeaderMemory-    { memoryHeaderMap = genesisMap net-    , memoryBestHeader = genesisNode net-    }---- | Initialize map for memory-based chain.-genesisMap :: Network -> BlockMap-genesisMap net =-    HashMap.singleton-        (shortBlockHash (headerHash (getGenesisHeader net)))-        (toShort (encode (genesisNode net)))---- | Add block header to memory block map.-addBlockHeaderMemory :: BlockNode -> HeaderMemory -> HeaderMemory-addBlockHeaderMemory bn s@HeaderMemory{..} =-    let bm' = addBlockToMap bn memoryHeaderMap-    in s { memoryHeaderMap = bm' }---- | Get block header from memory block map.-getBlockHeaderMemory :: BlockHash -> HeaderMemory -> Maybe BlockNode-getBlockHeaderMemory bh HeaderMemory {..} = do-    bs <- shortBlockHash bh `HashMap.lookup` memoryHeaderMap-    eitherToMaybe . decode $ fromShort bs---- | Calculate short block hash taking eight non-zero bytes from the 16-byte--- hash. This function will take the bytes that are not on the zero-side of the--- hash, making colissions between short block hashes difficult.-shortBlockHash :: BlockHash -> ShortBlockHash-shortBlockHash = either error id . decode . B.take 8 . encode---- | Add a block to memory-based block map.-addBlockToMap :: BlockNode -> BlockMap -> BlockMap-addBlockToMap node =-    HashMap.insert-    (shortBlockHash $ headerHash $ nodeHeader node)-    (toShort $ encode node)---- | Get the ancestor of the provided 'BlockNode' at the specified--- 'BlockHeight'.-getAncestor :: BlockHeaders m-            => BlockHeight-            -> BlockNode-            -> m (Maybe BlockNode)-getAncestor height node-    | height > nodeHeight node = return Nothing-    | otherwise = go node-  where-    e1 = error "Could not get skip header"-    e2 = error "Could not get previous block header"-    go walk-        | nodeHeight walk > height =-            let heightSkip = skipHeight (nodeHeight walk)-                heightSkipPrev = skipHeight (nodeHeight walk - 1)-             in if not (isGenesis walk) &&-                   (heightSkip == height ||-                    (heightSkip > height &&-                     not-                         (heightSkipPrev < heightSkip - 2 &&-                          heightSkipPrev >= height)))-                    then do-                        walk' <- fromMaybe e1 <$> getBlockHeader (nodeSkip walk)-                        go walk'-                    else do-                        walk' <--                            fromMaybe e2 <$>-                            getBlockHeader (prevBlock (nodeHeader walk))-                        go walk'-        | otherwise = return $ Just walk---- | Is the provided 'BlockNode' the Genesis block?-isGenesis :: BlockNode -> Bool-isGenesis GenesisNode{} = True-isGenesis BlockNode{}   = False---- | Build the genesis 'BlockNode' for the supplied 'Network'.-genesisNode :: Network -> BlockNode-genesisNode net =-    GenesisNode-        { nodeHeader = getGenesisHeader net-        , nodeHeight = 0-        , nodeWork = headerWork (getGenesisHeader net)-        }---- | Validate a list of continuous block headers and import them to the--- block chain. Return 'Left' on failure with error information.-connectBlocks :: BlockHeaders m-              => Network-              -> Timestamp       -- ^ current time-              -> [BlockHeader]-              -> m (Either String [BlockNode])-connectBlocks _ _ [] = return $ Right []-connectBlocks net t bhs@(bh:_) =-    runExceptT $ do-        unless (chained bhs) $-            throwError "Blocks to connect do not form a chain"-        par <--            maybeToExceptT-                "Could not get parent block"-                (MaybeT (parentBlock bh))-        pars <- lift $ getParents 10 par-        bb <- lift getBestBlockHeader-        go par [] bb par pars bhs >>= \case-            bns@(bn:_) -> do-                lift $ addBlockHeaders bns-                let bb' = chooseBest bn bb-                when (bb' /= bb) $ lift $ setBestBlockHeader bb'-                return bns-            _ -> undefined-  where-    chained (h1:h2:hs) = headerHash h1 == prevBlock h2 && chained (h2 : hs)-    chained _          = True-    skipit lbh ls par-        | sh == nodeHeight lbh = return lbh-        | sh < nodeHeight lbh = do-            skM <- lift $ getAncestor sh lbh-            case skM of-                Just sk -> return sk-                Nothing ->-                    throwError $-                    "BUG: Could not get skip for block " ++-                    show (headerHash $ nodeHeader par)-        | otherwise = do-            let sn = ls !! fromIntegral (nodeHeight par - sh)-            when (nodeHeight sn /= sh) $-                throwError "BUG: Node height not right in skip"-            return sn-      where-        sh = skipHeight (nodeHeight par + 1)-    go _ acc _ _ _ [] = return acc-    go lbh acc bb par pars (h:hs) = do-        sk <- skipit lbh acc par-        bn <- ExceptT . return $ validBlock net t bb par pars h sk-        go lbh (bn : acc) (chooseBest bn bb) bn (take 10 $ par : pars) hs---- | Block's parent. If the block header is in the store, its parent must also--- be there. No block header get deleted or pruned from the store.-parentBlock :: BlockHeaders m-            => BlockHeader-            -> m (Maybe BlockNode)-parentBlock bh = getBlockHeader (prevBlock bh)---- | Validate and connect single block header to the block chain. Return 'Left' if fails--- to be validated.-connectBlock ::-       BlockHeaders m-    => Network-    -> Timestamp -- ^ current time-    -> BlockHeader-    -> m (Either String BlockNode)-connectBlock net t bh =-    runExceptT $ do-        par <--            maybeToExceptT-                "Could not get parent block"-                (MaybeT (parentBlock bh))-        pars <- lift $ getParents 10 par-        skM <- lift $ getAncestor (skipHeight (nodeHeight par + 1)) par-        sk <--            case skM of-                Just sk -> return sk-                Nothing ->-                    throwError $-                    "BUG: Could not get skip for block " ++-                    show (headerHash $ nodeHeader par)-        bb <- lift getBestBlockHeader-        bn <- ExceptT . return $ validBlock net t bb par pars bh sk-        let bb' = chooseBest bb bn-        lift $ addBlockHeader bn-        when (bb /= bb') . lift $ setBestBlockHeader bb'-        return bn---- | Validate this block header. Build a 'BlockNode' if successful.-validBlock :: Network-           -> Timestamp     -- ^ current time-           -> BlockNode     -- ^ best block-           -> BlockNode     -- ^ immediate parent-           -> [BlockNode]   -- ^ 10 parents above-           -> BlockHeader   -- ^ header to validate-           -> BlockNode     -- ^ skip node (black magic)-           -> Either String BlockNode-validBlock net t bb par pars bh sk = do-    let mt = medianTime . map (blockTimestamp . nodeHeader) $ par : pars-        nt = blockTimestamp bh-        hh = headerHash bh-        nv = blockVersion bh-        ng = nodeHeight par + 1-        aw = nodeWork par + headerWork bh-    unless (isValidPOW net bh) $-        Left $ "Proof of work failed: " ++ show (headerHash bh)-    unless (nt <= t + 2 * 60 * 60) $-        Left $ "Invalid header timestamp: " ++ show nt-    unless (nt >= mt) $-        Left $ "Block timestamp too early: " ++ show nt-    unless (afterLastCP net (nodeHeight bb) ng) $-        Left $ "Rewriting pre-checkpoint chain: " ++ show ng-    unless (validCP net ng hh) $-        Left $ "Rejected checkpoint: " ++ show ng-    unless (bip34 net ng hh) $-        Left $ "Rejected BIP-34 block: " ++ show hh-    unless (validVersion net ng nv) $-        Left $ "Invalid block version: " ++ show nv-    return BlockNode { nodeHeader = bh-                     , nodeHeight = ng-                     , nodeWork = aw-                     , nodeSkip = headerHash $ nodeHeader sk-                     }---- | Return the median of all provided timestamps. Can be unsorted. Error on--- empty list.-medianTime :: [Timestamp] -> Timestamp-medianTime ts-    | null ts = error "Cannot compute median time of empty header list"-    | otherwise = sort ts !! (length ts `div` 2)---- | Calculate the height of the skip (magic) block that corresponds to the--- given height. The block hash of the ancestor at that height will be placed on--- the 'BlockNode' structure to help locate ancestors at any height quickly.-skipHeight :: BlockHeight -> BlockHeight-skipHeight height-    | height < 2 = 0-    | height .&. 1 /= 0 = invertLowestOne (invertLowestOne $ height - 1) + 1-    | otherwise = invertLowestOne height---- | Part of the skip black magic calculation.-invertLowestOne :: BlockHeight -> BlockHeight-invertLowestOne height = height .&. (height - 1)---- | Get a number of parents for the provided block.-getParents :: BlockHeaders m-           => Int-           -> BlockNode-           -> m [BlockNode]   -- ^ starts from immediate parent-getParents = getpars []-  where-    getpars acc 0 _ = return $ reverse acc-    getpars acc _ GenesisNode{} = return $ reverse acc-    getpars acc n BlockNode{..} = do-        parM <- getBlockHeader $ prevBlock nodeHeader-        case parM of-            Just bn -> getpars (bn : acc) (n - 1) bn-            Nothing -> error "BUG: All non-genesis blocks should have a parent"---- | Verify that checkpoint location is valid.-validCP :: Network-        -> BlockHeight  -- ^ new child height-        -> BlockHash    -- ^ new child hash-        -> Bool-validCP net height newChildHash =-    case lookup height (getCheckpoints net) of-        Just cpHash -> cpHash == newChildHash-        Nothing     -> True---- | New block height above the last checkpoint imported. Used to prevent a--- reorg below the highest checkpoint that was already imported.-afterLastCP :: Network-            -> BlockHeight  -- ^ best height-            -> BlockHeight  -- ^ new imported block height-            -> Bool-afterLastCP net bestHeight newChildHeight =-    case lM of-        Just l  -> l < newChildHeight-        Nothing -> True-  where-    lM =-        listToMaybe . reverse $-        [c | (c, _) <- getCheckpoints net, c <= bestHeight]---- | This block should be at least version 2 (BIP34). Block height must be--- included in the coinbase transaction to prevent non-unique transaction--- hashes.-bip34 :: Network-      -> BlockHeight  -- ^ new child height-      -> BlockHash    -- ^ new child hash-      -> Bool-bip34 net height hsh-    | fst (getBip34Block net) == 0 = True-    | fst (getBip34Block net) == height = snd (getBip34Block net) == hsh-    | otherwise = True---- | Check if the provided block height and version are valid.-validVersion :: Network-             -> BlockHeight  -- ^ new child height-             -> Word32       -- ^ new child version-             -> Bool-validVersion net height version-    | version < 2 = height < fst (getBip34Block net)-    | version < 3 = height < getBip66Height net-    | version < 4 = height < getBip65Height net-    | otherwise = True---- | Find last block with normal, as opposed to minimum difficulty (for test--- networks).-lastNoMinDiff :: BlockHeaders m => Network -> BlockNode -> m BlockNode-lastNoMinDiff net bn@BlockNode {..} = do-    let i = nodeHeight `mod` diffInterval net /= 0-        c = encodeCompact (getPowLimit net)-        l = blockBits nodeHeader == c-        e1 =-            error $-            "Could not get block header for parent of " ++-            show (headerHash nodeHeader)-    if i && l-        then do-            bn' <- fromMaybe e1 <$> getBlockHeader (prevBlock nodeHeader)-            lastNoMinDiff net bn'-        else return bn--lastNoMinDiff _ bn@GenesisNode{} = return bn---- | Returns the work required on a block header given the previous block. This--- coresponds to @bitcoind@ function @GetNextWorkRequired@ in @main.cpp@.-nextWorkRequired :: BlockHeaders m-                 => Network-                 -> BlockNode-                 -> BlockHeader-                 -> m Word32-nextWorkRequired net par bh = do-    let mf = daa <|> eda <|> pow-    case mf of-        Just f -> f net par bh-        Nothing ->-            error-                "Could not get an appropriate difficulty calculation algorithm"-  where-    daa = getDaaBlockHeight net >>= \daaHeight -> do-        guard (nodeHeight par + 1 >= daaHeight)-        return nextDaaWorkRequired-    eda = getEdaBlockHeight net >>= \edaHeight -> do-        guard (nodeHeight par + 1 >= edaHeight)-        return nextEdaWorkRequired-    pow = return nextPowWorkRequired---- | Find out the next amount of work required according to the Emergency--- Difficulty Adjustment (EDA) algorithm from Bitcoin Cash.-nextEdaWorkRequired ::-       BlockHeaders m => Network -> BlockNode -> BlockHeader -> m Word32-nextEdaWorkRequired net par bh-    | nodeHeight par + 1 `mod` diffInterval net == 0 =-        nextWorkRequired net par bh-    | minDifficulty = return (encodeCompact (getPowLimit net))-    | blockBits (nodeHeader par) == encodeCompact (getPowLimit net) =-        return (encodeCompact (getPowLimit net))-    | otherwise = do-        par6 <- fromMaybe e1 <$> getAncestor (nodeHeight par - 6) par-        pars <- getParents 10 par-        pars6 <- getParents 10 par6-        let par6med =-                medianTime $ map (blockTimestamp . nodeHeader) (par6 : pars6)-            parmed = medianTime $ map (blockTimestamp . nodeHeader) (par : pars)-            mtp6 = parmed - par6med-        if mtp6 < 12 * 3600-            then return $ blockBits (nodeHeader par)-            else return $-                 let (diff, _) = decodeCompact (blockBits (nodeHeader par))-                     ndiff = diff + (diff `shiftR` 2)-                  in if getPowLimit net > ndiff-                         then encodeCompact (getPowLimit net)-                         else encodeCompact ndiff-  where-    minDifficulty =-        blockTimestamp bh >-        blockTimestamp (nodeHeader par) + getTargetSpacing net * 2-    e1 = error "Could not get seventh ancestor of block"---- | Find the next amount of work required according to the Difficulty--- Adjustment Algorithm (DAA) from Bitcoin Cash.-nextDaaWorkRequired ::-       BlockHeaders m => Network -> BlockNode -> BlockHeader -> m Word32-nextDaaWorkRequired net par bh-    | minDifficulty = return (encodeCompact (getPowLimit net))-    | otherwise = do-        let height = nodeHeight par-        unless (height >= diffInterval net) $-            error "Block height below difficulty interval"-        l <- getSuitableBlock par-        par144 <- fromMaybe e1 <$> getAncestor (height - 144) par-        f <- getSuitableBlock par144-        let nextTarget = computeTarget net f l-        if nextTarget > getPowLimit net-            then return $ encodeCompact (getPowLimit net)-            else return $ encodeCompact nextTarget-  where-    e1 = error "Cannot get ancestor at parent - 144 height"-    minDifficulty =-        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)-        actualTimespan =-            blockTimestamp (nodeHeader l) - blockTimestamp (nodeHeader f)-        actualTimespan'-            | actualTimespan > 288 * getTargetSpacing net =-                288 * getTargetSpacing net-            | actualTimespan < 72 * getTargetSpacing net =-                72 * getTargetSpacing net-            | otherwise = actualTimespan-        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"-    blocks <- (par :) <$> getParents 2 par-    return $ sortBy (compare `on` blockTimestamp . nodeHeader) blocks !! 1---- | Returns the work required on a block header given the previous block. This--- coresponds to bitcoind function GetNextWorkRequired in main.cpp.-nextPowWorkRequired ::-       BlockHeaders m => Network -> BlockNode -> BlockHeader -> m Word32-nextPowWorkRequired net par bh-    | nodeHeight par + 1 `mod` diffInterval net /= 0 =-        if getAllowMinDifficultyBlocks net-            then if ht > pt + delta-                     then return $ encodeCompact (getPowLimit net)-                     else do-                         d <- lastNoMinDiff net par-                         return $ blockBits $ nodeHeader d-            else return $ blockBits $ nodeHeader par-    | otherwise = do-        let rh = nodeHeight par - (diffInterval net - 1)-        a <- fromMaybe e1 <$> getAncestor rh par-        let t = blockTimestamp $ nodeHeader a-        return $ calcNextWork net (nodeHeader par) t-  where-    e1 = error "Could not get ancestor for block header"-    pt = blockTimestamp $ nodeHeader par-    ht = blockTimestamp bh-    delta = getTargetSpacing net * 2---- | Computes the work required for the first block in a new retarget period.-calcNextWork :: Network-             -> BlockHeader  -- ^ last block in previous retarget (parent)-             -> Timestamp    -- ^ timestamp of first block in previous retarget-             -> Word32-calcNextWork net header time-    | getPowNoRetargetting net = blockBits header-    | new > getPowLimit net = encodeCompact (getPowLimit net)-    | otherwise = encodeCompact new-  where-    s = blockTimestamp header - time-    n | s < getTargetTimespan net `div` 4 = getTargetTimespan net `div` 4-      | s > getTargetTimespan net * 4 = getTargetTimespan net * 4-      | otherwise = s-    l = fst $ decodeCompact $ blockBits header-    new = l * fromIntegral n `div` fromIntegral (getTargetTimespan net)---- | Returns True if the difficulty target (bits) of the header is valid and the--- proof of work of the header matches the advertised difficulty target. This--- function corresponds to the function @CheckProofOfWork@ from @bitcoind@ in--- @main.cpp@.-isValidPOW :: Network -> BlockHeader -> Bool-isValidPOW net h-    | target <= 0 || over || target > getPowLimit net = False-    | otherwise = blockPOW (headerHash h) <= fromIntegral target-  where-    (target, over) = decodeCompact $ blockBits h---- | Returns the proof of work of a block header hash as an 'Integer' number.-blockPOW :: BlockHash -> Integer-blockPOW =  bsToInteger . B.reverse . encode---- | Returns the work represented by this block. Work is defined as the number--- of tries needed to solve a block in the average case with respect to the--- target.-headerWork :: BlockHeader -> Integer-headerWork bh = largestHash `div` (target + 1)-  where-    target      = fst $ decodeCompact $ blockBits bh-    largestHash = 1 `shiftL` 256---- | Number of blocks on average between difficulty cycles (2016 blocks).-diffInterval :: Network -> Word32-diffInterval net = getTargetTimespan net `div` getTargetSpacing net---- | Compare two blocks to get the best.-chooseBest :: BlockNode -> BlockNode -> BlockNode-chooseBest b1 b2 | nodeWork b1 == nodeWork b2 =-                       if nodeHeight b1 >= nodeHeight b2-                       then b1-                       else b2-                 | nodeWork b1 > nodeWork b2 = b1-                 | otherwise = b2---- | Get list of blocks for a block locator.-blockLocatorNodes :: BlockHeaders m => BlockNode -> m [BlockNode]-blockLocatorNodes best =-    reverse <$> go [] best 1-  where-    e1 = error "Could not get ancestor"-    go loc bn n =-        let loc' = bn : loc-            n' = if length loc' > 10-                 then n * 2-                 else 1-        in if nodeHeight bn < n'-           then do a <- fromMaybe e1 <$> getAncestor 0 bn-                   return $ a : loc'-           else do let h = nodeHeight bn - n'-                   bn' <- fromMaybe e1 <$> getAncestor h bn-                   go loc' bn' n'---- | Get block locator.-blockLocator :: BlockHeaders m => BlockNode -> m BlockLocator-blockLocator bn = map (headerHash . nodeHeader) <$> blockLocatorNodes bn---- | Become rich beyond your wildest dreams.-mineBlock :: Network -> Word32 -> BlockHeader -> BlockHeader-mineBlock net seed h =-    head-        [ j-        | i <- (+ seed) <$> [0 .. maxBound]-        , let j = h {bhNonce = i}-        , isValidPOW net j-        ]---- | Generate and append new blocks (mining). Only practical in regtest network.-appendBlocks ::-       Network-    -> Word32 -- ^ random seed-    -> BlockHeader-    -> Int-    -> [BlockHeader]-appendBlocks _ _ _ 0 = []-appendBlocks net seed bh i =-    bh' : appendBlocks net seed bh' (i - 1)-  where-    bh' = mineBlock net seed bh-        { prevBlock = headerHash bh-          -- Just to make it different in every header-        , merkleRoot = sha256 $ encode seed-        }---- | Find the last common block ancestor between provided block headers.-splitPoint :: BlockHeaders m => BlockNode -> BlockNode -> m BlockNode-splitPoint l r = do-    let h = min (nodeHeight l) (nodeHeight r)-    ll <- fromMaybe e <$> getAncestor h l-    lr <- fromMaybe e <$> getAncestor h r-    f ll lr-  where-    e = error "BUG: Could not get ancestor at lowest height"-    f ll lr =-        if ll == lr-            then return lr-            else do-                let h = nodeHeight ll - 1-                pl <- fromMaybe e <$> getAncestor h ll-                pr <- fromMaybe e <$> getAncestor h lr-                f pl pr---- | Generate the entire Genesis block for 'Network'.-genesisBlock :: Network -> Block-genesisBlock net = Block (getGenesisHeader net) [genesisTx]---- | Compute block subsidy at particular height.-computeSubsidy :: Network -> BlockHeight -> Word64-computeSubsidy net height =-    let halvings = height `div` getHalvingInterval net-        ini = 50 * 100 * 1000 * 1000-     in if halvings >= 64-            then 0-            else ini `shiftR` fromIntegral halvings
− src/Network/Haskoin/Block/Merkle.hs 
@@ -1,256 +0,0 @@-{-# LANGUAGE DeriveAnyClass #-}-{-# LANGUAGE DeriveGeneric  #-}-{-|-Module      : Network.Haskoin.Block.Merkle-Copyright   : No rights reserved-License     : UNLICENSE-Maintainer  : jprupp@protonmail.ch-Stability   : experimental-Portability : POSIX--Function to deal with Merkle trees inside blocks.--}-module Network.Haskoin.Block.Merkle-    ( MerkleBlock(..)-    , MerkleRoot-    , FlagBits-    , PartialMerkleTree-    , buildMerkleRoot-    , merkleBlockTxs-    , testMerkleRoot-    -- * Helper functions-    , buildPartialMerkle-    , decodeMerkleFlags-    , encodeMerkleFlags-    , calcTreeHeight-    , calcTreeWidth-    , hash2-    , calcHash-    , traverseAndBuild-    , traverseAndExtract-    , extractMatches-    , splitIn-    , boolsToWord8-    ) where--import           Control.DeepSeq-import           Control.Monad                      (forM_, replicateM, when)-import           Data.Bits-import qualified Data.ByteString                    as BS-import           Data.Either                        (isRight)-import           Data.Hashable-import           Data.Maybe-import           Data.Serialize                     (Serialize, encode, get,-                                                     put)-import           Data.Serialize.Get                 (getWord32le, getWord8)-import           Data.Serialize.Put                 (putWord32le, putWord8)-import           Data.Word                          (Word32, Word8)-import           GHC.Generics-import           Network.Haskoin.Block.Common-import           Network.Haskoin.Constants-import           Network.Haskoin.Crypto.Hash-import           Network.Haskoin.Network.Common-import           Network.Haskoin.Transaction.Common---- | Hash of the block's Merkle root.-type MerkleRoot        = Hash256---- | Bits that are used to rebuild partial merkle tree transaction hash list.-type FlagBits          = [Bool]---- | Partial Merkle tree for a filtered block.-type PartialMerkleTree = [Hash256]---- | Filtered block: a block with a partial Merkle tree that only includes the--- transactions that pass a bloom filter that was negotiated.-data MerkleBlock =-    MerkleBlock {-                -- | block header-                  merkleHeader    :: !BlockHeader-                -- | total number of transactions in block-                , merkleTotalTxns :: !Word32-                -- | hashes in depth-first order-                , mHashes         :: !PartialMerkleTree-                -- | bits to rebuild partial merkle tree-                , mFlags          :: !FlagBits-                } deriving (Eq, Show, Read, Generic, Hashable, NFData)--instance Serialize MerkleBlock where--    get = do-        header <- get-        ntx    <- getWord32le-        (VarInt matchLen) <- get-        hashes <- replicateM (fromIntegral matchLen) get-        (VarInt flagLen)  <- get-        ws <- replicateM (fromIntegral flagLen) getWord8-        return $ MerkleBlock header ntx hashes (decodeMerkleFlags ws)--    put (MerkleBlock h ntx hashes flags) = do-        put h-        putWord32le ntx-        putVarInt $ length hashes-        forM_ hashes put-        let ws = encodeMerkleFlags flags-        putVarInt $ length ws-        forM_ ws putWord8---- | Unpack Merkle flags into 'FlagBits' structure.-decodeMerkleFlags :: [Word8] -> FlagBits-decodeMerkleFlags ws =-    [ b | p <- [ 0 .. length ws * 8 - 1 ]-        , b <- [ testBit (ws !! (p `div` 8)) (p `mod` 8) ]-    ]---- | Pack Merkle flags from 'FlagBits'.-encodeMerkleFlags :: FlagBits -> [Word8]-encodeMerkleFlags bs = map boolsToWord8 $ splitIn 8 bs---- | Computes the height of a Merkle tree.-calcTreeHeight :: Int -- ^ number of transactions (leaf nodes)-               -> Int -- ^ height of the merkle tree-calcTreeHeight ntx | ntx < 2 = 0-                   | even ntx  = 1 + calcTreeHeight (ntx `div` 2)-                   | otherwise = calcTreeHeight $ ntx + 1---- | Computes the width of a Merkle tree at a specific height. The transactions--- are at height 0.-calcTreeWidth :: Int -- ^ number of transactions (leaf nodes)-              -> Int -- ^ height at which we want to compute the width-              -> Int -- ^ width of the Merkle tree-calcTreeWidth ntx h = (ntx + (1 `shiftL` h) - 1) `shiftR` h---- | Computes the root of a Merkle tree from a list of leaf node hashes.-buildMerkleRoot :: [TxHash]   -- ^ transaction hashes (leaf nodes)-                -> MerkleRoot -- ^ root of the Merkle tree-buildMerkleRoot txs = calcHash (calcTreeHeight $ length txs) 0 txs---- | Concatenate and compute double SHA256.-hash2 :: Hash256 -> Hash256 -> Hash256-hash2 a b = doubleSHA256 $ encode a `BS.append` encode b---- | Computes the hash of a specific node in a Merkle tree.-calcHash :: Int       -- ^ height of the node-         -> Int       -- ^ position of the node (0 for the leftmost node)-         -> [TxHash]  -- ^ transaction hashes (leaf nodes)-         -> Hash256   -- ^ hash of the node at the specified position-calcHash height pos txs-    | height < 0 || pos < 0 = error "calcHash: Invalid parameters"-    | height == 0 = getTxHash $ txs !! pos-    | otherwise = hash2 left right-  where-    left = calcHash (height-1) (pos*2) txs-    right | pos*2+1 < calcTreeWidth (length txs) (height-1) =-                calcHash (height-1) (pos*2+1) txs-          | otherwise = left---- | Build a partial Merkle tree. Provide a list of tuples with all transaction--- hashes in the block, and whether the transaction is to be included in the--- partial tree. Returns a flag bits structure and the computed partial Merkle--- tree.-buildPartialMerkle ::-       [(TxHash, Bool)] -- ^ transaction hash and whether to include-    -> (FlagBits, PartialMerkleTree) -- ^ flag bits and partial Merkle tree-buildPartialMerkle hs = traverseAndBuild (calcTreeHeight $ length hs) 0 hs---- | Helper function to build partial Merkle tree. Used by 'buildPartialMerkle'--- above.-traverseAndBuild ::-       Int -> Int -> [(TxHash, Bool)] -> (FlagBits, PartialMerkleTree)-traverseAndBuild height pos txs-    | height < 0 || pos < 0 = error "traverseAndBuild: Invalid parameters"-    | height == 0 || not match = ([match], [calcHash height pos t])-    | otherwise = (match : lb ++ rb, lh ++ rh)-  where-    t = map fst txs-    s = pos `shiftL` height-    e = min (length txs) $ (pos + 1) `shiftL` height-    match = any snd $ take (e - s) $ drop s txs-    (lb, lh) = traverseAndBuild (height - 1) (pos * 2) txs-    (rb, rh)-        | (pos * 2 + 1) < calcTreeWidth (length txs) (height - 1) =-            traverseAndBuild (height - 1) (pos * 2 + 1) txs-        | otherwise = ([], [])---- | Helper function to extract transaction hashes from partial Merkle tree.-traverseAndExtract :: Int -> Int -> Int -> FlagBits -> PartialMerkleTree-                   -> Maybe (MerkleRoot, [TxHash], Int, Int)-traverseAndExtract height pos ntx flags hashes-    | null flags               = Nothing-    | height == 0 || not match = leafResult-    | isNothing leftM          = Nothing-    | (pos*2+1) >= calcTreeWidth ntx (height-1) =-        Just (hash2 lh lh, lm, lcf+1, lch)-    | isNothing rightM         = Nothing-    | otherwise =-        Just (hash2 lh rh, lm ++ rm, lcf+rcf+1, lch+rch)-  where-    leafResult-        | null hashes = Nothing-        | otherwise = Just (h, [ TxHash h | height == 0 && match ], 1, 1)-    (match:fs) = flags-    (h:_)     = hashes-    leftM  = traverseAndExtract (height-1) (pos*2) ntx fs hashes-    (lh,lm,lcf,lch) = fromMaybe e leftM-    rightM = traverseAndExtract (height-1) (pos*2+1) ntx-                (drop lcf fs) (drop lch hashes)-    (rh,rm,rcf,rch) = fromMaybe e rightM-    e = error "traverseAndExtract: unexpected error extracting a Maybe value"---- | Extracts the matching hashes from a partial merkle tree. This will return--- the list of transaction hashes that have been included (set to true) in--- a call to 'buildPartialMerkle'.-extractMatches :: Network-               -> FlagBits-               -> PartialMerkleTree-               -> Int -- ^ number of transaction at height 0 (leaf nodes)-               -> Either String (MerkleRoot, [TxHash])-               -- ^ Merkle root and list of matching transaction hashes-extractMatches net flags hashes ntx-    | ntx == 0 = Left-        "extractMatches: number of transactions can not be 0"-    | ntx > getMaxBlockSize net `div` 60 = Left-        "extractMatches: number of transactions excessively high"-    | length hashes > ntx = Left-        "extractMatches: More hashes provided than the number of transactions"-    | length flags < length hashes = Left-        "extractMatches: At least one bit per node and one bit per hash"-    | isNothing resM = Left-        "extractMatches: traverseAndExtract failed"-    | (nBitsUsed+7) `div` 8 /= (length flags+7) `div` 8 = Left-        "extractMatches: All bits were not consumed"-    | nHashUsed /= length hashes = Left $-        "extractMatches: All hashes were not consumed: " ++ show nHashUsed-    | otherwise = return (merkRoot, matches)-  where-    resM = traverseAndExtract (calcTreeHeight ntx) 0 ntx flags hashes-    (merkRoot, matches, nBitsUsed, nHashUsed) = fromMaybe e resM-    e = error "extractMatches: unexpected error extracting a Maybe value"---- | Helper function to split a list in chunks 'Int' length. Last chunk may be--- smaller.-splitIn :: Int -> [a] -> [[a]]-splitIn _ [] = []-splitIn c xs = xs1 : splitIn c xs2-  where-    (xs1, xs2) = splitAt c xs---- | Pack up to eight bools in a byte.-boolsToWord8 :: [Bool] -> Word8-boolsToWord8 [] = 0-boolsToWord8 xs = foldl setBit 0 (map snd $ filter fst $ zip xs [0..7])---- | Get matching transactions from Merkle block.-merkleBlockTxs :: Network -> MerkleBlock -> Either String [TxHash]-merkleBlockTxs net b =-    let flags = mFlags b-        hs = mHashes b-        n = fromIntegral $ merkleTotalTxns b-        merkle = merkleRoot $ merkleHeader b-    in do (root, ths) <- extractMatches net flags hs n-          when (root /= merkle) $ Left "merkleBlockTxs: Merkle root incorrect"-          return ths---- | Check if Merkle block root is valid against the block header.-testMerkleRoot :: Network -> MerkleBlock -> Bool-testMerkleRoot net = isRight . merkleBlockTxs net
− src/Network/Haskoin/Constants.hs 
@@ -1,540 +0,0 @@-{-# LANGUAGE DeriveAnyClass    #-}-{-# LANGUAGE DeriveGeneric     #-}-{-# LANGUAGE OverloadedStrings #-}-{-|-Module      : Network.Haskoin.Constants-Copyright   : No rights reserved-License     : UNLICENSE-Maintainer  : jprupp@protonmail.ch-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-    , btcTest-    , btcRegTest-    , bch-    , bchTest-    , bchRegTest-    , allNets-    , netByName-    , netByIdent-    ) where--import           Control.DeepSeq-import           Data.ByteString              (ByteString)-import           Data.List-import           Data.Maybe-import           Data.Serialize-import           Data.String-import           Data.Text                    (Text)-import           Data.Version-import           Data.Word                    (Word32, Word64, Word8)-import           GHC.Generics                 (Generic)-import           Network.Haskoin.Block.Common-import           Paths_haskoin_core-import           Text.Read---- | Version of Haskoin Core package.-versionString :: IsString a => a-versionString = fromString (showVersion version)---- | Constants for network.-data Network = Network-    { -- | lowercase alphanumeric and dashes-      getNetworkName              :: !String-      -- | network Haskell identifier-    , getNetworkIdent             :: !String-      -- | prefix for 'Base58' P2PKH addresses-    , getAddrPrefix               :: !Word8-      -- | prefix for 'Base58' P2SH addresses-    , getScriptPrefix             :: !Word8-      -- | prefix for WIF private key-    , getSecretPrefix             :: !Word8-      -- | prefix for extended public key-    , getExtPubKeyPrefix          :: !Word32-      -- | prefix for extended private key-    , getExtSecretPrefix          :: !Word32-      -- | network magic-    , getNetworkMagic             :: !Word32-      -- | genesis block header-    , getGenesisHeader            :: !BlockHeader-      -- | maximum block size in bytes-    , getMaxBlockSize             :: !Int-      -- | maximum amount of satoshi-    , getMaxSatoshi               :: !Word64-      -- | user agent string-    , getHaskoinUserAgent         :: !ByteString-      -- | default port for P2P connections-    , getDefaultPort              :: !Int-      -- | allow min difficulty blocks (testnet)-    , getAllowMinDifficultyBlocks :: !Bool-      -- | do not retarget difficulty (regtest)-    , getPowNoRetargetting        :: !Bool-      -- | proof-of-work target higest possible value-    , getPowLimit                 :: !Integer-      -- | block at which BIP34 activates-    , getBip34Block               :: !(BlockHeight, BlockHash)-      -- | block at which BIP65 activates-    , getBip65Height              :: !BlockHeight-      -- | block at which BIP66 activates-    , getBip66Height              :: !BlockHeight-      -- | time between difficulty retargets-    , getTargetTimespan           :: !Word32-      -- | time between blocks-    , getTargetSpacing            :: !Word32-      -- | checkpoints-    , getCheckpoints              :: ![(BlockHeight, BlockHash)]-      -- | BIP44 derivation path root-    , getBip44Coin                :: !Word32-      -- | peer-to-peer network seeds-    , getSeeds                    :: ![String]-      -- | fork id for replay protection-    , getSigHashForkId            :: !(Maybe Word32)-      -- | EDA start block height-    , getEdaBlockHeight           :: !(Maybe Word32)-      -- | DAA start block height-    , getDaaBlockHeight           :: !(Maybe Word32)-      -- | segregated witness active-    , getSegWit                   :: !Bool-      -- | 'CashAddr' prefix (for Bitcoin Cash)-    , getCashAddrPrefix           :: !(Maybe Text)-      -- | 'Bech32' prefix (for SegWit network)-    , getBech32Prefix             :: !(Maybe Text)-      -- | Replace-By-Fee (BIP-125)-    , getReplaceByFee             :: !Bool-      -- | Subsidy halving interval-    , getHalvingInterval          :: !Word32-    } deriving (Eq, Generic, NFData)--instance Serialize Network where-    put net =-        putWord32be $ getNetworkMagic net-    get = do-        magic <- getWord32be-        case find ((== magic) . getNetworkMagic) allNets of-            Nothing  -> fail $ "Network magic unknown: " <> show magic-            Just net -> return net--instance Show Network where-    show = getNetworkIdent--instance Read Network where-    readPrec = do-        Ident str <- lexP-        maybe pfail return (netByIdent str)--instance IsString Network where-    fromString = fromMaybe (error "Network name invalid") . netByName---- | Query known networks by name.-netByName :: String -> Maybe Network-netByName str = find ((== str) . getNetworkName) allNets---- | Query known networks by Haskell identifier.-netByIdent :: String -> Maybe Network-netByIdent str = find ((== str) . getNetworkIdent) allNets---- | Bitcoin SegWit network. Symbol: BTC.-btc :: Network-btc =-    Network-    { getNetworkName = "btc"-    , getNetworkIdent = "btc"-    , getAddrPrefix = 0-    , getScriptPrefix = 5-    , getSecretPrefix = 128-    , getExtPubKeyPrefix = 0x0488b21e-    , getExtSecretPrefix = 0x0488ade4-    , getNetworkMagic = 0xf9beb4d9-    , getGenesisHeader =-          BlockHeader-              0x01-              "0000000000000000000000000000000000000000000000000000000000000000"-              "3ba3edfd7a7b12b27ac72c3e67768f617fc81bc3888a51323a9fb8aa4b1e5e4a"-              1231006505-              0x1d00ffff-              2083236893-            -- Hash 000000000019d6689c085ae165831e934ff763ae46a2a6c172b3f1b60a8ce26f-    , getMaxBlockSize = 1000000-    , getMaxSatoshi = 2100000000000000-    , getHaskoinUserAgent =-          "/haskoin-btc:" <> versionString <> "/"-    , getDefaultPort = 8333-    , getAllowMinDifficultyBlocks = False-    , getPowNoRetargetting = False-    , getPowLimit =-          0x00000000ffffffffffffffffffffffffffffffffffffffffffffffffffffffff-    , getBip34Block =-          ( 227931-          , "000000000000024b89b42a942fe0d9fea3bb44ab7bd1b19115dd6a759c0808b8")-    , getBip65Height = 388381-    , getBip66Height = 363725-    , getTargetTimespan = 14 * 24 * 60 * 60-    , getTargetSpacing = 10 * 60-    , getCheckpoints =-          [ ( 11111-            , "0000000069e244f73d78e8fd29ba2fd2ed618bd6fa2ee92559f542fdb26e7c1d")-          , ( 33333-            , "000000002dd5588a74784eaa7ab0507a18ad16a236e7b1ce69f00d7ddfb5d0a6")-          , ( 74000-            , "0000000000573993a3c9e41ce34471c079dcf5f52a0e824a81e7f953b8661a20")-          , ( 105000-            , "00000000000291ce28027faea320c8d2b054b2e0fe44a773f3eefb151d6bdc97")-          , ( 134444-            , "00000000000005b12ffd4cd315cd34ffd4a594f430ac814c91184a0d42d2b0fe")-          , ( 168000-            , "000000000000099e61ea72015e79632f216fe6cb33d7899acb35b75c8303b763")-          , ( 193000-            , "000000000000059f452a5f7340de6682a977387c17010ff6e6c3bd83ca8b1317")-          , ( 210000-            , "000000000000048b95347e83192f69cf0366076336c639f9b7228e9ba171342e")-          , ( 216116-            , "00000000000001b4f4b433e81ee46494af945cf96014816a4e2370f11b23df4e")-          , ( 225430-            , "00000000000001c108384350f74090433e7fcf79a606b8e797f065b130575932")-          , ( 250000-            , "000000000000003887df1f29024b06fc2200b55f8af8f35453d7be294df2d214")-          , ( 279000-            , "0000000000000001ae8c72a0b0c301f67e3afca10e819efa9041e458e9bd7e40")-          , ( 295000-            , "00000000000000004d9b4ef50f0f9d686fd69db2e03af35a100370c64632a983")-          ]-    , getSeeds =-          [ "seed.bitcoin.sipa.be" -- Pieter Wuille-          , "dnsseed.bluematt.me" -- Matt Corallo-          , "dnsseed.bitcoin.dashjr.org" -- Luke Dashjr-          , "seed.bitcoinstats.com" -- Chris Decker-          , "seed.bitcoin.jonasschnelli.ch" -- Jonas Schnelli-          , "seed.btc.petertodd.org" -- Peter Todd-          , "seed.bitcoin.sprovoost.nl" -- Sjors Provoost-          ]-    , getBip44Coin = 0-    , getSigHashForkId = Nothing-    , getEdaBlockHeight = Nothing-    , getDaaBlockHeight = Nothing-    , getSegWit = True-    , getCashAddrPrefix = Nothing-    , getBech32Prefix = Just "bc"-    , getReplaceByFee = True-    , getHalvingInterval = 210000-    }---- | Testnet for Bitcoin SegWit network.-btcTest :: Network-btcTest =-    Network-    { getNetworkName = "btctest"-    , getNetworkIdent = "btcTest"-    , getAddrPrefix = 111-    , getScriptPrefix = 196-    , getSecretPrefix = 239-    , getExtPubKeyPrefix = 0x043587cf-    , getExtSecretPrefix = 0x04358394-    , getNetworkMagic = 0x0b110907-    , getGenesisHeader =-          BlockHeader-              0x01-              "0000000000000000000000000000000000000000000000000000000000000000"-              "3ba3edfd7a7b12b27ac72c3e67768f617fc81bc3888a51323a9fb8aa4b1e5e4a"-              1296688602-              486604799-              414098458-            -- Hash 000000000933ea01ad0ee984209779baaec3ced90fa3f408719526f8d77f4943-    , getMaxBlockSize = 1000000-    , getMaxSatoshi = 2100000000000000-    , getHaskoinUserAgent = "/haskoin-btc-test:" <> versionString <> "/"-    , getDefaultPort = 18333-    , getAllowMinDifficultyBlocks = True-    , getPowNoRetargetting = False-    , getPowLimit =-          0x00000000ffffffffffffffffffffffffffffffffffffffffffffffffffffffff-    , getBip34Block =-          ( 21111-          , "0000000023b3a96d3484e5abb3755c413e7d41500f8e2a5c3f0dd01299cd8ef8")-    , getBip65Height = 581885-    , getBip66Height = 330776-    , getTargetTimespan = 14 * 24 * 60 * 60-    , getTargetSpacing = 10 * 60-    , getCheckpoints =-          [ ( 546-            , "000000002a936ca763904c3c35fce2f3556c559c0214345d31b1bcebf76acb70")-          ]-    , getSeeds =-          [ "testnet-seed.bitcoin.jonasschnelli.ch"-          , "seed.tbtc.petertodd.org"-          , "seed.testnet.bitcoin.sprovoost.nl"-          , "testnet-seed.bluematt.me"-          ]-    , getBip44Coin = 1-    , getSigHashForkId = Nothing-    , getEdaBlockHeight = Nothing-    , getDaaBlockHeight = Nothing-    , getSegWit = True-    , getCashAddrPrefix = Nothing-    , getBech32Prefix = Just "tb"-    , getReplaceByFee = True-    , getHalvingInterval = 210000-    }---- | RegTest for Bitcoin SegWit network.-btcRegTest :: Network-btcRegTest =-    Network-    { getNetworkName = "btcreg"-    , getNetworkIdent = "btcRegTest"-    , getAddrPrefix = 111-    , getScriptPrefix = 196-    , getSecretPrefix = 239-    , getExtPubKeyPrefix = 0x043587cf-    , getExtSecretPrefix = 0x04358394-    , getNetworkMagic = 0xfabfb5da-    , getGenesisHeader =-          BlockHeader-           -- 0f9188f13cb7b2c71f2a335e3a4fc328bf5beb436012afca590b1a11466e2206-              0x01-              "0000000000000000000000000000000000000000000000000000000000000000"-              "3ba3edfd7a7b12b27ac72c3e67768f617fc81bc3888a51323a9fb8aa4b1e5e4a"-              1296688602-              0x207fffff-              2-    , getMaxBlockSize = 1000000-    , getMaxSatoshi = 2100000000000000-    , getHaskoinUserAgent = "/haskoin-btc-regtest:" <> versionString <> "/"-    , getDefaultPort = 18444-    , getAllowMinDifficultyBlocks = True-    , getPowNoRetargetting = True-    , getPowLimit =-          0x7fffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff-    , getBip34Block =-          ( 100000000-          , "0000000000000000000000000000000000000000000000000000000000000000")-    , getBip65Height = 1351-    , getBip66Height = 1251-    , getTargetTimespan = 14 * 24 * 60 * 60-    , getTargetSpacing = 10 * 60-    , getCheckpoints = []-    , getSeeds = ["localhost"]-    , getBip44Coin = 1-    , getSigHashForkId = Nothing-    , getEdaBlockHeight = Nothing-    , getDaaBlockHeight = Nothing-    , getSegWit = True-    , getCashAddrPrefix = Nothing-    , getBech32Prefix = Just "bcrt"-    , getReplaceByFee = True-    , getHalvingInterval = 150-    }---- | Bitcoin Cash network. Symbol: BCH.-bch :: Network-bch =-    Network-    { getNetworkName = "bch"-    , getNetworkIdent = "bch"-    , getAddrPrefix = 0-    , getScriptPrefix = 5-    , getSecretPrefix = 128-    , getExtPubKeyPrefix = 0x0488b21e-    , getExtSecretPrefix = 0x0488ade4-    , getNetworkMagic = 0xe3e1f3e8-    , getGenesisHeader =-          BlockHeader-              0x01-              "0000000000000000000000000000000000000000000000000000000000000000"-              "3ba3edfd7a7b12b27ac72c3e67768f617fc81bc3888a51323a9fb8aa4b1e5e4a"-              1231006505-              0x1d00ffff-              2083236893-            -- Hash 000000000019d6689c085ae165831e934ff763ae46a2a6c172b3f1b60a8ce26f-    , getMaxBlockSize = 32000000-    , getMaxSatoshi = 2100000000000000-    , getHaskoinUserAgent = "/haskoin-bch:" <> versionString <> "/"-    , getDefaultPort = 8333-    , getAllowMinDifficultyBlocks = False-    , getPowNoRetargetting = False-    , getPowLimit =-          0x00000000ffffffffffffffffffffffffffffffffffffffffffffffffffffffff-    , getBip34Block =-          ( 227931-          , "000000000000024b89b42a942fe0d9fea3bb44ab7bd1b19115dd6a759c0808b8")-    , getBip65Height = 388381-    , getBip66Height = 363725-    , getTargetTimespan = 14 * 24 * 60 * 60-    , getTargetSpacing = 10 * 60-    , getCheckpoints =-          [ ( 11111-            , "0000000069e244f73d78e8fd29ba2fd2ed618bd6fa2ee92559f542fdb26e7c1d")-          , ( 33333-            , "000000002dd5588a74784eaa7ab0507a18ad16a236e7b1ce69f00d7ddfb5d0a6")-          , ( 74000-            , "0000000000573993a3c9e41ce34471c079dcf5f52a0e824a81e7f953b8661a20")-          , ( 105000-            , "00000000000291ce28027faea320c8d2b054b2e0fe44a773f3eefb151d6bdc97")-          , ( 134444-            , "00000000000005b12ffd4cd315cd34ffd4a594f430ac814c91184a0d42d2b0fe")-          , ( 168000-            , "000000000000099e61ea72015e79632f216fe6cb33d7899acb35b75c8303b763")-          , ( 193000-            , "000000000000059f452a5f7340de6682a977387c17010ff6e6c3bd83ca8b1317")-          , ( 210000-            , "000000000000048b95347e83192f69cf0366076336c639f9b7228e9ba171342e")-          , ( 216116-            , "00000000000001b4f4b433e81ee46494af945cf96014816a4e2370f11b23df4e")-          , ( 225430-            , "00000000000001c108384350f74090433e7fcf79a606b8e797f065b130575932")-          , ( 250000-            , "000000000000003887df1f29024b06fc2200b55f8af8f35453d7be294df2d214")-          , ( 279000-            , "0000000000000001ae8c72a0b0c301f67e3afca10e819efa9041e458e9bd7e40")-          , ( 295000-            , "00000000000000004d9b4ef50f0f9d686fd69db2e03af35a100370c64632a983")-            -- UAHF fork block.-          , ( 478559-            , "000000000000000000651ef99cb9fcbe0dadde1d424bd9f15ff20136191a5eec")-            -- Nov, 13 DAA activation block.-          , ( 504031-            , "0000000000000000011ebf65b60d0a3de80b8175be709d653b4c1a1beeb6ab9c")-          ]-    , getSeeds =-          [ "seed.bitcoinabc.org"-          , "seed-abc.bitcoinforks.org"-          , "btccash-seeder.bitcoinunlimited.info"-          , "seed.bitprim.org"-          , "seed.deadalnix.me"-          , "seeder.criptolayer.net"-          ]-    , getBip44Coin = 145-    , getSigHashForkId = Just 0-    , getEdaBlockHeight = Just 478559-    , getDaaBlockHeight = Just 404031-    , getSegWit = False-    , getCashAddrPrefix = Just "bitcoincash"-    , getBech32Prefix = Nothing-    , getReplaceByFee = False-    , getHalvingInterval = 210000-    }---- | Testnet for Bitcoin Cash network.-bchTest :: Network-bchTest =-    Network-    { getNetworkName = "bchtest"-    , getNetworkIdent = "bchTest"-    , getAddrPrefix = 111-    , getScriptPrefix = 196-    , getSecretPrefix = 239-    , getExtPubKeyPrefix = 0x043587cf-    , getExtSecretPrefix = 0x04358394-    , getNetworkMagic = 0xf4e5f3f4-    , getGenesisHeader =-          BlockHeader-              0x01-              "0000000000000000000000000000000000000000000000000000000000000000"-              "3ba3edfd7a7b12b27ac72c3e67768f617fc81bc3888a51323a9fb8aa4b1e5e4a"-              1296688602-              486604799-              414098458-            -- Hash 000000000933ea01ad0ee984209779baaec3ced90fa3f408719526f8d77f4943-    , getMaxBlockSize = 32000000-    , getMaxSatoshi = 2100000000000000-    , getHaskoinUserAgent = "/haskoin-bch-test:" <> versionString <> "/"-    , getDefaultPort = 18333-    , getAllowMinDifficultyBlocks = True-    , getPowNoRetargetting = False-    , getPowLimit =-          0x00000000ffffffffffffffffffffffffffffffffffffffffffffffffffffffff-    , getBip34Block =-          ( 21111-          , "0000000023b3a96d3484e5abb3755c413e7d41500f8e2a5c3f0dd01299cd8ef8")-    , getBip65Height = 581885-    , getBip66Height = 330776-    , getTargetTimespan = 14 * 24 * 60 * 60-    , getTargetSpacing = 10 * 60-    , getCheckpoints =-          [ ( 546-            , "000000002a936ca763904c3c35fce2f3556c559c0214345d31b1bcebf76acb70")-            -- UAHF fork block.-          , ( 1155876-            , "00000000000e38fef93ed9582a7df43815d5c2ba9fd37ef70c9a0ea4a285b8f5")-            -- Nov, 13. DAA activation block.-          , ( 1188697-            , "0000000000170ed0918077bde7b4d36cc4c91be69fa09211f748240dabe047fb")-          ]-    , getSeeds =-          [ "testnet-seed.bitcoinabc.org"-          , "testnet-seed-abc.bitcoinforks.org"-          , "testnet-seed.bitprim.org"-          , "testnet-seed.deadalnix.me"-          , "testnet-seeder.criptolayer.net"-          ]-    , getBip44Coin = 1-    , getSigHashForkId = Just 0-    , getEdaBlockHeight = Just 1155876-    , getDaaBlockHeight = Just 1188697-    , getSegWit = False-    , getCashAddrPrefix = Just "bchtest"-    , getBech32Prefix = Nothing-    , getReplaceByFee = False-    , getHalvingInterval = 210000-    }---- | RegTest for Bitcoin Cash network.-bchRegTest :: Network-bchRegTest =-    Network-    { getNetworkName = "bchreg"-    , getNetworkIdent = "bchRegTest"-    , getAddrPrefix = 111-    , getScriptPrefix = 196-    , getSecretPrefix = 239-    , getExtPubKeyPrefix = 0x043587cf-    , getExtSecretPrefix = 0x04358394-    , getNetworkMagic = 0xdab5bffa-    , getGenesisHeader =-          BlockHeader-           -- 0f9188f13cb7b2c71f2a335e3a4fc328bf5beb436012afca590b1a11466e2206-              0x01-              "0000000000000000000000000000000000000000000000000000000000000000"-              "3ba3edfd7a7b12b27ac72c3e67768f617fc81bc3888a51323a9fb8aa4b1e5e4a"-              1296688602-              0x207fffff-              2-    , getMaxBlockSize = 1000000-    , getMaxSatoshi = 2100000000000000-    , getHaskoinUserAgent = "/haskoin-bch-regtest:" <> versionString <> "/"-    , getDefaultPort = 18444-    , getAllowMinDifficultyBlocks = True-    , getPowNoRetargetting = True-    , getPowLimit =-          0x7fffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff-    , getBip34Block =-          ( 100000000-          , "0000000000000000000000000000000000000000000000000000000000000000")-    , getBip65Height = 1351-    , getBip66Height = 1251-    , getTargetTimespan = 14 * 24 * 60 * 60-    , getTargetSpacing = 10 * 60-    , getCheckpoints =-          [ ( 0-            , "0f9188f13cb7b2c71f2a335e3a4fc328bf5beb436012afca590b1a11466e2206")-          ]-    , getSeeds = ["localhost"]-    , getBip44Coin = 1-    , getSigHashForkId = Just 0-    , getEdaBlockHeight = Nothing-    , getDaaBlockHeight = Just 0-    , getSegWit = False-    , getCashAddrPrefix = Just "bchreg"-    , getBech32Prefix = Nothing-    , getReplaceByFee = False-    , getHalvingInterval = 150-    }---- | List of all networks supported by this library.-allNets :: [Network]-allNets = [btc, bch, btcTest, bchTest, btcRegTest, bchRegTest]
− src/Network/Haskoin/Crypto.hs 
@@ -1,22 +0,0 @@-{-|-Module      : Network.Haskoin.Crypto-Copyright   : No rights reserved-License     : UNLICENSE-Maintainer  : jprupp@protonmail.ch-Stability   : experimental-Portability : POSIX--Hashing functions and ECDSA signatures.--}-module Network.Haskoin.Crypto-    ( -- * Hashes-      module Hash-      -- * Signatures-    , module Signature-      -- * Secp256k1 (re-exported)-    , module Secp256k1-    ) where--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 
@@ -1,202 +0,0 @@-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE DeriveAnyClass #-}-{-|-Module      : Network.Haskoin.Crypto.Hash-Copyright   : No rights reserved-License     : UNLICENSE-Maintainer  : jprupp@protonmail.ch-Stability   : experimental-Portability : POSIX--Hashing functions and corresponding data types. Uses functions from the-cryptonite library.--}-module Network.Haskoin.Crypto.Hash-    ( -- * Hashes-      Hash512(getHash512)-    , Hash256(getHash256)-    , Hash160(getHash160)-    , CheckSum32(getCheckSum32)-    , sha512-    , sha256-    , ripemd160-    , sha1-    , doubleSHA256-    , addressHash-    , checkSum32-    , hmac512-    , hmac256-    , split512-    , join512-    ) where--import           Control.DeepSeq-import           Crypto.Hash             (RIPEMD160 (..), SHA1 (..),-                                          SHA256 (..), SHA512 (..), hashWith)-import           Crypto.MAC.HMAC         (HMAC, hmac)-import           Data.ByteArray          (ByteArrayAccess)-import qualified Data.ByteArray          as BA-import           Data.ByteString         (ByteString)-import qualified Data.ByteString         as BS-import           Data.ByteString.Short   (ShortByteString)-import qualified Data.ByteString.Short   as BSS-import           Data.Either             (fromRight)-import           Data.Hashable           (Hashable)-import           Data.Serialize          (Serialize (..), decode)-import qualified Data.Serialize.Get      as Get-import qualified Data.Serialize.Put      as Put-import           Data.String             (IsString, fromString)-import           Data.String.Conversions (cs)-import           Data.Word               (Word32)-import           GHC.Generics            (Generic)-import           Network.Haskoin.Util-import           Text.Read               as R---- | 'Word32' wrapped for type-safe 32-bit checksums.-newtype CheckSum32 = CheckSum32-    { getCheckSum32 :: Word32-    } deriving (Eq, Ord, Serialize, Show, Read, Hashable, Generic, NFData)---- | Type for 512-bit hashes.-newtype Hash512 = Hash512 { getHash512 :: ShortByteString }-    deriving (Eq, Ord, Hashable, Generic, NFData)---- | Type for 256-bit hashes.-newtype Hash256 = Hash256 { getHash256 :: ShortByteString }-    deriving (Eq, Ord, Hashable, Generic, NFData)---- | Type for 160-bit hashes.-newtype Hash160 = Hash160 { getHash160 :: ShortByteString }-    deriving (Eq, Ord, Hashable, Generic, NFData)--instance Show Hash512 where-    showsPrec _ = shows . encodeHex . BSS.fromShort . getHash512--instance Read Hash512 where-    readPrec = do-        R.String str <- lexP-        maybe pfail return $ Hash512 . BSS.toShort <$> decodeHex (cs str)--instance Show Hash256 where-    showsPrec _ = shows . encodeHex . BSS.fromShort . getHash256--instance Read Hash256 where-    readPrec = do-        R.String str <- lexP-        maybe pfail return $ Hash256 . BSS.toShort <$> decodeHex (cs str)--instance Show Hash160 where-    showsPrec _ = shows . encodeHex . BSS.fromShort . getHash160--instance Read Hash160 where-    readPrec = do-        R.String str <- lexP-        maybe pfail return $ Hash160 . BSS.toShort <$> decodeHex (cs str)--instance IsString Hash512 where-    fromString str =-        case decodeHex $ cs str of-            Nothing -> e-            Just bs ->-                case BS.length bs of-                    64 -> Hash512 (BSS.toShort bs)-                    _  -> e-      where-        e = error "Could not decode hash from hex string"--instance Serialize Hash512 where-    get = Hash512 <$> Get.getShortByteString 64-    put = Put.putShortByteString . getHash512--instance IsString Hash256 where-    fromString str =-        case decodeHex $ cs str of-            Nothing -> e-            Just bs ->-                case BS.length bs of-                    32 -> Hash256 (BSS.toShort bs)-                    _  -> e-      where-        e = error "Could not decode hash from hex string"--instance Serialize Hash256 where-    get = Hash256 <$> Get.getShortByteString 32-    put = Put.putShortByteString . getHash256--instance IsString Hash160 where-    fromString str =-        case decodeHex $ cs str of-            Nothing -> e-            Just bs ->-                case BS.length bs of-                    20 -> Hash160 (BSS.toShort bs)-                    _  -> e-      where-        e = error "Could not decode hash from hex string"--instance Serialize Hash160 where-    get = Hash160 <$> Get.getShortByteString 20-    put = Put.putShortByteString . getHash160---- | Calculate SHA512 hash.-sha512 :: ByteArrayAccess b => b -> Hash512-sha512 = Hash512 . BSS.toShort . BA.convert . hashWith SHA512---- | Calculate SHA256 hash.-sha256 :: ByteArrayAccess b => b -> Hash256-sha256 = Hash256 . BSS.toShort . BA.convert . hashWith SHA256---- | Calculate RIPEMD160 hash.-ripemd160 :: ByteArrayAccess b => b -> Hash160-ripemd160 = Hash160 . BSS.toShort . BA.convert . hashWith RIPEMD160---- | Claculate SHA1 hash.-sha1 :: ByteArrayAccess b => b -> Hash160-sha1 = Hash160 . BSS.toShort . BA.convert . hashWith SHA1---- | Compute two rounds of SHA-256.-doubleSHA256 :: ByteArrayAccess b => b -> Hash256-doubleSHA256 =-    Hash256 . BSS.toShort . BA.convert . hashWith SHA256 . hashWith SHA256---- | Compute SHA-256 followed by RIPMED-160.-addressHash :: ByteArrayAccess b => b -> Hash160-addressHash =-    Hash160 . BSS.toShort . BA.convert . hashWith RIPEMD160 . hashWith SHA256--{- CheckSum -}---- | Computes a 32 bit checksum.-checkSum32 :: ByteArrayAccess b => b -> CheckSum32-checkSum32 = fromRight (error "Could not decode bytes as CheckSum32")-             . decode-             . BS.take 4-             . BA.convert-             . hashWith SHA256-             . hashWith SHA256--{- HMAC -}---- | Computes HMAC over SHA-512.-hmac512 :: ByteString -> ByteString -> Hash512-hmac512 key msg =-    Hash512 $ BSS.toShort $ BA.convert (hmac key msg :: HMAC SHA512)---- | Computes HMAC over SHA-256.-hmac256 :: (ByteArrayAccess k, ByteArrayAccess m) => k -> m -> Hash256-hmac256 key msg =-    Hash256 $ BSS.toShort $ BA.convert (hmac key msg :: HMAC SHA256)---- | Split a 'Hash512' into a pair of 'Hash256'.-split512 :: Hash512 -> (Hash256, Hash256)-split512 h =-    (Hash256 (BSS.toShort a), Hash256 (BSS.toShort b))-  where-    (a, b) = BS.splitAt 32 . BSS.fromShort $ getHash512 h---- | Join a pair of 'Hash256' into a 'Hash512'.-join512 :: (Hash256, Hash256) -> Hash512-join512 (a, b) =-    Hash512 .-    BSS.toShort $-        BSS.fromShort (getHash256 a) `BS.append` BSS.fromShort (getHash256 b)
− src/Network/Haskoin/Crypto/Signature.hs 
@@ -1,90 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}-{-|-Module      : Network.Haskoin.Crypto.Signature-Copyright   : No rights reserved-License     : UNLICENSE-Maintainer  : jprupp@protonmail.ch-Stability   : experimental-Portability : POSIX--ECDSA signatures using secp256k1 curve. Uses functions from upstream secp256k1-library.--}-module Network.Haskoin.Crypto.Signature-    ( putSig-    , getSig-    , signHash-    , verifyHashSig-    , isCanonicalHalfOrder-    , decodeStrictSig-    , exportSig-    ) where--import           Control.Monad               (guard, unless, when)-import           Crypto.Secp256k1-import           Data.ByteString             (ByteString)-import qualified Data.ByteString             as BS-import           Data.ByteString.Short       (toShort)-import           Data.Maybe                  (fromMaybe)-import           Data.Serialize              as S-import           Data.Serialize.Put          (Putter, putByteString)-import           Network.Haskoin.Crypto.Hash-import           Numeric                     (showHex)---- | Convert 256-bit hash into a 'Msg' for signing or verification.-hashToMsg :: Hash256 -> Msg-hashToMsg =-    fromMaybe e . msg . encode-  where-    e = error "Could not convert 32-byte hash to secp256k1 message"---- | Sign a 256-bit hash using secp256k1 elliptic curve.-signHash :: SecKey -> Hash256 -> Sig-signHash k = signMsg k . hashToMsg---- | Verify an ECDSA signature for a 256-bit hash.-verifyHashSig :: Hash256 -> Sig -> PubKey -> Bool-verifyHashSig h s p =-    verifySig p g m-  where-    (g, _) = normalizeSig s-    m = hashToMsg h---- | Deserialize an ECDSA signature as commonly encoded in Bitcoin.-getSig :: Get Sig-getSig = do-        l <- lookAhead $ do-            t <- getWord8-            -- 0x30 is DER sequence type-            unless (t == 0x30) $ fail $-                "Bad DER identifier byte 0x" ++ showHex t ". Expecting 0x30"-            l <- getWord8-            when (l == 0x00) $ fail "Indeterminate form unsupported"-            when (l >= 0x80) $ fail "Multi-octect length not supported"-            return $ fromIntegral l-        bs <- getByteString $ l + 2-        case decodeStrictSig bs of-            Just s  -> return s-            Nothing -> fail "Invalid signature"---- | Serialize an ECDSA signature for Bitcoin use.-putSig :: Putter Sig-putSig s = putByteString $ exportSig s---- | Is canonical half order.-isCanonicalHalfOrder :: Sig -> Bool-isCanonicalHalfOrder = not . snd . normalizeSig---- | Decode signature strictly.-decodeStrictSig :: ByteString -> Maybe Sig-decodeStrictSig bs = do-    g <- importSig bs-    let compact = exportCompactSig g-    -- <http://www.secg.org/sec1-v2.pdf Section 4.1.4>-    -- 4.1.4.1 (r and s can not be zero)-    guard $ getCompactSigR compact /= zero-    guard $ getCompactSigS compact /= zero-    guard $ isCanonicalHalfOrder g-    return g-  where-    zero = toShort $ BS.replicate 32 0
− src/Network/Haskoin/Keys.hs 
@@ -1,22 +0,0 @@-{-|-Module      : Network.Haskoin.Keys-Copyright   : No rights reserved-License     : UNLICENSE-Maintainer  : jprupp@protonmail.ch-Stability   : experimental-Portability : POSIX--ECDSA private and public keys, extended keys (BIP-32) and mnemonic sentences-(BIP-39).--}-module Network.Haskoin.Keys-    ( module Network.Haskoin.Keys.Common-    -- * Extended Keys-    , module Network.Haskoin.Keys.Extended-    -- * Mnemonic-    , module Network.Haskoin.Keys.Mnemonic-    ) where--import           Network.Haskoin.Keys.Common-import           Network.Haskoin.Keys.Extended-import           Network.Haskoin.Keys.Mnemonic
− src/Network/Haskoin/Keys/Common.hs 
@@ -1,138 +0,0 @@-{-# LANGUAGE DeriveAnyClass    #-}-{-# LANGUAGE DeriveGeneric     #-}-{-# LANGUAGE FlexibleContexts  #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE OverloadedStrings #-}-{-|-Module      : Network.Haskoin.Keys.Common-Copyright   : No rights reserved-License     : UNLICENSE-Maintainer  : jprupp@protonmail.ch-Stability   : experimental-Portability : POSIX--ECDSA private and public key functions.--}-module Network.Haskoin.Keys.Common-    ( -- * Public & Private Keys-      PubKeyI(..)-    , SecKeyI(..)-    , exportPubKey-    , importPubKey-    , wrapPubKey-    , derivePubKeyI-    , wrapSecKey-    , fromMiniKey-    , tweakPubKey-    , tweakSecKey-    , secKeyPut-    , secKeyGet-    , getSecKey-    , secKey-    ) where--import           Control.Applicative         ((<|>))-import           Control.DeepSeq-import           Control.Monad               (guard, mzero, (<=<))-import           Crypto.Secp256k1-import           Data.Aeson                  (FromJSON, ToJSON (..),-                                              Value (String), parseJSON,-                                              withText)-import           Data.Aeson.Encoding         (unsafeToEncoding)-import           Data.ByteString             (ByteString)-import qualified Data.ByteString             as BS-import           Data.ByteString.Builder     (char7)-import           Data.Hashable-import           Data.Maybe                  (fromMaybe)-import           Data.Serialize              (Serialize, decode, encode, get,-                                              put)-import           Data.Serialize.Get          (Get, getByteString)-import           Data.Serialize.Put          (Putter, putByteString)-import           Data.String                 (IsString, fromString)-import           Data.String.Conversions     (cs)-import           GHC.Generics                (Generic)-import           Network.Haskoin.Crypto.Hash-import           Network.Haskoin.Util---- | Elliptic curve public key type with expected serialized compression flag.-data PubKeyI = PubKeyI-    { pubKeyPoint      :: !PubKey-    , pubKeyCompressed :: !Bool-    } deriving (Generic, Eq, Show, Read, Hashable, NFData)--instance IsString PubKeyI where-    fromString str =-        fromMaybe e $ eitherToMaybe . decode <=< decodeHex $ cs str-      where-        e = error "Could not decode public key"--instance ToJSON PubKeyI where-    toJSON = String . encodeHex . encode-    toEncoding s = unsafeToEncoding $ char7 '"' <> hexBuilder (encode s) <> char7 '"'--instance FromJSON PubKeyI where-    parseJSON = withText "PubKeyI" $-        maybe mzero return . (eitherToMaybe . decode =<<) . decodeHex--instance Serialize PubKeyI where-    get = c <|> u-      where-        c = do-            bs <- getByteString 33-            guard $ BS.head bs `BS.elem` BS.pack [0x02, 0x03]-            maybe mzero return $ PubKeyI <$> importPubKey bs <*> pure True-        u = do-            bs <- getByteString 65-            guard $ BS.head bs == 0x04-            maybe mzero return $ PubKeyI <$> importPubKey bs <*> pure False--    put pk = putByteString $ exportPubKey (pubKeyCompressed pk) (pubKeyPoint pk)---- | Wrap a public key from secp256k1 library adding information about compression.-wrapPubKey :: Bool -> PubKey -> PubKeyI-wrapPubKey c p = PubKeyI p c---- | Derives a public key from a private key. This function will preserve--- compression flag.-derivePubKeyI :: SecKeyI -> PubKeyI-derivePubKeyI (SecKeyI d c) = PubKeyI (derivePubKey d) c---- | Tweak a public key.-tweakPubKey :: PubKey -> Hash256 -> Maybe PubKey-tweakPubKey p h = tweakAddPubKey p =<< tweak (encode h)---- | Elliptic curve private key type with expected public key compression--- information. Compression information is stored in private key WIF formats and--- needs to be preserved to generate the correct address from the corresponding--- public key.-data SecKeyI = SecKeyI-    { secKeyData       :: !SecKey-    , secKeyCompressed :: !Bool-    } deriving (Eq, Show, Read, Generic, NFData)---- | Wrap private key with corresponding public key compression flag.-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-fromMiniKey bs = do-    guard checkShortKey-    wrapSecKey False <$> secKey (encode (sha256 bs))-  where-    checkHash = encode $ sha256 $ bs `BS.append` "?"-    checkShortKey = BS.length bs `elem` [22, 30] && BS.head checkHash == 0x00---- | Tweak a private key.-tweakSecKey :: SecKey -> Hash256 -> Maybe SecKey-tweakSecKey key h = tweakAddSecKey key =<< tweak (encode h)
− src/Network/Haskoin/Keys/Extended.hs 
@@ -1,920 +0,0 @@-{-# LANGUAGE DeriveAnyClass    #-}-{-# LANGUAGE DeriveGeneric     #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE GADTs             #-}-{-# LANGUAGE OverloadedStrings #-}-{-|-Module      : Network.Haskoin.Keys.Extended-Copyright   : No rights reserved-License     : UNLICENSE-Maintainer  : jprupp@protonmail.ch-Stability   : experimental-Portability : POSIX--BIP-32 extended keys.--}-module Network.Haskoin.Keys.Extended-    (-      -- * Extended Keys-      XPubKey(..)-    , XPrvKey(..)-    , ChainCode-    , KeyIndex-    , Fingerprint-    , DerivationException(..)-    , makeXPrvKey-    , deriveXPubKey-    , prvSubKey-    , pubSubKey-    , hardSubKey-    , xPrvIsHard-    , xPubIsHard-    , xPrvChild-    , xPubChild-    , xPubID-    , xPrvID-    , xPubFP-    , xPrvFP-    , xPubAddr-    , xPubWitnessAddr-    , xPubCompatWitnessAddr-    , xPubExport-    , xPubToJSON-    , xPubToEncoding-    , xPubFromJSON-    , xPrvExport-    , xPrvToJSON-    , xPrvToEncoding-    , xPrvFromJSON-    , xPubImport-    , xPrvImport-    , xPrvWif-    , putXPrvKey-    , putXPubKey-    , getXPrvKey-    , getXPubKey--      -- ** Helper Functions-    , prvSubKeys-    , pubSubKeys-    , hardSubKeys-    , deriveAddr-    , deriveWitnessAddr-    , deriveCompatWitnessAddr-    , deriveAddrs-    , deriveWitnessAddrs-    , deriveCompatWitnessAddrs-    , deriveMSAddr-    , deriveMSAddrs-    , cycleIndex--      -- ** Derivation Paths-    , DerivPathI(..)-    , AnyDeriv, HardDeriv, SoftDeriv-    , HardOrAny-    , AnyOrSoft-    , DerivPath-    , HardPath-    , SoftPath-    , Bip32PathIndex (..)-    , derivePath-    , derivePubPath-    , toHard-    , toSoft-    , toGeneric-    , (++/)-    , pathToStr-    , listToPath-    , pathToList--      -- *** Derivation Path Parser-    , XKey(..)-    , ParsedPath(..)-    , parsePath-    , parseHard-    , parseSoft-    , applyPath-    , derivePathAddr-    , derivePathAddrs-    , derivePathMSAddr-    , derivePathMSAddrs-    , concatBip32Segments-    ) where--import           Control.Applicative-import           Control.DeepSeq-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.Encoding            (Encoding, text)-import           Data.Aeson.Types               (Parser)-import           Data.Bits                      (clearBit, setBit, testBit)-import           Data.ByteString                (ByteString)-import qualified Data.ByteString                as B-import           Data.Either                    (fromRight)-import           Data.List                      (foldl')-import           Data.List.Split                (splitOn)-import           Data.Maybe                     (fromMaybe)-import           Data.Serialize                 as S (Serialize, decode, encode,-                                                      get, put)-import           Data.Serialize.Get             (Get, getWord32be, getWord8,-                                                 runGet)-import           Data.Serialize.Put             (Putter, putWord32be, putWord8,-                                                 runPut)-import           Data.String                    (IsString, fromString)-import           Data.String.Conversions        (cs)-import           Data.Typeable                  (Typeable)-import           Data.Word                      (Word32, Word8)-import           GHC.Generics                   (Generic)-import           Network.Haskoin.Address-import           Network.Haskoin.Constants-import           Network.Haskoin.Crypto.Hash-import           Network.Haskoin.Keys.Common-import           Network.Haskoin.Script-import           Network.Haskoin.Util-import           Text.Read                      as R-import           Text.Read.Lex----- | A derivation exception is thrown in the very unlikely event that a--- derivation is invalid.-newtype DerivationException = DerivationException String-    deriving (Eq, Read, Show, Typeable, Generic, NFData)--instance Exception DerivationException---- | Chain code as specified in BIP-32.-type ChainCode = Hash256---- | Index of key as specified in BIP-32.-type KeyIndex = Word32---- | Fingerprint of parent-type Fingerprint = Word32---- | Data type representing an extended BIP32 private key. An extended key--- is a node in a tree of key derivations. It has a depth in the tree, a--- parent node and an index to differentiate it from other siblings.-data XPrvKey = XPrvKey-    { xPrvDepth  :: !Word8       -- ^ depth in the tree-    , xPrvParent :: !Fingerprint -- ^ fingerprint of parent-    , xPrvIndex  :: !KeyIndex    -- ^ derivation index-    , xPrvChain  :: !ChainCode   -- ^ chain code-    , xPrvKey    :: !SecKey      -- ^ private key of this node-    } deriving (Generic, Eq, Show, Read, NFData)--xPrvToJSON :: Network -> XPrvKey -> Value-xPrvToJSON net = A.String . xPrvExport net--xPrvToEncoding :: Network -> XPrvKey -> Encoding-xPrvToEncoding net = text . xPrvExport net---- | Data type representing an extended BIP32 public key.-data XPubKey = XPubKey-    { xPubDepth  :: !Word8     -- ^ depth in the tree-    , xPubParent :: !Fingerprint    -- ^ fingerprint of parent-    , xPubIndex  :: !KeyIndex  -- ^ derivation index-    , xPubChain  :: !ChainCode -- ^ chain code-    , xPubKey    :: !PubKey    -- ^ public key of this node-    } deriving (Generic, Eq, Show, Read, NFData)----- | Decode an extended public key from a JSON string-xPubFromJSON :: Network -> Value -> Parser XPubKey-xPubFromJSON net =-    withText "xpub" $ \t ->-        case xPubImport net t of-            Nothing -> fail "could not read xpub"-            Just x  -> return x---- | Get JSON 'Value' from 'XPubKey'.-xPubToJSON :: Network -> XPubKey -> Value-xPubToJSON net = A.String . xPubExport net--xPubToEncoding :: Network -> XPubKey -> Encoding-xPubToEncoding net = text . xPubExport net---- | Decode an extended private key from a JSON string-xPrvFromJSON :: Network -> Value -> Parser XPrvKey-xPrvFromJSON net =-    withText "xprv" $ \t ->-        case xPrvImport net t of-            Nothing -> fail "could not read xprv"-            Just x  -> return x---- | Build a BIP32 compatible extended private key from a bytestring. This will--- produce a root node (@depth=0@ and @parent=0@).-makeXPrvKey :: ByteString -> XPrvKey-makeXPrvKey bs =-    XPrvKey 0 0 0 c k-  where-    (p, c) = split512 $ hmac512 "Bitcoin seed" bs-    k     = fromMaybe err (secKey (encode p))-    err   = throw $ DerivationException "Invalid seed"---- | Derive an extended public key from an extended private key. This function--- will preserve the depth, parent, index and chaincode fields of the extended--- private keys.-deriveXPubKey :: XPrvKey -> XPubKey-deriveXPubKey (XPrvKey d p i c k) = XPubKey d p i c (derivePubKey k)---- | Compute a private, soft child key derivation. A private soft derivation--- will allow the equivalent extended public key to derive the public key for--- this child. Given a parent key /m/ and a derivation index /i/, this function--- will compute /m\/i/.------ Soft derivations allow for more flexibility such as read-only wallets.--- However, care must be taken not the leak both the parent extended public key--- and one of the extended child private keys as this would compromise the--- extended parent private key.-prvSubKey :: XPrvKey  -- ^ extended parent private key-          -> KeyIndex -- ^ child derivation index-          -> XPrvKey  -- ^ extended child private key-prvSubKey xkey child-    | child >= 0 && child < 0x80000000 =-        XPrvKey (xPrvDepth xkey + 1) (xPrvFP xkey) child c k-    | otherwise = error "Invalid child derivation index"-  where-    pK = xPubKey $ deriveXPubKey xkey-    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"---- | Compute a public, soft child key derivation. Given a parent key /M/--- and a derivation index /i/, this function will compute /M\/i/.-pubSubKey :: XPubKey  -- ^ extended parent public key-          -> KeyIndex -- ^ child derivation index-          -> XPubKey  -- ^ extended child public key-pubSubKey xKey child-    | child >= 0 && child < 0x80000000 =-        XPubKey (xPubDepth xKey + 1) (xPubFP xKey) child c pK-    | otherwise = error "Invalid child derivation index"-  where-    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"---- | Compute a hard child key derivation. Hard derivations can only be computed--- for private keys. Hard derivations do not allow the parent public key to--- derive the child public keys. However, they are safer as a breach of the--- parent public key and child private keys does not lead to a breach of the--- parent private key. Given a parent key /m/ and a derivation index /i/, this--- function will compute /m\/i'/.-hardSubKey :: XPrvKey  -- ^ extended parent private key-           -> KeyIndex -- ^ child derivation index-           -> XPrvKey  -- ^ extended child private key-hardSubKey xkey child-    | child >= 0 && child < 0x80000000 =-        XPrvKey (xPrvDepth xkey + 1) (xPrvFP xkey) i c k-    | otherwise = error "Invalid child derivation index"-  where-    i      = setBit child 31-    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"---- | Returns true if the extended private key was derived through a hard--- derivation.-xPrvIsHard :: XPrvKey -> Bool-xPrvIsHard k = testBit (xPrvIndex k) 31---- | Returns true if the extended public key was derived through a hard--- derivation.-xPubIsHard :: XPubKey -> Bool-xPubIsHard k = testBit (xPubIndex k) 31---- | Returns the derivation index of this extended private key without the hard--- bit set.-xPrvChild :: XPrvKey -> KeyIndex-xPrvChild k = clearBit (xPrvIndex k) 31---- | Returns the derivation index of this extended public key without the hard--- bit set.-xPubChild :: XPubKey -> KeyIndex-xPubChild k = clearBit (xPubIndex k) 31---- | Computes the key identifier of an extended private key.-xPrvID :: XPrvKey -> Hash160-xPrvID = xPubID . deriveXPubKey---- | Computes the key identifier of an extended public key.-xPubID :: XPubKey -> Hash160-xPubID = ripemd160 . encode . sha256 . exportPubKey True . xPubKey---- | Computes the key fingerprint of an extended private key.-xPrvFP :: XPrvKey -> Fingerprint-xPrvFP =-    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 -> Fingerprint-xPubFP =-    fromRight err . decode . B.take 4 . encode . xPubID-  where-    err = error "Could not decode xPubFP"---- | Compute a standard P2PKH address for an extended public key.-xPubAddr :: XPubKey -> Address-xPubAddr xkey = pubKeyAddr (wrapPubKey True (xPubKey xkey))---- | Compute a SegWit P2WPKH address for an extended public key.-xPubWitnessAddr :: XPubKey -> Address-xPubWitnessAddr xkey = pubKeyWitnessAddr (wrapPubKey True (xPubKey xkey))---- | Compute a backwards-compatible SegWit P2SH-P2WPKH address for an extended--- public key.-xPubCompatWitnessAddr :: XPubKey -> Address-xPubCompatWitnessAddr xkey =-    pubKeyCompatWitnessAddr (wrapPubKey True (xPubKey xkey))---- | Exports an extended private key to the BIP32 key export format ('Base58').-xPrvExport :: Network -> XPrvKey -> Base58-xPrvExport net = encodeBase58Check . runPut . putXPrvKey net---- | Exports an extended public key to the BIP32 key export format ('Base58').-xPubExport :: Network -> XPubKey -> Base58-xPubExport net = encodeBase58Check . runPut . putXPubKey net---- | Decodes a BIP32 encoded extended private key. This function will fail if--- invalid base 58 characters are detected or if the checksum fails.-xPrvImport :: Network -> Base58 -> Maybe XPrvKey-xPrvImport net = eitherToMaybe . runGet (getXPrvKey net) <=< decodeBase58Check---- | Decodes a BIP32 encoded extended public key. This function will fail if--- invalid base 58 characters are detected or if the checksum fails.-xPubImport :: Network -> Base58 -> Maybe XPubKey-xPubImport net = eitherToMaybe . runGet (getXPubKey net) <=< decodeBase58Check---- | Export an extended private key to WIF (Wallet Import Format).-xPrvWif :: Network -> XPrvKey -> Base58-xPrvWif net xkey = toWif net (wrapSecKey True (xPrvKey xkey))---- | Parse a binary extended private key.-getXPrvKey :: Network -> Get XPrvKey-getXPrvKey net = do-        ver <- getWord32be-        unless (ver == getExtSecretPrefix net) $ fail-            "Get: Invalid version for extended private key"-        XPrvKey <$> getWord8-                <*> getWord32be-                <*> getWord32be-                <*> S.get-                <*> getPadPrvKey---- | Serialize an extended private key.-putXPrvKey :: Network -> Putter XPrvKey-putXPrvKey net k = do-        putWord32be  $ getExtSecretPrefix net-        putWord8     $ xPrvDepth k-        putWord32be  $ xPrvParent k-        putWord32be  $ xPrvIndex k-        put          $ xPrvChain k-        putPadPrvKey $ xPrvKey k---- | Parse a binary extended public key.-getXPubKey :: Network -> Get XPubKey-getXPubKey net = do-        ver <- getWord32be-        unless (ver == getExtPubKeyPrefix net) $ fail-            "Get: Invalid version for extended public key"-        XPubKey <$> getWord8-                <*> getWord32be-                <*> getWord32be-                <*> S.get-                <*> (pubKeyPoint <$> S.get)---- | Serialize an extended public key.-putXPubKey :: Network -> Putter XPubKey-putXPubKey net k = do-        putWord32be $ getExtPubKeyPrefix net-        putWord8    $ xPubDepth k-        putWord32be $ xPubParent k-        putWord32be $ xPubIndex k-        put         $ xPubChain k-        put         $ wrapPubKey True (xPubKey k)--{- Derivation helpers -}---- | Cyclic list of all private soft child key derivations of a parent key--- starting from an offset index.-prvSubKeys :: XPrvKey -> KeyIndex -> [(XPrvKey, KeyIndex)]-prvSubKeys k = map (\i -> (prvSubKey k i, i)) . cycleIndex---- | Cyclic list of all public soft child key derivations of a parent key--- starting from an offset index.-pubSubKeys :: XPubKey -> KeyIndex -> [(XPubKey, KeyIndex)]-pubSubKeys k = map (\i -> (pubSubKey k i, i)) . cycleIndex---- | Cyclic list of all hard child key derivations of a parent key starting--- from an offset index.-hardSubKeys :: XPrvKey -> KeyIndex -> [(XPrvKey, KeyIndex)]-hardSubKeys k = map (\i -> (hardSubKey k i, i)) . cycleIndex---- | Derive a standard address from an extended public key and an index.-deriveAddr :: XPubKey -> KeyIndex -> (Address, PubKey)-deriveAddr k i =-    (xPubAddr key, xPubKey key)-  where-    key = pubSubKey k i---- | Derive a SegWit P2WPKH address from an extended public key and an index.-deriveWitnessAddr :: XPubKey -> KeyIndex -> (Address, PubKey)-deriveWitnessAddr k i =-    (xPubWitnessAddr key, xPubKey key)-  where-    key = pubSubKey k i---- | Derive a backwards-compatible SegWit P2SH-P2WPKH address from an extended--- public key and an index.-deriveCompatWitnessAddr :: XPubKey -> KeyIndex -> (Address, PubKey)-deriveCompatWitnessAddr k i =-    (xPubCompatWitnessAddr key, xPubKey key)-  where-    key = pubSubKey k i---- | Cyclic list of all addresses derived from a public key starting from an--- offset index.-deriveAddrs :: XPubKey -> KeyIndex -> [(Address, PubKey, KeyIndex)]-deriveAddrs k =-    map f . cycleIndex-  where-    f i = let (a, key) = deriveAddr k i in (a, key, i)---- | Cyclic list of all SegWit P2WPKH addresses derived from a public key--- starting from an offset index.-deriveWitnessAddrs :: XPubKey -> KeyIndex -> [(Address, PubKey, KeyIndex)]-deriveWitnessAddrs k =-    map f . cycleIndex-  where-    f i = let (a, key) = deriveWitnessAddr k i in (a, key, i)---- | Cyclic list of all backwards-compatible SegWit P2SH-P2WPKH addresses--- derived from a public key starting from an offset index.-deriveCompatWitnessAddrs :: XPubKey -> KeyIndex -> [(Address, PubKey, KeyIndex)]-deriveCompatWitnessAddrs k =-    map f . cycleIndex-  where-    f i = let (a, key) = deriveCompatWitnessAddr k i in (a, key, i)---- | Derive a multisig address from a list of public keys, the number of--- required signatures /m/ and a derivation index. The derivation type is a--- public, soft derivation.-deriveMSAddr :: [XPubKey] -> Int -> KeyIndex -> (Address, RedeemScript)-deriveMSAddr keys m i = (payToScriptAddress rdm, rdm)-  where-    rdm = sortMulSig $ PayMulSig k m-    k = map (wrapPubKey True . xPubKey . flip pubSubKey i) keys---- | Cyclic list of all multisig addresses derived from a list of public keys,--- a number of required signatures /m/ and starting from an offset index. The--- derivation type is a public, soft derivation.-deriveMSAddrs :: [XPubKey] -> Int -> KeyIndex-              -> [(Address, RedeemScript, KeyIndex)]-deriveMSAddrs keys m = map f . cycleIndex-  where-    f i =-        let (a, rdm) = deriveMSAddr keys m i-         in (a, rdm, i)---- | Helper function to go through derivation indices.-cycleIndex :: KeyIndex -> [KeyIndex]-cycleIndex i-    | i == 0         = cycle [0..0x7fffffff]-    | i < 0x80000000 = cycle $ [i..0x7fffffff] ++ [0..(i-1)]-    | otherwise      = error $ "cycleIndex: invalid index " ++ show i--{- Derivation Paths -}---- | Phantom type signaling a hardened derivation path that can only be computed--- from private extended key.-data HardDeriv deriving (Generic, NFData)---- | Phantom type signaling no knowledge about derivation path: can be hardened or not.-data AnyDeriv deriving (Generic, NFData)---- | Phantom type signaling derivation path including only non-hardened paths--- that can be computed from an extended public key.-data SoftDeriv deriving (Generic, NFData)---- | 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---- | Data type representing a derivation path. Two constructors are provided--- for specifying soft or hard derivations. The path /\/0\/1'\/2/ for example can be--- expressed as @'Deriv' :\/ 0 :| 1 :\/ 2@. The 'HardOrAny' and 'AnyOrSoft' type--- classes are used to constrain the valid values for the phantom type /t/. If--- you mix hard '(:|)' and soft '(:\/)' paths, the only valid type for /t/ is 'AnyDeriv'.--- Otherwise, /t/ can be 'HardDeriv' if you only have hard derivation or 'SoftDeriv'--- if you only have soft derivations.------ Using this type is as easy as writing the required derivation like in these--- example:------ > Deriv :/ 0 :/ 1 :/ 2 :: SoftPath--- > Deriv :| 0 :| 1 :| 2 :: HardPath--- > Deriv :| 0 :/ 1 :/ 2 :: DerivPath-data DerivPathI t where-    (:|)  :: HardOrAny t => !(DerivPathI t) -> !KeyIndex -> DerivPathI t-    (:/)  :: AnyOrSoft t => !(DerivPathI t) -> !KeyIndex -> DerivPathI t-    Deriv :: DerivPathI t--instance NFData (DerivPathI t) where-    rnf (a :| b) = rnf a `seq` rnf b `seq` ()-    rnf (a :/ b) = rnf a `seq` rnf b `seq` ()-    rnf Deriv    = ()--instance Eq (DerivPathI t) where-    (nextA :| iA) == (nextB :| iB) = iA == iB && nextA == nextB-    (nextA :/ iA) == (nextB :/ iB) = iA == iB && nextA == nextB-    Deriv         == Deriv         = True-    _             == _             = False--instance Ord (DerivPathI t) where-    -- Same hardness on each side-    (nextA :| iA) `compare` (nextB :| iB) =-        if nextA == nextB then iA `compare` iB else nextA `compare` nextB-    (nextA :/ iA) `compare` (nextB :/ iB) =-        if nextA == nextB then iA `compare` iB else nextA `compare` nextB--    -- Different hardness: hard paths are LT soft paths-    (nextA :/ _iA) `compare` (nextB :| _iB) =-        if nextA == nextB then LT else nextA `compare` nextB-    (nextA :| _iA) `compare` (nextB :/ _iB) =-        if nextA == nextB then GT else nextA `compare` nextB--    Deriv `compare` Deriv  = EQ-    Deriv `compare` _      = LT-    _     `compare` Deriv  = GT---instance Serialize DerivPath where-    get = listToPath <$> S.get-    put = put . pathToList---- | Get a list of derivation indices from a derivation path.-pathToList :: DerivPathI t -> [KeyIndex]-pathToList =-    reverse . go-  where-    go (next :| i) = setBit i 31 : go next-    go (next :/ i) = i : go next-    go _           = []---- | Convert a list of derivation indices to a derivation path.-listToPath :: [KeyIndex] -> DerivPath-listToPath =-    go . reverse-  where-    go (i:is)-        | testBit i 31 = go is :| clearBit i 31-        | otherwise    = go is :/ i-    go [] = Deriv---- | Convert a derivation path to a human-readable string.-pathToStr :: DerivPathI t -> String-pathToStr p =-    case p of-        next :| i -> concat [ pathToStr next, "/", show i, "'" ]-        next :/ i -> concat [ pathToStr next, "/", show i ]-        Deriv     -> ""---- | Turn a derivation path into a hard derivation path. Will fail if the path--- contains soft derivations.-toHard :: DerivPathI t -> Maybe HardPath-toHard p = case p of-    next :| i -> (:| i) <$> toHard next-    Deriv     -> Just Deriv-    _         -> Nothing---- | Turn a derivation path into a soft derivation path. Will fail if the path--- has hard derivations.-toSoft :: DerivPathI t -> Maybe SoftPath-toSoft p = case p of-    next :/ i -> (:/ i) <$> toSoft next-    Deriv     -> Just Deriv-    _         -> Nothing---- | Make a derivation path generic.-toGeneric :: DerivPathI t -> DerivPath-toGeneric p = case p of-    next :/ i -> toGeneric next :/ i-    next :| i -> toGeneric next :| i-    Deriv     -> Deriv---- | Append two derivation paths together. The result will be a mixed--- derivation path.-(++/) :: DerivPathI t1 -> DerivPathI t2 -> DerivPath-(++/) p1 p2 =-    go id (toGeneric p2) $ toGeneric p1-  where-    go f p = case p of-        next :/ i -> go (f . (:/ i)) $ toGeneric next-        next :| i -> go (f . (:| i)) $ toGeneric next-        _         -> f---- | Derive a private key from a derivation path-derivePath :: DerivPathI t -> XPrvKey -> XPrvKey-derivePath = go id-  where-    -- Build the full derivation function starting from the end-    go f p = case p of-        next :| i -> go (f . flip hardSubKey i) next-        next :/ i -> go (f . flip prvSubKey i) next-        _         -> f---- | Derive a public key from a soft derivation path-derivePubPath :: SoftPath -> XPubKey -> XPubKey-derivePubPath = go id-  where-    -- Build the full derivation function starting from the end-    go f p = case p of-        next :/ i -> go (f . flip pubSubKey i) next-        _         -> f--instance Show DerivPath where-    showsPrec d p = showParen (d > 10) $-        showString "DerivPath " . shows (pathToStr p)--instance Read DerivPath where-    readPrec = parens $ do-        R.Ident "DerivPath" <- lexP-        R.String str <- lexP-        maybe pfail return $ getParsedPath <$> parsePath str--instance Show HardPath where-    showsPrec d p = showParen (d > 10) $-        showString "HardPath " . shows (pathToStr p)--instance Read HardPath where-    readPrec = parens $ do-        R.Ident "HardPath" <- lexP-        R.String str <- lexP-        maybe pfail return $ parseHard str--instance Show SoftPath where-    showsPrec d p = showParen (d > 10) $-        showString "SoftPath " . shows (pathToStr p)--instance Read SoftPath where-    readPrec = parens $ do-        R.Ident "SoftPath" <- lexP-        R.String str <- lexP-        maybe pfail return $ parseSoft str--instance IsString ParsedPath where-    fromString =-        fromMaybe e . parsePath-      where-        e = error "Could not parse derivation path"--instance IsString DerivPath where-    fromString =-        getParsedPath . fromMaybe e . parsePath-      where-        e = error "Could not parse derivation path"--instance IsString HardPath where-    fromString =-        fromMaybe e . parseHard-      where-        e = error "Could not parse hard derivation path"--instance IsString SoftPath where-    fromString =-        fromMaybe e . parseSoft-      where-        e = error "Could not parse soft derivation path"--instance FromJSON ParsedPath where-    parseJSON = withText "ParsedPath" $ \str -> case parsePath $ cs str of-        Just p -> return p-        _      -> mzero--instance FromJSON DerivPath where-    parseJSON = withText "DerivPath" $ \str -> case parsePath $ cs str of-        Just p -> return $ getParsedPath p-        _      -> mzero--instance FromJSON HardPath where-    parseJSON = withText "HardPath" $ \str -> case parseHard $ cs str of-        Just p -> return p-        _      -> mzero--instance FromJSON SoftPath where-    parseJSON = withText "SoftPath" $ \str -> case parseSoft $ cs str of-        Just p -> return p-        _      -> mzero--instance ToJSON (DerivPathI t) where-    toJSON = A.String . cs . pathToStr--instance ToJSON ParsedPath where-    toJSON (ParsedPrv p)   = A.String . cs . ("m" ++) . pathToStr $ p-    toJSON (ParsedPub p)   = A.String . cs . ("M" ++) . pathToStr $ p-    toJSON (ParsedEmpty p) = A.String . cs . ("" ++) . pathToStr $ p--{- Parsing derivation paths of the form m/1/2'/3 or M/1/2'/3 -}---- | Type for parsing derivation paths of the form /m\/1\/2'\/3/ or--- /M\/1\/2'\/3/.-data ParsedPath = ParsedPrv   { getParsedPath :: !DerivPath }-                | ParsedPub   { getParsedPath :: !DerivPath }-                | ParsedEmpty { getParsedPath :: !DerivPath }-  deriving (Eq, Generic, NFData)--instance Show ParsedPath where-    showsPrec d p = showParen (d > 10) $ showString "ParsedPath " . shows f-      where-        f =-            case p of-                ParsedPrv d'   -> "m" <> pathToStr d'-                ParsedPub d'   -> "M" <> pathToStr d'-                ParsedEmpty d' -> pathToStr d'--instance Read ParsedPath where-    readPrec = parens $ do-        R.Ident "ParsedPath" <- lexP-        R.String str <- lexP-        maybe pfail return $ parsePath str---- | Parse derivation path string for extended key.--- Forms: /m\/0'\/2/, /M\/2\/3\/4/.-parsePath :: String -> Maybe ParsedPath-parsePath str = do-    res <- concatBip32Segments <$> mapM parseBip32PathIndex xs-    case x of-        "m" -> Just $ ParsedPrv res-        "M" -> Just $ ParsedPub res-        ""  -> Just $ ParsedEmpty res-        _   -> Nothing-  where-    (x : xs) = splitOn "/" str---- | Concatenate derivation path indices into a derivation path.-concatBip32Segments :: [Bip32PathIndex] -> DerivPath-concatBip32Segments = foldl' appendBip32Segment Deriv---- | Append an extra derivation path index element into an existing path.-appendBip32Segment :: DerivPath -> Bip32PathIndex  -> DerivPath-appendBip32Segment d (Bip32SoftIndex i) = d :/ i-appendBip32Segment d (Bip32HardIndex i) = d :| i---- | Parse a BIP32 derivation path index element from a string.-parseBip32PathIndex :: String -> Maybe Bip32PathIndex-parseBip32PathIndex segment = case reads segment of-    [(i, "" )] -> guard (is31Bit i) >> return (Bip32SoftIndex i)-    [(i, "'")] -> guard (is31Bit i) >> return (Bip32HardIndex i)-    _          -> Nothing---- | Type for BIP32 path index element.-data Bip32PathIndex = Bip32HardIndex KeyIndex-                    | Bip32SoftIndex KeyIndex-  deriving (Eq, Generic, NFData)--instance Show Bip32PathIndex where-    showsPrec d (Bip32HardIndex i) = showParen (d > 10) $-        showString "Bip32HardIndex " . shows i-    showsPrec d (Bip32SoftIndex i) = showParen (d > 10) $-        showString "Bip32SoftIndex " . shows i--instance Read Bip32PathIndex where-    readPrec = h <|> s-      where-        h =-            parens $ do-                R.Ident "Bip32HardIndex" <- lexP-                R.Number n <- lexP-                maybe pfail return $-                    Bip32HardIndex . fromIntegral <$> numberToInteger n-        s =-            parens $ do-                R.Ident "Bip32SoftIndex" <- lexP-                R.Number n <- lexP-                maybe pfail return $-                    Bip32SoftIndex . fromIntegral <$> numberToInteger n---- | Test whether the number could be a valid BIP32 derivation index.-is31Bit :: (Integral a) => a -> Bool-is31Bit i = i >= 0 && i < 0x80000000---- | Helper function to parse a hard path.-parseHard :: String -> Maybe HardPath-parseHard = toHard . getParsedPath <=< parsePath---- | Helper function to parse a soft path.-parseSoft :: String -> Maybe SoftPath-parseSoft = toSoft . getParsedPath <=< parsePath---- | Data type representing a private or public key with its respective network.-data XKey-    = XPrv { getXKeyPrv :: !XPrvKey-           , getXKeyNet :: !Network }-    | XPub { getXKeyPub :: !XPubKey-           , getXKeyNet :: !Network }-    deriving (Eq, Show, Generic, NFData)---- | Apply a parsed path to an extended key to derive the new key defined in the--- path. If the path starts with /m/, a private key will be returned and if the--- path starts with /M/, a public key will be returned. Private derivations on a--- public key, and public derivations with a hard segment, return an error--- value.-applyPath :: ParsedPath -> XKey -> Either String XKey-applyPath path key =-    case (path, key) of-        (ParsedPrv _, XPrv k n) -> return $ XPrv (derivPrvF k) n-        (ParsedPrv _, XPub {}) -> Left "applyPath: Invalid public key"-        (ParsedPub _, XPrv k n) -> return $ XPub (deriveXPubKey (derivPrvF k)) n-        (ParsedPub _, XPub k n) -> derivPubFE >>= \f -> return $ XPub (f k) n-    -- For empty parsed paths, we take a hint from the provided key-        (ParsedEmpty _, XPrv k n) -> return $ XPrv (derivPrvF k) n-        (ParsedEmpty _, XPub k n) -> derivPubFE >>= \f -> return $ XPub (f k) n-  where-    derivPrvF = goPrv id $ getParsedPath path-    derivPubFE = goPubE id $ getParsedPath path-    -- Build the full private derivation function starting from the end-    goPrv f p =-        case p of-            next :| i -> goPrv (f . flip hardSubKey i) next-            next :/ i -> goPrv (f . flip prvSubKey i) next-            Deriv     -> f-    -- Build the full public derivation function starting from the end-    goPubE f p =-        case p of-            next :/ i -> goPubE (f . flip pubSubKey i) next-            Deriv     -> Right f-            _         -> Left "applyPath: Invalid hard derivation"--{- Helpers for derivation paths and addresses -}---- | Derive an address from a given parent path.-derivePathAddr :: XPubKey -> SoftPath -> KeyIndex -> (Address, PubKey)-derivePathAddr key path = deriveAddr (derivePubPath path key)---- | Cyclic list of all addresses derived from a given parent path and starting--- from the given offset index.-derivePathAddrs ::-       XPubKey -> SoftPath -> KeyIndex -> [(Address, PubKey, KeyIndex)]-derivePathAddrs key path = deriveAddrs (derivePubPath path key)---- | Derive a multisig address from a given parent path. The number of required--- signatures (m in m of n) is also needed.-derivePathMSAddr ::-       [XPubKey]-    -> SoftPath-    -> Int-    -> KeyIndex-    -> (Address, RedeemScript)-derivePathMSAddr keys path =-    deriveMSAddr $ map (derivePubPath path) keys---- | Cyclic list of all multisig addresses derived from a given parent path and--- starting from the given offset index. The number of required signatures--- (m in m of n) is also needed.-derivePathMSAddrs ::-       [XPubKey]-    -> SoftPath-    -> Int-    -> KeyIndex-    -> [(Address, RedeemScript, KeyIndex)]-derivePathMSAddrs keys path =-    deriveMSAddrs $ map (derivePubPath path) keys--{- Utilities for extended keys -}---- | De-serialize HDW-specific private key.-getPadPrvKey :: Get SecKey-getPadPrvKey = do-    pad <- getWord8-    unless (pad == 0x00) $ fail "Private key must be padded with 0x00"-    secKeyGet---- | Serialize HDW-specific private key.-putPadPrvKey :: Putter SecKey-putPadPrvKey p = putWord8 0x00 >> secKeyPut p--bsPadPrvKey :: SecKey -> ByteString-bsPadPrvKey = runPut . putPadPrvKey
− src/Network/Haskoin/Keys/Mnemonic.hs 
@@ -1,516 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}-{-|-Module      : Network.Haskoin.Keys.Mnemonic-Copyright   : No rights reserved-License     : UNLICENSE-Maintainer  : jprupp@protonmail.ch-Stability   : experimental-Portability : POSIX--Mnemonic keys (BIP-39). Only English dictionary.--}-module Network.Haskoin.Keys.Mnemonic-    ( -- * Mnemonic Sentences-      Entropy-    , Mnemonic-    , Passphrase-    , Seed-    , toMnemonic-    , fromMnemonic-    , mnemonicToSeed-    ) where--import           Control.Monad           (when)-import           Crypto.Hash             (SHA256 (..), hashWith)-import           Crypto.KDF.PBKDF2       (Parameters (..), fastPBKDF2_SHA512)-import           Data.Bits               (shiftL, shiftR)-import qualified Data.ByteArray          as BA-import           Data.ByteString         (ByteString)-import qualified Data.ByteString         as BS-import           Data.List-import qualified Data.Map.Strict         as M-import           Data.Maybe-import           Data.String.Conversions (cs)-import           Data.Text               (Text)-import qualified Data.Text               as T-import qualified Data.Text.Encoding      as E-import           Data.Vector             (Vector, (!))-import qualified Data.Vector             as V-import           Network.Haskoin.Util---- | Random data used to create a mnemonic sentence. Use a good entropy source.--- You will get your coins stolen if you don't. You have been warned.-type Entropy = ByteString---- | Human-readable mnemonic sentence.-type Mnemonic = Text---- | Optional passphrase for mnemnoic sentence.-type Passphrase = ByteString---- | Seed for a private key from a mnemonic sentence.-type Seed = ByteString---- | Mnemonic key checksum.-type Checksum = ByteString---- | Paremeters for PBKDF2 function.-pbkdfParams :: Parameters-pbkdfParams = Parameters {iterCounts = 2048, outputLength = 64}---- | Provide intial 'Entropy' as a 'ByteString' of length multiple of 4 bytes.--- Output a 'Mnemonic' sentence.-toMnemonic :: Entropy -> Either String Mnemonic-toMnemonic ent = do-    when (BS.null ent) $-        Left "toMnemonic: entropy can not be empty"-    when (remainder /= 0) $-        Left "toMnemonic: entropy must be multiples of 4 bytes"-    when (cs_len > 16) $-        Left "toMnemonic: maximum entropy is 64 bytes (512 bits)"-    return ms-  where-    (cs_len, remainder) = BS.length ent `quotRem` 4-    c = calcCS cs_len ent-    indices = bsToIndices $ ent `BS.append` c-    ms = T.unwords $ map (wl!) indices---- | Revert 'toMnemonic'. Do not use this to generate a 'Seed'. Instead use--- 'mnemonicToSeed'. This outputs the original 'Entropy' used to generate a--- 'Mnemonic' sentence.-fromMnemonic :: Mnemonic -> Either String Entropy-fromMnemonic ms = do-    when (T.null ms) $-        Left "fromMnemonic: empty mnemonic"-    when (word_count > 48) $-        Left $ "fromMnemonic: too many words: " ++ show word_count-    when (word_count `mod` 3 /= 0) $-        Left $ "fromMnemonic: wrong number of words:" ++ show word_count-    ms_bs <- indicesToBS =<< getIndices ms_words-    let (ms_ent, ms_cs) = BS.splitAt (ent_len * 4) ms_bs-        ms_cs_num = numCS cs_len ms_cs-        ent_cs_num = numCS cs_len $ calcCS cs_len ms_ent-    when (ent_cs_num /= ms_cs_num) $-        Left $ "fromMnemonic: checksum failed: " ++ sh ent_cs_num ms_cs_num-    return ms_ent-  where-    ms_words = T.words ms-    word_count = length ms_words-    (ent_len, cs_len) = (word_count * 11) `quotRem` 32-    sh cs_a cs_b = show cs_a ++ " /= " ++ show cs_b---- | Compute 'Checksum'.-calcCS :: Int -> Entropy -> Checksum-calcCS len = getBits len . BA.convert . hashWith SHA256--numCS :: Int -> Entropy -> Integer-numCS len =-    shiftCS . bsToInteger-  where-    shiftCS = case 8 - len `mod` 8 of-        8 -> id-        x -> flip shiftR x---- | Turn an arbitrary sequence of characters into a 512-bit 'Seed'. Use--- 'mnemonicToSeed' to get a seed from a 'Mnemonic' sentence. Warning: Does not--- perform NFKD normalization.-anyToSeed :: Passphrase -> Mnemonic -> Seed-anyToSeed pf ms =-    fastPBKDF2_SHA512 pbkdfParams (E.encodeUtf8 ms) ("mnemonic" `mappend` pf)---- | Get a 512-bit 'Seed' from a 'Mnemonic' sentence. Will validate checksum.--- 'Passphrase' can be used to protect the 'Mnemonic'. Use an empty string as--- 'Passphrase' if none is required.-mnemonicToSeed :: Passphrase -> Mnemonic -> Either String Seed-mnemonicToSeed pf ms = do-    ent <- fromMnemonic ms-    mnm <- toMnemonic ent-    return $ anyToSeed pf mnm---- | Get indices of words in word list.-getIndices :: [Text] -> Either String [Int]-getIndices ws-    | null n = return $ catMaybes i-    | otherwise = Left $ "getIndices: words not found: " ++ cs w-  where-    i = map (`M.lookup` wl') ws-    n = elemIndices Nothing i-    w = T.unwords $ map (ws !!) n---- | Turn a list of 11-bit numbers into a 'ByteString'-indicesToBS :: [Int] -> Either String ByteString-indicesToBS is = do-    when lrg $ Left "indicesToBS: index larger or equal than 2048"-    return . pad . integerToBS $ foldl' f 0 is `shiftL` shift_width-  where-    lrg = isJust $ find (>= 2048) is-    (q, r) = (length is * 11) `quotRem` 8-    shift_width =-        if r == 0-            then 0-            else 8 - r-    bl =-        if r == 0-            then q-            else q + 1 -- length of resulting ByteString-    pad bs = BS.append (BS.replicate (bl - BS.length bs) 0x00) bs-    f acc x = (acc `shiftL` 11) + fromIntegral x---- | Turn a 'ByteString' into a list of 11-bit numbers.-bsToIndices :: ByteString -> [Int]-bsToIndices bs =-    reverse . go q $ bsToInteger bs `shiftR` r-  where-    (q, r) = (BS.length bs * 8) `quotRem` 11-    go 0 _ = []-    go n i = fromIntegral (i `mod` 2048) : go (n - 1) (i `shiftR` 11)--wl' :: M.Map Text Int-wl' = V.ifoldr' (\i w m -> M.insert w i m) M.empty wl---- | Standard English dictionary from BIP-39 specification.-wl :: Vector Text-wl = V.fromListN 2048-    [ "abandon", "ability", "able", "about", "above", "absent"-    , "absorb", "abstract", "absurd", "abuse", "access", "accident"-    , "account", "accuse", "achieve", "acid", "acoustic", "acquire"-    , "across", "act", "action", "actor", "actress", "actual"-    , "adapt", "add", "addict", "address", "adjust", "admit"-    , "adult", "advance", "advice", "aerobic", "affair", "afford"-    , "afraid", "again", "age", "agent", "agree", "ahead"-    , "aim", "air", "airport", "aisle", "alarm", "album"-    , "alcohol", "alert", "alien", "all", "alley", "allow"-    , "almost", "alone", "alpha", "already", "also", "alter"-    , "always", "amateur", "amazing", "among", "amount", "amused"-    , "analyst", "anchor", "ancient", "anger", "angle", "angry"-    , "animal", "ankle", "announce", "annual", "another", "answer"-    , "antenna", "antique", "anxiety", "any", "apart", "apology"-    , "appear", "apple", "approve", "april", "arch", "arctic"-    , "area", "arena", "argue", "arm", "armed", "armor"-    , "army", "around", "arrange", "arrest", "arrive", "arrow"-    , "art", "artefact", "artist", "artwork", "ask", "aspect"-    , "assault", "asset", "assist", "assume", "asthma", "athlete"-    , "atom", "attack", "attend", "attitude", "attract", "auction"-    , "audit", "august", "aunt", "author", "auto", "autumn"-    , "average", "avocado", "avoid", "awake", "aware", "away"-    , "awesome", "awful", "awkward", "axis", "baby", "bachelor"-    , "bacon", "badge", "bag", "balance", "balcony", "ball"-    , "bamboo", "banana", "banner", "bar", "barely", "bargain"-    , "barrel", "base", "basic", "basket", "battle", "beach"-    , "bean", "beauty", "because", "become", "beef", "before"-    , "begin", "behave", "behind", "believe", "below", "belt"-    , "bench", "benefit", "best", "betray", "better", "between"-    , "beyond", "bicycle", "bid", "bike", "bind", "biology"-    , "bird", "birth", "bitter", "black", "blade", "blame"-    , "blanket", "blast", "bleak", "bless", "blind", "blood"-    , "blossom", "blouse", "blue", "blur", "blush", "board"-    , "boat", "body", "boil", "bomb", "bone", "bonus"-    , "book", "boost", "border", "boring", "borrow", "boss"-    , "bottom", "bounce", "box", "boy", "bracket", "brain"-    , "brand", "brass", "brave", "bread", "breeze", "brick"-    , "bridge", "brief", "bright", "bring", "brisk", "broccoli"-    , "broken", "bronze", "broom", "brother", "brown", "brush"-    , "bubble", "buddy", "budget", "buffalo", "build", "bulb"-    , "bulk", "bullet", "bundle", "bunker", "burden", "burger"-    , "burst", "bus", "business", "busy", "butter", "buyer"-    , "buzz", "cabbage", "cabin", "cable", "cactus", "cage"-    , "cake", "call", "calm", "camera", "camp", "can"-    , "canal", "cancel", "candy", "cannon", "canoe", "canvas"-    , "canyon", "capable", "capital", "captain", "car", "carbon"-    , "card", "cargo", "carpet", "carry", "cart", "case"-    , "cash", "casino", "castle", "casual", "cat", "catalog"-    , "catch", "category", "cattle", "caught", "cause", "caution"-    , "cave", "ceiling", "celery", "cement", "census", "century"-    , "cereal", "certain", "chair", "chalk", "champion", "change"-    , "chaos", "chapter", "charge", "chase", "chat", "cheap"-    , "check", "cheese", "chef", "cherry", "chest", "chicken"-    , "chief", "child", "chimney", "choice", "choose", "chronic"-    , "chuckle", "chunk", "churn", "cigar", "cinnamon", "circle"-    , "citizen", "city", "civil", "claim", "clap", "clarify"-    , "claw", "clay", "clean", "clerk", "clever", "click"-    , "client", "cliff", "climb", "clinic", "clip", "clock"-    , "clog", "close", "cloth", "cloud", "clown", "club"-    , "clump", "cluster", "clutch", "coach", "coast", "coconut"-    , "code", "coffee", "coil", "coin", "collect", "color"-    , "column", "combine", "come", "comfort", "comic", "common"-    , "company", "concert", "conduct", "confirm", "congress", "connect"-    , "consider", "control", "convince", "cook", "cool", "copper"-    , "copy", "coral", "core", "corn", "correct", "cost"-    , "cotton", "couch", "country", "couple", "course", "cousin"-    , "cover", "coyote", "crack", "cradle", "craft", "cram"-    , "crane", "crash", "crater", "crawl", "crazy", "cream"-    , "credit", "creek", "crew", "cricket", "crime", "crisp"-    , "critic", "crop", "cross", "crouch", "crowd", "crucial"-    , "cruel", "cruise", "crumble", "crunch", "crush", "cry"-    , "crystal", "cube", "culture", "cup", "cupboard", "curious"-    , "current", "curtain", "curve", "cushion", "custom", "cute"-    , "cycle", "dad", "damage", "damp", "dance", "danger"-    , "daring", "dash", "daughter", "dawn", "day", "deal"-    , "debate", "debris", "decade", "december", "decide", "decline"-    , "decorate", "decrease", "deer", "defense", "define", "defy"-    , "degree", "delay", "deliver", "demand", "demise", "denial"-    , "dentist", "deny", "depart", "depend", "deposit", "depth"-    , "deputy", "derive", "describe", "desert", "design", "desk"-    , "despair", "destroy", "detail", "detect", "develop", "device"-    , "devote", "diagram", "dial", "diamond", "diary", "dice"-    , "diesel", "diet", "differ", "digital", "dignity", "dilemma"-    , "dinner", "dinosaur", "direct", "dirt", "disagree", "discover"-    , "disease", "dish", "dismiss", "disorder", "display", "distance"-    , "divert", "divide", "divorce", "dizzy", "doctor", "document"-    , "dog", "doll", "dolphin", "domain", "donate", "donkey"-    , "donor", "door", "dose", "double", "dove", "draft"-    , "dragon", "drama", "drastic", "draw", "dream", "dress"-    , "drift", "drill", "drink", "drip", "drive", "drop"-    , "drum", "dry", "duck", "dumb", "dune", "during"-    , "dust", "dutch", "duty", "dwarf", "dynamic", "eager"-    , "eagle", "early", "earn", "earth", "easily", "east"-    , "easy", "echo", "ecology", "economy", "edge", "edit"-    , "educate", "effort", "egg", "eight", "either", "elbow"-    , "elder", "electric", "elegant", "element", "elephant", "elevator"-    , "elite", "else", "embark", "embody", "embrace", "emerge"-    , "emotion", "employ", "empower", "empty", "enable", "enact"-    , "end", "endless", "endorse", "enemy", "energy", "enforce"-    , "engage", "engine", "enhance", "enjoy", "enlist", "enough"-    , "enrich", "enroll", "ensure", "enter", "entire", "entry"-    , "envelope", "episode", "equal", "equip", "era", "erase"-    , "erode", "erosion", "error", "erupt", "escape", "essay"-    , "essence", "estate", "eternal", "ethics", "evidence", "evil"-    , "evoke", "evolve", "exact", "example", "excess", "exchange"-    , "excite", "exclude", "excuse", "execute", "exercise", "exhaust"-    , "exhibit", "exile", "exist", "exit", "exotic", "expand"-    , "expect", "expire", "explain", "expose", "express", "extend"-    , "extra", "eye", "eyebrow", "fabric", "face", "faculty"-    , "fade", "faint", "faith", "fall", "false", "fame"-    , "family", "famous", "fan", "fancy", "fantasy", "farm"-    , "fashion", "fat", "fatal", "father", "fatigue", "fault"-    , "favorite", "feature", "february", "federal", "fee", "feed"-    , "feel", "female", "fence", "festival", "fetch", "fever"-    , "few", "fiber", "fiction", "field", "figure", "file"-    , "film", "filter", "final", "find", "fine", "finger"-    , "finish", "fire", "firm", "first", "fiscal", "fish"-    , "fit", "fitness", "fix", "flag", "flame", "flash"-    , "flat", "flavor", "flee", "flight", "flip", "float"-    , "flock", "floor", "flower", "fluid", "flush", "fly"-    , "foam", "focus", "fog", "foil", "fold", "follow"-    , "food", "foot", "force", "forest", "forget", "fork"-    , "fortune", "forum", "forward", "fossil", "foster", "found"-    , "fox", "fragile", "frame", "frequent", "fresh", "friend"-    , "fringe", "frog", "front", "frost", "frown", "frozen"-    , "fruit", "fuel", "fun", "funny", "furnace", "fury"-    , "future", "gadget", "gain", "galaxy", "gallery", "game"-    , "gap", "garage", "garbage", "garden", "garlic", "garment"-    , "gas", "gasp", "gate", "gather", "gauge", "gaze"-    , "general", "genius", "genre", "gentle", "genuine", "gesture"-    , "ghost", "giant", "gift", "giggle", "ginger", "giraffe"-    , "girl", "give", "glad", "glance", "glare", "glass"-    , "glide", "glimpse", "globe", "gloom", "glory", "glove"-    , "glow", "glue", "goat", "goddess", "gold", "good"-    , "goose", "gorilla", "gospel", "gossip", "govern", "gown"-    , "grab", "grace", "grain", "grant", "grape", "grass"-    , "gravity", "great", "green", "grid", "grief", "grit"-    , "grocery", "group", "grow", "grunt", "guard", "guess"-    , "guide", "guilt", "guitar", "gun", "gym", "habit"-    , "hair", "half", "hammer", "hamster", "hand", "happy"-    , "harbor", "hard", "harsh", "harvest", "hat", "have"-    , "hawk", "hazard", "head", "health", "heart", "heavy"-    , "hedgehog", "height", "hello", "helmet", "help", "hen"-    , "hero", "hidden", "high", "hill", "hint", "hip"-    , "hire", "history", "hobby", "hockey", "hold", "hole"-    , "holiday", "hollow", "home", "honey", "hood", "hope"-    , "horn", "horror", "horse", "hospital", "host", "hotel"-    , "hour", "hover", "hub", "huge", "human", "humble"-    , "humor", "hundred", "hungry", "hunt", "hurdle", "hurry"-    , "hurt", "husband", "hybrid", "ice", "icon", "idea"-    , "identify", "idle", "ignore", "ill", "illegal", "illness"-    , "image", "imitate", "immense", "immune", "impact", "impose"-    , "improve", "impulse", "inch", "include", "income", "increase"-    , "index", "indicate", "indoor", "industry", "infant", "inflict"-    , "inform", "inhale", "inherit", "initial", "inject", "injury"-    , "inmate", "inner", "innocent", "input", "inquiry", "insane"-    , "insect", "inside", "inspire", "install", "intact", "interest"-    , "into", "invest", "invite", "involve", "iron", "island"-    , "isolate", "issue", "item", "ivory", "jacket", "jaguar"-    , "jar", "jazz", "jealous", "jeans", "jelly", "jewel"-    , "job", "join", "joke", "journey", "joy", "judge"-    , "juice", "jump", "jungle", "junior", "junk", "just"-    , "kangaroo", "keen", "keep", "ketchup", "key", "kick"-    , "kid", "kidney", "kind", "kingdom", "kiss", "kit"-    , "kitchen", "kite", "kitten", "kiwi", "knee", "knife"-    , "knock", "know", "lab", "label", "labor", "ladder"-    , "lady", "lake", "lamp", "language", "laptop", "large"-    , "later", "latin", "laugh", "laundry", "lava", "law"-    , "lawn", "lawsuit", "layer", "lazy", "leader", "leaf"-    , "learn", "leave", "lecture", "left", "leg", "legal"-    , "legend", "leisure", "lemon", "lend", "length", "lens"-    , "leopard", "lesson", "letter", "level", "liar", "liberty"-    , "library", "license", "life", "lift", "light", "like"-    , "limb", "limit", "link", "lion", "liquid", "list"-    , "little", "live", "lizard", "load", "loan", "lobster"-    , "local", "lock", "logic", "lonely", "long", "loop"-    , "lottery", "loud", "lounge", "love", "loyal", "lucky"-    , "luggage", "lumber", "lunar", "lunch", "luxury", "lyrics"-    , "machine", "mad", "magic", "magnet", "maid", "mail"-    , "main", "major", "make", "mammal", "man", "manage"-    , "mandate", "mango", "mansion", "manual", "maple", "marble"-    , "march", "margin", "marine", "market", "marriage", "mask"-    , "mass", "master", "match", "material", "math", "matrix"-    , "matter", "maximum", "maze", "meadow", "mean", "measure"-    , "meat", "mechanic", "medal", "media", "melody", "melt"-    , "member", "memory", "mention", "menu", "mercy", "merge"-    , "merit", "merry", "mesh", "message", "metal", "method"-    , "middle", "midnight", "milk", "million", "mimic", "mind"-    , "minimum", "minor", "minute", "miracle", "mirror", "misery"-    , "miss", "mistake", "mix", "mixed", "mixture", "mobile"-    , "model", "modify", "mom", "moment", "monitor", "monkey"-    , "monster", "month", "moon", "moral", "more", "morning"-    , "mosquito", "mother", "motion", "motor", "mountain", "mouse"-    , "move", "movie", "much", "muffin", "mule", "multiply"-    , "muscle", "museum", "mushroom", "music", "must", "mutual"-    , "myself", "mystery", "myth", "naive", "name", "napkin"-    , "narrow", "nasty", "nation", "nature", "near", "neck"-    , "need", "negative", "neglect", "neither", "nephew", "nerve"-    , "nest", "net", "network", "neutral", "never", "news"-    , "next", "nice", "night", "noble", "noise", "nominee"-    , "noodle", "normal", "north", "nose", "notable", "note"-    , "nothing", "notice", "novel", "now", "nuclear", "number"-    , "nurse", "nut", "oak", "obey", "object", "oblige"-    , "obscure", "observe", "obtain", "obvious", "occur", "ocean"-    , "october", "odor", "off", "offer", "office", "often"-    , "oil", "okay", "old", "olive", "olympic", "omit"-    , "once", "one", "onion", "online", "only", "open"-    , "opera", "opinion", "oppose", "option", "orange", "orbit"-    , "orchard", "order", "ordinary", "organ", "orient", "original"-    , "orphan", "ostrich", "other", "outdoor", "outer", "output"-    , "outside", "oval", "oven", "over", "own", "owner"-    , "oxygen", "oyster", "ozone", "pact", "paddle", "page"-    , "pair", "palace", "palm", "panda", "panel", "panic"-    , "panther", "paper", "parade", "parent", "park", "parrot"-    , "party", "pass", "patch", "path", "patient", "patrol"-    , "pattern", "pause", "pave", "payment", "peace", "peanut"-    , "pear", "peasant", "pelican", "pen", "penalty", "pencil"-    , "people", "pepper", "perfect", "permit", "person", "pet"-    , "phone", "photo", "phrase", "physical", "piano", "picnic"-    , "picture", "piece", "pig", "pigeon", "pill", "pilot"-    , "pink", "pioneer", "pipe", "pistol", "pitch", "pizza"-    , "place", "planet", "plastic", "plate", "play", "please"-    , "pledge", "pluck", "plug", "plunge", "poem", "poet"-    , "point", "polar", "pole", "police", "pond", "pony"-    , "pool", "popular", "portion", "position", "possible", "post"-    , "potato", "pottery", "poverty", "powder", "power", "practice"-    , "praise", "predict", "prefer", "prepare", "present", "pretty"-    , "prevent", "price", "pride", "primary", "print", "priority"-    , "prison", "private", "prize", "problem", "process", "produce"-    , "profit", "program", "project", "promote", "proof", "property"-    , "prosper", "protect", "proud", "provide", "public", "pudding"-    , "pull", "pulp", "pulse", "pumpkin", "punch", "pupil"-    , "puppy", "purchase", "purity", "purpose", "purse", "push"-    , "put", "puzzle", "pyramid", "quality", "quantum", "quarter"-    , "question", "quick", "quit", "quiz", "quote", "rabbit"-    , "raccoon", "race", "rack", "radar", "radio", "rail"-    , "rain", "raise", "rally", "ramp", "ranch", "random"-    , "range", "rapid", "rare", "rate", "rather", "raven"-    , "raw", "razor", "ready", "real", "reason", "rebel"-    , "rebuild", "recall", "receive", "recipe", "record", "recycle"-    , "reduce", "reflect", "reform", "refuse", "region", "regret"-    , "regular", "reject", "relax", "release", "relief", "rely"-    , "remain", "remember", "remind", "remove", "render", "renew"-    , "rent", "reopen", "repair", "repeat", "replace", "report"-    , "require", "rescue", "resemble", "resist", "resource", "response"-    , "result", "retire", "retreat", "return", "reunion", "reveal"-    , "review", "reward", "rhythm", "rib", "ribbon", "rice"-    , "rich", "ride", "ridge", "rifle", "right", "rigid"-    , "ring", "riot", "ripple", "risk", "ritual", "rival"-    , "river", "road", "roast", "robot", "robust", "rocket"-    , "romance", "roof", "rookie", "room", "rose", "rotate"-    , "rough", "round", "route", "royal", "rubber", "rude"-    , "rug", "rule", "run", "runway", "rural", "sad"-    , "saddle", "sadness", "safe", "sail", "salad", "salmon"-    , "salon", "salt", "salute", "same", "sample", "sand"-    , "satisfy", "satoshi", "sauce", "sausage", "save", "say"-    , "scale", "scan", "scare", "scatter", "scene", "scheme"-    , "school", "science", "scissors", "scorpion", "scout", "scrap"-    , "screen", "script", "scrub", "sea", "search", "season"-    , "seat", "second", "secret", "section", "security", "seed"-    , "seek", "segment", "select", "sell", "seminar", "senior"-    , "sense", "sentence", "series", "service", "session", "settle"-    , "setup", "seven", "shadow", "shaft", "shallow", "share"-    , "shed", "shell", "sheriff", "shield", "shift", "shine"-    , "ship", "shiver", "shock", "shoe", "shoot", "shop"-    , "short", "shoulder", "shove", "shrimp", "shrug", "shuffle"-    , "shy", "sibling", "sick", "side", "siege", "sight"-    , "sign", "silent", "silk", "silly", "silver", "similar"-    , "simple", "since", "sing", "siren", "sister", "situate"-    , "six", "size", "skate", "sketch", "ski", "skill"-    , "skin", "skirt", "skull", "slab", "slam", "sleep"-    , "slender", "slice", "slide", "slight", "slim", "slogan"-    , "slot", "slow", "slush", "small", "smart", "smile"-    , "smoke", "smooth", "snack", "snake", "snap", "sniff"-    , "snow", "soap", "soccer", "social", "sock", "soda"-    , "soft", "solar", "soldier", "solid", "solution", "solve"-    , "someone", "song", "soon", "sorry", "sort", "soul"-    , "sound", "soup", "source", "south", "space", "spare"-    , "spatial", "spawn", "speak", "special", "speed", "spell"-    , "spend", "sphere", "spice", "spider", "spike", "spin"-    , "spirit", "split", "spoil", "sponsor", "spoon", "sport"-    , "spot", "spray", "spread", "spring", "spy", "square"-    , "squeeze", "squirrel", "stable", "stadium", "staff", "stage"-    , "stairs", "stamp", "stand", "start", "state", "stay"-    , "steak", "steel", "stem", "step", "stereo", "stick"-    , "still", "sting", "stock", "stomach", "stone", "stool"-    , "story", "stove", "strategy", "street", "strike", "strong"-    , "struggle", "student", "stuff", "stumble", "style", "subject"-    , "submit", "subway", "success", "such", "sudden", "suffer"-    , "sugar", "suggest", "suit", "summer", "sun", "sunny"-    , "sunset", "super", "supply", "supreme", "sure", "surface"-    , "surge", "surprise", "surround", "survey", "suspect", "sustain"-    , "swallow", "swamp", "swap", "swarm", "swear", "sweet"-    , "swift", "swim", "swing", "switch", "sword", "symbol"-    , "symptom", "syrup", "system", "table", "tackle", "tag"-    , "tail", "talent", "talk", "tank", "tape", "target"-    , "task", "taste", "tattoo", "taxi", "teach", "team"-    , "tell", "ten", "tenant", "tennis", "tent", "term"-    , "test", "text", "thank", "that", "theme", "then"-    , "theory", "there", "they", "thing", "this", "thought"-    , "three", "thrive", "throw", "thumb", "thunder", "ticket"-    , "tide", "tiger", "tilt", "timber", "time", "tiny"-    , "tip", "tired", "tissue", "title", "toast", "tobacco"-    , "today", "toddler", "toe", "together", "toilet", "token"-    , "tomato", "tomorrow", "tone", "tongue", "tonight", "tool"-    , "tooth", "top", "topic", "topple", "torch", "tornado"-    , "tortoise", "toss", "total", "tourist", "toward", "tower"-    , "town", "toy", "track", "trade", "traffic", "tragic"-    , "train", "transfer", "trap", "trash", "travel", "tray"-    , "treat", "tree", "trend", "trial", "tribe", "trick"-    , "trigger", "trim", "trip", "trophy", "trouble", "truck"-    , "true", "truly", "trumpet", "trust", "truth", "try"-    , "tube", "tuition", "tumble", "tuna", "tunnel", "turkey"-    , "turn", "turtle", "twelve", "twenty", "twice", "twin"-    , "twist", "two", "type", "typical", "ugly", "umbrella"-    , "unable", "unaware", "uncle", "uncover", "under", "undo"-    , "unfair", "unfold", "unhappy", "uniform", "unique", "unit"-    , "universe", "unknown", "unlock", "until", "unusual", "unveil"-    , "update", "upgrade", "uphold", "upon", "upper", "upset"-    , "urban", "urge", "usage", "use", "used", "useful"-    , "useless", "usual", "utility", "vacant", "vacuum", "vague"-    , "valid", "valley", "valve", "van", "vanish", "vapor"-    , "various", "vast", "vault", "vehicle", "velvet", "vendor"-    , "venture", "venue", "verb", "verify", "version", "very"-    , "vessel", "veteran", "viable", "vibrant", "vicious", "victory"-    , "video", "view", "village", "vintage", "violin", "virtual"-    , "virus", "visa", "visit", "visual", "vital", "vivid"-    , "vocal", "voice", "void", "volcano", "volume", "vote"-    , "voyage", "wage", "wagon", "wait", "walk", "wall"-    , "walnut", "want", "warfare", "warm", "warrior", "wash"-    , "wasp", "waste", "water", "wave", "way", "wealth"-    , "weapon", "wear", "weasel", "weather", "web", "wedding"-    , "weekend", "weird", "welcome", "west", "wet", "whale"-    , "what", "wheat", "wheel", "when", "where", "whip"-    , "whisper", "wide", "width", "wife", "wild", "will"-    , "win", "window", "wine", "wing", "wink", "winner"-    , "winter", "wire", "wisdom", "wise", "wish", "witness"-    , "wolf", "woman", "wonder", "wood", "wool", "word"-    , "work", "world", "worry", "worth", "wrap", "wreck"-    , "wrestle", "wrist", "write", "wrong", "yard", "year"-    , "yellow", "you", "young", "youth", "zebra", "zero"-    , "zone", "zoo"-    ]
− src/Network/Haskoin/Network.hs 
@@ -1,21 +0,0 @@-{-|-Module      : Network.Haskoin.Network-Copyright   : No rights reserved-License     : UNLICENSE-Maintainer  : jprupp@protonmail.ch-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-    , module Message-    , module Bloom-    ) where--import           Network.Haskoin.Network.Bloom   as Bloom-import           Network.Haskoin.Network.Common  as Common-import           Network.Haskoin.Network.Message as Message
− src/Network/Haskoin/Network/Bloom.hs 
@@ -1,263 +0,0 @@-{-# LANGUAGE DeriveAnyClass #-}-{-# LANGUAGE DeriveGeneric  #-}-{-|-Module      : Network.Haskoin.Network.Bloom-Copyright   : No rights reserved-License     : UNLICENSE-Maintainer  : jprupp@protonmail.ch-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-      BloomFlags(..)-    , BloomFilter(..)-    , FilterLoad(..)-    , FilterAdd(..)-    , bloomCreate-    , bloomInsert-    , bloomContains-    , isBloomValid-    , isBloomEmpty-    , isBloomFull-    , acceptsFilters-    , bloomRelevantUpdate-    ) where--import           Control.DeepSeq-import           Control.Monad                      (forM_, replicateM)-import           Data.Bits-import           Data.ByteString                    (ByteString)-import qualified Data.ByteString                    as BS-import qualified Data.Foldable                      as F-import           Data.Hash.Murmur                   (murmur3)-import           Data.List                          (foldl')-import qualified Data.Sequence                      as S-import           Data.Serialize                     (Serialize, encode, get,-                                                     put)-import           Data.Serialize.Get                 (getByteString, getWord32le,-                                                     getWord8)-import           Data.Serialize.Put                 (putByteString, putWord32le,-                                                     putWord8)-import           Data.Word-import           GHC.Generics                       (Generic)-import           Network.Haskoin.Network.Common-import           Network.Haskoin.Script.Common-import           Network.Haskoin.Transaction.Common--- | 20,000 items with fp rate < 0.1% or 10,000 items and <0.0001%-maxBloomSize :: Int-maxBloomSize = 36000--maxHashFuncs :: Word32-maxHashFuncs = 50--ln2Squared :: Double-ln2Squared = 0.4804530139182014246671025263266649717305529515945455--ln2 :: Double-ln2 = 0.6931471805599453094172321214581765680755001343602552--bitMask :: [Word8]-bitMask = [0x01, 0x02, 0x04, 0x08, 0x10, 0x20, 0x40, 0x80]---- | The bloom flags are used to tell the remote peer how to auto-update--- the provided bloom filter.-data BloomFlags-    = BloomUpdateNone -- ^ never update-    | BloomUpdateAll -- ^ auto-update on all outputs-    | BloomUpdateP2PubKeyOnly-    -- ^ auto-update on pay-to-pubkey or pay-to-multisig (default)-    deriving (Eq, Show, Read, Generic, NFData)--instance Serialize BloomFlags where-    get = go =<< getWord8-      where-        go 0 = return BloomUpdateNone-        go 1 = return BloomUpdateAll-        go 2 = return BloomUpdateP2PubKeyOnly-        go _ = fail "BloomFlags get: Invalid bloom flag"--    put f = putWord8 $ case f of-        BloomUpdateNone         -> 0-        BloomUpdateAll          -> 1-        BloomUpdateP2PubKeyOnly -> 2---- | A bloom filter is a probabilistic data structure that SPV clients send to--- other peers to filter the set of transactions received from them. Bloom--- filters can have false positives but not false negatives. Some transactions--- that pass the filter may not be relevant to the receiving peer. By--- controlling the false positive rate, SPV nodes can trade off bandwidth--- versus privacy.-data BloomFilter = BloomFilter-    { bloomData      :: !(S.Seq Word8)-    -- ^ bloom filter data-    , bloomHashFuncs :: !Word32-    -- ^ number of hash functions for this filter-    , bloomTweak     :: !Word32-    -- ^ hash function random nonce-    , bloomFlags     :: !BloomFlags-    -- ^ bloom filter auto-update flags-    }-    deriving (Eq, Show, Read, Generic, NFData)--instance Serialize BloomFilter where--    get = BloomFilter <$> (S.fromList <$> (readDat =<< get))-                      <*> getWord32le <*> getWord32le-                      <*> get-      where-        readDat (VarInt len) = replicateM (fromIntegral len) getWord8--    put (BloomFilter dat hashFuncs tweak flags) = do-        putVarInt $ S.length dat-        forM_ (F.toList dat) putWord8-        putWord32le hashFuncs-        putWord32le tweak-        put flags---- | Set a new bloom filter on the peer connection.-newtype FilterLoad = FilterLoad { filterLoadBloomFilter :: BloomFilter }-    deriving (Eq, Show, Read, Generic, NFData)--instance Serialize FilterLoad where-    get = FilterLoad <$> get-    put (FilterLoad f) = put f---- | Add the given data element to the connections current filter without--- requiring a completely new one to be set.-newtype FilterAdd = FilterAdd { getFilterData :: ByteString }-    deriving (Eq, Show, Read, Generic, NFData)--instance Serialize FilterAdd where-    get = do-        (VarInt len) <- get-        dat <- getByteString $ fromIntegral len-        return $ FilterAdd dat--    put (FilterAdd bs) = do-        putVarInt $ BS.length bs-        putByteString bs----- | Build a bloom filter that will provide the given false positive rate when--- the given number of elements have been inserted.-bloomCreate :: Int          -- ^ number of elements-            -> Double       -- ^ false positive rate-            -> Word32       -- ^ random nonce (tweak) for the hash function-            -> BloomFlags   -- ^ bloom filter flags-            -> BloomFilter  -- ^ bloom filter-bloomCreate numElem fpRate =-    BloomFilter (S.replicate bloomSize 0) numHashF-  where-    -- Bloom filter size in bytes-    bloomSize = truncate $ min a b / 8-    -- Suggested size in bits-    a         = -1 / ln2Squared * fromIntegral numElem * log fpRate-    -- Maximum size in bits-    b         = fromIntegral $ maxBloomSize * 8-    numHashF  = truncate $ min c (fromIntegral maxHashFuncs)-    -- Suggested number of hash functions-    c         = fromIntegral bloomSize * 8 / fromIntegral numElem * ln2--bloomHash :: BloomFilter -> Word32 -> ByteString -> Word32-bloomHash bfilter hashNum bs =-    murmur3 seed bs `mod` (fromIntegral (S.length (bloomData bfilter)) * 8)-  where-    seed = hashNum * 0xfba4c795 + bloomTweak bfilter---- | Insert arbitrary data into a bloom filter. Returns the new bloom filter--- containing the new data.-bloomInsert :: BloomFilter    -- ^ Original bloom filter-            -> ByteString     -- ^ New data to insert-            -> BloomFilter    -- ^ Bloom filter containing the new data-bloomInsert bfilter bs-    | isBloomFull bfilter = bfilter-    | otherwise = bfilter { bloomData = newData }-  where-    idxs    = map (\i -> bloomHash bfilter i bs) [0..bloomHashFuncs bfilter - 1]-    upd s i = S.adjust (.|. bitMask !! fromIntegral (7 .&. i))-                       (fromIntegral $ i `shiftR` 3) s-    newData = foldl upd (bloomData bfilter) idxs---- | Tests if some arbitrary data matches the filter. This can be either because--- the data was inserted into the filter or because it is a false positive.-bloomContains :: BloomFilter    -- ^ Bloom filter-              -> ByteString-              -- ^ Data that will be checked against the given bloom filter-              -> Bool-              -- ^ Returns True if the data matches the filter-bloomContains bfilter bs-    | isBloomFull bfilter  = True-    | isBloomEmpty bfilter = False-    | otherwise            = all isSet idxs-  where-    s       = bloomData bfilter-    idxs    = map (\i -> bloomHash bfilter i bs) [0..bloomHashFuncs bfilter - 1]-    isSet i = S.index s (fromIntegral $ i `shiftR` 3)-          .&. (bitMask !! fromIntegral (7 .&. i)) /= 0---- | Checks if any of the outputs of a tx is in the current bloom filter.--- If it is, add the txid and vout as an outpoint (i.e. so that--- a future tx that spends the output won't be missed).-bloomRelevantUpdate :: BloomFilter-                    -- ^ Bloom filter-                    -> Tx-                    -- ^ Tx that may (or may not) have relevant outputs-                    -> Maybe BloomFilter-                    -- ^ Returns an updated bloom filter adding relevant output-bloomRelevantUpdate bfilter tx-    | isBloomFull bfilter || isBloomEmpty bfilter = Nothing-    | bloomFlags bfilter == BloomUpdateNone = Nothing-    | length matchOuts > 0 = Just $ foldl' (addRelevant) bfilter matchOuts-    | otherwise = Nothing-    where-        -- TxHash if we end up inserting an outpoint-        h = txHash tx-        -- Decode the scriptOutpus and add vOuts in case we make them outpoints-        decodedOutputScripts = traverse (decodeOutputBS . scriptOutput) $ txOut tx-        err = error $ "Error Decoding output script"-        idxOutputScripts = either (const err) (zip [0..]) decodedOutputScripts-        -- Check if any txOuts were contained in the bloom filter-        matchFilter = filter (\(_,op) -> bloomContains bfilter $ encodeScriptOut op)-        matchOuts = matchFilter idxOutputScripts--        addRelevant :: BloomFilter -> (Word32,ScriptOutput) -> BloomFilter-        addRelevant bfilter (id,scriptOut) = case (bloomFlags bfilter,scriptType) of-            -- We filtered out BloomUpdateNone so we insert any PayPk or PayMulSig-            (_, True) -> bloomInsert bfilter outpoint-            (BloomUpdateAll, _ ) -> bloomInsert bfilter outpoint-            _ ->  error "Error Updating Bloom Filter with relevant outpoint"-            where-                outpoint = encode $ OutPoint{ outPointHash = h, outPointIndex = id}-                scriptType = (\s -> isPayPK s ||isPayMulSig s) scriptOut--        -- Encodes a scriptOutput so it can be checked agains the Bloom Filter-        encodeScriptOut :: ScriptOutput -> ByteString-        encodeScriptOut (PayMulSig outputMuSig _) = encode outputMuSig-        encodeScriptOut (PayWitnessScriptHash scriptHash) = encode scriptHash-        encodeScriptOut (DataCarrier getOutputData) = encode getOutputData-        encodeScriptOut outputHash = (encode . getOutputHash) outputHash---- | Returns True if the filter is empty (all bytes set to 0x00)-isBloomEmpty :: BloomFilter -> Bool-isBloomEmpty bfilter = all (== 0x00) $ F.toList $ bloomData bfilter---- | Returns True if the filter is full (all bytes set to 0xff)-isBloomFull :: BloomFilter -> Bool-isBloomFull bfilter = all (== 0xff) $ F.toList $ bloomData bfilter---- | Tests if a given bloom filter is valid.-isBloomValid :: BloomFilter -- ^ Bloom filter to test-             -> Bool        -- ^ True if the given filter is valid-isBloomValid bfilter =-    S.length (bloomData bfilter) <= maxBloomSize &&-    bloomHashFuncs bfilter <= maxHashFuncs---- | Does the peer with these version services accept bloom filters?-acceptsFilters :: Word64 -> Bool-acceptsFilters srv = srv .&. (1 `shiftL` 2) /= 0
− src/Network/Haskoin/Network/Common.hs 
@@ -1,613 +0,0 @@-{-# LANGUAGE DeriveAnyClass    #-}-{-# LANGUAGE DeriveGeneric     #-}-{-# LANGUAGE LambdaCase        #-}-{-# LANGUAGE OverloadedStrings #-}-{-|-Module      : Network.Haskoin.Network.Common-Copyright   : No rights reserved-License     : UNLICENSE-Maintainer  : jprupp@protonmail.ch-Stability   : experimental-Portability : POSIX--Common functions and data types related to peer-to-peer network.--}-module Network.Haskoin.Network.Common-    ( -- * Network Data Types-      Addr(..)-    , NetworkAddressTime-    , Alert(..)-    , GetData(..)-    , Inv(..)-    , InvVector(..)-    , InvType(..)-    , HostAddress-    , hostToSockAddr-    , sockToHostAddress-    , NetworkAddress(..)-    , NotFound(..)-    , Ping(..)-    , Pong(..)-    , Reject(..)-    , RejectCode(..)-    , VarInt(..)-    , VarString(..)-    , Version(..)-    , MessageCommand(..)-      -- ** Useful Functions-    , reject-    , nodeNone-    , nodeNetwork-    , nodeGetUTXO-    , nodeBloom-    , nodeWitness-    , nodeXThin-    , commandToString-    , stringToCommand-    , putVarInt-    ) where--import           Control.DeepSeq-import           Control.Monad               (forM_, liftM2, replicateM, unless)-import           Data.Bits                   (shiftL)-import           Data.ByteString             (ByteString)-import qualified Data.ByteString             as B-import           Data.ByteString.Char8       as C (replicate)-import           Data.Serialize              as S-import           Data.String-import           Data.String.Conversions     (cs)-import           Data.Word                   (Word32, Word64)-import           GHC.Generics                (Generic)-import           Network.Haskoin.Crypto.Hash-import           Network.Socket              (SockAddr (..))-import           Text.Read                   as R---- | Network address with a timestamp.-type NetworkAddressTime = (Word32, NetworkAddress)---- | Provides information about known nodes in the bitcoin network. An 'Addr'--- type is sent inside a 'Message' as a response to a 'GetAddr' message.-newtype Addr =-    Addr { -- List of addresses of other nodes on the network with timestamps.-           addrList :: [NetworkAddressTime]-         }-    deriving (Eq, Show, Generic, NFData)--instance Serialize Addr where--    get = Addr <$> (repList =<< S.get)-      where-        repList (VarInt c) = replicateM (fromIntegral c) action-        action             = liftM2 (,) getWord32le S.get--    put (Addr xs) = do-        putVarInt $ length xs-        forM_ xs $ \(a,b) -> putWord32le a >> put b---- | Data type describing signed messages that can be sent between bitcoin--- nodes to display important notifications to end users about the health of--- the network.-data Alert =-    Alert {-          -- | Alert payload.-            alertPayload   :: !VarString-          -- | ECDSA signature of the payload-          , alertSignature :: !VarString-          } deriving (Eq, Show, Read, Generic, NFData)--instance Serialize Alert where-    get = Alert <$> S.get <*> S.get-    put (Alert p s) = put p >> put s---- | The 'GetData' type is used to retrieve information on a specific object--- ('Block' or 'Tx') identified by the objects hash. The payload of a 'GetData'--- request is a list of 'InvVector' which represent all the hashes of objects--- that a node wants. The response to a 'GetBlock' message will be either a--- 'Block' or a 'Tx' message depending on the type of the object referenced by--- the hash. Usually, 'GetData' messages are sent after a node receives an 'Inv'--- message that contains unknown object hashes.-newtype GetData =-    GetData { -- | list of object hashes-              getDataList :: [InvVector]-            } deriving (Eq, Show, Generic, NFData)--instance Serialize GetData where--    get = GetData <$> (repList =<< S.get)-      where-        repList (VarInt c) = replicateM (fromIntegral c) S.get--    put (GetData xs) = do-        putVarInt $ length xs-        forM_ xs put---- | 'Inv' messages are used by nodes to advertise their knowledge of new--- objects by publishing a list of hashes to a peer. 'Inv' messages can be sent--- unsolicited or in response to a 'GetBlocks' message.-newtype Inv =-    Inv {-        -- | inventory-          invList :: [InvVector]-        } deriving (Eq, Show, Generic, NFData)--instance Serialize Inv where--    get = Inv <$> (repList =<< S.get)-      where-        repList (VarInt c) = replicateM (fromIntegral c) S.get--    put (Inv xs) = do-        putVarInt $ length xs-        forM_ xs put---- | Data type identifying the type of an inventory vector. SegWit types are--- only used in 'GetData' messages, not 'Inv'.-data InvType-    = InvError -- ^ error-    | InvTx -- ^ transaction-    | InvBlock -- ^ block-    | InvMerkleBlock -- ^ filtered block-    | InvWitnessTx -- ^ segwit transaction-    | InvWitnessBlock -- ^ segwit block-    | InvWitnessMerkleBlock -- ^ segwit filtere block-    deriving (Eq, Show, Read, Generic, NFData)--instance Serialize InvType where-    get = go =<< getWord32le-      where-        go x =-            case x of-                0 -> return InvError-                1 -> return InvTx-                2 -> return InvBlock-                3 -> return InvMerkleBlock-                _-                    | x == 1 `shiftL` 30 + 1 -> return InvWitnessTx-                    | x == 1 `shiftL` 30 + 2 -> return InvWitnessBlock-                    | x == 1 `shiftL` 30 + 3 -> return InvWitnessMerkleBlock-                    | otherwise -> fail "bitcoinGet InvType: Invalid Type"-    put x =-        putWord32le $-        case x of-            InvError              -> 0-            InvTx                 -> 1-            InvBlock              -> 2-            InvMerkleBlock        -> 3-            InvWitnessTx          -> 1 `shiftL` 30 + 1-            InvWitnessBlock       -> 1 `shiftL` 30 + 2-            InvWitnessMerkleBlock -> 1 `shiftL` 30 + 3---- | Invectory vectors represent hashes identifying objects such as a 'Block' or--- a 'Tx'. They notify other peers about new data or data they have otherwise--- requested.-data InvVector =-    InvVector {-                -- | type of object-                invType :: !InvType-                -- | 256-bit hash of object-              , invHash :: !Hash256-              } deriving (Eq, Show, Generic, NFData)--instance Serialize InvVector where-    get = InvVector <$> S.get <*> S.get-    put (InvVector t h) = put t >> put h--newtype HostAddress =-    HostAddress ByteString-    deriving (Eq, Show, Ord, Generic, NFData)--instance Serialize HostAddress where-    put (HostAddress bs) = putByteString bs-    get = HostAddress <$> getByteString 18---- | Data type describing a bitcoin network address. Addresses are stored in--- IPv6 format. IPv4 addresses are mapped to IPv6 using IPv4 mapped IPv6--- addresses: <http://en.wikipedia.org/wiki/IPv6#IPv4-mapped_IPv6_addresses>.-data NetworkAddress =-    NetworkAddress { -- | bitmask of services available for this address-                     naServices :: !Word64-                     -- | address and port information-                   , naAddress  :: !HostAddress-                   } deriving (Eq, Show, Generic, NFData)--hostToSockAddr :: HostAddress -> SockAddr-hostToSockAddr (HostAddress bs) =-    case runGet getSockAddr bs of-        Left e  -> error e-        Right x -> x--sockToHostAddress :: SockAddr -> HostAddress-sockToHostAddress = HostAddress . runPut . putSockAddr--putSockAddr :: SockAddr -> Put-putSockAddr (SockAddrInet6 p _ (a, b, c, d) _) = do-    putWord32be a-    putWord32be b-    putWord32be c-    putWord32be d-    putWord16be (fromIntegral p)--putSockAddr (SockAddrInet p a) = do-    putWord32be 0x00000000-    putWord32be 0x00000000-    putWord32be 0x0000ffff-    putWord32host a-    putWord16be (fromIntegral p)--putSockAddr _ = error "Invalid address type"--getSockAddr :: Get SockAddr-getSockAddr = do-    a <- getWord32be-    b <- getWord32be-    c <- getWord32be-    if a == 0x00000000 && b == 0x00000000 && c == 0x0000ffff-        then do-            d <- getWord32host-            p <- getWord16be-            return $ SockAddrInet (fromIntegral p) d-        else do-            d <- getWord32be-            p <- getWord16be-            return $ SockAddrInet6 (fromIntegral p) 0 (a, b, c, d) 0--instance Serialize NetworkAddress where-    get = NetworkAddress <$> getWord64le <*> S.get-    put (NetworkAddress s a) = putWord64le s >> put a---- | A 'NotFound' message is returned as a response to a 'GetData' message--- whe one of the requested objects could not be retrieved. This could happen,--- for example, if a tranasaction was requested and was not available in the--- memory pool of the receiving node.-newtype NotFound =-    NotFound { -- | Inventory vectors related to this request-               notFoundList :: [InvVector]-             } deriving (Eq, Show, Generic, NFData)--instance Serialize NotFound where--    get = NotFound <$> (repList =<< S.get)-      where-        repList (VarInt c) = replicateM (fromIntegral c) S.get--    put (NotFound xs) = do-        putVarInt $ length xs-        forM_ xs put---- | A 'Ping' message is sent to bitcoin peers to check if a connection is still--- open.-newtype Ping =-    Ping { -- | A random nonce used to identify the recipient of the ping-           -- request once a Pong response is received.-           pingNonce :: Word64-         } deriving (Eq, Show, Read, Generic, NFData)---- | A Pong message is sent as a response to a ping message.-newtype Pong =-    Pong {-           -- | nonce from corresponding 'Ping'-           pongNonce :: Word64-         } deriving (Eq, Show, Read, Generic, NFData)--instance Serialize Ping where-    get = Ping <$> getWord64le-    put (Ping n) = putWord64le n--instance Serialize Pong where-    get = Pong <$> getWord64le-    put (Pong n) = putWord64le n---- | The 'Reject' message is sent when messages are rejected by a peer.-data Reject =-    Reject {-             -- | type of message rejected-             rejectMessage :: !MessageCommand-             -- | rejection code-           , rejectCode    :: !RejectCode-             -- | text reason for rejection-           , rejectReason  :: !VarString-             -- | extra data such as block or tx hash-           , rejectData    :: !ByteString-           } deriving (Eq, Show, Read, Generic, NFData)---- | Rejection code associated to the 'Reject' message.-data RejectCode-    = RejectMalformed-    | RejectInvalid-    | RejectObsolete-    | RejectDuplicate-    | RejectNonStandard-    | RejectDust-    | RejectInsufficientFee-    | RejectCheckpoint-    deriving (Eq, Show, Read, Generic, NFData)--instance Serialize RejectCode where--    get = getWord8 >>= \code -> case code of-        0x01 -> return RejectMalformed-        0x10 -> return RejectInvalid-        0x11 -> return RejectObsolete-        0x12 -> return RejectDuplicate-        0x40 -> return RejectNonStandard-        0x41 -> return RejectDust-        0x42 -> return RejectInsufficientFee-        0x43 -> return RejectCheckpoint-        _    -> fail $ unwords-            [ "Reject get: Invalid code"-            , show code-            ]--    put code = putWord8 $ case code of-        RejectMalformed       -> 0x01-        RejectInvalid         -> 0x10-        RejectObsolete        -> 0x11-        RejectDuplicate       -> 0x12-        RejectNonStandard     -> 0x40-        RejectDust            -> 0x41-        RejectInsufficientFee -> 0x42-        RejectCheckpoint      -> 0x43---- | Convenience function to build a 'Reject' message.-reject :: MessageCommand -> RejectCode -> ByteString -> Reject-reject cmd code reason =-    Reject cmd code (VarString reason) B.empty--instance Serialize Reject where-    get =-        S.get >>= \(VarString bs) ->-            Reject (stringToCommand bs) <$> S.get <*> S.get <*> maybeData-      where-        maybeData =-            isEmpty >>= \done ->-                if done-                    then return B.empty-                    else getByteString 32-    put (Reject cmd code reason dat) = do-        put $ VarString $ commandToString cmd-        put code-        put reason-        unless (B.null dat) $ putByteString dat---- | Data type representing a variable-length integer. The 'VarInt' type--- usually precedes an array or a string that can vary in length.-newtype VarInt = VarInt { getVarInt :: Word64 }-    deriving (Eq, Show, Read, Generic, NFData)--instance Serialize VarInt where--    get = VarInt <$> ( getWord8 >>= go )-      where-        go 0xff = getWord64le-        go 0xfe = fromIntegral <$> getWord32le-        go 0xfd = fromIntegral <$> getWord16le-        go x    = fromIntegral <$> return x--    put (VarInt x)-        | x < 0xfd =-            putWord8 $ fromIntegral x-        | x <= 0xffff = do-            putWord8 0xfd-            putWord16le $ fromIntegral x-        | x <= 0xffffffff = do-            putWord8 0xfe-            putWord32le $ fromIntegral x-        | otherwise = do-            putWord8 0xff-            putWord64le x--putVarInt :: Integral a => a -> Put-putVarInt = put . VarInt . fromIntegral---- | Data type for serialization of variable-length strings.-newtype VarString = VarString { getVarString :: ByteString }-    deriving (Eq, Show, Read, Generic, NFData)--instance Serialize VarString where--    get = VarString <$> (readBS =<< S.get)-      where-        readBS (VarInt len) = getByteString (fromIntegral len)--    put (VarString bs) = do-        putVarInt $ B.length bs-        putByteString bs---- | When a bitcoin node creates an outgoing connection to another node,--- the first message it will send is a 'Version' message. The other node--- will similarly respond with it's own 'Version' message.-data Version =-    Version {-              -- | protocol version-              version     :: !Word32-              -- | features supported by this connection-            , services    :: !Word64-              -- | unix timestamp-            , timestamp   :: !Word64-              -- | network address of remote node-            , addrRecv    :: !NetworkAddress-              -- | network address of sending node-            , addrSend    :: !NetworkAddress-              -- | random nonce to detect connection to self-            , verNonce    :: !Word64-              -- | user agent string-            , userAgent   :: !VarString-              -- | height of the last block in sending node-            , startHeight :: !Word32-              -- | relay transactions flag (BIP-37)-            , relay       :: !Bool-            } deriving (Eq, Show, Generic, NFData)--instance Serialize Version where--    get = Version <$> getWord32le-                  <*> getWord64le-                  <*> getWord64le-                  <*> S.get-                  <*> S.get-                  <*> getWord64le-                  <*> S.get-                  <*> getWord32le-                  <*> (go =<< isEmpty)-      where-        go True  = return True-        go False = getBool--    put (Version v s t ar as n ua sh r) = do-        putWord32le v-        putWord64le s-        putWord64le t-        put         ar-        put         as-        putWord64le n-        put         ua-        putWord32le sh-        putBool     r---- | 0x00 is 'False', anything else is 'True'.-getBool :: Get Bool-getBool = go =<< getWord8-  where-    go 0 = return False-    go _ = return True--putBool :: Bool -> Put-putBool True  = putWord8 1-putBool False = putWord8 0---- | A 'MessageCommand' is included in a 'MessageHeader' in order to identify--- the type of message present in the payload. This allows the message--- de-serialization code to know how to decode a particular message payload.--- Every valid 'Message' constructor has a corresponding 'MessageCommand'--- constructor.-data MessageCommand-    = MCVersion-    | MCVerAck-    | MCAddr-    | MCInv-    | MCGetData-    | MCNotFound-    | MCGetBlocks-    | MCGetHeaders-    | MCTx-    | MCBlock-    | MCMerkleBlock-    | MCHeaders-    | MCGetAddr-    | MCFilterLoad-    | MCFilterAdd-    | MCFilterClear-    | MCPing-    | MCPong-    | MCAlert-    | MCMempool-    | MCReject-    | MCSendHeaders-    | MCOther ByteString-    deriving (Eq, Generic, NFData)--instance Show MessageCommand where-    showsPrec _ = shows . commandToString--instance Read MessageCommand where-    readPrec = do-        String str <- lexP-        return (stringToCommand (cs str))--instance Serialize MessageCommand where-    get = go <$> getByteString 12-      where-        go bs =-            let str = unpackCommand bs-             in stringToCommand str-    put mc = putByteString $ packCommand $ commandToString mc--instance IsString MessageCommand where-    fromString str = stringToCommand (cs str)---- | Read a 'MessageCommand' from its string representation.-stringToCommand :: ByteString -> MessageCommand-stringToCommand str = case str of-    "version"     -> MCVersion-    "verack"      -> MCVerAck-    "addr"        -> MCAddr-    "inv"         -> MCInv-    "getdata"     -> MCGetData-    "notfound"    -> MCNotFound-    "getblocks"   -> MCGetBlocks-    "getheaders"  -> MCGetHeaders-    "tx"          -> MCTx-    "block"       -> MCBlock-    "merkleblock" -> MCMerkleBlock-    "headers"     -> MCHeaders-    "getaddr"     -> MCGetAddr-    "filterload"  -> MCFilterLoad-    "filteradd"   -> MCFilterAdd-    "filterclear" -> MCFilterClear-    "ping"        -> MCPing-    "pong"        -> MCPong-    "alert"       -> MCAlert-    "mempool"     -> MCMempool-    "reject"      -> MCReject-    "sendheaders" -> MCSendHeaders-    _             -> MCOther str---- | Convert a 'MessageCommand' to its string representation.-commandToString :: MessageCommand -> ByteString-commandToString mc = case mc of-    MCVersion     -> "version"-    MCVerAck      -> "verack"-    MCAddr        -> "addr"-    MCInv         -> "inv"-    MCGetData     -> "getdata"-    MCNotFound    -> "notfound"-    MCGetBlocks   -> "getblocks"-    MCGetHeaders  -> "getheaders"-    MCTx          -> "tx"-    MCBlock       -> "block"-    MCMerkleBlock -> "merkleblock"-    MCHeaders     -> "headers"-    MCGetAddr     -> "getaddr"-    MCFilterLoad  -> "filterload"-    MCFilterAdd   -> "filteradd"-    MCFilterClear -> "filterclear"-    MCPing        -> "ping"-    MCPong        -> "pong"-    MCAlert       -> "alert"-    MCMempool     -> "mempool"-    MCReject      -> "reject"-    MCSendHeaders -> "sendheaders"-    MCOther c     -> c---- | Pack a string 'MessageCommand' so that it is exactly 12-bytes long.-packCommand :: ByteString -> ByteString-packCommand s = B.take 12 $-    s `mappend` C.replicate 12 '\NUL'---- | Undo packing done by 'packCommand'.-unpackCommand :: ByteString -> ByteString-unpackCommand = B.takeWhile (/= 0)---- | Node offers no services.-nodeNone :: Word64-nodeNone = 0---- | Services indicate node is a full node that can serve full blocks.-nodeNetwork :: Word64-nodeNetwork = 1---- | Services indicate node allows to request 'UTXO' set.-nodeGetUTXO :: Word64-nodeGetUTXO = 1 `shiftL` 1---- | Services indicate node accepts bloom filters.-nodeBloom :: Word64-nodeBloom = 1 `shiftL` 2---- | Services indicate SegWit-capable node.-nodeWitness :: Word64-nodeWitness = 1 `shiftL` 3---- | Services indicate Xtreme Thinblocks compatibility.-nodeXThin :: Word64-nodeXThin = 1 `shiftL` 4
− src/Network/Haskoin/Network/Message.hs 
@@ -1,203 +0,0 @@-{-# LANGUAGE DeriveAnyClass #-}-{-# LANGUAGE DeriveGeneric  #-}-{-|-Module      : Network.Haskoin.Network.Message-Copyright   : No rights reserved-License     : UNLICENSE-Maintainer  : jprupp@protonmail.ch-Stability   : experimental-Portability : POSIX--Peer-to-peer network message serialization.--}-module Network.Haskoin.Network.Message-    ( -- * Network Message-      Message(..)-    , MessageHeader(..)-    , msgType-    , putMessage-    , getMessage-    ) where--import           Control.Monad                      (unless)-import           Control.DeepSeq-import           Data.ByteString                    (ByteString)-import qualified Data.ByteString                    as BS-import           Data.Serialize                     (Serialize, encode, get,-                                                     put)-import           Data.Serialize.Get                 (Get, getByteString,-                                                     getWord32be, getWord32le,-                                                     isolate, lookAhead)-import           Data.Serialize.Put                 (Putter, putByteString,-                                                     putWord32be, putWord32le)-import           Data.Word                          (Word32)-import           GHC.Generics                       (Generic)-import           Network.Haskoin.Block.Common-import           Network.Haskoin.Block.Merkle-import           Network.Haskoin.Constants-import           Network.Haskoin.Crypto.Hash-import           Network.Haskoin.Network.Bloom-import           Network.Haskoin.Network.Common-import           Network.Haskoin.Transaction.Common---- | Data type representing the header of a 'Message'. All messages sent between--- nodes contain a message header.-data MessageHeader = MessageHeader-    { -- | magic bytes identify network-      headMagic       :: !Word32-      -- | message type-    , headCmd         :: !MessageCommand-      -- | length of payload-    , headPayloadSize :: !Word32-      -- | checksum of payload-    , headChecksum    :: !CheckSum32-    } deriving (Eq, Show, Generic, NFData)--instance Serialize MessageHeader where--    get = MessageHeader <$> getWord32be-                        <*> get-                        <*> getWord32le-                        <*> get--    put (MessageHeader m c l chk) = do-        putWord32be m-        put         c-        putWord32le l-        put         chk---- | The 'Message' type is used to identify all the valid messages that can be--- sent between bitcoin peers. Only values of type 'Message' will be accepted--- by other bitcoin peers as bitcoin protocol messages need to be correctly--- serialized with message headers. Serializing a 'Message' value will--- include the 'MessageHeader' with the correct checksum value automatically.--- No need to add the 'MessageHeader' separately.-data Message-    = MVersion !Version-    | MVerAck-    | MAddr !Addr-    | MInv !Inv-    | MGetData !GetData-    | MNotFound !NotFound-    | MGetBlocks !GetBlocks-    | MGetHeaders !GetHeaders-    | MTx !Tx-    | MBlock !Block-    | MMerkleBlock !MerkleBlock-    | MHeaders !Headers-    | MGetAddr-    | MFilterLoad !FilterLoad-    | MFilterAdd !FilterAdd-    | MFilterClear-    | MPing !Ping-    | MPong !Pong-    | MAlert !Alert-    | MMempool-    | MReject !Reject-    | MSendHeaders-    | MOther !ByteString !ByteString-    deriving (Eq, Show, Generic, NFData)---- | Get 'MessageCommand' assocated with a message.-msgType :: Message -> MessageCommand-msgType (MVersion _)     = MCVersion-msgType MVerAck          = MCVerAck-msgType (MAddr _)        = MCAddr-msgType (MInv _)         = MCInv-msgType (MGetData _)     = MCGetData-msgType (MNotFound _)    = MCNotFound-msgType (MGetBlocks _)   = MCGetBlocks-msgType (MGetHeaders _)  = MCGetHeaders-msgType (MTx _)          = MCTx-msgType (MBlock _)       = MCBlock-msgType (MMerkleBlock _) = MCMerkleBlock-msgType (MHeaders _)     = MCHeaders--msgType (MFilterLoad _)  = MCFilterLoad-msgType (MFilterAdd _)   = MCFilterAdd-msgType MFilterClear     = MCFilterClear-msgType (MPing _)        = MCPing-msgType (MPong _)        = MCPong-msgType (MAlert _)       = MCAlert-msgType MMempool         = MCMempool-msgType (MReject _)      = MCReject-msgType MSendHeaders     = MCSendHeaders-msgType MGetAddr         = MCGetAddr-msgType (MOther c _)     = MCOther c---- | Deserializer for network messages.-getMessage :: Network -> Get Message-getMessage net = do-    (MessageHeader mgc cmd len chk) <- get-    bs <- lookAhead $ getByteString $ fromIntegral len-    unless-        (mgc == getNetworkMagic net)-        (fail $ "get: Invalid network magic bytes: " ++ show mgc)-    unless-        (checkSum32 bs == chk)-        (fail $ "get: Invalid message checksum: " ++ show chk)-    if len > 0-        then isolate (fromIntegral len) $-             case cmd of-                 MCVersion     -> MVersion <$> get-                 MCAddr        -> MAddr <$> get-                 MCInv         -> MInv <$> get-                 MCGetData     -> MGetData <$> get-                 MCNotFound    -> MNotFound <$> get-                 MCGetBlocks   -> MGetBlocks <$> get-                 MCGetHeaders  -> MGetHeaders <$> get-                 MCTx          -> MTx <$> get-                 MCBlock       -> MBlock <$> get-                 MCMerkleBlock -> MMerkleBlock <$> get-                 MCHeaders     -> MHeaders <$> get-                 MCFilterLoad  -> MFilterLoad <$> get-                 MCFilterAdd   -> MFilterAdd <$> get-                 MCPing        -> MPing <$> get-                 MCPong        -> MPong <$> get-                 MCAlert       -> MAlert <$> get-                 MCReject      -> MReject <$> get-                 MCOther c     -> MOther c <$> getByteString (fromIntegral len)-                 _             -> fail $ "get: command " ++ show cmd ++-                                         " should not carry a payload"-        else case cmd of-                 MCGetAddr     -> return MGetAddr-                 MCVerAck      -> return MVerAck-                 MCFilterClear -> return MFilterClear-                 MCMempool     -> return MMempool-                 MCSendHeaders -> return MSendHeaders-                 _             -> fail $ "get: command " ++ show cmd ++-                                         " is expected to carry a payload"---- | Serializer for network messages.-putMessage :: Network -> Putter Message-putMessage net msg = do-    let (cmd, payload) =-            case msg of-                MVersion m     -> (MCVersion, encode m)-                MVerAck        -> (MCVerAck, BS.empty)-                MAddr m        -> (MCAddr, encode m)-                MInv m         -> (MCInv, encode m)-                MGetData m     -> (MCGetData, encode m)-                MNotFound m    -> (MCNotFound, encode m)-                MGetBlocks m   -> (MCGetBlocks, encode m)-                MGetHeaders m  -> (MCGetHeaders, encode m)-                MTx m          -> (MCTx, encode m)-                MBlock m       -> (MCBlock, encode m)-                MMerkleBlock m -> (MCMerkleBlock, encode m)-                MHeaders m     -> (MCHeaders, encode m)-                MGetAddr       -> (MCGetAddr, BS.empty)-                MFilterLoad m  -> (MCFilterLoad, encode m)-                MFilterAdd m   -> (MCFilterAdd, encode m)-                MFilterClear   -> (MCFilterClear, BS.empty)-                MPing m        -> (MCPing, encode m)-                MPong m        -> (MCPong, encode m)-                MAlert m       -> (MCAlert, encode m)-                MMempool       -> (MCMempool, BS.empty)-                MReject m      -> (MCReject, encode m)-                MSendHeaders   -> (MCSendHeaders, BS.empty)-                MOther c p     -> (MCOther c, p)-        chk = checkSum32 payload-        len = fromIntegral $ BS.length payload-        header = MessageHeader (getNetworkMagic net) cmd len chk-    put header-    putByteString payload
− src/Network/Haskoin/Script.hs 
@@ -1,19 +0,0 @@-{-|-Module      : Network.Haskoin.Script-Copyright   : No rights reserved-License     : UNLICENSE-Maintainer  : jprupp@protonmail.ch-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-    ) where--import           Network.Haskoin.Script.Common   as X-import           Network.Haskoin.Script.SigHash  as X-import           Network.Haskoin.Script.Standard as X
− src/Network/Haskoin/Script/Common.hs 
@@ -1,731 +0,0 @@-{-# LANGUAGE DeriveAnyClass    #-}-{-# LANGUAGE DeriveGeneric     #-}-{-# LANGUAGE OverloadedStrings #-}-{-|-Module      : Network.Haskoin.Script.Common-Copyright   : No rights reserved-License     : UNLICENSE-Maintainer  : jprupp@protonmail.ch-Stability   : experimental-Portability : POSIX--Common script-related functions and data types.--}-module Network.Haskoin.Script.Common-    ( ScriptOp(..)-    , Script(..)-    , PushDataType(..)-    , ScriptOutput(..)-    , isPayPK-    , isPayPKHash-    , isPayMulSig-    , isPayScriptHash-    , isPayWitnessPKHash-    , isPayWitnessScriptHash-    , isDataCarrier-    , encodeOutput-    , encodeOutputBS-    , decodeOutput-    , decodeOutputBS-    , toP2SH-    , toP2WSH-    , isPushOp-    , opPushData-    , intToScriptOp-    , scriptOpToInt-    ) where--import           Control.DeepSeq-import           Control.Monad-import           Data.Aeson                  as A-import           Data.Aeson.Encoding         (text)-import           Data.ByteString             (ByteString)-import qualified Data.ByteString             as B-import           Data.Hashable-import           Data.Serialize              as S-import           Data.Word                   (Word8)-import           GHC.Generics                (Generic)-import           Network.Haskoin.Crypto.Hash-import           Network.Haskoin.Keys.Common-import           Network.Haskoin.Util---- | Data type representing a transaction script. Scripts are defined as lists--- of script operators 'ScriptOp'. Scripts are used to:------ * Define the spending conditions in the output of a transaction.--- * Provide signatures in the input of a transaction (except SegWit).------ SigWit only: the segregated witness data structure, and not the input script,--- contains signatures and redeem script for pay-to-witness-script and--- pay-to-witness-public-key-hash transactions.-newtype Script =-    Script {-             -- | script operators defining this script-             scriptOps :: [ScriptOp]-           }-    deriving (Eq, Show, Read, Generic, Hashable, NFData)--instance Serialize Script where-    get =-        Script <$> getScriptOps-      where-        getScriptOps = do-            empty <- isEmpty-            if empty-                then return []-                else (:) <$> get <*> getScriptOps--    put (Script ops) = forM_ ops put---- | Data type representing the type of an OP_PUSHDATA opcode.-data PushDataType-    =-      -- | next opcode bytes is data to be pushed-      OPCODE-      -- | next byte contains number of bytes of data to be pushed-    | OPDATA1-      -- | next two bytes contains number of bytes to be pushed-    | OPDATA2-      -- | next four bytes contains the number of bytes to be pushed-    | OPDATA4-    deriving (Show, Read, Eq, Generic, Hashable, NFData)---- | Data type representing an operator allowed inside a 'Script'.-data ScriptOp-      -- Pushing Data-    = OP_PUSHDATA !ByteString-                  !PushDataType-    | OP_0-    | OP_1NEGATE-    | OP_RESERVED-    | OP_1-    | OP_2-    | OP_3-    | OP_4-    | OP_5-    | OP_6-    | OP_7-    | OP_8-    | OP_9-    | OP_10-    | OP_11-    | OP_12-    | OP_13-    | OP_14-    | OP_15-    | OP_16-      -- Flow control-    | OP_NOP-    | OP_VER -- reserved-    | OP_IF-    | OP_NOTIF-    | OP_VERIF -- resreved-    | OP_VERNOTIF -- reserved-    | OP_ELSE-    | OP_ENDIF-    | OP_VERIFY-    | OP_RETURN-      -- Stack operations-    | OP_TOALTSTACK-    | OP_FROMALTSTACK-    | OP_IFDUP-    | OP_DEPTH-    | OP_DROP-    | OP_DUP-    | OP_NIP-    | OP_OVER-    | OP_PICK-    | OP_ROLL-    | OP_ROT-    | OP_SWAP-    | OP_TUCK-    | OP_2DROP-    | OP_2DUP-    | OP_3DUP-    | OP_2OVER-    | OP_2ROT-    | OP_2SWAP-      -- Splice-    | OP_CAT-    | OP_SUBSTR-    | OP_LEFT-    | OP_RIGHT-    | OP_SIZE-      -- Bitwise logic-    | OP_INVERT-    | OP_AND-    | OP_OR-    | OP_XOR-    | OP_EQUAL-    | OP_EQUALVERIFY-    | OP_RESERVED1-    | OP_RESERVED2-      -- Arithmetic-    | OP_1ADD-    | OP_1SUB-    | OP_2MUL-    | OP_2DIV-    | OP_NEGATE-    | OP_ABS-    | OP_NOT-    | OP_0NOTEQUAL-    | OP_ADD-    | OP_SUB-    | OP_MUL-    | OP_DIV-    | OP_MOD-    | OP_LSHIFT-    | OP_RSHIFT-    | OP_BOOLAND-    | OP_BOOLOR-    | OP_NUMEQUAL-    | OP_NUMEQUALVERIFY-    | OP_NUMNOTEQUAL-    | OP_LESSTHAN-    | OP_GREATERTHAN-    | OP_LESSTHANOREQUAL-    | OP_GREATERTHANOREQUAL-    | OP_MIN-    | OP_MAX-    | OP_WITHIN-      -- Crypto-    | OP_RIPEMD160-    | OP_SHA1-    | OP_SHA256-    | OP_HASH160-    | OP_HASH256-    | OP_CODESEPARATOR-    | OP_CHECKSIG-    | OP_CHECKSIGVERIFY-    | OP_CHECKMULTISIG-    | OP_CHECKMULTISIGVERIFY-      -- Expansion-    | OP_NOP1-    | OP_NOP2-    | OP_NOP3-    | OP_NOP4-    | OP_NOP5-    | OP_NOP6-    | OP_NOP7-    | OP_NOP8-    | OP_NOP9-    | OP_NOP10-      -- Bitcoin Cash Nov 2018 hard fork-    | OP_CHECKDATASIG-    | OP_CHECKDATASIGVERIFY-      -- Other-    | OP_PUBKEYHASH-    | OP_PUBKEY-    | OP_INVALIDOPCODE !Word8-    deriving (Show, Read, Eq, Generic, Hashable, NFData)--instance Serialize ScriptOp where-    get = go =<< (fromIntegral <$> getWord8)-      where-        go op-            | op == 0x00 = return OP_0-            | op <= 0x4b = do-                payload <- getByteString (fromIntegral op)-                return $ OP_PUSHDATA payload OPCODE-            | op == 0x4c = do-                len  <- getWord8-                payload <- getByteString (fromIntegral len)-                return $ OP_PUSHDATA payload OPDATA1-            | op == 0x4d = do-                len  <- getWord16le-                payload <- getByteString (fromIntegral len)-                return $ OP_PUSHDATA payload OPDATA2-            | op == 0x4e = do-                len  <- getWord32le-                payload <- getByteString (fromIntegral len)-                return $ OP_PUSHDATA payload OPDATA4--            | op == 0x4f = return OP_1NEGATE-            | op == 0x50 = return OP_RESERVED-            | op == 0x51 = return OP_1-            | op == 0x52 = return OP_2-            | op == 0x53 = return OP_3-            | op == 0x54 = return OP_4-            | op == 0x55 = return OP_5-            | op == 0x56 = return OP_6-            | op == 0x57 = return OP_7-            | op == 0x58 = return OP_8-            | op == 0x59 = return OP_9-            | op == 0x5a = return OP_10-            | op == 0x5b = return OP_11-            | op == 0x5c = return OP_12-            | op == 0x5d = return OP_13-            | op == 0x5e = return OP_14-            | op == 0x5f = return OP_15-            | op == 0x60 = return OP_16--            -- Flow control-            | op == 0x61 = return OP_NOP-            | op == 0x62 = return OP_VER        -- reserved-            | op == 0x63 = return OP_IF-            | op == 0x64 = return OP_NOTIF-            | op == 0x65 = return OP_VERIF      -- reserved-            | op == 0x66 = return OP_VERNOTIF   -- reserved-            | op == 0x67 = return OP_ELSE-            | op == 0x68 = return OP_ENDIF-            | op == 0x69 = return OP_VERIFY-            | op == 0x6a = return OP_RETURN--            -- Stack-            | op == 0x6b = return OP_TOALTSTACK-            | op == 0x6c = return OP_FROMALTSTACK-            | op == 0x6d = return OP_2DROP-            | op == 0x6e = return OP_2DUP-            | op == 0x6f = return OP_3DUP-            | op == 0x70 = return OP_2OVER-            | op == 0x71 = return OP_2ROT-            | op == 0x72 = return OP_2SWAP-            | op == 0x73 = return OP_IFDUP-            | op == 0x74 = return OP_DEPTH-            | op == 0x75 = return OP_DROP-            | op == 0x76 = return OP_DUP-            | op == 0x77 = return OP_NIP-            | op == 0x78 = return OP_OVER-            | op == 0x79 = return OP_PICK-            | op == 0x7a = return OP_ROLL-            | op == 0x7b = return OP_ROT-            | op == 0x7c = return OP_SWAP-            | op == 0x7d = return OP_TUCK--            -- Splice-            | op == 0x7e = return OP_CAT-            | op == 0x7f = return OP_SUBSTR-            | op == 0x80 = return OP_LEFT-            | op == 0x81 = return OP_RIGHT-            | op == 0x82 = return OP_SIZE--            -- Bitwise logic-            | op == 0x83 = return OP_INVERT-            | op == 0x84 = return OP_AND-            | op == 0x85 = return OP_OR-            | op == 0x86 = return OP_XOR-            | op == 0x87 = return OP_EQUAL-            | op == 0x88 = return OP_EQUALVERIFY-            | op == 0x89 = return OP_RESERVED1-            | op == 0x8a = return OP_RESERVED2--            -- Arithmetic-            | op == 0x8b = return OP_1ADD-            | op == 0x8c = return OP_1SUB-            | op == 0x8d = return OP_2MUL-            | op == 0x8e = return OP_2DIV-            | op == 0x8f = return OP_NEGATE-            | op == 0x90 = return OP_ABS-            | op == 0x91 = return OP_NOT-            | op == 0x92 = return OP_0NOTEQUAL-            | op == 0x93 = return OP_ADD-            | op == 0x94 = return OP_SUB-            | op == 0x95 = return OP_MUL-            | op == 0x96 = return OP_DIV-            | op == 0x97 = return OP_MOD-            | op == 0x98 = return OP_LSHIFT-            | op == 0x99 = return OP_RSHIFT-            | op == 0x9a = return OP_BOOLAND-            | op == 0x9b = return OP_BOOLOR-            | op == 0x9c = return OP_NUMEQUAL-            | op == 0x9d = return OP_NUMEQUALVERIFY-            | op == 0x9e = return OP_NUMNOTEQUAL-            | op == 0x9f = return OP_LESSTHAN-            | op == 0xa0 = return OP_GREATERTHAN-            | op == 0xa1 = return OP_LESSTHANOREQUAL-            | op == 0xa2 = return OP_GREATERTHANOREQUAL-            | op == 0xa3 = return OP_MIN-            | op == 0xa4 = return OP_MAX-            | op == 0xa5 = return OP_WITHIN--            -- Crypto-            | op == 0xa6 = return OP_RIPEMD160-            | op == 0xa7 = return OP_SHA1-            | op == 0xa8 = return OP_SHA256-            | op == 0xa9 = return OP_HASH160-            | op == 0xaa = return OP_HASH256-            | op == 0xab = return OP_CODESEPARATOR-            | op == 0xac = return OP_CHECKSIG-            | op == 0xad = return OP_CHECKSIGVERIFY-            | op == 0xae = return OP_CHECKMULTISIG-            | op == 0xaf = return OP_CHECKMULTISIGVERIFY--            -- More NOPs-            | op == 0xb0 = return OP_NOP1-            | op == 0xb1 = return OP_NOP2-            | op == 0xb2 = return OP_NOP3-            | op == 0xb3 = return OP_NOP4-            | op == 0xb4 = return OP_NOP5-            | op == 0xb5 = return OP_NOP6-            | op == 0xb6 = return OP_NOP7-            | op == 0xb7 = return OP_NOP8-            | op == 0xb8 = return OP_NOP9-            | op == 0xb9 = return OP_NOP10--            -- Bitcoin Cash Nov 2018 hard fork-            | op == 0xba = return OP_CHECKDATASIG-            | op == 0xbb = return OP_CHECKDATASIGVERIFY--            -- Constants-            | op == 0xfd = return OP_PUBKEYHASH-            | op == 0xfe = return OP_PUBKEY--            | otherwise = return $ OP_INVALIDOPCODE op--    put op = case op of--        (OP_PUSHDATA payload optype)-> do-            let len = B.length payload-            case optype of-                OPCODE -> do-                    unless (len <= 0x4b) $-                        error "OP_PUSHDATA OPCODE: Payload size too big"-                    putWord8 $ fromIntegral len-                OPDATA1 -> do-                    unless (len <= 0xff) $-                        error "OP_PUSHDATA OPDATA1: Payload size too big"-                    putWord8 0x4c-                    putWord8 $ fromIntegral len-                OPDATA2 -> do-                    unless (len <= 0xffff) $-                        error "OP_PUSHDATA OPDATA2: Payload size too big"-                    putWord8 0x4d-                    putWord16le $ fromIntegral len-                OPDATA4 -> do-                    unless (len <= 0x7fffffff) $-                        error "OP_PUSHDATA OPDATA4: Payload size too big"-                    putWord8 0x4e-                    putWord32le $ fromIntegral len-            putByteString payload--        -- Constants-        OP_0                 -> putWord8 0x00-        OP_1NEGATE           -> putWord8 0x4f-        OP_RESERVED          -> putWord8 0x50-        OP_1                 -> putWord8 0x51-        OP_2                 -> putWord8 0x52-        OP_3                 -> putWord8 0x53-        OP_4                 -> putWord8 0x54-        OP_5                 -> putWord8 0x55-        OP_6                 -> putWord8 0x56-        OP_7                 -> putWord8 0x57-        OP_8                 -> putWord8 0x58-        OP_9                 -> putWord8 0x59-        OP_10                -> putWord8 0x5a-        OP_11                -> putWord8 0x5b-        OP_12                -> putWord8 0x5c-        OP_13                -> putWord8 0x5d-        OP_14                -> putWord8 0x5e-        OP_15                -> putWord8 0x5f-        OP_16                -> putWord8 0x60--        -- Crypto Constants-        OP_PUBKEY            -> putWord8 0xfe-        OP_PUBKEYHASH        -> putWord8 0xfd--        -- Invalid Opcodes-        (OP_INVALIDOPCODE x) -> putWord8 x--        -- Flow Control-        OP_NOP               -> putWord8 0x61-        OP_VER               -> putWord8 0x62-        OP_IF                -> putWord8 0x63-        OP_NOTIF             -> putWord8 0x64-        OP_VERIF             -> putWord8 0x65-        OP_VERNOTIF          -> putWord8 0x66-        OP_ELSE              -> putWord8 0x67-        OP_ENDIF             -> putWord8 0x68-        OP_VERIFY            -> putWord8 0x69-        OP_RETURN            -> putWord8 0x6a--        -- Stack Operations-        OP_TOALTSTACK        -> putWord8 0x6b-        OP_FROMALTSTACK      -> putWord8 0x6c-        OP_2DROP             -> putWord8 0x6d-        OP_2DUP              -> putWord8 0x6e-        OP_3DUP              -> putWord8 0x6f-        OP_2OVER             -> putWord8 0x70-        OP_2ROT              -> putWord8 0x71-        OP_2SWAP             -> putWord8 0x72-        OP_IFDUP             -> putWord8 0x73-        OP_DEPTH             -> putWord8 0x74-        OP_DROP              -> putWord8 0x75-        OP_DUP               -> putWord8 0x76-        OP_NIP               -> putWord8 0x77-        OP_OVER              -> putWord8 0x78-        OP_PICK              -> putWord8 0x79-        OP_ROLL              -> putWord8 0x7a-        OP_ROT               -> putWord8 0x7b-        OP_SWAP              -> putWord8 0x7c-        OP_TUCK              -> putWord8 0x7d--        -- Splice-        OP_CAT               -> putWord8 0x7e-        OP_SUBSTR            -> putWord8 0x7f-        OP_LEFT              -> putWord8 0x80-        OP_RIGHT             -> putWord8 0x81-        OP_SIZE              -> putWord8 0x82--        -- Bitwise Logic-        OP_INVERT            -> putWord8 0x83-        OP_AND               -> putWord8 0x84-        OP_OR                -> putWord8 0x85-        OP_XOR               -> putWord8 0x86-        OP_EQUAL             -> putWord8 0x87-        OP_EQUALVERIFY       -> putWord8 0x88-        OP_RESERVED1         -> putWord8 0x89-        OP_RESERVED2         -> putWord8 0x8a--        -- Arithmetic-        OP_1ADD              -> putWord8 0x8b-        OP_1SUB              -> putWord8 0x8c-        OP_2MUL              -> putWord8 0x8d-        OP_2DIV              -> putWord8 0x8e-        OP_NEGATE            -> putWord8 0x8f-        OP_ABS               -> putWord8 0x90-        OP_NOT               -> putWord8 0x91-        OP_0NOTEQUAL         -> putWord8 0x92-        OP_ADD               -> putWord8 0x93-        OP_SUB               -> putWord8 0x94-        OP_MUL               -> putWord8 0x95-        OP_DIV               -> putWord8 0x96-        OP_MOD               -> putWord8 0x97-        OP_LSHIFT            -> putWord8 0x98-        OP_RSHIFT            -> putWord8 0x99-        OP_BOOLAND           -> putWord8 0x9a-        OP_BOOLOR            -> putWord8 0x9b-        OP_NUMEQUAL          -> putWord8 0x9c-        OP_NUMEQUALVERIFY    -> putWord8 0x9d-        OP_NUMNOTEQUAL       -> putWord8 0x9e-        OP_LESSTHAN          -> putWord8 0x9f-        OP_GREATERTHAN       -> putWord8 0xa0-        OP_LESSTHANOREQUAL   -> putWord8 0xa1-        OP_GREATERTHANOREQUAL-> putWord8 0xa2-        OP_MIN               -> putWord8 0xa3-        OP_MAX               -> putWord8 0xa4-        OP_WITHIN            -> putWord8 0xa5--        -- Crypto-        OP_RIPEMD160         -> putWord8 0xa6-        OP_SHA1              -> putWord8 0xa7-        OP_SHA256            -> putWord8 0xa8-        OP_HASH160           -> putWord8 0xa9-        OP_HASH256           -> putWord8 0xaa-        OP_CODESEPARATOR     -> putWord8 0xab-        OP_CHECKSIG          -> putWord8 0xac-        OP_CHECKSIGVERIFY    -> putWord8 0xad-        OP_CHECKMULTISIG     -> putWord8 0xae-        OP_CHECKMULTISIGVERIFY -> putWord8 0xaf--        -- More NOPs-        OP_NOP1              -> putWord8 0xb0-        OP_NOP2              -> putWord8 0xb1-        OP_NOP3              -> putWord8 0xb2-        OP_NOP4              -> putWord8 0xb3-        OP_NOP5              -> putWord8 0xb4-        OP_NOP6              -> putWord8 0xb5-        OP_NOP7              -> putWord8 0xb6-        OP_NOP8              -> putWord8 0xb7-        OP_NOP9              -> putWord8 0xb8-        OP_NOP10             -> putWord8 0xb9--        -- Bitcoin Cash Nov 2018 hard fork-        OP_CHECKDATASIG      -> putWord8 0xba-        OP_CHECKDATASIGVERIFY -> putWord8 0xbb----- | Check whether opcode is only data.-isPushOp :: ScriptOp -> Bool-isPushOp op = case op of-    OP_PUSHDATA _ _ -> True-    OP_0            -> True-    OP_1NEGATE      -> True-    OP_1            -> True-    OP_2            -> True-    OP_3            -> True-    OP_4            -> True-    OP_5            -> True-    OP_6            -> True-    OP_7            -> True-    OP_8            -> True-    OP_9            -> True-    OP_10           -> True-    OP_11           -> True-    OP_12           -> True-    OP_13           -> True-    OP_14           -> True-    OP_15           -> True-    OP_16           -> True-    _               -> False---- | Optimally encode data using one of the 4 types of data pushing opcodes.-opPushData :: ByteString -> ScriptOp-opPushData bs-    | len <= 0x4b       = OP_PUSHDATA bs OPCODE-    | len <= 0xff       = OP_PUSHDATA bs OPDATA1-    | len <= 0xffff     = OP_PUSHDATA bs OPDATA2-    | len <= 0xffffffff = OP_PUSHDATA bs OPDATA4-    | otherwise         = error "opPushData: payload size too big"-  where-    len = B.length bs---- | Transforms integers @[1 .. 16]@ to 'ScriptOp' @[OP_1 .. OP_16]@.-intToScriptOp :: Int -> ScriptOp-intToScriptOp i-    | i `elem` [1 .. 16] = op-    | otherwise = err-  where-    op = either (const err) id . S.decode . B.singleton . fromIntegral $ i + 0x50-    err = error $ "intToScriptOp: Invalid integer " ++ show i---- | Decode 'ScriptOp' @[OP_1 .. OP_16]@ to integers @[1 .. 16]@. This functions--- fails for other values of 'ScriptOp'-scriptOpToInt :: ScriptOp -> Either String Int-scriptOpToInt s-    | res `elem` [1..16] = return res-    | otherwise          = Left $ "scriptOpToInt: invalid opcode " ++ show s-  where-    res = fromIntegral (B.head $ S.encode s) - 0x50---- | Data type describing standard transaction output scripts. Output scripts--- provide the conditions that must be fulfilled for someone to spend the funds--- in a transaction output.-data ScriptOutput-      -- | pay to public key-    = PayPK { getOutputPubKey :: !PubKeyI }-      -- | pay to public key hash-    | PayPKHash { getOutputHash :: !Hash160 }-      -- | multisig-    | PayMulSig { getOutputMulSigKeys     :: ![PubKeyI]-                , getOutputMulSigRequired :: !Int }-      -- | pay to a script hash-    | PayScriptHash { getOutputHash :: !Hash160 }-      -- | pay to witness public key hash-    | PayWitnessPKHash { getOutputHash :: !Hash160 }-      -- | pay to witness script hash-    | PayWitnessScriptHash { getScriptHash :: !Hash256 }-      -- | provably unspendable data carrier-    | DataCarrier { getOutputData :: !ByteString }-    deriving (Eq, Show, Read, Generic, Hashable, NFData)--instance FromJSON ScriptOutput where-    parseJSON = withText "scriptoutput" $ \t -> either fail return $-        maybeToEither "scriptoutput not hex" (decodeHex t) >>=-        decodeOutputBS--instance ToJSON ScriptOutput where-    toJSON = String . encodeHex . encodeOutputBS-    toEncoding = text . encodeHex . encodeOutputBS---- | Is script a pay-to-public-key output?-isPayPK :: ScriptOutput -> Bool-isPayPK (PayPK _) = True-isPayPK _         = False---- | Is script a pay-to-pub-key-hash output?-isPayPKHash :: ScriptOutput -> Bool-isPayPKHash (PayPKHash _) = True-isPayPKHash _             = False---- | Is script a pay-to-multi-sig output?-isPayMulSig :: ScriptOutput -> Bool-isPayMulSig (PayMulSig _ _) = True-isPayMulSig _               = False---- | Is script a pay-to-script-hash output?-isPayScriptHash :: ScriptOutput -> Bool-isPayScriptHash (PayScriptHash _) = True-isPayScriptHash _                 = False---- | 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---- | Is script a data carrier output?-isDataCarrier :: ScriptOutput -> Bool-isDataCarrier (DataCarrier _) = True-isDataCarrier _               = False---- | Tries to decode a 'ScriptOutput' from a 'Script'. This can fail if the--- script is not recognized as any of the standard output types.-decodeOutput :: Script -> Either String ScriptOutput-decodeOutput s = case scriptOps s of-    -- Pay to PubKey-    [OP_PUSHDATA bs _, OP_CHECKSIG] -> PayPK <$> S.decode bs-    -- Pay to PubKey Hash-    [OP_DUP, OP_HASH160, OP_PUSHDATA bs _, OP_EQUALVERIFY, OP_CHECKSIG] ->-        PayPKHash <$> S.decode bs-    -- Pay to Script Hash-    [OP_HASH160, OP_PUSHDATA bs _, OP_EQUAL] ->-        PayScriptHash <$> S.decode  bs-    -- Pay to Witness-    [OP_0, OP_PUSHDATA bs OPCODE]-      | B.length bs == 20 -> PayWitnessPKHash     <$> S.decode bs-      | B.length bs == 32 -> PayWitnessScriptHash <$> S.decode bs-    -- Provably unspendable data carrier output-    [OP_RETURN, OP_PUSHDATA bs _] -> Right $ DataCarrier bs-    -- Pay to MultiSig Keys-    _ -> matchPayMulSig s---- | Similar to 'decodeOutput' but decodes from a 'ByteString'.-decodeOutputBS :: ByteString -> Either String ScriptOutput-decodeOutputBS = decodeOutput <=< S.decode---- | Computes a 'Script' from a standard 'ScriptOutput'.-encodeOutput :: ScriptOutput -> Script-encodeOutput s = Script $ case s of-    -- Pay to PubKey-    (PayPK k) -> [opPushData $ S.encode k, OP_CHECKSIG]-    -- Pay to PubKey Hash Address-    (PayPKHash h) ->-        [ OP_DUP, OP_HASH160, opPushData $ S.encode h, OP_EQUALVERIFY, OP_CHECKSIG]-    -- Pay to MultiSig Keys-    (PayMulSig ps r)-      | r <= length ps ->-        let opM = intToScriptOp r-            opN = intToScriptOp $ length ps-            keys = map (opPushData . S.encode) ps-            in opM : keys ++ [opN, OP_CHECKMULTISIG]-      | otherwise -> error "encodeOutput: PayMulSig r must be <= than pkeys"-    -- Pay to Script Hash Address-    (PayScriptHash h) ->-        [ OP_HASH160, opPushData $ S.encode h, OP_EQUAL]-    -- Pay to Witness PubKey Hash Address-    (PayWitnessPKHash h) ->-        [ OP_0, opPushData $ S.encode h ]-    (PayWitnessScriptHash h) ->-        [ OP_0, opPushData $ S.encode h ]-    -- Provably unspendable output-    (DataCarrier d) -> [OP_RETURN, opPushData d]---- | Similar to 'encodeOutput' but encodes to a ByteString-encodeOutputBS :: ScriptOutput -> ByteString-encodeOutputBS = S.encode . encodeOutput---- | Encode script as pay-to-script-hash script-toP2SH :: Script -> ScriptOutput-toP2SH = PayScriptHash . addressHash . S.encode---- | Encode script as a pay-to-witness-script-hash script-toP2WSH :: Script -> ScriptOutput-toP2WSH = PayWitnessScriptHash . sha256 . S.encode---- | Match @[OP_N, PubKey1, ..., PubKeyM, OP_M, OP_CHECKMULTISIG]@-matchPayMulSig :: Script -> Either String ScriptOutput-matchPayMulSig (Script ops) = case splitAt (length ops - 2) ops of-    (m:xs,[n,OP_CHECKMULTISIG]) -> do-        (intM,intN) <- liftM2 (,) (scriptOpToInt m) (scriptOpToInt n)-        if intM <= intN && length xs == intN-            then liftM2 PayMulSig (go xs) (return intM)-            else Left "matchPayMulSig: Invalid M or N parameters"-    _ -> Left "matchPayMulSig: script did not match output template"-  where-    go (OP_PUSHDATA bs _:xs) = liftM2 (:) (S.decode bs) (go xs)-    go []                    = return []-    go  _                    = Left "matchPayMulSig: invalid multisig opcode"
− src/Network/Haskoin/Script/SigHash.hs 
@@ -1,319 +0,0 @@-{-# LANGUAGE DeriveGeneric              #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE OverloadedStrings          #-}-{-|-Module      : Network.Haskoin.Script.SigHash-Copyright   : No rights reserved-License     : UNLICENSE-Maintainer  : jprupp@protonmail.ch-Stability   : experimental-Portability : POSIX--Transaction signatures and related functions.--}-module Network.Haskoin.Script.SigHash-( SigHash-, SigHashFlag(..)-, sigHashAll-, sigHashNone-, sigHashSingle-, hasAnyoneCanPayFlag-, hasForkIdFlag-, setAnyoneCanPayFlag-, setForkIdFlag-, isSigHashAll-, isSigHashNone-, isSigHashSingle-, isSigHashUnknown-, sigHashAddForkId-, sigHashGetForkId-, sigHashAddNetworkId-, txSigHash-, txSigHashForkId-, TxSignature(..)-, encodeTxSig-, decodeTxSig-) where--import           Control.DeepSeq-import           Control.Monad-import           Crypto.Secp256k1-import qualified Data.Aeson                         as J-import           Data.Bits-import           Data.ByteString                    (ByteString)-import qualified Data.ByteString                    as BS-import           Data.Hashable-import           Data.Maybe-import           Data.Scientific-import           Data.Serialize-import           Data.Word-import           GHC.Generics                       (Generic)-import           Network.Haskoin.Constants-import           Network.Haskoin.Crypto.Hash-import           Network.Haskoin.Crypto.Signature-import           Network.Haskoin.Network-import           Network.Haskoin.Script.Common-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, Read, Generic)--instance NFData SigHashFlag--instance Hashable SigHashFlag--instance Enum SigHashFlag where-    fromEnum SIGHASH_ALL          = 0x01-    fromEnum SIGHASH_NONE         = 0x02-    fromEnum SIGHASH_SINGLE       = 0x03-    fromEnum SIGHASH_FORKID       = 0x40-    fromEnum SIGHASH_ANYONECANPAY = 0x80-    toEnum 0x01 = SIGHASH_ALL-    toEnum 0x02 = SIGHASH_NONE-    toEnum 0x03 = SIGHASH_SINGLE-    toEnum 0x40 = SIGHASH_FORKID-    toEnum 0x80 = SIGHASH_ANYONECANPAY-    toEnum _    = error "Not a valid sighash flag"---- | Data type representing the different ways a transaction can be signed.--- When producing a signature, a hash of the transaction is used as the message--- to be signed. The 'SigHash' parameter controls which parts of the--- transaction are used or ignored to produce the transaction hash. The idea is--- that if some part of a transaction is not used to produce the transaction--- hash, then you can change that part of the transaction after producing a--- signature without invalidating that signature.------ If the 'SIGHASH_ANYONECANPAY' flag is set (true), then only the current input--- is signed. Otherwise, all of the inputs of a transaction are signed. The--- default value for 'SIGHASH_ANYONECANPAY' is unset (false).-newtype SigHash =-    SigHash Word32-    deriving ( Eq-             , Ord-             , Bits-             , Enum-             , Integral-             , Num-             , Real-             , Show-             , Read-             , Generic-             , Hashable-             , NFData-             )--instance J.FromJSON SigHash where-    parseJSON =-        J.withScientific "sighash" $-        maybe mzero (return . SigHash) . toBoundedInteger--instance J.ToJSON SigHash where-    toJSON = J.Number . fromIntegral-    toEncoding (SigHash n) = J.toEncoding n---- | 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'.-isSigHashAll :: SigHash -> Bool-isSigHashAll = (== sigHashAll) . (.&. 0x1f)---- | 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'.-isSigHashSingle :: SigHash -> Bool-isSigHashSingle = (== sigHashSingle) . (.&. 0x1f)---- | 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 (SigHash n) = fromIntegral $ n `shiftR` 8---- | Computes the hash that will be used for signing a transaction.-txSigHash :: Network-          -> Tx      -- ^ transaction to sign-          -> Script  -- ^ script from output being spent-          -> Word64  -- ^ value of output being spent-          -> Int     -- ^ index of input being signed-          -> SigHash -- ^ what to sign-          -> Hash256 -- ^ hash to be signed-txSigHash net tx out v i sh-    | hasForkIdFlag sh && isJust (getSigHashForkId net) =-        txSigHashForkId net tx out v i sh-    | otherwise = do-        let newIn = buildInputs (txIn tx) fout i sh-        -- When SigSingle and input index > outputs, then sign integer 1-        fromMaybe one $ do-            newOut <- buildOutputs (txOut tx) i sh-            let newTx = Tx (txVersion tx) newIn newOut [] (txLockTime tx)-            return $-                doubleSHA256 $-                runPut $ do-                    put newTx-                    putWord32le $ fromIntegral sh-  where-    fout = Script $ filter (/= OP_CODESEPARATOR) $ scriptOps out-    one = "0100000000000000000000000000000000000000000000000000000000000000"---- | Build transaction inputs for computing sighashes.-buildInputs :: [TxIn] -> Script -> Int -> SigHash -> [TxIn]-buildInputs txins out i sh-    | hasAnyoneCanPayFlag sh =-        [ (txins !! i) { scriptInput = encode out } ]-    | isSigHashAll sh || isSigHashUnknown sh = single-    | otherwise = zipWith noSeq single [0 ..]-  where-    emptyIn = map (\ti -> ti { scriptInput = BS.empty }) txins-    single =-        updateIndex i emptyIn $ \ti -> ti { scriptInput = encode out }-    noSeq ti j =-        if i == j-        then ti-        else ti { txInSequence = 0 }---- | Build transaction outputs for computing sighashes.-buildOutputs :: [TxOut] -> Int -> SigHash -> Maybe [TxOut]-buildOutputs txos i sh-    | isSigHashAll sh || isSigHashUnknown sh = return txos-    | isSigHashNone sh = return []-    | i >= length txos = Nothing-    | otherwise = return $ buffer ++ [txos !! i]-  where-    buffer = replicate i $ TxOut maxBound BS.empty---- | Compute the hash that will be used for signing a transaction. This--- function is used when the 'SIGHASH_FORKID' flag is set.-txSigHashForkId-    :: Network-    -> Tx      -- ^ transaction to sign-    -> Script  -- ^ script from output being spent-    -> Word64  -- ^ value of output being spent-    -> Int     -- ^ index of input being signed-    -> SigHash -- ^ what to sign-    -> Hash256 -- ^ hash to be signed-txSigHashForkId net tx out v i sh =-    doubleSHA256 . runPut $ do-        putWord32le $ txVersion tx-        put hashPrevouts-        put hashSequence-        put $ prevOutput $ txIn tx !! i-        putScript out-        putWord64le v-        putWord32le $ txInSequence $ txIn tx !! i-        put hashOutputs-        putWord32le $ txLockTime tx-        putWord32le $ fromIntegral $ sigHashAddNetworkId net sh-  where-    hashPrevouts-        | not $ hasAnyoneCanPayFlag sh =-            doubleSHA256 $ runPut $ mapM_ (put . prevOutput) $ txIn tx-        | otherwise = zeros-    hashSequence-        | not (hasAnyoneCanPayFlag sh) &&-              not (isSigHashSingle sh) && not (isSigHashNone sh) =-            doubleSHA256 $ runPut $ mapM_ (putWord32le . txInSequence) $ txIn tx-        | otherwise = zeros-    hashOutputs-        | not (isSigHashSingle sh) && not (isSigHashNone sh) =-            doubleSHA256 $ runPut $ mapM_ put $ txOut tx-        | isSigHashSingle sh && i < length (txOut tx) =-            doubleSHA256 $ encode $ txOut tx !! i-        | otherwise = zeros-    putScript s = do-        let encodedScript = encode s-        putVarInt $ BS.length encodedScript-        putByteString encodedScript-    zeros :: Hash256-    zeros = "0000000000000000000000000000000000000000000000000000000000000000"---- | Data type representing a signature together with a 'SigHash'. The 'SigHash'--- is serialized as one byte at the end of an ECDSA 'Sig'. All signatures in--- transaction inputs are of type 'TxSignature'.-data TxSignature-    = TxSignature { txSignature        :: !Sig-                  , txSignatureSigHash :: !SigHash-                  }-    | TxSignatureEmpty-    deriving (Eq, Show, Generic)--instance NFData TxSignature---- | Serialize a 'TxSignature'.-encodeTxSig :: TxSignature -> ByteString-encodeTxSig TxSignatureEmpty = error "Can not encode an empty signature"-encodeTxSig (TxSignature sig (SigHash n)) =-    runPut $ putSig sig >> putWord8 (fromIntegral n)---- | 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-            let sh = fromIntegral $ BS.last bs-            when (isSigHashUnknown sh) $-                Left "Non-canonical signature: unknown hashtype byte"-            when (isNothing (getSigHashForkId net) && hasForkIdFlag sh) $-                Left "Non-canonical signature: invalid network for forkId"-            return $ TxSignature sig sh-        Nothing -> Left "Non-canonical signature: could not parse signature"
− src/Network/Haskoin/Script/Standard.hs 
@@ -1,178 +0,0 @@-{-# LANGUAGE DeriveAnyClass    #-}-{-# LANGUAGE DeriveGeneric     #-}-{-# LANGUAGE OverloadedStrings #-}-{-|-Module      : Network.Haskoin.Script.Standard-Copyright   : No rights reserved-License     : UNLICENSE-Maintainer  : jprupp@protonmail.ch-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-    , encodeInput-    , encodeInputBS-    , decodeInput-    , decodeInputBS-    , sortMulSig-    , scriptOpToInt-    , isSpendPK-    , isSpendPKHash-    , isSpendMulSig-    , isScriptHashInput-    ) where--import           Control.Applicative            ((<|>))-import           Control.DeepSeq-import           Control.Monad                  (guard, (<=<))-import           Data.ByteString                (ByteString)-import           Data.Function                  (on)-import           Data.List                      (sortBy)-import           Data.Serialize                 (decode, encode)-import           GHC.Generics                   (Generic)-import           Network.Haskoin.Constants-import           Network.Haskoin.Keys.Common-import           Network.Haskoin.Script.Common-import           Network.Haskoin.Script.SigHash-import           Network.Haskoin.Util----- | Data type describing standard transaction input scripts. Input scripts--- provide the signing data required to unlock the coins of the output they are--- trying to spend, except in pay-to-witness-public-key-hash and--- pay-to-script-hash transactions.-data SimpleInput-      -- | spend pay-to-public-key output-    = 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]-                      -- ^ list of signatures-                   }-    deriving (Eq, Show, Generic, NFData)---- | Returns true if the input script is spending from a pay-to-public-key--- output.-isSpendPK :: ScriptInput -> Bool-isSpendPK (RegularInput (SpendPK _)) = True-isSpendPK _                          = False---- | Returns true if the input script is spending from a pay-to-public-key-hash--- output.-isSpendPKHash :: ScriptInput -> Bool-isSpendPKHash (RegularInput (SpendPKHash _ _)) = True-isSpendPKHash _                                = False---- | Returns true if the input script is spending a multisig output.-isSpendMulSig :: ScriptInput -> Bool-isSpendMulSig (RegularInput (SpendMulSig _)) = True-isSpendMulSig _                              = False---- | Returns true if the input script is spending a pay-to-script-hash output.-isScriptHashInput :: ScriptInput -> Bool-isScriptHashInput (ScriptHashInput _ _) = True-isScriptHashInput _                     = False---- | A redeem script is the output script serialized into the spending input--- 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-            -- ^ get wrapped simple input-          }-    | ScriptHashInput-          { getScriptHashInput  :: !SimpleInput-            -- ^ get simple input associated with redeem script-          , getScriptHashRedeem :: !RedeemScript-            -- ^ redeem script-          }-    deriving (Eq, Show, Generic, NFData)---- | Heuristic to decode an input script into one of the standard types.-decodeSimpleInput :: Network -> Script -> Either String SimpleInput-decodeSimpleInput net (Script ops) =-    maybeToEither errMsg $ matchPK ops <|> matchPKHash ops <|> matchMulSig ops-  where-    matchPK [op] = SpendPK <$> f op-    matchPK _    = Nothing-    matchPKHash [op, OP_PUSHDATA pub _] =-        SpendPKHash <$> f op <*> eitherToMaybe (decode pub)-    matchPKHash _ = Nothing-    matchMulSig (x:xs) = do-        guard $ x == OP_0-        SpendMulSig <$> mapM f xs-    matchMulSig _ = Nothing-    f OP_0                    = return TxSignatureEmpty-    f (OP_PUSHDATA "" OPCODE) = f OP_0-    f (OP_PUSHDATA bs _)      = eitherToMaybe $ decodeTxSig net bs-    f _                       = Nothing-    errMsg = "decodeInput: Could not decode script input"---- | Heuristic to decode a 'ScriptInput' from a 'Script'. This function fails if--- the script can not be parsed as a standard script input.-decodeInput :: Network -> Script -> Either String ScriptInput-decodeInput net s@(Script ops) =-    maybeToEither errMsg $ matchSimpleInput <|> matchPayScriptHash-  where-    matchSimpleInput =-        RegularInput <$> eitherToMaybe (decodeSimpleInput net s)-    matchPayScriptHash =-        case splitAt (length (scriptOps s) - 1) ops of-            (is, [OP_PUSHDATA bs _]) -> do-                rdm <- eitherToMaybe $ decodeOutputBS bs-                inp <- eitherToMaybe $ decodeSimpleInput net $ Script is-                return $ ScriptHashInput inp rdm-            _ -> Nothing-    errMsg = "decodeInput: Could not decode script input"---- | Like 'decodeInput' but decodes directly from a serialized script--- 'ByteString'.-decodeInputBS :: Network -> ByteString -> Either String ScriptInput-decodeInputBS net = decodeInput net <=< decode---- | Encode a standard input into a script.-encodeInput :: ScriptInput -> Script-encodeInput s = case s of-    RegularInput ri -> encodeSimpleInput ri-    ScriptHashInput i o -> Script $-        scriptOps (encodeSimpleInput i) ++ [opPushData $ encodeOutputBS o]---- | Similar to 'encodeInput' but encodes directly to a serialized script--- 'ByteString'.-encodeInputBS :: ScriptInput -> ByteString-encodeInputBS = encode . encodeInput---- | Encode a standard 'SimpleInput' into opcodes as an input 'Script'.-encodeSimpleInput :: SimpleInput -> Script-encodeSimpleInput s =-    Script $-    case s of-        SpendPK ts       -> [f ts]-        SpendPKHash ts p -> [f ts, opPushData $ encode p]-        SpendMulSig xs   -> OP_0 : map f xs-  where-    f TxSignatureEmpty = OP_0-    f ts               = opPushData $ encodeTxSig ts---- | Sort the public keys of a multisig output in ascending order by comparing--- their compressed serialized representations. Refer to BIP-67.-sortMulSig :: ScriptOutput -> ScriptOutput-sortMulSig out = case out of-    PayMulSig keys r -> PayMulSig (sortBy (compare `on` encode) keys) r-    _ -> error "Can only call orderMulSig on PayMulSig scripts"
− src/Network/Haskoin/Transaction.hs 
@@ -1,24 +0,0 @@-{-|-Module      : Network.Haskoin.Transaction-Copyright   : No rights reserved-License     : UNLICENSE-Maintainer  : jprupp@protonmail.ch-Stability   : experimental-Portability : POSIX--Transactions and related code.--}-module Network.Haskoin.Transaction-    ( module Common-    -- * Builder-    , module Builder-    -- * Segwit-    , module Segwit-    -- * Partial-    , module Partial-    ) where--import           Network.Haskoin.Transaction.Builder as Builder-import           Network.Haskoin.Transaction.Common  as Common-import           Network.Haskoin.Transaction.Partial as Partial-import           Network.Haskoin.Transaction.Segwit  as Segwit
− src/Network/Haskoin/Transaction/Builder.hs 
@@ -1,472 +0,0 @@-{-# LANGUAGE LambdaCase        #-}-{-# LANGUAGE OverloadedStrings #-}-{-|-Module      : Network.Haskoin.Transaction.Builder-Copyright   : No rights reserved-License     : UNLICENSE-Maintainer  : jprupp@protonmail.ch-Stability   : experimental-Portability : POSIX--Code to simplify transaction creation, signing, fee calculation and coin-selection.--}-module Network.Haskoin.Transaction.Builder-    ( -- * Transaction Creation & Signing-      buildAddrTx-    , buildTx-    , buildInput-    , SigInput(..)-    , signTx-    , signNestedWitnessTx-    , makeSignature-    , signInput-    , signNestedInput-    , verifyStdTx-    , mergeTxs-    , sigKeys-    , mergeTxInput-    , findSigInput-    , verifyStdInput-      -- * Coin Selection-    , Coin(..)-    , chooseCoins-    , chooseCoinsSink-    , chooseMSCoins-    , chooseMSCoinsSink-    , countMulSig-    , greedyAddSink-    , guessTxFee-    , guessMSTxFee-    , guessTxSize-    , guessMSSize-    ) where--import           Control.Applicative                      ((<|>))-import           Control.Arrow                            (first)-import           Control.Monad                            (foldM, unless)-import           Control.Monad.Identity                   (runIdentity)-import           Crypto.Secp256k1-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,-                                                           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.--- The value is used in coin selection algorithms.-class Coin c where-    coinValue :: c -> Word64---- | Coin selection algorithm for normal (non-multisig) transactions. This--- function returns the selected coins together with the amount of change to--- send back to yourself, taking the fee into account.-chooseCoins :: Coin c-            => Word64 -- ^ value to send-            -> Word64 -- ^ fee per byte-            -> Int    -- ^ number of outputs (including change)-            -> Bool   -- ^ try to find better solutions-            -> [c]    -- ^ list of ordered coins to choose from-            -> Either String ([c], Word64)-            -- ^ coin selection and change-chooseCoins target fee nOut continue coins =-    runIdentity . runConduit $-    sourceList coins .| chooseCoinsSink target fee nOut continue---- | Coin selection algorithm for normal (non-multisig) transactions. This--- function returns the selected coins together with the amount of change to--- send back to yourself, taking the fee into account. This version uses a Sink--- for conduit-based coin selection.-chooseCoinsSink :: (Monad m, Coin c)-                => Word64 -- ^ value to send-                -> Word64 -- ^ fee per byte-                -> Int    -- ^ number of outputs (including change)-                -> Bool   -- ^ try to find better solution-                -> ConduitT c Void m (Either String ([c], Word64))-                -- ^ coin selection and change-chooseCoinsSink target fee nOut continue-    | target > 0 =-        maybeToEither err <$>-            greedyAddSink target (guessTxFee fee nOut) continue-    | otherwise = return $ Left "chooseCoins: Target must be > 0"-  where-    err = "chooseCoins: No solution found"---- | Coin selection algorithm for multisig transactions. This function returns--- the selected coins together with the amount of change to send back to--- yourself, taking the fee into account. This function assumes all the coins--- are script hash outputs that send funds to a multisignature address.-chooseMSCoins :: Coin c-              => Word64     -- ^ value to send-              -> Word64     -- ^ fee per byte-              -> (Int, Int) -- ^ m of n multisig-              -> Int        -- ^ number of outputs (including change)-              -> Bool       -- ^ try to find better solution-              -> [c]-              -> Either String ([c], Word64)-              -- ^ coin selection change amount-chooseMSCoins target fee ms nOut continue coins =-    runIdentity . runConduit $-        sourceList coins .| chooseMSCoinsSink target fee ms nOut continue---- | Coin selection algorithm for multisig transactions. This function returns--- the selected coins together with the amount of change to send back to--- yourself, taking the fee into account. This function assumes all the coins--- are script hash outputs that send funds to a multisignature address. This--- version uses a Sink if you need conduit-based coin selection.-chooseMSCoinsSink :: (Monad m, Coin c)-                  => Word64     -- ^ value to send-                  -> Word64     -- ^ fee per byte-                  -> (Int, Int) -- ^ m of n multisig-                  -> Int        -- ^ number of outputs (including change)-                  -> Bool       -- ^ try to find better solution-                  -> ConduitT c Void m (Either String ([c], Word64))-                  -- ^ coin selection and change-chooseMSCoinsSink target fee ms nOut continue-    | target > 0 =-        maybeToEither err <$>-            greedyAddSink target (guessMSTxFee fee ms nOut) continue-    | otherwise = return $ Left "chooseMSCoins: Target must be > 0"-  where-    err = "chooseMSCoins: No solution found"---- | Select coins greedily by starting from an empty solution. If the 'continue'--- flag is set, the algorithm will try to find a better solution in the stream--- after a solution is found. If the next solution found is not strictly better--- than the previously found solution, the algorithm stops and returns the--- previous solution. If the continue flag is not set, the algorithm will return--- the first solution it finds in the stream.-greedyAddSink :: (Monad m, Coin c)-              => Word64          -- ^ value to send-              -> (Int -> Word64) -- ^ coin count to fee function-              -> Bool            -- ^ try to find better solutions-              -> ConduitT c Void m (Maybe ([c], Word64))-              -- ^ coin selection and change-greedyAddSink target guessFee continue =-    go [] 0 [] 0-  where-    -- The goal is the value we must reach (including the fee) for a certain-    -- amount of selected coins.-    goal c = target + guessFee c-    go acc aTot ps pTot = await >>= \case-        -- A coin is available in the stream-        Just coin -> do-            let val = coinValue coin-            -- We have reached the goal using this coin-            if val + aTot >= goal (length acc + 1)-                -- If we want to continue searching for better solutions-                then if continue-                    -- This solution is the first one or-                    -- This solution is better than the previous one-                    then if pTot == 0 || val + aTot < pTot-                        -- Continue searching for better solutions in the stream-                        then go [] 0 (coin:acc) (val + aTot)-                        -- Otherwise, we stop here and return the previous-                        -- solution-                        else return $ Just (ps, pTot - goal (length ps))-                    -- Otherwise, return this solution-                    else return $-                        Just (coin : acc, val + aTot - goal (length acc + 1))-                -- We have not yet reached the goal. Add the coin to the-                -- accumulator-                else go (coin:acc) (val + aTot) ps pTot-        -- We reached the end of the stream-        Nothing ->-            return $ if null ps-                -- If no solution was found, return Nothing-                then Nothing-                -- If we have a solution, return it-                else Just (ps, pTot - goal (length ps))---- | Estimate tranasction fee to pay based on transaction size estimation.-guessTxFee :: Word64 -> Int -> Int -> Word64-guessTxFee byteFee nOut nIn =-    byteFee * fromIntegral (guessTxSize nIn [] nOut 0)---- | Same as 'guessTxFee' but for multisig transactions.-guessMSTxFee :: Word64 -> (Int, Int) -> Int -> Int -> Word64-guessMSTxFee byteFee ms nOut nIn =-    byteFee * fromIntegral (guessTxSize 0 (replicate nIn ms) nOut 0)---- | Computes an upper bound on the size of a transaction based on some known--- properties of the transaction.-guessTxSize :: Int         -- ^ number of regular transaction inputs-            -> [(Int,Int)] -- ^ multisig m of n for each input-            -> Int         -- ^ number of P2PKH outputs-            -> Int         -- ^ number of P2SH outputs-            -> Int         -- ^ upper bound on transaction size-guessTxSize pki msi pkout msout =-    8 + inpLen + inp + outLen + out-  where-    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)-    out =-        pkout * 34 +-             -- (20: hash160) + (3: opcodes) +-             -- (1: script len) + (8: Word64)-        msout * 32---- | Size of a multisig P2SH input.-guessMSSize :: (Int,Int) -> Int-guessMSSize (m, n)-    -- OutPoint (36) + Sequence (4) + Script- = 40 + fromIntegral (B.length $ encode $ VarInt $ fromIntegral scp) + scp-    -- OP_M + n*PubKey + OP_N + OP_CHECKMULTISIG-  where-    rdm =-        fromIntegral $-        B.length $ encode $ opPushData $ B.replicate (n * 34 + 3) 0-    -- Redeem + m*sig + OP_0-    scp = rdm + m * 73 + 1--{- Build a new Tx -}---- | Build a transaction by providing a list of outpoints as inputs--- and a list of recipient addresses and amounts as outputs.-buildAddrTx :: Network -> [OutPoint] -> [(Text, Word64)] -> Either String Tx-buildAddrTx net xs ys = buildTx xs =<< mapM f ys-  where-    f (s, v) =-        maybe (Left ("buildAddrTx: Invalid address " ++ cs s)) Right $ do-            a <- stringToAddr net s-            let o = addressToOutput a-            return (o, v)---- | Build a transaction by providing a list of outpoints as inputs--- and a list of 'ScriptOutput' and amounts as outputs.-buildTx :: [OutPoint] -> [(ScriptOutput, Word64)] -> Either String Tx-buildTx xs ys =-    mapM fo ys >>= \os -> return $ Tx 1 (map fi xs) os [] 0-  where-    fi outPoint = TxIn outPoint B.empty maxBound-    fo (o, v)-        | v <= 2100000000000000 = return $ TxOut v $ encodeOutputBS o-        | otherwise =-            Left $ "buildTx: Invalid amount " ++ show v---- | 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-       -> Either String Tx -- ^ signed transaction-signTx net tx si = S.signTx net tx $ notNested <$> si-  where notNested s = (s, False)---- | 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-    -- 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 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 = S.findInputIndex sigInputOP--{- Merge 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"-    | length (nub emptyTxs) /= 1 = Left "Transactions do not match"-    | length txs == 1 = return $ head txs-    | otherwise = foldM (mergeTxInput net txs) (head emptyTxs) outs-  where-    zipOp = zip (matchTemplate os (txIn $ head txs) f) [0..]-    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 = B.empty })-    clearInput tx (_, i) =-        Tx (txVersion tx) (ins (txIn tx) i) (txOut tx) [] (txLockTime tx)---- | Merge input from partially-signed multisig transactions.  This function--- does not support segwit and P2SH-segwit inputs.-mergeTxInput ::-       Network-    -> [Tx]-    -> Tx-    -> ((ScriptOutput, Word64), Int)-    -> Either String Tx-mergeTxInput net txs tx ((so, val), i)-    -- Ignore transactions with empty inputs- = do-    let ins = map (scriptInput . (!! i) . txIn) txs-    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-    let ins' = updateIndex i (txIn tx) (\ti -> ti {scriptInput = si})-    return $ Tx (txVersion tx) ins' (txOut tx) [] (txLockTime tx)-  where-    go allSigs out rdmM =-        case out of-            PayMulSig msPubs r ->-                let sigs =-                        take r $-                        catMaybes $ matchTemplate allSigs msPubs $ f out-                 in return $ RegularInput $ SpendMulSig sigs-            PayScriptHash _ ->-                case rdmM of-                    Just rdm -> do-                        si <- go allSigs rdm Nothing-                        return $ ScriptHashInput (getRegularInput si) rdm-                    _ -> Left "Invalid output script type"-            _ -> Left "Invalid output script type"-    extractSigs si =-        case decodeInputBS net si of-            Right (RegularInput (SpendMulSig sigs)) -> Right (sigs, Nothing)-            Right (ScriptHashInput (SpendMulSig sigs) rdm) ->-                Right (sigs, Just rdm)-            _ -> Left "Invalid script input type"-    f out (TxSignature x sh) p =-        verifyHashSig-            (txSigHash net tx (encodeOutput out) val i sh)-            x-            (pubKeyPoint p)-    f _ TxSignatureEmpty _ = False--{- Tx verification -}---- | Verify if a transaction is valid and all of its inputs are standard.-verifyStdTx :: Network -> Tx -> [(ScriptOutput, Word64, OutPoint)] -> Bool-verifyStdTx net tx xs =-    not (null (txIn tx)) && all go (zip (matchTemplate xs (txIn tx) f) [0 ..])-  where-    f (_, _, o) txin = o == prevOutput txin-    go (Just (so, val, _), i) = verifyStdInput net tx i so val-    go _                      = False---- | Verify if a transaction input is valid and standard.-verifyStdInput :: Network -> Tx -> Int -> ScriptOutput -> Word64 -> Bool-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-    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--    verifyNestedInput so so' x = case so of-        PayScriptHash h -> payToScriptAddress so' == p2shAddr h && verifySegwitInput so' x-        _               -> False--    inp             = scriptInput $ txIn tx !! i-    theTxSigHash so = S.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-    -> Tx-    -> Script-    -> Word64-    -> Int-    -> [PubKey]-    -> [TxSignature]-    -> Int-countMulSig net tx out val i = countMulSig' h-  where-    h = txSigHash net tx out val i--countMulSig' :: (SigHash -> Hash256) -> [PubKey] -> [TxSignature] -> Int-countMulSig' _ [] _ = 0-countMulSig' _ _ [] = 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 
@@ -1,279 +0,0 @@-{-# 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, (.:), (.:?),-                                                     (.=), pairs)-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 ]-    toEncoding (SigInput so val op sh rdm) = pairs $-        "pkscript" .= so-        <> "value"    .= val-        <> "outpoint" .= op-        <> "sighash"  .= sh-        <> (case rdm of Nothing -> mempty-                        Just r  -> "redeem" .= r)--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 _ _ 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 
@@ -1,312 +0,0 @@-{-# LANGUAGE DeriveAnyClass    #-}-{-# LANGUAGE DeriveGeneric     #-}-{-# LANGUAGE OverloadedStrings #-}-{-|-Module      : Network.Haskoin.Transaction.Common-Copyright   : No rights reserved-License     : UNLICENSE-Maintainer  : jprupp@protonmail.ch-Stability   : experimental-Portability : POSIX--Code related to transactions parsing and serialization.--}-module Network.Haskoin.Transaction.Common-    ( Tx(..)-    , TxIn(..)-    , TxOut(..)-    , OutPoint(..)-    , TxHash(..)-    , WitnessData-    , WitnessStack-    , WitnessStackItem-    , txHash-    , hexToTxHash-    , txHashToHex-    , nosigTxHash-    , nullOutPoint-    , genesisTx-    ) where--import           Control.Applicative            ((<|>))-import           Control.DeepSeq-import           Control.Monad                  (forM_, guard, liftM2, mzero,-                                                 replicateM, (<=<))-import           Data.Aeson                     as A-import           Data.Aeson.Encoding            (unsafeToEncoding)-import           Data.ByteString                (ByteString)-import qualified Data.ByteString                as B-import           Data.ByteString.Builder        (char7)-import           Data.Hashable                  (Hashable)-import           Data.Maybe                     (fromMaybe)-import           Data.Serialize                 as S-import           Data.String                    (IsString, fromString)-import           Data.String.Conversions        (cs)-import           Data.Text                      (Text)-import           Data.Word                      (Word32, Word64)-import           GHC.Generics                   (Generic)-import           Network.Haskoin.Crypto.Hash-import           Network.Haskoin.Network.Common-import           Network.Haskoin.Script.Common-import           Network.Haskoin.Util-import           Text.Read                      as R---- | Transaction id: hash of transaction excluding witness data.-newtype TxHash = TxHash { getTxHash :: Hash256 }-    deriving (Eq, Ord, Generic, Hashable, Serialize, NFData)--instance Show TxHash where-    showsPrec _ = shows . txHashToHex--instance Read TxHash where-    readPrec = do-        R.String str <- R.lexP-        maybe R.pfail return $ hexToTxHash $ cs str--instance IsString TxHash where-    fromString s =-        let e = error "Could not read transaction hash from hex string"-        in fromMaybe e $ hexToTxHash $ cs s--instance FromJSON TxHash where-    parseJSON = withText "txid" $-        maybe mzero return . hexToTxHash--instance ToJSON TxHash where-    toJSON = A.String . txHashToHex-    toEncoding (TxHash h) =-        unsafeToEncoding $-        char7 '"' <> hexBuilder (B.reverse (S.encode h)) <> char7 '"'---- | Transaction hash excluding signatures.-nosigTxHash :: Tx -> TxHash-nosigTxHash tx =-    TxHash $ doubleSHA256 $ S.encode tx { txIn = map clearInput $ txIn tx }-  where-    clearInput ti = ti { scriptInput = B.empty }---- | Convert transaction hash to hex form, reversing bytes.-txHashToHex :: TxHash -> Text-txHashToHex (TxHash h) = encodeHex (B.reverse (S.encode h))---- | Convert transaction hash from hex, reversing bytes.-hexToTxHash :: Text -> Maybe TxHash-hexToTxHash hex = do-    bs <- B.reverse <$> decodeHex hex-    h <- either (const Nothing) Just (S.decode bs)-    return $ TxHash h---- | Witness stack for SegWit transactions.-type WitnessData = [WitnessStack]--- | Witness stack for SegWit transactions.-type WitnessStack = [WitnessStackItem]--- | Witness stack item for SegWit transactions.-type WitnessStackItem = ByteString---- | Data type representing a transaction.-data Tx = Tx-    { -- | transaction data format version-      txVersion  :: !Word32-      -- | list of transaction inputs-    , txIn       :: ![TxIn]-      -- | list of transaction outputs-    , txOut      :: ![TxOut]-      -- | witness data for the transaction-    , txWitness  :: !WitnessData-      -- | earliest mining height or time-    , txLockTime :: !Word32-    } deriving (Show, Read, Eq, Ord, Generic, Hashable, NFData)---- | Compute transaction hash.-txHash :: Tx -> TxHash-txHash tx = TxHash (doubleSHA256 (S.encode tx {txWitness = []}))--instance IsString Tx where-    fromString =-        fromMaybe e . (eitherToMaybe . S.decode <=< decodeHex) . cs-      where-        e = error "Could not read transaction from hex string"--instance Serialize Tx where-    get = parseWitnessTx <|> parseLegacyTx-    put tx-        | null (txWitness tx) = putLegacyTx tx-        | otherwise = putWitnessTx tx--putInOut :: Tx -> Put-putInOut tx = do-    putVarInt $ length (txIn tx)-    forM_ (txIn tx) put-    putVarInt $ length (txOut tx)-    forM_ (txOut tx) put---- | Non-SegWit transaction serializer.-putLegacyTx :: Tx -> Put-putLegacyTx tx = do-    putWord32le (txVersion tx)-    putInOut tx-    putWord32le (txLockTime tx)---- | Witness transaciton serializer.-putWitnessTx :: Tx -> Put-putWitnessTx tx = do-    putWord32le (txVersion tx)-    putWord8 0x00-    putWord8 0x01-    putInOut tx-    putWitnessData (txWitness tx)-    putWord32le (txLockTime tx)---- | Non-SegWit transaction deseralizer.-parseLegacyTx :: Get Tx-parseLegacyTx = do-    v <- getWord32le-    is <- replicateList =<< S.get-    os <- replicateList =<< S.get-    l <- getWord32le-    return-        Tx-        {txVersion = v, txIn = is, txOut = os, txWitness = [], txLockTime = l}-  where-    replicateList (VarInt c) = replicateM (fromIntegral c) S.get---- | Witness transaction deserializer.-parseWitnessTx :: Get Tx-parseWitnessTx = do-    v <- getWord32le-    m <- getWord8-    f <- getWord8-    guard $ m == 0x00-    guard $ f == 0x01-    is <- replicateList =<< S.get-    os <- replicateList =<< S.get-    w <- parseWitnessData $ length is-    l <- getWord32le-    return-        Tx {txVersion = v, txIn = is, txOut = os, txWitness = w, txLockTime = l}-  where-    replicateList (VarInt c) = replicateM (fromIntegral c) S.get---- | Witness data deserializer. Requires count of inputs.-parseWitnessData :: Int -> Get WitnessData-parseWitnessData n = replicateM n parseWitnessStack-  where-    parseWitnessStack = do-        VarInt i <- S.get-        replicateM (fromIntegral i) parseWitnessStackItem-    parseWitnessStackItem = do-        VarInt i <- S.get-        getByteString $ fromIntegral i---- | Witness data serializer.-putWitnessData :: WitnessData -> Put-putWitnessData = mapM_ putWitnessStack-  where-    putWitnessStack ws = do-        putVarInt $ length ws-        mapM_ putWitnessStackItem ws-    putWitnessStackItem bs = do-        putVarInt $ B.length bs-        putByteString bs--instance FromJSON Tx where-    parseJSON = withText "Tx" $-        maybe mzero return . (eitherToMaybe . S.decode <=< decodeHex)--instance ToJSON Tx where-    toJSON = A.String . encodeHex . S.encode-    toEncoding tx =-        unsafeToEncoding $ char7 '"' <> hexBuilder (S.encode tx) <> char7 '"'---- | Data type representing a transaction input.-data TxIn =-    TxIn {-           -- | output being spent-           prevOutput   :: !OutPoint-           -- | signatures and redeem script-         , scriptInput  :: !ByteString-           -- | lock-time using sequence numbers (BIP-68)-         , txInSequence :: !Word32-         } deriving (Eq, Show, Read, Ord, Generic, Hashable, NFData)--instance Serialize TxIn where-    get =-        TxIn <$> S.get <*> (readBS =<< S.get) <*> getWord32le-      where-        readBS (VarInt len) = getByteString $ fromIntegral len--    put (TxIn o s q) = do-        put o-        putVarInt $ B.length s-        putByteString s-        putWord32le q---- | Data type representing a transaction output.-data TxOut =-    TxOut {-            -- | value of output is satoshi-            outValue     :: !Word64-            -- | pubkey script-          , scriptOutput :: !ByteString-          } deriving (Eq, Show, Read, Ord, Generic, Hashable, NFData)--instance Serialize TxOut where-    get = do-        val <- getWord64le-        (VarInt len) <- S.get-        TxOut val <$> getByteString (fromIntegral len)--    put (TxOut o s) = do-        putWord64le o-        putVarInt $ B.length s-        putByteString s---- | The 'OutPoint' refers to a transaction output being spent.-data OutPoint = OutPoint-    { -- | hash of previous transaction-      outPointHash  :: !TxHash-      -- | position of output in previous transaction-    , outPointIndex :: !Word32-    } deriving (Show, Read, Eq, Ord, Generic, Hashable, NFData)--instance FromJSON OutPoint where-    parseJSON = withText "OutPoint" $-        maybe mzero return . (eitherToMaybe . S.decode <=< decodeHex)--instance ToJSON OutPoint where-    toJSON = A.String . encodeHex . S.encode-    toEncoding op =-        unsafeToEncoding $ char7 '"' <> hexBuilder (S.encode op) <> char7 '"'--instance Serialize OutPoint where-    get = do-        (h,i) <- liftM2 (,) S.get getWord32le-        return $ OutPoint h i-    put (OutPoint h i) = put h >> putWord32le i---- | Outpoint used in coinbase transactions.-nullOutPoint :: OutPoint-nullOutPoint =-    OutPoint-    { outPointHash =-          "0000000000000000000000000000000000000000000000000000000000000000"-    , outPointIndex = maxBound-    }---- | Transaction from Genesis block.-genesisTx :: Tx-genesisTx =-    Tx 1 [txin] [txout] [] locktime-  where-    txin = TxIn outpoint inputBS maxBound-    txout = TxOut 5000000000 (encodeOutputBS output)-    locktime = 0-    outpoint = OutPoint z maxBound-    Just inputBS = decodeHex $ fromString $-        "04ffff001d0104455468652054696d65732030332f4a616e2f323030392043686" ++-        "16e63656c6c6f72206f6e206272696e6b206f66207365636f6e64206261696c6f" ++-        "757420666f722062616e6b73"-    output = PayPK $ fromString $-        "04678afdb0fe5548271967f1a67130b7105cd6a828e03909a67962e0ea1f61deb" ++-        "649f6bc3f4cef38c4f35504e51ec112de5c384df7ba0b8d578a4c702b6bf11d5f"-    z = "0000000000000000000000000000000000000000000000000000000000000000"
− src/Network/Haskoin/Transaction/Partial.hs 
@@ -1,505 +0,0 @@-{-# LANGUAGE DeriveGeneric              #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE NamedFieldPuns             #-}-{-# LANGUAGE OverloadedStrings          #-}-{-# LANGUAGE ScopedTypeVariables        #-}-{-|-Module      : Network.Haskoin.Transaction.Partial-Copyright   : No rights reserved-License     : UNLICENSE-Maintainer  : matt@bitnomial.com-Stability   : experimental-Portability : POSIX--Code related to PSBT parsing and serialization.--}-module Network.Haskoin.Transaction.Partial-    ( PartiallySignedTransaction (..)-    , Input (..)-    , Output (..)-    , UnknownMap (..)-    , Key (..)-    , merge-    , mergeInput-    , mergeOutput-    , complete-    , finalTransaction-    , emptyPSBT-    , emptyInput-    , emptyOutput-    ) where--import           Control.Applicative                ((<|>))-import           Control.DeepSeq-import           Control.Monad                      (guard, replicateM, void)-import           Data.ByteString                    (ByteString)-import qualified Data.ByteString                    as B-import           Data.Hashable                      (Hashable)-import           Data.HashMap.Strict                (HashMap)-import qualified Data.HashMap.Strict                as HashMap-import           Data.List                          (foldl')-import           Data.Maybe                         (fromMaybe, isJust)-import           Data.Serialize                     as S-import           GHC.Generics                       (Generic)-import           GHC.Word                           (Word32, Word8)-import           Network.Haskoin.Address            (Address (..), pubKeyAddr)-import           Network.Haskoin.Keys               (Fingerprint, KeyIndex,-                                                     PubKeyI)-import           Network.Haskoin.Network            (VarInt (..),-                                                     VarString (..), putVarInt)-import           Network.Haskoin.Script             (Script (..), ScriptOp (..),-                                                     ScriptOutput (..), SigHash,-                                                     decodeOutput,-                                                     decodeOutputBS,-                                                     encodeOutputBS,-                                                     isPayScriptHash,-                                                     opPushData, toP2SH,-                                                     toP2WSH)-import           Network.Haskoin.Transaction.Common (Tx (..), TxOut,-                                                     WitnessStack,-                                                     outPointIndex, prevOutput,-                                                     scriptInput, scriptOutput)-import           Network.Haskoin.Util               (eitherToMaybe)---- | PSBT data type as specified in--- [BIP-174](https://github.com/bitcoin/bips/blob/master/bip-0174.mediawiki).--- This contains an unsigned transaction, inputs and outputs, and unspecified--- extra data. There is one input per input in the unsigned transaction, and one--- output per output in the unsigned transaction. The inputs and outputs in the--- 'PartiallySignedTransaction' line up by index with the inputs and outputs in--- the unsigned transaction.-data PartiallySignedTransaction = PartiallySignedTransaction-    { unsignedTransaction :: Tx-    , globalUnknown       :: UnknownMap-    , inputs              :: [Input]-    , outputs             :: [Output]-    } deriving (Show, Eq, Generic)--instance NFData PartiallySignedTransaction---- | Inputs contain all of the data needed to sign a transaction and all of the--- resulting signature data after signing.-data Input = Input-    { nonWitnessUtxo     :: Maybe Tx-    , witnessUtxo        :: Maybe TxOut-    , partialSigs        :: HashMap PubKeyI ByteString-    , sigHashType        :: Maybe SigHash-    , inputRedeemScript  :: Maybe Script-    , inputWitnessScript :: Maybe Script-    , inputHDKeypaths    :: HashMap PubKeyI (Fingerprint, [KeyIndex])-    , finalScriptSig     :: Maybe Script-    , finalScriptWitness :: Maybe WitnessStack-    , inputUnknown       :: UnknownMap-    } deriving (Show, Eq, Generic)--instance NFData Input---- | Outputs can contain information needed to spend the output at a later date.-data Output = Output-    { outputRedeemScript  :: Maybe Script-    , outputWitnessScript :: Maybe Script-    , outputHDKeypaths    :: HashMap PubKeyI (Fingerprint, [KeyIndex])-    , outputUnknown       :: UnknownMap-    } deriving (Show, Eq, Generic)--instance NFData Output---- | A map of raw PSBT keys to byte strings for extra data. The 'keyType' field cannot overlap with any of the reserved--- 'keyType' fields specified in the PSBT specification.-newtype UnknownMap = UnknownMap { unknownMap :: HashMap Key ByteString }-    deriving (Show, Eq, Semigroup, Monoid, Generic)--instance NFData UnknownMap---- | Raw keys for the map type used in PSBTs.-data Key = Key-    { keyType :: Word8-    , key     :: ByteString-    } deriving (Show, Eq, Generic)--instance NFData Key--instance Hashable Key---- | Take two 'PartiallySignedTransaction's and merge them. The 'unsignedTransaction' field in both must be the same.-merge :: PartiallySignedTransaction -> PartiallySignedTransaction -> Maybe PartiallySignedTransaction-merge psbt1 psbt2-    | unsignedTransaction psbt1 == unsignedTransaction psbt2-    = Just $ psbt1-        { globalUnknown = globalUnknown psbt1 <> globalUnknown psbt2-        , inputs = zipWith mergeInput (inputs psbt1) (inputs psbt2)-        , outputs = zipWith mergeOutput (outputs psbt1) (outputs psbt2)-        }-merge _ _ = Nothing--mergeInput :: Input -> Input -> Input-mergeInput a b = Input-    { nonWitnessUtxo = if isJust witUtx then Nothing else nonWitnessUtxo a <|> nonWitnessUtxo b-    , witnessUtxo = witUtx-    , sigHashType = sigHashType a <|> sigHashType b-    , partialSigs = partialSigs a <> partialSigs b-    , inputHDKeypaths = inputHDKeypaths a <> inputHDKeypaths b-    , inputUnknown = inputUnknown a <> inputUnknown b-    , inputRedeemScript = inputRedeemScript a <|> inputRedeemScript b-    , inputWitnessScript = inputWitnessScript a <|> inputWitnessScript b-    , finalScriptSig = finalScriptSig a <|> finalScriptSig b-    , finalScriptWitness = finalScriptWitness a <|> finalScriptWitness b-    }-  where-    witUtx = witnessUtxo a <|> witnessUtxo b--mergeOutput :: Output -> Output -> Output-mergeOutput a b = Output-    { outputRedeemScript = outputRedeemScript a <|> outputRedeemScript b-    , outputWitnessScript = outputWitnessScript a <|> outputWitnessScript b-    , outputHDKeypaths = outputHDKeypaths a <> outputHDKeypaths b-    , outputUnknown = outputUnknown a <> outputUnknown b-    }---- | Take partial signatures from all of the 'Input's and finalize the signature.-complete :: PartiallySignedTransaction -> PartiallySignedTransaction-complete psbt = psbt { inputs = map (completeInput . analyzeInputs) (indexed $ inputs psbt) }-  where-    analyzeInputs (i, input) = (outputScript =<< witnessUtxo input <|> nonWitScript, input)-      where-        nonWitScript = getPrevOut i =<< nonWitnessUtxo input--    getPrevOut i tx =-       (txOut tx !!?) . fromIntegral . outPointIndex . prevOutput =<< txIn (unsignedTransaction psbt) !!? i-    xs !!? i = lookup i $ indexed xs--    outputScript = eitherToMaybe . decodeOutputBS . scriptOutput--    completeInput (Nothing, input)     = input-    completeInput (Just script, input) = completeSig input script--    indexed :: [a] -> [(Word32, a)]-    indexed = zip [0..]--completeSig :: Input -> ScriptOutput -> Input-completeSig input (PayPK k) =-    input { finalScriptSig = eitherToMaybe . S.decode =<< HashMap.lookup k (partialSigs input) }-completeSig input (PayPKHash h)-    | [(k, sig)] <- HashMap.toList $ partialSigs input-    , PubKeyAddress h == pubKeyAddr k-    = input { finalScriptSig = Just $ Script [opPushData sig, opPushData (S.encode k)] }-completeSig input (PayMulSig pubKeys m) | length sigs >= m = input { finalScriptSig = finalSig }-  where-    sigs = collectSigs m pubKeys input-    finalSig = Script . (OP_0 :) . (map opPushData sigs <>) . pure . opPushData . S.encode <$> inputRedeemScript input-completeSig input (PayScriptHash h)-    | Just rdmScript <- inputRedeemScript input-    , PayScriptHash h == toP2SH rdmScript-    , Right decodedScript <- decodeOutput rdmScript-    , not (isPayScriptHash decodedScript)-    = completeSig input decodedScript-completeSig input (PayWitnessPKHash h)-    | [(k, sig)] <- HashMap.toList $ partialSigs input-    , PubKeyAddress h == pubKeyAddr k-    = input { finalScriptWitness = Just [sig, S.encode k]-            , finalScriptSig = Script . pure . opPushData . S.encode <$> inputRedeemScript input-            }-completeSig input (PayWitnessScriptHash h)-    | Just witScript <- inputWitnessScript input-    , PayWitnessScriptHash h == toP2WSH witScript-    , Right decodedScript <- decodeOutput witScript-    = completeWitnessSig input decodedScript-completeSig input _ = input--completeWitnessSig :: Input -> ScriptOutput -> Input-completeWitnessSig input script@(PayMulSig pubKeys m) | length sigs >= m = input-    { finalScriptWitness = Just finalWit-    , finalScriptSig = finalSig-    }-  where-    sigs = collectSigs m pubKeys input-    finalSig = Script . pure . opPushData . S.encode <$> inputRedeemScript input-    finalWit = mempty : sigs <> [encodeOutputBS script]-completeWitnessSig input _ = input--collectSigs :: Int -> [PubKeyI] -> Input -> [ByteString]-collectSigs m pubKeys input = take m . reverse $ foldl' lookupKey [] pubKeys-  where-    lookupKey sigs key = maybe sigs (:sigs) $ HashMap.lookup key (partialSigs input)---- | Take a finalized 'PartiallySignedTransaction' and produce the signed final transaction.  You may need to call--- 'complete' on the 'PartiallySignedTransaction' before producing the final transaction.-finalTransaction :: PartiallySignedTransaction -> Tx-finalTransaction psbt = setInputs . foldl' finalizeInput ([], []) $ zip (txIn tx) (inputs psbt)-  where-    tx = unsignedTransaction psbt-    hasWitness = any (isJust . finalScriptWitness) (inputs psbt)-    setInputs (ins, witData) = tx { txIn = reverse ins, txWitness = if hasWitness then reverse witData else [] }-    finalizeInput (ins, witData) (txInput, psbtInput) = maybe finalWitness finalScript $ finalScriptSig psbtInput-      where-        finalScript script = (txInput { scriptInput = encode script }:ins, []:witData)-        finalWitness = (ins, fromMaybe [] (finalScriptWitness psbtInput):witData)---- | Take an unsigned transaction and produce an empty 'PartiallySignedTransaction'-emptyPSBT :: Tx -> PartiallySignedTransaction-emptyPSBT tx = PartiallySignedTransaction-    { unsignedTransaction = tx-    , globalUnknown = mempty-    , inputs = replicate (length (txIn tx)) emptyInput-    , outputs = replicate (length (txOut tx)) emptyOutput-    }--emptyInput :: Input-emptyInput = Input-    Nothing Nothing HashMap.empty Nothing-    Nothing Nothing HashMap.empty-    Nothing Nothing (UnknownMap HashMap.empty)--emptyOutput :: Output-emptyOutput = Output Nothing Nothing HashMap.empty (UnknownMap HashMap.empty)--instance Serialize PartiallySignedTransaction where-    get = do-        magic <- getBytes 4-        guard $ magic == "psbt"-        headerSep <- getWord8-        guard $ headerSep == 0xff--        keySize <- getWord8-        guard $ keySize == 1-        globalUnsignedTxType <- getWord8-        guard $ globalUnsignedTxType == 0x00-        unsignedTransaction <- getSizedBytes-        guard $ all (B.null . scriptInput) (txIn unsignedTransaction)-        guard $ null (txWitness unsignedTransaction)--        globalUnknown <- get-        globalEnd <- getWord8-        guard $ globalEnd == 0x00--        inputs <- replicateM (length $ txIn unsignedTransaction) get-        outputs <- replicateM (length $ txOut unsignedTransaction) get--        return PartiallySignedTransaction { unsignedTransaction, globalUnknown, inputs, outputs }--    put PartiallySignedTransaction{ unsignedTransaction, globalUnknown, inputs, outputs } = do-        putByteString "psbt"-        putWord8 0xff -- Header separator--        putWord8 0x01 -- Key size-        putWord8 0x00 -- Unsigned Transaction type-        putSizedBytes unsignedTransaction-        put globalUnknown-        putWord8 0x00 -- Global end--        mapM_ put inputs-        mapM_ put outputs--instance Serialize Key where-    get = do-        VarInt keySize <- get-        guard $ keySize > 0-        t <- getWord8-        k <- getBytes (fromIntegral keySize - 1)-        return (Key t k)--    put (Key t k) = do-        putVarInt $ 1 + B.length k-        putWord8 t-        putByteString k--instance Serialize UnknownMap where-    get = go HashMap.empty-      where-        getItem m = do-            k <- get-            VarString v <- get-            go $ HashMap.insert k v m-        go m = do-            isEnd <- lookAhead getWord8-            if isEnd == 0x00-                then return (UnknownMap m)-                else getItem m--    put (UnknownMap m) = void $ HashMap.traverseWithKey (\k v -> put k >> put (VarString v)) m--instance Serialize Input where-    get = getMap getInputItem setInputUnknown emptyInput-      where-        setInputUnknown f input = input { inputUnknown = UnknownMap $ f (unknownMap $ inputUnknown input) }--    put Input { nonWitnessUtxo, witnessUtxo, partialSigs, sigHashType-                  , inputRedeemScript, inputWitnessScript, inputHDKeypaths-                  , finalScriptSig, finalScriptWitness, inputUnknown-                  } = do-        whenJust (putKeyValue InNonWitnessUtxo) nonWitnessUtxo-        whenJust (putKeyValue InWitnessUtxo) witnessUtxo-        putPartialSig partialSigs-        whenJust putSigHash sigHashType-        whenJust (putKeyValue InRedeemScript) inputRedeemScript-        whenJust (putKeyValue InWitnessScript) inputWitnessScript-        putHDPath InBIP32Derivation inputHDKeypaths-        whenJust (putKeyValue InFinalScriptSig) finalScriptSig-        whenJust (putKeyValue InFinalScriptWitness) finalScriptWitness-        put inputUnknown-        putWord8 0x00-      where-        putPartialSig = putPubKeyMap InPartialSig . fmap VarString-        putSigHash sigHash = do-            putKey InSigHashType-            putWord8 0x04-            putWord32le (fromIntegral sigHash)--instance Serialize Output where-    get = getMap getOutputItem setOutputUnknown emptyOutput-      where-        setOutputUnknown f output = output { outputUnknown = UnknownMap $ f (unknownMap $ outputUnknown output) }--    put Output{ outputRedeemScript, outputWitnessScript, outputHDKeypaths, outputUnknown } = do-        whenJust (putKeyValue OutRedeemScript) outputRedeemScript-        whenJust (putKeyValue OutWitnessScript) outputWitnessScript-        putHDPath OutBIP32Derivation outputHDKeypaths-        put outputUnknown-        putWord8 0x00--putSizedBytes :: Serialize a => a -> Put-putSizedBytes a = putVarInt (B.length bs) >> putByteString bs-  where bs = encode a--getSizedBytes :: Serialize a => Get a-getSizedBytes = getNested (fromIntegral . getVarInt <$> get) get--putKeyValue :: (Enum t, Serialize v) => t -> v -> Put-putKeyValue t v = putKey t >> putSizedBytes v--putKey :: Enum t => t -> Put-putKey t = putVarInt (1 :: Word8) >> putWord8 (enumWord8 t)--getMap :: (Bounded t, Enum t)-       => (Int -> a -> t -> Get a)-       -> ((HashMap Key ByteString -> HashMap Key ByteString) -> a -> a)-       -> a -> Get a-getMap getMapItem setUnknown = go-  where-    getItem keySize m (Right t) = getMapItem (fromIntegral keySize - 1) m t >>= go-    getItem keySize m (Left t)  = do-        k <- getBytes (fromIntegral keySize - 1)-        VarString v <- get-        go $ setUnknown (HashMap.insert (Key t k) v) m-    go m = do-        keySize <- getVarInt <$> get-        if keySize == 0-            then return m-            else getItem keySize m =<< (word8Enum <$> getWord8)--data InputType-    = InNonWitnessUtxo-    | InWitnessUtxo-    | InPartialSig-    | InSigHashType-    | InRedeemScript-    | InWitnessScript-    | InBIP32Derivation-    | InFinalScriptSig-    | InFinalScriptWitness-    deriving (Show, Eq, Enum, Bounded, Generic)--instance NFData InputType--data OutputType-    = OutRedeemScript-    | OutWitnessScript-    | OutBIP32Derivation-    deriving (Show, Eq, Enum, Bounded, Generic)--instance NFData OutputType--getInputItem :: Int -> Input -> InputType -> Get Input-getInputItem 0 input@Input{nonWitnessUtxo = Nothing} InNonWitnessUtxo = do-    utxo <- getSizedBytes-    return $ input { nonWitnessUtxo = Just utxo }-getInputItem 0 input@Input{witnessUtxo = Nothing} InWitnessUtxo = do-    utxo <- getSizedBytes-    return $ input { witnessUtxo = Just utxo }-getInputItem keySize input InPartialSig = do-    (k, v) <- getPartialSig-    return $ input { partialSigs = HashMap.insert k v (partialSigs input) }-  where-    getPartialSig = (,) <$> isolate keySize get <*> (getVarString <$> get)-getInputItem 0 input@Input{sigHashType = Nothing} InSigHashType = do-    VarInt size <- get-    guard $ size == 0x04-    sigHash <- fromIntegral <$> getWord32le-    return $ input { sigHashType = Just sigHash }-getInputItem 0 input@Input{inputRedeemScript = Nothing} InRedeemScript = do-    script <- getSizedBytes-    return $ input { inputRedeemScript = Just script }-getInputItem 0 input@Input{inputWitnessScript = Nothing} InWitnessScript = do-    script <- getSizedBytes-    return $ input { inputWitnessScript = Just script }-getInputItem keySize input InBIP32Derivation = do-    (k, v) <- getHDPath keySize-    return $ input { inputHDKeypaths = HashMap.insert k v (inputHDKeypaths input) }-getInputItem 0 input@Input{finalScriptSig = Nothing} InFinalScriptSig = do-    script <- getSizedBytes-    return $ input { finalScriptSig = Just script }-getInputItem 0 input@Input{finalScriptWitness = Nothing} InFinalScriptWitness = do-    scripts <- map getVarString <$> getVarIntList-    return $ input { finalScriptWitness = Just scripts }-  where-    getVarIntList = do-        VarInt n <- get-        replicateM (fromIntegral n) get-getInputItem keySize input inputType = fail $-    "Incorrect key size for input item or item already existed: " <>-    show (keySize, input, inputType)--getOutputItem :: Int -> Output -> OutputType -> Get Output-getOutputItem 0 output@Output{outputRedeemScript = Nothing} OutRedeemScript = do-    script <- getSizedBytes-    return $ output { outputRedeemScript = Just script }-getOutputItem 0 output@Output{outputWitnessScript = Nothing} OutWitnessScript = do-    script <- getSizedBytes-    return $ output { outputWitnessScript = Just script }-getOutputItem keySize output OutBIP32Derivation = do-    (k, v) <- getHDPath keySize-    return $ output { outputHDKeypaths = HashMap.insert k v (outputHDKeypaths output) }-getOutputItem keySize output outputType = fail $-    "Incorrect key size for output item or item already existed: " <>-    show (keySize, output, outputType)--getHDPath :: Int -> Get (PubKeyI, (Fingerprint, [KeyIndex]))-getHDPath keySize = (,) <$> isolate keySize get <*> (unPSBTHDPath <$> get)--putHDPath :: Enum t => t -> HashMap PubKeyI (Fingerprint, [KeyIndex]) -> Put-putHDPath t = putPubKeyMap t . fmap PSBTHDPath--newtype PSBTHDPath = PSBTHDPath { unPSBTHDPath :: (Fingerprint, [KeyIndex]) }-    deriving (Show, Eq, Generic)--instance NFData PSBTHDPath--instance Serialize PSBTHDPath where-    get = do-        VarInt valueSize <- get-        guard $ valueSize `mod` 4 == 0-        let numIndices = (fromIntegral valueSize - 4) `div` 4-        PSBTHDPath <$>-            isolate-                (fromIntegral valueSize)-                ((,) <$> getWord32le <*> getKeyIndexList numIndices)-      where-        getKeyIndexList n = replicateM n getWord32le-    put (PSBTHDPath (fp, kis)) = putVarInt (B.length bs) >> putByteString bs-      where-        bs = runPut $ putWord32le fp >> mapM_ putWord32le kis--putPubKeyMap :: (Serialize a, Enum t) => t -> HashMap PubKeyI a -> Put-putPubKeyMap t = void . HashMap.traverseWithKey putItem-  where-    putItem k v = put (Key (enumWord8 t) (encode k)) >> put v--enumWord8 :: Enum a => a -> Word8-enumWord8 = fromIntegral . fromEnum--word8Enum :: forall a. (Bounded a, Enum a) => Word8 -> Either Word8 a-word8Enum n | n <= enumWord8 (maxBound :: a) = Right . toEnum $ fromIntegral n-word8Enum n = Left n--whenJust :: Monad m => (a -> m ()) -> Maybe a -> m ()-whenJust = maybe (return ())
− src/Network/Haskoin/Transaction/Segwit.hs 
@@ -1,141 +0,0 @@-{-# 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 _, [sigBS]) ->-                SpendPK <$> decodeTxSig net sigBS-            (PayPKHash _, [sigBS, keyBS]) ->-                SpendPKHash <$> decodeTxSig net sigBS <*> S.decode keyBS-            (PayMulSig _ _, "" : 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 
@@ -1,202 +0,0 @@-{-# LANGUAGE MultiParamTypeClasses #-}-{-|-Module      : Network.Haskoin.Util-Copyright   : No rights reserved-License     : UNLICENSE-Maintainer  : jprupp@protonmail.ch-Stability   : experimental-Portability : POSIX--This module defines various utility functions used across the library.--}-module Network.Haskoin.Util-    (-      -- * ByteString Helpers-      bsToInteger-    , integerToBS-    , hexBuilder-    , encodeHex-    , decodeHex-    , getBits--      -- * Maybe & Either Helpers-    , eitherToMaybe-    , maybeToEither-    , liftEither-    , liftMaybe--      -- * Other Helpers-    , updateIndex-    , matchTemplate-    , convertBits--      -- * Triples-    , fst3-    , snd3-    , lst3--      -- * JSON Utilities-    , dropFieldLabel-    , dropSumLabels--    ) where--import           Control.Monad           (guard)-import           Control.Monad.Except    (ExceptT (..), liftEither)-import           Data.Aeson.Types        (Options (..), SumEncoding (..),-                                          defaultOptions, defaultTaggedObject)-import           Data.Bits-import           Data.ByteString         (ByteString)-import qualified Data.ByteString         as BS-import qualified Data.ByteString.Base16  as B16-import           Data.ByteString.Builder-import qualified Data.ByteString.Lazy    as BL-import           Data.Char               (toLower)-import           Data.List-import           Data.Text               (Text)-import qualified Data.Text.Encoding      as E-import           Data.Word               (Word8)---- ByteString helpers---- | Decode a big endian 'Integer' from a 'ByteString'.-bsToInteger :: ByteString -> Integer-bsToInteger = BS.foldr f 0 . BS.reverse-  where-    f w n = toInteger w .|. shiftL n 8---- | Encode an 'Integer' to a 'ByteString' as big endian.-integerToBS :: Integer -> ByteString-integerToBS 0 = BS.pack [0]-integerToBS i-    | i > 0     = BS.reverse $ BS.unfoldr f i-    | otherwise = error "integerToBS not defined for negative values"-  where-    f 0 = Nothing-    f x = Just (fromInteger x :: Word8, x `shiftR` 8)--hexBuilder :: ByteString -> Builder-hexBuilder = byteStringHex---- | Encode as string of human-readable hex characters.-encodeHex :: ByteString -> Text-encodeHex = E.decodeUtf8 . BL.toStrict . toLazyByteString . byteStringHex---- | Decode string of human-readable hex characters.-decodeHex :: Text -> Maybe ByteString-decodeHex text =-    let (x, b) = B16.decode (E.encodeUtf8 text)-    in guard (b == BS.empty) >> return x---- | Obtain 'Int' bits from beginning of 'ByteString'. Resulting 'ByteString'--- will be smallest required to hold that many bits, padded with zeroes to the--- right.-getBits :: Int -> ByteString -> ByteString-getBits b bs-    | r == 0 = BS.take q bs-    | otherwise = i `BS.snoc` l-  where-    (q, r) = b `quotRem` 8-    s = BS.take (q + 1) bs-    i = BS.init s-    l = BS.last s .&. (0xff `shiftL` (8 - r)) -- zero unneeded bits---- Maybe and Either monad helpers---- | Transform an 'Either' value into a 'Maybe' value. 'Right' is mapped to--- 'Just' and 'Left' is mapped to 'Nothing'. The value inside 'Left' is lost.-eitherToMaybe :: Either a b -> Maybe b-eitherToMaybe (Right b) = Just b-eitherToMaybe _         = Nothing---- | Transform a 'Maybe' value into an 'Either' value. 'Just' is mapped to--- 'Right' and 'Nothing' is mapped to 'Left'. Default 'Left' required.-maybeToEither :: b -> Maybe a -> Either b a-maybeToEither err = maybe (Left err) Right---- | Lift a 'Maybe' computation into the 'ExceptT' monad.-liftMaybe :: Monad m => b -> Maybe a -> ExceptT b m a-liftMaybe err = liftEither . maybeToEither err---- Various helpers---- | Applies a function to only one element of a list defined by its index.  If--- the index is out of the bounds of the list, the original list is returned.-updateIndex :: Int      -- ^ index of the element to change-            -> [a]      -- ^ list of elements-            -> (a -> a) -- ^ function to apply-            -> [a]      -- ^ result with one element changed-updateIndex i xs f-    | i < 0 || i >= length xs = xs-    | otherwise = l ++ (f h : r)-  where-    (l,h:r) = splitAt i xs---- | Use the list @[b]@ as a template and try to match the elements of @[a]@--- against it. For each element of @[b]@ return the (first) matching element of--- @[a]@, or 'Nothing'. Output list has same size as @[b]@ and contains results--- in same order. Elements of @[a]@ can only appear once.-matchTemplate :: [a]              -- ^ input list-              -> [b]              -- ^ list to serve as a template-              -> (a -> b -> Bool) -- ^ comparison function-              -> [Maybe a]-matchTemplate [] bs _ = replicate (length bs) Nothing-matchTemplate _  [] _ = []-matchTemplate as (b:bs) f = case break (`f` b) as of-    (l,r:rs) -> Just r  : matchTemplate (l ++ rs) bs f-    _        -> Nothing : matchTemplate as bs f---- | Returns the first value of a triple.-fst3 :: (a,b,c) -> a-fst3 (a,_,_) = a---- | Returns the second value of a triple.-snd3 :: (a,b,c) -> b-snd3 (_,b,_) = b---- | Returns the last value of a triple.-lst3 :: (a,b,c) -> c-lst3 (_,_,c) = c---- | Field label goes lowercase and first @n@ characters get removed.-dropFieldLabel :: Int -> Options-dropFieldLabel n = defaultOptions-    { fieldLabelModifier = map toLower . drop n-    }---- | Transformation from 'dropFieldLabel' is applied with argument @f@, plus--- constructor tags are lowercased and first @c@ characters removed. @tag@ is--- used as the name of the object field name that will hold the transformed--- constructor tag as its value.-dropSumLabels :: Int -> Int -> String -> Options-dropSumLabels c f tag = (dropFieldLabel f)-    { constructorTagModifier = map toLower . drop c-    , sumEncoding = defaultTaggedObject { tagFieldName = tag }-    }---- | Convert from one power-of-two base to another, as long as it fits in a--- 'Word'.-convertBits :: Bool -> Int -> Int -> [Word] -> ([Word], Bool)-convertBits pad frombits tobits i = (reverse yout, rem')-  where-    (xacc, xbits, xout) = foldl' outer (0, 0, []) i-    (yout, rem')-        | pad && xbits /= 0 =-            let xout' = (xacc `shiftL` (tobits - xbits)) .&. maxv : xout-            in (xout', False)-        | pad = (xout, False)-        | xbits /= 0 = (xout, True)-        | otherwise = (xout, False)-    maxv = 1 `shiftL` tobits - 1-    max_acc = 1 `shiftL` (frombits + tobits - 1) - 1-    outer (acc, bits, out) it =-        let acc' = ((acc `shiftL` frombits) .|. it) .&. max_acc-            bits' = bits + frombits-            (out', bits'') = inner acc' out bits'-        in (acc', bits'', out')-    inner acc out bits-        | bits >= tobits =-            let bits' = bits - tobits-                out' = ((acc `shiftR` bits') .&. maxv) : out-            in inner acc out' bits'-        | otherwise = (out, bits)
+ test/Haskoin/Address/Bech32Spec.hs view
@@ -0,0 +1,154 @@+{-# LANGUAGE OverloadedStrings #-}+module Haskoin.Address.Bech32Spec+    ( spec+    ) where++import           Control.Monad+import           Data.Bits               (xor)+import           Data.ByteString         (ByteString)+import qualified Data.ByteString         as B+import           Data.Char               (chr, ord, toLower)+import           Data.Maybe+import           Data.String.Conversions+import           Data.Text               (Text, append, pack, snoc, uncons)+import qualified Data.Text               as T+import           Data.Word               (Word8)+import           Haskoin.Address+import           Haskoin.Address.Bech32+import           Haskoin.Util+import           Test.Hspec+import           Test.HUnit++spec = do+    describe "bech32 checksum" $ do+        it "should have valid checksum" $ forM_ validChecksums testValidChecksum+        it "should have invalid checksum" $+            forM_ invalidChecksums testInvalidChecksum+        it "should be a valid address" $ forM_ validAddresses testValidAddress+        it "should be an invalid address" $+            forM_ invalidAddresses testInvalidAddress+        it "should be same for the input in different case" $+            all (== Just "test12hrzfj") . map (flip bech32Encode []) $ hrpCaseVariants+    describe "more encoding/decoding cases" $ do+        it "length > 90" $+            assert $+            isNothing $+            bech32Encode "bc" (replicate 82 (word5 (1 :: Word8)))+        it "segwit version bounds" $+            assert $ isNothing $ segwitEncode "bc" 17 []+        it "segwit prog len version 0" $+            assert $ isNothing $ segwitEncode "bc" 0 (replicate 30 1)+        it "segwit prog len version != 0" $+            assert $ isJust $ segwitEncode "bc" 1 (replicate 30 1)+        it "segwit prog len version != 0" $+            assert $ isNothing $ segwitEncode "bc" 1 (replicate 41 1)+        it "empty HRP encode" $ assert $ isNothing $ bech32Encode "" []+        it "empty HRP encode" $+            assert $ isNothing $ bech32Decode "10a06t8"+        it "hrp lowercased" $+            bech32Encode "HRP" [] `shouldBe` bech32Encode "hrp" []+++testValidChecksum :: Bech32 -> Assertion+testValidChecksum checksum = case bech32Decode checksum of+    Nothing                      -> assertFailure (show checksum)+    Just (resultHRP, resultData) -> do+        -- test that a corrupted checksum fails decoding.+        let (hrp, rest)         = T.breakOnEnd "1" checksum+            Just (first, rest') = uncons rest+            checksumCorrupted   = (hrp `snoc` chr (ord first `xor` 1)) `append` rest'+        assertBool (show checksum ++ " corrupted")+            $ isNothing (bech32Decode checksumCorrupted)+        -- test that re-encoding the decoded checksum results in the same checksum.+        let checksumEncoded  = bech32Encode resultHRP resultData+            expectedChecksum = Just $ T.toLower checksum+        assertEqual (show checksum ++ " re-encode")+                    expectedChecksum+                    checksumEncoded++testInvalidChecksum :: Bech32 -> Assertion+testInvalidChecksum checksum =+    assertBool (show checksum) (isNothing $ bech32Decode checksum)++testValidAddress :: (Text, Text) -> Assertion+testValidAddress (address, hexscript) = do+    let address' = T.toLower address+        hrp      = T.take 2 address'+    case segwitDecode hrp address of+        Nothing                -> assertFailure "decode failed"+        Just (witver, witprog) -> do+            assertEqual (show address)+                        (decodeHex hexscript)+                        (Just $ segwitScriptPubkey witver witprog)+            assertEqual (show address)+                        (Just address')+                        (segwitEncode hrp witver witprog)++testInvalidAddress :: Text -> Assertion+testInvalidAddress address = do+    assertBool (show address) (isNothing $ segwitDecode "bc" address)+    assertBool (show address) (isNothing $ segwitDecode "tb" address)++segwitScriptPubkey :: Word8 -> [Word8] -> ByteString+segwitScriptPubkey witver witprog =+    B.pack $ witver' : fromIntegral (length witprog) : witprog+    where witver' = if witver == 0 then 0 else witver + 0x50++validChecksums :: [Text]+validChecksums =+    [ "A12UEL5L"+    , "an83characterlonghumanreadablepartthatcontainsthenumber1andtheexcludedcharactersbio1tt5tgs"+    , "abcdef1qpzry9x8gf2tvdw0s3jn54khce6mua7lmqqqxw"+    , "11qqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqc8247j"+    , "split1checkupstagehandshakeupstreamerranterredcaperred2y9e3w"+    ]++invalidChecksums :: [Text]+invalidChecksums =+    [ " 1nwldj5"+    , "\DEL1axkwrx"+    , "an84characterslonghumanreadablepartthatcontainsthenumber1andtheexcludedcharactersbio1569pvx"+    , "pzry9x0s0muk"+    , "1pzry9x0s0muk"+    , "x1b4n0q5v"+    , "li1dgmt3"+    , "de1lg7wt\xFF"+    ]++validAddresses :: [(Text, Text)]+validAddresses =+    [ ("BC1QW508D6QEJXTDG4Y5R3ZARVARY0C5XW7KV8F3T4", "0014751e76e8199196d454941c45d1b3a323f1433bd6")+    , ("tb1qrp33g0q5c5txsp9arysrx4k6zdkfs4nce4xj0gdcccefvpysxf3q0sl5k7"+      ,"00201863143c14c5166804bd19203356da136c985678cd4d27a1b8c6329604903262")+    , ("bc1pw508d6qejxtdg4y5r3zarvary0c5xw7kw508d6qejxtdg4y5r3zarvary0c5xw7k7grplx"+      ,"5128751e76e8199196d454941c45d1b3a323f1433bd6751e76e8199196d454941c45d1b3a323f1433bd6")+    , ("BC1SW50QA3JX3S", "6002751e")+    , ("bc1zw508d6qejxtdg4y5r3zarvaryvg6kdaj", "5210751e76e8199196d454941c45d1b3a323")+    , ("tb1qqqqqp399et2xygdj5xreqhjjvcmzhxw4aywxecjdzew6hylgvsesrxh6hy"+      ,"0020000000c4a5cad46221b2a187905e5266362b99d5e91c6ce24d165dab93e86433")+    ]++invalidAddresses :: [Text]+invalidAddresses =+    [ "tc1qw508d6qejxtdg4y5r3zarvary0c5xw7kg3g4ty"+    , "bc1qw508d6qejxtdg4y5r3zarvary0c5xw7kv8f3t5"+    , "BC13W508D6QEJXTDG4Y5R3ZARVARY0C5XW7KN40WF2"+    , "bc1rw5uspcuh"+    , "bc10w508d6qejxtdg4y5r3zarvary0c5xw7kw508d6qejxtdg4y5r3zarvary0c5xw7kw5rljs90"+    , "BC1QR508D6QEJXTDG4Y5R3ZARVARYV98GJ9P"+    , "tb1qrp33g0q5c5txsp9arysrx4k6zdkfs4nce4xj0gdcccefvpysxf3q0sL5k7"+    , "bc1zw508d6qejxtdg4y5r3zarvaryvqyzf3du"+    , "tb1qrp33g0q5c5txsp9arysrx4k6zdkfs4nce4xj0gdcccefvpysxf3pjxtptv"+    , "bc1gmk9yu"+    ]++hrpCaseVariants:: [Text]+hrpCaseVariants = map T.pack hrpTestPermutations++hrpTestPermutations :: [String]+hrpTestPermutations = do+    a <- ['t', 'T']+    b <- ['e', 'E']+    c <- ['s', 'S']+    d <- ['t', 'T']+    return [a, b, c, d]
+ test/Haskoin/Address/CashAddrSpec.hs view
@@ -0,0 +1,280 @@+{-# LANGUAGE OverloadedStrings #-}+module Haskoin.Address.CashAddrSpec (spec) where++import           Control.Monad+import qualified Data.ByteString.Char8    as C+import           Data.Maybe+import           Data.String.Conversions+import           Data.Text                (Text)+import           Haskoin.Address+import           Haskoin.Address.CashAddr+import           Haskoin.Constants+import           Haskoin.Util+import           Test.Hspec+import           Test.HUnit++spec :: Spec+spec = do+    describe "cashaddr checksum test vectors" $ do+        it "prefix:x64nx6hz" $ do+            let mpb = cash32decode "prefix:x64nx6hz"+            mpb `shouldBe` Just ("prefix", "")+        it "p:gpf8m4h7" $ do+            let mpb = cash32decode "p:gpf8m4h7"+            mpb `shouldBe` Just ("p", "")+        it "bitcoincash:qpzry9x8gf2tvdw0s3jn54khce6mua7lcw20ayyn" $ do+            let mpb =+                    cash32decode+                        "bitcoincash:qpzry9x8gf2tvdw0s3jn54khce6mua7lcw20ayyn"+            mpb `shouldBe`+                Just+                    ( "bitcoincash"+                    , "\NULD2\DC4\199BT\182\&5\207\132e:V\215\198u\190w\223")+        it "bchtest:testnetaddress4d6njnut" $ do+            let mpb = cash32decode "bchtest:testnetaddress4d6njnut"+            mpb `shouldBe` Just ("bchtest", "^`\185\229}kG\152")+        it "bchreg:555555555555555555555555555555555555555555555udxmlmrz" $ do+            let mpb =+                    cash32decode+                        "bchreg:555555555555555555555555555555555555555555555udxmlmrz"+            mpb `shouldBe`+                Just+                    ( "bchreg"+                    , "\165)JR\148\165)JR\148\165)JR\148\165)JR\148\165)JR\148\165)J")+    describe "cashaddr to base58 translation test vectors" $ do+        it "1BpEi6DfDAUFd7GtittLSdBeYJvcoaVggu" $ do+            let addr =+                    addrToString bch =<<+                    stringToAddr btc "1BpEi6DfDAUFd7GtittLSdBeYJvcoaVggu"+            addr `shouldBe`+                Just "bitcoincash:qpm2qsznhks23z7629mms6s4cwef74vcwvy22gdx6a"+        it "1KXrWXciRDZUpQwQmuM1DbwsKDLYAYsVLR" $ do+            let addr =+                    addrToString bch =<<+                    stringToAddr btc "1KXrWXciRDZUpQwQmuM1DbwsKDLYAYsVLR"+            addr `shouldBe`+                Just "bitcoincash:qr95sy3j9xwd2ap32xkykttr4cvcu7as4y0qverfuy"+        it "16w1D5WRVKJuZUsSRzdLp9w3YGcgoxDXb" $ do+            let addr =+                    addrToString bch =<<+                    stringToAddr btc "16w1D5WRVKJuZUsSRzdLp9w3YGcgoxDXb"+            addr `shouldBe`+                Just "bitcoincash:qqq3728yw0y47sqn6l2na30mcw6zm78dzqre909m2r"+        it "3CWFddi6m4ndiGyKqzYvsFYagqDLPVMTzC" $ do+            let addr =+                    addrToString bch =<<+                    stringToAddr btc "3CWFddi6m4ndiGyKqzYvsFYagqDLPVMTzC"+            addr `shouldBe`+                Just "bitcoincash:ppm2qsznhks23z7629mms6s4cwef74vcwvn0h829pq"+        it "3LDsS579y7sruadqu11beEJoTjdFiFCdX4" $ do+            let addr =+                    addrToString bch =<<+                    stringToAddr btc "3LDsS579y7sruadqu11beEJoTjdFiFCdX4"+            addr `shouldBe`+                Just "bitcoincash:pr95sy3j9xwd2ap32xkykttr4cvcu7as4yc93ky28e"+        it "31nwvkZwyPdgzjBJZXfDmSWsC4ZLKpYyUw" $ do+            let addr =+                    addrToString bch =<<+                    stringToAddr btc "31nwvkZwyPdgzjBJZXfDmSWsC4ZLKpYyUw"+            addr `shouldBe`+                Just "bitcoincash:pqq3728yw0y47sqn6l2na30mcw6zm78dzq5ucqzc37"+    describe "base58 to cashaddr translation test vectors" $ do+        it "bitcoincash:qpm2qsznhks23z7629mms6s4cwef74vcwvy22gdx6a" $ do+            let addr =+                    addrToString btc =<<+                    stringToAddr+                        bch+                        "bitcoincash:qpm2qsznhks23z7629mms6s4cwef74vcwvy22gdx6a"+            addr `shouldBe` Just "1BpEi6DfDAUFd7GtittLSdBeYJvcoaVggu"+        it "bitcoincash:qr95sy3j9xwd2ap32xkykttr4cvcu7as4y0qverfuy" $ do+            let addr =+                    addrToString btc =<<+                    stringToAddr+                        bch+                        "bitcoincash:qr95sy3j9xwd2ap32xkykttr4cvcu7as4y0qverfuy"+            addr `shouldBe` Just "1KXrWXciRDZUpQwQmuM1DbwsKDLYAYsVLR"+        it "bitcoincash:qqq3728yw0y47sqn6l2na30mcw6zm78dzqre909m2r" $ do+            let addr =+                    addrToString btc =<<+                    stringToAddr+                        bch+                        "bitcoincash:qqq3728yw0y47sqn6l2na30mcw6zm78dzqre909m2r"+            addr `shouldBe` Just "16w1D5WRVKJuZUsSRzdLp9w3YGcgoxDXb"+        it "bitcoincash:ppm2qsznhks23z7629mms6s4cwef74vcwvn0h829pq" $ do+            let addr =+                    addrToString btc =<<+                    stringToAddr+                        bch+                        "bitcoincash:ppm2qsznhks23z7629mms6s4cwef74vcwvn0h829pq"+            addr `shouldBe` Just "3CWFddi6m4ndiGyKqzYvsFYagqDLPVMTzC"+        it "bitcoincash:pr95sy3j9xwd2ap32xkykttr4cvcu7as4yc93ky28e" $ do+            let addr =+                    addrToString btc =<<+                    stringToAddr+                        bch+                        "bitcoincash:pr95sy3j9xwd2ap32xkykttr4cvcu7as4yc93ky28e"+            addr `shouldBe` Just "3LDsS579y7sruadqu11beEJoTjdFiFCdX4"+        it "bitcoincash:pqq3728yw0y47sqn6l2na30mcw6zm78dzq5ucqzc37" $ do+            let addr =+                    addrToString btc =<<+                    stringToAddr+                        bch+                        "bitcoincash:pqq3728yw0y47sqn6l2na30mcw6zm78dzq5ucqzc37"+            addr `shouldBe` Just "31nwvkZwyPdgzjBJZXfDmSWsC4ZLKpYyUw"+    describe "cashaddr larger test vectors" $+        forM_ (zip [0 ..] vectors) $ \(i, vec) ->+            it ("cashaddr test vector " <> show (i :: Int)) $ testCashAddr vec++{- Various utilities -}++testCashAddr :: (Int, CashVersion, Cash32, Text) -> Assertion+testCashAddr (len, typ, addr, hex) = do+    let mbs = decodeHex hex+    assertBool "Could not decode hex payload from test vector" (isJust mbs)+    let mlow = cash32decode addr+    assertBool "Could not decode low level address" (isJust 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)+    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 (_, ver, pay) = cash32decodeType addr++-- | All vectors starting with @pref@ had the wrong version in the spec+-- document.+vectors :: [(Int, CashVersion, Text, Text)]+vectors =+    [ ( 20+      , 0+      , "bitcoincash:qr6m7j9njldwwzlg9v7v53unlr4jkmx6eylep8ekg2"+      , "F5BF48B397DAE70BE82B3CCA4793F8EB2B6CDAC9")+    , ( 20+      , 1+      , "bchtest:pr6m7j9njldwwzlg9v7v53unlr4jkmx6eyvwc0uz5t"+      , "F5BF48B397DAE70BE82B3CCA4793F8EB2B6CDAC9")+    , ( 20+      , 1+      , "pref:pr6m7j9njldwwzlg9v7v53unlr4jkmx6ey65nvtks5"+      , "F5BF48B397DAE70BE82B3CCA4793F8EB2B6CDAC9")+    , ( 20+      , 15+      , "prefix:0r6m7j9njldwwzlg9v7v53unlr4jkmx6ey3qnjwsrf"+      , "F5BF48B397DAE70BE82B3CCA4793F8EB2B6CDAC9")+    , ( 24+      , 0+      , "bitcoincash:q9adhakpwzztepkpwp5z0dq62m6u5v5xtyj7j3h2ws4mr9g0"+      , "7ADBF6C17084BC86C1706827B41A56F5CA32865925E946EA")+    , ( 24+      , 1+      , "bchtest:p9adhakpwzztepkpwp5z0dq62m6u5v5xtyj7j3h2u94tsynr"+      , "7ADBF6C17084BC86C1706827B41A56F5CA32865925E946EA")+    , ( 24+      , 1+      , "pref:p9adhakpwzztepkpwp5z0dq62m6u5v5xtyj7j3h2khlwwk5v"+      , "7ADBF6C17084BC86C1706827B41A56F5CA32865925E946EA")+    , ( 24+      , 15+      , "prefix:09adhakpwzztepkpwp5z0dq62m6u5v5xtyj7j3h2p29kc2lp"+      , "7ADBF6C17084BC86C1706827B41A56F5CA32865925E946EA")+    , ( 28+      , 0+      , "bitcoincash:qgagf7w02x4wnz3mkwnchut2vxphjzccwxgjvvjmlsxqwkcw59jxxuz"+      , "3A84F9CF51AAE98A3BB3A78BF16A6183790B18719126325BFC0C075B")+    , ( 28+      , 1+      , "bchtest:pgagf7w02x4wnz3mkwnchut2vxphjzccwxgjvvjmlsxqwkcvs7md7wt"+      , "3A84F9CF51AAE98A3BB3A78BF16A6183790B18719126325BFC0C075B")+    , ( 28+      , 1+      , "pref:pgagf7w02x4wnz3mkwnchut2vxphjzccwxgjvvjmlsxqwkcrsr6gzkn"+      , "3A84F9CF51AAE98A3BB3A78BF16A6183790B18719126325BFC0C075B")+    , ( 28+      , 15+      , "prefix:0gagf7w02x4wnz3mkwnchut2vxphjzccwxgjvvjmlsxqwkc5djw8s9g"+      , "3A84F9CF51AAE98A3BB3A78BF16A6183790B18719126325BFC0C075B")+    , ( 32+      , 0+      , "bitcoincash:qvch8mmxy0rtfrlarg7ucrxxfzds5pamg73h7370aa87d80gyhqxq5nlegake"+      , "3173EF6623C6B48FFD1A3DCC0CC6489B0A07BB47A37F47CFEF4FE69DE825C060")+    , ( 32+      , 1+      , "bchtest:pvch8mmxy0rtfrlarg7ucrxxfzds5pamg73h7370aa87d80gyhqxq7fqng6m6"+      , "3173EF6623C6B48FFD1A3DCC0CC6489B0A07BB47A37F47CFEF4FE69DE825C060")+    , ( 32+      , 1+      , "pref:pvch8mmxy0rtfrlarg7ucrxxfzds5pamg73h7370aa87d80gyhqxq4k9m7qf9"+      , "3173EF6623C6B48FFD1A3DCC0CC6489B0A07BB47A37F47CFEF4FE69DE825C060")+    , ( 32+      , 15+      , "prefix:0vch8mmxy0rtfrlarg7ucrxxfzds5pamg73h7370aa87d80gyhqxqsh6jgp6w"+      , "3173EF6623C6B48FFD1A3DCC0CC6489B0A07BB47A37F47CFEF4FE69DE825C060")+    , ( 40+      , 0+      , "bitcoincash:qnq8zwpj8cq05n7pytfmskuk9r4gzzel8qtsvwz79zdskftrzxtar994cgutavfklv39gr3uvz"+      , "C07138323E00FA4FC122D3B85B9628EA810B3F381706385E289B0B25631197D194B5C238BEB136FB")+    , ( 40+      , 1+      , "bchtest:pnq8zwpj8cq05n7pytfmskuk9r4gzzel8qtsvwz79zdskftrzxtar994cgutavfklvmgm6ynej"+      , "C07138323E00FA4FC122D3B85B9628EA810B3F381706385E289B0B25631197D194B5C238BEB136FB")+    , ( 40+      , 1+      , "pref:pnq8zwpj8cq05n7pytfmskuk9r4gzzel8qtsvwz79zdskftrzxtar994cgutavfklv0vx5z0w3"+      , "C07138323E00FA4FC122D3B85B9628EA810B3F381706385E289B0B25631197D194B5C238BEB136FB")+    , ( 40+      , 15+      , "prefix:0nq8zwpj8cq05n7pytfmskuk9r4gzzel8qtsvwz79zdskftrzxtar994cgutavfklvwsvctzqy"+      , "C07138323E00FA4FC122D3B85B9628EA810B3F381706385E289B0B25631197D194B5C238BEB136FB")+    , ( 48+      , 0+      , "bitcoincash:qh3krj5607v3qlqh5c3wq3lrw3wnuxw0sp8dv0zugrrt5a3kj6ucysfz8kxwv2k53krr7n933jfsunqex2w82sl"+      , "E361CA9A7F99107C17A622E047E3745D3E19CF804ED63C5C40C6BA763696B98241223D8CE62AD48D863F4CB18C930E4C")+    , ( 48+      , 1+      , "bchtest:ph3krj5607v3qlqh5c3wq3lrw3wnuxw0sp8dv0zugrrt5a3kj6ucysfz8kxwv2k53krr7n933jfsunqnzf7mt6x"+      , "E361CA9A7F99107C17A622E047E3745D3E19CF804ED63C5C40C6BA763696B98241223D8CE62AD48D863F4CB18C930E4C")+    , ( 48+      , 1+      , "pref:ph3krj5607v3qlqh5c3wq3lrw3wnuxw0sp8dv0zugrrt5a3kj6ucysfz8kxwv2k53krr7n933jfsunqjntdfcwg"+      , "E361CA9A7F99107C17A622E047E3745D3E19CF804ED63C5C40C6BA763696B98241223D8CE62AD48D863F4CB18C930E4C")+    , ( 48+      , 15+      , "prefix:0h3krj5607v3qlqh5c3wq3lrw3wnuxw0sp8dv0zugrrt5a3kj6ucysfz8kxwv2k53krr7n933jfsunqakcssnmn"+      , "E361CA9A7F99107C17A622E047E3745D3E19CF804ED63C5C40C6BA763696B98241223D8CE62AD48D863F4CB18C930E4C")+    , ( 56+      , 0+      , "bitcoincash:qmvl5lzvdm6km38lgga64ek5jhdl7e3aqd9895wu04fvhlnare5937w4ywkq57juxsrhvw8ym5d8qx7sz7zz0zvcypqscw8jd03f"+      , "D9FA7C4C6EF56DC4FF423BAAE6D495DBFF663D034A72D1DC7D52CBFE7D1E6858F9D523AC0A7A5C34077638E4DD1A701BD017842789982041")+    , ( 56+      , 1+      , "bchtest:pmvl5lzvdm6km38lgga64ek5jhdl7e3aqd9895wu04fvhlnare5937w4ywkq57juxsrhvw8ym5d8qx7sz7zz0zvcypqs6kgdsg2g"+      , "D9FA7C4C6EF56DC4FF423BAAE6D495DBFF663D034A72D1DC7D52CBFE7D1E6858F9D523AC0A7A5C34077638E4DD1A701BD017842789982041")+    , ( 56+      , 1+      , "pref:pmvl5lzvdm6km38lgga64ek5jhdl7e3aqd9895wu04fvhlnare5937w4ywkq57juxsrhvw8ym5d8qx7sz7zz0zvcypqsammyqffl"+      , "D9FA7C4C6EF56DC4FF423BAAE6D495DBFF663D034A72D1DC7D52CBFE7D1E6858F9D523AC0A7A5C34077638E4DD1A701BD017842789982041")+    , ( 56+      , 15+      , "prefix:0mvl5lzvdm6km38lgga64ek5jhdl7e3aqd9895wu04fvhlnare5937w4ywkq57juxsrhvw8ym5d8qx7sz7zz0zvcypqsgjrqpnw8"+      , "D9FA7C4C6EF56DC4FF423BAAE6D495DBFF663D034A72D1DC7D52CBFE7D1E6858F9D523AC0A7A5C34077638E4DD1A701BD017842789982041")+    , ( 64+      , 0+      , "bitcoincash:qlg0x333p4238k0qrc5ej7rzfw5g8e4a4r6vvzyrcy8j3s5k0en7calvclhw46hudk5flttj6ydvjc0pv3nchp52amk97tqa5zygg96mtky5sv5w"+      , "D0F346310D5513D9E01E299978624BA883E6BDA8F4C60883C10F28C2967E67EC77ECC7EEEAEAFC6DA89FAD72D11AC961E164678B868AEEEC5F2C1DA08884175B")+    , ( 64+      , 1+      , "bchtest:plg0x333p4238k0qrc5ej7rzfw5g8e4a4r6vvzyrcy8j3s5k0en7calvclhw46hudk5flttj6ydvjc0pv3nchp52amk97tqa5zygg96mc773cwez"+      , "D0F346310D5513D9E01E299978624BA883E6BDA8F4C60883C10F28C2967E67EC77ECC7EEEAEAFC6DA89FAD72D11AC961E164678B868AEEEC5F2C1DA08884175B")+    , ( 64+      , 1+      , "pref:plg0x333p4238k0qrc5ej7rzfw5g8e4a4r6vvzyrcy8j3s5k0en7calvclhw46hudk5flttj6ydvjc0pv3nchp52amk97tqa5zygg96mg7pj3lh8"+      , "D0F346310D5513D9E01E299978624BA883E6BDA8F4C60883C10F28C2967E67EC77ECC7EEEAEAFC6DA89FAD72D11AC961E164678B868AEEEC5F2C1DA08884175B")+    , ( 64+      , 15+      , "prefix:0lg0x333p4238k0qrc5ej7rzfw5g8e4a4r6vvzyrcy8j3s5k0en7calvclhw46hudk5flttj6ydvjc0pv3nchp52amk97tqa5zygg96ms92w6845"+      , "D0F346310D5513D9E01E299978624BA883E6BDA8F4C60883C10F28C2967E67EC77ECC7EEEAEAFC6DA89FAD72D11AC961E164678B868AEEEC5F2C1DA08884175B")+    ]
+ test/Haskoin/AddressSpec.hs view
@@ -0,0 +1,90 @@+{-# LANGUAGE OverloadedStrings #-}+module Haskoin.AddressSpec (spec) where++import           Data.Aeson+import           Data.Aeson.Types+import           Data.ByteString        (ByteString)+import qualified Data.ByteString        as BS (append, empty, pack)+import           Data.Either            (isRight)+import           Data.Maybe             (fromJust, isJust)+import qualified Data.Serialize         as S+import           Data.Text              (Text)+import           Haskoin.Address+import           Haskoin.Address.Base58+import           Haskoin.Constants+import           Haskoin.Keys           (derivePubKeyI)+import           Haskoin.Test+import           Test.Hspec+import           Test.HUnit             (Assertion, assertBool, assertEqual)+import           Test.QuickCheck++spec :: Spec+spec = do+    let net = btc+    describe "btc address" . it "base58 encodings" $ mapM_ runVector vectors+    describe "btc-test address" $ props btcTest+    describe "bch address" $ props bch+    describe "bch-test address" $ props bchTest+    describe "bch-regtest address" $ props bchRegTest+    describe "json serialization" . it "encodes and decodes address" $+        forAll arbitraryAddress (testCustom (addrFromJSON net) (addrToJSON net))+    describe "witness address vectors" . it "p2sh(pwpkh)" $+        mapM_ testCompatWitness compatWitnessVectors++props :: Network -> Spec+props net = do+    it "encodes and decodes base58 bytestring" $+        property $+        forAll arbitraryBS $ \bs -> decodeBase58 (encodeBase58 bs) == Just bs+    it "encodes and decodes base58 bytestring with checksum" $+        property $+        forAll arbitraryBS $ \bs ->+            decodeBase58Check (encodeBase58Check bs) == Just bs+    it "encodes and decodes address" $+        property $+        forAll arbitraryAddress $ \a ->+            (stringToAddr net =<< addrToString net a) == Just a+    it "shows and reads address" $+        property $ forAll arbitraryAddress $ \a -> read (show a) == a++runVector :: (ByteString, Text, Text) -> Assertion+runVector (bs, e, chk) = do+    assertEqual "encodeBase58" e b58+    assertEqual "encodeBase58Check" chk b58Chk+    assertEqual "decodeBase58" (Just bs) (decodeBase58 b58)+    assertEqual "decodeBase58Check" (Just bs) (decodeBase58Check b58Chk)+  where+    b58    = encodeBase58 bs+    b58Chk = encodeBase58Check bs++vectors :: [(ByteString, Text, Text)]+vectors =+    [ ( BS.empty, "", "3QJmnh" )+    , ( BS.pack [0], "1", "1Wh4bh" )+    , ( BS.pack [0,0,0,0], "1111", "11114bdQda" )+    , ( BS.pack [0,0,1,0,0], "11LUw", "113CUwsFVuo" )+    , ( BS.pack [255], "5Q", "VrZDWwe" )+    , ( BS.pack [0,0,0,0] `BS.append` BS.pack [1..255]+      , "1111cWB5HCBdLjAuqGGReWE3R3CguuwSjw6RHn39s2yuDRTS5NsBgNiFpWgAnEx6VQi8csexkgYw3mdYrMHr8x9i7aEwP8kZ7vccXWqKDvGv3u1GxFKPuAkn8JCPPGDMf3vMMnbzm6Nh9zh1gcNsMvH3ZNLmP5fSG6DGbbi2tuwMWPthr4boWwCxf7ewSgNQeacyozhKDDQQ1qL5fQFUW52QKUZDZ5fw3KXNQJMcNTcaB723LchjeKun7MuGW5qyCBZYzA1KjofN1gYBV3NqyhQJ3Ns746GNuf9N2pQPmHz4xpnSrrfCvy6TVVz5d4PdrjeshsWQwpZsZGzvbdAdN8MKV5QsBDY"+      , "111151KWPPBRzdWPr1ASeu172gVgLf1YfUp6VJyk6K9t4cLqYtFHcMa2iX8S3NJEprUcW7W5LvaPRpz7UG7puBj5STE3nKhCGt5eckYq7mMn5nT7oTTic2BAX6zDdqrmGCnkszQkzkz8e5QLGDjf7KeQgtEDm4UER6DMSdBjFQVa6cHrrJn9myVyyhUrsVnfUk2WmNFZvkWv3Tnvzo2cJ1xW62XDfUgYz1pd97eUGGPuXvDFfLsBVd1dfdUhPwxW7pMPgdWHTmg5uqKGFF6vE4xXpAqZTbTxRZjCDdTn68c2wrcxApm8hq3JX65Hix7VtcD13FF8b7BzBtwjXq1ze6NMjKgUcqpJTN9vt"+      )+    ]++testCustom :: Eq a => (Value -> Parser a) -> (a -> Value) -> a -> Bool+testCustom f g x = parseMaybe f (g x) == Just x++compatWitnessVectors :: [(Network, Text, Text)]+compatWitnessVectors =+    [ ( btcTest+      , "cNUnpYpMsJXYCERYBciJnsWBpcYEFjdcbq6dxj4SskGhs7uHuJ7Q"+      , "2N6PDTueBHvXzW61B4oe5SW1D3v2Z3Vpbvw")+    ]++testCompatWitness :: (Network, Text, Text) -> Assertion+testCompatWitness (net, seckey, addr) = do+    let seckeyM = fromWif net seckey+    assertBool "decode seckey" (isJust seckeyM)+    let pubkey = derivePubKeyI (fromJust seckeyM)+    let addrM = addrToString btcTest (pubKeyCompatWitnessAddr pubkey)+    assertBool "address can be encoded" (isJust addrM)+    assertEqual "witness address matches" addr (fromJust addrM)
+ test/Haskoin/BlockSpec.hs view
@@ -0,0 +1,359 @@+{-# LANGUAGE OverloadedStrings #-}+module Haskoin.BlockSpec+    ( spec+    ) where++import           Control.Monad.State.Strict+import           Data.Aeson                 as A+import           Data.Either                (fromRight)+import           Data.Map.Strict            (singleton)+import           Data.Maybe                 (fromJust)+import           Data.Serialize             as S+import           Data.String                (fromString)+import           Data.String.Conversions    (cs)+import           Data.Text                  (Text)+import           Haskoin.Block+import           Haskoin.Block.Headers+import           Haskoin.Block.Merkle+import           Haskoin.Constants+import           Haskoin.Test+import           Haskoin.Transaction+import           Test.Hspec+import           Test.HUnit                 hiding (State)+import           Test.QuickCheck++myTime :: Timestamp+myTime = 1499083075++withChain :: Network -> State HeaderMemory a -> a+withChain net f = evalState f (initialChain net)++chain :: BlockHeaders m => Network -> BlockHeader -> Int -> m ()+chain net bh i = do+    bnsE <- connectBlocks net myTime bhs+    either error (const $ return ()) bnsE+  where+    bhs = appendBlocks net 6 bh i++spec :: Spec+spec = do+    let net = bchRegTest+    describe "blockchain headers" $ do+        it "gets best block" $+            let bb =+                    withChain net $ do+                        chain net (getGenesisHeader net) 100+                        getBestBlockHeader+             in nodeHeight bb `shouldBe` 100+        it "builds a block locator" $+            let loc =+                    withChain net $ do+                        chain net (getGenesisHeader net) 100+                        bb <- getBestBlockHeader+                        blockLocatorNodes bb+                heights = map nodeHeight loc+             in heights `shouldBe` [100,99 .. 90] <> [88, 84, 76, 60, 28, 0]+        it "follows split chains" $+            let bb = withChain net $ splitChain net >> getBestBlockHeader+             in nodeHeight bb `shouldBe` 4035+    describe "block hash" $ do+        it "encodes and decodes block hash" $+            property $+            forAll arbitraryBlockHash $ \h ->+                hexToBlockHash (blockHashToHex h) == Just h+        it "from string block hash" $+            property $+            forAll arbitraryBlockHash $ \h ->+                fromString (cs $ blockHashToHex h) == h+        it "show and read block hash" $+            property $ forAll arbitraryBlockHash $ \h -> read (show h) == h+        it "json block hash" $ property $ forAll arbitraryBlockHash testID+    describe "merkle trees" $ do+        let net' = btc+        it "builds tree of right width at height 1" $ property testTreeWidth+        it "builds tree of right width at height 0" $ property testBaseWidth+        it "builds and extracts partial merkle tree" $+            property $+            forAll+                (listOf1 ((,) <$> arbitraryTxHash <*> arbitrary))+                (buildExtractTree net')+        it "merkle root test vectors" $+            mapM_ runMerkleVector merkleVectors+    describe "compact number" $ do+        it "compact number local vectors" testCompact+        it "compact number imported vectors" testCompactBitcoinCore+    describe "block serialization" $ do+        it "encodes and decodes block" $+            property $ forAll (arbitraryBlock net) cerealID+        it "encodes and decodes block JSON" $+            property $ forAll (arbitraryBlock net) testID+        it "encodes and decodes block header" $+            property $ forAll arbitraryBlockHeader cerealID+        it "encodes and decodes block header JSON" $+            property $ forAll arbitraryBlockHeader testID+        it "encodes and decodes getblocks" $+            property $ forAll arbitraryGetBlocks cerealID+        it "encodes and decodes getheaders" $+            property $ forAll arbitraryGetHeaders cerealID+        it "encodes and decdoes headers" $+            property $ forAll arbitraryHeaders cerealID+        it "encodes and decodes merkle block" $+            property $ forAll arbitraryMerkleBlock cerealID+    describe "helper functions" $ do+        it "computes bitcoin block subsidy correctly" (testSubsidy btc)+        it "computes regtest block subsidy correctly" (testSubsidy btcRegTest)++-- 0 → → 2015 → → → → → → → 4031+--       ↓+--       → → 2035 → → → → → → 4035*+--           ↓+--           → → 2185+splitChain :: Network -> State HeaderMemory ()+splitChain net = do+    start <- go 1 (getGenesisHeader net) 2015+    e 2015 (head start)+    tail1 <- go 2 (nodeHeader $ head start) 2016+    e 4031 (head tail1)+    tail2 <- go 3 (nodeHeader $ head start) 20+    e 2035 (head tail2)+    tail3 <- go 4 (nodeHeader $ head tail2) 2000+    e 4035 (head tail3)+    tail4 <- go 5 (nodeHeader $ head tail2) 150+    e 2185 (head tail4)+    sp1 <- splitPoint (head tail1) (head tail3)+    unless (sp1 == head start) $+        error $+        "Split point wrong between blocks 4031 and 4035: " +++        show (nodeHeight sp1)+    sp2 <- splitPoint (head tail4) (head tail3)+    unless (sp2 == head tail2) $+        error $+        "Split point wrong between blocks 2185 and 4035: " +++        show (nodeHeight sp2)+  where+    e n bn =+        unless (nodeHeight bn == n) $+        error $+        "Node height " +++        show (nodeHeight bn) ++ " of first chunk should be " ++ show n+    go seed start n = do+        let bhs = appendBlocks net seed start n+        bnE <- connectBlocks net myTime bhs+        case bnE of+            Right bn -> return bn+            Left ex  -> error ex++{- Merkle Trees -}++testTreeWidth :: Int -> Property+testTreeWidth i = i /= 0 ==> calcTreeWidth (abs i) (calcTreeHeight $ abs i) == 1++testBaseWidth :: Int -> Property+testBaseWidth i = i /= 0 ==> calcTreeWidth (abs i) 0 == abs i++buildExtractTree :: Network -> [(TxHash, Bool)] -> Bool+buildExtractTree net txs =+    r == buildMerkleRoot (map fst txs) && m == map fst (filter snd txs)+  where+    (f, h) = buildPartialMerkle txs+    (r, m) =+        fromRight (error "Could not extract matches from Merkle tree") $+        extractMatches net f h (length txs)++testCompact :: Assertion+testCompact = do+    assertEqual "vector 1" 0x05123456 (encodeCompact 0x1234560000)+    assertEqual "vector 2" (0x1234560000, False) (decodeCompact 0x05123456)+    assertEqual "vector 3" 0x0600c0de (encodeCompact 0xc0de000000)+    assertEqual "vector 4" (0xc0de000000, False) (decodeCompact 0x0600c0de)+    assertEqual "vector 5" 0x05c0de00 (encodeCompact (-0x40de000000))+    assertEqual "vector 6" (-0x40de000000, False) (decodeCompact 0x05c0de00)++testCompactBitcoinCore :: Assertion+testCompactBitcoinCore = do+    assertEqual "zero" (0, False) (decodeCompact 0x00000000)+    assertEqual+        "zero (encode · decode)"+        0x00000000+        (encodeCompact . fst $ decodeCompact 0x00000000)+    assertEqual "rounds to zero" (0, False) (decodeCompact 0x00123456)+    assertEqual "rounds to zero" (0, False) (decodeCompact 0x01003456)+    assertEqual "rounds to zero" (0, False) (decodeCompact 0x02000056)+    assertEqual "rounds to zero" (0, False) (decodeCompact 0x03000000)+    assertEqual "rounds to zero" (0, False) (decodeCompact 0x04000000)+    assertEqual "rounds to zero" (0, False) (decodeCompact 0x00923456)+    assertEqual "rounds to zero" (0, False) (decodeCompact 0x01803456)+    assertEqual "rounds to zero" (0, False) (decodeCompact 0x02800056)+    assertEqual "rounds to zero" (0, False) (decodeCompact 0x03800000)+    assertEqual "rounds to zero" (0, False) (decodeCompact 0x04800000)+    assertEqual "vector 1 (decode)" (0x12, False) (decodeCompact 0x01123456)+    assertEqual+        "vector 1 (encode · decode)"+        0x01120000+        (encodeCompact . fst $ decodeCompact 0x01123456)+    assertEqual "0x80 bit set" 0x02008000 (encodeCompact 0x80)+    assertEqual+        "vector 2 (negative) (decode)"+        (-0x7e, False)+        (decodeCompact 0x01fedcba)+    assertEqual+        "vector 2 (negative) (encode · decode)"+        0x01fe0000+        (encodeCompact . fst $ decodeCompact 0x01fedcba)+    assertEqual "vector 3 (decode)" (0x1234, False) (decodeCompact 0x02123456)+    assertEqual+        "vector 3 (encode · decode)"+        0x02123400+        (encodeCompact . fst $ decodeCompact 0x02123456)+    assertEqual "vector 4 (decode)" (0x123456, False) (decodeCompact 0x03123456)+    assertEqual+        "vector 4 (encode · decode)"+        0x03123456+        (encodeCompact . fst $ decodeCompact 0x03123456)+    assertEqual+        "vector 5 (decode)"+        (0x12345600, False)+        (decodeCompact 0x04123456)+    assertEqual+        "vector 5 (encode · decode)"+        0x04123456+        (encodeCompact . fst $ decodeCompact 0x04123456)+    assertEqual+        "vector 6 (decode)"+        (-0x12345600, False)+        (decodeCompact 0x04923456)+    assertEqual+        "vector 6 (encode · decode)"+        0x04923456+        (encodeCompact . fst $ decodeCompact 0x04923456)+    assertEqual+        "vector 7 (decode)"+        (0x92340000, False)+        (decodeCompact 0x05009234)+    assertEqual+        "vector 7 (encode · decode)"+        0x05009234+        (encodeCompact . fst $ decodeCompact 0x05009234)+    assertEqual+        "vector 8 (decode)"+        ( 0x1234560000000000000000000000000000000000000000000000000000000000+        , False)+        (decodeCompact 0x20123456)+    assertEqual+        "vector 8 (encode · decode)"+        0x20123456+        (encodeCompact . fst $ decodeCompact 0x20123456)+    assertBool "vector 9 (decode) (overflow)" (snd $ decodeCompact 0xff123456)+    assertBool+        "vector 9 (decode) (positive)"+        ((> 0) . fst $ decodeCompact 0xff123456)++runMerkleVector :: (Text, [Text]) -> Assertion+runMerkleVector (r, hs) =+    assertBool "merkle vector" $+        buildMerkleRoot (map f hs) == getTxHash (f r)+  where+    f = fromJust . hexToTxHash++merkleVectors :: [(Text, [Text])]+merkleVectors =+      -- Block 000000000000cd7e8cf6510303dde76121a1a791c15dba0be4be7022b07cf9e1+    [ ( "fb6698ac95b754256c5e71b4fbe07638cb6ca83ee67f44e181b91727f09f4b1f"+      , [ "dd96fdcfaec994bf583af650ff6022980ee0ba1686d84d0a3a2d24eabf34bc52"+        , "1bc216f786a564378710ae589916fc8e092ddfb9f24fe6c47b733550d476d5d9"+        , "a1db0b0194426064b067899ff2d975fb277fd52dbb1a38370800c76dd6503d41"+        , "d69f7fb0e668fbd437d1bf5211cc34d7eb8746f50cfddf705fe10bc2f8f7035f"+        , "5b4057cd80be7df5ed2ac42b776897ed3c26e3a01e4072075b8129c587094ef6"+        , "ed6dabcfba0ef43c50d89a8a0e4b236b1bc6585d4c3bbf49728b55f44312d6bc"+        , "056aaa9a3c635909c794e9b0acc7dccb0456c59a84c6b08417335bee4515e3d3"+        , "05bae5f1d1c874171692e1fc06f664e63eb143d3f096601ef938e4a9012eee66"+        , "b5e48e94e3f2fba197b3f591e01f47e185d7834d669529d44078e41c671aab0f"+        , "3b56aeadfc0c5484fd507bc89f13f2e5f61c42e0a4ae9062eda9a9aeef7db6a4"+        , "2affa187e1ebb94a2a86578b9f64951e854ff3d346fef259acfb6d0f5212e0d3"+        ]+      )+      -- Block 00000000000007cc4b6f07bfed72bccc1ed8dd031a93969a4c22211f784457d4+    , ( "886fea311d2dc64c315519f2d647e43998d780d2170f77e53dc0d85bf2ee680c"+      , [ "c9c9e5211512629fd111cc071d745b8c79bf486b4ea95489eb5de08b5d786b8e"+        , "20beb0ee30dfd323ade790ce9a46ae7a174f9ea44ce22a17c4d4eb23b7016f51"+        , "d4cb7dd741e78a8f57e12f6c8ddb0361ff2a5bf9365bd7d7df761060847daf9a"+        , "ddbfa6fdd29d4b47aeaadf82a4bf0a93d58cd7d8401fabf860a1ae8eeb51f42e"+        , "9d82bafe44abee248b968c86f165051c8413482c232659795335c52922dab471"+        , "86035372d31b53efd848cea7231aa9738c209aff64d3c59b1619341afb5b6ba3"+        , "11e7a7393d9658813dfaebc04fa6d4b73bac8d641bffa7067da879523d43d030"+        , "2f676b9aa5bc0ebf3395032c84c466e40cac29f80434cd1138e31c2d0fcc5c13"+        , "37567d559fbfae07fda9a90de0ce30b202128bc8ebdfef5ad2b53e865a3478c2"+        , "0b8e6c1200c454361e94e261738429e9c9b8dcffd85ec8511bbf5dc7e2e0ada8"+        ]+      )+      -- Block 00000000839a8e6886ab5951d76f411475428afc90947ee320161bbf18eb6048+    , ( "0e3e2357e806b6cdb1f70b54c3a3a17b6714ee1f0e68bebb44a74b1efd512098"+      , [ "0e3e2357e806b6cdb1f70b54c3a3a17b6714ee1f0e68bebb44a74b1efd512098" ]+      )+      -- Block 000000000004d160ac1f7b775d7c1823345aeadd5fcb29ca2ad2403bb7babd4c+    , ( "aae018650f513fc42d55b2210ec3ceeeb194fb1261d37989de07451fc0cbac5c"+      , [ "a4454f22831acd7904a9902c5070a3ee4bf4c2b13bc6b2dc66735dd3c4414028"+        , "45297f334278885108dd38a0b689ed95a4373dd3f7e4413e6aebdc2654fb771b"+        ]+      )+      -- Block 000000000001d1b13a7e86ddb20da178f20d6da5cd037a29c2a15b8b84cc774e+    , ( "ca3580505feb87544760ac14a5859659e23be05f765bbed9f86a3c9aad1a5d0c"+      , [ "60702384c6e9d34ff03c2b3e726bdc649befe603216815bd0a2974921d0d9549"+        , "11f40f58941d2a81a1616a3b84b7dd8b9d07e68750827de488c11a18f54220bb"+        , "d78e82527aa8cf16e375010bc666362c0258d3c0da1885a1871121706da8b633"+        ]+      )+      -- Block 0000000000000630a4e2266a31776e952a19b7c99a6387917d9de9032f608021+    , ( "dcce8be0a9a41e7bb726c5b49d957d90b5308e3dc5dce070ccbc8996e265a6c2"+      , [ "c0f58ff12cd1023b05f8f7035cc62bf50958ddb216a4e0eb5471deb7ef25fe81"+        , "24e5bbf9008641b8fcf3d076fef66c28c695362ba9f6a6042f8275a98414ee92"+        , "e8e1f72abad5e34dabc0f6de46a484b17a9af857d1c41de19482fadf6f7f4b27"+        , "540e4d34d9fd9e5ec02853054be7ad9260379bc23388489049cca1b0f7cf518a"+        , "324444835c5fe0545f98c4240011b75e6ea1bb76f41829e4cfbe7f75b6cee924"+        , "e7d31437ac21bceb0c222a82b2723e2b8a7654147e33397679f041537022a4b2"+        , "a8b5768d8b33525ee89d546a6a6897f8e42ba9d56a2c5e871a5d2ab40258dc95"+        , "7ba712b31bae8d45810a5cda3838c7e7fb9abd6e88bb4b3ee79be9ea2f714bb4"+        , "2ae1c4d927b06edaa626b230976ad8062bbae24da9378d1de2409da5ab08a26d"+        , "3c417dc8087d6878003624b74431e17fec9ca761389034b1b1e0f32cbfb11f4f"+        , "de6de7beae8d8c98c7d46b4409d5460e58e3204d8b4caed256c7471998595909"+        , "c7c3c211402b7c4379f7b01fadc67260ee58d11e8d0bcce3d68cb45f3467e99d"+        , "77aa2717e727a096d81074bd46ae59462692d20a1acc1a01b2535518ae5aeb53"+        , "4859a710bb673aca46208bbd59d1000ae990dafff5f70b56f0853aeeaea3948b"+        , "38deca6991988e461b83aa0d49ffef0f304c4b760371682d152eeb8c56a48174"+        , "648f4f50dada3574e2dfe2dc68956b01dd97d543859a3540bbe1ef5418d0e494"+        , "9cd7be42c2f0cd8bf38738c162cd05108e213ec7958bf2571cb627872963f5c4"+        , "6740e0dd8b97e23864af41839fc197238d2f0dbefce9a82c657556be65c465fa"+        , "f75c2e4b70db4b0aabc44b77af1ae75d305340fcf6e7b5f806ddcba4aa42b55d"+        , "e125c488636749da68e6696b97525a77146c0777c7946927e37afd513d74a4e6"+        , "c20526f119aea10880af631eba7f0b60385a22e0b0c402fe8508d41952e58be9"+        , "6456c023c7e245f5c57a168633a23f57f4fadb651115f807694a6bed14ae3b55"+        , "98b26e364e2888c9f264e4b5e13103c89608609774eb07ce933d8a2a45d19776"+        , "2efaa4f167bb65ba5684f8076cd9279fd67fd9c67388c8862809bab5542e637d"+        , "ec44eeb84d8d976d77079a822710b4dfdb11a2d9a03d8cc00bab0ae424e84666"+        , "410730d9f807d81ac48b8eafac6f1d36642c1c370241b367a35f0bac6ac7c05f"+        , "e95a7d0d477fd3db22756a3fd390a50c7bc48dc9e946fea9d24bd0866b3bb0e9"+        , "a72fec99d14939216628aaf7a0afc4c017113bcae964e777e6b508864eeaacc4"+        , "8548433310fcf75dbbc042121e8318c678e0a017534786dd322a91cebe8d213f"+        ]+      )+    ]++testID :: (FromJSON a, ToJSON a, Eq a) => a -> Bool+testID x =+    (A.decode . A.encode) (singleton ("object" :: String) x) ==+    Just (singleton ("object" :: String) x)++cerealID :: (Serialize a, Eq a) => a -> Bool+cerealID x = S.decode (S.encode x) == Right x++testSubsidy :: Network -> Assertion+testSubsidy net = go (2 * 50 * 100 * 1000 * 1000) 0+  where+    go previous_subsidy halvings = do+        let height = halvings * getHalvingInterval net+            subsidy = computeSubsidy net height+        if halvings >= 64+            then subsidy `shouldBe` 0+            else do+                subsidy `shouldBe` (previous_subsidy `div` 2)+                go subsidy (halvings + 1)
+ test/Haskoin/Crypto/HashSpec.hs view
@@ -0,0 +1,1269 @@+{-# LANGUAGE OverloadedStrings #-}+module Haskoin.Crypto.HashSpec (spec) where++import           Data.ByteString         (ByteString)+import           Data.Map.Strict         (singleton)+import           Data.Maybe              (fromJust)+import           Data.Serialize          as S+import           Data.String             (fromString)+import           Data.String.Conversions+import           Haskoin.Block+import           Haskoin.Crypto+import           Haskoin.Test+import           Haskoin.Util+import           Test.Hspec+import           Test.HUnit              (Assertion, assertBool)+import           Test.QuickCheck++-- Test vectors from NIST+-- http://csrc.nist.gov/groups/STM/cavp/documents/drbg/drbgtestvectors.zip+-- About 1/3 of HMAC DRBG SHA-256 test vectors are tested here++spec :: Spec+spec =+    describe "hash" $ do+        it "join512( split512(h) ) == h" $+            property $+            forAll arbitraryHash256 $ forAll arbitraryHash256 . joinSplit512+        it "decodeCompact . encodeCompact i == i" $ property decEncCompact+        it "from string 64-byte hash" $+            property $+            forAll arbitraryHash512 $ \h ->+                fromString (cs $ encodeHex $ encode h) == h+        it "from string 32-byte hash" $+            property $+            forAll arbitraryHash256 $ \h ->+                fromString (cs $ encodeHex $ encode h) == h+        it "from string 20-byte hash" $+            property $+            forAll arbitraryHash160 $ \h ->+                fromString (cs $ encodeHex $ encode h) == h+        it "encodes and decodes bytestring" $+            property $ forAll arbitraryBS cerealID+        it "encodes and decodes hash160" $+            property $ forAll arbitraryHash160 cerealID+        it "encodes and decodes hash256" $+            property $ forAll arbitraryHash256 cerealID+        it "encodes and decodes hash512" $+            property $ forAll arbitraryHash512 cerealID++type TestVector = [ByteString]++{-+    [SHA-256]+    [PredictionResistance = False]+    [EntropyInputLen = 256]+    [NonceLen = 128]+    [PersonalizationStringLen = 0]+    [AdditionalInputLen = 0]+    [ReturnedBitsLen = 1024]+-}++joinSplit512 :: Hash256 -> Hash256 -> Bool+joinSplit512 a b = split512 (join512 (a, b)) == (a, b)++-- After encoding and decoding, we may loose precision so the new result is >=+-- to the old one.+decEncCompact :: Integer -> Bool+decEncCompact i+    -- Integer completely fits inside the mantisse+    | abs i <= 0x007fffff = decodeCompact (encodeCompact i) == (i, False)+    -- Otherwise precision will be lost and the decoded result will+    -- be smaller than the original number+    | i >= 0              = fst (decodeCompact (encodeCompact i)) < i+    | otherwise           = fst (decodeCompact (encodeCompact i)) > i++cerealID :: (Serialize a, Eq a) => a -> Bool+cerealID x = decode (encode x) == Right x++t1 :: [TestVector]+t1 =+    [+    -- COUNT = 0+    [ "ca851911349384bffe89de1cbdc46e6831e44d34a4fb935ee285dd14b71a7488"+    , "659ba96c601dc69fc902940805ec0ca8"+    , ""+    , ""+    , ""+    , "e528e9abf2dece54d47c7e75e5fe302149f817ea9fb4bee6f4199697d04d5b89d54fbb978a15b5c443c9ec21036d2460b6f73ebad0dc2aba6e624abf07745bc107694bb7547bb0995f70de25d6b29e2d3011bb19d27676c07162c8b5ccde0668961df86803482cb37ed6d5c0bb8d50cf1f50d476aa0458bdaba806f48be9dcb8"+    ],+    -- COUNT = 1+    [ "79737479ba4e7642a221fcfd1b820b134e9e3540a35bb48ffae29c20f5418ea3"+    , "3593259c092bef4129bc2c6c9e19f343"+    , ""+    , ""+    , ""+    , "cf5ad5984f9e43917aa9087380dac46e410ddc8a7731859c84e9d0f31bd43655b924159413e2293b17610f211e09f770f172b8fb693a35b85d3b9e5e63b1dc252ac0e115002e9bedfb4b5b6fd43f33b8e0eafb2d072e1a6fee1f159df9b51e6c8da737e60d5032dd30544ec51558c6f080bdbdab1de8a939e961e06b5f1aca37"+    ],+    -- COUNT = 2+    [ "b340907445b97a8b589264de4a17c0bea11bb53ad72f9f33297f05d2879d898d"+    , "65cb27735d83c0708f72684ea58f7ee5"+    , ""+    , ""+    , ""+    , "75183aaaf3574bc68003352ad655d0e9ce9dd17552723b47fab0e84ef903694a32987eeddbdc48efd24195dbdac8a46ba2d972f5808f23a869e71343140361f58b243e62722088fe10a98e43372d252b144e00c89c215a76a121734bdc485486f65c0b16b8963524a3a70e6f38f169c12f6cbdd169dd48fe4421a235847a23ff"+    ],+    -- COUNT = 3+    [ "8e159f60060a7d6a7e6fe7c9f769c30b98acb1240b25e7ee33f1da834c0858e7"+    , "c39d35052201bdcce4e127a04f04d644"+    , ""+    , ""+    , ""+    , "62910a77213967ea93d6457e255af51fc79d49629af2fccd81840cdfbb4910991f50a477cbd29edd8a47c4fec9d141f50dfde7c4d8fcab473eff3cc2ee9e7cc90871f180777a97841597b0dd7e779eff9784b9cc33689fd7d48c0dcd341515ac8fecf5c55a6327aea8d58f97220b7462373e84e3b7417a57e80ce946d6120db5"+    ],+    -- COUNT = 4+    [ "74755f196305f7fb6689b2fe6835dc1d81484fc481a6b8087f649a1952f4df6a"+    , "c36387a544a5f2b78007651a7b74b749"+    , ""+    , ""+    , ""+    , "b2896f3af4375dab67e8062d82c1a005ef4ed119d13a9f18371b1b873774418684805fd659bfd69964f83a5cfe08667ddad672cafd16befffa9faed49865214f703951b443e6dca22edb636f3308380144b9333de4bcb0735710e4d9266786342fc53babe7bdbe3c01a3addb7f23c63ce2834729fabbd419b47beceb4a460236"+    ],+    -- COUNT = 5+    [ "4b222718f56a3260b3c2625a4cf80950b7d6c1250f170bd5c28b118abdf23b2f"+    , "7aed52d0016fcaef0b6492bc40bbe0e9"+    , ""+    , ""+    , ""+    , "a6da029b3665cd39fd50a54c553f99fed3626f4902ffe322dc51f0670dfe8742ed48415cf04bbad5ed3b23b18b7892d170a7dcf3ef8052d5717cb0c1a8b3010d9a9ea5de70ae5356249c0e098946030c46d9d3d209864539444374d8fbcae068e1d6548fa59e6562e6b2d1acbda8da0318c23752ebc9be0c1c1c5b3cf66dd967"+    ],+    -- COUNT = 6+    [ "b512633f27fb182a076917e39888ba3ff35d23c3742eb8f3c635a044163768e0"+    , "e2c39b84629a3de5c301db5643af1c21"+    , ""+    , ""+    , ""+    , "fb931d0d0194a97b48d5d4c231fdad5c61aedf1c3a55ac24983ecbf38487b1c93396c6b86ff3920cfa8c77e0146de835ea5809676e702dee6a78100da9aa43d8ec0bf5720befa71f82193205ac2ea403e8d7e0e6270b366dc4200be26afd9f63b7e79286a35c688c57cbff55ac747d4c28bb80a2b2097b3b62ea439950d75dff"+    ],+    -- COUNT = 7+    [ "aae3ffc8605a975befefcea0a7a286642bc3b95fb37bd0eb0585a4cabf8b3d1e"+    , "9504c3c0c4310c1c0746a036c91d9034"+    , ""+    , ""+    , ""+    , "2819bd3b0d216dad59ddd6c354c4518153a2b04374b07c49e64a8e4d055575dfbc9a8fcde68bd257ff1ba5c6000564b46d6dd7ecd9c5d684fd757df62d85211575d3562d7814008ab5c8bc00e7b5a649eae2318665b55d762de36eba00c2906c0e0ec8706edb493e51ca5eb4b9f015dc932f262f52a86b11c41e9a6d5b3bd431"+    ],+    -- COUNT = 8+    [ "b9475210b79b87180e746df704b3cbc7bf8424750e416a7fbb5ce3ef25a82cc6"+    , "24baf03599c10df6ef44065d715a93f7"+    , ""+    , ""+    , ""+    , "ae12d784f796183c50db5a1a283aa35ed9a2b685dacea97c596ff8c294906d1b1305ba1f80254eb062b874a8dfffa3378c809ab2869aa51a4e6a489692284a25038908a347342175c38401193b8afc498077e10522bec5c70882b7f760ea5946870bd9fc72961eedbe8bff4fd58c7cc1589bb4f369ed0d3bf26c5bbc62e0b2b2"+    ],+    -- COUNT = 9+    [ "27838eb44ceccb4e36210703ebf38f659bc39dd3277cd76b7a9bcd6bc964b628"+    , "39cfe0210db2e7b0eb52a387476e7ea1"+    , ""+    , ""+    , ""+    , "e5e72a53605d2aaa67832f97536445ab774dd9bff7f13a0d11fd27bf6593bfb52309f2d4f09d147192199ea584503181de87002f4ee085c7dc18bf32ce5315647a3708e6f404d6588c92b2dda599c131aa350d18c747b33dc8eda15cf40e95263d1231e1b4b68f8d829f86054d49cfdb1b8d96ab0465110569c8583a424a099a"+    ],+    -- COUNT = 10+    [ "d7129e4f47008ad60c9b5d081ff4ca8eb821a6e4deb91608bf4e2647835373a5"+    , "a72882773f78c2fc4878295840a53012"+    , ""+    , ""+    , ""+    , "0cbf48585c5de9183b7ff76557f8fc9ebcfdfde07e588a8641156f61b7952725bbee954f87e9b937513b16bba0f2e523d095114658e00f0f3772175acfcb3240a01de631c19c5a834c94cc58d04a6837f0d2782fa53d2f9f65178ee9c837222494c799e64c60406069bd319549b889fa00a0032dd7ba5b1cc9edbf58de82bfcd"+    ],+    -- COUNT = 11+    [ "67fe5e300c513371976c80de4b20d4473889c9f1214bce718bc32d1da3ab7532"+    , "e256d88497738a33923aa003a8d7845c"+    , ""+    , ""+    , ""+    , "b44660d64ef7bcebc7a1ab71f8407a02285c7592d755ae6766059e894f694373ed9c776c0cfc8594413eefb400ed427e158d687e28da3ecc205e0f7370fb089676bbb0fa591ec8d916c3d5f18a3eb4a417120705f3e2198154cd60648dbfcfc901242e15711cacd501b2c2826abe870ba32da785ed6f1fdc68f203d1ab43a64f"+    ],+    -- COUNT = 12+    [ "de8142541255c46d66efc6173b0fe3ffaf5936c897a3ce2e9d5835616aafa2cb"+    , "d01f9002c407127bc3297a561d89b81d"+    , ""+    , ""+    , ""+    , "64d1020929d74716446d8a4e17205d0756b5264867811aa24d0d0da8644db25d5cde474143c57d12482f6bf0f31d10af9d1da4eb6d701bdd605a8db74fb4e77f79aaa9e450afda50b18d19fae68f03db1d7b5f1738d2fdce9ad3ee9461b58ee242daf7a1d72c45c9213eca34e14810a9fca5208d5c56d8066bab1586f1513de7"+    ],+    -- COUNT = 13+    [ "4a8e0bd90bdb12f7748ad5f147b115d7385bb1b06aee7d8b76136a25d779bcb7"+    , "7f3cce4af8c8ce3c45bdf23c6b181a00"+    , ""+    , ""+    , ""+    , "320c7ca4bbeb7af977bc054f604b5086a3f237aa5501658112f3e7a33d2231f5536d2c85c1dad9d9b0bf7f619c81be4854661626839c8c10ae7fdc0c0b571be34b58d66da553676167b00e7d8e49f416aacb2926c6eb2c66ec98bffae20864cf92496db15e3b09e530b7b9648be8d3916b3c20a3a779bec7d66da63396849aaf"+    ],+    -- COUNT = 14+    [ "451ed024bc4b95f1025b14ec3616f5e42e80824541dc795a2f07500f92adc665"+    , "2f28e6ee8de5879db1eccd58c994e5f0"+    , ""+    , ""+    , ""+    , "3fb637085ab75f4e95655faae95885166a5fbb423bb03dbf0543be063bcd48799c4f05d4e522634d9275fe02e1edd920e26d9accd43709cb0d8f6e50aa54a5f3bdd618be23cf73ef736ed0ef7524b0d14d5bef8c8aec1cf1ed3e1c38a808b35e61a44078127c7cb3a8fd7addfa50fcf3ff3bc6d6bc355d5436fe9b71eb44f7fd"+    ]+    ]++{-+    [SHA-256]+    [PredictionResistance = False]+    [EntropyInputLen = 256]+    [NonceLen = 128]+    [PersonalizationStringLen = 0]+    [AdditionalInputLen = 256]+    [ReturnedBitsLen = 1024]+-}++t2 :: [TestVector]+t2 =+    [+    -- COUNT = 0+    [ "d3cc4d1acf3dde0c4bd2290d262337042dc632948223d3a2eaab87da44295fbd"+    , "0109b0e729f457328aa18569a9224921"+    , ""+    , "3c311848183c9a212a26f27f8c6647e40375e466a0857cc39c4e47575d53f1f6"+    , "fcb9abd19ccfbccef88c9c39bfb3dd7b1c12266c9808992e305bc3cff566e4e4"+    , "9c7b758b212cd0fcecd5daa489821712e3cdea4467b560ef5ddc24ab47749a1f1ffdbbb118f4e62fcfca3371b8fbfc5b0646b83e06bfbbab5fac30ea09ea2bc76f1ea568c9be0444b2cc90517b20ca825f2d0eccd88e7175538b85d90ab390183ca6395535d34473af6b5a5b88f5a59ee7561573337ea819da0dcc3573a22974"+    ],+    -- COUNT = 1+    [ "f97a3cfd91faa046b9e61b9493d436c4931f604b22f1081521b3419151e8ff06"+    , "11f3a7d43595357d58120bd1e2dd8aed"+    , ""+    , "517289afe444a0fe5ed1a41dbbb5eb17150079bdd31e29cf2ff30034d8268e3b"+    , "88028d29ef80b4e6f0fe12f91d7449fe75062682e89c571440c0c9b52c42a6e0"+    , "c6871cff0824fe55ea7689a52229886730450e5d362da5bf590dcf9acd67fed4cb32107df5d03969a66b1f6494fdf5d63d5b4d0d34ea7399a07d0116126d0d518c7c55ba46e12f62efc8fe28a51c9d428e6d371d7397ab319fc73ded4722e5b4f30004032a6128df5e7497ecf82ca7b0a50e867ef6728a4f509a8c859087039c"+    ],+    -- COUNT = 2+    [ "0f2f23d64f481cabec7abb01db3aabf125c3173a044b9bf26844300b69dcac8b"+    , "9a5ae13232b43aa19cfe8d7958b4b590"+    , ""+    , "ec4c7a62acab73385f567da10e892ff395a0929f959231a5628188ce0c26e818"+    , "6b97b8c6b6bb8935e676c410c17caa8042aa3145f856d0a32b641e4ae5298648"+    , "7480a361058bd9afa3db82c9d7586e42269102013f6ec5c269b6d05f17987847748684766b44918fd4b65e1648622fc0e0954178b0279dfc9fa99b66c6f53e51c4860131e9e0644287a4afe4ca8e480417e070db68008a97c3397e4b320b5d1a1d7e1d18a95cfedd7d1e74997052bf649d132deb9ec53aae7dafdab55e6dae93"+    ],+    -- COUNT = 3+    [ "53c56660c78481be9c63284e005fcc14fbc7fb27732c9bf1366d01a426765a31"+    , "dc7a14d0eb5b0b3534e717a0b3c64614"+    , ""+    , "3aa848706ecb877f5bedf4ffc332d57c22e08747a47e75cff6f0fd1316861c95"+    , "9a401afa739b8f752fddacd291e0b854f5eff4a55b515e20cb319852189d3722"+    , "5c0eb420e0bf41ce9323e815310e4e8303cd677a8a8b023f31f0d79f0ca15aeb636099a369fd074d69889865eac1b72ab3cbfebdb8cf460b00072802e2ec648b1349a5303be4ccaadd729f1a9ea17482fd026aaeb93f1602bc1404b9853adde40d6c34b844cf148bc088941ecfc1642c8c0b9778e45f3b07e06e21ee2c9e0300"+    ],+    -- COUNT = 4+    [ "f63c804404902db334c54bb298fc271a21d7acd9f770278e089775710bf4fdd7"+    , "3e45009ea9cb2a36ba1aa4bf39178200"+    , ""+    , "d165a13dc8cc43f3f0952c3f5d3de4136954d983683d4a3e6d2dc4c89bf23423"+    , "75106bc86d0336df85097f6af8e80e2da59046a03fa65b06706b8bbc7ffc6785"+    , "6363139bba32c22a0f5cd23ca6d437b5669b7d432f786b8af445471bee0b2d24c9d5f2f93717cbe00d1f010cc3b9c515fc9f7336d53d4d26ba5c0d76a90186663c8582eb739c7b6578a3328bf68dc2cec2cd89b3a90201f6993adcc854df0f5c6974d0f5570765a15fe03dbce28942dd2fd16ba2027e68abac83926969349af8"+    ],+    -- COUNT = 5+    [ "2aaca9147da66c176615726b69e3e851cc3537f5f279fe7344233d8e44cfc99d"+    , "4e171f080af9a6081bee9f183ac9e340"+    , ""+    , "d75a2a6eb66c3833e50f5ec3d2e434cf791448d618026d0c360806d120ded669"+    , "b643b74c15b37612e6577ed7ca2a4c67a78d560af9eb50a4108fca742e87b8d6"+    , "501dcdc977f4ba856f24eaa4968b374bebb3166b280334cb510232c31ebffde10fa47b7840ef3fe3b77725c2272d3a1d4219baf23e0290c622271edcced58838cf428f0517425d2e19e0d8c89377eecfc378245f283236fafa466c914b99672ceafab369e8889a0c866d8bd639db9fb797254262c6fd44cfa9045ad6340a60ef"+    ],+    -- COUNT = 6+    [ "a2e4cd48a5cf918d6f55942d95fcb4e8465cdc4f77b7c52b6fae5b16a25ca306"+    , "bef036716440db6e6d333d9d760b7ca8"+    , ""+    , "bfa591c7287f3f931168f95e38869441d1f9a11035ad8ea625bb61b9ea17591c"+    , "c00c735463bca215adc372cb892b05e939bf669583341c06d4e31d0e5b363a37"+    , "e7d136af69926a5421d4266ee0420fd729f2a4f7c295d3c966bdfa05268180b508b8a2852d1b3a06fd2ab3e13c54005123ef319f42d0c6d3a575e6e7e1496cb28aacadbcf83740fba8f35fcee04bb2ed8a51db3d3362b01094a62fb57e33c99a432f29fce6676cffbbcc05107e794e75e44a02d5e6d9d748c5fbff00a0178d65"+    ],+    -- COUNT = 7+    [ "95a67771cba69011a79776e713145d309edae56fad5fd6d41d83eaff89df6e5e"+    , "be5b5164e31ecc51ba6f7c3c5199eb33"+    , ""+    , "065f693b229a7c4fd373cd15b3807552dd9bf98c5485cef361949d4e7d774b53"+    , "9afb62406f0e812c4f156d58b19a656c904813c1b4a45a0029ae7f50731f8014"+    , "f61b61a6e79a41183e8ed6647899d2dc85cdaf5c3abf5c7f3bf37685946dc28f4923dc842f2d4326bd6ce0d50a84cb3ba869d72a36e246910eba6512ba36cd7ed3a5437c9245b00a344308c792b668b458d3c3e16dee2fbec41867da31084d46d8ec168de2148ef64fc5b72069abf5a6ada1ead2b7146bb793ff1c9c3690fa56"+    ],+    -- COUNT = 8+    [ "a459e1815cbca4514ec8094d5ab2414a557ba6fe10e613c345338d0521e4bf90"+    , "62221392e2552e76cd0d36df6e6068eb"+    , ""+    , "0a3642b02b23b3ef62c701a63401124022f5b896de86dab6e6c7451497aa1dcc"+    , "c80514865901371c45ba92d9f95d50bb7c9dd1768cb3dfbc45b968da94965c6e"+    , "464e6977b8adaef307c9623e41c357013249c9ffd77f405f3925cebb69f151ce8fbb6a277164002aee7858fc224f6499042aa1e6322deee9a5d133c31d640e12a7487c731ba03ad866a24675badb1d79220c40be689f79c2a0be93cb4dada3e0eac4ab140cb91998b6f11953e68f2319b050c40f71c34de9905ae41b2de1c2f6"+    ],+    -- COUNT = 9+    [ "252c2cad613e002478162861880979ee4e323025eebb6fb2e0aa9f200e28e0a1"+    , "d001bc9a8f2c8c242e4369df0c191989"+    , ""+    , "9bcfc61cb2bc000034bb3db980eb47c76fb5ecdd40553eff113368d639b947fd"+    , "8b0565c767c2610ee0014582e9fbecb96e173005b60e9581503a6dca5637a26e"+    , "e96c15fe8a60692b0a7d67171e0195ff6e1c87aab844221e71700d1bbee75feea695f6a740c9760bbe0e812ecf4061d8f0955bc0195e18c4fd1516ebca50ba6a6db86881737dbab8321707675479b87611db6af2c97ea361a5484555ead454defb1a64335de964fc803d40f3a6f057893d2afc25725754f4f00abc51920743dc"+    ],+    -- COUNT = 10+    [ "8be0ca6adc8b3870c9d69d6021bc1f1d8eb9e649073d35ee6c5aa0b7e56ad8a5"+    , "9d1265f7d51fdb65377f1e6edd6ae0e4"+    , ""+    , "da86167ac997c406bb7979f423986a84ec6614d6caa7afc10aff0699a9b2cf7f"+    , "e4baa3c555950b53e2bfdba480cb4c94b59381bac1e33947e0c22e838a9534cf"+    , "64384ecc4ea6b458efc227ca697eac5510092265520c0a0d8a0ccf9ed3ca9d58074671188c6a7ad16d0b050cdc072c125d7298d3a31d9f044a9ee40da0089a84fea28cc7f05f1716db952fad29a0e779635cb7a912a959be67be2f0a4170aace2981802e2ff6467e5b46f0ffbff3b42ba5935fd553c82482ac266acf1cd247d7"+    ],+    -- COUNT = 11+    [ "d43a75b6adf26d60322284cb12ac38327792442aa8f040f60a2f331b33ac4a8f"+    , "0682f8b091f811afacaacaec9b04d279"+    , ""+    , "7fd3b8f512940da7de5d80199d9a7b42670c04a945775a3dba869546cbb9bc65"+    , "2575db20bc7aafc2a90a5dabab760db851d754777bc9f05616af1858b24ff3da"+    , "0da7a8dc73c163014bf0841913d3067806456bbca6d5de92b85534c6545467313648d71ef17c923d090dc92cff8d4d1a9a2bb63e001dc2e8ab1a597999be3d6cf70ff63fee9985801395fbd4f4990430c4259fcae4fa1fcd73dc3187ccc102d04af7c07532885e5a226fc42809c48f22eecf4f6ab996ae4fcb144786957d9f41"+    ],+    -- COUNT = 12+    [ "64352f236af5d32067a529a8fd05ba00a338c9de306371a0b00c36e610a48d18"+    , "df99ed2c7608c870624b962a5dc68acd"+    , ""+    , "da416335e7aaf60cf3d06fb438735ce796aad09034f8969c8f8c3f81e32fef24"+    , "a28c07c21a2297311adf172c19e83ca0a87731bdffb80548978d2d1cd82cf8a3"+    , "132b9f25868729e3853d3c51f99a3b5fae6d4204bea70890daf62e042b776a526c8fb831b80a6d5d3f153237df1fd39b6fd9137963f5516d9cdd4e3f9195c46e9972c15d3edc6606e3368bde1594977fb88d0ca6e6f5f3d057ccadc7d7dab77dfc42658a1e972aa446b20d418286386a52dfc1c714d2ac548713268b0b709729"+    ],+    -- COUNT = 13+    [ "282f4d2e05a2cd30e9087f5633089389449f04bac11df718c90bb351cd3653a5"+    , "90a7daf3c0de9ea286081efc4a684dfb"+    , ""+    , "2630b4ccc7271cc379cb580b0aaede3d3aa8c1c7ba002cf791f0752c3d739007"+    , "c31d69de499f1017be44e3d4fa77ecebc6a9b9934749fcf136f267b29115d2cc"+    , "c899094520e0197c37b91dd50778e20a5b950decfb308d39f1db709447ae48f6101d9abe63a783fbb830eec1d359a5f61a2013728966d349213ee96382614aa4135058a967627183810c6622a2158cababe3b8ab99169c89e362108bf5955b4ffc47440f87e4bad0d36bc738e737e072e64d8842e7619f1be0af1141f05afe2d"+    ],+    -- COUNT = 14+    [ "13c752b9e745ce77bbc7c0dbda982313d3fe66f903e83ebd8dbe4ff0c11380e9"+    , "f1a533095d6174164bd7c82532464ae7"+    , ""+    , "4f53db89b9ba7fc00767bc751fb8f3c103fe0f76acd6d5c7891ab15b2b7cf67c"+    , "582c2a7d34679088cca6bd28723c99aac07db46c332dc0153d1673256903b446"+    , "6311f4c0c4cd1f86bd48349abb9eb930d4f63df5e5f7217d1d1b91a71d8a6938b0ad2b3e897bd7e3d8703db125fab30e03464fad41e5ddf5bf9aeeb5161b244468cfb26a9d956931a5412c97d64188b0da1bd907819c686f39af82e91cfeef0cbffb5d1e229e383bed26d06412988640706815a6e820796876f416653e464961"+    ]+    ]++{-+    [SHA-256]+    [PredictionResistance = False]+    [EntropyInputLen = 256]+    [NonceLen = 128]+    [PersonalizationStringLen = 256]+    [AdditionalInputLen = 0]+    [ReturnedBitsLen = 1024]+-}++t3 :: [TestVector]+t3 =+    [+    -- COUNT = 0+    [ "5cacc68165a2e2ee20812f35ec73a79dbf30fd475476ac0c44fc6174cdac2b55"+    , "6f885496c1e63af620becd9e71ecb824"+    , "e72dd8590d4ed5295515c35ed6199e9d211b8f069b3058caa6670b96ef1208d0"+    , ""+    , ""+    , "f1012cf543f94533df27fedfbf58e5b79a3dc517a9c402bdbfc9a0c0f721f9d53faf4aafdc4b8f7a1b580fcaa52338d4bd95f58966a243cdcd3f446ed4bc546d9f607b190dd69954450d16cd0e2d6437067d8b44d19a6af7a7cfa8794e5fbd728e8fb2f2e8db5dd4ff1aa275f35886098e80ff844886060da8b1e7137846b23b"+    ],+    -- COUNT = 1+    [ "8df013b4d103523073917ddf6a869793059e9943fc8654549e7ab22f7c29f122"+    , "da2625af2ddd4abcce3cf4fa4659d84e"+    , "b571e66d7c338bc07b76ad3757bb2f9452bf7e07437ae8581ce7bc7c3ac651a9"+    , ""+    , ""+    , "b91cba4cc84fa25df8610b81b641402768a2097234932e37d590b1154cbd23f97452e310e291c45146147f0da2d81761fe90fba64f94419c0f662b28c1ed94da487bb7e73eec798fbcf981b791d1be4f177a8907aa3c401643a5b62b87b89d66b3a60e40d4a8e4e9d82af6d2700e6f535cdb51f75c321729103741030ccc3a56"+    ],+    -- COUNT = 2+    [ "565b2b77937ba46536b0f693b3d5e4a8a24563f9ef1f676e8b5b2ef17823832f"+    , "4ef3064ec29f5b7f9686d75a23d170e3"+    , "3b722433226c9dba745087270ab3af2c909425ba6d39f5ce46f07256068319d9"+    , ""+    , ""+    , "d144ee7f8363d128872f82c15663fe658413cd42651098e0a7c51a970de75287ec943f9061e902280a5a9e183a7817a44222d198fbfab184881431b4adf35d3d1019da5a90b3696b2349c8fba15a56d0f9d010a88e3f9eeedb67a69bcaa71281b41afa11af576b765e66858f0eb2e4ec4081609ec81da81df0a0eb06787340ea"+    ],+    -- COUNT = 3+    [ "fc3832a91b1dcdcaa944f2d93cbceb85c267c491b7b59d017cde4add79a836b6"+    , "d5e76ce9eabafed06e33a913e395c5e0"+    , "ffc5f6eefd51da64a0f67b5f0cf60d7ab43fc7836bca650022a0cee57a43c148"+    , ""+    , ""+    , "0e713c6cc9a4dbd4249201d12b7bf5c69c3e18eb504bf3252db2f43675e17d99b6a908400cea304011c2e54166dae1f20260008efe4e06a87e0ce525ca482bca223a902a14adcf2374a739a5dfeaf14cadd72efa4d55d15154c974d9521535bcb70658c5b6c944020afb04a87b223b4b8e5d89821704a9985bb010405ba8f3d4"+    ],+    -- COUNT = 4+    [ "8009eb2cb49fdf16403bcdfd4a9f952191062acb9cc111eca019f957fb9f4451"+    , "355598866952394b1eddd85d59f81c9d"+    , "09ff1d4b97d83b223d002e05f754be480d13ba968e5aac306d71cc9fc49cc2dd"+    , ""+    , ""+    , "9550903c2f02cf77c8f9c9a37041d0040ee1e3ef65ba1a1fbbcf44fb7a2172bd6b3aaabe850281c3a1778277bacd09614dfefececac64338ae24a1bf150cbf9d9541173a82ecba08aa19b75abb779eb10efa4257d5252e8afcac414bc3bb5d3006b6f36fb9daea4c8c359ef6cdbeff27c1068571dd3c89dc87eda9190086888d"+    ],+    -- COUNT = 5+    [ "a6e4c9a8bd6da23b9c2b10a7748fd08c4f782fadbac7ea501c17efdc6f6087bd"+    , "acdc47edf1d3b21d0aec7631abb6d7d5"+    , "c16ee0908a5886dccf332fbc61de9ec7b7972d2c4c83c477409ce8a15c623294"+    , ""+    , ""+    , "a52f93ccb363e2bdf0903622c3caedb7cffd04b726052b8d455744c71b76dee1b71db9880dc3c21850489cb29e412d7d80849cfa9151a151dcbf32a32b4a54cac01d3200200ed66a3a5e5c131a49655ffbf1a8824ff7f265690dffb4054df46a707b9213924c631c5bce379944c856c4f7846e281ac89c64fad3a49909dfb92b"+    ],+    -- COUNT = 6+    [ "59d6307460a9bdd392dfc0904973991d585696010a71e52d590a5039b4849fa4"+    , "34a0aafb95917cbf8c38fc5548373c05"+    , "0407b7c57bc11361747c3d67526c36e228028a5d0b145d66ab9a2fe4b07507a0"+    , ""+    , ""+    , "299aba0661315211b09d2861855d0b4b125ab24649461341af6abd903ed6f025223b3299f2126fcad44c675166d800619cf49540946b12138989417904324b0ddad121327211a297f11259c9c34ce4c70c322a653675f78d385e4e2443f8058d141195e17e0bd1b9d44bf3e48c376e6eb44ef020b11cf03eb141c46ecb43cf3d"+    ],+    -- COUNT = 7+    [ "9ae3506aadbc8358696ba1ba17e876e1157b7048235921503d36d9211b430342"+    , "9abf7d66afee5d2b811cba358bbc527d"+    , "0d645f6238e9ceb038e4af9772426ca110c5be052f8673b8b5a65c4e53d2f519"+    , ""+    , ""+    , "5f032c7fec6320fe423b6f38085cbad59d826085afe915247b3d546c4c6b174554dd4877c0d671de9554b505393a44e71f209b70f991ac8aa6e08f983fff2a4c817b0cd26c12b2c929378506489a75b2025b358cb5d0400821e7e252ac6376cd94a40c911a7ed8b6087e3de5fa39fa6b314c3ba1c593b864ce4ff281a97c325b"+    ],+    -- COUNT = 8+    [ "96ae3b8775b36da2a29b889ad878941f43c7d51295d47440cd0e3c4999193109"+    , "1fe022a6fc0237b055d4d6a7036b18d5"+    , "1e40e97362d0a823d3964c26b81ab53825c56446c5261689011886f19b08e5c2"+    , ""+    , ""+    , "e707cd14b06ce1e6dbcceaedbf08d88891b03f44ad6a797bd12fdeb557d0151df9346a028dec004844ca46adec3051dafb345895fa9f4604d8a13c8ff66ae093fa63c4d9c0816d55a0066d31e8404c841e87b6b2c7b5ae9d7afb6840c2f7b441bf2d3d8bd3f40349c1c014347c1979213c76103e0bece26ad7720601eff42275"+    ],+    -- COUNT = 9+    [ "33f5120396336e51ee3b0b619b5f873db05ca57cda86aeae2964f51480d14992"+    , "6f1f6e9807ba5393edcf3cb4e4bb6113"+    , "3709605af44d90196867c927512aa8ba31837063337b4879408d91a05c8efa9f"+    , ""+    , ""+    , "8b8291126ded9acef12516025c99ccce225d844308b584b872c903c7bc6467599a1cead003dc4c70f6d519f5b51ce0da57f53da90dbe8f666a1a1dde297727fee2d44cebd1301fc1ca75956a3fcae0d374e0df6009b668fd21638d2b733e6902d22d5bfb4af1b455975e08eef0ebe4dc87705801e7776583c8de11672729f723"+    ],+    -- COUNT = 10+    [ "ad300b799005f290fee7f930eebce158b98fb6cb449987fe433f955456b35300"+    , "06aa2514e4bd114edf7ac105cfef2772"+    , "87ada711465e4169da2a74c931afb9b5a5b190d07b7af342aa99570401c3ee8a"+    , ""+    , ""+    , "80d7c606ff49415a3a92ba1f2943235c01339c8f9cd0b0511fbfdf3ef23c42ffff008524193faaa4b7f2f2eb0cfa221d9df89bd373fe4e158ec06fad3ecf1eb48b8239b0bb826ee69d773883a3e8edac66254610ff70b6609836860e39ea1f3bfa04596fee1f2baca6cebb244774c6c3eb4af1f02899eba8f4188f91776de16f"+    ],+    -- COUNT = 11+    [ "130b044e2c15ab89375e54b72e7baae6d4cad734b013a090f4df057e634f6ff0"+    , "65fd6ac602cd44107d705dbc066e52b6"+    , "f374aba16f34d54aae5e494505b67d3818ef1c08ea24967a76876d4361379aec"+    , ""+    , ""+    , "5d179534fb0dba3526993ed8e27ec9f915183d967336bb24352c67f4ab5d7935d3168e57008da851515efbaecb69904b6d899d3bfa6e9805659aef2942c4903875b8fcbc0d1d24d1c075f0ff667c1fc240d8b410dff582fa71fa30878955ce2ed786ef32ef852706e62439b69921f26e84e0f54f62b938f04905f05fcd7c2204"+    ],+    -- COUNT = 12+    [ "716430e999964b35459c17921fe5f60e09bd9ab234cb8f4ba4932bec4a60a1d5"+    , "9533b711e061b07d505da707cafbca03"+    , "372ae616d1a1fc45c5aecad0939c49b9e01c93bfb40c835eebd837af747f079d"+    , ""+    , ""+    , "a80d6a1b2d0ce01fe0d26e70fb73da20d45841cf01bfbd50b90d2751a46114c0e758cb787d281a0a9cf62f5c8ce2ee7ca74fefff330efe74926acca6d6f0646e4e3c1a1e52fce1d57b88beda4a5815896f25f38a652cc240deb582921c8b1d03a1da966dd04c2e7eee274df2cd1837096b9f7a0d89a82434076bc30173229a60"+    ],+    -- COUNT = 13+    [ "7679f154296e6d580854826539003a82d1c54e2e062c619d00da6c6ac820789b"+    , "55d12941b0896462e7d888e5322a99a3"+    , "ba4d1ed696f58ef64596c76cee87cc1ca83069a79e7982b9a06f9d62f4209faf"+    , ""+    , ""+    , "10dc7cd2bb68c2c28f76d1b04ae2aa287071e04c3b688e1986b05cc1209f691daa55868ebb05b633c75a40a32b49663185fe5bb8f906008347ef51590530948b87613920014802e5864e0758f012e1eae31f0c4c031ef823aecfb2f8a73aaa946fc507037f9050b277bdeaa023123f9d22da1606e82cb7e56de34bf009eccb46"+    ],+    -- COUNT = 14+    [ "8ca4a964e1ff68753db86753d09222e09b888b500be46f2a3830afa9172a1d6d"+    , "a59394e0af764e2f21cf751f623ffa6c"+    , "eb8164b3bf6c1750a8de8528af16cffdf400856d82260acd5958894a98afeed5"+    , ""+    , ""+    , "fc5701b508f0264f4fdb88414768e1afb0a5b445400dcfdeddd0eba67b4fea8c056d79a69fd050759fb3d626b29adb8438326fd583f1ba0475ce7707bd294ab01743d077605866425b1cbd0f6c7bba972b30fbe9fce0a719b044fcc1394354895a9f8304a2b5101909808ddfdf66df6237142b6566588e4e1e8949b90c27fc1f"+    ]+    ]++{-+    [SHA-256]+    [PredictionResistance = False]+    [EntropyInputLen = 256]+    [NonceLen = 128]+    [PersonalizationStringLen = 256]+    [AdditionalInputLen = 256]+    [ReturnedBitsLen = 1024]+-}++t4 :: [TestVector]+t4 =+    [+    -- COUNT = 0+    [ "5d3286bc53a258a53ba781e2c4dcd79a790e43bbe0e89fb3eed39086be34174b"+    , "c5422294b7318952ace7055ab7570abf"+    , "2dba094d008e150d51c4135bb2f03dcde9cbf3468a12908a1b025c120c985b9d"+    , "793a7ef8f6f0482beac542bb785c10f8b7b406a4de92667ab168ecc2cf7573c6"+    , "2238cdb4e23d629fe0c2a83dd8d5144ce1a6229ef41dabe2a99ff722e510b530"+    , "d04678198ae7e1aeb435b45291458ffde0891560748b43330eaf866b5a6385e74c6fa5a5a44bdb284d436e98d244018d6acedcdfa2e9f499d8089e4db86ae89a6ab2d19cb705e2f048f97fb597f04106a1fa6a1416ad3d859118e079a0c319eb95686f4cbcce3b5101c7a0b010ef029c4ef6d06cdfac97efb9773891688c37cf"+    ],+    -- COUNT = 1+    [ "c2a566a9a1817b15c5c3b778177ac87c24e797be0a845f11c2fe399dd37732f2"+    , "cb1894eb2b97b3c56e628329516f86ec"+    , "13ce4d8dd2db9796f94156c8e8f0769b0aa1c82c1323b61536603bca37c9ee29"+    , "413dd83fe56835abd478cb9693d67635901c40239a266462d3133b83e49c820b"+    , "d5c4a71f9d6d95a1bedf0bd2247c277d1f84a4e57a4a8825b82a2d097de63ef1"+    , "b3a3698d777699a0dd9fa3f0a9fa57832d3cefac5df24437c6d73a0fe41040f1729038aef1e926352ea59de120bfb7b073183a34106efed6278ff8ad844ba0448115dfddf3319a82de6bb11d80bd871a9acd35c73645e1270fb9fe4fa88ec0e465409ea0cba809fe2f45e04943a2e396bbb7dd2f4e0795303524cc9cc5ea54a1"+    ],+    -- COUNT = 2+    [ "a33288a96f41dd54b945e060c8bd0c094f1e28267cc1dcbba52063c1a9d54c4d"+    , "36918c977e1a7276a2bb475591c367b7"+    , "6aa528c940962638dc2201738850fd1fe6f5d0eb9f687ff1af39d9c7b36830d9"+    , "37ee633a635e43af59abdb1762c7ea45bfe060ec1d9077ecd2a43a658673f3c7"+    , "2eb96f2e28fa9f674bb03ade703b8f791ee5356e2ee85c7ed5bda96325256c61"+    , "db2f91932767eb846961ce5321c7003431870508e8c6f8d432ca1f9cee5cdc1aed6e0f133d317eb6990c4b3b0a360cdfb5b43a6e712bd46bca04c414868fab22c6a49c4b89c812697c3a7fbfc8ddf10c8aa5ebf13a09fd114eb2a02a07f69786f3ce7fd30231f22779bc8db103b13fa546dbc45a89a86275281172761683d384"+    ],+    -- COUNT = 3+    [ "5f37b6e47e1776e735adc03d4b999879477ff4a206231924033d94c0114f911b"+    , "7d12d62c79c9f6234ae0314156947459"+    , "92d4d9fab5f8bf5119f2663a9df7334f50dcde74fb9d7732f7eba56501e60d54"+    , "c9aef0d7a9ba7345d08b6d5b5ce5645c7495b8685e6b93846ffcf470f5abd40d"+    , "50d9d1f5074f7d9f1a24a9c63aa47b94da5ba78db1b0f18e4d4fe45c6875813c"+    , "20d942bbd7d98700faa37e94d53bf74f2d6bd1d8c95c0b88d842c4857797d59e7c8788aeeac29740122f208f703bf35dc32b0035db0648384feb6aa17a3274bc09b2d2b746c5a06fd82f4469fb86131a49482cb7be7d9b4b95042394cfb18b13f333ec0fe5c227bf1d8f33ecb2e42e358b6c3e034cb585331bd1d27f638029b9"+    ],+    -- COUNT = 4+    [ "2311c5afd64c584484b2729e84db80c0b4063fe9ca7edc83350488d7e67264a0"+    , "6a6dfd975a0dc7b72df1f107c4b3b3a6"+    , "2abd870ec5fe26ed14dfa57a3309f920131b70580c3639af2645cd1af93db1b1"+    , "c6e532a3b25653b6002aed5269cc2118749306e736bde039d4d569d4f967773f"+    , "5e7d26c4da769c373092b2b4f72b109fe34bdb7d169ea38f78ebae5df4a15759"+    , "cacaeb1b4ac2305d8714eb50cbe1c67c5a2c0bbc7938fdfdcafef7c85fc40becbf777a4cfb6f14c6eee320943a493d2b0a744a6eb3c256ee9a3763037437df9adce3e2260f0c35e958af0edb5a81debd8bdaf2b8bb2b98b9186e5a222a21609ff58df4cbe1d4898d10d6e7c46f31f5cb1041bfd83a5fb27d5c56c961e91403fc"+    ],+    -- COUNT = 5+    [ "362ece9d330e1172a8f9e50258476d0c79c3ee50346524ba12d970ee3a6ef8c5"+    , "cf11bcb4d9d51311ceacfca8705e833f"+    , "abb5a8edde02e526449284ecc31bc713383df3ed085f752e3b6a32f305861eed"+    , "746302ab1f4a86b17546bea762e929360f2e95c7788a63545a264ef997c8c65e"+    , "b907c5b2a8833a48e56e819228ce9a050b41b3309f5ca37bed720311d92b33af"+    , "73c7131a558350590053580873ef956ff952f2aa6ff1bea452e013d1bc2afddea2311756dbe756e63ba6258480c48f3f6c1319b5f572f67ca530af09e39413d1d432bea8f89206619618cb0e7c88e9f2033639d0eb0efc20616b64f940da99b88231984c3fb23f19e890576f555fde394dbd4351f17a7ffd5c369379001bda03"+    ],+    -- COUNT = 6+    [ "cf614bc29946bc0095f415e8bdeda10aab05392f9cc9187a86ea6ec95ee422e1"+    , "77fb5ec22dc0432cc13f4693e2e3bd9a"+    , "e4ce77914ffbc5fddf1fb51edfafdc196109139b84c741354135ec8d314c7c43"+    , "e1e83ee1205acaf6164dc287aec08e5b32789e5be818078db39e53cad589db51"+    , "4e20c0226d5e1e7e805679f03f72452b5bea2d0ba41e0c12329bf60eb3016dd1"+    , "838fdf1418a746aa52ae4005d90c3fd301f648c5770ffef2a9f3912e37a93850cc4b8bfcce910aead0cb75958823b1a62e283901c5e4a3980e4ea36257458e2e4953555819b8852a26489b1d74821f80c9908469b43f124ff7ea62497c36159a47353098a1b9ec32e54800d6704371cc37f357ad74aacc203e9b6db97f94d0c4"+    ],+    -- COUNT = 7+    [ "a8da1d3e233f393fd44d204c200202f7d01896e72c5ac652940cfd15b5d4b0bd"+    , "0a112b4cb0890af0a495e0f49fcf6874"+    , "d2e32799bc822b8d033299bdf63dc35774f7649e935d25be5b10512c430d1bda"+    , "920a82d76fcd2cd106ada64bba232b7b2344f3afe6b1d1d20ee8795144571009"+    , "eeaac5878275372025f8231febed64db6a11273c3c00d625fc80a95f18ad7d3f"+    , "5f6dae489b53d89027b2cc333c700f090152d77b3eaf01d47f56ce6eca9893ef877b4cb560fab0fbdb34e3d1c6cd8480b33c053d2661a10aa531df4961b97d659c7492584236582b3fe701055efa59c328194cd1e07fcffd910d9ee01b7b9e8c8fda7f7ac01a8e203b8b26eb8078a9b9a5021562c44af24089e3ef84c1d5a6bd"+    ],+    -- COUNT = 8+    [ "a77b1ed4ecaa650374e1052c405f1d88881c25c87d13dbe1334d8c1a847fa76b"+    , "05c143e2f145db216fe7be9ed23635d0"+    , "b5c750968ff09ed251d4a1c05342ac843db5246b19045728a634fa4f6e752e54"+    , "ff5937bcd01a363696bf8e40adc8e4ab3e56dbf7e7d09451c99e538785fe6697"+    , "4acb34eea8266badcf8f6557a0eecf3eb4d7a295c876d6175598cb66a388efb8"+    , "ec13eadfcc84e77d2a2efa1a2cd8b1355587cb27feb3d19d75b37f0446333ddb8236e751c63b7a6e595ec24a25051a696dbe8c062dd8896d1446db228a2f10e8094ee07e7ee648ed6bebb2f5ec5aae24c9c640665c28355cc11c116795ecc070790f7fdfc4398900311b6695d5da0175091ed1828d2731085bfb4a20bd86cce0"+    ],+    -- COUNT = 9+    [ "491686c781e83eb4e21d9989e8d718100b0d21a2c56295888baef1a65f219651"+    , "499085296d21065feabf3106101c8d6f"+    , "d208a72f9ae34f0817669fb04f49239dd31700f3dc9a93db8d75fb79f9b686c1"+    , "9ffc61893a293a864008fdd56d3292600d9e2ec8a1ea8f34ac5931e968905a23"+    , "4ff3a397dfdae0912032a302a5e7a07dceca8d9013a21545689319b7c024cd07"+    , "3c258ebf2203fca3b322ad1b016e21c7f5c148425f81e4fb0a0e462dce9dfa569c37a006527768297a5b68461b08912642a341b88c85597e30e7561206886098c4e2d861f11513f0ffdbbc78d3a2dd60c105abbb33c5e05ae27081b690fb8b3610917aa9bf1a4ad74481b5ff8334f14e5ad6a6a1eb2259476078076fb7e3a992"+    ],+    -- COUNT = 10+    [ "36a5267eeeb5a1a7d46de0f8f9281f73cd9611f01198fdaa78c5315205e5a177"+    , "b66b5337970df36219321badacc624eb"+    , "c2a7b164949da102bece44a423197682ff97627d1fe9654266b8527f64e5b386"+    , "a977e2d8637b019c74063d163bb25387dc56f4eb40e502cefc5ae6ad26a6abdc"+    , "c5c9819557b1e7d8a86fa8c60be42993edc3ef539c13d9a51fb64b0de06e145e"+    , "b471711a4fc7ab7247e65d2c2fe49a50169187187b7978cd2fdb0f8318be3ec55fc68ed4577ad9b42cbb57100b5d35ac86c244c4c93a5b28c1a11c2dfe905d608ec7804dec5bb15cf8d79695534d5e13a6a7e18a887ec9cf184da0cbbc6267f3a952a769403bafcdbb559401be0d8b3300ea7258b4026fc892175efd55ba1a67"+    ],+    -- COUNT = 11+    [ "a76b0366df89e4073a6b6b9c04da1d6817ce26f1c4825cad4097bdf4d7b9445e"+    , "773d3cc3290176773847869be528d1a4"+    , "1bfd3bcfb9287a5ad055d1b2b8615fa81c94ac24bc1c219a0f8de58789e0404a"+    , "edd879fa56f21d93029da875b683ce50f6fdc4c0da41da051d000eed2afefefa"+    , "f528ffd29160039260133ed9654589ce60e39e7f667c34f82cda65ddcf5fff14"+    , "39d1ff8848e74dd2cdc6b818ad69823878062116fdf1679942f892c7e191be1c4b6ea268ecdff001b22af0d510f30c2c25b90fc34927f46e3f45d36b0e1848b3a5d54c36c7c65ee7287d325dfbb51b56a438feb6650ce13df88bf06b87ac4a35d2a199ea888629fb0d83f82f0ea160dc79ed220d8ef195b9e80c542f60c2d320"+    ],+    -- COUNT = 12+    [ "46571e1df43e5e141235e2a9ec85bb0faf1dc0566031e14d41a2fbd0315653ec"+    , "b60ef6a3347967519aabeaf748e4e991"+    , "759fd8593e3688b23c4a003b655311770d670789878570eb3b155a8e6c2d8c45"+    , "033128460b449e1accb0e9c54508759ddc2538bc64b51e6277553f0c60a02723"+    , "a5e4a717240bdeac18a0c0e231a11dc04a47d7550f342fa9a7a5ff334eb9327d"+    , "9d222df1d530ea7f8f2297a0c79d637da570b48042ecddded75956bba0f0e70b271ffa3c9a53bada6ee1b8a4203c22bfde82a5e2eb1b150f54c6483458569422c1a34a8997d42cc09750167a78bf52a0bd158397af9f83caabe689185c099bf0a9a4853dd3cf8b8e89efebb6a27dba873e65e9927741b22968f2875789b44e01"+    ],+    -- COUNT = 13+    [ "d63980e63bbe4ac08d2ac5646bf085b82c75995e3fdfc23bb9cc734cd85ca7d2"+    , "d33ed1dcae13fb634ba08272d6697590"+    , "acd0da070072a5340c4f5f4395568e1a36374e074196ae87f3692ee40487e1df"+    , "f567677b5e12e26f3544be3da9314c88fc475bf84804a89a51f12b191392c02b"+    , "c01cc7873e93c86e2bfb8fc984cfc2eab5cc58eeef018fedb5cba5aedd386156"+    , "b133446f633bcb40724bbf9fa187c39a44b9c094a0a0d40e98977e5466dc2c9adf62a5f4551eeb6406a14658de8a0ed7487c3bf6277e811101284a941745ce16176acc875f1435e14161772fa84609e8123c53dd03cbb868030835c0d11d8d6aa04a1b6f908248b028997737f54735ec4ed7a81fc868199ffb61a779d9340334"+    ],+    -- COUNT = 14+    [ "3d99f9b7ac3a2fbe9cf15d960bf41f5588fc4db1e0d2a5c9c0fe9059f03593fb"+    , "411f504bb63a9b3afa7ffa1357bb48be"+    , "0bb5ebd55981a25ba69164da49fa92f2871fd3fc65eb30d0f0d0b8d798a4f8f2"+    , "288e948a551284eb3cb23e26299955c2fb8f063c132a92683c1615ecaed80f30"+    , "d975b22f79e34acf5db25a2a167ef60a10682dd9964e15533d75f7fa9efc5dcb"+    , "ee8d707eea9bc7080d58768c8c64a991606bb808600cafab834db8bc884f866941b4a7eb8d0334d876c0f1151bccc7ce8970593dad0c1809075ce6dbca54c4d4667227331eeac97f83ccb76901762f153c5e8562a8ccf12c8a1f2f480ec6f1975ac097a49770219107d4edea54fb5ee23a8403874929d073d7ef0526a647011a"+    ]+    ]++{- Reseed test vectors -}++{-+    [SHA-256]+    [PredictionResistance = False]+    [EntropyInputLen = 256]+    [NonceLen = 128]+    [PersonalizationStringLen = 0]+    [AdditionalInputLen = 0]+    [ReturnedBitsLen = 1024]+-}++r1 :: [TestVector]+r1 =+    [+    -- COUNT = 0+    [ "06032cd5eed33f39265f49ecb142c511da9aff2af71203bffaf34a9ca5bd9c0d"+    , "0e66f71edc43e42a45ad3c6fc6cdc4df"+    , ""+    , "01920a4e669ed3a85ae8a33b35a74ad7fb2a6bb4cf395ce00334a9c9a5a5d552"+    , ""+    , ""+    , ""+    , "76fc79fe9b50beccc991a11b5635783a83536add03c157fb30645e611c2898bb2b1bc215000209208cd506cb28da2a51bdb03826aaf2bd2335d576d519160842e7158ad0949d1a9ec3e66ea1b1a064b005de914eac2e9d4f2d72a8616a80225422918250ff66a41bd2f864a6a38cc5b6499dc43f7f2bd09e1e0f8f5885935124"+    ],+    -- COUNT = 1+    [ "aadcf337788bb8ac01976640726bc51635d417777fe6939eded9ccc8a378c76a"+    , "9ccc9d80c89ac55a8cfe0f99942f5a4d"+    , ""+    , "03a57792547e0c98ea1776e4ba80c007346296a56a270a35fd9ea2845c7e81e2"+    , ""+    , ""+    , ""+    , "17d09f40a43771f4a2f0db327df637dea972bfff30c98ebc8842dc7a9e3d681c61902f71bffaf5093607fbfba9674a70d048e562ee88f027f630a78522ec6f706bb44ae130e05c8d7eac668bf6980d99b4c0242946452399cb032cc6f9fd96284709bd2fa565b9eb9f2004be6c9ea9ff9128c3f93b60dc30c5fc8587a10de68c"+    ],+    -- COUNT = 2+    [ "62cda441dd802c7652c00b99cac3652a64fc75388dc9adcf763530ac31df9214"+    , "5fdc897a0c1c482204ef07e0805c014b"+    , ""+    , "bd9bbf717467bf4b5db2aa344dd0d90997c8201b2265f4451270128f5ac05a1a"+    , ""+    , ""+    , ""+    , "7e41f9647a5e6750eb8acf13a02f23f3be77611e51992cedb6602c314531aff2a6e4c557da0777d4e85faefcb143f1a92e0dbac8de8b885ced62a124f0b10620f1409ae87e228994b830eca638ccdceedd3fcd07d024b646704f44d5d9c4c3a7b705f37104b45b9cfc2d933ae43c12f53e3e6f798c51be5f640115d45cf919a4"+    ],+    -- COUNT = 3+    [ "6bdc6ca8eef0e3533abd02580ebbc8a92f382c5b1c8e3eaa12566ecfb90389a3"+    , "8f8481cc7735827477e0e4acb7f4a0fa"+    , ""+    , "72eca6f1560720e6bd1ff0152c12eeff1f959462fd62c72b7dde96abcb7f79fb"+    , ""+    , ""+    , ""+    , "d5a2e2f254b5ae65590d4fd1ff5c758e425be4bacdeede7989669f0a22d34274fdfc2bf87135e30abdae2691629c2f6f425bd4e119904d4785ecd9328f15259563e5a71f915ec0c02b66655471067b01016fdf934a47b017e07c21332641400bbe5719050dba22c020b9b2d2cdb933dbc70f76fec4b1d83980fd1a13c4565836"+    ],+    -- COUNT = 4+    [ "096ef37294d369face1add3eb8b425895e921626495705c5a03ee566b34158ec"+    , "6e2e0825534d2989715cc85956e0148d"+    , ""+    , "1b4f7125f472c253837fa787d5acf0382a3b89c3f41c211d263052402dcc62c5"+    , ""+    , ""+    , ""+    , "4541f24f759b5f2ac2b57b51125077cc740b3859a719a9bab1196e6c0ca2bd057af9d3892386a1813fc8875d8d364f15e7fd69d1cc6659470415278164df656295ba9cfcee79f6cbe26ee136e6b45ec224ad379c6079b10a2e0cb5f7f785ef0ab7a7c3fcd9cb6506054d20e2f3ec610cbba9b045a248af56e4f6d3f0c8d96a23"+    ],+    -- COUNT = 5+    [ "a7dccdd431ae5726b83585b54eae4108f7b7a25c70187c0acbb94c96cc277aa8"+    , "94c8f4b8e195a47356a89a50d1389ab5"+    , ""+    , "51733eee2e922f4055e53939e222e71fae730eb037443db2c7679708abb86a65"+    , ""+    , ""+    , ""+    , "99ba2691a622afecc9472418e6a8f9f1cdc1e3583c3bc7a2a650a1ab79dcbccbd656636c573179276e782569420c97438c06be898867f628b1c01eb570263d2c0f09c7aab536f6fba7df6aad19e05c236b645674667c03d1b6a04d7fc11177fe78933b309679f5bf26a4632b9a13e314c4bf4532428d3d95c689002b6dc1fbb1"+    ],+    -- COUNT = 6+    [ "c286425ecf543a49bcc9196b0db1a80bc54e4948adba6f41712a350a02891fa6"+    , "957a659a4ec2e0b7ad185483c220fd61"+    , ""+    , "08c2129813eea0776fba72788fdf2718759cc3c4207fa20a5fe23ac6e32cc28e"+    , ""+    , ""+    , ""+    , "8e1020a4fd84c99e0fc7e3f7ce48de5ed9ec9a5c2ccd624dbe6f30e2f688a31dc55957630357a5d48ca2a456241a28bfb16d8bb000877697a7ce24d9ad4d22b0c15117996f1f270b94f46d7a9bdfa7608fa1dd849177a9b8049e51b6b7a2742623854a1fddb5efc447eed1ea1aed6f02b4b2754ecf71ea0509da2e54f524a7e7"+    ],+    -- COUNT = 7+    [ "02818bd7c1ec456ace55beeba99f646a6d3aa0ea78356ea726b763ff0dd2d656"+    , "c482687d508c9b5c2a75f7ce390014e8"+    , ""+    , "cf319bfa63980e3cb997fd28771bb5614e3acb1149ba45c133ffbbab17433193"+    , ""+    , ""+    , ""+    , "19a231ff26c1865ce75d7a7185c30dd0b333126433d0c8cbf1be0d2b384d4eb3a8aff03540fbfa5f5496521a4e4a64071b44c78bd0b7e68fac9e5695c5c13fd3b9dbe7f7739781a4c8f0b980f1b17d99bce17ceb52b56866ae02456ffef83399c8cf7826f3c45c8a19315890919d20f40fc4e18d07e9c8ccd16c3327b5988f71"+    ],+    -- COUNT = 8+    [ "77a5c86d99be7bc2502870f4025f9f7563e9174ec67c5f481f21fcf2b41cae4b"+    , "ed044ad72ee822506a6d0b1211502967"+    , ""+    , "778100749f01a4d35c3b4a958aafe296877e0acafd089f50bc7797a42a33ab71"+    , ""+    , ""+    , ""+    , "831a4da566f46289904893ef1cc1cd4ad19ee48f3857e2b69e936d10afbdc29822e85d02663d346ef3e09a848b1d9cc04f4c4c6e3b3b0e56a034e2334d34ca08f8097be307ba41d020bc94f8c1937fe85644eeb5592c2b5a2138f7ded9a5b44b200c8b5beb27597c790f94d660eb61e8248391edc3ae2d77656cbe8354275b13"+    ],+    -- COUNT = 9+    [ "0ea458cff8bfd1dd8b1addcba9c01317d53039e533104e32f96e7d342e6c7b9b"+    , "935a4b66fc74c2a48757a99c399e64e3"+    , ""+    , "6c5f3708e7b714c4ed139b4fa9e8c763af01773484005109a85e33653bb0ce98"+    , ""+    , ""+    , ""+    , "373a37af84fddec13645a9768d6a785ae5a2589d64cd9b37980dde2541499210c4f408335de1d585349064f3f53a2b4c5ec6dc2a09591f99ad9fad528ac83474164b45497bf167f81e66fa08463ffea917f6891e48f149fafc20622bb1172f34886feb45c26fd446a4a4e2891b4bc594186896141aaaeeb301b49e7c1a26fec7"+    ],+    -- COUNT = 10+    [ "bfb68be4ce1756d25bdfad5e0c2f8bec29360901cc4da51d423d1591cc57e1ba"+    , "98afe4bd194c143e099680c504cceaab"+    , ""+    , "b97caf210e82498c3408790d41c320dd4a72007778389b44b7bc3c1c4b8c53f8"+    , ""+    , ""+    , ""+    , "409e0aa949fb3b38231bf8732e7959e943a338ea399026b744df15cbfeff8d71b3da023dcce059a88cf0d4b7475f628e4764c8bef13c70cfbbbb6da2a18aabcad919db09d04fc59765edb165147c88dd473a0f3c5ee19237ca955697e001ba654c5ee0bd26761b49333154426bc63286298a8be634fe0d72cfdeef0f3fc48eca"+    ],+    -- COUNT = 11+    [ "4f6880a64610004463031d67d7924fa446c39138d4d41007e8df3d65691a9367"+    , "6b33b2c13600f4b1df6ca3d1960e8dd4"+    , ""+    , "57b87b8c8f48312b5333d43b367730c0a5ad4725a16778fcb53fe136d136cbfd"+    , ""+    , ""+    , ""+    , "73d0f324ed186e2ad06bd1800e262bdbda79ba54e626761bd60f74f43e3bb62958ec1e2f1d940af163e1cadc124e7ebaba2f72e67efd746c7f6d0cad53ef03d859d93cff778a32ee5be172fe7fdbdc232ded360d704a6fa0f70bebe942e56478345492f49dc5c6fc346b88a58947ad250e688e8c626fe1efe7624620e571976e"+    ],+    -- COUNT = 12+    [ "aae352e111843219cae8f70e7b8f6eb9bb53d246cbec1e4f07d42757143295b4"+    , "b84485dccd1bf93210e322eafcbebcd9"+    , ""+    , "f9237f00d744d8fbff21b9d0043c258e8731817e6a5fb7b4bf5011680e5bc642"+    , ""+    , ""+    , ""+    , "cfb28b93522c7d61d8d3ce3f080e435e4c83c7e13a9dab788db8fef0407267a14fbc9324e090e24df5491fedfa81116869983938d4d4d7324a310c3af33a6f7938f602c5e4e63f1771cdaabdab0782b5affb54eb53047c109a9606739dd0065bd21eca33132986554878354f5f9f852e674dd690163b0ff74c7a25e6bae8ce39"+    ],+    -- COUNT = 13+    [ "589e79e339b7d2a1b879f0b0e1a7d1ad2474eaa8025b070f1ffa877b7124d4ff"+    , "0961ed64dbd62065d96e75de6d2ff9d6"+    , ""+    , "e928388d3af48c2968527a4d2f9c2626fbc3f3f5a5d84e0583ab6f78e7f8b081"+    , ""+    , ""+    , ""+    , "fce6ced1ecf474d181ab331f79c3d2cc8a768ec2818de5b3fc7cf418322716d6a6853733561a497c0c25cb288d2c9fcfbca891bafd5a834c85f3603f402acf1a7b1ea92db847ed5c252a862ad4ab5e259715f1fc81da67f5230bf8be50ee8069758095f7d0e559e03f2c6072290e61794458437609e473eb66580cddaad19b71"+    ],+    -- COUNT = 14+    [ "714277d408ad87fde317f0a94732fce62f1352bdc90936673b4f1daa0925aa26"+    , "d16582a99f23010b4248b88d86485419"+    , ""+    , "bd9fc7cb2fd5063b2c3c0c4f346ad2e3879371a9c805e59b9f2cd2cc2a40894f"+    , ""+    , ""+    , ""+    , "62ef7a431288252e0d736c1d4e36cc9ac37107dcd0d0e971a22444a4adae73a41eff0b11c8625e118dbc9226142fd0a6aa10ac9b190919bda44e7248d6c88874612abd77fb3716ea515a2d563237c446e2a282e7c3b0a3aef27d3427cc7d0a7d38714659c3401dbc91d3595159318ebca01ae7d7fd1c89f6ad6b604173b0c744"+    ]+    ]++{-+    [SHA-256]+    [PredictionResistance = False]+    [EntropyInputLen = 256]+    [NonceLen = 128]+    [PersonalizationStringLen = 0]+    [AdditionalInputLen = 256]+    [ReturnedBitsLen = 1024]+-}++r2 :: [TestVector]+r2 =+    [+    -- COUNT = 0+    [ "05ac9fc4c62a02e3f90840da5616218c6de5743d66b8e0fbf833759c5928b53d"+    , "2b89a17904922ed8f017a63044848545"+    , ""+    , "2791126b8b52ee1fd9392a0a13e0083bed4186dc649b739607ac70ec8dcecf9b"+    , "43bac13bae715092cf7eb280a2e10a962faf7233c41412f69bc74a35a584e54c"+    , "3f2fed4b68d506ecefa21f3f5bb907beb0f17dbc30f6ffbba5e5861408c53a1e"+    , "529030df50f410985fde068df82b935ec23d839cb4b269414c0ede6cffea5b68"+    , "02ddff5173da2fcffa10215b030d660d61179e61ecc22609b1151a75f1cbcbb4363c3a89299b4b63aca5e581e73c860491010aa35de3337cc6c09ebec8c91a6287586f3a74d9694b462d2720ea2e11bbd02af33adefb4a16e6b370fa0effd57d607547bdcfbb7831f54de7073ad2a7da987a0016a82fa958779a168674b56524"+    ],+    -- COUNT = 1+    [ "1bea3296f24e9242b96ed00648ac6255007c91f7c1a5088b2482c28c834942bf"+    , "71073136a5cc1eb5b5fa09e1790a0bed"+    , ""+    , "d714329f3fbea1df9d0b0b0d88dfe3774beb63d011935923d048e521b710dc6f"+    , "4ef872fd211a426ea1085ab39eb220cc698fdfeabe49b8835d620ab7885de7a4"+    , "d74d1669e89875852d9ccbf11c20fe3c13a621ebcb3f7edeea39a2b3379fdcf5"+    , "0c8aa67ca310bd8e58c16aba35880f747266dbf624e88ec8f9ee9be5d08fdeb1"+    , "ce95b98f13adcdf7a32aa34709d6e02f658ae498d2ab01ce920f69e7e42c4be1d005acf0ca6b17891dfafc620dd4cd3894f8492a5c846089b9b452483eb0b91f3649ec0b6f98d1aaabc2e42cd39c2b25081b85ab50cb723007a0fd83550f32c210b7c4150b5a6bb3b0c9e3c971a09d43acb48e410a77f824b957092aa8ef98bc"+    ],+    -- COUNT = 2+    [ "a7ea449b49db48601fc3a3d5d77081fab092b8d420ed1b266f704f94352dd726"+    , "d11a159b60af8d20a0e37d27e6c74aa3"+    , ""+    , "50916ab47e8cb5dc843f9fba80639103711f86be8e3aa94f8a64a3fe0e6e5b35"+    , "e2bb6768120555e7b9e0d573537a82f8f32f54560e1050b6abb1588fb3441e66"+    , "a50cec9d1ecddb2c163d24019e81c31a2b350ccd3ad8181fd31bb8d1f64fa50e"+    , "591dbbd48b51abced67f9c6269cf0133cd3dcbb5cfafcb6ef758569c555a5773"+    , "0a464abcc8685158372d544635b953fcb1d3821c30aaa93982f9b788935f00f88115aad61d5cee003b3d1cb50f3e961a501e2dd0fc7e1724778b184a4bdf9f64e110dda7446e5544a30bd49a400ea1a5411800e1edfeea349323618afc5dc5782dc4b71d2da4d6a4785f8dd346feb9c8740ffd26bf644e3e4323ff24c30b9f10"+    ],+    -- COUNT = 3+    [ "14683ec508a29d7812e0f04a3e9d87897000dc07b4fbcfda58eb7cdabc492e58"+    , "b2243e744eb980b3ece25ce76383fd46"+    , ""+    , "18590e0ef4ee2bdae462f76d9324b3002559f74c370cfccf96a571d6955703a7"+    , "9ea3ccca1e8d791d22fcda621fc4d51b882df32d94ea8f20ee449313e6909b78"+    , "16366a578b5ea4d0cb547790ef5b4fd45d7cd845bc8a7c45e99419c8737debb4"+    , "a68caa29a53f1ba857e484d095805dc319fe6963e4c4daaf355f722eba746b92"+    , "c4e7532ee816789c2d3da9ff9f4b37139a8515dbf8f9e1d0bf00c12addd79ebbd76236f75f2aa705a09f7955038ebff0d566911c5ea13214e2c2eeb46d23ad86a33b60f7b9448d63eec3e1d59f48b39552857447dc5d7944667a230e3dbfa30ca322f6eacaf7536a286706a627c5083c32de0658b9073857c30fb1d86eb8ad1b"+    ],+    -- COUNT = 4+    [ "fa261fb230e2822458532ca2d5c39758750e6819a6fcebef10579ba995096959"+    , "564e1c9fbcb12878df2bd49202cbf821"+    , ""+    , "bf7de29e99e7f0e1b9f96f3b1902fb4049c8c6234d20de8316ebe66d97725457"+    , "8b7326621f6afbd44a726de48d03bcc5331f7306026c229ea9523497fbeaa88d"+    , "33b00b31623d6160c4c6740363a96481be14b19bc47be95641227284c366922a"+    , "2d812c8203575790ad6b6f2ed91a49d57460de779a3e881bef3be12e8766dc91"+    , "5574e0b4efc17e8ce136e592beabfe32551072bddd740929e698467b40b3991f028a22c760f7034853cc53007e3793e3c4a600d9e9d94528f8dc09aeba86146cdde2b7f71255ae0efc529b49be2205979dba6525bfe155e8819e8e2aeeaa285704242da90b4c4535101cc47d94b0e388a1b2e63ad0cbe158b9e1bbae9cc0007c"+    ],+    -- COUNT = 5+    [ "61f1471ced56aa04c57e1b512307d4cb92497d9592d7e9e35356e99d585cab1b"+    , "84714e960c403a4fac06b2828cc564d9"+    , ""+    , "7bf97db3c102edc81596d4757045fe6bdc008f35792fc6290b77d889c09c33a8"+    , "5b8bdc41f76d98cfa71ed976ea3994706375c8841adb8b6b3b6418e3132e8832"+    , "94c8a8fdf38a6ccb8571c89420d899adab169214bb0dfcd43a04622e289935b2"+    , "8a4b46e0a7a55907365f82d4ab9376509bd44728cab8cbafb0da901012ad8dcd"+    , "933eb159a6af7455b60e40586c064f05f1970f564281b1ebc4662701ac1f299e4eb908c4afcb2e065191281ab576f684aefedd6904bad04d96bd93c0516c62a496c3073a0cda0676a11cc08866b0cc74f62cb9d3db48673b2c3fbeada69f922b4b795ccba22df12ef7125909381f7d681f6b9caba02fb913c5437b98c040c576"+    ],+    -- COUNT = 6+    [ "a1d5bb7d70621dee6b668b28c56d5610c2f8ced30284cc3e0e48de331af05062"+    , "88a49e3e54c5ea54c98b95de81bcc807"+    , ""+    , "b4e2426e98f6eed97a6cdf690a89ee109e84c3dca16c883c26fa4ac671638d8d"+    , "5bd1e086ed228cfd8b55c1731fea40c3a63d022599ca2da4bb23118f4821ba62"+    , "b754b53ac226e8ebe47a3d31496ec822de06fca2e7ef5bf1dec6c83d05368ec3"+    , "fa7e76b2805d90b3d89fff545010d84f67aa3a2c9eb2ba232e75f4d53267dac3"+    , "df6b2460688fa537df3ddfe5575fca5eb8abad56cbc4e5a618a2b4a7daf6e215c3a497974c502f9d0ec35de3fc2ea5d4f10de9b2aee66dcc7e7ae6357983095959b817f0383e3030771bd2ed97406acf78a1a4a5f30fa0992289c9202e69e3eb1eabe227c11409ff430f6dfca1a923a8b17bc4b87e908007f5e9759c41482b01"+    ],+    -- COUNT = 7+    [ "68f21d14525d56233c7e263482d344c388a840103a77fb20ac60ce463cabdc79"+    , "59fa80ae570f3e0c60ac7e2578cec3cb"+    , ""+    , "7584b4166530442f06e241dd904f562167e2fdae3247ab853a4a9d4884a5fa46"+    , "f6a5482f139045c5389c9246d772c782c4ebf79c3a84b5cf779f458a69a52914"+    , "9d37b1ce99f8079993ddf0bd54bab218016685b22655a678ce4300105f3a45b7"+    , "4c97c67026ff43c2ee730e7b2ce8cce4794fd0588deb16185fa6792ddd0d46de"+    , "e5f8874be0a8345aabf2f829a7c06bb40e60869508c2bdef071d73692c0265f6a5bf9ca6cf47d75cbd9df88b9cb236cdfce37d2fd4913f177dbd41887dae116edfbdad4fd6e4c1a51aad9f9d6afe7fcafced45a4913d742a7ec00fd6170d63a68f986d8c2357765e4d38835d3fea301afab43a50bd9edd2dec6a979732b25292"+    ],+    -- COUNT = 8+    [ "7988146cbf9598d74cf88dc314af6b25c3f7de96ae9892fb0756318cea01987e"+    , "280bc1ae9bfdf8a73c2df07b82a32c9c"+    , ""+    , "2bbc607085232e5e12ccf7c0c19a5dc80e45eb4b3d4a147fe941fa6c13333474"+    , "f3f5c1bb5da59252861753c4980c23f72be1732f899fdea7183b5c024c858a12"+    , "44d0cfc4f56ab38fa465a659151b3461b65b2462d1ad6b3463b5cf96ad9dc577"+    , "34fb9a3cdacc834ff6241474c4f6e73ed6f5d9ea0337ab2b7468f01ad8a26e93"+    , "4caec9e760c4d468e47613fe50de4a366ae20ba76793744a4e14433ea4de79dc188601eb86c803b094641ab2337b99d459d37decc7d27473057be45ba848868ee0fb5f1cf303d2fcd0b3e0c36f65a65f81b3fee8778a1f22302e25dfe34e6d587fa8864e621121880f7cd55f350531c4ce0530099eec2d0059706dcd657708d9"+    ],+    -- COUNT = 9+    [ "1c974c953fa2a057c9fc9409a6843f6f839aa544bca4fa11e48afd77931d4656"+    , "ed7c08285464af7a5dbdc10b944a1270"+    , ""+    , "78146ad135acb836360d36afc50653dcc36c21662da2a6f6ae05222e75f34000"+    , "263c4984c238ded333c86472866353817379502157172cfa51371d82b1efd7b5"+    , "79b591529f9a26a0d7c8f8fd64e354b0c134ef1f757e43f9463b3dbb7a3da1ab"+    , "7d8f7204b0b5401ddce9e88dcf5facb9a44660a9f5f1c862748e7269c29f7964"+    , "72e2ca257b9edaf59b50e05a144f56fb517832fb9ad3489b1e664e3d5412cbf6b2883e891703b2e73aff9ab56da1009fcdef010ab4cdab996795c8f7c47fb1192bb160353997ad39d7d5fd0e2efc9103a7c3f158246afd53fe53ca6782f809698ef5f1f0d85536780a3fd6a8bafa475891c09213088bd1a3dc169257c34a517a"+    ],+    -- COUNT = 10+    [ "56216d71984a77154569122c777ce57e1d101a6025b28163a25971d39c1c5d0f"+    , "5cd148ba7e54f4975ac8e3e0f9b5d06a"+    , ""+    , "3580f8ca974626c77259c6e37383cb8150b4d0ab0b30e377bed0dc9d1ff1a1bf"+    , "15633e3a62b21594d49d3d26c4c3509f96011d4dbb9d48bbbea1b61c453f6abe"+    , "6068eaca85c14165b101bb3e8c387c41d3f298918c7f3da2a28786ab0738a6fc"+    , "e34f92d2b6aeeeea4ff49bfe7e4b1f462eabb853f0e86fbae0e8b3d51409ce49"+    , "587fdb856abc19ede9078797ecb44099e07aadcd83acdcb2b090601d653f4a14c68ab2ebdda63578c5633a825bae4c0c818f89aac58d30fd7b0b5d459a0f3d86fcad78f4bb14dfff08ad81e4ea9f487cb426e91d6e80dfed436ba38fce8d6f21ca2151c92dd5c323b077d6139c66395558f0537026c4a028affa271ef4e7ea23"+    ],+    -- COUNT = 11+    [ "83eb48bedc1e9294866ab8e5322ef83f6f271f8188e8fdabe5817788bd31570d"+    , "d6ed90bc692237f132441ede857a6629"+    , ""+    , "a4e5e127f992bd5ca79ee56bb8a9bccf74c21814bfaf97ffd052211e802e12e4"+    , "84136e403d9ed7f4515c188213abcfaca35715fa55de6d734aec63c4606a68f1"+    , "fe9d8ef26e2d2e94b99943148392b2b33a581b4b97a8d7a0ecd41660a61dd10b"+    , "594dad642183ce2cdc9494d6bcb358e0e7b767c5a0fa33e456971b8754a9abd5"+    , "86715d43ba95fbbca9b7193ea977a820f4b61ba1b7e3b8d161b6c51b09dfd5040d94c04338b14d97ed25af577186b36ae7251a486c8a2d24a35e84a95c89d669d49e307b4a368b72164135ac54d020a970a180dfbed135d2c86f01270846d5301bd73db2c431a8aa10a0a3d03d146e5fafb9a2aa0b4efc80edab06ff3b532236"+    ],+    -- COUNT = 12+    [ "ba2c94203dab2e6499d8c50dca7b5c34a6b4764834f9816631aa21b9f9c37361"+    , "67db133bdefb25e395085bceee5a0afc"+    , ""+    , "fa8984d16d35302cda35a3a355ab9242ec96fec0652d39282d4a0abf0a80df87"+    , "b6fed10255a3fea6772ae1ae6d9f6cbb9bfaa34804e58a5b786f9bc60b348ccd"+    , "445e072244edc716d3528f0e0a20ff0cd8f819c0d031736c8da122748f24d6c6"+    , "1f856e403c4fa035bac9aa81a20e347c7d8b213aab699d69d9d6186a06ac45c1"+    , "79f33fc36b3b47d9ac805bdbbe699909a8d0beb689a8b2723c291bd5bf7f3ce61343d4722a14e4add36312dbb0594910c8828aff1abc159915d498106f9ffb31147478d8c9ef75d1536ba5036506b313f6e85033f8f6fea2a4de817c867a59378c53c70a2f108275daedd415c05b61c4fd5d48c54be9adb9dea6c40a2ec99ee0"+    ],+    -- COUNT = 13+    [ "0db4c51492db4fe973b4bb1c52a1e873b58fc6bb37a3a4bfc252b03b994495d1"+    , "a2a3900f169bba3f78a42526c700de62"+    , ""+    , "29d5aab356876447e3a20d81c7e3fc6975e2b984180a91493044442999e1ca3a"+    , "40b34183b4e72cdff5952b317b3d45943d0fdcfa0527f3563055f7c73ae8f892"+    , "dc94220c99ffb595c7c4d6de8de5a6bb4b38847169e24a557ef6d879ad84149d"+    , "b2376626fd2f5218b3ed4a5609b43aa24d371cd2176ea017c2b99cf868060021"+    , "f0bd6bc4c506d9427a09352d9c1970b146360732841a6323f4cb602c87dedfb5ff7e6964b9144933af3c5c83017ccd6a94bdca467a504564aaa7b452591a16ff6a1e7e94ddc98f9a58016cdcb8caaed6c80671ba48cc81a832d341093dda1d4e5001ec6bf66348b21e3692a13df92538ad572bb2023822072fc95f9590293ffc"+    ],+    --  COUNT = 14+    [ "593845f0adfeffa7c169f8a610147ae8a08c0072fc0c14c3977d3de0d00b55af"+    , "9e0eb2507342ee01c02beadee7d077bd"+    , ""+    , "aefe591697eab678c52e20013aa424b95cfd217b259757fbe17335563f5b5706"+    , "cbb5be0ef9bf0555ee58955c4d971fb9baa6d6070c3f7244a4eb88b48f0793bf"+    , "6dd878394abdc0402146ba07005327c55f4d821bfebca08d04e66824e3760ab4"+    , "ba86a691d6cbf452b1e2fd1dfb5d31ef9ea5b8be92c4988dc5f560733b371f69"+    , "00735cbfafac5df82e5cb28fc619b01e2ba9571dc0023d26f09c37fb37d0e809066165a97e532bf86fa7d148078e865fe1a09e27a6889be1533b459cd9cd229494b5cf4d2abf28c38180278d47281f13820276ec85effb8d45284eb9eef5d179ab4880023ab2bd08ee3f766f990286bf32430c042f5521bbfd0c7ee09e2254d7"+    ]+    ]++{-+    [SHA-256]+    [PredictionResistance = False]+    [EntropyInputLen = 256]+    [NonceLen = 128]+    [PersonalizationStringLen = 256]+    [AdditionalInputLen = 0]+    [ReturnedBitsLen = 1024]+-}++r3 :: [TestVector]+r3 =+    [+    -- COUNT = 0+    [ "fa0ee1fe39c7c390aa94159d0de97564342b591777f3e5f6a4ba2aea342ec840"+    , "dd0820655cb2ffdb0da9e9310a67c9e5"+    , "f2e58fe60a3afc59dad37595415ffd318ccf69d67780f6fa0797dc9aa43e144c"+    , "e0629b6d7975ddfa96a399648740e60f1f9557dc58b3d7415f9ba9d4dbb501f6"+    , ""+    , ""+    , ""+    , "f92d4cf99a535b20222a52a68db04c5af6f5ffc7b66a473a37a256bd8d298f9b4aa4af7e8d181e02367903f93bdb744c6c2f3f3472626b40ce9bd6a70e7b8f93992a16a76fab6b5f162568e08ee6c3e804aefd952ddd3acb791c50f2ad69e9a04028a06a9c01d3a62aca2aaf6efe69ed97a016213a2dd642b4886764072d9cbe"+    ],+    -- COUNT = 1+    [ "cff72f345115376a57f4db8a5c9f64053e7379171a5a1e81e82aad3448d17d44"+    , "d1e971ec795d098b3dae14ffcbeecfd9"+    , "6ec0c798c240f22740cad7e27b41f5e42dccaf66def3b7f341c4d827294f83c9"+    , "45ec80f0c00cad0ff0b7616d2a930af3f5cf23cd61be7fbf7c65be0031e93e38"+    , ""+    , ""+    , ""+    , "17a7901e2550de088f472518d377cc4cc6979f4a64f4975c74344215e4807a1234eefef99f64cb8abc3fb86209f6fc7ddd03e94f83746c5abe5360cdde4f2525ccf7167e6f0befae05b38fd6089a2ab83719874ce8f670480d5f3ed9bf40538a15aaad112db1618a58b10687b68875f00f139a72bdf043f736e4a320c06efd2c"+    ],+    -- COUNT = 2+    [ "b7099b06fc7a8a74c58219729db6b0f780d7b4fa307bc3d3f9f22bfb763596a3"+    , "b8772059a135a6b61da72f375411de26"+    , "2ac1bfb24e0b8c6ac2803e89261822b7f72a0320df2b199171b79bcbdb40b719"+    , "9aec4f56ec5e96fbd96048b9a63ac8d047aedbbeea7712e241133b1a357ecfc4"+    , ""+    , ""+    , ""+    , "0e1f2bfef778f5e5be671ecb4971624ec784ed2732abc4fbb98a8b482fb68737df91fd15acfad2951403ac77c5ca3edffc1e03398ae6cf6ac24a91678db5c7290abc3fa001aa02d50399326f85d2b8942199a1575f6746364740a5910552c639804d7530c0d41339345a58ff0080eccf1711895192a3817a8dc3f00f28cc10cc"+    ],+    -- COUNT = 3+    [ "7ba02a734c8744b15ef8b4074fe639b32e4431762ab5b7cd4d5df675ea90672b"+    , "8a424f32108607c8f1f45d97f500ee12"+    , "3ad627433f465187c48141e30c2678106091e7a680229a534b851b8d46feb957"+    , "d8f02b59b6a3dd276bc69cba68efcf11ab83ead1397afd9841786bd1bb5da97a"+    , ""+    , ""+    , ""+    , "1fb91186ba4b4459d994b4b9f4ca252c7be6294d6cdb5fe56f8ff784d4b190a1c6456e0a41223bbbdf83ed8e7cfbfa765d9d8bc7ea5f4d79ea7eccb4928081a21de4cca36620d6267f55d9a352b76fc0a57375884112c31f65ff28e76d315698c29e6c4c05cb58b0a07ae66143b4abc78b9d25c78b4121e1e45bef1a6c1793e2"+    ],+    -- COUNT = 4+    [ "9a8865dfe053ae77cb6a9365b88f34eec17ea5cbfb0b1f04d1459e7fa9c4f3cb"+    , "180c0a74da3ec464df11fac172d1c632"+    , "336372ec82d0d68befad83691966ef6ffc65105388eb2d6eed826c2285037c77"+    , "75b95108eff1fabe83613e1c4de575e72a5cdc4bb9311dd006f971a052386692"+    , ""+    , ""+    , ""+    , "3c683f6d4f8f5a4018d01633dfee74266aaa68ed6fc649e81b64dfdf5f75e75d5c058d66cf5fd01a4f143a6ff695517a4a43bd3adfd1fb2c28ba9a41063140bedbffdb4d21b1ace1550d59209ec61f1e2dbacb2a9116a79cb1410bf2deca5218080aacd9c68e1d6557721a8913e23f617e30f2e594f61267d5ed81464ee730b2"+    ],+    -- COUNT = 5+    [ "22c1af2f2a4c885f06988567da9fc90f34f80f6dd5101c281beef497a6a1b2f8"+    , "3fafdecf79a4174801f133131629037b"+    , "80327dac486111b8a8b2c8e8381fb2d713a67695c2e660b2b0d4af696cc3e1de"+    , "f95a0e4bd24f0e2e9e444f511b7632868ead0d5bb3846771264e03f8ab8ed074"+    , ""+    , ""+    , ""+    , "77a7fea2f35a188f6d1bfdd49b569d8c45e2dd431d35a18c6f432c724f1e33ae92cb89a9cf91519e50705a53199f5b572dc85c1aef8f28fb52dc7986228f66954d54eda84a86962cf25cf765bd9949876349291b1aae5f88fcf4b376912d205add4f53b2770c657946c0d824281f441509153f48356d9d43f8a927e0693db8fc"+    ],+    -- COUNT = 6+    [ "d0840e3a8d629d5b883d33e053a341b21c674e67e1999f068c497ecfaabfd6f6"+    , "071de7244ecb2fdf7ab27f2d84aa7b7a"+    , "90d609527fad96ffe64ab153860346f3d237c8940555ae17b47842d82d3b0943"+    , "1dd1a8b59856c49a388f594c5f42cc2e4a56b3ccb8a65e7066e44c12f4344d50"+    , ""+    , ""+    , ""+    , "7ab28a9b2d3ae999195553e6550cced4c2daccbe7ec9dcbb0d467fabba185b727fbfd9830242cd098f4db3cf4a85e8bf8e8d5974b62b28550922b32ed5bfc1a522b6605cf93bf8d90bdec1c5b9e59c6fc37a817d437068a87254be1f7c4618ada46fbc3a2efb02e44524e21d91be7534cf05fbfd858304b706d6a91ea1cc6ad5"+    ],+    -- COUNT = 7+    [ "2e2dd56869104492767a59778652831919e1c8b970f84e824ae4116597a0ab7f"+    , "01c42a7e983641de46c82fd09b4f2f76"+    , "bcd9e1508fcc22820a8be07180fea5045367333b569e111b011cd57dc1858765"+    , "7306507cd3ca7eec667e640d270cfbb033063d97520b6b7e38ff3cea0e79d12b"+    , ""+    , ""+    , ""+    , "b915726c7b8c5dc3975f1a334684b973abf6a9495d930088cf5d071548e4fd29a67b55cc561ed6949ad28150a9fb4307c1fa5f783a7ea872e8d7c7e67ff0c2906081ee915737d813c25be5c30b952a36f393e6baa56ab01adc2b4776ad7b5d036a53659877c7a4e5220a897d6c0799af37beeed91173fbe9c613c3b6b9bb28e5"+    ],+    -- COUNT = 8+    [ "d1aab0f16bd47a5ccd67c22e094daa3735eae21aa57f0bcd9e053d9d0d545cb8"+    , "199310dfe1b01265b8c0d2b46d6c7c9f"+    , "625b4b8f4de72ea9cb6f70556322dc2a19d6b2b32de623f557e419a084ba60fd"+    , "f50cabae4e060f3971096b78e550cda2837a26a693d905db2d992d589b268f44"+    , ""+    , ""+    , ""+    , "987e1fdfe004c619cf1e9034576707eccd849400e19c87a1fef5b0179ec51c42a2f8c45d7942d0023a023c89f188b2634362703985695369863322f58619c50a7385a2dc91fc78f94b59f0131dc2b56a0d7c699d427285da1c104b0ad1739da10d8071c23993787045dc21f0070e1e9aa1658fc8e3add73dac7262e80e0aa2ee"+    ],+    -- COUNT = 9+    [ "449480eaa100aff6f48dc6286a5a81b9728b084864f78a9da98f606a00a6a41f"+    , "e53c6c5ac3da9f4726389a03f97bb640"+    , "6b8fedc084d8e28d333aef6db3702b6351f0d24e30908cccb63794282655886b"+    , "73a6d64e1966ae324388dc12c14544e9dc5ae4fcb331e99d350c456ff16f9aa0"+    , ""+    , ""+    , ""+    , "a06912d362da7eb25598857f6d65344c3e23ec3deb80c6e43158845b95eaeca241c0bbbd67ac385e24693444455cc1c2c08c1134d956b8bc93b28be9c2d3322b3e09252979dfb8d39d04c94f81bebda5c73110605a237b561216bda9ee9bdee1cc0c7728bcc8304682334ca944e467a27a85313fa5395a9c790e35defd2edb12"+    ],+    -- COUNT = 10+    [ "9a6174166e97aa4981ddf580bc01c96754b9f0ba042750aabfda1cffe56e8581"+    , "d7512ff6b7db7ce141b2bb01dcd0425e"+    , "ed75288f23275f9422444da5d3b53ccb3c4ac8acfb659a1e9b7655c2db52f879"+    , "6888b9277e57dc57663d402eba8d03cf56a070dc868e6a128b18040002baf690"+    , ""+    , ""+    , ""+    , "03519dfb2ff88cc2b53eecc48ae2a18ddcf91a5d69d5aefcdda8444e6df790a5240e67b2a4de75b4bb8a31f0f8aeb5e785ffb7a1341bb52fe00a05ee66fa2d44ea9956e055f9ffa6647c3bfe851ab364ade71a0d356de710ddafb7622b1da1bc53fd4d3210407289c68d8aeb346bf15806dbe787e781b94f63da3e1f61b5ac60"+    ],+    -- COUNT = 11+    [ "9c6ae1002ee1b0add0be563ce50f899da936e13efa620d08c2688c192514763a"+    , "fde7db5160c73044be73e9d4c1b22d86"+    , "8fdaaeffd64e53f7b4374d902d441209964e12b65d29afec258e65db6de167ca"+    , "bcc28fd58e397f53f494ad8132df82c5d8c4c22ea0b7139bd81eeba65667bb69"+    , ""+    , ""+    , ""+    , "021d938c9b4db780c7d8134aeff1053e5b8843370b8ae9a6749fca7199d809810f1bc8dfa49426470c30c3616f903e35fbacb23420a32f1bee567cc32300f704246ddc0217f236ef52c3ec9e2433ca66f05c25721f7661c43f22c1a125ed5db531bd0836eb435c27eefc7424ce9d845e1d4cc4c503097b4ffca788e674a5cb53"+    ],+    -- COUNT = 12+    [ "fe96a85b69d46b540918927bb609dc57642eeaefd46bb5da2163a0bc60294b58"+    , "22195a410d24db45589448dfe979d3fd"+    , "20f698833a4472fd7b78fb9b0c4eb68604f166a2694c4af48dac2b2376790e1e"+    , "09cb870879d3f734214f6a4bd2e08c62a2a954bebe559416d8c3551aafe71d6a"+    , ""+    , ""+    , ""+    , "d3e96dbe29e1fcb8ed83b19dbfb240e6f41679fbe83853aa71446617e63e5af78cf98b331d15bccb8c673c4e5d5dcec467a1fe26a6cd1696d0c9bc49f78139d051287df7f3ae0dbb4bbf581cb8211931063c3f4612ced53f59d1b4ebb875729139f5d2a7d60642e8f2835eed888b7e3e49c0dffd012cd746abfa3e1c5c2308c6"+    ],+    -- COUNT = 13+    [ "a4fd693ff0a8af24bcec352d3196549fd0da5ee5d99ca58416ca03ce4c50f38e"+    , "8cd67f2bf71d4366ce61396642531ff5"+    , "368969c15a4849d7593be8b162113b9298a535c148ff668a9e8b147fb3af4eba"+    , "83d2be9a0d74e6a42159ae630acebf4e15271ef7f14f3de14752be0e0e822b11"+    , ""+    , ""+    , ""+    , "e9188fc0eaec74b2608e21e3a40be94aaf4ae08eb684de8f8bba2d5fd3b073aa5531c938c0fc628da65725c54b5c68bb91d7d326565e96685e0a4e7b220c50e0caf1628edba5bd755b31894f8cb90afa76e88c5eb9e61b4932444c1397dee3e32241a3fb70a3929e49f6da02eea54812abb3d6b5cee18f03af1e0b4958430ab3"+    ],+    -- COUNT = 14+    [ "254ff5687a6dad3f1d237dc762f58d24ef2e2c084d0a48d26a3dc81e5490cda3"+    , "f2ec392acca491e03ce47b95963a49fc"+    , "f806b9b4a56682c61b55cb6a334caf87ffe135adfea6d0c3fc22b39898fbd078"+    , "b8494b1c1f1752fb6f80d732a89b08115857f7cc96e7dff05ebb822706889917"+    , ""+    , ""+    , ""+    , "0e527e00494d55564f9d9b28e7110f9a61ce36c883b5be2dcb055444164cdddd1a9f2731716f22d6ff476ce413c77abfc0e946871d5481345c2e97b4bfdd12ac03df606fc56bdb99ac7b71a69b5b9160373bbec3e9dde477180af454e7acc6bc58dc0afb4281c0de4354c1bf599054e3800c6d60d892858865b5361f50bfca9b"+    ]+    ]++{-+    [SHA-256]+    [PredictionResistance = False]+    [EntropyInputLen = 256]+    [NonceLen = 128]+    [PersonalizationStringLen = 256]+    [AdditionalInputLen = 256]+    [ReturnedBitsLen = 1024]+-}++r4 :: [TestVector]+r4 =+    [+    -- COUNT = 0+    [ "cdb0d9117cc6dbc9ef9dcb06a97579841d72dc18b2d46a1cb61e314012bdf416"+    , "d0c0d01d156016d0eb6b7e9c7c3c8da8"+    , "6f0fb9eab3f9ea7ab0a719bfa879bf0aaed683307fda0c6d73ce018b6e34faaa"+    , "8ec6f7d5a8e2e88f43986f70b86e050d07c84b931bcf18e601c5a3eee3064c82"+    , "1ab4ca9014fa98a55938316de8ba5a68c629b0741bdd058c4d70c91cda5099b3"+    , "16e2d0721b58d839a122852abd3bf2c942a31c84d82fca74211871880d7162ff"+    , "53686f042a7b087d5d2eca0d2a96de131f275ed7151189f7ca52deaa78b79fb2"+    , "dda04a2ca7b8147af1548f5d086591ca4fd951a345ce52b3cd49d47e84aa31a183e31fbc42a1ff1d95afec7143c8008c97bc2a9c091df0a763848391f68cb4a366ad89857ac725a53b303ddea767be8dc5f605b1b95f6d24c9f06be65a973a089320b3cc42569dcfd4b92b62a993785b0301b3fc452445656fce22664827b88f"+    ],+    -- COUNT = 1+    [ "3e42348bf76c0559cce9a44704308c85d9c205b676af0ac6ba377a5da12d3244"+    , "9af783973c632a490f03dbb4b4852b1e"+    , "2e51c7a8ac70adc37fc7e40d59a8e5bf8dfd8f7b027c77e6ec648bd0c41a78de"+    , "45718ac567fd2660b91c8f5f1f8f186c58c6284b6968eadc9810b7beeca148a1"+    , "63a107246a2070739aa4bed6746439d8c2ce678a54fc887c5aba29c502da7ba9"+    , "e4576291b1cde51c5044fdc5375624cebf63333c58c7457ca7490da037a9556e"+    , "b5a3fbd57784b15fd875e0b0c5e59ec5f089829fac51620aa998fff003534d6f"+    , "c624d26087ffb8f39836c067ba37217f1977c47172d5dcb7d40193a1cfe20158b774558cbee8eb6f9c62d629e1bcf70a1439e46c5709ba4c94a006ba94994796e10660d6cb1e150a243f7ba5d35c8572fd96f43c08490131797e86d3ed8467b692f92f668631b1d32862c3dc43bfba686fe72fdd947db2792463e920522eb4bc"+    ],+    -- COUNT = 2+    [ "b63fdd83c674699ba473faab9c358434771c5fa0348ca0faf7ebd7cf5891826b"+    , "5fd204e2598d9626edab4158a8cfd95f"+    , "2a5dfad8494306d9d4648a805c4602216a746ae3493492693a50a86d1ba05c64"+    , "adea5ba92f8010bb1a6a4b6fae2caa0b384165adf721253afd635d6021f764af"+    , "07c69d8d2b8aa1454c5c48083dd41477fda6bfcf0385638379933a60ed2e0a77"+    , "a14e902247a3d6493d3fbc8519518b71a660e5502cf7ecfc796cfaa5b4ee4baa"+    , "60e690e4a1eba14aec5187112a383e9991347fab7bac7cb2a40a52579a0d2718"+    , "792b47b6ed221623bb187d63e3f039c6983d94efd5771dc9b4c40bee65924513485a6332baeda6a96f9bb431f592d73462b61d9d914a72b56fa9d87597426fb246424ebcd7abd51b2eefec8f5b839c0b3c34015342ace296b5f2218fa194b50aea1c89663460292c92c45f112ddbf6b9406f6e7ccee9c47ed2d90a27be5dd73e"+    ],+    -- COUNT = 3+    [ "dab85f98eaf0cfba013b97de4d9c264ca6fe120366cb83e8b3113c68b34e39d5"+    , "d05108e1028ae67b4ea63bdc6d75eb88"+    , "09fed3822f6f5e5b9e575d31dc215de1607b0dfc927412618c2d8f79166dbaba"+    , "1794885a64470744198b7d0bc24472ffe8daf3c7eb219df6ddf180e484fe0aa5"+    , "8d74d01b582f70b92f53b43468084e1586d9b36465d333d5faaf6911e62fe40e"+    , "ef7f6b6eb479ab05b3f9ab6dd72eac8b1e86d887f1bcae363cae386d0275a06f"+    , "7442b2a792a6a29559bb8a515d56916ee18200580aa02e1237dd358619382d8f"+    , "49d2cbfa0897b7d961c293c1e572fb26f28e7b956e746f6eda90454c1370a29e25303ceadc7837514dc638553b487ef9487c977c10625409178ad6506d103c487a66655d08659d92a4d5994d1c8ddb28fe60f2e49577d6e80cae1478068c98268f45e6293c9326c7f726ec89601351c0a26fd3a6549f8a41c6f58692c86594c0"+    ],+    -- COUNT = 4+    [ "0f0aa84ef12e10ae2b279e799c683441862457b9bc25581c2cd3d5b58a5b3246"+    , "f74f4230c2427a52f01f39e825d250ac"+    , "d02b2f53da48b923c2921e0f75bd7e6139d7030aead5aeebe46c20b9ca47a38a"+    , "5222b26e79f7c3b7066d581185b1a1f6376796f3d67f59d025dd2a7b1886d258"+    , "d11512457bf3b92d1b1c0923989911f58f74e136b1436f00bad440dd1d6f1209"+    , "54d9ea7d40b7255ef3d0ab16ea9fdf29b9a281920962b5c72d97b0e371b9d816"+    , "601cef261da8864f1e30196c827143e4c363d3fa865b808e9450b13e251d47fa"+    , "e9847cefea3b88062ea63f92dc9e96767ce9202a6e049c98dc1dcbc6d707687bd0e98ed2cc215780c454936292e44a7c6856d664581220b8c8ca1d413a2b81120380bfd0da5ff2bf737b602727709523745c2ced8daef6f47d1e93ef9bc141a135674cba23045e1f99aa78f8cead12eeffff20de2008878b1f806a2652db565a"+    ],+    -- COUNT = 5+    [ "6a868ce39a3adcd189bd704348ba732936628f083de8208640dbd42731447d4e"+    , "efdde4e22b376e5e7385e79024350699"+    , "f7285cd5647ff0e2c71a9b54b57f04392641a4bde4a4024fa11c859fecaad713"+    , "0174f7f456ac06c1d789facc071701f8b60e9accebced73a634a6ad0e1a697d4"+    , "5463bb2241d10c970b68c3abc356c0fe5ef87439fc6457c5ee94be0a3fb89834"+    , "3ab62cdbc638c1b2b50533d28f31b1758c3b8435fe24bb6d4740005a73e54ce6"+    , "2dbf4c9123e97177969139f5d06466c272f60d067fefadf326ccc47971115469"+    , "8afce49dccc4ff64c65a83d8c0638bd8e3b7c13c52c3c59d110a8198753e96da512c7e03aeed30918706f3ad3b819e6571cfa87369c179fb9c9bbc88110baa490032a9d41f9931434e80c40ae0051400b7498810d769fb42dddbc7aa19bdf79603172efe9c0f5d1a65372b463a31178cbae581fa287f39c4fbf8434051b7419f"+    ],+    -- COUNT = 6+    [ "bb6b339eae26072487084ec9e4b53f2f1d4267d205042e74c77fb9ca0591ba50"+    , "c0e7bf6eb07feccbc494af4098e59d30"+    , "34aeec7ed0cae83701b6477709c8654a1114212401dc91cbe7de39d71f0c06e1"+    , "f47fc60afbeb807236f7974d837335bc0b22288ef09ddfcb684e16b4c36a050b"+    , "e8071ccd84ac4527e5c6e85b0709ed867776f25ae0e04180dcb7105ecd3e3490"+    , "fbac45b5952200ad7c4232500f2417a1c14723bdd1cc078821bc2fe138b86597"+    , "c4292d7dbef3ba7c18bf46bcf26776add22ab8ee206d6c722665dec6576b1bc0"+    , "228aa2a314fcbfe63089ce953ac457093deaa39dd9ce2a4ece56a6028a476a98129be516d6979eff5587c032cdf4739d7ac712970f600fa781a8e542e399661183e34e4b90c59ec5dc5cad86f91083529d41c77b8f36c5a8e28ba1a548223a02eaed8426f6fe9f349ebec11bc743e767482e3472ec2799c1f530ebdc6c03bc4b"+    ],+    -- COUNT = 7+    [ "be658e56f80436039e2a9c0a62952dd7d70842244b5ab10f3b8a87d36104e629"+    , "33c9627455dfde91865aee93e5071147"+    , "d3a6eb29b180b791984deb056d72c0608a2c9044237aecf100ccb03700064c5e"+    , "bef24dc9a5aa23003d3825f9b2b00e7dab571ea6ad86415dbd30c0bbdce7b972"+    , "047c29e4d1584fa70cb66e2aa148a2aa29837c5eee64dcac60fdba356cdf90bb"+    , "41c4792161b1b00d410cb79cd56bd311a714fb78dc3471c25bdd7479f2e9a952"+    , "cd4936d7bc3ea0e7201bcbefbc908215a97680ca6ce8672360aea600b6564308"+    , "2c25557f6db07db057f56ad5b6dc0427d1a0e825c48c19a526f9a65087c6d1ead7c78363a61616c84f1022653af65173a3f9ec3275f2b0a0d0bc750194673c0eaa6c623cd88abb0c8979baee4cd85bfce2e4a20bfebf2c3be61676563767dfe229e0b7be67ad6fcd116dd0b460708b1b0e5c3d60f3dd8138030404d197375d75"+    ],+    -- COUNT = 8+    [ "ae537f31a28ca14500e759716bc207983bfeab60b25079fa30b77b8d41244cb9"+    , "fca9e27d8ab84cf9b9ce491ec5d8cb67"+    , "8c9cb2b19aa3abe83c8fe7da96e9c11648252653a29dcd5bf0ac334ac587f032"+    , "1eb52777be480f05115ae6370f30159a94d50ffcc64454678ab1d1ac6f166fa7"+    , "9cdf6f1a2bc07acd4b0f43b5f2b892a1153e2669f237d257923636094fb40b54"+    , "692d512722de6ba720fd23c8994ac63179b5f7e611addf9cfacd60e06e144a6a"+    , "bbeea7b2bea821f339f494947c0b4bae8056119db69a3cbef21914953729cdef"+    , "c0c4fb7080c0fbe425c1b756fb3a090cb0d08c7027d1bb82ed3b07613e2a757f83a78d42f9d8653954b489f800a5e058ebc4f5a1747526541d8448cb72e2232db20569dc96342c36672c4be625b363b4587f44557e58cedb4597cb57d006fda27e027818ae89e15b4c6382b9e7a4453290ea43163b4f9cae38b1023de6a47f7b"+    ],+    -- COUNT = 9+    [ "2f8994c949e08862db0204008f55d3561f3e0362df13b9d9a70fda39938f2d33"+    , "1bf3e94ea858160b832fe85d301256f5"+    , "b46671cf7fa142e7012ed261e1fe86714711c246c7d1c0330fa692141e86d5d1"+    , "5ecdb1e8fe12260b9bfe12d6e6f161474fa2311e12e39b0beb0fcd92a6737b73"+    , "3ce9a29f0207d079e6dc81fb830356e555f96a23ea71424972ea9308965786d3"+    , "db950000c0776cc0e049929ce021020adc42d29cd9b5d8f7117fbe6bde3e594f"+    , "fc18ee6dd3dac2306774f0ac36cd789e33462d72a8c75df9057123db33e5f7bc"+    , "8546362cc8af9b78dd6e8eb2c37db96e70708852bfd9380abedc7f324575a167bea18f632f3e19d099cfbf310773f9719eec036d2e09f393a023add8ebdc4fb87af43b2fe6c7eaa4d39f8022ce247aa45fdc84d1b92cacce6eae8252a03ec2ec5330c01f56d113fd2ec3d0240af0afcf13ddde205bb5e7c2d912dcb4aee5dcf3"+    ],+    -- COUNT = 10+    [ "0c85e31487de1d7ba4a7b998ac56dc42c6dc0eae7bf5c8aaf1e4e78875f5fb47"+    , "de878f728f73f83dc2a2f550b96c8b97"+    , "9aac37bce1a6a81dc7934e23747991e3cf48c55ffe5a57781c41768a35220a01"+    , "2d5ca8af1a70cfdccd015ee3bf0665dd1941fc6a7317b9d0d06658f5744cfbd9"+    , "db881e6d0dc3b62793d7da5fe5a18e33be9b93f4a63a00a878dfbecf0d383bd2"+    , "f743ce1b72f3de4c901369eed581c626ed3081ca707e6634fdaff46721ce0878"+    , "cd52da3ec8a839c537dacdea8506a3eeee879de388ff5e513322d6d1bb3ff694"+    , "a5bdd57cb8fde6298e7c5e563afcca60dd472eca484bd8c3cc17f3307be09b601744dd3ab9e8a44107c5868824575f850c0f399b280cf198006f83ede8c0b537e9be227fa140b65995ad9dfa1f2303d560c3b7f59bedd93c1282ea263924469411c2653f87fd814c74cb91c148430481d64bad0fec3cbb3dd1f39aa55c36f81b"+    ],+    -- COUNT = 11+    [ "93161b2dc08cb0fd50171141c865a841ca935cfdd2b5907d6ff8ab0348c4ceb0"+    , "5cb9f6e5912b90c3349a50ab881b35a1"+    , "0dceb4a36326c4df1685df43fddeecb5d0c76f00eb44826694f27e610290f6e1"+    , "d8e9be44b5f293482548d4787762ebfb03c73c40e45385e8b98907cd66f493dd"+    , "105a8f85d6959f3e043ef508cfea21d52123f03b7aea8034c4eec761eaba1fee"+    , "bf781f7e489d9b4b5aa5ee6d1796468af672a8d25f311edf3c4b4dbf433d703f"+    , "c81d6bcf1e5bf37e39dda1735c6f193df115b1a854a12e7cafe060afe4589335"+    , "4306628124d0100fade7eaaf5edf227d50771f9e5f2e1e983800eef9a39fde0b0c280e63c8728d836b5b93ea794a32c1c04cfc54bd5300e3febb5fe2e1023eded8d7cd180279a598f76823e8d5a7dffcc93a09deec5d1f80838e938fba4de9f47e94b99382ae55f116df9c3b3ddf7e50516e203645852a415796f03a86418107"+    ],+    -- COUNT = 12+    [ "1ae12a5e4e9a4a5bfa79da30a9e6c62ffc639572ef1254194d129a16eb53c716"+    , "5399b3481fdf24d373222267790a0fec"+    , "8280cfdcd7a575816e0199e115da0ea77cae9d30b49c891a6c225e9037ba67e2"+    , "681554ff702658122e91ba017450cfdfc8e3f4911153f7bcc428403e9c7b9d68"+    , "226732b7a457cf0ac0ef09fd4f81296573b49a68de5e7ac3070e148c95e8e323"+    , "45942b5e9a1a128e85e12c34596374ddc85fd7502e5633c7390fc6e6f1e5ef56"+    , "6fc59929b41e77072886aff45f737b449b105ed7eacbd74c7cbfedf533dbeaa1"+    , "b7547332e1509663fcfea2128f7f3a3df484cd8df034b00199157d35d61e35f1a9d481c7d2e81305616d70fc371ee459b0b2267d627e928590edcac3231898b24ef378aa9c3d381619f665379be76c7c1bd535505c563db3725f034786e35bdd90429305fd71d7bf680e8cdd6d4c348d97078f5cf5e89dee2dc410fad4f2a30f"+    ],+    -- COUNT = 13+    [ "29e20d724dfa459960df21c6ec76b1e6cabd23a9e9456d6c591d7e4529da0ef8"+    , "95df1f837eba47a1687aa5c4ddcf8aaf"+    , "3713b601e164b1a51dda1ca9242ff477514648e90d311a06e10ce5aa15da5d7f"+    , "2a2a312626ca3e20034fc4f28033c7d573f66ef61ab2ea0c7bf0411a9d247264"+    , "ec68be33ac8ff3dd127e051604898c0f9a501271859376653a0516336180993d"+    , "9935499661d699a00c622a875441b4df5204958fe95892c8ce67f7dfb2be3e4a"+    , "256a4ba9e8f439d5487fa5eb45efcf1bc1120491724db3abe328d951f2739fc9"+    , "73114cb3624d687d4cd49a6e769dfc7a3f8901dc41f6ad1df4ce480536fa82e52ae958d0528640d92b8bb981b755058e32c4733682e5c4c0df41f3505a1643a0dd49cfdeaf7a18adffca88256c6d2cceb838af6c92a64bc21cb7a760a0391291bfe3575e014fc156323f8eb5e86518c669dad8d29ad5fd4ef6e296f4a0764c26"+    ],+    -- COUNT = 14+    [ "1353f3543eb1134980e061fc4382394975dbc74f1f1ea5ecc02780a813ac5ee6"+    , "cf584db2447afbe2c8fa0c15575ee391"+    , "345b0cc016f2765a8c33fc24f1dcfa182cbe29d7eacbcdc9bcda988521458fc2"+    , "ba60219332a67b95d90ec9de6b8453d4c8af991ae9277461ff3af1b92fc985d3"+    , "6964b9b9842aec9c7ec2aad926d701f30eec76fe699265ae2a7765d716958069"+    , "6a03c28a9365c558c33d3fdc7e5ebf0b4d32caac70df71403fd70ced09757528"+    , "a58546c72a0b4d47c9bd6c19e7cf4ab73b2d7ba36c6c6dc08606f608795ebd29"+    , "5b029ef68b6799868b04dc28dbea26bc2fa9fcc8c2b2795aafeed0127b7297fa19a4ef2ba60c42ff8259d5a759f92bd90fdfb27145e82d798bb3ab7fd60bfaefb7aefb116ca2a4fa8b01d96a03c47c8d987fdd33c460e560b138891278313bb619d0c3c6f9d7c5a37e88fce83e94943705c6ff68e00484e74ad4097b0c9e5f10"+    ]+    ]
+ test/Haskoin/Crypto/SignatureSpec.hs view
@@ -0,0 +1,165 @@+{-# LANGUAGE OverloadedStrings #-}+module Haskoin.Crypto.SignatureSpec (spec) where++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           Haskoin.Crypto        (SecKey, Sig, decodeStrictSig,+                                        derivePubKey, exportSig,+                                        importCompactSig, isCanonicalHalfOrder,+                                        sha256, signHash, verifyHashSig)+import           Haskoin.Test          (arbitrarySignature)+import           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+        prop "verify signature" $+            forAll arbitrarySignature $ \(msg, key, sig) ->+                verifyHashSig msg sig (derivePubKey key)+        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+        prop "encodes and decodes signature" $+            forAll arbitrarySignature $+            (\s -> decodeStrictSig (exportSig s) == Just s) . lst3+    describe "trezor rfc6979 test vectors" $ do+        it "rfc6979 test vector 1" (testSigning $ head detVec)+        it "rfc6979 test vector 2" (testSigning $ detVec !! 1)+        it "rfc6979 test vector 3" (testSigning $ detVec !! 2)+        it "rfc6979 test vector 4" (testSigning $ detVec !! 3)+        it "rfc6979 test vector 5" (testSigning $ detVec !! 4)+        it "rfc6979 test vector 6" (testSigning $ detVec !! 5)+        it "rfc6979 test vector 7" (testSigning $ detVec !! 6)+        it "rfc6979 test vector 8" (testSigning $ detVec !! 7)+        it "rfc6979 test vector 9" (testSigning $ detVec !! 8)+        it "rfc6979 test vector 10" (testSigning $ detVec !! 9)+        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 "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+++{- ECDSA Canonical -}++-- github.com/bitcoin/bitcoin/blob/master/src/script.cpp+-- from function IsCanonicalSignature+testIsCanonical :: Sig -> Bool+testIsCanonical sig = not $+    -- Non-canonical signature: too short+    (len < 8) ||+    -- Non-canonical signature: too long+    (len > 72) ||+    -- Non-canonical signature: wrong type+    (BS.index s 0 /= 0x30) ||+    -- Non-canonical signature: wrong length marker+    (BS.index s 1 /= len - 2) ||+    -- Non-canonical signature: S length misplaced+    (5 + rlen >= len) ||+    -- Non-canonical signature: R+S length mismatch+    (rlen + slen + 6 /= len) ||+    -- Non-canonical signature: R value type mismatch+    (BS.index s 2 /= 0x02) ||+    -- Non-canonical signature: R length is zero+    (rlen == 0) ||+    -- Non-canonical signature: R value negative+    testBit (BS.index s 4) 7 ||+    -- Non-canonical signature: R value excessively padded+    (  rlen > 1+    && BS.index s 4 == 0+    && not (testBit (BS.index s 5) 7)+    ) ||+    -- Non-canonical signature: S value type mismatch+    (BS.index s (fromIntegral rlen + 4) /= 0x02) ||+    -- Non-canonical signature: S length is zero+    (slen == 0) ||+    -- Non-canonical signature: S value negative+    testBit (BS.index s (fromIntegral rlen+6)) 7 ||+    -- Non-canonical signature: S value excessively padded+    (  slen > 1+    && BS.index s (fromIntegral rlen + 6) == 0+    && not (testBit (BS.index s (fromIntegral rlen + 7)) 7)+    )+  where+    s = exportSig sig+    len = fromIntegral $ BS.length s+    rlen = BS.index s 3+    slen = BS.index s (fromIntegral rlen + 5)+++{- Trezor RFC 6979 Test Vectors -}+-- github.com/trezor/python-ecdsa/blob/master/ecdsa/test_pyecdsa.py++detVec :: [(SecKey, ByteString, Text)]+detVec =+    [+      ( "0000000000000000000000000000000000000000000000000000000000000001"+      , "Satoshi Nakamoto"+      , "934b1ea10a4b3c1757e2b0c017d0b6143ce3c9a7e6a4a49860d7a6ab210ee3d82442ce9d2b916064108014783e923ec36b49743e2ffa1c4496f01a512aafd9e5"+      )+    , ( "0000000000000000000000000000000000000000000000000000000000000001"+      , "All those moments will be lost in time, like tears in rain. Time to die..."+      , "8600dbd41e348fe5c9465ab92d23e3db8b98b873beecd930736488696438cb6b547fe64427496db33bf66019dacbf0039c04199abb0122918601db38a72cfc21"+      )+    , ( "fffffffffffffffffffffffffffffffebaaedce6af48a03bbfd25e8cd0364140"+      , "Satoshi Nakamoto"+      , "fd567d121db66e382991534ada77a6bd3106f0a1098c231e47993447cd6af2d06b39cd0eb1bc8603e159ef5c20a5c8ad685a45b06ce9bebed3f153d10d93bed5"+      )+    , ( "f8b8af8ce3c7cca5e300d33939540c10d45ce001b8f252bfbc57ba0342904181"+      , "Alan Turing"+      , "7063ae83e7f62bbb171798131b4a0564b956930092b33b07b395615d9ec7e15c58dfcc1e00a35e1572f366ffe34ba0fc47db1e7189759b9fb233c5b05ab388ea"+      )+    , ( "e91671c46231f833a6406ccbea0e3e392c76c167bac1cb013f6f1013980455c2"+      , "There is a computer disease that anybody who works with computers knows about. It's a very serious disease and it interferes completely with the work. The trouble with computers is that you 'play' with them!"+      , "b552edd27580141f3b2a5463048cb7cd3e047b97c9f98076c32dbdf85a68718b279fa72dd19bfae05577e06c7c0c1900c371fcd5893f7e1d56a37d30174671f6"+      )+    , ( "0000000000000000000000000000000000000000000000000000000000000001"+      , "Everything should be made as simple as possible, but not simpler."+      , "33a69cd2065432a30f3d1ce4eb0d59b8ab58c74f27c41a7fdb5696ad4e6108c96f807982866f785d3f6418d24163ddae117b7db4d5fdf0071de069fa54342262"+      )+    , ( "fffffffffffffffffffffffffffffffebaaedce6af48a03bbfd25e8cd0364140"+      , "Equations are more important to me, because politics is for the present, but an equation is something for eternity."+      , "54c4a33c6423d689378f160a7ff8b61330444abb58fb470f96ea16d99d4a2fed07082304410efa6b2943111b6a4e0aaa7b7db55a07e9861d1fb3cb1f421044a5"+      )+    , ( "fffffffffffffffffffffffffffffffebaaedce6af48a03bbfd25e8cd0364140"+      , "Not only is the Universe stranger than we think, it is stranger than we can think."+      , "ff466a9f1b7b273e2f4c3ffe032eb2e814121ed18ef84665d0f515360dab3dd06fc95f5132e5ecfdc8e5e6e616cc77151455d46ed48f5589b7db7771a332b283"+      )+    , ( "0000000000000000000000000000000000000000000000000000000000000001"+      , "How wonderful that we have met with a paradox. Now we have some hope of making progress."+      , "c0dafec8251f1d5010289d210232220b03202cba34ec11fec58b3e93a85b91d375afdc06b7d6322a590955bf264e7aaa155847f614d80078a90292fe205064d3"+      )+    , ( "69ec59eaa1f4f2e36b639716b7c30ca86d9a5375c7b38d8918bd9c0ebc80ba64"+      , "Computer science is no more about computers than astronomy is about telescopes."+      , "7186363571d65e084e7f02b0b77c3ec44fb1b257dee26274c38c928986fea45d0de0b38e06807e46bda1f1e293f4f6323e854c86d58abdd00c46c16441085df6"+      )+    , ( "00000000000000000000000000007246174ab1e92e9149c6e446fe194d072637"+      , "...if you aren't, at any given time, scandalized by code you wrote five or even three years ago, you're not learning anywhere near enough"+      , "fbfe5076a15860ba8ed00e75e9bd22e05d230f02a936b653eb55b61c99dda4870e68880ebb0050fe4312b1b1eb0899e1b82da89baa5b895f612619edf34cbd37"+      )+    , ( "000000000000000000000000000000000000000000056916d0f9b31dc9b637f3"+      , "The question of whether computers can think is like the question of whether submarines can swim."+      , "cde1302d83f8dd835d89aef803c74a119f561fbaef3eb9129e45f30de86abbf906ce643f5049ee1f27890467b77a6a8e11ec4661cc38cd8badf90115fbd03cef"+      )+    ]
+ test/Haskoin/CryptoSpec.hs view
@@ -0,0 +1,165 @@+{-# LANGUAGE OverloadedStrings #-}+module Haskoin.CryptoSpec (spec) where++import           Control.Monad+import           Data.ByteString       (ByteString)+import qualified Data.ByteString.Char8 as C (pack)+import           Data.Maybe            (fromMaybe, isJust, isNothing)+import           Data.Text             (Text)+import           Haskoin.Address+import           Haskoin.Constants+import           Haskoin.Crypto+import           Haskoin.Keys+import           Haskoin.Util+import           Test.Hspec+import           Test.HUnit            (Assertion, assertBool)++-- Unit tests copied from bitcoind implementation+-- https://github.com/bitcoin/bitcoin/blob/master/src/test/key_tests.cpp++strSecret1 :: Text+strSecret1  = "5HxWvvfubhXpYYpS3tJkw6fq9jE9j18THftkZjHHfmFiWtmAbrj"++strSecret2 :: Text+strSecret2  = "5KC4ejrDjv152FGwP386VD1i2NYc5KkfSMyv1nGy1VGDxGHqVY3"++strSecret1C :: Text+strSecret1C = "Kwr371tjA9u2rFSMZjTNun2PXXP3WPZu2afRHTcta6KxEUdm1vEw"++strSecret2C :: Text+strSecret2C = "L3Hq7a8FEQwJkW1M2GNKDW28546Vp5miewcCzSqUD9kCAXrJdS3g"++addr1 :: Text+addr1  = "1QFqqMUD55ZV3PJEJZtaKCsQmjLT6JkjvJ"++addr2 :: Text+addr2  = "1F5y5E5FMc5YzdJtB9hLaUe43GDxEKXENJ"++addr1C :: Text+addr1C = "1NoJrossxPBKfCHuJXT4HadJrXRE9Fxiqs"++addr2C :: Text+addr2C = "1CRj2HyM1CXWzHAXLQtiGLyggNT9WQqsDs"++strAddressBad :: Text+strAddressBad = "1HV9Lc3sNHZxwj4Zk6fB38tEmBryq2cBiF"++sigMsg :: [ByteString]+sigMsg =+    [ mconcat ["Very secret message ", C.pack (show (i :: Int)), ": 11"]+    | i <- [0..15]+    ]++sec1 :: SecKeyI+sec1 =+    fromMaybe (error "Could not decode WIF secret 1") (fromWif btc strSecret1)++sec2 :: SecKeyI+sec2 =+    fromMaybe (error "Could not decode WIF secret 2") (fromWif btc strSecret2)++sec1C :: SecKeyI+sec1C =+    fromMaybe+        (error "Could not decode WIF compressed secret 1")+        (fromWif btc strSecret1C)++sec2C :: SecKeyI+sec2C =+    fromMaybe+        (error "Could not decode WIF compressed secret 2")+        (fromWif btc strSecret2C)++pub1 :: PubKeyI+pub1  = derivePubKeyI sec1++pub2 :: PubKeyI+pub2  = derivePubKeyI sec2++pub1C :: PubKeyI+pub1C = derivePubKeyI sec1C++pub2C :: PubKeyI+pub2C = derivePubKeyI sec2C++spec :: Spec+spec =+    describe "bitcoind /src/test/key_tests.cpp" $ do+        it "decode valid wif" checkPrivkey+        it "decode invalid wif" checkInvalidKey+        it "decode minikey format" checkMiniKey+        it "check private key compression" checkPrvKeyCompressed+        it "check public key compression" checkKeyCompressed+        it "check matching address" checkMatchingAddress+        it "check various signatures" sigCheck++sigCheck :: Assertion+sigCheck = forM_ sigMsg $ checkSignatures . doubleSHA256++{- bitcoind /src/test/key_tests.cpp -}++checkPrivkey :: Assertion+checkPrivkey = do+    assertBool "Key 1"  $ isJust $ fromWif btc strSecret1+    assertBool "Key 2"  $ isJust $ fromWif btc strSecret2+    assertBool "Key 1C" $ isJust $ fromWif btc strSecret1C+    assertBool "Key 2C" $ isJust $ fromWif btc strSecret2C++checkInvalidKey :: Assertion+checkInvalidKey =+    assertBool "Bad key" $ isNothing $ fromWif btc strAddressBad++checkMiniKey :: Assertion+checkMiniKey =+    assertBool "Bad mini key" $+    isJust res && fromMiniKey "S6c56bnXQiBjk9mqSYE7ykVQ7NzrRy" == res+  where+    res = do+        bs <-+            decodeHex+                "4C7A9640C72DC2099F23715D0C8A0D8A35F8906E3CAB61DD3F78B67BF887C9AB"+        wrapSecKey False <$> secKey bs++checkPrvKeyCompressed :: Assertion+checkPrvKeyCompressed = do+    assertBool "Key 1"  $ not $ secKeyCompressed sec1+    assertBool "Key 2"  $ not $ secKeyCompressed sec2+    assertBool "Key 1C" $ secKeyCompressed sec1C+    assertBool "Key 2C" $ secKeyCompressed sec2C++checkKeyCompressed :: Assertion+checkKeyCompressed = do+    assertBool "Key 1"  $ not $ pubKeyCompressed pub1+    assertBool "Key 2"  $ not $ pubKeyCompressed pub2+    assertBool "Key 1C" $ pubKeyCompressed pub1C+    assertBool "Key 2C" $ pubKeyCompressed pub2C++checkMatchingAddress :: Assertion+checkMatchingAddress = do+    assertBool "Key 1"  $ Just addr1  == addrToString btc (pubKeyAddr pub1)+    assertBool "Key 2"  $ Just addr2  == addrToString btc (pubKeyAddr pub2)+    assertBool "Key 1C" $ Just addr1C == addrToString btc (pubKeyAddr pub1C)+    assertBool "Key 2C" $ Just addr2C == addrToString btc (pubKeyAddr pub2C)++checkSignatures :: Hash256 -> Assertion+checkSignatures h = do+    let sign1  = signHash (secKeyData sec1) h+        sign2  = signHash (secKeyData sec2) h+        sign1C = signHash (secKeyData sec1C) h+        sign2C = signHash (secKeyData sec2C) h+    assertBool "Key 1, Sign1"   $ verifyHashSig h sign1 (pubKeyPoint pub1)+    assertBool "Key 1, Sign2"   $ not $ verifyHashSig h sign2 (pubKeyPoint pub1)+    assertBool "Key 1, Sign1C"  $ verifyHashSig h sign1C (pubKeyPoint pub1)+    assertBool "Key 1, Sign2C"  $ not $ verifyHashSig h sign2C (pubKeyPoint pub1)+    assertBool "Key 2, Sign1"   $ not $ verifyHashSig h sign1 (pubKeyPoint pub2)+    assertBool "Key 2, Sign2"   $ verifyHashSig h sign2 (pubKeyPoint pub2)+    assertBool "Key 2, Sign1C"  $ not $ verifyHashSig h sign1C (pubKeyPoint pub2)+    assertBool "Key 2, Sign2C"  $ verifyHashSig h sign2C (pubKeyPoint pub2)+    assertBool "Key 1C, Sign1"  $ verifyHashSig h sign1 (pubKeyPoint pub1C)+    assertBool "Key 1C, Sign2"  $ not $ verifyHashSig h sign2 (pubKeyPoint pub1C)+    assertBool "Key 1C, Sign1C" $ verifyHashSig h sign1C (pubKeyPoint pub1C)+    assertBool "Key 1C, Sign2C" $ not $ verifyHashSig h sign2C (pubKeyPoint pub1C)+    assertBool "Key 2C, Sign1"  $ not $ verifyHashSig h sign1 (pubKeyPoint pub2C)+    assertBool "Key 2C, Sign2"  $ verifyHashSig h sign2 (pubKeyPoint pub2C)+    assertBool "Key 2C, Sign1C" $ not $ verifyHashSig h sign1C (pubKeyPoint pub2C)+    assertBool "Key 2C, Sign2C" $ verifyHashSig h sign2C (pubKeyPoint pub2C)
+ test/Haskoin/Keys/ExtendedSpec.hs view
@@ -0,0 +1,521 @@+{-# LANGUAGE OverloadedStrings #-}+module Haskoin.Keys.ExtendedSpec (spec) where++import           Data.Aeson                 as A+import           Data.Aeson.Types           as A+import           Data.Bits                  ((.&.))+import qualified Data.ByteString.Lazy.Char8 as B8+import           Data.Either                (isLeft)+import           Data.Map.Strict            (singleton)+import           Data.Maybe                 (fromJust, isJust, isNothing)+import           Data.Serialize             as S+import           Data.String                (fromString)+import           Data.String.Conversions    (cs)+import           Data.Text                  (Text)+import           Data.Word                  (Word32)+import           Haskoin.Address+import           Haskoin.Constants+import           Haskoin.Keys+import           Haskoin.Test+import           Haskoin.Util+import           Test.Hspec+import           Test.HUnit                 (Assertion, assertBool, assertEqual)+import           Test.QuickCheck            hiding ((.&.))++spec :: Spec+spec = do+    describe "bip32 derivation vector 1" $ do+        it "chain m" $ runXKeyVec (head xKeyVec)+        it "chain m/0'" $ runXKeyVec (xKeyVec !! 1)+        it "chain m/0'/1" $ runXKeyVec (xKeyVec !! 2)+        it "chain m/0'/1/2'" $ runXKeyVec (xKeyVec !! 3)+        it "chain m/0'/1/2'/2" $ runXKeyVec (xKeyVec !! 4)+        it "chain m/0'/1/2'/2/1000000000" $ runXKeyVec (xKeyVec !! 5)+    describe "bip32 subkey derivation vector 2" $ do+        it "chain m" $ runXKeyVec (head xKeyVec2)+        it "chain m/0" $ runXKeyVec (xKeyVec2 !! 1)+        it "chain m/0/2147483647'" $ runXKeyVec (xKeyVec2 !! 2)+        it "chain m/0/2147483647'/1" $ runXKeyVec (xKeyVec2 !! 3)+        it "chain m/0/2147483647'/1/2147483646'" $ runXKeyVec (xKeyVec2 !! 4)+        it "Chain m/0/2147483647'/1/2147483646'/2" $ runXKeyVec (xKeyVec2 !! 5)+    describe "bip32 subkey derivation using string path" $ do+        it "either derivations" testApplyPath+        it "either derivations" testBadApplyPath+        it "dublic derivations" testDerivePubPath+        it "private derivations" testDerivePrvPath+        it "path parsing" testParsePath+        it "from json" testFromJsonPath+        it "to json" testToJsonPath+    describe "extended keys" $ do+        let net = btc+        it "computes pubkey of a subkey is subkey of the pubkey" $+            property $ forAll arbitraryXPrvKey pubKeyOfSubKeyIsSubKeyOfPubKey+        it "exports and imports extended private key" $+            property $+            forAll arbitraryXPrvKey $ \k ->+                xPrvImport net (xPrvExport net k) == Just k+        it "exports and imports extended public key" $+            property $+            forAll arbitraryXPubKey $ \(_, k) ->+                xPubImport net (xPubExport net k) == Just k+        it "show and read derivation path" $+            property $ forAll arbitraryDerivPath $ \p -> read (show p) == p+        it "show and read hard derivation path" $+            property $ forAll arbitraryHardPath $ \p -> read (show p) == p+        it "show and read soft derivation path" $+            property $ forAll arbitrarySoftPath $ \p -> read (show p) == p+        it "from string derivation path" $+            property $+            forAll arbitraryDerivPath $ \p -> fromString (cs $ pathToStr p) == p+        it "from string hard derivation path" $+            property $+            forAll arbitraryHardPath $ \p -> fromString (cs $ pathToStr p) == p+        it "from string soft derivation path" $+            property $+            forAll arbitrarySoftPath $ \p -> fromString (cs $ pathToStr p) == p+        it "from and to lists of derivation paths" $+            property $+            forAll arbitraryDerivPath $ \p -> listToPath (pathToList p) == p+        it "from and to lists of hard derivation paths" $+            property $+            forAll arbitraryHardPath $ \p ->+                toHard (listToPath $ pathToList p) == Just p+        it "from and to lists of soft derivation paths" $+            property $+            forAll arbitrarySoftPath $ \p ->+                toSoft (listToPath $ pathToList p) == Just p+        it "read and show parsed path" $+            property $ forAll arbitraryParsedPath $ \p -> read (show p) == p+        it "encodes and decodes extended private key" $+            forAll+                arbitraryXPrvKey+                (testCustom (xPrvFromJSON net) (xPrvToJSON net))+        it "encodes and decodes extended public key" $+            forAll+                arbitraryXPubKey+                (testCustom (xPubFromJSON net) (xPubToJSON net) . snd)+        it "encodes and decodes derivation path" $+            forAll arbitraryDerivPath testID+        it "encodes and decodes parsed derivation path" $+            forAll arbitraryParsedPath testID+        it "encodes and decodes extended private key" $+            property $+            forAll arbitraryXPrvKey $+            testPutGet (getXPrvKey net) (putXPrvKey net)+        it "shows and reads extended private key" $+            property $+            forAll arbitraryXPrvKey $ \k -> read (show k) `shouldBe` k+        it "shows and reads extended private key" $+            property $+            forAll arbitraryXPubKey $ \(prv, pub) ->+                read (show (prv, pub)) `shouldBe` (prv, pub)++testFromJsonPath :: Assertion+testFromJsonPath =+    sequence_ $ do+        path <- jsonPathVectors+        return $+            assertEqual+                path+                (Just [fromString path :: DerivPath])+                (A.decode $ B8.pack $ "[\"" ++ path ++ "\"]")++testToJsonPath :: Assertion+testToJsonPath =+    sequence_ $ do+        path <- jsonPathVectors+        return $+            assertEqual+                path+                (B8.pack $ "[\"" ++ path ++ "\"]")+                (A.encode [fromString path :: ParsedPath])++jsonPathVectors :: [String]+jsonPathVectors =+    [ "m"+    , "m/0"+    , "m/0'"+    , "M/0'"+    , "m/2147483647"+    , "M/2147483647"+    , "m/1/2/3/4/5/6/7/8"+    , "M/1/2/3/4/5/6/7/8"+    , "m/1'/2'/3/4"+    , "M/1'/2'/3/4"+    ]++testParsePath :: Assertion+testParsePath =+    sequence_ $ do+        (path, t) <- parsePathVectors+        return $ assertBool path (t $ parsePath path)++parsePathVectors :: [(String, Maybe ParsedPath -> Bool)]+parsePathVectors =+    [ ("m", isJust)+    , ("m/0'", isJust)+    , ("M/0'", isJust)+    , ("m/2147483648", isNothing)+    , ("m/2147483647", isJust)+    , ("M/2147483648", isNothing)+    , ("M/2147483647", isJust)+    , ("M/-1", isNothing)+    , ("M/-2147483648", isNothing)+    , ("m/1/2/3/4/5/6/7/8", isJust)+    , ("M/1/2/3/4/5/6/7/8", isJust)+    , ("m/1'/2'/3/4", isJust)+    , ("M/1'/2'/3/4", isJust)+    , ("m/1/2'/3/4'", isJust)+    , ("M/1/2'/3/4'", isJust)+    , ("meh", isNothing)+    , ("infinity", isNothing)+    , ("NaN", isNothing)+    ]++testApplyPath :: Assertion+testApplyPath =+    sequence_ $ do+        (key, path, final) <- applyPathVectors+        return $+            assertEqual path final $ applyPath (fromJust $ parsePath path) key++testBadApplyPath :: Assertion+testBadApplyPath =+    sequence_ $ do+        (key, path) <- badApplyPathVectors+        return $+            assertBool path $ isLeft $ applyPath (fromJust $ parsePath path) key++testDerivePubPath :: Assertion+testDerivePubPath =+    sequence_ $ do+        (key, path, final) <- derivePubPathVectors+        return $+            assertEqual path final $+            derivePubPath (fromString path :: SoftPath) key++testDerivePrvPath :: Assertion+testDerivePrvPath =+    sequence_ $ do+        (key, path, final) <- derivePrvPathVectors+        return $+            assertEqual path final $+            derivePath (fromString path :: DerivPath) key++derivePubPathVectors :: [(XPubKey, String, XPubKey)]+derivePubPathVectors =+    [ ( xpub, "M", xpub )+    , ( xpub, "M/8", pubSubKey xpub 8 )+    , ( xpub, "M/8/30/1", foldl pubSubKey xpub [8,30,1] )+    ]+  where+    xprv = fromJust $ xPrvImport btc+        "xprv9s21ZrQH143K46iDVRSyFfGfMgQjzC4BV3ZUfNbG7PHQrJjE53ofAn5gYkp6KQ\+        \WzGmb8oageSRxBY8s4rjr9VXPVp2HQDbwPt4H31Gg4LpB"+    xpub = deriveXPubKey xprv++derivePrvPathVectors :: [(XPrvKey, String, XPrvKey)]+derivePrvPathVectors =+    [ ( xprv, "m", xprv )+    , ( xprv, "M", xprv )+    , ( xprv, "m/8'", hardSubKey xprv 8 )+    , ( xprv, "M/8'", hardSubKey xprv 8 )+    , ( xprv, "m/8'/30/1"+      , foldl prvSubKey (hardSubKey xprv 8) [30,1]+      )+    , ( xprv, "M/8'/30/1"+      , foldl prvSubKey (hardSubKey xprv 8) [30,1]+      )+    , ( xprv, "m/3/20"+      , foldl prvSubKey xprv [3,20]+      )+    , ( xprv, "M/3/20"+      , foldl prvSubKey xprv [3,20]+      )+    ]+  where+    xprv = fromJust $ xPrvImport btc+        "xprv9s21ZrQH143K46iDVRSyFfGfMgQjzC4BV3ZUfNbG7PHQrJjE53ofAn5gYkp6KQ\+        \WzGmb8oageSRxBY8s4rjr9VXPVp2HQDbwPt4H31Gg4LpB"++applyPathVectors :: [(XKey, String, Either String XKey)]+applyPathVectors =+    [ (XPrv xprv btc, "m", Right (XPrv xprv btc))+    , (XPrv xprv btc, "M", Right (XPub xpub btc))+    , (XPrv xprv btc, "m/8'", Right (XPrv (hardSubKey xprv 8) btc))+    , ( XPrv xprv btc+      , "M/8'"+      , Right (XPub (deriveXPubKey (hardSubKey xprv 8)) btc))+    , ( XPrv xprv btc+      , "m/8'/30/1"+      , Right (XPrv (foldl prvSubKey (hardSubKey xprv 8) [30, 1]) btc))+    , ( XPrv xprv btc+      , "M/8'/30/1"+      , Right+            (XPub+                 (deriveXPubKey (foldl prvSubKey (hardSubKey xprv 8) [30, 1]))+                 btc))+    , (XPrv xprv btc, "m/3/20", Right (XPrv (foldl prvSubKey xprv [3, 20]) btc))+    , ( XPrv xprv btc+      , "M/3/20"+      , Right (XPub (deriveXPubKey (foldl prvSubKey xprv [3, 20])) btc))+    , ( XPub xpub btc+      , "M/3/20"+      , Right (XPub (deriveXPubKey (foldl prvSubKey xprv [3, 20])) btc))+    ]+  where+    xprv =+        fromJust $+        xPrvImport+            btc+            "xprv9s21ZrQH143K46iDVRSyFfGfMgQjzC4BV3ZUfNbG7PHQrJjE53ofAn5gYkp6KQ\+        \WzGmb8oageSRxBY8s4rjr9VXPVp2HQDbwPt4H31Gg4LpB"+    xpub = deriveXPubKey xprv++badApplyPathVectors :: [(XKey, String)]+badApplyPathVectors =+    [ (XPub xpub btc, "m/8'")+    , (XPub xpub btc, "M/8'")+    , (XPub xpub btc, "M/1/2/3'/4/5")+    ]+  where+    xprv =+        fromJust $+        xPrvImport+            btc+            "xprv9s21ZrQH143K46iDVRSyFfGfMgQjzC4BV3ZUfNbG7PHQrJjE53ofAn5gYkp6KQ\+        \WzGmb8oageSRxBY8s4rjr9VXPVp2HQDbwPt4H31Gg4LpB"+    xpub = deriveXPubKey xprv+++runXKeyVec :: ([Text], XPrvKey) -> Assertion+runXKeyVec (v, m) = do+    assertBool "xPrvID" $ encodeHex (S.encode $ xPrvID m) == head v+    assertBool "xPrvFP" $ encodeHex (S.encode $ xPrvFP m) == v !! 1+    assertBool "xPrvAddr" $+        addrToString btc (xPubAddr $ deriveXPubKey m) == Just (v !! 2)+    assertBool "prvKey" $ encodeHex (getSecKey $ xPrvKey m) == v !! 3+    assertBool "xPrvWIF" $ xPrvWif btc m == v !! 4+    assertBool "pubKey" $+        encodeHex (exportPubKey True $ xPubKey $ deriveXPubKey m) == v !! 5+    assertBool "chain code" $ encodeHex (S.encode $ xPrvChain m) == v !! 6+    assertBool "Hex PubKey" $+        encodeHex (runPut $ putXPubKey btc $ deriveXPubKey m) == v !! 7+    assertBool "Hex PrvKey" $ encodeHex (runPut (putXPrvKey btc m)) == v !! 8+    assertBool "Base58 PubKey" $ xPubExport btc (deriveXPubKey m) == v !! 9+    assertBool "Base58 PrvKey" $ xPrvExport btc m == v !! 10++-- BIP 0032 Test Vectors+-- https://en.bitcoin.it/wiki/BIP_0032_TestVectors++xKeyVec :: [([Text], XPrvKey)]+xKeyVec = zip xKeyResVec $ foldl f [m] der+    where f acc d = acc ++ [d $ last acc]+          m   = makeXPrvKey $ fromJust $ decodeHex m0+          der = [ flip hardSubKey 0+                , flip prvSubKey 1+                , flip hardSubKey 2+                , flip prvSubKey 2+                , flip prvSubKey 1000000000+                ]++xKeyVec2 :: [([Text], XPrvKey)]+xKeyVec2 = zip xKeyResVec2 $ foldl f [m] der+    where f acc d = acc ++ [d $ last acc]+          m   = makeXPrvKey $ fromJust $ decodeHex m1+          der = [ flip prvSubKey 0+                , flip hardSubKey 2147483647+                , flip prvSubKey 1+                , flip hardSubKey 2147483646+                , flip prvSubKey 2+                ]++m0 :: Text+m0 = "000102030405060708090a0b0c0d0e0f"++xKeyResVec :: [[Text]]+xKeyResVec =+    [+      -- m+      [ "3442193e1bb70916e914552172cd4e2dbc9df811"+      , "3442193e"+      , "15mKKb2eos1hWa6tisdPwwDC1a5J1y9nma"+      , "e8f32e723decf4051aefac8e2c93c9c5b214313817cdb01a1494b917c8436b35"+      , "L52XzL2cMkHxqxBXRyEpnPQZGUs3uKiL3R11XbAdHigRzDozKZeW"+      , "0339a36013301597daef41fbe593a02cc513d0b55527ec2df1050e2e8ff49c85c2"+      , "873dff81c02f525623fd1fe5167eac3a55a049de3d314bb42ee227ffed37d508"+      , "0488b21e000000000000000000873dff81c02f525623fd1fe5167eac3a55a049de3d314bb42ee227ffed37d5080339a36013301597daef41fbe593a02cc513d0b55527ec2df1050e2e8ff49c85c2"+      , "0488ade4000000000000000000873dff81c02f525623fd1fe5167eac3a55a049de3d314bb42ee227ffed37d50800e8f32e723decf4051aefac8e2c93c9c5b214313817cdb01a1494b917c8436b35"+      , "xpub661MyMwAqRbcFtXgS5sYJABqqG9YLmC4Q1Rdap9gSE8NqtwybGhePY2gZ29ESFjqJoCu1Rupje8YtGqsefD265TMg7usUDFdp6W1EGMcet8"+      , "xprv9s21ZrQH143K3QTDL4LXw2F7HEK3wJUD2nW2nRk4stbPy6cq3jPPqjiChkVvvNKmPGJxWUtg6LnF5kejMRNNU3TGtRBeJgk33yuGBxrMPHi"+      ]+      -- m/0'+    , [ "5c1bd648ed23aa5fd50ba52b2457c11e9e80a6a7"+      , "5c1bd648"+      , "19Q2WoS5hSS6T8GjhK8KZLMgmWaq4neXrh"+      , "edb2e14f9ee77d26dd93b4ecede8d16ed408ce149b6cd80b0715a2d911a0afea"+      , "L5BmPijJjrKbiUfG4zbiFKNqkvuJ8usooJmzuD7Z8dkRoTThYnAT"+      , "035a784662a4a20a65bf6aab9ae98a6c068a81c52e4b032c0fb5400c706cfccc56"+      , "47fdacbd0f1097043b78c63c20c34ef4ed9a111d980047ad16282c7ae6236141"+      , "0488b21e013442193e8000000047fdacbd0f1097043b78c63c20c34ef4ed9a111d980047ad16282c7ae6236141035a784662a4a20a65bf6aab9ae98a6c068a81c52e4b032c0fb5400c706cfccc56"+      , "0488ade4013442193e8000000047fdacbd0f1097043b78c63c20c34ef4ed9a111d980047ad16282c7ae623614100edb2e14f9ee77d26dd93b4ecede8d16ed408ce149b6cd80b0715a2d911a0afea"+      , "xpub68Gmy5EdvgibQVfPdqkBBCHxA5htiqg55crXYuXoQRKfDBFA1WEjWgP6LHhwBZeNK1VTsfTFUHCdrfp1bgwQ9xv5ski8PX9rL2dZXvgGDnw"+      , "xprv9uHRZZhk6KAJC1avXpDAp4MDc3sQKNxDiPvvkX8Br5ngLNv1TxvUxt4cV1rGL5hj6KCesnDYUhd7oWgT11eZG7XnxHrnYeSvkzY7d2bhkJ7"+      ]+      -- m/0'/1+    , [ "bef5a2f9a56a94aab12459f72ad9cf8cf19c7bbe"+      , "bef5a2f9"+      , "1JQheacLPdM5ySCkrZkV66G2ApAXe1mqLj"+      , "3c6cb8d0f6a264c91ea8b5030fadaa8e538b020f0a387421a12de9319dc93368"+      , "KyFAjQ5rgrKvhXvNMtFB5PCSKUYD1yyPEe3xr3T34TZSUHycXtMM"+      , "03501e454bf00751f24b1b489aa925215d66af2234e3891c3b21a52bedb3cd711c"+      , "2a7857631386ba23dacac34180dd1983734e444fdbf774041578e9b6adb37c19"+      , "0488b21e025c1bd648000000012a7857631386ba23dacac34180dd1983734e444fdbf774041578e9b6adb37c1903501e454bf00751f24b1b489aa925215d66af2234e3891c3b21a52bedb3cd711c"+      , "0488ade4025c1bd648000000012a7857631386ba23dacac34180dd1983734e444fdbf774041578e9b6adb37c19003c6cb8d0f6a264c91ea8b5030fadaa8e538b020f0a387421a12de9319dc93368"+      , "xpub6ASuArnXKPbfEwhqN6e3mwBcDTgzisQN1wXN9BJcM47sSikHjJf3UFHKkNAWbWMiGj7Wf5uMash7SyYq527Hqck2AxYysAA7xmALppuCkwQ"+      , "xprv9wTYmMFdV23N2TdNG573QoEsfRrWKQgWeibmLntzniatZvR9BmLnvSxqu53Kw1UmYPxLgboyZQaXwTCg8MSY3H2EU4pWcQDnRnrVA1xe8fs"+      ]+      -- m/0'/1/2'+    , [ "ee7ab90cde56a8c0e2bb086ac49748b8db9dce72"+      , "ee7ab90c"+      , "1NjxqbA9aZWnh17q1UW3rB4EPu79wDXj7x"+      , "cbce0d719ecf7431d88e6a89fa1483e02e35092af60c042b1df2ff59fa424dca"+      , "L43t3od1Gh7Lj55Bzjj1xDAgJDcL7YFo2nEcNaMGiyRZS1CidBVU"+      , "0357bfe1e341d01c69fe5654309956cbea516822fba8a601743a012a7896ee8dc2"+      , "04466b9cc8e161e966409ca52986c584f07e9dc81f735db683c3ff6ec7b1503f"+      , "0488b21e03bef5a2f98000000204466b9cc8e161e966409ca52986c584f07e9dc81f735db683c3ff6ec7b1503f0357bfe1e341d01c69fe5654309956cbea516822fba8a601743a012a7896ee8dc2"+      , "0488ade403bef5a2f98000000204466b9cc8e161e966409ca52986c584f07e9dc81f735db683c3ff6ec7b1503f00cbce0d719ecf7431d88e6a89fa1483e02e35092af60c042b1df2ff59fa424dca"+      , "xpub6D4BDPcP2GT577Vvch3R8wDkScZWzQzMMUm3PWbmWvVJrZwQY4VUNgqFJPMM3No2dFDFGTsxxpG5uJh7n7epu4trkrX7x7DogT5Uv6fcLW5"+      , "xprv9z4pot5VBttmtdRTWfWQmoH1taj2axGVzFqSb8C9xaxKymcFzXBDptWmT7FwuEzG3ryjH4ktypQSAewRiNMjANTtpgP4mLTj34bhnZX7UiM"+      ]+      -- m/0'/1/2'/2+    , [ "d880d7d893848509a62d8fb74e32148dac68412f"+      , "d880d7d8"+      , "1LjmJcdPnDHhNTUgrWyhLGnRDKxQjoxAgt"+      , "0f479245fb19a38a1954c5c7c0ebab2f9bdfd96a17563ef28a6a4b1a2a764ef4"+      , "KwjQsVuMjbCP2Zmr3VaFaStav7NvevwjvvkqrWd5Qmh1XVnCteBR"+      , "02e8445082a72f29b75ca48748a914df60622a609cacfce8ed0e35804560741d29"+      , "cfb71883f01676f587d023cc53a35bc7f88f724b1f8c2892ac1275ac822a3edd"+      , "0488b21e04ee7ab90c00000002cfb71883f01676f587d023cc53a35bc7f88f724b1f8c2892ac1275ac822a3edd02e8445082a72f29b75ca48748a914df60622a609cacfce8ed0e35804560741d29"+      , "0488ade404ee7ab90c00000002cfb71883f01676f587d023cc53a35bc7f88f724b1f8c2892ac1275ac822a3edd000f479245fb19a38a1954c5c7c0ebab2f9bdfd96a17563ef28a6a4b1a2a764ef4"+      , "xpub6FHa3pjLCk84BayeJxFW2SP4XRrFd1JYnxeLeU8EqN3vDfZmbqBqaGJAyiLjTAwm6ZLRQUMv1ZACTj37sR62cfN7fe5JnJ7dh8zL4fiyLHV"+      , "xprvA2JDeKCSNNZky6uBCviVfJSKyQ1mDYahRjijr5idH2WwLsEd4Hsb2Tyh8RfQMuPh7f7RtyzTtdrbdqqsunu5Mm3wDvUAKRHSC34sJ7in334"+      ]+      -- m/0'/1/2'/2/1000000000+    , [ "d69aa102255fed74378278c7812701ea641fdf32"+      , "d69aa102"+      , "1LZiqrop2HGR4qrH1ULZPyBpU6AUP49Uam"+      , "471b76e389e528d6de6d816857e012c5455051cad6660850e58372a6c3e6e7c8"+      , "Kybw8izYevo5xMh1TK7aUr7jHFCxXS1zv8p3oqFz3o2zFbhRXHYs"+      , "022a471424da5e657499d1ff51cb43c47481a03b1e77f951fe64cec9f5a48f7011"+      , "c783e67b921d2beb8f6b389cc646d7263b4145701dadd2161548a8b078e65e9e"+      , "0488b21e05d880d7d83b9aca00c783e67b921d2beb8f6b389cc646d7263b4145701dadd2161548a8b078e65e9e022a471424da5e657499d1ff51cb43c47481a03b1e77f951fe64cec9f5a48f7011"+      , "0488ade405d880d7d83b9aca00c783e67b921d2beb8f6b389cc646d7263b4145701dadd2161548a8b078e65e9e00471b76e389e528d6de6d816857e012c5455051cad6660850e58372a6c3e6e7c8"+      , "xpub6H1LXWLaKsWFhvm6RVpEL9P4KfRZSW7abD2ttkWP3SSQvnyA8FSVqNTEcYFgJS2UaFcxupHiYkro49S8yGasTvXEYBVPamhGW6cFJodrTHy"+      , "xprvA41z7zogVVwxVSgdKUHDy1SKmdb533PjDz7J6N6mV6uS3ze1ai8FHa8kmHScGpWmj4WggLyQjgPie1rFSruoUihUZREPSL39UNdE3BBDu76"+      ]+    ]++m1 :: Text+m1 = "fffcf9f6f3f0edeae7e4e1dedbd8d5d2cfccc9c6c3c0bdbab7b4b1aeaba8a5a29f9c999693908d8a8784817e7b7875726f6c696663605d5a5754514e4b484542"++xKeyResVec2 :: [[Text]]+xKeyResVec2 =+    [+      -- m+      [ "bd16bee53961a47d6ad888e29545434a89bdfe95"+      , "bd16bee5"+      , "1JEoxevbLLG8cVqeoGKQiAwoWbNYSUyYjg"+      , "4b03d6fc340455b363f51020ad3ecca4f0850280cf436c70c727923f6db46c3e"+      , "KyjXhyHF9wTphBkfpxjL8hkDXDUSbE3tKANT94kXSyh6vn6nKaoy"+      , "03cbcaa9c98c877a26977d00825c956a238e8dddfbd322cce4f74b0b5bd6ace4a7"+      , "60499f801b896d83179a4374aeb7822aaeaceaa0db1f85ee3e904c4defbd9689"+      , "0488b21e00000000000000000060499f801b896d83179a4374aeb7822aaeaceaa0db1f85ee3e904c4defbd968903cbcaa9c98c877a26977d00825c956a238e8dddfbd322cce4f74b0b5bd6ace4a7"+      , "0488ade400000000000000000060499f801b896d83179a4374aeb7822aaeaceaa0db1f85ee3e904c4defbd9689004b03d6fc340455b363f51020ad3ecca4f0850280cf436c70c727923f6db46c3e"+      , "xpub661MyMwAqRbcFW31YEwpkMuc5THy2PSt5bDMsktWQcFF8syAmRUapSCGu8ED9W6oDMSgv6Zz8idoc4a6mr8BDzTJY47LJhkJ8UB7WEGuduB"+      , "xprv9s21ZrQH143K31xYSDQpPDxsXRTUcvj2iNHm5NUtrGiGG5e2DtALGdso3pGz6ssrdK4PFmM8NSpSBHNqPqm55Qn3LqFtT2emdEXVYsCzC2U"+      ]+      -- m/0+    , [ "5a61ff8eb7aaca3010db97ebda76121610b78096"+      , "5a61ff8e"+      , "19EuDJdgfRkwCmRzbzVBHZWQG9QNWhftbZ"+      , "abe74a98f6c7eabee0428f53798f0ab8aa1bd37873999041703c742f15ac7e1e"+      , "L2ysLrR6KMSAtx7uPqmYpoTeiRzydXBattRXjXz5GDFPrdfPzKbj"+      , "02fc9e5af0ac8d9b3cecfe2a888e2117ba3d089d8585886c9c826b6b22a98d12ea"+      , "f0909affaa7ee7abe5dd4e100598d4dc53cd709d5a5c2cac40e7412f232f7c9c"+      , "0488b21e01bd16bee500000000f0909affaa7ee7abe5dd4e100598d4dc53cd709d5a5c2cac40e7412f232f7c9c02fc9e5af0ac8d9b3cecfe2a888e2117ba3d089d8585886c9c826b6b22a98d12ea"+      , "0488ade401bd16bee500000000f0909affaa7ee7abe5dd4e100598d4dc53cd709d5a5c2cac40e7412f232f7c9c00abe74a98f6c7eabee0428f53798f0ab8aa1bd37873999041703c742f15ac7e1e"+      , "xpub69H7F5d8KSRgmmdJg2KhpAK8SR3DjMwAdkxj3ZuxV27CprR9LgpeyGmXUbC6wb7ERfvrnKZjXoUmmDznezpbZb7ap6r1D3tgFxHmwMkQTPH"+      , "xprv9vHkqa6EV4sPZHYqZznhT2NPtPCjKuDKGY38FBWLvgaDx45zo9WQRUT3dKYnjwih2yJD9mkrocEZXo1ex8G81dwSM1fwqWpWkeS3v86pgKt"+      ]+      -- m/0/2147483647'+    , [ "d8ab493736da02f11ed682f88339e720fb0379d1"+      , "d8ab4937"+      , "1Lke9bXGhn5VPrBuXgN12uGUphrttUErmk"+      , "877c779ad9687164e9c2f4f0f4ff0340814392330693ce95a58fe18fd52e6e93"+      , "L1m5VpbXmMp57P3knskwhoMTLdhAAaXiHvnGLMribbfwzVRpz2Sr"+      , "03c01e7425647bdefa82b12d9bad5e3e6865bee0502694b94ca58b666abc0a5c3b"+      , "be17a268474a6bb9c61e1d720cf6215e2a88c5406c4aee7b38547f585c9a37d9"+      , "0488b21e025a61ff8effffffffbe17a268474a6bb9c61e1d720cf6215e2a88c5406c4aee7b38547f585c9a37d903c01e7425647bdefa82b12d9bad5e3e6865bee0502694b94ca58b666abc0a5c3b"+      , "0488ade4025a61ff8effffffffbe17a268474a6bb9c61e1d720cf6215e2a88c5406c4aee7b38547f585c9a37d900877c779ad9687164e9c2f4f0f4ff0340814392330693ce95a58fe18fd52e6e93"+      , "xpub6ASAVgeehLbnwdqV6UKMHVzgqAG8Gr6riv3Fxxpj8ksbH9ebxaEyBLZ85ySDhKiLDBrQSARLq1uNRts8RuJiHjaDMBU4Zn9h8LZNnBC5y4a"+      , "xprv9wSp6B7kry3Vj9m1zSnLvN3xH8RdsPP1Mh7fAaR7aRLcQMKTR2vidYEeEg2mUCTAwCd6vnxVrcjfy2kRgVsFawNzmjuHc2YmYRmagcEPdU9"+      ]+      -- m/0/2147483647'/1+    , [ "78412e3a2296a40de124307b6485bd19833e2e34"+      , "78412e3a"+      , "1BxrAr2pHpeBheusmd6fHDP2tSLAUa3qsW"+      , "704addf544a06e5ee4bea37098463c23613da32020d604506da8c0518e1da4b7"+      , "KzyzXnznxSv249b4KuNkBwowaN3akiNeEHy5FWoPCJpStZbEKXN2"+      , "03a7d1d856deb74c508e05031f9895dab54626251b3806e16b4bd12e781a7df5b9"+      , "f366f48f1ea9f2d1d3fe958c95ca84ea18e4c4ddb9366c336c927eb246fb38cb"+      , "0488b21e03d8ab493700000001f366f48f1ea9f2d1d3fe958c95ca84ea18e4c4ddb9366c336c927eb246fb38cb03a7d1d856deb74c508e05031f9895dab54626251b3806e16b4bd12e781a7df5b9"+      , "0488ade403d8ab493700000001f366f48f1ea9f2d1d3fe958c95ca84ea18e4c4ddb9366c336c927eb246fb38cb00704addf544a06e5ee4bea37098463c23613da32020d604506da8c0518e1da4b7"+      , "xpub6DF8uhdarytz3FWdA8TvFSvvAh8dP3283MY7p2V4SeE2wyWmG5mg5EwVvmdMVCQcoNJxGoWaU9DCWh89LojfZ537wTfunKau47EL2dhHKon"+      , "xprv9zFnWC6h2cLgpmSA46vutJzBcfJ8yaJGg8cX1e5StJh45BBciYTRXSd25UEPVuesF9yog62tGAQtHjXajPPdbRCHuWS6T8XA2ECKADdw4Ef"+      ]+      -- m/0/2147483647'/1/2147483646'+    , [ "31a507b815593dfc51ffc7245ae7e5aee304246e"+      , "31a507b8"+      , "15XVotxCAV7sRx1PSCkQNsGw3W9jT9A94R"+      , "f1c7c871a54a804afe328b4c83a1c33b8e5ff48f5087273f04efa83b247d6a2d"+      , "L5KhaMvPYRW1ZoFmRjUtxxPypQ94m6BcDrPhqArhggdaTbbAFJEF"+      , "02d2b36900396c9282fa14628566582f206a5dd0bcc8d5e892611806cafb0301f0"+      , "637807030d55d01f9a0cb3a7839515d796bd07706386a6eddf06cc29a65a0e29"+      , "0488b21e0478412e3afffffffe637807030d55d01f9a0cb3a7839515d796bd07706386a6eddf06cc29a65a0e2902d2b36900396c9282fa14628566582f206a5dd0bcc8d5e892611806cafb0301f0"+      , "0488ade40478412e3afffffffe637807030d55d01f9a0cb3a7839515d796bd07706386a6eddf06cc29a65a0e2900f1c7c871a54a804afe328b4c83a1c33b8e5ff48f5087273f04efa83b247d6a2d"+      , "xpub6ERApfZwUNrhLCkDtcHTcxd75RbzS1ed54G1LkBUHQVHQKqhMkhgbmJbZRkrgZw4koxb5JaHWkY4ALHY2grBGRjaDMzQLcgJvLJuZZvRcEL"+      , "xprvA1RpRA33e1JQ7ifknakTFpgNXPmW2YvmhqLQYMmrj4xJXXWYpDPS3xz7iAxn8L39njGVyuoseXzU6rcxFLJ8HFsTjSyQbLYnMpCqE2VbFWc"+      ]+      -- m/0/2147483647'/1/2147483646'/2+    , [ "26132fdbe7bf89cbc64cf8dafa3f9f88b8666220"+      , "26132fdb"+      , "14UKfRV9ZPUp6ZC9PLhqbRtxdihW9em3xt"+      , "bb7d39bdb83ecf58f2fd82b6d918341cbef428661ef01ab97c28a4842125ac23"+      , "L3WAYNAZPxx1fr7KCz7GN9nD5qMBnNiqEJNJMU1z9MMaannAt4aK"+      , "024d902e1a2fc7a8755ab5b694c575fce742c48d9ff192e63df5193e4c7afe1f9c"+      , "9452b549be8cea3ecb7a84bec10dcfd94afe4d129ebfd3b3cb58eedf394ed271"+      , "0488b21e0531a507b8000000029452b549be8cea3ecb7a84bec10dcfd94afe4d129ebfd3b3cb58eedf394ed271024d902e1a2fc7a8755ab5b694c575fce742c48d9ff192e63df5193e4c7afe1f9c"+      , "0488ade40531a507b8000000029452b549be8cea3ecb7a84bec10dcfd94afe4d129ebfd3b3cb58eedf394ed27100bb7d39bdb83ecf58f2fd82b6d918341cbef428661ef01ab97c28a4842125ac23"+      , "xpub6FnCn6nSzZAw5Tw7cgR9bi15UV96gLZhjDstkXXxvCLsUXBGXPdSnLFbdpq8p9HmGsApME5hQTZ3emM2rnY5agb9rXpVGyy3bdW6EEgAtqt"+      , "xprvA2nrNbFZABcdryreWet9Ea4LvTJcGsqrMzxHx98MMrotbir7yrKCEXw7nadnHM8Dq38EGfSh6dqA9QWTyefMLEcBYJUuekgW4BYPJcr9E7j"+      ]+    ]++pubKeyOfSubKeyIsSubKeyOfPubKey :: XPrvKey -> Word32 -> Bool+pubKeyOfSubKeyIsSubKeyOfPubKey k i =+    deriveXPubKey (prvSubKey k i') == pubSubKey (deriveXPubKey k) i'+  where+    i' = fromIntegral $ i .&. 0x7fffffff -- make it a public derivation+++testID :: (FromJSON a, ToJSON a, Eq a) => a -> Bool+testID x =+    (A.decode . A.encode) (singleton ("object" :: String) x) ==+    Just (singleton ("object" :: String) x)++testCustom :: Eq a => (Value -> Parser a) -> (a -> Value) -> a -> Bool+testCustom f g x = parseMaybe f (g x) == Just x++testPutGet :: Eq a => Get a -> Putter a -> a -> Bool+testPutGet g p a = runGet g (runPut (p a)) == Right a
+ test/Haskoin/Keys/MnemonicSpec.hs view
@@ -0,0 +1,494 @@+{-# LANGUAGE OverloadedStrings #-}+module Haskoin.Keys.MnemonicSpec (spec) where++import           Control.Monad           (zipWithM_)+import           Data.Bits               (shiftR, (.&.))+import           Data.ByteString         (ByteString)+import qualified Data.ByteString         as BS+import qualified Data.ByteString.Char8   as C+import           Data.Either             (fromRight)+import           Data.List               (isPrefixOf)+import           Data.Maybe              (fromJust)+import           Data.Serialize          (Serialize, encode)+import           Data.String.Conversions (cs)+import           Data.Text               (Text)+import qualified Data.Text               as T+import           Data.Word               (Word32, Word64)+import           Haskoin.Crypto+import           Haskoin.Keys+import           Haskoin.Test+import           Haskoin.Util+import           Test.Hspec+import           Test.HUnit+import           Test.QuickCheck         hiding ((.&.))++spec :: Spec+spec =+    describe "mnemonic" $ do+        it "entropy to mnemonic sentence" toMnemonicTest+        it "mnemonic sentence to entropy" fromMnemonicTest+        it "mnemonic sentence to seed" mnemonicToSeedTest+        it "mnemonic sentence with invalid checksum" fromMnemonicInvalidTest+        it "empty mnemonic sentence is invalid" $ sequence_ [emptyMnemonicTest]+        it "generate 12 words" $ property toMnemonic128+        it "generate 18 words" $ property toMnemonic160+        it "generate 24 words" $ property toMnemonic256+        it "generate 48 words" $ property toMnemonic512+        it "generate any number of words" $ property toMnemonicVar+        it "encode and decode 128-bit entropy" $ property fromToMnemonic128+        it "encode and decode 160-bit entropy" $ property fromToMnemonic160+        it "encode and decode 256-bit entropy" $ property fromToMnemonic256+        it "encode and decode 512-bit entropy" $ property fromToMnemonic512+        it "encode and decode n-bit entropy" $ property fromToMnemonicVar+        it "convert 128-bit mnemonic to seed" $ property mnemonicToSeed128+        it "convert 160-bit mnemonic to seed" $ property mnemonicToSeed160+        it "convert 256-bit mnemonic to seed" $ property mnemonicToSeed256+        it "convert 512-bit mnemonic to seed" $ property mnemonicToSeed512+        it "convert n-bit mnemonic to seed" $ property mnemonicToSeedVar+        it "get bits" $ property getBitsByteCount+        it "get end bits" $ property getBitsEndBits++toMnemonicTest :: Assertion+toMnemonicTest = zipWithM_ f ents mss+  where+    f e m = assertEqual "" m . h $ e+    h =+        fromRight (error "Could not decode mnemonic sentence") .+        toMnemonic . fromJust . decodeHex++fromMnemonicTest :: Assertion+fromMnemonicTest = zipWithM_ f ents mss+  where+    f e = assertEqual "" e . h+    h =+        encodeHex .+        fromRight (error "Could not decode mnemonic sentence") . fromMnemonic++mnemonicToSeedTest :: Assertion+mnemonicToSeedTest = zipWithM_ f mss seeds+  where+    f m s = assertEqual "" s . h $ m+    h =+        encodeHex .+        fromRight (error "Could not decode mnemonic seed") .+        mnemonicToSeed "TREZOR"++fromMnemonicInvalidTest :: Assertion+fromMnemonicInvalidTest = mapM_ f invalidMss+  where+    f = assertBool "" . h+    h m = case fromMnemonic m of+            Right _  -> False+            Left err -> "fromMnemonic: checksum failed:" `isPrefixOf` err++emptyMnemonicTest :: Assertion+emptyMnemonicTest =+    assertBool "" $+    case fromMnemonic "" of+        Right _  -> False+        Left err -> "fromMnemonic: empty mnemonic" `isPrefixOf` err++ents :: [Text]+ents =+    [ "00000000000000000000000000000000"+    , "7f7f7f7f7f7f7f7f7f7f7f7f7f7f7f7f"+    , "80808080808080808080808080808080"+    , "ffffffffffffffffffffffffffffffff"+    , "000000000000000000000000000000000000000000000000"+    , "7f7f7f7f7f7f7f7f7f7f7f7f7f7f7f7f7f7f7f7f7f7f7f7f"+    , "808080808080808080808080808080808080808080808080"+    , "ffffffffffffffffffffffffffffffffffffffffffffffff"+    , "0000000000000000000000000000000000000000000000000000000000000000"+    , "7f7f7f7f7f7f7f7f7f7f7f7f7f7f7f7f7f7f7f7f7f7f7f7f7f7f7f7f7f7f7f7f"+    , "8080808080808080808080808080808080808080808080808080808080808080"+    , "ffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff"+    , "77c2b00716cec7213839159e404db50d"+    , "b63a9c59a6e641f288ebc103017f1da9f8290b3da6bdef7b"+    , "3e141609b97933b66a060dcddc71fad1d91677db872031e85f4c015c5e7e8982"+    , "0460ef47585604c5660618db2e6a7e7f"+    , "72f60ebac5dd8add8d2a25a797102c3ce21bc029c200076f"+    , "2c85efc7f24ee4573d2b81a6ec66cee209b2dcbd09d8eddc51e0215b0b68e416"+    , "eaebabb2383351fd31d703840b32e9e2"+    , "7ac45cfe7722ee6c7ba84fbc2d5bd61b45cb2fe5eb65aa78"+    , "4fa1a8bc3e6d80ee1316050e862c1812031493212b7ec3f3bb1b08f168cabeef"+    , "18ab19a9f54a9274f03e5209a2ac8a91"+    , "18a2e1d81b8ecfb2a333adcb0c17a5b9eb76cc5d05db91a4"+    , "15da872c95a13dd738fbf50e427583ad61f18fd99f628c417a61cf8343c90419"+    ]++mss :: [Mnemonic]+mss =+    [ "abandon abandon abandon abandon abandon abandon abandon abandon abandon\+      \ abandon abandon about"+    , "legal winner thank year wave sausage worth useful legal winner thank\+      \ yellow"+    , "letter advice cage absurd amount doctor acoustic avoid letter advice\+      \ cage above"+    , "zoo zoo zoo zoo zoo zoo zoo zoo zoo zoo zoo wrong"+    , "abandon abandon abandon abandon abandon abandon abandon abandon abandon\+      \ abandon abandon abandon abandon abandon abandon abandon abandon agent"+    , "legal winner thank year wave sausage worth useful legal winner thank\+      \ year wave sausage worth useful legal will"+    , "letter advice cage absurd amount doctor acoustic avoid letter advice\+      \ cage absurd amount doctor acoustic avoid letter always"+    , "zoo zoo zoo zoo zoo zoo zoo zoo zoo zoo zoo zoo zoo zoo zoo zoo zoo\+      \ when"+    , "abandon abandon abandon abandon abandon abandon abandon abandon abandon\+      \ abandon abandon abandon abandon abandon abandon abandon abandon abandon\+      \ abandon abandon abandon abandon abandon art"+    , "legal winner thank year wave sausage worth useful legal winner thank\+      \ year wave sausage worth useful legal winner thank year wave sausage\+      \ worth title"+    , "letter advice cage absurd amount doctor acoustic avoid letter advice\+      \ cage absurd amount doctor acoustic avoid letter advice cage absurd\+      \ amount doctor acoustic bless"+    , "zoo zoo zoo zoo zoo zoo zoo zoo zoo zoo zoo zoo zoo zoo zoo zoo zoo zoo\+      \ zoo zoo zoo zoo zoo vote"+    , "jelly better achieve collect unaware mountain thought cargo oxygen act\+      \ hood bridge"+    , "renew stay biology evidence goat welcome casual join adapt armor shuffle\+      \ fault little machine walk stumble urge swap"+    , "dignity pass list indicate nasty swamp pool script soccer toe leaf photo\+      \ multiply desk host tomato cradle drill spread actor shine dismiss\+      \ champion exotic"+    , "afford alter spike radar gate glance object seek swamp infant panel\+      \ yellow"+    , "indicate race push merry suffer human cruise dwarf pole review arch keep\+      \ canvas theme poem divorce alter left"+    , "clutch control vehicle tonight unusual clog visa ice plunge glimpse\+      \ recipe series open hour vintage deposit universe tip job dress radar\+      \ refuse motion taste"+    , "turtle front uncle idea crush write shrug there lottery flower risk\+      \ shell"+    , "kiss carry display unusual confirm curtain upgrade antique rotate hello\+      \ void custom frequent obey nut hole price segment"+    , "exile ask congress lamp submit jacket era scheme attend cousin alcohol\+      \ catch course end lucky hurt sentence oven short ball bird grab wing top"+    , "board flee heavy tunnel powder denial science ski answer betray cargo\+      \ cat"+    , "board blade invite damage undo sun mimic interest slam gaze truly\+      \ inherit resist great inject rocket museum chief"+    , "beyond stage sleep clip because twist token leaf atom beauty genius food\+      \ business side grid unable middle armed observe pair crouch tonight away\+      \ coconut"+    ]++seeds :: [Text]+seeds =+    [ "c55257c360c07c72029aebc1b53c05ed0362ada38ead3e3e9efa3708e53495531f09a69\+      \87599d18264c1e1c92f2cf141630c7a3c4ab7c81b2f001698e7463b04"+    , "2e8905819b8723fe2c1d161860e5ee1830318dbf49a83bd451cfb8440c28bd6fa457fe1\+      \296106559a3c80937a1c1069be3a3a5bd381ee6260e8d9739fce1f607"+    , "d71de856f81a8acc65e6fc851a38d4d7ec216fd0796d0a6827a3ad6ed5511a30fa280f1\+      \2eb2e47ed2ac03b5c462a0358d18d69fe4f985ec81778c1b370b652a8"+    , "ac27495480225222079d7be181583751e86f571027b0497b5b5d11218e0a8a133325729\+      \17f0f8e5a589620c6f15b11c61dee327651a14c34e18231052e48c069"+    , "035895f2f481b1b0f01fcf8c289c794660b289981a78f8106447707fdd9666ca06da5a9\+      \a565181599b79f53b844d8a71dd9f439c52a3d7b3e8a79c906ac845fa"+    , "f2b94508732bcbacbcc020faefecfc89feafa6649a5491b8c952cede496c214a0c7b3c3\+      \92d168748f2d4a612bada0753b52a1c7ac53c1e93abd5c6320b9e95dd"+    , "107d7c02a5aa6f38c58083ff74f04c607c2d2c0ecc55501dadd72d025b751bc27fe913f\+      \fb796f841c49b1d33b610cf0e91d3aa239027f5e99fe4ce9e5088cd65"+    , "0cd6e5d827bb62eb8fc1e262254223817fd068a74b5b449cc2f667c3f1f985a76379b43\+      \348d952e2265b4cd129090758b3e3c2c49103b5051aac2eaeb890a528"+    , "bda85446c68413707090a52022edd26a1c9462295029f2e60cd7c4f2bbd3097170af7a4\+      \d73245cafa9c3cca8d561a7c3de6f5d4a10be8ed2a5e608d68f92fcc8"+    , "bc09fca1804f7e69da93c2f2028eb238c227f2e9dda30cd63699232578480a4021b146a\+      \d717fbb7e451ce9eb835f43620bf5c514db0f8add49f5d121449d3e87"+    , "c0c519bd0e91a2ed54357d9d1ebef6f5af218a153624cf4f2da911a0ed8f7a09e2ef61a\+      \f0aca007096df430022f7a2b6fb91661a9589097069720d015e4e982f"+    , "dd48c104698c30cfe2b6142103248622fb7bb0ff692eebb00089b32d22484e1613912f0\+      \a5b694407be899ffd31ed3992c456cdf60f5d4564b8ba3f05a69890ad"+    , "b5b6d0127db1a9d2226af0c3346031d77af31e918dba64287a1b44b8ebf63cdd52676f6\+      \72a290aae502472cf2d602c051f3e6f18055e84e4c43897fc4e51a6ff"+    , "9248d83e06f4cd98debf5b6f010542760df925ce46cf38a1bdb4e4de7d21f5c39366941\+      \c69e1bdbf2966e0f6e6dbece898a0e2f0a4c2b3e640953dfe8b7bbdc5"+    , "ff7f3184df8696d8bef94b6c03114dbee0ef89ff938712301d27ed8336ca89ef9635da2\+      \0af07d4175f2bf5f3de130f39c9d9e8dd0472489c19b1a020a940da67"+    , "65f93a9f36b6c85cbe634ffc1f99f2b82cbb10b31edc7f087b4f6cb9e976e9faf76ff41\+      \f8f27c99afdf38f7a303ba1136ee48a4c1e7fcd3dba7aa876113a36e4"+    , "3bbf9daa0dfad8229786ace5ddb4e00fa98a044ae4c4975ffd5e094dba9e0bb289349db\+      \e2091761f30f382d4e35c4a670ee8ab50758d2c55881be69e327117ba"+    , "fe908f96f46668b2d5b37d82f558c77ed0d69dd0e7e043a5b0511c48c2f1064694a956f\+      \86360c93dd04052a8899497ce9e985ebe0c8c52b955e6ae86d4ff4449"+    , "bdfb76a0759f301b0b899a1e3985227e53b3f51e67e3f2a65363caedf3e32fde42a66c4\+      \04f18d7b05818c95ef3ca1e5146646856c461c073169467511680876c"+    , "ed56ff6c833c07982eb7119a8f48fd363c4a9b1601cd2de736b01045c5eb8ab4f57b079\+      \403485d1c4924f0790dc10a971763337cb9f9c62226f64fff26397c79"+    , "095ee6f817b4c2cb30a5a797360a81a40ab0f9a4e25ecd672a3f58a0b5ba0687c096a6b\+      \14d2c0deb3bdefce4f61d01ae07417d502429352e27695163f7447a8c"+    , "6eff1bb21562918509c73cb990260db07c0ce34ff0e3cc4a8cb3276129fbcb300bddfe0\+      \05831350efd633909f476c45c88253276d9fd0df6ef48609e8bb7dca8"+    , "f84521c777a13b61564234bf8f8b62b3afce27fc4062b51bb5e62bdfecb23864ee6ecf0\+      \7c1d5a97c0834307c5c852d8ceb88e7c97923c0a3b496bedd4e5f88a9"+    , "b15509eaa2d09d3efd3e006ef42151b30367dc6e3aa5e44caba3fe4d3e352e65101fbdb\+      \86a96776b91946ff06f8eac594dc6ee1d3e82a42dfe1b40fef6bcc3fd"+    ]++invalidMss :: [Mnemonic]+invalidMss =+    [ "abandon abandon abandon abandon abandon abandon abandon abandon abandon\+      \ abandon abandon abandon"+    , "legal winner thank year wave sausage worth useful legal winner thank\+      \ thank"+    , "letter advice cage absurd amount doctor acoustic avoid letter advice\+      \ cage sausage"+    , "zoo zoo zoo zoo zoo zoo zoo zoo zoo zoo zoo zoo"+    , "abandon abandon abandon abandon abandon abandon abandon abandon abandon\+      \ abandon abandon abandon abandon abandon abandon abandon abandon abandon"+    , "legal winner thank year wave sausage worth useful legal winner thank\+      \ year wave sausage worth useful legal letter"+    , "letter advice cage absurd amount doctor acoustic avoid letter advice\+      \ cage absurd amount doctor acoustic avoid letter abandon"+    , "zoo zoo zoo zoo zoo zoo zoo zoo zoo zoo zoo zoo zoo zoo zoo zoo zoo\+      \ zoo"+    , "abandon abandon abandon abandon abandon abandon abandon abandon abandon\+      \ abandon abandon abandon abandon abandon abandon abandon abandon abandon\+      \ abandon abandon abandon abandon abandon abandon"+    , "legal winner thank year wave sausage worth useful legal winner thank\+      \ year wave sausage worth useful legal winner thank year wave sausage\+      \ worth letter"+    , "letter advice cage absurd amount doctor acoustic avoid letter advice\+      \ cage absurd amount doctor acoustic avoid letter advice cage absurd\+      \ amount doctor acoustic letter"+    , "zoo zoo zoo zoo zoo zoo zoo zoo zoo zoo zoo zoo zoo zoo zoo zoo zoo zoo\+      \ zoo zoo zoo zoo zoo zoo"+    , "jelly better achieve collect unaware mountain thought cargo oxygen act\+      \ hood zoo"+    , "renew stay biology evidence goat welcome casual join adapt armor shuffle\+      \ fault little machine walk stumble urge zoo"+    , "dignity pass list indicate nasty swamp pool script soccer toe leaf photo\+      \ multiply desk host tomato cradle drill spread actor shine dismiss\+      \ champion zoo"+    , "afford alter spike radar gate glance object seek swamp infant panel\+      \ zoo"+    , "indicate race push merry suffer human cruise dwarf pole review arch keep\+      \ canvas theme poem divorce alter zoo"+    , "clutch control vehicle tonight unusual clog visa ice plunge glimpse\+      \ recipe series open hour vintage deposit universe tip job dress radar\+      \ refuse motion zoo"+    , "turtle front uncle idea crush write shrug there lottery flower risk\+      \ zoo"+    , "kiss carry display unusual confirm curtain upgrade antique rotate hello\+      \ void custom frequent obey nut hole price zoo"+    , "exile ask congress lamp submit jacket era scheme attend cousin alcohol\+      \ catch course end lucky hurt sentence oven short ball bird grab wing zoo"+    , "board flee heavy tunnel powder denial science ski answer betray cargo\+      \ zoo"+    , "board blade invite damage undo sun mimic interest slam gaze truly\+      \ inherit resist great inject rocket museum zoo"+    , "beyond stage sleep clip because twist token leaf atom beauty genius food\+      \ business side grid unable middle armed observe pair crouch tonight away\+      \ zoo"+    ]++binWordsToBS :: Serialize a => [a] -> BS.ByteString+binWordsToBS = foldr f BS.empty+  where+    f b a = a `BS.append` encode b++{- Encode mnemonic -}++toMnemonic128 :: (Word64, Word64) -> Bool+toMnemonic128 (a, b) = l == 12+  where+    bs = encode a `BS.append` encode b+    l =+        length .+        T.words . fromRight (error "Could not decode mnemonic senttence") $+        toMnemonic bs++toMnemonic160 :: (Word32, Word64, Word64) -> Bool+toMnemonic160 (a, b, c) = l == 15+  where+    bs = BS.concat [encode a, encode b, encode c]+    l =+        length .+        T.words . fromRight (error "Could not decode mnemonic sentence") $+        toMnemonic bs++toMnemonic256 :: (Word64, Word64, Word64, Word64) -> Bool+toMnemonic256 (a, b, c, d) = l == 24+  where+    bs = BS.concat [encode a, encode b, encode c, encode d]+    l =+        length .+        T.words . fromRight (error "Could not decode mnemonic sentence") $+        toMnemonic bs++toMnemonic512 ::+    ((Word64, Word64, Word64, Word64), (Word64, Word64, Word64, Word64)) -> Bool+toMnemonic512 ((a, b, c, d), (e, f, g, h)) = l == 48+  where+    bs =+        BS.concat+            [ encode a+            , encode b+            , encode c+            , encode d+            , encode e+            , encode f+            , encode g+            , encode h+            ]+    l =+        length .+        T.words . fromRight (error "Could not decode mnemonic sentence") $+        toMnemonic bs++toMnemonicVar :: [Word32] -> Property+toMnemonicVar ls = not (null ls) && length ls <= 8 ==> l == wc+  where+    bs = binWordsToBS ls+    bl = BS.length bs+    cb = bl `div` 4+    wc = (cb + bl * 8) `div` 11+    l =+        length . T.words .+        fromRight (error "Could not decode mnemonic sentence") $+        toMnemonic bs++{- Encode/Decode -}++fromToMnemonic128 :: (Word64, Word64) -> Bool+fromToMnemonic128 (a, b) = bs == bs'+  where+    bs = encode a `BS.append` encode b+    bs' =+        fromRight+            (error "Could not decode mnemonic entropy")+            (fromMnemonic =<< toMnemonic bs)++fromToMnemonic160 :: (Word32, Word64, Word64) -> Bool+fromToMnemonic160 (a, b, c) = bs == bs'+  where+    bs = BS.concat [encode a, encode b, encode c]+    bs' =+        fromRight+            (error "Could not decode mnemonic entropy")+            (fromMnemonic =<< toMnemonic bs)++fromToMnemonic256 :: (Word64, Word64, Word64, Word64) -> Bool+fromToMnemonic256 (a, b, c, d) = bs == bs'+  where+    bs = BS.concat [encode a, encode b, encode c, encode d]+    bs' =+        fromRight+            (error "Could not decode mnemonic entropy")+            (fromMnemonic =<< toMnemonic bs)++fromToMnemonic512 ::+    ((Word64, Word64, Word64, Word64), (Word64, Word64, Word64, Word64)) -> Bool+fromToMnemonic512 ((a, b, c, d), (e, f, g, h)) = bs == bs'+  where+    bs =+        BS.concat+            [ encode a+            , encode b+            , encode c+            , encode d+            , encode e+            , encode f+            , encode g+            , encode h+            ]+    bs' =+        fromRight+            (error "Could not decode mnemonic entropy")+            (fromMnemonic =<< toMnemonic bs)++fromToMnemonicVar :: [Word32] -> Property+fromToMnemonicVar ls = not (null ls) && length ls <= 8 ==> bs == bs'+  where+    bs = binWordsToBS ls+    bs' =+        fromRight+            (error "Could not decode mnemonic entropy")+            (fromMnemonic =<< toMnemonic bs)++{- Mnemonic to seed -}++mnemonicToSeed128 :: (Word64, Word64) -> Bool+mnemonicToSeed128 (a, b) = l == 64+  where+    bs = encode a `BS.append` encode b+    seed =+        fromRight+            (error "Could not decode mnemonic seed")+            (mnemonicToSeed "" =<< toMnemonic bs)+    l = BS.length seed++mnemonicToSeed160 :: (Word32, Word64, Word64) -> Bool+mnemonicToSeed160 (a, b, c) = l == 64+  where+    bs = BS.concat [encode a, encode b, encode c]+    seed =+        fromRight+            (error "Could not decode mnemonic seed")+            (mnemonicToSeed "" =<< toMnemonic bs)+    l = BS.length seed++mnemonicToSeed256 :: (Word64, Word64, Word64, Word64) -> Bool+mnemonicToSeed256 (a, b, c, d) = l == 64+  where+    bs = BS.concat [encode a, encode b, encode c, encode d]+    seed =+        fromRight+            (error "Could not decode mnemonic seed")+            (mnemonicToSeed "" =<< toMnemonic bs)+    l = BS.length seed++mnemonicToSeed512 ::+    ((Word64, Word64, Word64, Word64), (Word64, Word64, Word64, Word64)) -> Bool+mnemonicToSeed512 ((a, b, c, d), (e, f, g, h)) = l == 64+  where+    bs =+        BS.concat+            [ encode a+            , encode b+            , encode c+            , encode d+            , encode e+            , encode f+            , encode g+            , encode h+            ]+    seed =+        fromRight+            (error "Could not decode mnemonic seed")+            (mnemonicToSeed "" =<< toMnemonic bs)+    l = BS.length seed++mnemonicToSeedVar :: [Word32] -> Property+mnemonicToSeedVar ls = not (null ls) && length ls <= 16 ==> l == 64+  where+    bs = binWordsToBS ls+    seed =+        fromRight+            (error "Could not decode mnemonic seed")+            (mnemonicToSeed "" =<< toMnemonic bs)+    l = BS.length seed++{- Get bits from ByteString -}++data ByteCountGen = ByteCountGen BS.ByteString Int deriving Show++instance Arbitrary ByteCountGen where+    arbitrary = do+        bs <- arbitraryBS+        i <- choose (0, BS.length bs * 8)+        return $ ByteCountGen bs i++getBitsByteCount :: ByteCountGen -> Bool+getBitsByteCount (ByteCountGen bs i) = BS.length bits == l+  where+    (q, r) = i `quotRem` 8+    bits = getBits i bs+    l = if r == 0 then q else q + 1++getBitsEndBits :: ByteCountGen -> Bool+getBitsEndBits (ByteCountGen bs i) =+    (r == 0) || (BS.last bits .&. (0xff `shiftR` r) == 0x00)+  where+    r = i `mod` 8+    bits = getBits i bs
+ test/Haskoin/KeysSpec.hs view
@@ -0,0 +1,72 @@+module Haskoin.KeysSpec (spec) where++import           Data.Aeson              as A+import qualified Data.ByteString         as BS+import           Data.Map.Strict         (singleton)+import           Data.Serialize          as S+import           Data.String             (fromString)+import           Data.String.Conversions (cs)+import           Haskoin.Address+import           Haskoin.Constants+import           Haskoin.Crypto+import           Haskoin.Keys+import           Haskoin.Test+import           Haskoin.Util+import           Test.Hspec+import           Test.QuickCheck++spec :: Spec+spec =+    describe "keys" $ do+        let net = btc+        it "is public key canonical" $+            property $ forAll arbitraryKeyPair (isCanonicalPubKey . snd)+        it "encode and decode wif private keys" $+            property $+            forAll arbitraryKeyPair $ \(pk, _) ->+                fromWif net (toWif net pk) == Just pk+        it "encode and decode serialized private key" $+            property $ forAll arbitrary binaryPrvKey+        it "read and show public key" $+            property $ forAll arbitraryKeyPair $ \(_, k) -> read (show k) == k+        it "read and show private key" $+            property $ forAll arbitrarySecKeyI $ \k -> read (show k) == k+        it "from string public key" $+            property $+            forAll arbitraryKeyPair $ \(_, k) ->+                fromString (cs . encodeHex $ S.encode k) == k+        it "encode and decode json public key" $+            property $ forAll arbitraryKeyPair (testID . snd)+        it "encodes and decodes serialized public key" $+            property $ forAll arbitraryKeyPair $ cerealID . snd+++-- github.com/bitcoin/bitcoin/blob/master/src/script.cpp+-- from function IsCanonicalPubKey+isCanonicalPubKey :: PubKeyI -> Bool+isCanonicalPubKey p = not $+    -- Non-canonical public key: too short+    (BS.length bs < 33) ||+    -- Non-canonical public key: invalid length for uncompressed key+    (BS.index bs 0 == 4 && BS.length bs /= 65) ||+    -- Non-canonical public key: invalid length for compressed key+    (BS.index bs 0 `elem` [2,3] && BS.length bs /= 33) ||+    -- Non-canonical public key: compressed nor uncompressed+    (BS.index bs 0 `notElem` [2,3,4])+  where+    bs = S.encode p++{- Key formats -}++binaryPrvKey :: SecKey -> Bool+binaryPrvKey k =+    Right k == runGet secKeyGet (runPut (secKeyPut k)) &&+    Just k == secKey (getSecKey k)++testID :: (FromJSON a, ToJSON a, Eq a) => a -> Bool+testID x =+    (A.decode . A.encode) (singleton ("object" :: String) x) ==+    Just (singleton ("object" :: String) x)++cerealID :: (Serialize a, Eq a) => a -> Bool+cerealID x = S.decode (S.encode x) == Right x
+ test/Haskoin/NetworkSpec.hs view
@@ -0,0 +1,186 @@+{-# LANGUAGE OverloadedStrings #-}+module Haskoin.NetworkSpec (spec) where++import           Data.Maybe          (fromJust)+import           Data.Serialize      as S+import           Data.Text           (Text)+import           Data.Word           (Word32)+import           Haskoin.Address+import           Haskoin.Constants+import           Haskoin.Keys+import           Haskoin.Network+import           Haskoin.Test+import           Haskoin.Transaction+import           Haskoin.Util+import           Test.Hspec+import           Test.HUnit          (Assertion, assertBool, assertEqual)+import           Test.QuickCheck++spec :: Spec+spec = do+    let net = btc+    describe "bloom filters" $ do+        it "bloom filter vector 1" bloomFilter1+        it "bloom filter vector 2" bloomFilter2+        it "bloom filter vector 3" bloomFilter3+    describe "relevant bloom filter update" $ do+        it "Relevant Update" relevantOutputUpdated+        it "Irrelevant Update" irrelevantOutputNotUpdated+    describe "serialization of protocol types" $ do+        it "encodes and decodes varint" $+            property $ forAll arbitraryVarInt cerealID+        it "encodes and decodes varstring" $+            property $ forAll arbitraryVarString cerealID+        it "encodes and decodes network address" $+            property $ forAll arbitraryNetworkAddress cerealID+        it "encodes and decodes invtype" $+            property $ forAll arbitraryInvType cerealID+        it "encodes and decodes invvector" $+            property $ forAll arbitraryInvVector cerealID+        it "encodes and decodes inv" $ property $ forAll arbitraryInv1 cerealID+        it "encodes and decodes version" $+            property $ forAll arbitraryVersion cerealID+        it "encodes and decodes addr" $ property $ forAll arbitraryAddr1 cerealID+        it "encodes and decodes alert" $ property $ forAll arbitraryAlert cerealID+        it "encodes and decodes reject" $+            property $ forAll arbitraryReject cerealID+        it "encodes and decodes getdata" $+            property $ forAll arbitraryGetData cerealID+        it "encodes and decodes notfound" $+            property $ forAll arbitraryNotFound cerealID+        it "encodes and decodes ping" $ property $ forAll arbitraryPing cerealID+        it "encodes and decodes pong" $ property $ forAll arbitraryPong cerealID+        it "encodes and decodes message command" $+            property $ forAll arbitraryMessageCommand cerealID+        it "encodes and decodes message header" $+            property $ forAll arbitraryMessageHeader cerealID+        it "encodes and decodes message" $+            property $+            forAll (arbitraryMessage net) $+            testPutGet (getMessage net) (putMessage net)+    describe "serialization of bloom types" $ do+        it "encodes and decodes bloom flags" $+            property $ forAll arbitraryBloomFlags cerealID+        it "encodes and decodes bloom filter" $+            property $ forAll arbitraryBloomFilter $ cerealID . lst3+        it "encodes and decodes filterload" $+            property $ forAll arbitraryFilterLoad cerealID+        it "encodes and decodes filteradd" $+            property $ forAll arbitraryFilterAdd cerealID++bloomFilter :: Word32 -> Text -> Assertion+bloomFilter n x = do+    assertBool "Bloom filter doesn't contain vector 1" $ bloomContains f1 v1+    assertBool "Bloom filter contains something it should not" $+        not $ bloomContains f1 v2+    assertBool "Bloom filter doesn't contain vector 3" $ bloomContains f3 v3+    assertBool "Bloom filter doesn't contain vector 4" $ bloomContains f4 v4+    assertBool "Bloom filter serialization is incorrect" $+        S.encode f4 == bs+  where+    f0 = bloomCreate 3 0.01 n BloomUpdateAll+    f1 = bloomInsert f0 v1+    f3 = bloomInsert f1 v3+    f4 = bloomInsert f3 v4+    v1 = fromJust $ decodeHex "99108ad8ed9bb6274d3980bab5a85c048f0950c8"+    v2 = fromJust $ decodeHex "19108ad8ed9bb6274d3980bab5a85c048f0950c8"+    v3 = fromJust $ decodeHex "b5a2c786d9ef4658287ced5914b37a1b4aa32eee"+    v4 = fromJust $ decodeHex "b9300670b4c5366e95b2699e8b18bc75e5f729c5"+    bs = fromJust $ decodeHex x++bloomFilter1 :: Assertion+bloomFilter1 = bloomFilter 0 "03614e9b050000000000000001"++bloomFilter2 :: Assertion+bloomFilter2 = bloomFilter 2147483649 "03ce4299050000000100008001"++bloomFilter3 :: Assertion+bloomFilter3 =+    assertBool "Bloom filter serialization is incorrect" $+        S.encode f2 == bs+  where+    f0 = bloomCreate 2 0.001 0 BloomUpdateAll+    f1 = bloomInsert f0 $ S.encode p+    f2 = bloomInsert f1 $ S.encode $ getAddrHash160 $ pubKeyAddr p+    k = fromJust $ fromWif btc "5Kg1gnAjaLfKiwhhPpGS3QfRg2m6awQvaj98JCZBZQ5SuS2F15C"+    p = derivePubKeyI k+    bs = fromJust $ decodeHex "038fc16b080000000000000001"++cerealID :: (Serialize a, Eq a) => a -> Bool+cerealID x = S.decode (S.encode x) == Right x++testPutGet :: Eq a => Get a -> Putter a -> a -> Bool+testPutGet g p a = runGet g (runPut (p a)) == Right a++relevantOutputUpdated :: Assertion+relevantOutputUpdated = assertBool "Bloom filter output updated" $+    any (bloomContains bf2) spendTxInput+    where+        bf0 = bloomCreate 10 0.000001 0 BloomUpdateAll+        relevantOutputHash = fromJust $ decodeHex"03f47604ea2736334151081e13265b4fe38e6fa8"+        bf1 = bloomInsert bf0 relevantOutputHash+        bf2 = fromJust $ bloomRelevantUpdate bf1 relevantTx+        spendTxInput = (encode .prevOutput) <$> txIn spendRelevantTx++irrelevantOutputNotUpdated :: Assertion+irrelevantOutputNotUpdated = assertEqual "Bloom filter not updated" Nothing bf2+    where+        bf0 = bloomCreate 10 0.000001 0 BloomUpdateAll+        relevantOutputHash = fromJust $ decodeHex"03f47604ea2736334151081e13265b4fe38e6fa8"+        bf1 = bloomInsert bf0 relevantOutputHash+        bf2 = bloomRelevantUpdate bf1 unrelatedTx+        spendTxInput = (encode .prevOutput) <$> txIn spendRelevantTx++-- Random transaction (57dc904f32ad4daab7b321dd469e8791ad09df784cdd273a73985150a4f225e9)+relevantTx :: Tx+relevantTx = Tx+        { txVersion = 1+        , txIn = [ TxIn+            { prevOutput = OutPoint "35fe9017b7e3af592920b56fa06ac02faf0c52cdb19dcb416129ac71c95d060e" 1+            , scriptInput = fromJust $ decodeHex "473044022032fc8eef299b7e94b9a986a6aa2dcb9733ab804bef80df995e443b9c1f8c604202203335df7a2e2b4789451cdb4b2b05a786a81c51519eb6a567fd6fe8cd7b2d33fe014104272502dc63a512dad1473cb82a71be9baf4f4303abd1ff6028fc8a78e1f3aec1218907119dec14f07354850758ff0948e88a904fa411c4df7d5444414ec64ad6"+            , txInSequence = 4294967295+            } ]+        , txOut =+            [ TxOut { outValue = 100000000, scriptOutput = fromJust $ decodeHex "76a91403f47604ea2736334151081e13265b4fe38e6fa888ac" }+            , TxOut { outValue = 107980000, scriptOutput = fromJust $ decodeHex "76a91481cc186a2f4a69f633ed4bf10ef4a78be13effdd88ac" }+            ]+        , txWitness = []+        , txLockTime = 0+        }++-- Transaction that spends above (fd6e3b693b844aa431fad46765c1aa019a6b13aebfa9dae916b3ffa43283a300)+spendRelevantTx :: Tx+spendRelevantTx = Tx+        { txVersion = 1+        , txIn = [ TxIn+            { prevOutput = OutPoint "57dc904f32ad4daab7b321dd469e8791ad09df784cdd273a73985150a4f225e9" 0+            , scriptInput = fromJust $ decodeHex "483045022100ecc334821e4e94cc2fdc841d5ad147d5bb942b993ba81460cc446e0410afa811022015fcbc542b734dbb61a05ec06012095096de5839c50808fe56f2b315e877c20d012103fb64e5792fa586172339b776b7017d3d529358cb73be6406a1fc994228d14f88"+            , txInSequence = 4294967295+            }, TxIn+            { prevOutput = OutPoint "cfee6a8d6e68e8fd16df6fff010afffcd19d7e075aa7b707dd1bae6adc420042" 0+            , scriptInput = fromJust $ decodeHex "47304402200e6bb95fa606f254d17089d83c4ceeb19c5d1699b4faddcd4f1f1568286e6b650220087fb8439f31e1b30e47710d095422405f601d6151f2f93e125e1a08a6e29ad4012103b49252e8fc6d5b49c8d14ee71fab45591df4a126a6c453c724f3d356e38f0cee"+            , txInSequence = 4294967295+            } ]+        , txOut =+            [ TxOut { outValue = 3851100, scriptOutput = fromJust $ decodeHex "76a914a297cae82a9a3b932bf023ae274fe2585295c9ca88ac" }+            , TxOut { outValue = 111000000, scriptOutput = fromJust $ decodeHex "76a9148f952c38600a61385974acc30a64f74407f9801488ac" }+            ]+        , txWitness = []+        , txLockTime = 0+        }++-- This random transaction is unrelated to the others+unrelatedTx :: Tx+unrelatedTx = Tx+        { txVersion = 1+        , txIn = [ TxIn+            { prevOutput = OutPoint "3ec3a71431c68e5d978a5fb4a0a1081d8bee8384d8aa4c06b1fbaf9413e2214f" 20+            , scriptInput = fromJust $ decodeHex "483045022100ec9c202c9d3140b973aca9d7f21a82138aa4cfa43fddc5419098ac5e26a6f152022010848fd688f290ae010fb5cb493410caa03145fc12445900ec1ad2bde33aecd9012102c7445e72d723f99a0064526c28269d07f47c8fd81531a94a8d3bf5ebd5e23ef1"+            , txInSequence = 4294967295+            }]+        , txOut =+            [ TxOut { outValue = 12600000, scriptOutput = fromJust $ decodeHex "76a9148fef3b7051de8cc44e966159e7ea37f4520187e888ac" }+            ]+        , txWitness = []+        , txLockTime = 0+        }
+ test/Haskoin/ScriptSpec.hs view
@@ -0,0 +1,406 @@+{-# LANGUAGE OverloadedStrings #-}+module Haskoin.ScriptSpec (spec) where++import           Control.Monad+import           Data.Aeson              as A+import           Data.ByteString         (ByteString)+import qualified Data.ByteString         as B+import qualified Data.ByteString.Lazy    as L+import           Data.Either+import           Data.List+import           Data.Map.Strict         (singleton)+import           Data.Maybe+import           Data.Monoid             ((<>))+import           Data.Serialize          as S+import           Data.String+import           Data.String.Conversions (cs)+import           Data.Text               (Text)+import           Data.Word+import           Haskoin.Address+import           Haskoin.Constants+import           Haskoin.Keys+import           Haskoin.Script+import           Haskoin.Test+import           Haskoin.Transaction+import           Haskoin.Util+import           Test.Hspec+import           Test.HUnit              as HUnit+import           Test.QuickCheck+import           Text.Read++spec :: Spec+spec = do+    let net = btc+    describe "btc scripts" $ props btc+    describe "bch scripts" $ props bch+    describe "multi signatures" $+        zipWithM_ (curry mapMulSigVector) mulSigVectors [0 ..]+    describe "signature decoding" $+        zipWithM_ (curry (sigDecodeMap net)) scriptSigSignatures [0 ..]+    describe "json serialization" $ do+        it "encodes and decodes script output" $+            forAll (arbitraryScriptOutput net) testID+        it "encodes and decodes outpoint" $ forAll arbitraryOutPoint testID+        it "encodes and decodes sighash" $ forAll arbitrarySigHash testID+        it "encodes and decodes siginput" $+            forAll (arbitrarySigInput net) (testID . fst)+    describe "script serialization" $ do+        it "encodes and decodes script op" $+            property $ forAll arbitraryScriptOp cerealID+        it "encodes and decodes script" $+            property $ forAll arbitraryScript cerealID++props :: Network -> Spec+props net = do+    standardSpec net+    strictSigSpec net+    scriptSpec net+    txSigHashForkIdSpec net+    forkIdScriptSpec net+    sigHashSpec net+    txSigHashSpec net++cerealID :: (Serialize a, Eq a) => a -> Bool+cerealID x = S.decode (S.encode x) == Right x++standardSpec :: Network -> Spec+standardSpec net = do+    it "has intToScriptOp . scriptOpToInt identity" $+        property $+        forAll arbitraryIntScriptOp $ \i ->+            intToScriptOp <$> scriptOpToInt i `shouldBe` Right i+    it "has decodeOutput . encodeOutput identity" $+        property $+        forAll (arbitraryScriptOutput net) $ \so ->+            decodeOutput (encodeOutput so) `shouldBe` Right so+    it "has decodeInput . encodeOutput identity" $+        property $+        forAll (arbitraryScriptInput net) $ \si ->+            decodeInput net (encodeInput si) `shouldBe` Right si+    it "can sort multisig scripts" $+        forAll arbitraryMSOutput $ \out ->+            map S.encode (getOutputMulSigKeys (sortMulSig out)) `shouldSatisfy` \xs ->+                xs == sort xs+    it "can decode inputs with empty signatures" $ do+        decodeInput net (Script [OP_0]) `shouldBe`+            Right (RegularInput (SpendPK TxSignatureEmpty))+        decodeInput net (Script [opPushData ""]) `shouldBe`+            Right (RegularInput (SpendPK TxSignatureEmpty))+        let pk =+                derivePubKeyI $+                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`+            Right (RegularInput (SpendMulSig [TxSignatureEmpty]))+        decodeInput net (Script [OP_0, OP_0, OP_0, OP_0]) `shouldBe`+            Right (RegularInput (SpendMulSig $ replicate 3 TxSignatureEmpty))++scriptSpec :: Network -> Spec+scriptSpec net =+    when (getNetworkName net == "btc") $+    it "can verify standard scripts from script_tests.json file" $ do+        xs <- readTestFile "script_tests" :: IO [A.Value]+        let vectorsA =+                mapMaybe (A.decode . A.encode) xs :: [( String+                                                      , String+                                                      , String+                                                      , String+                                                      , String)]+            vectorsB =+                mapMaybe (A.decode . A.encode) xs :: [( [Word64]+                                                      , String+                                                      , String+                                                      , String+                                                      , String+                                                      , String)]+            vectors =+                map (\(a, b, c, d, e) -> ([0], a, b, c, d, e)) vectorsA <>+                vectorsB+        length vectors `shouldBe` 86+        forM_ vectors $ \([val], siStr, soStr, flags, res, desc)+          -- We can disable specific tests by adding a DISABLED flag in the data+         ->+            unless ("DISABLED" `isInfixOf` flags) $ do+                let _strict =+                        "DERSIG" `isInfixOf` flags ||+                        "STRICTENC" `isInfixOf` flags ||+                        "NULLDUMMY" `isInfixOf` flags+                    scriptSig     = parseScript siStr+                    scriptPubKey  = parseScript soStr+                    decodedOutput = decodeOutputBS scriptPubKey+                    ver = either (const False) $ \so ->+                        verifyStdInput+                            net+                            (spendTx scriptPubKey 0 scriptSig)+                            0+                            so+                            (val * 100000000)+                case res of+                    "OK" -> assertBool desc $ ver decodedOutput+                    _    -> assertBool desc (not $ ver decodedOutput)++forkIdScriptSpec :: Network -> Spec+forkIdScriptSpec net =+    when (isJust (getSigHashForkId net)) $+    it "can verify scripts from forkid_script_tests.json file" $ do+        xs <- readTestFile "forkid_script_tests" :: IO [A.Value]+        let vectors =+                mapMaybe (A.decode . A.encode) xs :: [( [Word64]+                                                      , String+                                                      , String+                                                      , String+                                                      , String+                                                      , String)]+        length vectors `shouldBe` 3+        forM_ vectors $ \([valBTC], siStr, soStr, _, res, _) -> do+            let val = valBTC * 100000000+                scriptSig = parseScript siStr+                scriptPubKey = parseScript soStr+                decodedOutput =+                    fromRight (error $ "Could not decode output: " <> soStr) $+                    decodeOutputBS scriptPubKey+                ver =+                    verifyStdInput+                        net+                        (spendTx scriptPubKey val scriptSig)+                        0+                        decodedOutput+                        val+            case res of+                "OK" -> ver `shouldBe` True+                _    -> ver `shouldBe` False++creditTx :: ByteString -> Word64 -> Tx+creditTx scriptPubKey val =+    Tx 1 [txI] [txO] [] 0+  where+    txO = TxOut {outValue = val, scriptOutput = scriptPubKey}+    txI =+        TxIn+        { prevOutput = nullOutPoint+        , scriptInput = S.encode $ Script [OP_0, OP_0]+        , txInSequence = maxBound+        }++spendTx :: ByteString -> Word64 -> ByteString -> Tx+spendTx scriptPubKey val scriptSig =+    Tx 1 [txI] [txO] [] 0+  where+    txO = TxOut {outValue = val, scriptOutput = B.empty}+    txI =+        TxIn+        { prevOutput = OutPoint (txHash $ creditTx scriptPubKey val) 0+        , scriptInput = scriptSig+        , txInSequence = maxBound+        }++parseScript :: String -> ByteString+parseScript str =+    B.concat $ fromMaybe err $ mapM f $ words str+  where+    f = decodeHex . cs . dropHex . replaceToken+    dropHex ('0':'x':xs) = xs+    dropHex xs           = xs+    err = error $ "Could not decode script: " <> str++replaceToken :: String -> String+replaceToken str = case readMaybe $ "OP_" <> str of+    Just opcode -> "0x" <> cs (encodeHex $ S.encode (opcode :: ScriptOp))+    _           -> str++strictSigSpec :: Network -> Spec+strictSigSpec net =+    when (getNetworkName net == "btc") $ do+        it "can decode strict signatures" $ do+            xs <- readTestFile "sig_strict"+            let vectors = mapMaybe decodeHex xs+            length vectors `shouldBe` 3+            forM_ vectors $ \sig ->+                decodeTxSig net sig `shouldSatisfy` isRight+        it "can detect non-strict signatures" $ do+            xs <- readTestFile "sig_nonstrict"+            let vectors = mapMaybe decodeHex xs+            length vectors `shouldBe` 17+            forM_ vectors $ \sig ->+                decodeTxSig net sig `shouldSatisfy` isLeft++txSigHashSpec :: Network -> Spec+txSigHashSpec net =+    when (getNetworkName net == "btc") $+    it "can produce valid sighashes from sighash.json test vectors" $ do+        xs <- readTestFile "sighash" :: IO [A.Value]+        let vectors =+                mapMaybe (A.decode . A.encode) xs :: [( String+                                                      , String+                                                      , Int+                                                      , Integer+                                                      , String)]+        length vectors `shouldBe` 500+        forM_ vectors $ \(txStr, scpStr, i, shI, resStr) -> do+            let tx = fromString txStr+                s =+                    fromMaybe (error $ "Could not decode script: " <> cs scpStr) $+                    eitherToMaybe . S.decode =<< decodeHex (cs scpStr)+                sh = fromIntegral shI+                res =+                    eitherToMaybe . S.decode . B.reverse =<<+                    decodeHex (cs resStr)+            Just (txSigHash net tx s 0 i sh) `shouldBe` res++txSigHashForkIdSpec :: Network -> Spec+txSigHashForkIdSpec net =+    when (getNetworkName net == "btc") $+    it "can produce valid sighashes from forkid_sighash.json test vectors" $ do+        xs <- readTestFile "forkid_sighash" :: IO [A.Value]+        let vectors =+                mapMaybe (A.decode . A.encode) xs :: [( String+                                                      , String+                                                      , Int+                                                      , Word64+                                                      , Integer+                                                      , String)]+        length vectors `shouldBe` 13+        forM_ vectors $ \(txStr, scpStr, i, val, shI, resStr) -> do+            let tx = fromString txStr+                s =+                    fromMaybe (error $ "Could not decode script: " <> cs scpStr) $+                    eitherToMaybe . S.decode =<< decodeHex (cs scpStr)+                sh = fromIntegral shI+                res = eitherToMaybe . S.decode =<< decodeHex (cs resStr)+            Just (txSigHashForkId net tx s val i sh) `shouldBe` res++sigHashSpec :: Network -> Spec+sigHashSpec net = do+    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 :: 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+        0xffff `sigHashAddForkId` 0x00aaaaaa `shouldBe` 0xaaaaaaff+        0xffff `sigHashAddForkId` 0xaaaaaaaa `shouldBe` 0xaaaaaaff+        0xffff `sigHashAddForkId` 0x00004444 `shouldBe` 0x004444ff+        0xff01 `sigHashAddForkId` 0x44440000 `shouldBe` 0x44000001+        0xff03 `sigHashAddForkId` 0x00550000 `shouldBe` 0x55000003+    it "can extract a forkid" $ do+        sigHashGetForkId 0x00000000 `shouldBe` 0x00000000+        sigHashGetForkId 0x80000000 `shouldBe` 0x00800000+        sigHashGetForkId 0xffffffff `shouldBe` 0x00ffffff+        sigHashGetForkId 0xabac3403 `shouldBe` 0x00abac34+    it "can build some vectors" $ do+        sigHashAll `shouldBe` 0x01+        sigHashNone `shouldBe` 0x02+        sigHashSingle `shouldBe` 0x03+        setForkIdFlag sigHashAll `shouldBe` 0x41+        setAnyoneCanPayFlag sigHashAll `shouldBe` 0x81+        setAnyoneCanPayFlag (setForkIdFlag sigHashAll) `shouldBe` 0xc1+    it "can test flags" $ do+        hasForkIdFlag sigHashAll `shouldBe` False+        hasForkIdFlag (setForkIdFlag sigHashAll) `shouldBe` True+        hasAnyoneCanPayFlag sigHashAll `shouldBe` False+        hasAnyoneCanPayFlag (setAnyoneCanPayFlag sigHashAll) `shouldBe` True+        isSigHashAll sigHashNone `shouldBe` False+        isSigHashAll sigHashAll `shouldBe` True+        isSigHashNone sigHashSingle `shouldBe` False+        isSigHashNone sigHashNone `shouldBe` True+        isSigHashSingle sigHashAll `shouldBe` False+        isSigHashSingle sigHashSingle `shouldBe` True+        isSigHashUnknown sigHashAll `shouldBe` False+        isSigHashUnknown sigHashNone `shouldBe` False+        isSigHashUnknown sigHashSingle `shouldBe` False+        isSigHashUnknown 0x00 `shouldBe` True+        isSigHashUnknown 0x04 `shouldBe` True+    it "can decodeTxSig . encode a TxSignature" $+        property $+        forAll (arbitraryTxSignature net) $ \(_, _, ts) ->+            decodeTxSig net (encodeTxSig ts) `shouldBe` Right ts+    it "can produce the sighash one" $+        property $+        forAll (arbitraryTx net) $ forAll arbitraryScript . testSigHashOne net++testSigHashOne :: Network -> Tx -> Script -> Word64 -> Bool -> Property+testSigHashOne net tx s val acp =+    not (null $ txIn tx) ==>+    if length (txIn tx) > length (txOut tx)+        then res `shouldBe` one+        else res `shouldNotBe` one+  where+    res = txSigHash net tx s val (length (txIn tx) - 1) (f sigHashSingle)+    one = "0100000000000000000000000000000000000000000000000000000000000000"+    f =+        if acp+            then setAnyoneCanPayFlag+            else id++{-- Test Utilities --}++readTestFile :: A.FromJSON a => FilePath -> IO a+readTestFile fp = do+    bs <- L.readFile $ "data/" <> fp <> ".json"+    maybe (error $ "Could not read test file " <> fp) return $ A.decode bs++{- Parse tests from bitcoin-qt repository -}++mapMulSigVector :: ((Text, Text), Int) -> Spec+mapMulSigVector (v, i) =+    it name $ runMulSigVector v+  where+    name = "check multisig vector " <> show i++runMulSigVector :: (Text, Text) -> Assertion+runMulSigVector (a, ops) = assertBool "multisig vector" $ Just a == b+  where+    s = do+        s' <- decodeHex ops+        eitherToMaybe $ S.decode s'+    b = do+        o <- s+        d <- eitherToMaybe $ decodeOutput o+        addrToString btc $ payToScriptAddress d++sigDecodeMap :: Network -> (Text, Int) -> Spec+sigDecodeMap net (_, i) =+    it ("check signature " ++ show i) func+  where+    func = testSigDecode net $ scriptSigSignatures !! i++testSigDecode :: Network -> Text -> Assertion+testSigDecode net str =+    let bs = fromJust $ decodeHex str+        eitherSig = decodeTxSig net bs+    in assertBool+           (unwords+                [ "Decode failed:"+                , fromLeft (error "Decode did not fail") eitherSig+                ]) $+       isRight eitherSig++mulSigVectors :: [(Text, Text)]+mulSigVectors =+    [ ( "3QJmV3qfvL9SuYo34YihAf3sRCW3qSinyC"+      , "52410491bba2510912a5bd37da1fb5b1673010e43d2c6d812c514e91bfa9f2eb129e1c183329db55bd868e209aac2fbc02cb33d98fe74bf23f0c235d6126b1d8334f864104865c40293a680cb9c020e7b1e106d8c1916d3cef99aa431a56d253e69256dac09ef122b1a986818a7cb624532f062c1d1f8722084861c5c3291ccffef4ec687441048d2455d2403e08708fc1f556002f1b6cd83f992d085097f9974ab08a28838f07896fbab08f39495e15fa6fad6edbfb1e754e35fa1c7844c41f322a1863d4621353ae"+      )+    ]++scriptSigSignatures :: [Text]+scriptSigSignatures =+     -- Signature in input of txid 1983a69265920c24f89aac81942b1a59f7eb30821a8b3fb258f88882b6336053+    [ "304402205ca6249f43538908151fe67b26d020306c0e59fa206cf9f3ccf641f33357119d02206c82f244d04ac0a48024fb9cc246b66e58598acf206139bdb7b75a2941a2b1e401"+      -- Signature in input of txid+      -- fb0a1d8d34fa5537e461ac384bac761125e1bfa7fec286fa72511240fa66864d.+      -- Strange DER sizes, but in Blockchain. Now invalid as Haskoin can only+      -- decode strict signatures.+      -- "3048022200002b83d59c1d23c08efd82ee0662fec23309c3adbcbd1f0b8695378db4b14e736602220000334a96676e58b1bb01784cb7c556dd8ce1c220171904da22e18fe1e7d1510db501"+    ]+++testID :: (FromJSON a, ToJSON a, Eq a) => a -> Bool+testID x =+    (A.decode . A.encode) (singleton ("object" :: String) x) ==+    Just (singleton ("object" :: String) x)
+ test/Haskoin/Test.hs view
@@ -0,0 +1,23 @@+{-|+Module      : Haskoin.Test+Copyright   : No rights reserved+License     : UNLICENSE+Maintainer  : jprupp@protonmail.ch+Stability   : experimental+Portability : POSIX++Arbitrary instances for testing.+-}+module Haskoin.Test+    ( module X+    ) where++import           Haskoin.Test.Address     as X+import           Haskoin.Test.Block       as X+import           Haskoin.Test.Crypto      as X+import           Haskoin.Test.Keys        as X+import           Haskoin.Test.Message     as X+import           Haskoin.Test.Network     as X+import           Haskoin.Test.Script      as X+import           Haskoin.Test.Transaction as X+import           Haskoin.Test.Util        as X
+ test/Haskoin/Test/Address.hs view
@@ -0,0 +1,25 @@+{-|+Module      : Haskoin.Test.Address+Copyright   : No rights reserved+License     : UNLICENSE+Maintainer  : jprupp@protonmail.ch+Stability   : experimental+Portability : POSIX+-}+module Haskoin.Test.Address where++import           Haskoin.Address+import           Haskoin.Test.Crypto+import           Test.QuickCheck++-- | Arbitrary pay-to-public-key-hash or pay-to-script-hash address.+arbitraryAddress :: Gen Address+arbitraryAddress = oneof [arbitraryPubKeyAddress, arbitraryScriptAddress]++-- | Arbitrary pay-to-public-key-hash address.+arbitraryPubKeyAddress :: Gen Address+arbitraryPubKeyAddress = p2pkhAddr <$> arbitraryHash160++-- | Arbitrary pay-to-script-hash address.+arbitraryScriptAddress :: Gen Address+arbitraryScriptAddress = p2shAddr <$> arbitraryHash160
+ test/Haskoin/Test/Block.hs view
@@ -0,0 +1,69 @@+{-|+Module      : Haskoin.Test.Block+Copyright   : No rights reserved+License     : UNLICENSE+Maintainer  : jprupp@protonmail.ch+Stability   : experimental+Portability : POSIX+-}+module Haskoin.Test.Block where++import           Haskoin.Block.Common+import           Haskoin.Block.Merkle+import           Haskoin.Constants+import           Haskoin.Test.Crypto+import           Haskoin.Test.Network+import           Haskoin.Test.Transaction+import           Test.QuickCheck++-- | Block full or arbitrary transactions.+arbitraryBlock :: Network -> Gen Block+arbitraryBlock net = do+    h   <- arbitraryBlockHeader+    c   <- choose (0,10)+    txs <- vectorOf c (arbitraryTx net)+    return $ Block h txs++-- | Block header with random hash.+arbitraryBlockHeader :: Gen BlockHeader+arbitraryBlockHeader =+    BlockHeader <$> arbitrary+                      <*> arbitraryBlockHash+                      <*> arbitraryHash256+                      <*> arbitrary+                      <*> arbitrary+                      <*> arbitrary++-- | Arbitrary block hash.+arbitraryBlockHash :: Gen BlockHash+arbitraryBlockHash = BlockHash <$> arbitraryHash256++-- | Arbitrary 'GetBlocks' object with at least one block hash.+arbitraryGetBlocks :: Gen GetBlocks+arbitraryGetBlocks =+    GetBlocks <$> arbitrary+              <*> listOf1 arbitraryBlockHash+              <*> arbitraryBlockHash++-- | Arbitrary 'GetHeaders' object with at least one block header.+arbitraryGetHeaders :: Gen GetHeaders+arbitraryGetHeaders =+    GetHeaders <$> arbitrary+               <*> listOf1 arbitraryBlockHash+               <*> arbitraryBlockHash++-- | Arbitrary 'Headers' object with at least one block header.+arbitraryHeaders :: Gen Headers+arbitraryHeaders =+    Headers <$> listOf1 ((,) <$> arbitraryBlockHeader <*> arbitraryVarInt)++-- | Arbitrary 'MerkleBlock' with at least one hash.+arbitraryMerkleBlock :: Gen MerkleBlock+arbitraryMerkleBlock = do+    bh     <- arbitraryBlockHeader+    ntx    <- arbitrary+    hashes <- listOf1 arbitraryHash256+    c      <- choose (1,10)+    flags  <- vectorOf (c*8) arbitrary+    return $ MerkleBlock bh ntx hashes flags+
+ test/Haskoin/Test/Crypto.hs view
@@ -0,0 +1,33 @@+{-|+Module      : Haskoin.Test.Crypto+Copyright   : No rights reserved+License     : UNLICENSE+Maintainer  : jprupp@protonmail.ch+Stability   : experimental+Portability : POSIX+-}+module Haskoin.Test.Crypto where++import           Haskoin.Crypto.Hash+import           Haskoin.Test.Util+import           Test.QuickCheck++-- | Arbitrary 160-bit hash.+arbitraryHash160 :: Gen Hash160+arbitraryHash160 =+    ripemd160 <$> arbitraryBSn 20++-- | Arbitrary 256-bit hash.+arbitraryHash256 :: Gen Hash256+arbitraryHash256 =+    sha256 <$> arbitraryBSn 32++-- | Arbitrary 512-bit hash.+arbitraryHash512 :: Gen Hash512+arbitraryHash512 =+    sha512 <$> arbitraryBSn 64++-- | Arbitrary 32-bit checksum.+arbitraryCheckSum32 :: Gen CheckSum32+arbitraryCheckSum32 =+    checkSum32 <$> arbitraryBSn 4
+ test/Haskoin/Test/Keys.hs view
@@ -0,0 +1,85 @@+{-|+Module      : Haskoin.Test.Keys+Copyright   : No rights reserved+License     : UNLICENSE+Maintainer  : jprupp@protonmail.ch+Stability   : experimental+Portability : POSIX+-}+module Haskoin.Test.Keys where++import           Data.Bits             (clearBit)+import           Data.List             (foldl')+import           Data.Word             (Word32)+import           Haskoin.Crypto+import           Haskoin.Keys.Common+import           Haskoin.Keys.Extended+import           Haskoin.Test.Crypto+import           Test.QuickCheck++-- | Arbitrary private key with arbitrary compressed flag.+arbitrarySecKeyI :: Gen SecKeyI+arbitrarySecKeyI = wrapSecKey <$> arbitrary <*> arbitrary++-- | Arbitrary keypair, both either compressed or not.+arbitraryKeyPair :: Gen (SecKeyI, PubKeyI)+arbitraryKeyPair = do+    k <- arbitrarySecKeyI+    return (k, derivePubKeyI k)++-- | Arbitrary extended private key.+arbitraryXPrvKey :: Gen XPrvKey+arbitraryXPrvKey =+    XPrvKey <$> arbitrary+            <*> arbitrary+            <*> arbitrary+            <*> arbitraryHash256+            <*> arbitrary++-- | Arbitrary extended public key with its corresponding private key.+arbitraryXPubKey :: Gen (XPrvKey, XPubKey)+arbitraryXPubKey = (\k -> (k, deriveXPubKey k)) <$> arbitraryXPrvKey++{- Custom derivations -}++-- | Arbitrary derivation index with last bit unset.+genIndex :: Gen Word32+genIndex = (`clearBit` 31) <$> arbitrary++-- | Arbitrary BIP-32 path index. Can be hardened or not.+arbitraryBip32PathIndex :: Gen Bip32PathIndex+arbitraryBip32PathIndex =+    oneof [ Bip32SoftIndex <$> genIndex+          , Bip32HardIndex <$> genIndex+          ]++-- | Arbitrary BIP-32 derivation path composed of only hardened derivations.+arbitraryHardPath :: Gen HardPath+arbitraryHardPath = foldl' (:|) Deriv <$> listOf genIndex++-- | Arbitrary BIP-32 derivation path composed of only non-hardened derivations.+arbitrarySoftPath :: Gen SoftPath+arbitrarySoftPath = foldl' (:/) Deriv <$> listOf genIndex++-- | Arbitrary derivation path composed of hardened and non-hardened derivations.+arbitraryDerivPath :: Gen DerivPath+arbitraryDerivPath = concatBip32Segments <$> listOf arbitraryBip32PathIndex++-- | Arbitrary parsed derivation path. Can contain 'ParsedPrv', 'ParsedPub' or+-- 'ParsedEmpty' elements.+arbitraryParsedPath :: Gen ParsedPath+arbitraryParsedPath =+    oneof [ ParsedPrv <$> arbitraryDerivPath+          , ParsedPub <$> arbitraryDerivPath+          , ParsedEmpty <$> arbitraryDerivPath+          ]++-- | Arbitrary message hash, private key, nonce and corresponding signature. The+-- signature is generated with a random message, random private key and a random+-- nonce.+arbitrarySignature :: Gen (Hash256, SecKey, Sig)+arbitrarySignature = do+    m <- arbitraryHash256+    key <- arbitrary+    let sig = signHash key m+    return (m, key, sig)
+ test/Haskoin/Test/Message.hs view
@@ -0,0 +1,52 @@+{-|+Module      : Haskoin.Test.Message+Copyright   : No rights reserved+License     : UNLICENSE+Maintainer  : jprupp@protonmail.ch+Stability   : experimental+Portability : POSIX+-}+module Haskoin.Test.Message where++import           Haskoin.Constants+import           Haskoin.Network.Message+import           Haskoin.Test.Block+import           Haskoin.Test.Crypto+import           Haskoin.Test.Network+import           Haskoin.Test.Transaction+import           Test.QuickCheck++-- | Arbitrary 'MessageHeader'.+arbitraryMessageHeader :: Gen MessageHeader+arbitraryMessageHeader =+    MessageHeader <$> arbitrary+                  <*> arbitraryMessageCommand+                  <*> arbitrary+                  <*> arbitraryCheckSum32++-- | Arbitrary 'Message'.+arbitraryMessage :: Network -> Gen Message+arbitraryMessage net =+    oneof+        [ MVersion <$> arbitraryVersion+        , return MVerAck+        , MAddr <$> arbitraryAddr1+        , MInv <$> arbitraryInv1+        , MGetData <$> arbitraryGetData+        , MNotFound <$> arbitraryNotFound+        , MGetBlocks <$> arbitraryGetBlocks+        , MGetHeaders <$> arbitraryGetHeaders+        , MTx <$> arbitraryTx net+        , MBlock <$> arbitraryBlock net+        , MMerkleBlock <$> arbitraryMerkleBlock+        , MHeaders <$> arbitraryHeaders+        , return MGetAddr+        , MFilterLoad <$> arbitraryFilterLoad+        , MFilterAdd <$> arbitraryFilterAdd+        , return MFilterClear+        , MPing <$> arbitraryPing+        , MPong <$> arbitraryPong+        , MAlert <$> arbitraryAlert+        , MReject <$> arbitraryReject+        , return MSendHeaders+        ]
+ test/Haskoin/Test/Network.hs view
@@ -0,0 +1,178 @@+{-|+Module      : Haskoin.Test.Network+Copyright   : No rights reserved+License     : UNLICENSE+Maintainer  : jprupp@protonmail.ch+Stability   : experimental+Portability : POSIX+-}+module Haskoin.Test.Network where++import qualified Data.ByteString       as BS (empty, pack)+import qualified Data.ByteString.Char8 as C8+import           Data.Word             (Word16, Word32)+import           Haskoin.Network+import           Haskoin.Test.Crypto+import           Haskoin.Test.Util+import           Network.Socket        (SockAddr (..))+import           Test.QuickCheck++-- | Arbitrary 'VarInt'.+arbitraryVarInt :: Gen VarInt+arbitraryVarInt = VarInt <$> arbitrary++-- | Arbitrary 'VarString'.+arbitraryVarString :: Gen VarString+arbitraryVarString = VarString <$> arbitraryBS++-- | Arbitrary 'NetworkAddress'.+arbitraryNetworkAddress :: Gen NetworkAddress+arbitraryNetworkAddress = do+    s <- arbitrary+    a <- arbitrary+    p <- arbitrary+    d <- oneof+        [ do+            b <- arbitrary+            c <- arbitrary+            d <- arbitrary+            return $ SockAddrInet6 (fromIntegral p) 0 (a,b,c,d) 0+        , return $ SockAddrInet (fromIntegral (p :: Word16)) a+        ]+    let n = sockToHostAddress d+    return $ NetworkAddress s n++-- | Arbitrary 'NetworkAddressTime'.+arbitraryNetworkAddressTime :: Gen (Word32, NetworkAddress)+arbitraryNetworkAddressTime = (,) <$> arbitrary <*> arbitraryNetworkAddress++-- | Arbitrary 'InvType'.+arbitraryInvType :: Gen InvType+arbitraryInvType = elements [InvError, InvTx, InvBlock, InvMerkleBlock]++-- | Arbitrary 'InvVector'.+arbitraryInvVector :: Gen InvVector+arbitraryInvVector = InvVector <$> arbitraryInvType <*> arbitraryHash256++-- | Arbitrary non-empty 'Inv'.+arbitraryInv1 :: Gen Inv+arbitraryInv1 = Inv <$> listOf1 arbitraryInvVector++-- | Arbitrary 'Version'.+arbitraryVersion :: Gen Version+arbitraryVersion =+    Version <$> arbitrary+            <*> arbitrary+            <*> arbitrary+            <*> arbitraryNetworkAddress+            <*> arbitraryNetworkAddress+            <*> arbitrary+            <*> arbitraryVarString+            <*> arbitrary+            <*> arbitrary++-- | Arbitrary non-empty 'Addr'.+arbitraryAddr1 :: Gen Addr+arbitraryAddr1 = Addr <$> listOf1 arbitraryNetworkAddressTime++-- | Arbitrary 'Alert' with random payload and signature. Signature is not+-- valid.+arbitraryAlert :: Gen Alert+arbitraryAlert = Alert <$> arbitraryVarString <*> arbitraryVarString++-- | Arbitrary 'Reject'.+arbitraryReject :: Gen Reject+arbitraryReject = do+    m <- arbitraryMessageCommand+    c <- arbitraryRejectCode+    s <- arbitraryVarString+    d <- oneof [ return BS.empty+               , BS.pack <$> vectorOf 32 arbitrary+               ]+    return $ Reject m c s d++-- | Arbitrary 'RejectCode'.+arbitraryRejectCode :: Gen RejectCode+arbitraryRejectCode =+    elements+        [ RejectMalformed+        , RejectInvalid+        , RejectInvalid+        , RejectDuplicate+        , RejectNonStandard+        , RejectDust+        , RejectInsufficientFee+        , RejectCheckpoint+        ]++-- | Arbitrary non-empty 'GetData'.+arbitraryGetData :: Gen GetData+arbitraryGetData = GetData <$> listOf1 arbitraryInvVector++-- | Arbitrary 'NotFound'.+arbitraryNotFound :: Gen NotFound+arbitraryNotFound = NotFound <$> listOf1 arbitraryInvVector++-- | Arbitrary 'Ping'.+arbitraryPing :: Gen Ping+arbitraryPing = Ping <$> arbitrary++-- | Arbitrary 'Pong'.+arbitraryPong :: Gen Pong+arbitraryPong = Pong <$> arbitrary++-- | Arbitrary bloom filter flags.+arbitraryBloomFlags :: Gen BloomFlags+arbitraryBloomFlags =+    elements+        [ BloomUpdateNone+        , BloomUpdateAll+        , BloomUpdateP2PubKeyOnly+        ]++-- | Arbitrary bloom filter with its corresponding number of elements+-- and false positive rate.+arbitraryBloomFilter :: Gen (Int, Double, BloomFilter)+arbitraryBloomFilter = do+    n     <- choose (0,100000)+    fp    <- choose (1e-8,1)+    tweak <- arbitrary+    fl    <- arbitraryBloomFlags+    return (n, fp, bloomCreate n fp tweak fl)++-- | Arbitrary 'FilterLoad'.+arbitraryFilterLoad :: Gen FilterLoad+arbitraryFilterLoad = do+    (_, _, bf) <- arbitraryBloomFilter+    return $ FilterLoad bf++-- | Arbitrary 'FilterAdd'.+arbitraryFilterAdd :: Gen FilterAdd+arbitraryFilterAdd = FilterAdd <$> arbitraryBS++-- | Arbitrary 'MessageCommand'.+arbitraryMessageCommand :: Gen MessageCommand+arbitraryMessageCommand = do+    ASCIIString str <- arbitrary+    elements+        [ MCVersion+        , MCVerAck+        , MCAddr+        , MCInv+        , MCGetData+        , MCNotFound+        , MCGetBlocks+        , MCGetHeaders+        , MCTx+        , MCBlock+        , MCMerkleBlock+        , MCHeaders+        , MCGetAddr+        , MCFilterLoad+        , MCFilterAdd+        , MCFilterClear+        , MCPing+        , MCPong+        , MCAlert+        , MCOther (C8.take 12 (C8.pack (filter (/= '\NUL') str)))+        ]
+ test/Haskoin/Test/Script.hs view
@@ -0,0 +1,374 @@+{-# LANGUAGE LambdaCase #-}+{-|+Module      : Haskoin.Test.Script+Copyright   : No rights reserved+License     : UNLICENSE+Maintainer  : jprupp@protonmail.ch+Stability   : experimental+Portability : POSIX+-}+module Haskoin.Test.Script where++import           Crypto.Secp256k1+import           Data.Maybe+import           Data.Word+import           Haskoin.Address+import           Haskoin.Constants+import           Haskoin.Keys.Common+import           Haskoin.Script+import           Haskoin.Test.Address+import           Haskoin.Test.Crypto+import           Haskoin.Test.Keys+import           Haskoin.Test.Util+import           Haskoin.Transaction.Common+import           Haskoin.Util+import           Test.QuickCheck++-- | Arbitrary 'Script' with random script ops.+arbitraryScript :: Gen Script+arbitraryScript = Script <$> listOf arbitraryScriptOp++-- | Arbitrary 'ScriptOp' (push operations have random data).+arbitraryScriptOp :: Gen ScriptOp+arbitraryScriptOp =+    oneof+          -- Pushing Data+        [ opPushData <$> arbitraryBS1+        , return OP_0+        , return OP_1NEGATE+        , return OP_RESERVED+        , return OP_1+        , return OP_2+        , return OP_3+        , return OP_4+        , return OP_5+        , return OP_6+        , return OP_7+        , return OP_8+        , return OP_9+        , return OP_10+        , return OP_11+        , return OP_12+        , return OP_13+        , return OP_14+        , return OP_15+        , return OP_16+        -- Flow control+        , return OP_NOP+        , return OP_VER+        , return OP_IF+        , return OP_NOTIF+        , return OP_VERIF+        , return OP_VERNOTIF+        , return OP_ELSE+        , return OP_ENDIF+        , return OP_VERIFY+        , return OP_RETURN+        -- Stack operations+        , return OP_TOALTSTACK+        , return OP_FROMALTSTACK+        , return OP_IFDUP+        , return OP_DEPTH+        , return OP_DROP+        , return OP_DUP+        , return OP_NIP+        , return OP_OVER+        , return OP_PICK+        , return OP_ROLL+        , return OP_ROT+        , return OP_SWAP+        , return OP_TUCK+        , return OP_2DROP+        , return OP_2DUP+        , return OP_3DUP+        , return OP_2OVER+        , return OP_2ROT+        , return OP_2SWAP+        -- Splice+        , return OP_CAT+        , return OP_SUBSTR+        , return OP_LEFT+        , return OP_RIGHT+        , return OP_SIZE+        -- Bitwise logic+        , return OP_INVERT+        , return OP_AND+        , return OP_OR+        , return OP_XOR+        , return OP_EQUAL+        , return OP_EQUALVERIFY+        , return OP_RESERVED1+        , return OP_RESERVED2+        -- Arithmetic+        , return OP_1ADD+        , return OP_1SUB+        , return OP_2MUL+        , return OP_2DIV+        , return OP_NEGATE+        , return OP_ABS+        , return OP_NOT+        , return OP_0NOTEQUAL+        , return OP_ADD+        , return OP_SUB+        , return OP_MUL+        , return OP_DIV+        , return OP_MOD+        , return OP_LSHIFT+        , return OP_RSHIFT+        , return OP_BOOLAND+        , return OP_BOOLOR+        , return OP_NUMEQUAL+        , return OP_NUMEQUALVERIFY+        , return OP_NUMNOTEQUAL+        , return OP_LESSTHAN+        , return OP_GREATERTHAN+        , return OP_LESSTHANOREQUAL+        , return OP_GREATERTHANOREQUAL+        , return OP_MIN+        , return OP_MAX+        , return OP_WITHIN+        -- Crypto+        , return OP_RIPEMD160+        , return OP_SHA1+        , return OP_SHA256+        , return OP_HASH160+        , return OP_HASH256+        , return OP_CODESEPARATOR+        , return OP_CHECKSIG+        , return OP_CHECKSIGVERIFY+        , return OP_CHECKMULTISIG+        , return OP_CHECKMULTISIGVERIFY+        -- Expansion+        , return OP_NOP1+        , return OP_NOP2+        , return OP_NOP3+        , return OP_NOP4+        , return OP_NOP5+        , return OP_NOP6+        , return OP_NOP7+        , return OP_NOP8+        , return OP_NOP9+        , return OP_NOP10+        -- Other+        , return OP_PUBKEYHASH+        , return OP_PUBKEY+        , return $ OP_INVALIDOPCODE 0xff+        ]++-- | Arbtirary 'ScriptOp' with a value in @[OP_1 .. OP_16]@.+arbitraryIntScriptOp :: Gen ScriptOp+arbitraryIntScriptOp =+    elements+        [ OP_1,  OP_2,  OP_3,  OP_4+        , OP_5,  OP_6,  OP_7,  OP_8+        , OP_9,  OP_10, OP_11, OP_12+        , OP_13, OP_14, OP_15, OP_16+        ]++-- | Arbitrary 'PushDataType'.+arbitraryPushDataType :: Gen PushDataType+arbitraryPushDataType = elements [OPCODE, OPDATA1, OPDATA2, OPDATA4]++-- | Arbitrary 'SigHash' (including invalid/unknown sighash codes).+arbitrarySigHash :: Gen SigHash+arbitrarySigHash = fromIntegral <$> (arbitrary :: Gen Word32)++-- | Arbitrary valid 'SigHash'.+arbitraryValidSigHash :: Network -> Gen SigHash+arbitraryValidSigHash net = do+    sh <- elements [sigHashAll, sigHashNone, sigHashSingle]+    f1 <-+        elements $+        if isJust (getSigHashForkId net)+            then [id, setForkIdFlag]+            else [id]+    f2 <- elements [id, setAnyoneCanPayFlag]+    return $ f1 $ f2 sh++-- | Arbitrary message hash, private key and corresponding 'TxSignature'. The+-- signature is generated deterministically using a random message and a random+-- private key.+arbitraryTxSignature :: Network -> Gen (TxHash, SecKey, TxSignature)+arbitraryTxSignature net = do+    (m, key, sig) <- arbitrarySignature+    sh <- (fromIntegral <$> (arbitrary :: Gen Word8)) `suchThat` filterBad+    let txsig = TxSignature sig sh+    return (TxHash m, key, txsig)+  where+    filterBad sh = not $+        isSigHashUnknown sh ||+        isNothing (getSigHashForkId net) && hasForkIdFlag sh++-- | Arbitrary transaction signature that could also be empty.+arbitraryTxSignatureEmpty :: Network -> Gen TxSignature+arbitraryTxSignatureEmpty net =+    frequency [ (1, return TxSignatureEmpty)+              , (10, lst3 <$> arbitraryTxSignature net)+              ]++-- | Arbitrary m of n parameters.+arbitraryMSParam :: Gen (Int, Int)+arbitraryMSParam = do+    m <- choose (1,16)+    n <- choose (m,16)+    return (m, n)++-- | Arbitrary 'ScriptOutput' (Can by any valid type).+arbitraryScriptOutput :: Network -> Gen ScriptOutput+arbitraryScriptOutput net =+    oneof $+    [ arbitraryPKOutput+    , arbitraryPKHashOutput+    , arbitraryMSOutput+    , arbitrarySHOutput+    , arbitraryDCOutput+    ] +++    if getSegWit net+        then [arbitraryWPKHashOutput, arbitraryWSHOutput]+        else []++-- | Arbitrary 'ScriptOutput' of type 'PayPK', 'PayPKHash' or 'PayMS'+-- (Not 'PayScriptHash', 'DataCarrier', or SegWit)+arbitrarySimpleOutput :: Gen ScriptOutput+arbitrarySimpleOutput =+    oneof+        [ arbitraryPKOutput+        , arbitraryPKHashOutput+        , arbitraryMSOutput+        ]++-- | Arbitrary 'ScriptOutput' of type 'PayPK'+arbitraryPKOutput :: Gen ScriptOutput+arbitraryPKOutput =  PayPK . snd <$> arbitraryKeyPair++-- | Arbitrary 'ScriptOutput' of type 'PayPKHash'+arbitraryPKHashOutput :: Gen ScriptOutput+arbitraryPKHashOutput = PayPKHash <$> arbitraryHash160++-- | Arbitrary 'PayWitnessPKHash' output.+arbitraryWPKHashOutput :: Gen ScriptOutput+arbitraryWPKHashOutput = PayWitnessPKHash <$> arbitraryHash160++-- | Arbitrary 'PayWitnessScriptHash' output.+arbitraryWSHOutput :: Gen ScriptOutput+arbitraryWSHOutput = PayWitnessScriptHash <$> arbitraryHash256++-- | Arbitrary 'ScriptOutput' of type 'PayMS'.+arbitraryMSOutput :: Gen ScriptOutput+arbitraryMSOutput = do+    (m, n) <- arbitraryMSParam+    keys <- map snd <$> vectorOf n arbitraryKeyPair+    return $ PayMulSig keys m++-- | Arbitrary 'ScriptOutput' of type 'PayMS', only using compressed keys.+arbitraryMSOutputC :: Gen ScriptOutput+arbitraryMSOutputC = do+    (m, n) <- arbitraryMSParam+    keys <-+        map snd <$>+        vectorOf n (arbitraryKeyPair `suchThat` (pubKeyCompressed . snd))+    return $ PayMulSig keys m++-- | Arbitrary 'ScriptOutput' of type 'PayScriptHash'.+arbitrarySHOutput :: Gen ScriptOutput+arbitrarySHOutput = PayScriptHash . getAddrHash160 <$> arbitraryScriptAddress++-- | Arbitrary 'ScriptOutput' of type 'DataCarrier'.+arbitraryDCOutput :: Gen ScriptOutput+arbitraryDCOutput = DataCarrier <$> arbitraryBS1++-- | Arbitrary 'ScriptInput'.+arbitraryScriptInput :: Network -> Gen ScriptInput+arbitraryScriptInput net =+    oneof+        [ arbitraryPKInput net+        , arbitraryPKHashInput net+        , arbitraryMSInput net+        , arbitrarySHInput net+        ]++-- | Arbitrary 'ScriptInput' of type 'SpendPK', 'SpendPKHash' or 'SpendMulSig'+-- (not 'ScriptHashInput')+arbitrarySimpleInput :: Network -> Gen ScriptInput+arbitrarySimpleInput net =+    oneof+        [ arbitraryPKInput net+        , arbitraryPKHashInput net+        , arbitraryMSInput net+        ]++-- | Arbitrary 'ScriptInput' of type 'SpendPK'.+arbitraryPKInput :: Network -> Gen ScriptInput+arbitraryPKInput net = RegularInput . SpendPK <$> arbitraryTxSignatureEmpty net++-- | Arbitrary 'ScriptInput' of type 'SpendPK'.+arbitraryPKHashInput :: Network -> Gen ScriptInput+arbitraryPKHashInput net = do+    sig <- arbitraryTxSignatureEmpty net+    key <- snd <$> arbitraryKeyPair+    return $ RegularInput $ SpendPKHash sig key++-- | Like 'arbitraryPKHashInput' without empty signatures.+arbitraryPKHashInputFull :: Network -> Gen ScriptInput+arbitraryPKHashInputFull net = do+    sig <- lst3 <$> arbitraryTxSignature net+    key <- snd <$> arbitraryKeyPair+    return $ RegularInput $ SpendPKHash sig key++-- | Like above but only compressed.+arbitraryPKHashInputFullC :: Network -> Gen ScriptInput+arbitraryPKHashInputFullC net = do+    sig <- lst3 <$> arbitraryTxSignature net+    key <- fmap snd $ arbitraryKeyPair `suchThat` (pubKeyCompressed . snd)+    return $ RegularInput $ SpendPKHash sig key++-- | Arbitrary 'ScriptInput' of type 'SpendMulSig'.+arbitraryMSInput :: Network -> Gen ScriptInput+arbitraryMSInput net = do+    m    <- fst <$> arbitraryMSParam+    sigs <- vectorOf m (arbitraryTxSignatureEmpty net)+    return $ RegularInput $ SpendMulSig sigs++-- | Arbitrary 'ScriptInput' of type 'ScriptHashInput'.+arbitrarySHInput :: Network -> Gen ScriptInput+arbitrarySHInput net = do+    i <- arbitrarySimpleInput net+    ScriptHashInput (getRegularInput i) <$> arbitrarySimpleOutput++-- | Arbitrary 'ScriptInput' of type 'ScriptHashInput' containing a+-- 'RedeemScript' of type 'PayMulSig' and an input of type 'SpendMulSig'.+arbitraryMulSigSHInput :: Network -> Gen ScriptInput+arbitraryMulSigSHInput net =+    arbitraryMSOutput >>= \case+        rdm@(PayMulSig _ m) -> do+            sigs <- vectorOf m (arbitraryTxSignatureEmpty net)+            return $ ScriptHashInput (SpendMulSig sigs) rdm+        _ -> undefined++-- | Arbitrary 'ScriptInput' of type 'ScriptHashInput' containing a+-- 'RedeemScript' of type 'PayMulSig' and an input of type 'SpendMulSig'.+arbitraryMulSigSHInputC :: Network -> Gen ScriptInput+arbitraryMulSigSHInputC net =+    arbitraryMSOutputC >>= \case+        rdm@(PayMulSig _ m) -> do+          sigs <- vectorOf m (arbitraryTxSignatureEmpty net)+          return $ ScriptHashInput (SpendMulSig sigs) rdm+        _ -> undefined++-- | Like 'arbitraryMulSigSHCInput' with no empty signatures.+arbitraryMulSigSHInputFull :: Network -> Gen ScriptInput+arbitraryMulSigSHInputFull net =+    arbitraryMSOutput >>= \case+        rdm@(PayMulSig _ m) -> do+            sigs <- map lst3 <$> vectorOf m (arbitraryTxSignature net)+            return $ ScriptHashInput (SpendMulSig sigs) rdm+        _ -> undefined++-- | Like 'arbitraryMulSigSHCInput' with no empty signatures.+arbitraryMulSigSHInputFullC :: Network -> Gen ScriptInput+arbitraryMulSigSHInputFullC net =+    arbitraryMSOutputC >>= \case+        rdm@(PayMulSig _ m) -> do+            sigs <- map lst3 <$> vectorOf m (arbitraryTxSignature net)+            return $ ScriptHashInput (SpendMulSig sigs) rdm+        _ -> undefined
+ test/Haskoin/Test/Transaction.hs view
@@ -0,0 +1,275 @@+{-|+Module      : Haskoin.Test.Transaction+Copyright   : No rights reserved+License     : UNLICENSE+Maintainer  : jprupp@protonmail.ch+Stability   : experimental+Portability : POSIX+-}+module Haskoin.Test.Transaction where++import           Control.Monad+import qualified Data.ByteString     as BS+import           Data.Either         (fromRight)+import           Data.List           (nub, nubBy, permutations)+import           Data.Word           (Word64)+import           Haskoin.Address+import           Haskoin.Constants+import           Haskoin.Keys.Common+import           Haskoin.Script+import           Haskoin.Test.Crypto+import           Haskoin.Test.Keys+import           Haskoin.Test.Script+import           Haskoin.Test.Util+import           Haskoin.Transaction+import           Test.QuickCheck++-- | Wrapped coin value for testing.+newtype TestCoin = TestCoin { getTestCoin :: Word64 }+    deriving (Eq, Show)++instance Coin TestCoin where+    coinValue = getTestCoin++-- | Arbitrary transaction hash (for non-existent transaction).+arbitraryTxHash :: Gen TxHash+arbitraryTxHash = TxHash <$> arbitraryHash256++-- | Arbitrary amount of Satoshi as 'Word64' (Between 1 and 21e14)+arbitrarySatoshi :: Network -> Gen TestCoin+arbitrarySatoshi net = TestCoin <$> choose (1, getMaxSatoshi net)++-- | Arbitrary 'OutPoint'.+arbitraryOutPoint :: Gen OutPoint+arbitraryOutPoint = OutPoint <$> arbitraryTxHash <*> arbitrary++-- | Arbitrary 'TxOut'.+arbitraryTxOut :: Network -> Gen TxOut+arbitraryTxOut net =+    TxOut <$> (getTestCoin <$> arbitrarySatoshi net)+          <*> (encodeOutputBS <$> arbitraryScriptOutput net)++-- | Arbitrary 'TxIn'.+arbitraryTxIn :: Network -> Gen TxIn+arbitraryTxIn net =+    TxIn <$> arbitraryOutPoint+         <*> (encodeInputBS <$> arbitraryScriptInput net)+         <*> arbitrary++-- | Arbitrary transaction. Can be regular or with witnesses.+arbitraryTx :: Network -> Gen Tx+arbitraryTx net = oneof [arbitraryLegacyTx net, arbitraryWitnessTx net]++-- | Arbitrary regular transaction.+arbitraryLegacyTx :: Network -> Gen Tx+arbitraryLegacyTx net = arbitraryWLTx net False++-- | Arbitrary witness transaction (witness data is fake).+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)+    no <-+        if wit+            then choose (0, 5)+            else choose+                     ( if ni == 0+                           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+    w <- if wit then vectorOf (length uniqueInps) (listOf arbitraryBS) else return []+    Tx <$> arbitrary <*> pure uniqueInps <*> pure outs <*> pure w <*> arbitrary++-- | Arbitrary transaction containing only inputs of type 'SpendPKHash',+-- 'SpendScriptHash' (multisig) and outputs of type 'PayPKHash' and 'PaySH'.+-- Only compressed public keys are used.+arbitraryAddrOnlyTx :: Network -> Gen Tx+arbitraryAddrOnlyTx net = do+    ni <- choose (0, 5)+    no <- choose (0, 5)+    inps <- vectorOf ni (arbitraryAddrOnlyTxIn net)+    outs <- vectorOf no (arbitraryAddrOnlyTxOut net)+    Tx <$> arbitrary <*> pure inps <*> pure outs <*> pure [] <*> arbitrary++-- | Like 'arbitraryAddrOnlyTx' without empty signatures in the inputs.+arbitraryAddrOnlyTxFull :: Network -> Gen Tx+arbitraryAddrOnlyTxFull net = do+    ni <- choose (0, 5)+    no <- choose (0, 5)+    inps <- vectorOf ni (arbitraryAddrOnlyTxInFull net)+    outs <- vectorOf no (arbitraryAddrOnlyTxOut net)+    Tx <$> arbitrary <*> pure inps <*> pure outs <*> pure [] <*> arbitrary++-- | Arbitrary TxIn that can only be of type 'SpendPKHash' or 'SpendScriptHash'+-- (multisig). Only compressed public keys are used.+arbitraryAddrOnlyTxIn :: Network -> Gen TxIn+arbitraryAddrOnlyTxIn net = do+    inp <- oneof [arbitraryPKHashInput net, arbitraryMulSigSHInput net]+    TxIn <$> arbitraryOutPoint <*> pure (encodeInputBS inp) <*> arbitrary++-- | like 'arbitraryAddrOnlyTxIn' with no empty signatures.+arbitraryAddrOnlyTxInFull :: Network -> Gen TxIn+arbitraryAddrOnlyTxInFull net = do+    inp <-+        oneof [arbitraryPKHashInputFullC net, arbitraryMulSigSHInputFullC net]+    TxIn <$> arbitraryOutPoint <*> pure (encodeInputBS inp) <*> arbitrary++-- | Arbitrary 'TxOut' that can only be of type 'PayPKHash' or 'PaySH'.+arbitraryAddrOnlyTxOut :: Network -> Gen TxOut+arbitraryAddrOnlyTxOut net = do+    v <- getTestCoin <$> arbitrarySatoshi net+    out <- oneof [arbitraryPKHashOutput, arbitrarySHOutput]+    return $ TxOut v $ encodeOutputBS out++-- | Arbitrary 'SigInput' with the corresponding private keys used+-- to generate the 'ScriptOutput' or 'RedeemScript'.+arbitrarySigInput :: Network -> Gen (SigInput, [SecKeyI])+arbitrarySigInput net =+    oneof+        [ wrapKey <$> arbitraryPKSigInput net+        , wrapKey <$> arbitraryPKHashSigInput net+        , arbitraryMSSigInput net+        , arbitrarySHSigInput net+        , wrapKey <$> arbitraryWPKHSigInput net+        , arbitraryWSHSigInput net+        ]++-- | Arbitrary 'SigInput' with a 'ScriptOutput' of type 'PayPK'.+arbitraryPKSigInput :: Network -> Gen (SigInput, SecKeyI)+arbitraryPKSigInput net = arbitraryAnyInput net False++-- | Arbitrary 'SigInput' with a 'ScriptOutput' of type 'PayPKHash'.+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+    let out | pkh = PayPKHash $ getAddrHash160 $ pubKeyAddr p+            | otherwise = PayPK p+    (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+    op <- arbitraryOutPoint+    sh <- arbitraryValidSigHash net+    return (val, op, sh)++-- | Arbitrary 'SigInput' with a 'ScriptOutput' of type 'PayMulSig'.+arbitraryMSSigInput :: Network -> Gen (SigInput, [SecKeyI])+arbitraryMSSigInput net = do+    (m, n) <- arbitraryMSParam+    ks <- vectorOf n arbitraryKeyPair+    let out = PayMulSig (map snd ks) m+    (val, op, sh) <- arbitraryInputStuff net+    perm <- choose (0, n - 1)+    let ksPerm = map fst $ take m $ permutations ks !! perm+    return (SigInput out val op sh Nothing, ksPerm)++-- | Arbitrary 'SigInput' with 'ScriptOutput' of type 'PaySH' and a+-- 'RedeemScript'.+arbitrarySHSigInput :: Network -> Gen (SigInput, [SecKeyI])+arbitrarySHSigInput net = do+    (SigInput rdm val op sh _, ks) <- oneof+        [ wrapKey <$> arbitraryPKSigInput net+        , wrapKey <$> arbitraryPKHashSigInput net+        , arbitraryMSSigInput net+        ]+    let out = PayScriptHash $ getAddrHash160 $ payToScriptAddress rdm+    return (SigInput out val op sh $ Just rdm, ks)++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])+arbitrarySigningData net = do+    v <- arbitrary+    ni <- choose (1, 5)+    no <- choose (1, 5)+    sigis <- vectorOf ni (arbitrarySigInput net)+    let uSigis = nubBy (\(a, _) (b, _) -> sigInputOP a == sigInputOP b) sigis+    inps <- forM uSigis $ \(s, _) -> TxIn (sigInputOP s) BS.empty <$> arbitrary+    outs <- vectorOf no (arbitraryTxOut net)+    l <- arbitrary+    perm <- choose (0, length inps - 1)+    let tx = Tx v (permutations inps !! perm) outs [] l+        keys = concatMap snd uSigis+    return (tx, map fst uSigis, keys)++-- | Arbitrary transaction with empty inputs.+arbitraryEmptyTx :: Network -> Gen Tx+arbitraryEmptyTx net = do+    v    <- arbitrary+    no   <- choose (1,5)+    ni   <- choose (1,5)+    outs <- vectorOf no (arbitraryTxOut net)+    ops  <- vectorOf ni arbitraryOutPoint+    t    <- arbitrary+    s    <- arbitrary+    return $ Tx v (map (\op -> TxIn op BS.empty s) (nub ops)) outs [] t++-- | Arbitrary partially-signed transactions.+arbitraryPartialTxs ::+       Network -> Gen ([Tx], [(ScriptOutput, Word64, OutPoint, Int, Int)])+arbitraryPartialTxs net = do+    tx <- arbitraryEmptyTx net+    res <-+        forM (map prevOutput $ txIn tx) $ \op -> do+            (so, val, rdmM, prvs, m, n) <- arbitraryData+            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+    singleSig so val rdmM tx op prv = do+        sh <- arbitraryValidSigHash net+        let sigi = SigInput so val op sh rdmM+        return . fromRight (error "Could not decode transaction") $+            signTx net tx [sigi] [prv]+    arbitraryData = do+        (m, n) <- arbitraryMSParam+        val <- getTestCoin <$> arbitrarySatoshi net+        nPrv <- choose (m, n)+        keys <- vectorOf n arbitraryKeyPair+        perm <- choose (0, length keys - 1)+        let pubKeys = map snd keys+            prvKeys = take nPrv $ permutations (map fst keys) !! perm+        let so = PayMulSig pubKeys m+        elements+            [ (so, val, Nothing, prvKeys, m, n)+            , ( PayScriptHash $ getAddrHash160 $ payToScriptAddress so+              , val+              , Just so+              , prvKeys+              , m+              , n)+            ]++wrapKey :: (SigInput, SecKeyI) -> (SigInput, [SecKeyI])+wrapKey (s, k) = (s, [k])
+ test/Haskoin/Test/Util.hs view
@@ -0,0 +1,40 @@+{-|+Module      : Haskoin.Test.Util+Copyright   : No rights reserved+License     : UNLICENSE+Maintainer  : jprupp@protonmail.ch+Stability   : experimental+Portability : POSIX+-}+module Haskoin.Test.Util where++import           Data.ByteString       (ByteString, pack)+import           Data.Time.Clock       (UTCTime (..))+import           Data.Time.Clock.POSIX (posixSecondsToUTCTime)+import           Data.Word             (Word32)+import           Test.QuickCheck++-- | Arbitrary strict 'ByteString'.+arbitraryBS :: Gen ByteString+arbitraryBS = pack <$> arbitrary++-- | Arbitrary non-empty strict ByteString+arbitraryBS1 :: Gen ByteString+arbitraryBS1 = pack <$> listOf1 arbitrary++-- | Arbitrary strict ByteString of a given length+arbitraryBSn :: Int -> Gen ByteString+arbitraryBSn n = pack <$> vectorOf n arbitrary++-- | Arbitrary UTCTime that generates dates after 01 Jan 1970 01:00:00 CET+arbitraryUTCTime :: Gen UTCTime+arbitraryUTCTime = do+    w <- arbitrary :: Gen Word32+    return $ posixSecondsToUTCTime $ realToFrac w++-- | Generate a Maybe from a Gen a+arbitraryMaybe :: Gen a -> Gen (Maybe a)+arbitraryMaybe g = frequency [ (1, return Nothing)+                             , (5, Just <$> g)+                             ]+
+ test/Haskoin/Transaction/PartialSpec.hs view
@@ -0,0 +1,335 @@+{-# LANGUAGE OverloadedStrings #-}++module Haskoin.Transaction.PartialSpec (spec) where++import           Control.Monad.Fail          (MonadFail)+import           Data.ByteString             (ByteString)+import           Data.Either                 (fromRight, isLeft, isRight)+import           Data.HashMap.Strict         (fromList, singleton)+import           Data.Maybe                  (fromJust, isJust)+import           Data.Serialize              as S+import           Data.Text                   (Text)+import           Test.Hspec+import           Test.HUnit                  (Assertion, assertBool,+                                              assertEqual)+import           Test.QuickCheck++import           Haskoin.Address+import           Haskoin.Constants+import           Haskoin.Crypto+import           Haskoin.Keys+import           Haskoin.Script+import           Haskoin.Test+import           Haskoin.Transaction+import           Haskoin.Transaction.Partial+import           Haskoin.Util++spec :: Spec+spec = describe "partially signed bitcoin transaction unit tests" $ do+    it "encodes trivial psbt" $+        encodeHex (S.encode trivialPSBT) == trivialPSBTHex+    it "decodes trivial psbt" $+        decodeHexPSBT trivialPSBTHex == Right trivialPSBT+    it "encodes and decodes non-empty transactions" $+        S.decode (S.encode nonEmptyTransactionPSBT) == Right nonEmptyTransactionPSBT+    it "does not decode invalid bip vectors" $+        mapM_ invalidVecTest invalidVec+    it "encodes valid bip vecs" $+        mapM_ (uncurry encodeVecTest) validEncodeVec+    it "decodes valid bip vecs" $+        mapM_ (uncurry decodeVecTest) $ zip [1..] validVec+    it "decodes vector 2" vec2Test+    it "decodes vector 3" vec3Test+    it "decodes vector 4" vec4Test+    it "decodes vector 5" vec5Test+    it "decodes vector 6" vec6Test+    it "signed and finalized p2pkh PSBTs verify" $ property $+        forAll arbitraryKeyPair $ verifyNonWitnessPSBT btc . unfinalizedPkhPSBT btc+    it "signed and finalized multisig PSBTs verify" $ property $+        forAll arbitraryMultiSig $ verifyNonWitnessPSBT btc . unfinalizedMsPSBT btc++vec2Test :: Assertion+vec2Test = do+    psbt <- decodeHexPSBTM "Cannot parse validVec2" validVec2Hex+    assertEqual "2 inputs" 2 (length $ inputs psbt)+    assertEqual "2 outputs" 2 (length $ outputs psbt)+    assertBool "final script sig" $ isJust (finalScriptSig . head $ inputs psbt)++    let rdmScript = fromJust . inputRedeemScript $ inputs psbt !! 1+    assertBool "p2wpkh" $ (isPayWitnessPKHash <$> decodeOutput rdmScript) == Right True++    let scrptPubKey = witnessScriptPubKey $ inputs psbt !! 1+        rdmScriptP2SH = toP2SH rdmScript+    assertEqual "redeem script pubkey equal" rdmScriptP2SH scrptPubKey+    assertEqual "expected redeem script"  expectedOut rdmScriptP2SH++    mapM_ (assertEqual "outputs are empty" emptyOutput) (outputs psbt)++vec3Test :: Assertion+vec3Test = do+    psbt <- decodeHexPSBTM "Cannot parse validVec3" validVec3Hex+    assertEqual "1 input" 1 (length $ inputs psbt)+    assertEqual "2 outputs" 2 (length $ outputs psbt)+    let txInput = head . txIn $ unsignedTransaction psbt+        firstInput = head $ inputs psbt+        Just utx = nonWitnessUtxo firstInput+        OutPoint prevHash prevVOut = prevOutput txInput+    assertEqual "txids of inputs match" prevHash (txHash utx)+    let prevOutputKey = fromRight (error "Could not decode key")+                      . decodeOutputBS . scriptOutput $ txOut utx !! fromIntegral prevVOut+    assertBool "p2pkh" $ isPayPKHash prevOutputKey+    assertEqual "sighash type" sigHashAll (fromJust $ sigHashType firstInput)++vec4Test :: Assertion+vec4Test = do+    psbt <- decodeHexPSBTM "Cannot parse validVec4" validVec4Hex+    assertEqual "2 inputs" 2 (length $ inputs psbt)+    assertEqual "2 outputs" 2 (length $ outputs psbt)+    let firstInput = head $ inputs psbt+        secondInput = inputs psbt !! 1+    assertEqual "first input not final script sig" Nothing (finalScriptSig firstInput)+    assertEqual "second input not final script sig" Nothing (finalScriptSig secondInput)++    let rdmScript = fromJust $ inputRedeemScript secondInput+    assertBool "p2wpkh" $ (isPayWitnessPKHash <$> decodeOutput rdmScript) == Right True++    let scrptPubKey = witnessScriptPubKey secondInput+        rdmScriptP2SH = toP2SH rdmScript+    assertEqual "redeem script pubkey equal" rdmScriptP2SH scrptPubKey+    assertEqual "expected redeem script"  expectedOut rdmScriptP2SH++    assertBool "all non-empty outputs" $ emptyOutput `notElem` outputs psbt++vec5Test :: Assertion+vec5Test = do+    psbt <- decodeHexPSBTM "Cannot parse validVec5" validVec5Hex+    assertEqual "1 input" 1 (length $ inputs psbt)+    assertEqual "1 output" 1 (length $ outputs psbt)+    let input = head $ inputs psbt+    assertEqual "input not final script sig" Nothing (finalScriptSig input)++    let rdmScript = fromJust $ inputRedeemScript input+    assertBool "p2wsh" $ (isPayWitnessScriptHash <$> decodeOutput rdmScript) == Right True++    let scrptPubKey = witnessScriptPubKey input+        rdmScriptP2SH = toP2SH rdmScript+    assertEqual "redeem script pubkey equal" rdmScriptP2SH scrptPubKey+    assertEqual "expected redeem script"  expectedOut2 rdmScriptP2SH+  where+    expectedOut2 = fromRight (error "could not decode expected output")+                . decodeOutputBS . fromJust $ decodeHex "a9146345200f68d189e1adc0df1c4d16ea8f14c0dbeb87"++vec6Test :: Assertion+vec6Test = do+    psbt <- decodeHexPSBTM "Cannot parse validVec6" validVec6Hex+    assertEqual "1 input" 1 (length $ inputs psbt)+    assertEqual "1 output" 1 (length $ outputs psbt)++    let tx = unsignedTransaction psbt+    assertEqual "correct transaction" "75c5c9665a570569ad77dd1279e6fd4628a093c4dcbf8d41532614044c14c115" (txHash tx)++    assertEqual "correct unknowns" expectedUnknowns (inputUnknown . head $ inputs psbt)+  where+    expectedUnknowns = UnknownMap $ singleton+        (Key 0x0f (fromJust $ decodeHex "010203040506070809"))+        (fromJust $ decodeHex "0102030405060708090a0b0c0d0e0f")++expectedOut :: ScriptOutput+expectedOut = fromRight (error "could not decode expected output")+            . decodeOutputBS . fromJust $ decodeHex "a9143545e6e33b832c47050f24d3eeb93c9c03948bc787"++witnessScriptPubKey :: Input -> ScriptOutput+witnessScriptPubKey = fromRight (error "could not decode witness utxo")+                    . decodeOutputBS . scriptOutput . fromJust . witnessUtxo++decodeHexPSBT :: Text -> Either String PartiallySignedTransaction+decodeHexPSBT = S.decode . fromJust . decodeHex++decodeHexPSBTM :: (Monad m, MonadFail m) => String -> Text -> m PartiallySignedTransaction+decodeHexPSBTM errMsg = either (fail . (errMsg <>) . (": " <>)) return . decodeHexPSBT++hexScript :: Text -> ByteString+hexScript =+    either (error "Could not decode script") encodeScript . S.decode . fromJust . decodeHex+  where+    encodeScript :: Script -> ByteString+    encodeScript = S.encode++invalidVecTest :: Text -> Assertion+invalidVecTest = assertBool "invalid psbt" . isLeft . decodeHexPSBT++decodeVecTest :: Int -> Text -> Assertion+decodeVecTest i = assertBool (show i <> " decodes correctly") . isRight . decodeHexPSBT++encodeVecTest :: PartiallySignedTransaction -> Text -> Assertion+encodeVecTest psbt hex = assertEqual "encodes correctly" (S.encode psbt) (fromJust $ decodeHex hex)++trivialPSBT :: PartiallySignedTransaction+trivialPSBT = PartiallySignedTransaction+    { unsignedTransaction = Tx { txVersion = 2, txIn = [], txOut = [], txWitness = [], txLockTime = 0 }+    , globalUnknown = UnknownMap mempty+    , inputs = []+    , outputs = []+    }++trivialPSBTHex :: Text+trivialPSBTHex = "70736274ff01000a0200000000000000000000"++nonEmptyTransactionPSBT :: PartiallySignedTransaction+nonEmptyTransactionPSBT = emptyPSBT testTx1++verifyNonWitnessPSBT :: Network -> PartiallySignedTransaction -> Bool+verifyNonWitnessPSBT net psbt = verifyStdTx net (finalTransaction (complete psbt)) sigData+  where+    sigData = inputSigData =<< zip (inputs psbt) (txIn $ unsignedTransaction psbt)+    decodeOutScript = fromRight (error "Could not parse output script") . decodeOutputBS+    inputSigData (input, txInput) =+        map (\(TxOut val script) -> (decodeOutScript script, val, prevOutput txInput))+            (txOut . fromJust $ nonWitnessUtxo input)++unfinalizedPkhPSBT :: Network -> (SecKeyI, PubKeyI) -> PartiallySignedTransaction+unfinalizedPkhPSBT net (prvKey, pubKey) = (emptyPSBT currTx)+    { inputs = [ emptyInput { nonWitnessUtxo = Just prevTx, partialSigs = singleton pubKey sig } ] }+  where+    currTx = unfinalizedTx (txHash prevTx)+    prevTx = testUtxo [prevOut]+    prevOutScript = addressToScript (pubKeyAddr pubKey)+    prevOut = TxOut { outValue = 200000000, scriptOutput = S.encode prevOutScript }+    h = txSigHash net currTx prevOutScript (outValue prevOut) 0 sigHashAll+    sig = encodeTxSig $ TxSignature (signHash (secKeyData prvKey) h) sigHashAll++arbitraryMultiSig :: Gen ([(SecKeyI, PubKeyI)], Int)+arbitraryMultiSig = do+    (m, n) <- arbitraryMSParam+    keys <- vectorOf n arbitraryKeyPair+    return (keys, m)++unfinalizedMsPSBT :: Network -> ([(SecKeyI, PubKeyI)], Int) -> PartiallySignedTransaction+unfinalizedMsPSBT net (keys, m) = (emptyPSBT currTx)+    { inputs = [ emptyInput { nonWitnessUtxo = Just prevTx, partialSigs = sigs+                            , inputRedeemScript = Just prevOutScript+                            } ] }+  where+    currTx = unfinalizedTx (txHash prevTx)+    prevTx = testUtxo [prevOut]+    prevOutScript = encodeOutput $ PayMulSig (map snd keys) m+    prevOut = TxOut { outValue = 200000000, scriptOutput = encodeOutputBS (toP2SH prevOutScript) }+    h = txSigHash net currTx prevOutScript (outValue prevOut) 0 sigHashAll+    sigs = fromList $ map sig keys+    sig (prvKey, pubKey) = (pubKey, encodeTxSig $ TxSignature (signHash (secKeyData prvKey) h) sigHashAll)++unfinalizedTx :: TxHash -> Tx+unfinalizedTx prevHash = Tx+        { txVersion = 2+        , txIn = [ TxIn+            { prevOutput = OutPoint prevHash 0+            , scriptInput = ""+            , txInSequence = 4294967294+            } ]+        , txOut =+            [ TxOut { outValue = 99999699, scriptOutput = hexScript "76a914d0c59903c5bac2868760e90fd521a4665aa7652088ac" }+            , TxOut { outValue = 100000000, scriptOutput = hexScript "a9143545e6e33b832c47050f24d3eeb93c9c03948bc787" }+            ]+        , txWitness = []+        , txLockTime = 1257139+        }++invalidVec :: [Text]+invalidVec =+    [ "0200000001268171371edff285e937adeea4b37b78000c0566cbb3ad64641713ca42171bf6000000006a473044022070b2245123e6bf474d60c5b50c043d4c691a5d2435f09a34a7662a9dc251790a022001329ca9dacf280bdf30740ec0390422422c81cb45839457aeb76fc12edd95b3012102657d118d3357b8e0f4c2cd46db7b39f6d9c38d9a70abcb9b2de5dc8dbfe4ce31feffffff02d3dff505000000001976a914d0c59903c5bac2868760e90fd521a4665aa7652088ac00e1f5050000000017a9143545e6e33b832c47050f24d3eeb93c9c03948bc787b32e1300"+    , "70736274ff0100750200000001268171371edff285e937adeea4b37b78000c0566cbb3ad64641713ca42171bf60000000000feffffff02d3dff505000000001976a914d0c59903c5bac2868760e90fd521a4665aa7652088ac00e1f5050000000017a9143545e6e33b832c47050f24d3eeb93c9c03948bc787b32e1300000100fda5010100000000010289a3c71eab4d20e0371bbba4cc698fa295c9463afa2e397f8533ccb62f9567e50100000017160014be18d152a9b012039daf3da7de4f53349eecb985ffffffff86f8aa43a71dff1448893a530a7237ef6b4608bbb2dd2d0171e63aec6a4890b40100000017160014fe3e9ef1a745e974d902c4355943abcb34bd5353ffffffff0200c2eb0b000000001976a91485cff1097fd9e008bb34af709c62197b38978a4888ac72fef84e2c00000017a914339725ba21efd62ac753a9bcd067d6c7a6a39d05870247304402202712be22e0270f394f568311dc7ca9a68970b8025fdd3b240229f07f8a5f3a240220018b38d7dcd314e734c9276bd6fb40f673325bc4baa144c800d2f2f02db2765c012103d2e15674941bad4a996372cb87e1856d3652606d98562fe39c5e9e7e413f210502483045022100d12b852d85dcd961d2f5f4ab660654df6eedcc794c0c33ce5cc309ffb5fce58d022067338a8e0e1725c197fb1a88af59f51e44e4255b20167c8684031c05d1f2592a01210223b72beef0965d10be0778efecd61fcac6f79a4ea169393380734464f84f2ab30000000000"+    , "70736274ff0100fd0a010200000002ab0949a08c5af7c49b8212f417e2f15ab3f5c33dcf153821a8139f877a5b7be4000000006a47304402204759661797c01b036b25928948686218347d89864b719e1f7fcf57d1e511658702205309eabf56aa4d8891ffd111fdf1336f3a29da866d7f8486d75546ceedaf93190121035cdc61fc7ba971c0b501a646a2a83b102cb43881217ca682dc86e2d73fa88292feffffffab0949a08c5af7c49b8212f417e2f15ab3f5c33dcf153821a8139f877a5b7be40100000000feffffff02603bea0b000000001976a914768a40bbd740cbe81d988e71de2a4d5c71396b1d88ac8e240000000000001976a9146f4620b553fa095e721b9ee0efe9fa039cca459788ac00000000000001012000e1f5050000000017a9143545e6e33b832c47050f24d3eeb93c9c03948bc787010416001485d13537f2e265405a34dbafa9e3dda01fb82308000000"+    , "70736274ff000100fda5010100000000010289a3c71eab4d20e0371bbba4cc698fa295c9463afa2e397f8533ccb62f9567e50100000017160014be18d152a9b012039daf3da7de4f53349eecb985ffffffff86f8aa43a71dff1448893a530a7237ef6b4608bbb2dd2d0171e63aec6a4890b40100000017160014fe3e9ef1a745e974d902c4355943abcb34bd5353ffffffff0200c2eb0b000000001976a91485cff1097fd9e008bb34af709c62197b38978a4888ac72fef84e2c00000017a914339725ba21efd62ac753a9bcd067d6c7a6a39d05870247304402202712be22e0270f394f568311dc7ca9a68970b8025fdd3b240229f07f8a5f3a240220018b38d7dcd314e734c9276bd6fb40f673325bc4baa144c800d2f2f02db2765c012103d2e15674941bad4a996372cb87e1856d3652606d98562fe39c5e9e7e413f210502483045022100d12b852d85dcd961d2f5f4ab660654df6eedcc794c0c33ce5cc309ffb5fce58d022067338a8e0e1725c197fb1a88af59f51e44e4255b20167c8684031c05d1f2592a01210223b72beef0965d10be0778efecd61fcac6f79a4ea169393380734464f84f2ab30000000000"+    , "70736274ff0100750200000001268171371edff285e937adeea4b37b78000c0566cbb3ad64641713ca42171bf60000000000feffffff02d3dff505000000001976a914d0c59903c5bac2868760e90fd521a4665aa7652088ac00e1f5050000000017a9143545e6e33b832c47050f24d3eeb93c9c03948bc787b32e1300000100fda5010100000000010289a3c71eab4d20e0371bbba4cc698fa295c9463afa2e397f8533ccb62f9567e50100000017160014be18d152a9b012039daf3da7de4f53349eecb985ffffffff86f8aa43a71dff1448893a530a7237ef6b4608bbb2dd2d0171e63aec6a4890b40100000017160014fe3e9ef1a745e974d902c4355943abcb34bd5353ffffffff0200c2eb0b000000001976a91485cff1097fd9e008bb34af709c62197b38978a4888ac72fef84e2c00000017a914339725ba21efd62ac753a9bcd067d6c7a6a39d05870247304402202712be22e0270f394f568311dc7ca9a68970b8025fdd3b240229f07f8a5f3a240220018b38d7dcd314e734c9276bd6fb40f673325bc4baa144c800d2f2f02db2765c012103d2e15674941bad4a996372cb87e1856d3652606d98562fe39c5e9e7e413f210502483045022100d12b852d85dcd961d2f5f4ab660654df6eedcc794c0c33ce5cc309ffb5fce58d022067338a8e0e1725c197fb1a88af59f51e44e4255b20167c8684031c05d1f2592a01210223b72beef0965d10be0778efecd61fcac6f79a4ea169393380734464f84f2ab30000000001003f0200000001ffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff0000000000ffffffff010000000000000000036a010000000000000000"+    , "70736274ff020001550200000001279a2323a5dfb51fc45f220fa58b0fc13e1e3342792a85d7e36cd6333b5cbc390000000000ffffffff01a05aea0b000000001976a914ffe9c0061097cc3b636f2cb0460fa4fc427d2b4588ac0000000000010120955eea0b0000000017a9146345200f68d189e1adc0df1c4d16ea8f14c0dbeb87220203b1341ccba7683b6af4f1238cd6e97e7167d569fac47f1e48d47541844355bd4646304302200424b58effaaa694e1559ea5c93bbfd4a89064224055cdf070b6771469442d07021f5c8eb0fea6516d60b8acb33ad64ede60e8785bfb3aa94b99bdf86151db9a9a010104220020771fd18ad459666dd49f3d564e3dbc42f4c84774e360ada16816a8ed488d5681010547522103b1341ccba7683b6af4f1238cd6e97e7167d569fac47f1e48d47541844355bd462103de55d1e1dac805e3f8a58c1fbf9b94c02f3dbaafe127fefca4995f26f82083bd52ae220603b1341ccba7683b6af4f1238cd6e97e7167d569fac47f1e48d47541844355bd4610b4a6ba67000000800000008004000080220603de55d1e1dac805e3f8a58c1fbf9b94c02f3dbaafe127fefca4995f26f82083bd10b4a6ba670000008000000080050000800000"+    , "70736274ff0100550200000001279a2323a5dfb51fc45f220fa58b0fc13e1e3342792a85d7e36cd6333b5cbc390000000000ffffffff01a05aea0b000000001976a914ffe9c0061097cc3b636f2cb0460fa4fc427d2b4588ac000000000002010020955eea0b0000000017a9146345200f68d189e1adc0df1c4d16ea8f14c0dbeb87220203b1341ccba7683b6af4f1238cd6e97e7167d569fac47f1e48d47541844355bd4646304302200424b58effaaa694e1559ea5c93bbfd4a89064224055cdf070b6771469442d07021f5c8eb0fea6516d60b8acb33ad64ede60e8785bfb3aa94b99bdf86151db9a9a010104220020771fd18ad459666dd49f3d564e3dbc42f4c84774e360ada16816a8ed488d5681010547522103b1341ccba7683b6af4f1238cd6e97e7167d569fac47f1e48d47541844355bd462103de55d1e1dac805e3f8a58c1fbf9b94c02f3dbaafe127fefca4995f26f82083bd52ae220603b1341ccba7683b6af4f1238cd6e97e7167d569fac47f1e48d47541844355bd4610b4a6ba67000000800000008004000080220603de55d1e1dac805e3f8a58c1fbf9b94c02f3dbaafe127fefca4995f26f82083bd10b4a6ba670000008000000080050000800000"+    , "70736274ff0100550200000001279a2323a5dfb51fc45f220fa58b0fc13e1e3342792a85d7e36cd6333b5cbc390000000000ffffffff01a05aea0b000000001976a914ffe9c0061097cc3b636f2cb0460fa4fc427d2b4588ac0000000000010120955eea0b0000000017a9146345200f68d189e1adc0df1c4d16ea8f14c0dbeb87210203b1341ccba7683b6af4f1238cd6e97e7167d569fac47f1e48d47541844355bd46304302200424b58effaaa694e1559ea5c93bbfd4a89064224055cdf070b6771469442d07021f5c8eb0fea6516d60b8acb33ad64ede60e8785bfb3aa94b99bdf86151db9a9a010104220020771fd18ad459666dd49f3d564e3dbc42f4c84774e360ada16816a8ed488d5681010547522103b1341ccba7683b6af4f1238cd6e97e7167d569fac47f1e48d47541844355bd462103de55d1e1dac805e3f8a58c1fbf9b94c02f3dbaafe127fefca4995f26f82083bd52ae220603b1341ccba7683b6af4f1238cd6e97e7167d569fac47f1e48d47541844355bd4610b4a6ba67000000800000008004000080220603de55d1e1dac805e3f8a58c1fbf9b94c02f3dbaafe127fefca4995f26f82083bd10b4a6ba670000008000000080050000800000"+    , "70736274ff0100550200000001279a2323a5dfb51fc45f220fa58b0fc13e1e3342792a85d7e36cd6333b5cbc390000000000ffffffff01a05aea0b000000001976a914ffe9c0061097cc3b636f2cb0460fa4fc427d2b4588ac0000000000010120955eea0b0000000017a9146345200f68d189e1adc0df1c4d16ea8f14c0dbeb87220203b1341ccba7683b6af4f1238cd6e97e7167d569fac47f1e48d47541844355bd4646304302200424b58effaaa694e1559ea5c93bbfd4a89064224055cdf070b6771469442d07021f5c8eb0fea6516d60b8acb33ad64ede60e8785bfb3aa94b99bdf86151db9a9a01020400220020771fd18ad459666dd49f3d564e3dbc42f4c84774e360ada16816a8ed488d5681010547522103b1341ccba7683b6af4f1238cd6e97e7167d569fac47f1e48d47541844355bd462103de55d1e1dac805e3f8a58c1fbf9b94c02f3dbaafe127fefca4995f26f82083bd52ae220603b1341ccba7683b6af4f1238cd6e97e7167d569fac47f1e48d47541844355bd4610b4a6ba67000000800000008004000080220603de55d1e1dac805e3f8a58c1fbf9b94c02f3dbaafe127fefca4995f26f82083bd10b4a6ba670000008000000080050000800000"+    , "70736274ff0100550200000001279a2323a5dfb51fc45f220fa58b0fc13e1e3342792a85d7e36cd6333b5cbc390000000000ffffffff01a05aea0b000000001976a914ffe9c0061097cc3b636f2cb0460fa4fc427d2b4588ac0000000000010120955eea0b0000000017a9146345200f68d189e1adc0df1c4d16ea8f14c0dbeb87220203b1341ccba7683b6af4f1238cd6e97e7167d569fac47f1e48d47541844355bd4646304302200424b58effaaa694e1559ea5c93bbfd4a89064224055cdf070b6771469442d07021f5c8eb0fea6516d60b8acb33ad64ede60e8785bfb3aa94b99bdf86151db9a9a010104220020771fd18ad459666dd49f3d564e3dbc42f4c84774e360ada16816a8ed488d568102050047522103b1341ccba7683b6af4f1238cd6e97e7167d569fac47f1e48d47541844355bd462103de55d1e1dac805e3f8a58c1fbf9b94c02f3dbaafe127fefca4995f26f82083bd52ae220603b1341ccba7683b6af4f1238cd6e97e7167d569fac47f1e48d47541844355bd4610b4a6ba67000000800000008004000080220603de55d1e1dac805e3f8a58c1fbf9b94c02f3dbaafe127fefca4995f26f82083bd10b4a6ba670000008000000080050000800000"+    , "70736274ff0100550200000001279a2323a5dfb51fc45f220fa58b0fc13e1e3342792a85d7e36cd6333b5cbc390000000000ffffffff01a05aea0b000000001976a914ffe9c0061097cc3b636f2cb0460fa4fc427d2b4588ac0000000000010120955eea0b0000000017a9146345200f68d189e1adc0df1c4d16ea8f14c0dbeb87220203b1341ccba7683b6af4f1238cd6e97e7167d569fac47f1e48d47541844355bd4646304302200424b58effaaa694e1559ea5c93bbfd4a89064224055cdf070b6771469442d07021f5c8eb0fea6516d60b8acb33ad64ede60e8785bfb3aa94b99bdf86151db9a9a010104220020771fd18ad459666dd49f3d564e3dbc42f4c84774e360ada16816a8ed488d5681010547522103b1341ccba7683b6af4f1238cd6e97e7167d569fac47f1e48d47541844355bd462103de55d1e1dac805e3f8a58c1fbf9b94c02f3dbaafe127fefca4995f26f82083bd52ae210603b1341ccba7683b6af4f1238cd6e97e7167d569fac47f1e48d47541844355bd10b4a6ba67000000800000008004000080220603de55d1e1dac805e3f8a58c1fbf9b94c02f3dbaafe127fefca4995f26f82083bd10b4a6ba670000008000000080050000800000"+    , "70736274ff01009a020000000258e87a21b56daf0c23be8e7070456c336f7cbaa5c8757924f545887bb2abdd750000000000ffffffff838d0427d0ec650a68aa46bb0b098aea4422c071b2ca78352a077959d07cea1d0100000000ffffffff0270aaf00800000000160014d85c2b71d0060b09c9886aeb815e50991dda124d00e1f5050000000016001400aea9a2e5f0f876a588df5546e8742d1d87008f0000000000020000bb0200000001aad73931018bd25f84ae400b68848be09db706eac2ac18298babee71ab656f8b0000000048473044022058f6fc7c6a33e1b31548d481c826c015bd30135aad42cd67790dab66d2ad243b02204a1ced2604c6735b6393e5b41691dd78b00f0c5942fb9f751856faa938157dba01feffffff0280f0fa020000000017a9140fb9463421696b82c833af241c78c17ddbde493487d0f20a270100000017a91429ca74f8a08f81999428185c97b5d852e4063f6187650000000107da00473044022074018ad4180097b873323c0015720b3684cc8123891048e7dbcd9b55ad679c99022073d369b740e3eb53dcefa33823c8070514ca55a7dd9544f157c167913261118c01483045022100f61038b308dc1da865a34852746f015772934208c6d24454393cd99bdf2217770220056e675a675a6d0a02b85b14e5e29074d8a25a9b5760bea2816f661910a006ea01475221029583bf39ae0a609747ad199addd634fa6108559d6c5cd39b4c2183f1ab96e07f2102dab61ff49a14db6a7d02b0cd1fbb78fc4b18312b5b4e54dae4dba2fbfef536d752ae0001012000c2eb0b0000000017a914b7f5faf40e3d40a5a459b1db3535f2b72fa921e8870107232200208c2353173743b595dfb4a07b72ba8e42e3797da74e87fe7d9d7497e3b20289030108da0400473044022062eb7a556107a7c73f45ac4ab5a1dddf6f7075fb1275969a7f383efff784bcb202200c05dbb7470dbf2f08557dd356c7325c1ed30913e996cd3840945db12228da5f01473044022065f45ba5998b59a27ffe1a7bed016af1f1f90d54b3aa8f7450aa5f56a25103bd02207f724703ad1edb96680b284b56d4ffcb88f7fb759eabbe08aa30f29b851383d20147522103089dc10c7ac6db54f91329af617333db388cead0c231f723379d1b99030b02dc21023add904f3d6dcf59ddb906b0dee23529b7ffb9ed50e5e86151926860221f0e7352ae00220203a9a4c37f5996d3aa25dbac6b570af0650394492942460b354753ed9eeca5877110d90c6a4f000000800000008004000080002202027f6399757d2eff55a136ad02c684b1838b6556e5f1b6b34282a94b6b5005109610d90c6a4f00000080000000800500008000"+    , "70736274ff01009a020000000258e87a21b56daf0c23be8e7070456c336f7cbaa5c8757924f545887bb2abdd750000000000ffffffff838d0427d0ec650a68aa46bb0b098aea4422c071b2ca78352a077959d07cea1d0100000000ffffffff0270aaf00800000000160014d85c2b71d0060b09c9886aeb815e50991dda124d00e1f5050000000016001400aea9a2e5f0f876a588df5546e8742d1d87008f00000000000100bb0200000001aad73931018bd25f84ae400b68848be09db706eac2ac18298babee71ab656f8b0000000048473044022058f6fc7c6a33e1b31548d481c826c015bd30135aad42cd67790dab66d2ad243b02204a1ced2604c6735b6393e5b41691dd78b00f0c5942fb9f751856faa938157dba01feffffff0280f0fa020000000017a9140fb9463421696b82c833af241c78c17ddbde493487d0f20a270100000017a91429ca74f8a08f81999428185c97b5d852e4063f618765000000020700da00473044022074018ad4180097b873323c0015720b3684cc8123891048e7dbcd9b55ad679c99022073d369b740e3eb53dcefa33823c8070514ca55a7dd9544f157c167913261118c01483045022100f61038b308dc1da865a34852746f015772934208c6d24454393cd99bdf2217770220056e675a675a6d0a02b85b14e5e29074d8a25a9b5760bea2816f661910a006ea01475221029583bf39ae0a609747ad199addd634fa6108559d6c5cd39b4c2183f1ab96e07f2102dab61ff49a14db6a7d02b0cd1fbb78fc4b18312b5b4e54dae4dba2fbfef536d752ae0001012000c2eb0b0000000017a914b7f5faf40e3d40a5a459b1db3535f2b72fa921e8870107232200208c2353173743b595dfb4a07b72ba8e42e3797da74e87fe7d9d7497e3b20289030108da0400473044022062eb7a556107a7c73f45ac4ab5a1dddf6f7075fb1275969a7f383efff784bcb202200c05dbb7470dbf2f08557dd356c7325c1ed30913e996cd3840945db12228da5f01473044022065f45ba5998b59a27ffe1a7bed016af1f1f90d54b3aa8f7450aa5f56a25103bd02207f724703ad1edb96680b284b56d4ffcb88f7fb759eabbe08aa30f29b851383d20147522103089dc10c7ac6db54f91329af617333db388cead0c231f723379d1b99030b02dc21023add904f3d6dcf59ddb906b0dee23529b7ffb9ed50e5e86151926860221f0e7352ae00220203a9a4c37f5996d3aa25dbac6b570af0650394492942460b354753ed9eeca5877110d90c6a4f000000800000008004000080002202027f6399757d2eff55a136ad02c684b1838b6556e5f1b6b34282a94b6b5005109610d90c6a4f00000080000000800500008000"+    , "70736274ff01009a020000000258e87a21b56daf0c23be8e7070456c336f7cbaa5c8757924f545887bb2abdd750000000000ffffffff838d0427d0ec650a68aa46bb0b098aea4422c071b2ca78352a077959d07cea1d0100000000ffffffff0270aaf00800000000160014d85c2b71d0060b09c9886aeb815e50991dda124d00e1f5050000000016001400aea9a2e5f0f876a588df5546e8742d1d87008f00000000000100bb0200000001aad73931018bd25f84ae400b68848be09db706eac2ac18298babee71ab656f8b0000000048473044022058f6fc7c6a33e1b31548d481c826c015bd30135aad42cd67790dab66d2ad243b02204a1ced2604c6735b6393e5b41691dd78b00f0c5942fb9f751856faa938157dba01feffffff0280f0fa020000000017a9140fb9463421696b82c833af241c78c17ddbde493487d0f20a270100000017a91429ca74f8a08f81999428185c97b5d852e4063f6187650000000107da00473044022074018ad4180097b873323c0015720b3684cc8123891048e7dbcd9b55ad679c99022073d369b740e3eb53dcefa33823c8070514ca55a7dd9544f157c167913261118c01483045022100f61038b308dc1da865a34852746f015772934208c6d24454393cd99bdf2217770220056e675a675a6d0a02b85b14e5e29074d8a25a9b5760bea2816f661910a006ea01475221029583bf39ae0a609747ad199addd634fa6108559d6c5cd39b4c2183f1ab96e07f2102dab61ff49a14db6a7d02b0cd1fbb78fc4b18312b5b4e54dae4dba2fbfef536d752ae0001012000c2eb0b0000000017a914b7f5faf40e3d40a5a459b1db3535f2b72fa921e8870107232200208c2353173743b595dfb4a07b72ba8e42e3797da74e87fe7d9d7497e3b2028903020800da0400473044022062eb7a556107a7c73f45ac4ab5a1dddf6f7075fb1275969a7f383efff784bcb202200c05dbb7470dbf2f08557dd356c7325c1ed30913e996cd3840945db12228da5f01473044022065f45ba5998b59a27ffe1a7bed016af1f1f90d54b3aa8f7450aa5f56a25103bd02207f724703ad1edb96680b284b56d4ffcb88f7fb759eabbe08aa30f29b851383d20147522103089dc10c7ac6db54f91329af617333db388cead0c231f723379d1b99030b02dc21023add904f3d6dcf59ddb906b0dee23529b7ffb9ed50e5e86151926860221f0e7352ae00220203a9a4c37f5996d3aa25dbac6b570af0650394492942460b354753ed9eeca5877110d90c6a4f000000800000008004000080002202027f6399757d2eff55a136ad02c684b1838b6556e5f1b6b34282a94b6b5005109610d90c6a4f00000080000000800500008000"+    , "70736274ff01009a020000000258e87a21b56daf0c23be8e7070456c336f7cbaa5c8757924f545887bb2abdd750000000000ffffffff838d0427d0ec650a68aa46bb0b098aea4422c071b2ca78352a077959d07cea1d0100000000ffffffff0270aaf00800000000160014d85c2b71d0060b09c9886aeb815e50991dda124d00e1f5050000000016001400aea9a2e5f0f876a588df5546e8742d1d87008f00000000000100bb0200000001aad73931018bd25f84ae400b68848be09db706eac2ac18298babee71ab656f8b0000000048473044022058f6fc7c6a33e1b31548d481c826c015bd30135aad42cd67790dab66d2ad243b02204a1ced2604c6735b6393e5b41691dd78b00f0c5942fb9f751856faa938157dba01feffffff0280f0fa020000000017a9140fb9463421696b82c833af241c78c17ddbde493487d0f20a270100000017a91429ca74f8a08f81999428185c97b5d852e4063f6187650000000107da00473044022074018ad4180097b873323c0015720b3684cc8123891048e7dbcd9b55ad679c99022073d369b740e3eb53dcefa33823c8070514ca55a7dd9544f157c167913261118c01483045022100f61038b308dc1da865a34852746f015772934208c6d24454393cd99bdf2217770220056e675a675a6d0a02b85b14e5e29074d8a25a9b5760bea2816f661910a006ea01475221029583bf39ae0a609747ad199addd634fa6108559d6c5cd39b4c2183f1ab96e07f2102dab61ff49a14db6a7d02b0cd1fbb78fc4b18312b5b4e54dae4dba2fbfef536d752ae0001012000c2eb0b0000000017a914b7f5faf40e3d40a5a459b1db3535f2b72fa921e8870107232200208c2353173743b595dfb4a07b72ba8e42e3797da74e87fe7d9d7497e3b20289030108da0400473044022062eb7a556107a7c73f45ac4ab5a1dddf6f7075fb1275969a7f383efff784bcb202200c05dbb7470dbf2f08557dd356c7325c1ed30913e996cd3840945db12228da5f01473044022065f45ba5998b59a27ffe1a7bed016af1f1f90d54b3aa8f7450aa5f56a25103bd02207f724703ad1edb96680b284b56d4ffcb88f7fb759eabbe08aa30f29b851383d20147522103089dc10c7ac6db54f91329af617333db388cead0c231f723379d1b99030b02dc21023add904f3d6dcf59ddb906b0dee23529b7ffb9ed50e5e86151926860221f0e7352ae00210203a9a4c37f5996d3aa25dbac6b570af0650394492942460b354753ed9eeca58710d90c6a4f000000800000008004000080002202027f6399757d2eff55a136ad02c684b1838b6556e5f1b6b34282a94b6b5005109610d90c6a4f00000080000000800500008000"+    , "70736274ff0100730200000001301ae986e516a1ec8ac5b4bc6573d32f83b465e23ad76167d68b38e730b4dbdb0000000000ffffffff02747b01000000000017a91403aa17ae882b5d0d54b25d63104e4ffece7b9ea2876043993b0000000017a914b921b1ba6f722e4bfa83b6557a3139986a42ec8387000000000001011f00ca9a3b00000000160014d2d94b64ae08587eefc8eeb187c601e939f9037c0203000100000000010016001462e9e982fff34dd8239610316b090cd2a3b747cb000100220020876bad832f1d168015ed41232a9ea65a1815d9ef13c0ef8759f64b5b2b278a65010125512103b7ce23a01c5b4bf00a642537cdfabb315b668332867478ef51309d2bd57f8a8751ae00"+    , "70736274ff0100730200000001301ae986e516a1ec8ac5b4bc6573d32f83b465e23ad76167d68b38e730b4dbdb0000000000ffffffff02747b01000000000017a91403aa17ae882b5d0d54b25d63104e4ffece7b9ea2876043993b0000000017a914b921b1ba6f722e4bfa83b6557a3139986a42ec8387000000000001011f00ca9a3b00000000160014d2d94b64ae08587eefc8eeb187c601e939f9037c0002000016001462e9e982fff34dd8239610316b090cd2a3b747cb000100220020876bad832f1d168015ed41232a9ea65a1815d9ef13c0ef8759f64b5b2b278a65010125512103b7ce23a01c5b4bf00a642537cdfabb315b668332867478ef51309d2bd57f8a8751ae00"+    , "70736274ff0100730200000001301ae986e516a1ec8ac5b4bc6573d32f83b465e23ad76167d68b38e730b4dbdb0000000000ffffffff02747b01000000000017a91403aa17ae882b5d0d54b25d63104e4ffece7b9ea2876043993b0000000017a914b921b1ba6f722e4bfa83b6557a3139986a42ec8387000000000001011f00ca9a3b00000000160014d2d94b64ae08587eefc8eeb187c601e939f9037c00010016001462e9e982fff34dd8239610316b090cd2a3b747cb000100220020876bad832f1d168015ed41232a9ea65a1815d9ef13c0ef8759f64b5b2b278a6521010025512103b7ce23a01c5b4bf00a642537cdfabb315b668332867478ef51309d2bd57f8a8751ae00"+    ]+++validEncodeVec :: [(PartiallySignedTransaction, Text)]+validEncodeVec = [(validVec1, validVec1Hex)]++testTx1 :: Tx+testTx1 = Tx+        { txVersion = 2+        , txIn = [ TxIn+            { prevOutput = OutPoint "f61b1742ca13176464adb3cb66050c00787bb3a4eead37e985f2df1e37718126" 0+            , scriptInput = ""+            , txInSequence = 4294967294+            } ]+        , txOut =+            [ TxOut { outValue = 99999699, scriptOutput = hexScript "76a914d0c59903c5bac2868760e90fd521a4665aa7652088ac" }+            , TxOut { outValue = 100000000, scriptOutput = hexScript "a9143545e6e33b832c47050f24d3eeb93c9c03948bc787" }+            ]+        , txWitness = []+        , txLockTime = 1257139+        }++testUtxo :: [TxOut] -> Tx+testUtxo prevOuts = Tx+        { txVersion = 1+        , txIn =+            [ TxIn+                { prevOutput = OutPoint "e567952fb6cc33857f392efa3a46c995a28f69cca4bb1b37e0204dab1ec7a389" 1+                , scriptInput = hexScript "160014be18d152a9b012039daf3da7de4f53349eecb985"+                , txInSequence = 4294967295+                }+            , TxIn+                { prevOutput = OutPoint "b490486aec3ae671012dddb2bb08466bef37720a533a894814ff1da743aaf886" 1+                , scriptInput = hexScript "160014fe3e9ef1a745e974d902c4355943abcb34bd5353"+                , txInSequence = 4294967295+                }+            ]+        , txOut = prevOuts+        , txWitness =+            [+              [ fromJust $ decodeHex "304402202712be22e0270f394f568311dc7ca9a68970b8025fdd3b240229f07f8a5f3a240220018b38d7dcd314e734c9276bd6fb40f673325bc4baa144c800d2f2f02db2765c01"+              , fromJust $ decodeHex "03d2e15674941bad4a996372cb87e1856d3652606d98562fe39c5e9e7e413f2105"+              ]+            , [ fromJust $ decodeHex "3045022100d12b852d85dcd961d2f5f4ab660654df6eedcc794c0c33ce5cc309ffb5fce58d022067338a8e0e1725c197fb1a88af59f51e44e4255b20167c8684031c05d1f2592a01"+              , fromJust $ decodeHex "0223b72beef0965d10be0778efecd61fcac6f79a4ea169393380734464f84f2ab3"+              ]+            ]+        , txLockTime = 0+        }++testUtxo1 :: Tx+testUtxo1 = testUtxo+    [ TxOut { outValue = 200000000, scriptOutput = hexScript "76a91485cff1097fd9e008bb34af709c62197b38978a4888ac" }+    , TxOut { outValue = 190303501938, scriptOutput = hexScript "a914339725ba21efd62ac753a9bcd067d6c7a6a39d0587" }+    ]++validVec1 :: PartiallySignedTransaction+validVec1 = (emptyPSBT testTx1) { inputs = [ emptyInput { nonWitnessUtxo = Just testUtxo1 } ] }++validVec :: [Text]+validVec = [validVec1Hex, validVec2Hex, validVec3Hex, validVec4Hex, validVec5Hex, validVec6Hex]++validVec1Hex :: Text+validVec1Hex = "70736274ff0100750200000001268171371edff285e937adeea4b37b78000c0566cbb3ad64641713ca42171bf60000000000feffffff02d3dff505000000001976a914d0c59903c5bac2868760e90fd521a4665aa7652088ac00e1f5050000000017a9143545e6e33b832c47050f24d3eeb93c9c03948bc787b32e1300000100fda5010100000000010289a3c71eab4d20e0371bbba4cc698fa295c9463afa2e397f8533ccb62f9567e50100000017160014be18d152a9b012039daf3da7de4f53349eecb985ffffffff86f8aa43a71dff1448893a530a7237ef6b4608bbb2dd2d0171e63aec6a4890b40100000017160014fe3e9ef1a745e974d902c4355943abcb34bd5353ffffffff0200c2eb0b000000001976a91485cff1097fd9e008bb34af709c62197b38978a4888ac72fef84e2c00000017a914339725ba21efd62ac753a9bcd067d6c7a6a39d05870247304402202712be22e0270f394f568311dc7ca9a68970b8025fdd3b240229f07f8a5f3a240220018b38d7dcd314e734c9276bd6fb40f673325bc4baa144c800d2f2f02db2765c012103d2e15674941bad4a996372cb87e1856d3652606d98562fe39c5e9e7e413f210502483045022100d12b852d85dcd961d2f5f4ab660654df6eedcc794c0c33ce5cc309ffb5fce58d022067338a8e0e1725c197fb1a88af59f51e44e4255b20167c8684031c05d1f2592a01210223b72beef0965d10be0778efecd61fcac6f79a4ea169393380734464f84f2ab300000000000000"++validVec2Hex :: Text+validVec2Hex = "70736274ff0100a00200000002ab0949a08c5af7c49b8212f417e2f15ab3f5c33dcf153821a8139f877a5b7be40000000000feffffffab0949a08c5af7c49b8212f417e2f15ab3f5c33dcf153821a8139f877a5b7be40100000000feffffff02603bea0b000000001976a914768a40bbd740cbe81d988e71de2a4d5c71396b1d88ac8e240000000000001976a9146f4620b553fa095e721b9ee0efe9fa039cca459788ac000000000001076a47304402204759661797c01b036b25928948686218347d89864b719e1f7fcf57d1e511658702205309eabf56aa4d8891ffd111fdf1336f3a29da866d7f8486d75546ceedaf93190121035cdc61fc7ba971c0b501a646a2a83b102cb43881217ca682dc86e2d73fa882920001012000e1f5050000000017a9143545e6e33b832c47050f24d3eeb93c9c03948bc787010416001485d13537f2e265405a34dbafa9e3dda01fb82308000000"++validVec3Hex :: Text+validVec3Hex = "70736274ff0100750200000001268171371edff285e937adeea4b37b78000c0566cbb3ad64641713ca42171bf60000000000feffffff02d3dff505000000001976a914d0c59903c5bac2868760e90fd521a4665aa7652088ac00e1f5050000000017a9143545e6e33b832c47050f24d3eeb93c9c03948bc787b32e1300000100fda5010100000000010289a3c71eab4d20e0371bbba4cc698fa295c9463afa2e397f8533ccb62f9567e50100000017160014be18d152a9b012039daf3da7de4f53349eecb985ffffffff86f8aa43a71dff1448893a530a7237ef6b4608bbb2dd2d0171e63aec6a4890b40100000017160014fe3e9ef1a745e974d902c4355943abcb34bd5353ffffffff0200c2eb0b000000001976a91485cff1097fd9e008bb34af709c62197b38978a4888ac72fef84e2c00000017a914339725ba21efd62ac753a9bcd067d6c7a6a39d05870247304402202712be22e0270f394f568311dc7ca9a68970b8025fdd3b240229f07f8a5f3a240220018b38d7dcd314e734c9276bd6fb40f673325bc4baa144c800d2f2f02db2765c012103d2e15674941bad4a996372cb87e1856d3652606d98562fe39c5e9e7e413f210502483045022100d12b852d85dcd961d2f5f4ab660654df6eedcc794c0c33ce5cc309ffb5fce58d022067338a8e0e1725c197fb1a88af59f51e44e4255b20167c8684031c05d1f2592a01210223b72beef0965d10be0778efecd61fcac6f79a4ea169393380734464f84f2ab30000000001030401000000000000"++validVec4Hex :: Text+validVec4Hex = "70736274ff0100a00200000002ab0949a08c5af7c49b8212f417e2f15ab3f5c33dcf153821a8139f877a5b7be40000000000feffffffab0949a08c5af7c49b8212f417e2f15ab3f5c33dcf153821a8139f877a5b7be40100000000feffffff02603bea0b000000001976a914768a40bbd740cbe81d988e71de2a4d5c71396b1d88ac8e240000000000001976a9146f4620b553fa095e721b9ee0efe9fa039cca459788ac00000000000100df0200000001268171371edff285e937adeea4b37b78000c0566cbb3ad64641713ca42171bf6000000006a473044022070b2245123e6bf474d60c5b50c043d4c691a5d2435f09a34a7662a9dc251790a022001329ca9dacf280bdf30740ec0390422422c81cb45839457aeb76fc12edd95b3012102657d118d3357b8e0f4c2cd46db7b39f6d9c38d9a70abcb9b2de5dc8dbfe4ce31feffffff02d3dff505000000001976a914d0c59903c5bac2868760e90fd521a4665aa7652088ac00e1f5050000000017a9143545e6e33b832c47050f24d3eeb93c9c03948bc787b32e13000001012000e1f5050000000017a9143545e6e33b832c47050f24d3eeb93c9c03948bc787010416001485d13537f2e265405a34dbafa9e3dda01fb8230800220202ead596687ca806043edc3de116cdf29d5e9257c196cd055cf698c8d02bf24e9910b4a6ba670000008000000080020000800022020394f62be9df19952c5587768aeb7698061ad2c4a25c894f47d8c162b4d7213d0510b4a6ba6700000080010000800200008000"++validVec5Hex :: Text+validVec5Hex = "70736274ff0100550200000001279a2323a5dfb51fc45f220fa58b0fc13e1e3342792a85d7e36cd6333b5cbc390000000000ffffffff01a05aea0b000000001976a914ffe9c0061097cc3b636f2cb0460fa4fc427d2b4588ac0000000000010120955eea0b0000000017a9146345200f68d189e1adc0df1c4d16ea8f14c0dbeb87220203b1341ccba7683b6af4f1238cd6e97e7167d569fac47f1e48d47541844355bd4646304302200424b58effaaa694e1559ea5c93bbfd4a89064224055cdf070b6771469442d07021f5c8eb0fea6516d60b8acb33ad64ede60e8785bfb3aa94b99bdf86151db9a9a010104220020771fd18ad459666dd49f3d564e3dbc42f4c84774e360ada16816a8ed488d5681010547522103b1341ccba7683b6af4f1238cd6e97e7167d569fac47f1e48d47541844355bd462103de55d1e1dac805e3f8a58c1fbf9b94c02f3dbaafe127fefca4995f26f82083bd52ae220603b1341ccba7683b6af4f1238cd6e97e7167d569fac47f1e48d47541844355bd4610b4a6ba67000000800000008004000080220603de55d1e1dac805e3f8a58c1fbf9b94c02f3dbaafe127fefca4995f26f82083bd10b4a6ba670000008000000080050000800000"++validVec6Hex :: Text+validVec6Hex = "70736274ff01003f0200000001ffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff0000000000ffffffff010000000000000000036a010000000000000a0f0102030405060708090f0102030405060708090a0b0c0d0e0f0000"
+ test/Haskoin/TransactionSpec.hs view
@@ -0,0 +1,396 @@+{-# LANGUAGE OverloadedStrings #-}++module Haskoin.TransactionSpec (spec) where++import           Data.Aeson                 as A+import qualified Data.ByteString            as B+import           Data.Either+import           Data.Map.Strict            (singleton)+import           Data.Maybe+import           Data.Serialize             as S+import           Data.String                (fromString)+import           Data.String.Conversions+import           Data.Text                  (Text)+import           Data.Word                  (Word32, Word64)+import           Haskoin.Address+import           Haskoin.Constants+import           Haskoin.Keys+import           Haskoin.Script+import           Haskoin.Test+import           Haskoin.Transaction+import           Haskoin.Transaction.Segwit (isSegwit)+import           Haskoin.Util+import           Safe                       (readMay)+import           Test.Hspec+import           Test.HUnit                 (Assertion, assertBool)+import           Test.QuickCheck++spec :: Spec+spec = do+    let net = btc+    describe "transaction unit tests" $ do+        it "compute txid from tx" $+            mapM_ runTxIDVec txIDVec+        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 $+            forAll arbitraryTxHash $ \h -> hexToTxHash (txHashToHex h) == Just h+        it "from string transaction id" $+            property $+            forAll arbitraryTxHash $ \h -> fromString (cs $ txHashToHex h) == h+        it "building address tx" $+            property $+            forAll arbitraryAddress $+            forAll (arbitrarySatoshi net) . testBuildAddrTx net+        it "guess transaction size" $+            property $ forAll (arbitraryAddrOnlyTxFull net) (testGuessSize net)+        it "choose coins" $+            property $ forAll (listOf (arbitrarySatoshi net)) testChooseCoins+        it "choose multisig coins" $+            property $+            forAll arbitraryMSParam $+            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+        it "encodes and decodes transaction" $+            property $ forAll (arbitraryTx net) testID+        it "encodes and decodes transaction hash" $+            property $ forAll arbitraryTxHash testID+    describe "transaction serialization" $ do+        it "encodes and decodes tx input" $+            property $ forAll (arbitraryTxIn net) cerealID+        it "encodes and decodes tx output" $+            property $ forAll (arbitraryTxOut net) cerealID+        it "encodes and decodes outpoint" $+            property $ forAll arbitraryOutPoint cerealID+        it "encodes and decodes transaction" $+            property $ forAll (arbitraryTx net) cerealID+        it "encodes and decodes witness transaction" $+            property $ forAll (arbitraryWitnessTx net) cerealID+        it "encodes and decodes legacy transaction" $+            property $ forAll (arbitraryLegacyTx net) cerealID++cerealID :: (Serialize a, Eq a) => a -> Bool+cerealID x = S.decode (S.encode x) == Right x++runTxIDVec :: (Text, Text) -> Assertion+runTxIDVec (tid, tx) = assertBool "txid" $ txHashToHex (txHash txBS) == tid+  where+    txBS = fromJust $ either (const Nothing) return . S.decode =<< decodeHex tx++txIDVec :: [(Text, Text)]+txIDVec =+    [ ( "23b397edccd3740a74adb603c9756370fafcde9bcc4483eb271ecad09a94dd63"+      , "0100000001b14bdcbc3e01bdaad36cc08e81e69c82e1060bc14e518db2b49aa43ad90ba26000000000490047304402203f16c6f40162ab686621ef3000b04e75418a0c0cb2d8aebeac894ae360ac1e780220ddc15ecdfc3507ac48e1681a33eb60996631bf6bf5bc0a0682c4db743ce7ca2b01ffffffff0140420f00000000001976a914660d4ef3a743e3e696ad990364e555c271ad504b88ac00000000"+      )+    , ( "c99c49da4c38af669dea436d3e73780dfdb6c1ecf9958baa52960e8baee30e73"+      , "01000000010276b76b07f4935c70acf54fbf1f438a4c397a9fb7e633873c4dd3bc062b6b40000000008c493046022100d23459d03ed7e9511a47d13292d3430a04627de6235b6e51a40f9cd386f2abe3022100e7d25b080f0bb8d8d5f878bba7d54ad2fda650ea8d158a33ee3cbd11768191fd004104b0e2c879e4daf7b9ab68350228c159766676a14f5815084ba166432aab46198d4cca98fa3e9981d0a90b2effc514b76279476550ba3663fdcaff94c38420e9d5000000000100093d00000000001976a9149a7b0f3b80c6baaeedce0a0842553800f832ba1f88ac00000000"+      )+    , ( "f7fdd091fa6d8f5e7a8c2458f5c38faffff2d3f1406b6e4fe2c99dcc0d2d1cbb"+      , "01000000023d6cf972d4dff9c519eff407ea800361dd0a121de1da8b6f4138a2f25de864b4000000008a4730440220ffda47bfc776bcd269da4832626ac332adfca6dd835e8ecd83cd1ebe7d709b0e022049cffa1cdc102a0b56e0e04913606c70af702a1149dc3b305ab9439288fee090014104266abb36d66eb4218a6dd31f09bb92cf3cfa803c7ea72c1fc80a50f919273e613f895b855fb7465ccbc8919ad1bd4a306c783f22cd3227327694c4fa4c1c439affffffff21ebc9ba20594737864352e95b727f1a565756f9d365083eb1a8596ec98c97b7010000008a4730440220503ff10e9f1e0de731407a4a245531c9ff17676eda461f8ceeb8c06049fa2c810220c008ac34694510298fa60b3f000df01caa244f165b727d4896eb84f81e46bcc4014104266abb36d66eb4218a6dd31f09bb92cf3cfa803c7ea72c1fc80a50f919273e613f895b855fb7465ccbc8919ad1bd4a306c783f22cd3227327694c4fa4c1c439affffffff01f0da5200000000001976a914857ccd42dded6df32949d4646dfa10a92458cfaa88ac00000000"+      )+    , ( "afd9c17f8913577ec3509520bd6e5d63e9c0fd2a5f70c787993b097ba6ca9fae"+      , "010000000370ac0a1ae588aaf284c308d67ca92c69a39e2db81337e563bf40c59da0a5cf63000000006a4730440220360d20baff382059040ba9be98947fd678fb08aab2bb0c172efa996fd8ece9b702201b4fb0de67f015c90e7ac8a193aeab486a1f587e0f54d0fb9552ef7f5ce6caec032103579ca2e6d107522f012cd00b52b9a65fb46f0c57b9b8b6e377c48f526a44741affffffff7d815b6447e35fbea097e00e028fb7dfbad4f3f0987b4734676c84f3fcd0e804010000006b483045022100c714310be1e3a9ff1c5f7cacc65c2d8e781fc3a88ceb063c6153bf950650802102200b2d0979c76e12bb480da635f192cc8dc6f905380dd4ac1ff35a4f68f462fffd032103579ca2e6d107522f012cd00b52b9a65fb46f0c57b9b8b6e377c48f526a44741affffffff3f1f097333e4d46d51f5e77b53264db8f7f5d2e18217e1099957d0f5af7713ee010000006c493046022100b663499ef73273a3788dea342717c2640ac43c5a1cf862c9e09b206fcb3f6bb8022100b09972e75972d9148f2bdd462e5cb69b57c1214b88fc55ca638676c07cfc10d8032103579ca2e6d107522f012cd00b52b9a65fb46f0c57b9b8b6e377c48f526a44741affffffff0380841e00000000001976a914bfb282c70c4191f45b5a6665cad1682f2c9cfdfb88ac80841e00000000001976a9149857cc07bed33a5cf12b9c5e0500b675d500c81188ace0fd1c00000000001976a91443c52850606c872403c0601e69fa34b26f62db4a88ac00000000"+      )+    ]++runPKHashVec :: ([(Text, Word32)], [(Text, Word64)], Text) -> Assertion+runPKHashVec (xs, ys, res) =+    assertBool "Build PKHash Tx" $ encodeHex (S.encode tx) == res+  where+    tx =+        fromRight (error "Could not decode transaction") $+        buildAddrTx btc (map f xs) ys+    f (tid, ix) = OutPoint (fromJust $ hexToTxHash tid) ix++-- These test vectors have been generated from bitcoind raw transaction api++pkHashVec :: [([(Text, Word32)], [(Text, Word64)], Text)]+pkHashVec =+    [+      ( [("eb29eba154166f6541ebcc9cbdf5088756e026af051f123bcfb526df594549db",14)]+      , [("14LsRquZfURNFrzpcLVGdaHTfAPjjwiSPb",90000000)]+      , "0100000001db494559df26b5cf3b121f05af26e0568708f5bd9ccceb41656f1654a1eb29eb0e00000000ffffffff01804a5d05000000001976a91424aa604689cc582292b97668bedd91dd5bf9374c88ac00000000"+      )+    , ( [ ("eb29eba154166f6541ebcc9cbdf5088756e026af051f123bcfb526df594549db",0)+        , ("0001000000000000000000000000000000000000000000000000000000000000",2147483647)+        ]+      , [ ("14LsRquZfURNFrzpcLVGdaHTfAPjjwiSPb",1)+        , ("19VCgS642vzEA1sdByoSn6GsWBwraV8D4n",2100000000000000)+        ]+      , "0100000002db494559df26b5cf3b121f05af26e0568708f5bd9ccceb41656f1654a1eb29eb0000000000ffffffff0000000000000000000000000000000000000000000000000000000000000100ffffff7f00ffffffff0201000000000000001976a91424aa604689cc582292b97668bedd91dd5bf9374c88ac0040075af07507001976a9145d16672f53981ff21c5f42b40d1954993cbca54f88ac00000000"+      )+    , ( [ ("eb29eba154166f6541ebcc9cbdf5088756e026af051f123bcfb526df594549db",0)+        , ("0001000000000000000000000000000000000000000000000000000000000000",2147483647)+        ]+      , []+      , "0100000002db494559df26b5cf3b121f05af26e0568708f5bd9ccceb41656f1654a1eb29eb0000000000ffffffff0000000000000000000000000000000000000000000000000000000000000100ffffff7f00ffffffff0000000000"+      )+    , ( []+      , [ ("14LsRquZfURNFrzpcLVGdaHTfAPjjwiSPb",1)+        , ("19VCgS642vzEA1sdByoSn6GsWBwraV8D4n",2100000000000000)+        ]+      , "01000000000201000000000000001976a91424aa604689cc582292b97668bedd91dd5bf9374c88ac0040075af07507001976a9145d16672f53981ff21c5f42b40d1954993cbca54f88ac00000000"+      )+    ]++tEncodeSatoshiCoreScriptPubKey :: Assertion+tEncodeSatoshiCoreScriptPubKey = assertBool "tEncodeSatoshiCoreScriptPubKey" $+  t1BsOutputScriptPubKey == encodeSatoshiCoreScriptPubKey t1SatoshiCoreJsonScriptPubKey+  where+    t1BsOutputScriptPubKey :: Text+    t1BsOutputScriptPubKey = "514104cc71eb30d653c0c3163990c47b976f3fb3f37cccdcbedb169a1dfef58bbfbfaff7d8a473e7e2e6d317b87bafe8bde97e3cf8f065dec022b51d11fcdd0d348ac4410461cbdcc5409fb4b4d42b51d33381354d80e550078cb532a34bfa2fcfdeb7d76519aecc62770f5b0e4ef8551946d8a540911abe3e7854a26f39f58b25c15342af52ae"+    t1SatoshiCoreJsonScriptPubKey :: String+    t1SatoshiCoreJsonScriptPubKey = "1 0x41 0x04cc71eb30d653c0c3163990c47b976f3fb3f37cccdcbedb169a1dfef58bbfbfaff7d8a473e7e2e6d317b87bafe8bde97e3cf8f065dec022b51d11fcdd0d348ac4 0x41 0x0461cbdcc5409fb4b4d42b51d33381354d80e550078cb532a34bfa2fcfdeb7d76519aecc62770f5b0e4ef8551946d8a540911abe3e7854a26f39f58b25c15342af 2 OP_CHECKMULTISIG"++encodeSatoshiCoreScriptPubKey :: String -> Text+encodeSatoshiCoreScriptPubKey =+  mconcat . map encodeSatoshiCoreScriptPiece . words+  where+    encodeSatoshiCoreScriptPiece :: String -> Text+    encodeSatoshiCoreScriptPiece s = case (readMay ("OP_" ++ s) :: Maybe ScriptOp) of+      Just op -> encodeHex . S.encode $ op+      Nothing -> case take 2 s of+          "OP" -> encodeHex . S.encode . (read :: String -> ScriptOp) $ s+          "0x" -> (fromString . drop 2 :: String -> Text) s+          _ -> case (readMay s :: Maybe Int) of -- can we get rid of this case now?+            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+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 [] [(fromJust (addrToString net a), v)]+    out =+        decodeOutputBS $+        scriptOutput $+        head $ txOut (fromRight (error "Could not build transaction") tx)++testGuessSize :: Network -> Tx -> Bool+testGuessSize net tx+    -- We compute an upper bound but it should be close enough to the real size+    -- We give 2 bytes of slack on every signature (1 on r and 1 on s)+ = guess >= len && guess <= len + 2 * delta+  where+    delta = pki + sum (map fst msi)+    guess = guessTxSize pki msi pkout msout+    len = B.length $ S.encode tx+    ins = map f $ txIn tx+    f i =+        fromRight (error "Could not decode input") $+        decodeInputBS net $ scriptInput i+    pki = length $ filter isSpendPKHash ins+    msi = concatMap shData ins+    shData (ScriptHashInput _ (PayMulSig keys r)) = [(r, length keys)]+    shData _                                      = []+    out =+        map+            (fromRight (error "Could not decode transaction output") .+             decodeOutputBS . scriptOutput) $+        txOut tx+    pkout = length $ filter isPayPKHash out+    msout = length $ filter isPayScriptHash out++testChooseCoins :: [TestCoin] -> Word64 -> Word64 -> Int -> Property+testChooseCoins coins target byteFee nOut = nOut >= 0 ==>+    case chooseCoins target byteFee nOut True coins of+        Right (chosen, change) ->+            let outSum = sum $ map coinValue chosen+                fee    = guessTxFee byteFee nOut (length chosen)+            in outSum == target + change + fee+        Left _ ->+            let fee = guessTxFee byteFee nOut (length coins)+            in target == 0 || s < target + fee+  where+    s  = sum $ map coinValue coins++testChooseMSCoins :: (Int, Int) -> [TestCoin]+                  -> Word64 -> Word64 -> Int -> Property+testChooseMSCoins (m, n) coins target byteFee nOut = nOut >= 0 ==>+    case chooseMSCoins target byteFee (m,n) nOut True coins of+        Right (chosen,change) ->+            let outSum = sum $ map coinValue chosen+                fee    = guessMSTxFee byteFee (m,n) nOut (length chosen)+            in outSum == target + change + fee+        Left _ ->+            let fee = guessMSTxFee byteFee (m,n) nOut (length coins)+            in target == 0 || s < target + fee+  where+    s = sum $ map coinValue coins++{- Signing Transactions -}++testDetSignTx :: Network -> (Tx, [SigInput], [SecKeyI]) -> Bool+testDetSignTx 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") $+        signTx net tx sigis (map secKeyData (tail prv))+    txSigC =+        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+    [ isRight mergeRes+    , length (txIn mergedTx) == length os+    , if enoughSigs then isValid else not isValid+    -- Signature count == min (length txs) (sum required signatures)+    , sum (map snd sigMap) == min (length txs) (sum (map fst sigMap))+    ]+  where+    outs = map (\(so, val, op, _, _) -> (so, val, op)) os+    mergeRes = mergeTxs net txs outs+    mergedTx = fromRight (error "Could not merge") mergeRes+    isValid = verifyStdTx net mergedTx outs+    enoughSigs = all (\(m,c) -> c >= m) sigMap+    sigMap = map (\((_,_,_,m,_), inp) -> (m, sigCnt inp)) $ zip os $ txIn mergedTx+    sigCnt inp = case decodeInputBS net $ scriptInput inp of+        Right (RegularInput (SpendMulSig sigs)) -> length sigs+        Right (ScriptHashInput (SpendMulSig sigs) _) -> length sigs+        _ -> error "Invalid input script type"++testID :: (FromJSON a, ToJSON a, Eq a) => a -> Bool+testID x =+    (A.decode . A.encode) (singleton ("object" :: String) x) ==+    Just (singleton ("object" :: String) x)
+ test/Haskoin/UtilSpec.hs view
@@ -0,0 +1,64 @@+module Haskoin.UtilSpec (spec) where++import qualified Data.ByteString as BS+import           Data.Either     (fromLeft, fromRight, isLeft, isRight)+import           Data.Foldable   (toList)+import           Data.List       (permutations)+import           Data.Maybe+import qualified Data.Sequence   as Seq+import           Haskoin.Test+import           Haskoin.Util+import           Test.Hspec+import           Test.QuickCheck++spec :: Spec+spec =+    describe "utility functions" $ do+        it "bsToInteger . integerToBS" $ property getPutInteger+        it "decodeHex . encodeHex" $ property $ forAll arbitraryBS fromToHex+        it "compare updateIndex with Data.Sequence" $ property testUpdateIndex+        it "matchTemplate" $ property testMatchTemplate+        it "testing matchTemplate with two lists" $+            property testMatchTemplateLen+        it "either helper functions" $ property testEither++{- Various utilities -}++getPutInteger :: Integer -> Bool+getPutInteger i = bsToInteger (integerToBS $ abs i) == abs i++fromToHex :: BS.ByteString -> Bool+fromToHex bs = decodeHex (encodeHex bs) == Just bs++testUpdateIndex :: [Int] -> Int -> Int -> Bool+testUpdateIndex xs v i =+    updateIndex i xs (const v) == toList (Seq.update i v $ Seq.fromList xs)++testMatchTemplate :: [Int] -> Int -> Bool+testMatchTemplate as i = catMaybes res == bs+  where+    res = matchTemplate as bs (==)+    idx =+        if null as+            then 0+            else i `mod` length as+    bs = permutations as !! idx++testMatchTemplateLen :: [Int] -> [Int] -> Bool+testMatchTemplateLen as bs = length bs == length res+  where+    res = matchTemplate as bs (==)++testEither :: Either String Int -> Bool+testEither e =+    case e of+        (Right v) ->+            isRight e &&+            not (isLeft e) &&+            fromRight (error "Unexpected Left") e == v &&+            eitherToMaybe e == Just v+        (Left v) ->+            isLeft e &&+            not (isRight e) &&+            fromLeft (error "Unexpected Right") e == v &&+            isNothing (eitherToMaybe e)
− test/Network/Haskoin/Address/Bech32Spec.hs 
@@ -1,155 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}-module Network.Haskoin.Address.Bech32Spec-    ( spec-    ) where--import           Control.Monad-import           Data.Bits                      (xor)-import           Data.ByteString                (ByteString)-import qualified Data.ByteString                as B-import           Data.Char                      (chr, ord, toLower)-import           Data.Maybe-import           Data.String.Conversions-import           Data.Text                      (Text, append, pack, snoc,-                                                 uncons)-import qualified Data.Text                      as T-import           Data.Word                      (Word8)-import           Network.Haskoin.Address-import           Network.Haskoin.Address.Bech32-import           Network.Haskoin.Util-import           Test.Hspec-import           Test.HUnit--spec = do-    describe "bech32 checksum" $ do-        it "should have valid checksum" $ forM_ validChecksums testValidChecksum-        it "should have invalid checksum" $-            forM_ invalidChecksums testInvalidChecksum-        it "should be a valid address" $ forM_ validAddresses testValidAddress-        it "should be an invalid address" $-            forM_ invalidAddresses testInvalidAddress-        it "should be same for the input in different case" $-            all (== Just "test12hrzfj") . map (flip bech32Encode []) $ hrpCaseVariants-    describe "more encoding/decoding cases" $ do-        it "length > 90" $-            assert $-            isNothing $-            bech32Encode "bc" (replicate 82 (word5 (1 :: Word8)))-        it "segwit version bounds" $-            assert $ isNothing $ segwitEncode "bc" 17 []-        it "segwit prog len version 0" $-            assert $ isNothing $ segwitEncode "bc" 0 (replicate 30 1)-        it "segwit prog len version != 0" $-            assert $ isJust $ segwitEncode "bc" 1 (replicate 30 1)-        it "segwit prog len version != 0" $-            assert $ isNothing $ segwitEncode "bc" 1 (replicate 41 1)-        it "empty HRP encode" $ assert $ isNothing $ bech32Encode "" []-        it "empty HRP encode" $-            assert $ isNothing $ bech32Decode "10a06t8"-        it "hrp lowercased" $-            bech32Encode "HRP" [] `shouldBe` bech32Encode "hrp" []---testValidChecksum :: Bech32 -> Assertion-testValidChecksum checksum = case bech32Decode checksum of-    Nothing                      -> assertFailure (show checksum)-    Just (resultHRP, resultData) -> do-        -- test that a corrupted checksum fails decoding.-        let (hrp, rest)         = T.breakOnEnd "1" checksum-            Just (first, rest') = uncons rest-            checksumCorrupted   = (hrp `snoc` chr (ord first `xor` 1)) `append` rest'-        assertBool (show checksum ++ " corrupted")-            $ isNothing (bech32Decode checksumCorrupted)-        -- test that re-encoding the decoded checksum results in the same checksum.-        let checksumEncoded  = bech32Encode resultHRP resultData-            expectedChecksum = Just $ T.toLower checksum-        assertEqual (show checksum ++ " re-encode")-                    expectedChecksum-                    checksumEncoded--testInvalidChecksum :: Bech32 -> Assertion-testInvalidChecksum checksum =-    assertBool (show checksum) (isNothing $ bech32Decode checksum)--testValidAddress :: (Text, Text) -> Assertion-testValidAddress (address, hexscript) = do-    let address' = T.toLower address-        hrp      = T.take 2 address'-    case segwitDecode hrp address of-        Nothing                -> assertFailure "decode failed"-        Just (witver, witprog) -> do-            assertEqual (show address)-                        (decodeHex hexscript)-                        (Just $ segwitScriptPubkey witver witprog)-            assertEqual (show address)-                        (Just address')-                        (segwitEncode hrp witver witprog)--testInvalidAddress :: Text -> Assertion-testInvalidAddress address = do-    assertBool (show address) (isNothing $ segwitDecode "bc" address)-    assertBool (show address) (isNothing $ segwitDecode "tb" address)--segwitScriptPubkey :: Word8 -> [Word8] -> ByteString-segwitScriptPubkey witver witprog =-    B.pack $ witver' : fromIntegral (length witprog) : witprog-    where witver' = if witver == 0 then 0 else witver + 0x50--validChecksums :: [Text]-validChecksums =-    [ "A12UEL5L"-    , "an83characterlonghumanreadablepartthatcontainsthenumber1andtheexcludedcharactersbio1tt5tgs"-    , "abcdef1qpzry9x8gf2tvdw0s3jn54khce6mua7lmqqqxw"-    , "11qqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqc8247j"-    , "split1checkupstagehandshakeupstreamerranterredcaperred2y9e3w"-    ]--invalidChecksums :: [Text]-invalidChecksums =-    [ " 1nwldj5"-    , "\DEL1axkwrx"-    , "an84characterslonghumanreadablepartthatcontainsthenumber1andtheexcludedcharactersbio1569pvx"-    , "pzry9x0s0muk"-    , "1pzry9x0s0muk"-    , "x1b4n0q5v"-    , "li1dgmt3"-    , "de1lg7wt\xFF"-    ]--validAddresses :: [(Text, Text)]-validAddresses =-    [ ("BC1QW508D6QEJXTDG4Y5R3ZARVARY0C5XW7KV8F3T4", "0014751e76e8199196d454941c45d1b3a323f1433bd6")-    , ("tb1qrp33g0q5c5txsp9arysrx4k6zdkfs4nce4xj0gdcccefvpysxf3q0sl5k7"-      ,"00201863143c14c5166804bd19203356da136c985678cd4d27a1b8c6329604903262")-    , ("bc1pw508d6qejxtdg4y5r3zarvary0c5xw7kw508d6qejxtdg4y5r3zarvary0c5xw7k7grplx"-      ,"5128751e76e8199196d454941c45d1b3a323f1433bd6751e76e8199196d454941c45d1b3a323f1433bd6")-    , ("BC1SW50QA3JX3S", "6002751e")-    , ("bc1zw508d6qejxtdg4y5r3zarvaryvg6kdaj", "5210751e76e8199196d454941c45d1b3a323")-    , ("tb1qqqqqp399et2xygdj5xreqhjjvcmzhxw4aywxecjdzew6hylgvsesrxh6hy"-      ,"0020000000c4a5cad46221b2a187905e5266362b99d5e91c6ce24d165dab93e86433")-    ]--invalidAddresses :: [Text]-invalidAddresses =-    [ "tc1qw508d6qejxtdg4y5r3zarvary0c5xw7kg3g4ty"-    , "bc1qw508d6qejxtdg4y5r3zarvary0c5xw7kv8f3t5"-    , "BC13W508D6QEJXTDG4Y5R3ZARVARY0C5XW7KN40WF2"-    , "bc1rw5uspcuh"-    , "bc10w508d6qejxtdg4y5r3zarvary0c5xw7kw508d6qejxtdg4y5r3zarvary0c5xw7kw5rljs90"-    , "BC1QR508D6QEJXTDG4Y5R3ZARVARYV98GJ9P"-    , "tb1qrp33g0q5c5txsp9arysrx4k6zdkfs4nce4xj0gdcccefvpysxf3q0sL5k7"-    , "bc1zw508d6qejxtdg4y5r3zarvaryvqyzf3du"-    , "tb1qrp33g0q5c5txsp9arysrx4k6zdkfs4nce4xj0gdcccefvpysxf3pjxtptv"-    , "bc1gmk9yu"-    ]--hrpCaseVariants:: [Text]-hrpCaseVariants = map T.pack hrpTestPermutations--hrpTestPermutations :: [String]-hrpTestPermutations = do-    a <- ['t', 'T']-    b <- ['e', 'E']-    c <- ['s', 'S']-    d <- ['t', 'T']-    return [a, b, c, d]
− test/Network/Haskoin/Address/CashAddrSpec.hs 
@@ -1,280 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}-module Network.Haskoin.Address.CashAddrSpec (spec) where--import           Control.Monad-import qualified Data.ByteString.Char8            as C-import           Data.Maybe-import           Data.String.Conversions-import           Data.Text                        (Text)-import           Network.Haskoin.Address-import           Network.Haskoin.Address.CashAddr-import           Network.Haskoin.Constants-import           Network.Haskoin.Util-import           Test.Hspec-import           Test.HUnit--spec :: Spec-spec = do-    describe "cashaddr checksum test vectors" $ do-        it "prefix:x64nx6hz" $ do-            let mpb = cash32decode "prefix:x64nx6hz"-            mpb `shouldBe` Just ("prefix", "")-        it "p:gpf8m4h7" $ do-            let mpb = cash32decode "p:gpf8m4h7"-            mpb `shouldBe` Just ("p", "")-        it "bitcoincash:qpzry9x8gf2tvdw0s3jn54khce6mua7lcw20ayyn" $ do-            let mpb =-                    cash32decode-                        "bitcoincash:qpzry9x8gf2tvdw0s3jn54khce6mua7lcw20ayyn"-            mpb `shouldBe`-                Just-                    ( "bitcoincash"-                    , "\NULD2\DC4\199BT\182\&5\207\132e:V\215\198u\190w\223")-        it "bchtest:testnetaddress4d6njnut" $ do-            let mpb = cash32decode "bchtest:testnetaddress4d6njnut"-            mpb `shouldBe` Just ("bchtest", "^`\185\229}kG\152")-        it "bchreg:555555555555555555555555555555555555555555555udxmlmrz" $ do-            let mpb =-                    cash32decode-                        "bchreg:555555555555555555555555555555555555555555555udxmlmrz"-            mpb `shouldBe`-                Just-                    ( "bchreg"-                    , "\165)JR\148\165)JR\148\165)JR\148\165)JR\148\165)JR\148\165)J")-    describe "cashaddr to base58 translation test vectors" $ do-        it "1BpEi6DfDAUFd7GtittLSdBeYJvcoaVggu" $ do-            let addr =-                    addrToString bch =<<-                    stringToAddr btc "1BpEi6DfDAUFd7GtittLSdBeYJvcoaVggu"-            addr `shouldBe`-                Just "bitcoincash:qpm2qsznhks23z7629mms6s4cwef74vcwvy22gdx6a"-        it "1KXrWXciRDZUpQwQmuM1DbwsKDLYAYsVLR" $ do-            let addr =-                    addrToString bch =<<-                    stringToAddr btc "1KXrWXciRDZUpQwQmuM1DbwsKDLYAYsVLR"-            addr `shouldBe`-                Just "bitcoincash:qr95sy3j9xwd2ap32xkykttr4cvcu7as4y0qverfuy"-        it "16w1D5WRVKJuZUsSRzdLp9w3YGcgoxDXb" $ do-            let addr =-                    addrToString bch =<<-                    stringToAddr btc "16w1D5WRVKJuZUsSRzdLp9w3YGcgoxDXb"-            addr `shouldBe`-                Just "bitcoincash:qqq3728yw0y47sqn6l2na30mcw6zm78dzqre909m2r"-        it "3CWFddi6m4ndiGyKqzYvsFYagqDLPVMTzC" $ do-            let addr =-                    addrToString bch =<<-                    stringToAddr btc "3CWFddi6m4ndiGyKqzYvsFYagqDLPVMTzC"-            addr `shouldBe`-                Just "bitcoincash:ppm2qsznhks23z7629mms6s4cwef74vcwvn0h829pq"-        it "3LDsS579y7sruadqu11beEJoTjdFiFCdX4" $ do-            let addr =-                    addrToString bch =<<-                    stringToAddr btc "3LDsS579y7sruadqu11beEJoTjdFiFCdX4"-            addr `shouldBe`-                Just "bitcoincash:pr95sy3j9xwd2ap32xkykttr4cvcu7as4yc93ky28e"-        it "31nwvkZwyPdgzjBJZXfDmSWsC4ZLKpYyUw" $ do-            let addr =-                    addrToString bch =<<-                    stringToAddr btc "31nwvkZwyPdgzjBJZXfDmSWsC4ZLKpYyUw"-            addr `shouldBe`-                Just "bitcoincash:pqq3728yw0y47sqn6l2na30mcw6zm78dzq5ucqzc37"-    describe "base58 to cashaddr translation test vectors" $ do-        it "bitcoincash:qpm2qsznhks23z7629mms6s4cwef74vcwvy22gdx6a" $ do-            let addr =-                    addrToString btc =<<-                    stringToAddr-                        bch-                        "bitcoincash:qpm2qsznhks23z7629mms6s4cwef74vcwvy22gdx6a"-            addr `shouldBe` Just "1BpEi6DfDAUFd7GtittLSdBeYJvcoaVggu"-        it "bitcoincash:qr95sy3j9xwd2ap32xkykttr4cvcu7as4y0qverfuy" $ do-            let addr =-                    addrToString btc =<<-                    stringToAddr-                        bch-                        "bitcoincash:qr95sy3j9xwd2ap32xkykttr4cvcu7as4y0qverfuy"-            addr `shouldBe` Just "1KXrWXciRDZUpQwQmuM1DbwsKDLYAYsVLR"-        it "bitcoincash:qqq3728yw0y47sqn6l2na30mcw6zm78dzqre909m2r" $ do-            let addr =-                    addrToString btc =<<-                    stringToAddr-                        bch-                        "bitcoincash:qqq3728yw0y47sqn6l2na30mcw6zm78dzqre909m2r"-            addr `shouldBe` Just "16w1D5WRVKJuZUsSRzdLp9w3YGcgoxDXb"-        it "bitcoincash:ppm2qsznhks23z7629mms6s4cwef74vcwvn0h829pq" $ do-            let addr =-                    addrToString btc =<<-                    stringToAddr-                        bch-                        "bitcoincash:ppm2qsznhks23z7629mms6s4cwef74vcwvn0h829pq"-            addr `shouldBe` Just "3CWFddi6m4ndiGyKqzYvsFYagqDLPVMTzC"-        it "bitcoincash:pr95sy3j9xwd2ap32xkykttr4cvcu7as4yc93ky28e" $ do-            let addr =-                    addrToString btc =<<-                    stringToAddr-                        bch-                        "bitcoincash:pr95sy3j9xwd2ap32xkykttr4cvcu7as4yc93ky28e"-            addr `shouldBe` Just "3LDsS579y7sruadqu11beEJoTjdFiFCdX4"-        it "bitcoincash:pqq3728yw0y47sqn6l2na30mcw6zm78dzq5ucqzc37" $ do-            let addr =-                    addrToString btc =<<-                    stringToAddr-                        bch-                        "bitcoincash:pqq3728yw0y47sqn6l2na30mcw6zm78dzq5ucqzc37"-            addr `shouldBe` Just "31nwvkZwyPdgzjBJZXfDmSWsC4ZLKpYyUw"-    describe "cashaddr larger test vectors" $-        forM_ (zip [0 ..] vectors) $ \(i, vec) ->-            it ("cashaddr test vector " <> show (i :: Int)) $ testCashAddr vec--{- Various utilities -}--testCashAddr :: (Int, CashVersion, Cash32, Text) -> Assertion-testCashAddr (len, typ, addr, hex) = do-    let mbs = decodeHex hex-    assertBool "Could not decode hex payload from test vector" (isJust mbs)-    let mlow = cash32decode addr-    assertBool "Could not decode low level address" (isJust 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)-    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 (_, ver, pay) = cash32decodeType addr---- | All vectors starting with @pref@ had the wrong version in the spec--- document.-vectors :: [(Int, CashVersion, Text, Text)]-vectors =-    [ ( 20-      , 0-      , "bitcoincash:qr6m7j9njldwwzlg9v7v53unlr4jkmx6eylep8ekg2"-      , "F5BF48B397DAE70BE82B3CCA4793F8EB2B6CDAC9")-    , ( 20-      , 1-      , "bchtest:pr6m7j9njldwwzlg9v7v53unlr4jkmx6eyvwc0uz5t"-      , "F5BF48B397DAE70BE82B3CCA4793F8EB2B6CDAC9")-    , ( 20-      , 1-      , "pref:pr6m7j9njldwwzlg9v7v53unlr4jkmx6ey65nvtks5"-      , "F5BF48B397DAE70BE82B3CCA4793F8EB2B6CDAC9")-    , ( 20-      , 15-      , "prefix:0r6m7j9njldwwzlg9v7v53unlr4jkmx6ey3qnjwsrf"-      , "F5BF48B397DAE70BE82B3CCA4793F8EB2B6CDAC9")-    , ( 24-      , 0-      , "bitcoincash:q9adhakpwzztepkpwp5z0dq62m6u5v5xtyj7j3h2ws4mr9g0"-      , "7ADBF6C17084BC86C1706827B41A56F5CA32865925E946EA")-    , ( 24-      , 1-      , "bchtest:p9adhakpwzztepkpwp5z0dq62m6u5v5xtyj7j3h2u94tsynr"-      , "7ADBF6C17084BC86C1706827B41A56F5CA32865925E946EA")-    , ( 24-      , 1-      , "pref:p9adhakpwzztepkpwp5z0dq62m6u5v5xtyj7j3h2khlwwk5v"-      , "7ADBF6C17084BC86C1706827B41A56F5CA32865925E946EA")-    , ( 24-      , 15-      , "prefix:09adhakpwzztepkpwp5z0dq62m6u5v5xtyj7j3h2p29kc2lp"-      , "7ADBF6C17084BC86C1706827B41A56F5CA32865925E946EA")-    , ( 28-      , 0-      , "bitcoincash:qgagf7w02x4wnz3mkwnchut2vxphjzccwxgjvvjmlsxqwkcw59jxxuz"-      , "3A84F9CF51AAE98A3BB3A78BF16A6183790B18719126325BFC0C075B")-    , ( 28-      , 1-      , "bchtest:pgagf7w02x4wnz3mkwnchut2vxphjzccwxgjvvjmlsxqwkcvs7md7wt"-      , "3A84F9CF51AAE98A3BB3A78BF16A6183790B18719126325BFC0C075B")-    , ( 28-      , 1-      , "pref:pgagf7w02x4wnz3mkwnchut2vxphjzccwxgjvvjmlsxqwkcrsr6gzkn"-      , "3A84F9CF51AAE98A3BB3A78BF16A6183790B18719126325BFC0C075B")-    , ( 28-      , 15-      , "prefix:0gagf7w02x4wnz3mkwnchut2vxphjzccwxgjvvjmlsxqwkc5djw8s9g"-      , "3A84F9CF51AAE98A3BB3A78BF16A6183790B18719126325BFC0C075B")-    , ( 32-      , 0-      , "bitcoincash:qvch8mmxy0rtfrlarg7ucrxxfzds5pamg73h7370aa87d80gyhqxq5nlegake"-      , "3173EF6623C6B48FFD1A3DCC0CC6489B0A07BB47A37F47CFEF4FE69DE825C060")-    , ( 32-      , 1-      , "bchtest:pvch8mmxy0rtfrlarg7ucrxxfzds5pamg73h7370aa87d80gyhqxq7fqng6m6"-      , "3173EF6623C6B48FFD1A3DCC0CC6489B0A07BB47A37F47CFEF4FE69DE825C060")-    , ( 32-      , 1-      , "pref:pvch8mmxy0rtfrlarg7ucrxxfzds5pamg73h7370aa87d80gyhqxq4k9m7qf9"-      , "3173EF6623C6B48FFD1A3DCC0CC6489B0A07BB47A37F47CFEF4FE69DE825C060")-    , ( 32-      , 15-      , "prefix:0vch8mmxy0rtfrlarg7ucrxxfzds5pamg73h7370aa87d80gyhqxqsh6jgp6w"-      , "3173EF6623C6B48FFD1A3DCC0CC6489B0A07BB47A37F47CFEF4FE69DE825C060")-    , ( 40-      , 0-      , "bitcoincash:qnq8zwpj8cq05n7pytfmskuk9r4gzzel8qtsvwz79zdskftrzxtar994cgutavfklv39gr3uvz"-      , "C07138323E00FA4FC122D3B85B9628EA810B3F381706385E289B0B25631197D194B5C238BEB136FB")-    , ( 40-      , 1-      , "bchtest:pnq8zwpj8cq05n7pytfmskuk9r4gzzel8qtsvwz79zdskftrzxtar994cgutavfklvmgm6ynej"-      , "C07138323E00FA4FC122D3B85B9628EA810B3F381706385E289B0B25631197D194B5C238BEB136FB")-    , ( 40-      , 1-      , "pref:pnq8zwpj8cq05n7pytfmskuk9r4gzzel8qtsvwz79zdskftrzxtar994cgutavfklv0vx5z0w3"-      , "C07138323E00FA4FC122D3B85B9628EA810B3F381706385E289B0B25631197D194B5C238BEB136FB")-    , ( 40-      , 15-      , "prefix:0nq8zwpj8cq05n7pytfmskuk9r4gzzel8qtsvwz79zdskftrzxtar994cgutavfklvwsvctzqy"-      , "C07138323E00FA4FC122D3B85B9628EA810B3F381706385E289B0B25631197D194B5C238BEB136FB")-    , ( 48-      , 0-      , "bitcoincash:qh3krj5607v3qlqh5c3wq3lrw3wnuxw0sp8dv0zugrrt5a3kj6ucysfz8kxwv2k53krr7n933jfsunqex2w82sl"-      , "E361CA9A7F99107C17A622E047E3745D3E19CF804ED63C5C40C6BA763696B98241223D8CE62AD48D863F4CB18C930E4C")-    , ( 48-      , 1-      , "bchtest:ph3krj5607v3qlqh5c3wq3lrw3wnuxw0sp8dv0zugrrt5a3kj6ucysfz8kxwv2k53krr7n933jfsunqnzf7mt6x"-      , "E361CA9A7F99107C17A622E047E3745D3E19CF804ED63C5C40C6BA763696B98241223D8CE62AD48D863F4CB18C930E4C")-    , ( 48-      , 1-      , "pref:ph3krj5607v3qlqh5c3wq3lrw3wnuxw0sp8dv0zugrrt5a3kj6ucysfz8kxwv2k53krr7n933jfsunqjntdfcwg"-      , "E361CA9A7F99107C17A622E047E3745D3E19CF804ED63C5C40C6BA763696B98241223D8CE62AD48D863F4CB18C930E4C")-    , ( 48-      , 15-      , "prefix:0h3krj5607v3qlqh5c3wq3lrw3wnuxw0sp8dv0zugrrt5a3kj6ucysfz8kxwv2k53krr7n933jfsunqakcssnmn"-      , "E361CA9A7F99107C17A622E047E3745D3E19CF804ED63C5C40C6BA763696B98241223D8CE62AD48D863F4CB18C930E4C")-    , ( 56-      , 0-      , "bitcoincash:qmvl5lzvdm6km38lgga64ek5jhdl7e3aqd9895wu04fvhlnare5937w4ywkq57juxsrhvw8ym5d8qx7sz7zz0zvcypqscw8jd03f"-      , "D9FA7C4C6EF56DC4FF423BAAE6D495DBFF663D034A72D1DC7D52CBFE7D1E6858F9D523AC0A7A5C34077638E4DD1A701BD017842789982041")-    , ( 56-      , 1-      , "bchtest:pmvl5lzvdm6km38lgga64ek5jhdl7e3aqd9895wu04fvhlnare5937w4ywkq57juxsrhvw8ym5d8qx7sz7zz0zvcypqs6kgdsg2g"-      , "D9FA7C4C6EF56DC4FF423BAAE6D495DBFF663D034A72D1DC7D52CBFE7D1E6858F9D523AC0A7A5C34077638E4DD1A701BD017842789982041")-    , ( 56-      , 1-      , "pref:pmvl5lzvdm6km38lgga64ek5jhdl7e3aqd9895wu04fvhlnare5937w4ywkq57juxsrhvw8ym5d8qx7sz7zz0zvcypqsammyqffl"-      , "D9FA7C4C6EF56DC4FF423BAAE6D495DBFF663D034A72D1DC7D52CBFE7D1E6858F9D523AC0A7A5C34077638E4DD1A701BD017842789982041")-    , ( 56-      , 15-      , "prefix:0mvl5lzvdm6km38lgga64ek5jhdl7e3aqd9895wu04fvhlnare5937w4ywkq57juxsrhvw8ym5d8qx7sz7zz0zvcypqsgjrqpnw8"-      , "D9FA7C4C6EF56DC4FF423BAAE6D495DBFF663D034A72D1DC7D52CBFE7D1E6858F9D523AC0A7A5C34077638E4DD1A701BD017842789982041")-    , ( 64-      , 0-      , "bitcoincash:qlg0x333p4238k0qrc5ej7rzfw5g8e4a4r6vvzyrcy8j3s5k0en7calvclhw46hudk5flttj6ydvjc0pv3nchp52amk97tqa5zygg96mtky5sv5w"-      , "D0F346310D5513D9E01E299978624BA883E6BDA8F4C60883C10F28C2967E67EC77ECC7EEEAEAFC6DA89FAD72D11AC961E164678B868AEEEC5F2C1DA08884175B")-    , ( 64-      , 1-      , "bchtest:plg0x333p4238k0qrc5ej7rzfw5g8e4a4r6vvzyrcy8j3s5k0en7calvclhw46hudk5flttj6ydvjc0pv3nchp52amk97tqa5zygg96mc773cwez"-      , "D0F346310D5513D9E01E299978624BA883E6BDA8F4C60883C10F28C2967E67EC77ECC7EEEAEAFC6DA89FAD72D11AC961E164678B868AEEEC5F2C1DA08884175B")-    , ( 64-      , 1-      , "pref:plg0x333p4238k0qrc5ej7rzfw5g8e4a4r6vvzyrcy8j3s5k0en7calvclhw46hudk5flttj6ydvjc0pv3nchp52amk97tqa5zygg96mg7pj3lh8"-      , "D0F346310D5513D9E01E299978624BA883E6BDA8F4C60883C10F28C2967E67EC77ECC7EEEAEAFC6DA89FAD72D11AC961E164678B868AEEEC5F2C1DA08884175B")-    , ( 64-      , 15-      , "prefix:0lg0x333p4238k0qrc5ej7rzfw5g8e4a4r6vvzyrcy8j3s5k0en7calvclhw46hudk5flttj6ydvjc0pv3nchp52amk97tqa5zygg96ms92w6845"-      , "D0F346310D5513D9E01E299978624BA883E6BDA8F4C60883C10F28C2967E67EC77ECC7EEEAEAFC6DA89FAD72D11AC961E164678B868AEEEC5F2C1DA08884175B")-    ]
− test/Network/Haskoin/AddressSpec.hs 
@@ -1,91 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}-module Network.Haskoin.AddressSpec (spec) where--import           Data.Aeson-import           Data.Aeson.Types-import           Data.ByteString                (ByteString)-import qualified Data.ByteString                as BS (append, empty, pack)-import           Data.Either                    (isRight)-import           Data.Maybe                     (isJust, fromJust)-import qualified Data.Serialize                 as S-import           Data.Text                      (Text)-import           Network.Haskoin.Address-import           Network.Haskoin.Address.Base58-import           Network.Haskoin.Constants-import           Network.Haskoin.Keys           (derivePubKeyI)-import           Network.Haskoin.Test-import           Test.Hspec-import           Test.HUnit                     (Assertion, assertBool,-                                                 assertEqual)-import           Test.QuickCheck--spec :: Spec-spec = do-    let net = btc-    describe "btc address" . it "base58 encodings" $ mapM_ runVector vectors-    describe "btc-test address" $ props btcTest-    describe "bch address" $ props bch-    describe "bch-test address" $ props bchTest-    describe "bch-regtest address" $ props bchRegTest-    describe "json serialization" . it "encodes and decodes address" $-        forAll arbitraryAddress (testCustom (addrFromJSON net) (addrToJSON net))-    describe "witness address vectors" . it "p2sh(pwpkh)" $-        mapM_ testCompatWitness compatWitnessVectors--props :: Network -> Spec-props net = do-    it "encodes and decodes base58 bytestring" $-        property $-        forAll arbitraryBS $ \bs -> decodeBase58 (encodeBase58 bs) == Just bs-    it "encodes and decodes base58 bytestring with checksum" $-        property $-        forAll arbitraryBS $ \bs ->-            decodeBase58Check (encodeBase58Check bs) == Just bs-    it "encodes and decodes address" $-        property $-        forAll arbitraryAddress $ \a ->-            (stringToAddr net =<< addrToString net a) == Just a-    it "shows and reads address" $-        property $ forAll arbitraryAddress $ \a -> read (show a) == a--runVector :: (ByteString, Text, Text) -> Assertion-runVector (bs, e, chk) = do-    assertEqual "encodeBase58" e b58-    assertEqual "encodeBase58Check" chk b58Chk-    assertEqual "decodeBase58" (Just bs) (decodeBase58 b58)-    assertEqual "decodeBase58Check" (Just bs) (decodeBase58Check b58Chk)-  where-    b58    = encodeBase58 bs-    b58Chk = encodeBase58Check bs--vectors :: [(ByteString, Text, Text)]-vectors =-    [ ( BS.empty, "", "3QJmnh" )-    , ( BS.pack [0], "1", "1Wh4bh" )-    , ( BS.pack [0,0,0,0], "1111", "11114bdQda" )-    , ( BS.pack [0,0,1,0,0], "11LUw", "113CUwsFVuo" )-    , ( BS.pack [255], "5Q", "VrZDWwe" )-    , ( BS.pack [0,0,0,0] `BS.append` BS.pack [1..255]-      , "1111cWB5HCBdLjAuqGGReWE3R3CguuwSjw6RHn39s2yuDRTS5NsBgNiFpWgAnEx6VQi8csexkgYw3mdYrMHr8x9i7aEwP8kZ7vccXWqKDvGv3u1GxFKPuAkn8JCPPGDMf3vMMnbzm6Nh9zh1gcNsMvH3ZNLmP5fSG6DGbbi2tuwMWPthr4boWwCxf7ewSgNQeacyozhKDDQQ1qL5fQFUW52QKUZDZ5fw3KXNQJMcNTcaB723LchjeKun7MuGW5qyCBZYzA1KjofN1gYBV3NqyhQJ3Ns746GNuf9N2pQPmHz4xpnSrrfCvy6TVVz5d4PdrjeshsWQwpZsZGzvbdAdN8MKV5QsBDY"-      , "111151KWPPBRzdWPr1ASeu172gVgLf1YfUp6VJyk6K9t4cLqYtFHcMa2iX8S3NJEprUcW7W5LvaPRpz7UG7puBj5STE3nKhCGt5eckYq7mMn5nT7oTTic2BAX6zDdqrmGCnkszQkzkz8e5QLGDjf7KeQgtEDm4UER6DMSdBjFQVa6cHrrJn9myVyyhUrsVnfUk2WmNFZvkWv3Tnvzo2cJ1xW62XDfUgYz1pd97eUGGPuXvDFfLsBVd1dfdUhPwxW7pMPgdWHTmg5uqKGFF6vE4xXpAqZTbTxRZjCDdTn68c2wrcxApm8hq3JX65Hix7VtcD13FF8b7BzBtwjXq1ze6NMjKgUcqpJTN9vt"-      )-    ]--testCustom :: Eq a => (Value -> Parser a) -> (a -> Value) -> a -> Bool-testCustom f g x = parseMaybe f (g x) == Just x--compatWitnessVectors :: [(Network, Text, Text)]-compatWitnessVectors =-    [ ( btcTest-      , "cNUnpYpMsJXYCERYBciJnsWBpcYEFjdcbq6dxj4SskGhs7uHuJ7Q"-      , "2N6PDTueBHvXzW61B4oe5SW1D3v2Z3Vpbvw")-    ]--testCompatWitness :: (Network, Text, Text) -> Assertion-testCompatWitness (net, seckey, addr) = do-    let seckeyM = fromWif net seckey-    assertBool "decode seckey" (isJust seckeyM)-    let pubkey = derivePubKeyI (fromJust seckeyM)-    let addrM = addrToString btcTest (pubKeyCompatWitnessAddr pubkey)-    assertBool "address can be encoded" (isJust addrM)-    assertEqual "witness address matches" addr (fromJust addrM)
− test/Network/Haskoin/BlockSpec.hs 
@@ -1,359 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}-module Network.Haskoin.BlockSpec-    ( spec-    ) where--import           Control.Monad.State.Strict-import           Data.Aeson                    as A-import           Data.Either                   (fromRight)-import           Data.Map.Strict               (singleton)-import           Data.Maybe                    (fromJust)-import           Data.Serialize                as S-import           Data.String                   (fromString)-import           Data.String.Conversions       (cs)-import           Data.Text                     (Text)-import           Network.Haskoin.Block-import           Network.Haskoin.Block.Headers-import           Network.Haskoin.Block.Merkle-import           Network.Haskoin.Constants-import           Network.Haskoin.Test-import           Network.Haskoin.Transaction-import           Test.Hspec-import           Test.HUnit                    hiding (State)-import           Test.QuickCheck--myTime :: Timestamp-myTime = 1499083075--withChain :: Network -> State HeaderMemory a -> a-withChain net f = evalState f (initialChain net)--chain :: BlockHeaders m => Network -> BlockHeader -> Int -> m ()-chain net bh i = do-    bnsE <- connectBlocks net myTime bhs-    either error (const $ return ()) bnsE-  where-    bhs = appendBlocks net 6 bh i--spec :: Spec-spec = do-    let net = bchRegTest-    describe "blockchain headers" $ do-        it "gets best block" $-            let bb =-                    withChain net $ do-                        chain net (getGenesisHeader net) 100-                        getBestBlockHeader-             in nodeHeight bb `shouldBe` 100-        it "builds a block locator" $-            let loc =-                    withChain net $ do-                        chain net (getGenesisHeader net) 100-                        bb <- getBestBlockHeader-                        blockLocatorNodes bb-                heights = map nodeHeight loc-             in heights `shouldBe` [100,99 .. 90] <> [88, 84, 76, 60, 28, 0]-        it "follows split chains" $-            let bb = withChain net $ splitChain net >> getBestBlockHeader-             in nodeHeight bb `shouldBe` 4035-    describe "block hash" $ do-        it "encodes and decodes block hash" $-            property $-            forAll arbitraryBlockHash $ \h ->-                hexToBlockHash (blockHashToHex h) == Just h-        it "from string block hash" $-            property $-            forAll arbitraryBlockHash $ \h ->-                fromString (cs $ blockHashToHex h) == h-        it "show and read block hash" $-            property $ forAll arbitraryBlockHash $ \h -> read (show h) == h-        it "json block hash" $ property $ forAll arbitraryBlockHash testID-    describe "merkle trees" $ do-        let net' = btc-        it "builds tree of right width at height 1" $ property testTreeWidth-        it "builds tree of right width at height 0" $ property testBaseWidth-        it "builds and extracts partial merkle tree" $-            property $-            forAll-                (listOf1 ((,) <$> arbitraryTxHash <*> arbitrary))-                (buildExtractTree net')-        it "merkle root test vectors" $-            mapM_ runMerkleVector merkleVectors-    describe "compact number" $ do-        it "compact number local vectors" testCompact-        it "compact number imported vectors" testCompactBitcoinCore-    describe "block serialization" $ do-        it "encodes and decodes block" $-            property $ forAll (arbitraryBlock net) cerealID-        it "encodes and decodes block JSON" $-            property $ forAll (arbitraryBlock net) testID-        it "encodes and decodes block header" $-            property $ forAll arbitraryBlockHeader cerealID-        it "encodes and decodes block header JSON" $-            property $ forAll arbitraryBlockHeader testID-        it "encodes and decodes getblocks" $-            property $ forAll arbitraryGetBlocks cerealID-        it "encodes and decodes getheaders" $-            property $ forAll arbitraryGetHeaders cerealID-        it "encodes and decdoes headers" $-            property $ forAll arbitraryHeaders cerealID-        it "encodes and decodes merkle block" $-            property $ forAll arbitraryMerkleBlock cerealID-    describe "helper functions" $ do-        it "computes bitcoin block subsidy correctly" (testSubsidy btc)-        it "computes regtest block subsidy correctly" (testSubsidy btcRegTest)---- 0 → → 2015 → → → → → → → 4031---       ↓---       → → 2035 → → → → → → 4035*---           ↓---           → → 2185-splitChain :: Network -> State HeaderMemory ()-splitChain net = do-    start <- go 1 (getGenesisHeader net) 2015-    e 2015 (head start)-    tail1 <- go 2 (nodeHeader $ head start) 2016-    e 4031 (head tail1)-    tail2 <- go 3 (nodeHeader $ head start) 20-    e 2035 (head tail2)-    tail3 <- go 4 (nodeHeader $ head tail2) 2000-    e 4035 (head tail3)-    tail4 <- go 5 (nodeHeader $ head tail2) 150-    e 2185 (head tail4)-    sp1 <- splitPoint (head tail1) (head tail3)-    unless (sp1 == head start) $-        error $-        "Split point wrong between blocks 4031 and 4035: " ++-        show (nodeHeight sp1)-    sp2 <- splitPoint (head tail4) (head tail3)-    unless (sp2 == head tail2) $-        error $-        "Split point wrong between blocks 2185 and 4035: " ++-        show (nodeHeight sp2)-  where-    e n bn =-        unless (nodeHeight bn == n) $-        error $-        "Node height " ++-        show (nodeHeight bn) ++ " of first chunk should be " ++ show n-    go seed start n = do-        let bhs = appendBlocks net seed start n-        bnE <- connectBlocks net myTime bhs-        case bnE of-            Right bn -> return bn-            Left ex  -> error ex--{- Merkle Trees -}--testTreeWidth :: Int -> Property-testTreeWidth i = i /= 0 ==> calcTreeWidth (abs i) (calcTreeHeight $ abs i) == 1--testBaseWidth :: Int -> Property-testBaseWidth i = i /= 0 ==> calcTreeWidth (abs i) 0 == abs i--buildExtractTree :: Network -> [(TxHash, Bool)] -> Bool-buildExtractTree net txs =-    r == buildMerkleRoot (map fst txs) && m == map fst (filter snd txs)-  where-    (f, h) = buildPartialMerkle txs-    (r, m) =-        fromRight (error "Could not extract matches from Merkle tree") $-        extractMatches net f h (length txs)--testCompact :: Assertion-testCompact = do-    assertEqual "vector 1" 0x05123456 (encodeCompact 0x1234560000)-    assertEqual "vector 2" (0x1234560000, False) (decodeCompact 0x05123456)-    assertEqual "vector 3" 0x0600c0de (encodeCompact 0xc0de000000)-    assertEqual "vector 4" (0xc0de000000, False) (decodeCompact 0x0600c0de)-    assertEqual "vector 5" 0x05c0de00 (encodeCompact (-0x40de000000))-    assertEqual "vector 6" (-0x40de000000, False) (decodeCompact 0x05c0de00)--testCompactBitcoinCore :: Assertion-testCompactBitcoinCore = do-    assertEqual "zero" (0, False) (decodeCompact 0x00000000)-    assertEqual-        "zero (encode · decode)"-        0x00000000-        (encodeCompact . fst $ decodeCompact 0x00000000)-    assertEqual "rounds to zero" (0, False) (decodeCompact 0x00123456)-    assertEqual "rounds to zero" (0, False) (decodeCompact 0x01003456)-    assertEqual "rounds to zero" (0, False) (decodeCompact 0x02000056)-    assertEqual "rounds to zero" (0, False) (decodeCompact 0x03000000)-    assertEqual "rounds to zero" (0, False) (decodeCompact 0x04000000)-    assertEqual "rounds to zero" (0, False) (decodeCompact 0x00923456)-    assertEqual "rounds to zero" (0, False) (decodeCompact 0x01803456)-    assertEqual "rounds to zero" (0, False) (decodeCompact 0x02800056)-    assertEqual "rounds to zero" (0, False) (decodeCompact 0x03800000)-    assertEqual "rounds to zero" (0, False) (decodeCompact 0x04800000)-    assertEqual "vector 1 (decode)" (0x12, False) (decodeCompact 0x01123456)-    assertEqual-        "vector 1 (encode · decode)"-        0x01120000-        (encodeCompact . fst $ decodeCompact 0x01123456)-    assertEqual "0x80 bit set" 0x02008000 (encodeCompact 0x80)-    assertEqual-        "vector 2 (negative) (decode)"-        (-0x7e, False)-        (decodeCompact 0x01fedcba)-    assertEqual-        "vector 2 (negative) (encode · decode)"-        0x01fe0000-        (encodeCompact . fst $ decodeCompact 0x01fedcba)-    assertEqual "vector 3 (decode)" (0x1234, False) (decodeCompact 0x02123456)-    assertEqual-        "vector 3 (encode · decode)"-        0x02123400-        (encodeCompact . fst $ decodeCompact 0x02123456)-    assertEqual "vector 4 (decode)" (0x123456, False) (decodeCompact 0x03123456)-    assertEqual-        "vector 4 (encode · decode)"-        0x03123456-        (encodeCompact . fst $ decodeCompact 0x03123456)-    assertEqual-        "vector 5 (decode)"-        (0x12345600, False)-        (decodeCompact 0x04123456)-    assertEqual-        "vector 5 (encode · decode)"-        0x04123456-        (encodeCompact . fst $ decodeCompact 0x04123456)-    assertEqual-        "vector 6 (decode)"-        (-0x12345600, False)-        (decodeCompact 0x04923456)-    assertEqual-        "vector 6 (encode · decode)"-        0x04923456-        (encodeCompact . fst $ decodeCompact 0x04923456)-    assertEqual-        "vector 7 (decode)"-        (0x92340000, False)-        (decodeCompact 0x05009234)-    assertEqual-        "vector 7 (encode · decode)"-        0x05009234-        (encodeCompact . fst $ decodeCompact 0x05009234)-    assertEqual-        "vector 8 (decode)"-        ( 0x1234560000000000000000000000000000000000000000000000000000000000-        , False)-        (decodeCompact 0x20123456)-    assertEqual-        "vector 8 (encode · decode)"-        0x20123456-        (encodeCompact . fst $ decodeCompact 0x20123456)-    assertBool "vector 9 (decode) (overflow)" (snd $ decodeCompact 0xff123456)-    assertBool-        "vector 9 (decode) (positive)"-        ((> 0) . fst $ decodeCompact 0xff123456)--runMerkleVector :: (Text, [Text]) -> Assertion-runMerkleVector (r, hs) =-    assertBool "merkle vector" $-        buildMerkleRoot (map f hs) == getTxHash (f r)-  where-    f = fromJust . hexToTxHash--merkleVectors :: [(Text, [Text])]-merkleVectors =-      -- Block 000000000000cd7e8cf6510303dde76121a1a791c15dba0be4be7022b07cf9e1-    [ ( "fb6698ac95b754256c5e71b4fbe07638cb6ca83ee67f44e181b91727f09f4b1f"-      , [ "dd96fdcfaec994bf583af650ff6022980ee0ba1686d84d0a3a2d24eabf34bc52"-        , "1bc216f786a564378710ae589916fc8e092ddfb9f24fe6c47b733550d476d5d9"-        , "a1db0b0194426064b067899ff2d975fb277fd52dbb1a38370800c76dd6503d41"-        , "d69f7fb0e668fbd437d1bf5211cc34d7eb8746f50cfddf705fe10bc2f8f7035f"-        , "5b4057cd80be7df5ed2ac42b776897ed3c26e3a01e4072075b8129c587094ef6"-        , "ed6dabcfba0ef43c50d89a8a0e4b236b1bc6585d4c3bbf49728b55f44312d6bc"-        , "056aaa9a3c635909c794e9b0acc7dccb0456c59a84c6b08417335bee4515e3d3"-        , "05bae5f1d1c874171692e1fc06f664e63eb143d3f096601ef938e4a9012eee66"-        , "b5e48e94e3f2fba197b3f591e01f47e185d7834d669529d44078e41c671aab0f"-        , "3b56aeadfc0c5484fd507bc89f13f2e5f61c42e0a4ae9062eda9a9aeef7db6a4"-        , "2affa187e1ebb94a2a86578b9f64951e854ff3d346fef259acfb6d0f5212e0d3"-        ]-      )-      -- Block 00000000000007cc4b6f07bfed72bccc1ed8dd031a93969a4c22211f784457d4-    , ( "886fea311d2dc64c315519f2d647e43998d780d2170f77e53dc0d85bf2ee680c"-      , [ "c9c9e5211512629fd111cc071d745b8c79bf486b4ea95489eb5de08b5d786b8e"-        , "20beb0ee30dfd323ade790ce9a46ae7a174f9ea44ce22a17c4d4eb23b7016f51"-        , "d4cb7dd741e78a8f57e12f6c8ddb0361ff2a5bf9365bd7d7df761060847daf9a"-        , "ddbfa6fdd29d4b47aeaadf82a4bf0a93d58cd7d8401fabf860a1ae8eeb51f42e"-        , "9d82bafe44abee248b968c86f165051c8413482c232659795335c52922dab471"-        , "86035372d31b53efd848cea7231aa9738c209aff64d3c59b1619341afb5b6ba3"-        , "11e7a7393d9658813dfaebc04fa6d4b73bac8d641bffa7067da879523d43d030"-        , "2f676b9aa5bc0ebf3395032c84c466e40cac29f80434cd1138e31c2d0fcc5c13"-        , "37567d559fbfae07fda9a90de0ce30b202128bc8ebdfef5ad2b53e865a3478c2"-        , "0b8e6c1200c454361e94e261738429e9c9b8dcffd85ec8511bbf5dc7e2e0ada8"-        ]-      )-      -- Block 00000000839a8e6886ab5951d76f411475428afc90947ee320161bbf18eb6048-    , ( "0e3e2357e806b6cdb1f70b54c3a3a17b6714ee1f0e68bebb44a74b1efd512098"-      , [ "0e3e2357e806b6cdb1f70b54c3a3a17b6714ee1f0e68bebb44a74b1efd512098" ]-      )-      -- Block 000000000004d160ac1f7b775d7c1823345aeadd5fcb29ca2ad2403bb7babd4c-    , ( "aae018650f513fc42d55b2210ec3ceeeb194fb1261d37989de07451fc0cbac5c"-      , [ "a4454f22831acd7904a9902c5070a3ee4bf4c2b13bc6b2dc66735dd3c4414028"-        , "45297f334278885108dd38a0b689ed95a4373dd3f7e4413e6aebdc2654fb771b"-        ]-      )-      -- Block 000000000001d1b13a7e86ddb20da178f20d6da5cd037a29c2a15b8b84cc774e-    , ( "ca3580505feb87544760ac14a5859659e23be05f765bbed9f86a3c9aad1a5d0c"-      , [ "60702384c6e9d34ff03c2b3e726bdc649befe603216815bd0a2974921d0d9549"-        , "11f40f58941d2a81a1616a3b84b7dd8b9d07e68750827de488c11a18f54220bb"-        , "d78e82527aa8cf16e375010bc666362c0258d3c0da1885a1871121706da8b633"-        ]-      )-      -- Block 0000000000000630a4e2266a31776e952a19b7c99a6387917d9de9032f608021-    , ( "dcce8be0a9a41e7bb726c5b49d957d90b5308e3dc5dce070ccbc8996e265a6c2"-      , [ "c0f58ff12cd1023b05f8f7035cc62bf50958ddb216a4e0eb5471deb7ef25fe81"-        , "24e5bbf9008641b8fcf3d076fef66c28c695362ba9f6a6042f8275a98414ee92"-        , "e8e1f72abad5e34dabc0f6de46a484b17a9af857d1c41de19482fadf6f7f4b27"-        , "540e4d34d9fd9e5ec02853054be7ad9260379bc23388489049cca1b0f7cf518a"-        , "324444835c5fe0545f98c4240011b75e6ea1bb76f41829e4cfbe7f75b6cee924"-        , "e7d31437ac21bceb0c222a82b2723e2b8a7654147e33397679f041537022a4b2"-        , "a8b5768d8b33525ee89d546a6a6897f8e42ba9d56a2c5e871a5d2ab40258dc95"-        , "7ba712b31bae8d45810a5cda3838c7e7fb9abd6e88bb4b3ee79be9ea2f714bb4"-        , "2ae1c4d927b06edaa626b230976ad8062bbae24da9378d1de2409da5ab08a26d"-        , "3c417dc8087d6878003624b74431e17fec9ca761389034b1b1e0f32cbfb11f4f"-        , "de6de7beae8d8c98c7d46b4409d5460e58e3204d8b4caed256c7471998595909"-        , "c7c3c211402b7c4379f7b01fadc67260ee58d11e8d0bcce3d68cb45f3467e99d"-        , "77aa2717e727a096d81074bd46ae59462692d20a1acc1a01b2535518ae5aeb53"-        , "4859a710bb673aca46208bbd59d1000ae990dafff5f70b56f0853aeeaea3948b"-        , "38deca6991988e461b83aa0d49ffef0f304c4b760371682d152eeb8c56a48174"-        , "648f4f50dada3574e2dfe2dc68956b01dd97d543859a3540bbe1ef5418d0e494"-        , "9cd7be42c2f0cd8bf38738c162cd05108e213ec7958bf2571cb627872963f5c4"-        , "6740e0dd8b97e23864af41839fc197238d2f0dbefce9a82c657556be65c465fa"-        , "f75c2e4b70db4b0aabc44b77af1ae75d305340fcf6e7b5f806ddcba4aa42b55d"-        , "e125c488636749da68e6696b97525a77146c0777c7946927e37afd513d74a4e6"-        , "c20526f119aea10880af631eba7f0b60385a22e0b0c402fe8508d41952e58be9"-        , "6456c023c7e245f5c57a168633a23f57f4fadb651115f807694a6bed14ae3b55"-        , "98b26e364e2888c9f264e4b5e13103c89608609774eb07ce933d8a2a45d19776"-        , "2efaa4f167bb65ba5684f8076cd9279fd67fd9c67388c8862809bab5542e637d"-        , "ec44eeb84d8d976d77079a822710b4dfdb11a2d9a03d8cc00bab0ae424e84666"-        , "410730d9f807d81ac48b8eafac6f1d36642c1c370241b367a35f0bac6ac7c05f"-        , "e95a7d0d477fd3db22756a3fd390a50c7bc48dc9e946fea9d24bd0866b3bb0e9"-        , "a72fec99d14939216628aaf7a0afc4c017113bcae964e777e6b508864eeaacc4"-        , "8548433310fcf75dbbc042121e8318c678e0a017534786dd322a91cebe8d213f"-        ]-      )-    ]--testID :: (FromJSON a, ToJSON a, Eq a) => a -> Bool-testID x =-    (A.decode . A.encode) (singleton ("object" :: String) x) ==-    Just (singleton ("object" :: String) x)--cerealID :: (Serialize a, Eq a) => a -> Bool-cerealID x = S.decode (S.encode x) == Right x--testSubsidy :: Network -> Assertion-testSubsidy net = go (2 * 50 * 100 * 1000 * 1000) 0-  where-    go previous_subsidy halvings = do-        let height = halvings * getHalvingInterval net-            subsidy = computeSubsidy net height-        if halvings >= 64-            then subsidy `shouldBe` 0-            else do-                subsidy `shouldBe` (previous_subsidy `div` 2)-                go subsidy (halvings + 1)
− test/Network/Haskoin/Crypto/HashSpec.hs 
@@ -1,1269 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}-module Network.Haskoin.Crypto.HashSpec (spec) where--import           Data.ByteString         (ByteString)-import           Data.Map.Strict         (singleton)-import           Data.Maybe              (fromJust)-import           Data.Serialize          as S-import           Data.String             (fromString)-import           Data.String.Conversions-import           Network.Haskoin.Block-import           Network.Haskoin.Crypto-import           Network.Haskoin.Test-import           Network.Haskoin.Util-import           Test.Hspec-import           Test.HUnit              (Assertion, assertBool)-import           Test.QuickCheck---- Test vectors from NIST--- http://csrc.nist.gov/groups/STM/cavp/documents/drbg/drbgtestvectors.zip--- About 1/3 of HMAC DRBG SHA-256 test vectors are tested here--spec :: Spec-spec =-    describe "hash" $ do-        it "join512( split512(h) ) == h" $-            property $-            forAll arbitraryHash256 $ forAll arbitraryHash256 . joinSplit512-        it "decodeCompact . encodeCompact i == i" $ property decEncCompact-        it "from string 64-byte hash" $-            property $-            forAll arbitraryHash512 $ \h ->-                fromString (cs $ encodeHex $ encode h) == h-        it "from string 32-byte hash" $-            property $-            forAll arbitraryHash256 $ \h ->-                fromString (cs $ encodeHex $ encode h) == h-        it "from string 20-byte hash" $-            property $-            forAll arbitraryHash160 $ \h ->-                fromString (cs $ encodeHex $ encode h) == h-        it "encodes and decodes bytestring" $-            property $ forAll arbitraryBS cerealID-        it "encodes and decodes hash160" $-            property $ forAll arbitraryHash160 cerealID-        it "encodes and decodes hash256" $-            property $ forAll arbitraryHash256 cerealID-        it "encodes and decodes hash512" $-            property $ forAll arbitraryHash512 cerealID--type TestVector = [ByteString]--{--    [SHA-256]-    [PredictionResistance = False]-    [EntropyInputLen = 256]-    [NonceLen = 128]-    [PersonalizationStringLen = 0]-    [AdditionalInputLen = 0]-    [ReturnedBitsLen = 1024]--}--joinSplit512 :: Hash256 -> Hash256 -> Bool-joinSplit512 a b = split512 (join512 (a, b)) == (a, b)---- After encoding and decoding, we may loose precision so the new result is >=--- to the old one.-decEncCompact :: Integer -> Bool-decEncCompact i-    -- Integer completely fits inside the mantisse-    | abs i <= 0x007fffff = decodeCompact (encodeCompact i) == (i, False)-    -- Otherwise precision will be lost and the decoded result will-    -- be smaller than the original number-    | i >= 0              = fst (decodeCompact (encodeCompact i)) < i-    | otherwise           = fst (decodeCompact (encodeCompact i)) > i--cerealID :: (Serialize a, Eq a) => a -> Bool-cerealID x = decode (encode x) == Right x--t1 :: [TestVector]-t1 =-    [-    -- COUNT = 0-    [ "ca851911349384bffe89de1cbdc46e6831e44d34a4fb935ee285dd14b71a7488"-    , "659ba96c601dc69fc902940805ec0ca8"-    , ""-    , ""-    , ""-    , "e528e9abf2dece54d47c7e75e5fe302149f817ea9fb4bee6f4199697d04d5b89d54fbb978a15b5c443c9ec21036d2460b6f73ebad0dc2aba6e624abf07745bc107694bb7547bb0995f70de25d6b29e2d3011bb19d27676c07162c8b5ccde0668961df86803482cb37ed6d5c0bb8d50cf1f50d476aa0458bdaba806f48be9dcb8"-    ],-    -- COUNT = 1-    [ "79737479ba4e7642a221fcfd1b820b134e9e3540a35bb48ffae29c20f5418ea3"-    , "3593259c092bef4129bc2c6c9e19f343"-    , ""-    , ""-    , ""-    , "cf5ad5984f9e43917aa9087380dac46e410ddc8a7731859c84e9d0f31bd43655b924159413e2293b17610f211e09f770f172b8fb693a35b85d3b9e5e63b1dc252ac0e115002e9bedfb4b5b6fd43f33b8e0eafb2d072e1a6fee1f159df9b51e6c8da737e60d5032dd30544ec51558c6f080bdbdab1de8a939e961e06b5f1aca37"-    ],-    -- COUNT = 2-    [ "b340907445b97a8b589264de4a17c0bea11bb53ad72f9f33297f05d2879d898d"-    , "65cb27735d83c0708f72684ea58f7ee5"-    , ""-    , ""-    , ""-    , "75183aaaf3574bc68003352ad655d0e9ce9dd17552723b47fab0e84ef903694a32987eeddbdc48efd24195dbdac8a46ba2d972f5808f23a869e71343140361f58b243e62722088fe10a98e43372d252b144e00c89c215a76a121734bdc485486f65c0b16b8963524a3a70e6f38f169c12f6cbdd169dd48fe4421a235847a23ff"-    ],-    -- COUNT = 3-    [ "8e159f60060a7d6a7e6fe7c9f769c30b98acb1240b25e7ee33f1da834c0858e7"-    , "c39d35052201bdcce4e127a04f04d644"-    , ""-    , ""-    , ""-    , "62910a77213967ea93d6457e255af51fc79d49629af2fccd81840cdfbb4910991f50a477cbd29edd8a47c4fec9d141f50dfde7c4d8fcab473eff3cc2ee9e7cc90871f180777a97841597b0dd7e779eff9784b9cc33689fd7d48c0dcd341515ac8fecf5c55a6327aea8d58f97220b7462373e84e3b7417a57e80ce946d6120db5"-    ],-    -- COUNT = 4-    [ "74755f196305f7fb6689b2fe6835dc1d81484fc481a6b8087f649a1952f4df6a"-    , "c36387a544a5f2b78007651a7b74b749"-    , ""-    , ""-    , ""-    , "b2896f3af4375dab67e8062d82c1a005ef4ed119d13a9f18371b1b873774418684805fd659bfd69964f83a5cfe08667ddad672cafd16befffa9faed49865214f703951b443e6dca22edb636f3308380144b9333de4bcb0735710e4d9266786342fc53babe7bdbe3c01a3addb7f23c63ce2834729fabbd419b47beceb4a460236"-    ],-    -- COUNT = 5-    [ "4b222718f56a3260b3c2625a4cf80950b7d6c1250f170bd5c28b118abdf23b2f"-    , "7aed52d0016fcaef0b6492bc40bbe0e9"-    , ""-    , ""-    , ""-    , "a6da029b3665cd39fd50a54c553f99fed3626f4902ffe322dc51f0670dfe8742ed48415cf04bbad5ed3b23b18b7892d170a7dcf3ef8052d5717cb0c1a8b3010d9a9ea5de70ae5356249c0e098946030c46d9d3d209864539444374d8fbcae068e1d6548fa59e6562e6b2d1acbda8da0318c23752ebc9be0c1c1c5b3cf66dd967"-    ],-    -- COUNT = 6-    [ "b512633f27fb182a076917e39888ba3ff35d23c3742eb8f3c635a044163768e0"-    , "e2c39b84629a3de5c301db5643af1c21"-    , ""-    , ""-    , ""-    , "fb931d0d0194a97b48d5d4c231fdad5c61aedf1c3a55ac24983ecbf38487b1c93396c6b86ff3920cfa8c77e0146de835ea5809676e702dee6a78100da9aa43d8ec0bf5720befa71f82193205ac2ea403e8d7e0e6270b366dc4200be26afd9f63b7e79286a35c688c57cbff55ac747d4c28bb80a2b2097b3b62ea439950d75dff"-    ],-    -- COUNT = 7-    [ "aae3ffc8605a975befefcea0a7a286642bc3b95fb37bd0eb0585a4cabf8b3d1e"-    , "9504c3c0c4310c1c0746a036c91d9034"-    , ""-    , ""-    , ""-    , "2819bd3b0d216dad59ddd6c354c4518153a2b04374b07c49e64a8e4d055575dfbc9a8fcde68bd257ff1ba5c6000564b46d6dd7ecd9c5d684fd757df62d85211575d3562d7814008ab5c8bc00e7b5a649eae2318665b55d762de36eba00c2906c0e0ec8706edb493e51ca5eb4b9f015dc932f262f52a86b11c41e9a6d5b3bd431"-    ],-    -- COUNT = 8-    [ "b9475210b79b87180e746df704b3cbc7bf8424750e416a7fbb5ce3ef25a82cc6"-    , "24baf03599c10df6ef44065d715a93f7"-    , ""-    , ""-    , ""-    , "ae12d784f796183c50db5a1a283aa35ed9a2b685dacea97c596ff8c294906d1b1305ba1f80254eb062b874a8dfffa3378c809ab2869aa51a4e6a489692284a25038908a347342175c38401193b8afc498077e10522bec5c70882b7f760ea5946870bd9fc72961eedbe8bff4fd58c7cc1589bb4f369ed0d3bf26c5bbc62e0b2b2"-    ],-    -- COUNT = 9-    [ "27838eb44ceccb4e36210703ebf38f659bc39dd3277cd76b7a9bcd6bc964b628"-    , "39cfe0210db2e7b0eb52a387476e7ea1"-    , ""-    , ""-    , ""-    , "e5e72a53605d2aaa67832f97536445ab774dd9bff7f13a0d11fd27bf6593bfb52309f2d4f09d147192199ea584503181de87002f4ee085c7dc18bf32ce5315647a3708e6f404d6588c92b2dda599c131aa350d18c747b33dc8eda15cf40e95263d1231e1b4b68f8d829f86054d49cfdb1b8d96ab0465110569c8583a424a099a"-    ],-    -- COUNT = 10-    [ "d7129e4f47008ad60c9b5d081ff4ca8eb821a6e4deb91608bf4e2647835373a5"-    , "a72882773f78c2fc4878295840a53012"-    , ""-    , ""-    , ""-    , "0cbf48585c5de9183b7ff76557f8fc9ebcfdfde07e588a8641156f61b7952725bbee954f87e9b937513b16bba0f2e523d095114658e00f0f3772175acfcb3240a01de631c19c5a834c94cc58d04a6837f0d2782fa53d2f9f65178ee9c837222494c799e64c60406069bd319549b889fa00a0032dd7ba5b1cc9edbf58de82bfcd"-    ],-    -- COUNT = 11-    [ "67fe5e300c513371976c80de4b20d4473889c9f1214bce718bc32d1da3ab7532"-    , "e256d88497738a33923aa003a8d7845c"-    , ""-    , ""-    , ""-    , "b44660d64ef7bcebc7a1ab71f8407a02285c7592d755ae6766059e894f694373ed9c776c0cfc8594413eefb400ed427e158d687e28da3ecc205e0f7370fb089676bbb0fa591ec8d916c3d5f18a3eb4a417120705f3e2198154cd60648dbfcfc901242e15711cacd501b2c2826abe870ba32da785ed6f1fdc68f203d1ab43a64f"-    ],-    -- COUNT = 12-    [ "de8142541255c46d66efc6173b0fe3ffaf5936c897a3ce2e9d5835616aafa2cb"-    , "d01f9002c407127bc3297a561d89b81d"-    , ""-    , ""-    , ""-    , "64d1020929d74716446d8a4e17205d0756b5264867811aa24d0d0da8644db25d5cde474143c57d12482f6bf0f31d10af9d1da4eb6d701bdd605a8db74fb4e77f79aaa9e450afda50b18d19fae68f03db1d7b5f1738d2fdce9ad3ee9461b58ee242daf7a1d72c45c9213eca34e14810a9fca5208d5c56d8066bab1586f1513de7"-    ],-    -- COUNT = 13-    [ "4a8e0bd90bdb12f7748ad5f147b115d7385bb1b06aee7d8b76136a25d779bcb7"-    , "7f3cce4af8c8ce3c45bdf23c6b181a00"-    , ""-    , ""-    , ""-    , "320c7ca4bbeb7af977bc054f604b5086a3f237aa5501658112f3e7a33d2231f5536d2c85c1dad9d9b0bf7f619c81be4854661626839c8c10ae7fdc0c0b571be34b58d66da553676167b00e7d8e49f416aacb2926c6eb2c66ec98bffae20864cf92496db15e3b09e530b7b9648be8d3916b3c20a3a779bec7d66da63396849aaf"-    ],-    -- COUNT = 14-    [ "451ed024bc4b95f1025b14ec3616f5e42e80824541dc795a2f07500f92adc665"-    , "2f28e6ee8de5879db1eccd58c994e5f0"-    , ""-    , ""-    , ""-    , "3fb637085ab75f4e95655faae95885166a5fbb423bb03dbf0543be063bcd48799c4f05d4e522634d9275fe02e1edd920e26d9accd43709cb0d8f6e50aa54a5f3bdd618be23cf73ef736ed0ef7524b0d14d5bef8c8aec1cf1ed3e1c38a808b35e61a44078127c7cb3a8fd7addfa50fcf3ff3bc6d6bc355d5436fe9b71eb44f7fd"-    ]-    ]--{--    [SHA-256]-    [PredictionResistance = False]-    [EntropyInputLen = 256]-    [NonceLen = 128]-    [PersonalizationStringLen = 0]-    [AdditionalInputLen = 256]-    [ReturnedBitsLen = 1024]--}--t2 :: [TestVector]-t2 =-    [-    -- COUNT = 0-    [ "d3cc4d1acf3dde0c4bd2290d262337042dc632948223d3a2eaab87da44295fbd"-    , "0109b0e729f457328aa18569a9224921"-    , ""-    , "3c311848183c9a212a26f27f8c6647e40375e466a0857cc39c4e47575d53f1f6"-    , "fcb9abd19ccfbccef88c9c39bfb3dd7b1c12266c9808992e305bc3cff566e4e4"-    , "9c7b758b212cd0fcecd5daa489821712e3cdea4467b560ef5ddc24ab47749a1f1ffdbbb118f4e62fcfca3371b8fbfc5b0646b83e06bfbbab5fac30ea09ea2bc76f1ea568c9be0444b2cc90517b20ca825f2d0eccd88e7175538b85d90ab390183ca6395535d34473af6b5a5b88f5a59ee7561573337ea819da0dcc3573a22974"-    ],-    -- COUNT = 1-    [ "f97a3cfd91faa046b9e61b9493d436c4931f604b22f1081521b3419151e8ff06"-    , "11f3a7d43595357d58120bd1e2dd8aed"-    , ""-    , "517289afe444a0fe5ed1a41dbbb5eb17150079bdd31e29cf2ff30034d8268e3b"-    , "88028d29ef80b4e6f0fe12f91d7449fe75062682e89c571440c0c9b52c42a6e0"-    , "c6871cff0824fe55ea7689a52229886730450e5d362da5bf590dcf9acd67fed4cb32107df5d03969a66b1f6494fdf5d63d5b4d0d34ea7399a07d0116126d0d518c7c55ba46e12f62efc8fe28a51c9d428e6d371d7397ab319fc73ded4722e5b4f30004032a6128df5e7497ecf82ca7b0a50e867ef6728a4f509a8c859087039c"-    ],-    -- COUNT = 2-    [ "0f2f23d64f481cabec7abb01db3aabf125c3173a044b9bf26844300b69dcac8b"-    , "9a5ae13232b43aa19cfe8d7958b4b590"-    , ""-    , "ec4c7a62acab73385f567da10e892ff395a0929f959231a5628188ce0c26e818"-    , "6b97b8c6b6bb8935e676c410c17caa8042aa3145f856d0a32b641e4ae5298648"-    , "7480a361058bd9afa3db82c9d7586e42269102013f6ec5c269b6d05f17987847748684766b44918fd4b65e1648622fc0e0954178b0279dfc9fa99b66c6f53e51c4860131e9e0644287a4afe4ca8e480417e070db68008a97c3397e4b320b5d1a1d7e1d18a95cfedd7d1e74997052bf649d132deb9ec53aae7dafdab55e6dae93"-    ],-    -- COUNT = 3-    [ "53c56660c78481be9c63284e005fcc14fbc7fb27732c9bf1366d01a426765a31"-    , "dc7a14d0eb5b0b3534e717a0b3c64614"-    , ""-    , "3aa848706ecb877f5bedf4ffc332d57c22e08747a47e75cff6f0fd1316861c95"-    , "9a401afa739b8f752fddacd291e0b854f5eff4a55b515e20cb319852189d3722"-    , "5c0eb420e0bf41ce9323e815310e4e8303cd677a8a8b023f31f0d79f0ca15aeb636099a369fd074d69889865eac1b72ab3cbfebdb8cf460b00072802e2ec648b1349a5303be4ccaadd729f1a9ea17482fd026aaeb93f1602bc1404b9853adde40d6c34b844cf148bc088941ecfc1642c8c0b9778e45f3b07e06e21ee2c9e0300"-    ],-    -- COUNT = 4-    [ "f63c804404902db334c54bb298fc271a21d7acd9f770278e089775710bf4fdd7"-    , "3e45009ea9cb2a36ba1aa4bf39178200"-    , ""-    , "d165a13dc8cc43f3f0952c3f5d3de4136954d983683d4a3e6d2dc4c89bf23423"-    , "75106bc86d0336df85097f6af8e80e2da59046a03fa65b06706b8bbc7ffc6785"-    , "6363139bba32c22a0f5cd23ca6d437b5669b7d432f786b8af445471bee0b2d24c9d5f2f93717cbe00d1f010cc3b9c515fc9f7336d53d4d26ba5c0d76a90186663c8582eb739c7b6578a3328bf68dc2cec2cd89b3a90201f6993adcc854df0f5c6974d0f5570765a15fe03dbce28942dd2fd16ba2027e68abac83926969349af8"-    ],-    -- COUNT = 5-    [ "2aaca9147da66c176615726b69e3e851cc3537f5f279fe7344233d8e44cfc99d"-    , "4e171f080af9a6081bee9f183ac9e340"-    , ""-    , "d75a2a6eb66c3833e50f5ec3d2e434cf791448d618026d0c360806d120ded669"-    , "b643b74c15b37612e6577ed7ca2a4c67a78d560af9eb50a4108fca742e87b8d6"-    , "501dcdc977f4ba856f24eaa4968b374bebb3166b280334cb510232c31ebffde10fa47b7840ef3fe3b77725c2272d3a1d4219baf23e0290c622271edcced58838cf428f0517425d2e19e0d8c89377eecfc378245f283236fafa466c914b99672ceafab369e8889a0c866d8bd639db9fb797254262c6fd44cfa9045ad6340a60ef"-    ],-    -- COUNT = 6-    [ "a2e4cd48a5cf918d6f55942d95fcb4e8465cdc4f77b7c52b6fae5b16a25ca306"-    , "bef036716440db6e6d333d9d760b7ca8"-    , ""-    , "bfa591c7287f3f931168f95e38869441d1f9a11035ad8ea625bb61b9ea17591c"-    , "c00c735463bca215adc372cb892b05e939bf669583341c06d4e31d0e5b363a37"-    , "e7d136af69926a5421d4266ee0420fd729f2a4f7c295d3c966bdfa05268180b508b8a2852d1b3a06fd2ab3e13c54005123ef319f42d0c6d3a575e6e7e1496cb28aacadbcf83740fba8f35fcee04bb2ed8a51db3d3362b01094a62fb57e33c99a432f29fce6676cffbbcc05107e794e75e44a02d5e6d9d748c5fbff00a0178d65"-    ],-    -- COUNT = 7-    [ "95a67771cba69011a79776e713145d309edae56fad5fd6d41d83eaff89df6e5e"-    , "be5b5164e31ecc51ba6f7c3c5199eb33"-    , ""-    , "065f693b229a7c4fd373cd15b3807552dd9bf98c5485cef361949d4e7d774b53"-    , "9afb62406f0e812c4f156d58b19a656c904813c1b4a45a0029ae7f50731f8014"-    , "f61b61a6e79a41183e8ed6647899d2dc85cdaf5c3abf5c7f3bf37685946dc28f4923dc842f2d4326bd6ce0d50a84cb3ba869d72a36e246910eba6512ba36cd7ed3a5437c9245b00a344308c792b668b458d3c3e16dee2fbec41867da31084d46d8ec168de2148ef64fc5b72069abf5a6ada1ead2b7146bb793ff1c9c3690fa56"-    ],-    -- COUNT = 8-    [ "a459e1815cbca4514ec8094d5ab2414a557ba6fe10e613c345338d0521e4bf90"-    , "62221392e2552e76cd0d36df6e6068eb"-    , ""-    , "0a3642b02b23b3ef62c701a63401124022f5b896de86dab6e6c7451497aa1dcc"-    , "c80514865901371c45ba92d9f95d50bb7c9dd1768cb3dfbc45b968da94965c6e"-    , "464e6977b8adaef307c9623e41c357013249c9ffd77f405f3925cebb69f151ce8fbb6a277164002aee7858fc224f6499042aa1e6322deee9a5d133c31d640e12a7487c731ba03ad866a24675badb1d79220c40be689f79c2a0be93cb4dada3e0eac4ab140cb91998b6f11953e68f2319b050c40f71c34de9905ae41b2de1c2f6"-    ],-    -- COUNT = 9-    [ "252c2cad613e002478162861880979ee4e323025eebb6fb2e0aa9f200e28e0a1"-    , "d001bc9a8f2c8c242e4369df0c191989"-    , ""-    , "9bcfc61cb2bc000034bb3db980eb47c76fb5ecdd40553eff113368d639b947fd"-    , "8b0565c767c2610ee0014582e9fbecb96e173005b60e9581503a6dca5637a26e"-    , "e96c15fe8a60692b0a7d67171e0195ff6e1c87aab844221e71700d1bbee75feea695f6a740c9760bbe0e812ecf4061d8f0955bc0195e18c4fd1516ebca50ba6a6db86881737dbab8321707675479b87611db6af2c97ea361a5484555ead454defb1a64335de964fc803d40f3a6f057893d2afc25725754f4f00abc51920743dc"-    ],-    -- COUNT = 10-    [ "8be0ca6adc8b3870c9d69d6021bc1f1d8eb9e649073d35ee6c5aa0b7e56ad8a5"-    , "9d1265f7d51fdb65377f1e6edd6ae0e4"-    , ""-    , "da86167ac997c406bb7979f423986a84ec6614d6caa7afc10aff0699a9b2cf7f"-    , "e4baa3c555950b53e2bfdba480cb4c94b59381bac1e33947e0c22e838a9534cf"-    , "64384ecc4ea6b458efc227ca697eac5510092265520c0a0d8a0ccf9ed3ca9d58074671188c6a7ad16d0b050cdc072c125d7298d3a31d9f044a9ee40da0089a84fea28cc7f05f1716db952fad29a0e779635cb7a912a959be67be2f0a4170aace2981802e2ff6467e5b46f0ffbff3b42ba5935fd553c82482ac266acf1cd247d7"-    ],-    -- COUNT = 11-    [ "d43a75b6adf26d60322284cb12ac38327792442aa8f040f60a2f331b33ac4a8f"-    , "0682f8b091f811afacaacaec9b04d279"-    , ""-    , "7fd3b8f512940da7de5d80199d9a7b42670c04a945775a3dba869546cbb9bc65"-    , "2575db20bc7aafc2a90a5dabab760db851d754777bc9f05616af1858b24ff3da"-    , "0da7a8dc73c163014bf0841913d3067806456bbca6d5de92b85534c6545467313648d71ef17c923d090dc92cff8d4d1a9a2bb63e001dc2e8ab1a597999be3d6cf70ff63fee9985801395fbd4f4990430c4259fcae4fa1fcd73dc3187ccc102d04af7c07532885e5a226fc42809c48f22eecf4f6ab996ae4fcb144786957d9f41"-    ],-    -- COUNT = 12-    [ "64352f236af5d32067a529a8fd05ba00a338c9de306371a0b00c36e610a48d18"-    , "df99ed2c7608c870624b962a5dc68acd"-    , ""-    , "da416335e7aaf60cf3d06fb438735ce796aad09034f8969c8f8c3f81e32fef24"-    , "a28c07c21a2297311adf172c19e83ca0a87731bdffb80548978d2d1cd82cf8a3"-    , "132b9f25868729e3853d3c51f99a3b5fae6d4204bea70890daf62e042b776a526c8fb831b80a6d5d3f153237df1fd39b6fd9137963f5516d9cdd4e3f9195c46e9972c15d3edc6606e3368bde1594977fb88d0ca6e6f5f3d057ccadc7d7dab77dfc42658a1e972aa446b20d418286386a52dfc1c714d2ac548713268b0b709729"-    ],-    -- COUNT = 13-    [ "282f4d2e05a2cd30e9087f5633089389449f04bac11df718c90bb351cd3653a5"-    , "90a7daf3c0de9ea286081efc4a684dfb"-    , ""-    , "2630b4ccc7271cc379cb580b0aaede3d3aa8c1c7ba002cf791f0752c3d739007"-    , "c31d69de499f1017be44e3d4fa77ecebc6a9b9934749fcf136f267b29115d2cc"-    , "c899094520e0197c37b91dd50778e20a5b950decfb308d39f1db709447ae48f6101d9abe63a783fbb830eec1d359a5f61a2013728966d349213ee96382614aa4135058a967627183810c6622a2158cababe3b8ab99169c89e362108bf5955b4ffc47440f87e4bad0d36bc738e737e072e64d8842e7619f1be0af1141f05afe2d"-    ],-    -- COUNT = 14-    [ "13c752b9e745ce77bbc7c0dbda982313d3fe66f903e83ebd8dbe4ff0c11380e9"-    , "f1a533095d6174164bd7c82532464ae7"-    , ""-    , "4f53db89b9ba7fc00767bc751fb8f3c103fe0f76acd6d5c7891ab15b2b7cf67c"-    , "582c2a7d34679088cca6bd28723c99aac07db46c332dc0153d1673256903b446"-    , "6311f4c0c4cd1f86bd48349abb9eb930d4f63df5e5f7217d1d1b91a71d8a6938b0ad2b3e897bd7e3d8703db125fab30e03464fad41e5ddf5bf9aeeb5161b244468cfb26a9d956931a5412c97d64188b0da1bd907819c686f39af82e91cfeef0cbffb5d1e229e383bed26d06412988640706815a6e820796876f416653e464961"-    ]-    ]--{--    [SHA-256]-    [PredictionResistance = False]-    [EntropyInputLen = 256]-    [NonceLen = 128]-    [PersonalizationStringLen = 256]-    [AdditionalInputLen = 0]-    [ReturnedBitsLen = 1024]--}--t3 :: [TestVector]-t3 =-    [-    -- COUNT = 0-    [ "5cacc68165a2e2ee20812f35ec73a79dbf30fd475476ac0c44fc6174cdac2b55"-    , "6f885496c1e63af620becd9e71ecb824"-    , "e72dd8590d4ed5295515c35ed6199e9d211b8f069b3058caa6670b96ef1208d0"-    , ""-    , ""-    , "f1012cf543f94533df27fedfbf58e5b79a3dc517a9c402bdbfc9a0c0f721f9d53faf4aafdc4b8f7a1b580fcaa52338d4bd95f58966a243cdcd3f446ed4bc546d9f607b190dd69954450d16cd0e2d6437067d8b44d19a6af7a7cfa8794e5fbd728e8fb2f2e8db5dd4ff1aa275f35886098e80ff844886060da8b1e7137846b23b"-    ],-    -- COUNT = 1-    [ "8df013b4d103523073917ddf6a869793059e9943fc8654549e7ab22f7c29f122"-    , "da2625af2ddd4abcce3cf4fa4659d84e"-    , "b571e66d7c338bc07b76ad3757bb2f9452bf7e07437ae8581ce7bc7c3ac651a9"-    , ""-    , ""-    , "b91cba4cc84fa25df8610b81b641402768a2097234932e37d590b1154cbd23f97452e310e291c45146147f0da2d81761fe90fba64f94419c0f662b28c1ed94da487bb7e73eec798fbcf981b791d1be4f177a8907aa3c401643a5b62b87b89d66b3a60e40d4a8e4e9d82af6d2700e6f535cdb51f75c321729103741030ccc3a56"-    ],-    -- COUNT = 2-    [ "565b2b77937ba46536b0f693b3d5e4a8a24563f9ef1f676e8b5b2ef17823832f"-    , "4ef3064ec29f5b7f9686d75a23d170e3"-    , "3b722433226c9dba745087270ab3af2c909425ba6d39f5ce46f07256068319d9"-    , ""-    , ""-    , "d144ee7f8363d128872f82c15663fe658413cd42651098e0a7c51a970de75287ec943f9061e902280a5a9e183a7817a44222d198fbfab184881431b4adf35d3d1019da5a90b3696b2349c8fba15a56d0f9d010a88e3f9eeedb67a69bcaa71281b41afa11af576b765e66858f0eb2e4ec4081609ec81da81df0a0eb06787340ea"-    ],-    -- COUNT = 3-    [ "fc3832a91b1dcdcaa944f2d93cbceb85c267c491b7b59d017cde4add79a836b6"-    , "d5e76ce9eabafed06e33a913e395c5e0"-    , "ffc5f6eefd51da64a0f67b5f0cf60d7ab43fc7836bca650022a0cee57a43c148"-    , ""-    , ""-    , "0e713c6cc9a4dbd4249201d12b7bf5c69c3e18eb504bf3252db2f43675e17d99b6a908400cea304011c2e54166dae1f20260008efe4e06a87e0ce525ca482bca223a902a14adcf2374a739a5dfeaf14cadd72efa4d55d15154c974d9521535bcb70658c5b6c944020afb04a87b223b4b8e5d89821704a9985bb010405ba8f3d4"-    ],-    -- COUNT = 4-    [ "8009eb2cb49fdf16403bcdfd4a9f952191062acb9cc111eca019f957fb9f4451"-    , "355598866952394b1eddd85d59f81c9d"-    , "09ff1d4b97d83b223d002e05f754be480d13ba968e5aac306d71cc9fc49cc2dd"-    , ""-    , ""-    , "9550903c2f02cf77c8f9c9a37041d0040ee1e3ef65ba1a1fbbcf44fb7a2172bd6b3aaabe850281c3a1778277bacd09614dfefececac64338ae24a1bf150cbf9d9541173a82ecba08aa19b75abb779eb10efa4257d5252e8afcac414bc3bb5d3006b6f36fb9daea4c8c359ef6cdbeff27c1068571dd3c89dc87eda9190086888d"-    ],-    -- COUNT = 5-    [ "a6e4c9a8bd6da23b9c2b10a7748fd08c4f782fadbac7ea501c17efdc6f6087bd"-    , "acdc47edf1d3b21d0aec7631abb6d7d5"-    , "c16ee0908a5886dccf332fbc61de9ec7b7972d2c4c83c477409ce8a15c623294"-    , ""-    , ""-    , "a52f93ccb363e2bdf0903622c3caedb7cffd04b726052b8d455744c71b76dee1b71db9880dc3c21850489cb29e412d7d80849cfa9151a151dcbf32a32b4a54cac01d3200200ed66a3a5e5c131a49655ffbf1a8824ff7f265690dffb4054df46a707b9213924c631c5bce379944c856c4f7846e281ac89c64fad3a49909dfb92b"-    ],-    -- COUNT = 6-    [ "59d6307460a9bdd392dfc0904973991d585696010a71e52d590a5039b4849fa4"-    , "34a0aafb95917cbf8c38fc5548373c05"-    , "0407b7c57bc11361747c3d67526c36e228028a5d0b145d66ab9a2fe4b07507a0"-    , ""-    , ""-    , "299aba0661315211b09d2861855d0b4b125ab24649461341af6abd903ed6f025223b3299f2126fcad44c675166d800619cf49540946b12138989417904324b0ddad121327211a297f11259c9c34ce4c70c322a653675f78d385e4e2443f8058d141195e17e0bd1b9d44bf3e48c376e6eb44ef020b11cf03eb141c46ecb43cf3d"-    ],-    -- COUNT = 7-    [ "9ae3506aadbc8358696ba1ba17e876e1157b7048235921503d36d9211b430342"-    , "9abf7d66afee5d2b811cba358bbc527d"-    , "0d645f6238e9ceb038e4af9772426ca110c5be052f8673b8b5a65c4e53d2f519"-    , ""-    , ""-    , "5f032c7fec6320fe423b6f38085cbad59d826085afe915247b3d546c4c6b174554dd4877c0d671de9554b505393a44e71f209b70f991ac8aa6e08f983fff2a4c817b0cd26c12b2c929378506489a75b2025b358cb5d0400821e7e252ac6376cd94a40c911a7ed8b6087e3de5fa39fa6b314c3ba1c593b864ce4ff281a97c325b"-    ],-    -- COUNT = 8-    [ "96ae3b8775b36da2a29b889ad878941f43c7d51295d47440cd0e3c4999193109"-    , "1fe022a6fc0237b055d4d6a7036b18d5"-    , "1e40e97362d0a823d3964c26b81ab53825c56446c5261689011886f19b08e5c2"-    , ""-    , ""-    , "e707cd14b06ce1e6dbcceaedbf08d88891b03f44ad6a797bd12fdeb557d0151df9346a028dec004844ca46adec3051dafb345895fa9f4604d8a13c8ff66ae093fa63c4d9c0816d55a0066d31e8404c841e87b6b2c7b5ae9d7afb6840c2f7b441bf2d3d8bd3f40349c1c014347c1979213c76103e0bece26ad7720601eff42275"-    ],-    -- COUNT = 9-    [ "33f5120396336e51ee3b0b619b5f873db05ca57cda86aeae2964f51480d14992"-    , "6f1f6e9807ba5393edcf3cb4e4bb6113"-    , "3709605af44d90196867c927512aa8ba31837063337b4879408d91a05c8efa9f"-    , ""-    , ""-    , "8b8291126ded9acef12516025c99ccce225d844308b584b872c903c7bc6467599a1cead003dc4c70f6d519f5b51ce0da57f53da90dbe8f666a1a1dde297727fee2d44cebd1301fc1ca75956a3fcae0d374e0df6009b668fd21638d2b733e6902d22d5bfb4af1b455975e08eef0ebe4dc87705801e7776583c8de11672729f723"-    ],-    -- COUNT = 10-    [ "ad300b799005f290fee7f930eebce158b98fb6cb449987fe433f955456b35300"-    , "06aa2514e4bd114edf7ac105cfef2772"-    , "87ada711465e4169da2a74c931afb9b5a5b190d07b7af342aa99570401c3ee8a"-    , ""-    , ""-    , "80d7c606ff49415a3a92ba1f2943235c01339c8f9cd0b0511fbfdf3ef23c42ffff008524193faaa4b7f2f2eb0cfa221d9df89bd373fe4e158ec06fad3ecf1eb48b8239b0bb826ee69d773883a3e8edac66254610ff70b6609836860e39ea1f3bfa04596fee1f2baca6cebb244774c6c3eb4af1f02899eba8f4188f91776de16f"-    ],-    -- COUNT = 11-    [ "130b044e2c15ab89375e54b72e7baae6d4cad734b013a090f4df057e634f6ff0"-    , "65fd6ac602cd44107d705dbc066e52b6"-    , "f374aba16f34d54aae5e494505b67d3818ef1c08ea24967a76876d4361379aec"-    , ""-    , ""-    , "5d179534fb0dba3526993ed8e27ec9f915183d967336bb24352c67f4ab5d7935d3168e57008da851515efbaecb69904b6d899d3bfa6e9805659aef2942c4903875b8fcbc0d1d24d1c075f0ff667c1fc240d8b410dff582fa71fa30878955ce2ed786ef32ef852706e62439b69921f26e84e0f54f62b938f04905f05fcd7c2204"-    ],-    -- COUNT = 12-    [ "716430e999964b35459c17921fe5f60e09bd9ab234cb8f4ba4932bec4a60a1d5"-    , "9533b711e061b07d505da707cafbca03"-    , "372ae616d1a1fc45c5aecad0939c49b9e01c93bfb40c835eebd837af747f079d"-    , ""-    , ""-    , "a80d6a1b2d0ce01fe0d26e70fb73da20d45841cf01bfbd50b90d2751a46114c0e758cb787d281a0a9cf62f5c8ce2ee7ca74fefff330efe74926acca6d6f0646e4e3c1a1e52fce1d57b88beda4a5815896f25f38a652cc240deb582921c8b1d03a1da966dd04c2e7eee274df2cd1837096b9f7a0d89a82434076bc30173229a60"-    ],-    -- COUNT = 13-    [ "7679f154296e6d580854826539003a82d1c54e2e062c619d00da6c6ac820789b"-    , "55d12941b0896462e7d888e5322a99a3"-    , "ba4d1ed696f58ef64596c76cee87cc1ca83069a79e7982b9a06f9d62f4209faf"-    , ""-    , ""-    , "10dc7cd2bb68c2c28f76d1b04ae2aa287071e04c3b688e1986b05cc1209f691daa55868ebb05b633c75a40a32b49663185fe5bb8f906008347ef51590530948b87613920014802e5864e0758f012e1eae31f0c4c031ef823aecfb2f8a73aaa946fc507037f9050b277bdeaa023123f9d22da1606e82cb7e56de34bf009eccb46"-    ],-    -- COUNT = 14-    [ "8ca4a964e1ff68753db86753d09222e09b888b500be46f2a3830afa9172a1d6d"-    , "a59394e0af764e2f21cf751f623ffa6c"-    , "eb8164b3bf6c1750a8de8528af16cffdf400856d82260acd5958894a98afeed5"-    , ""-    , ""-    , "fc5701b508f0264f4fdb88414768e1afb0a5b445400dcfdeddd0eba67b4fea8c056d79a69fd050759fb3d626b29adb8438326fd583f1ba0475ce7707bd294ab01743d077605866425b1cbd0f6c7bba972b30fbe9fce0a719b044fcc1394354895a9f8304a2b5101909808ddfdf66df6237142b6566588e4e1e8949b90c27fc1f"-    ]-    ]--{--    [SHA-256]-    [PredictionResistance = False]-    [EntropyInputLen = 256]-    [NonceLen = 128]-    [PersonalizationStringLen = 256]-    [AdditionalInputLen = 256]-    [ReturnedBitsLen = 1024]--}--t4 :: [TestVector]-t4 =-    [-    -- COUNT = 0-    [ "5d3286bc53a258a53ba781e2c4dcd79a790e43bbe0e89fb3eed39086be34174b"-    , "c5422294b7318952ace7055ab7570abf"-    , "2dba094d008e150d51c4135bb2f03dcde9cbf3468a12908a1b025c120c985b9d"-    , "793a7ef8f6f0482beac542bb785c10f8b7b406a4de92667ab168ecc2cf7573c6"-    , "2238cdb4e23d629fe0c2a83dd8d5144ce1a6229ef41dabe2a99ff722e510b530"-    , "d04678198ae7e1aeb435b45291458ffde0891560748b43330eaf866b5a6385e74c6fa5a5a44bdb284d436e98d244018d6acedcdfa2e9f499d8089e4db86ae89a6ab2d19cb705e2f048f97fb597f04106a1fa6a1416ad3d859118e079a0c319eb95686f4cbcce3b5101c7a0b010ef029c4ef6d06cdfac97efb9773891688c37cf"-    ],-    -- COUNT = 1-    [ "c2a566a9a1817b15c5c3b778177ac87c24e797be0a845f11c2fe399dd37732f2"-    , "cb1894eb2b97b3c56e628329516f86ec"-    , "13ce4d8dd2db9796f94156c8e8f0769b0aa1c82c1323b61536603bca37c9ee29"-    , "413dd83fe56835abd478cb9693d67635901c40239a266462d3133b83e49c820b"-    , "d5c4a71f9d6d95a1bedf0bd2247c277d1f84a4e57a4a8825b82a2d097de63ef1"-    , "b3a3698d777699a0dd9fa3f0a9fa57832d3cefac5df24437c6d73a0fe41040f1729038aef1e926352ea59de120bfb7b073183a34106efed6278ff8ad844ba0448115dfddf3319a82de6bb11d80bd871a9acd35c73645e1270fb9fe4fa88ec0e465409ea0cba809fe2f45e04943a2e396bbb7dd2f4e0795303524cc9cc5ea54a1"-    ],-    -- COUNT = 2-    [ "a33288a96f41dd54b945e060c8bd0c094f1e28267cc1dcbba52063c1a9d54c4d"-    , "36918c977e1a7276a2bb475591c367b7"-    , "6aa528c940962638dc2201738850fd1fe6f5d0eb9f687ff1af39d9c7b36830d9"-    , "37ee633a635e43af59abdb1762c7ea45bfe060ec1d9077ecd2a43a658673f3c7"-    , "2eb96f2e28fa9f674bb03ade703b8f791ee5356e2ee85c7ed5bda96325256c61"-    , "db2f91932767eb846961ce5321c7003431870508e8c6f8d432ca1f9cee5cdc1aed6e0f133d317eb6990c4b3b0a360cdfb5b43a6e712bd46bca04c414868fab22c6a49c4b89c812697c3a7fbfc8ddf10c8aa5ebf13a09fd114eb2a02a07f69786f3ce7fd30231f22779bc8db103b13fa546dbc45a89a86275281172761683d384"-    ],-    -- COUNT = 3-    [ "5f37b6e47e1776e735adc03d4b999879477ff4a206231924033d94c0114f911b"-    , "7d12d62c79c9f6234ae0314156947459"-    , "92d4d9fab5f8bf5119f2663a9df7334f50dcde74fb9d7732f7eba56501e60d54"-    , "c9aef0d7a9ba7345d08b6d5b5ce5645c7495b8685e6b93846ffcf470f5abd40d"-    , "50d9d1f5074f7d9f1a24a9c63aa47b94da5ba78db1b0f18e4d4fe45c6875813c"-    , "20d942bbd7d98700faa37e94d53bf74f2d6bd1d8c95c0b88d842c4857797d59e7c8788aeeac29740122f208f703bf35dc32b0035db0648384feb6aa17a3274bc09b2d2b746c5a06fd82f4469fb86131a49482cb7be7d9b4b95042394cfb18b13f333ec0fe5c227bf1d8f33ecb2e42e358b6c3e034cb585331bd1d27f638029b9"-    ],-    -- COUNT = 4-    [ "2311c5afd64c584484b2729e84db80c0b4063fe9ca7edc83350488d7e67264a0"-    , "6a6dfd975a0dc7b72df1f107c4b3b3a6"-    , "2abd870ec5fe26ed14dfa57a3309f920131b70580c3639af2645cd1af93db1b1"-    , "c6e532a3b25653b6002aed5269cc2118749306e736bde039d4d569d4f967773f"-    , "5e7d26c4da769c373092b2b4f72b109fe34bdb7d169ea38f78ebae5df4a15759"-    , "cacaeb1b4ac2305d8714eb50cbe1c67c5a2c0bbc7938fdfdcafef7c85fc40becbf777a4cfb6f14c6eee320943a493d2b0a744a6eb3c256ee9a3763037437df9adce3e2260f0c35e958af0edb5a81debd8bdaf2b8bb2b98b9186e5a222a21609ff58df4cbe1d4898d10d6e7c46f31f5cb1041bfd83a5fb27d5c56c961e91403fc"-    ],-    -- COUNT = 5-    [ "362ece9d330e1172a8f9e50258476d0c79c3ee50346524ba12d970ee3a6ef8c5"-    , "cf11bcb4d9d51311ceacfca8705e833f"-    , "abb5a8edde02e526449284ecc31bc713383df3ed085f752e3b6a32f305861eed"-    , "746302ab1f4a86b17546bea762e929360f2e95c7788a63545a264ef997c8c65e"-    , "b907c5b2a8833a48e56e819228ce9a050b41b3309f5ca37bed720311d92b33af"-    , "73c7131a558350590053580873ef956ff952f2aa6ff1bea452e013d1bc2afddea2311756dbe756e63ba6258480c48f3f6c1319b5f572f67ca530af09e39413d1d432bea8f89206619618cb0e7c88e9f2033639d0eb0efc20616b64f940da99b88231984c3fb23f19e890576f555fde394dbd4351f17a7ffd5c369379001bda03"-    ],-    -- COUNT = 6-    [ "cf614bc29946bc0095f415e8bdeda10aab05392f9cc9187a86ea6ec95ee422e1"-    , "77fb5ec22dc0432cc13f4693e2e3bd9a"-    , "e4ce77914ffbc5fddf1fb51edfafdc196109139b84c741354135ec8d314c7c43"-    , "e1e83ee1205acaf6164dc287aec08e5b32789e5be818078db39e53cad589db51"-    , "4e20c0226d5e1e7e805679f03f72452b5bea2d0ba41e0c12329bf60eb3016dd1"-    , "838fdf1418a746aa52ae4005d90c3fd301f648c5770ffef2a9f3912e37a93850cc4b8bfcce910aead0cb75958823b1a62e283901c5e4a3980e4ea36257458e2e4953555819b8852a26489b1d74821f80c9908469b43f124ff7ea62497c36159a47353098a1b9ec32e54800d6704371cc37f357ad74aacc203e9b6db97f94d0c4"-    ],-    -- COUNT = 7-    [ "a8da1d3e233f393fd44d204c200202f7d01896e72c5ac652940cfd15b5d4b0bd"-    , "0a112b4cb0890af0a495e0f49fcf6874"-    , "d2e32799bc822b8d033299bdf63dc35774f7649e935d25be5b10512c430d1bda"-    , "920a82d76fcd2cd106ada64bba232b7b2344f3afe6b1d1d20ee8795144571009"-    , "eeaac5878275372025f8231febed64db6a11273c3c00d625fc80a95f18ad7d3f"-    , "5f6dae489b53d89027b2cc333c700f090152d77b3eaf01d47f56ce6eca9893ef877b4cb560fab0fbdb34e3d1c6cd8480b33c053d2661a10aa531df4961b97d659c7492584236582b3fe701055efa59c328194cd1e07fcffd910d9ee01b7b9e8c8fda7f7ac01a8e203b8b26eb8078a9b9a5021562c44af24089e3ef84c1d5a6bd"-    ],-    -- COUNT = 8-    [ "a77b1ed4ecaa650374e1052c405f1d88881c25c87d13dbe1334d8c1a847fa76b"-    , "05c143e2f145db216fe7be9ed23635d0"-    , "b5c750968ff09ed251d4a1c05342ac843db5246b19045728a634fa4f6e752e54"-    , "ff5937bcd01a363696bf8e40adc8e4ab3e56dbf7e7d09451c99e538785fe6697"-    , "4acb34eea8266badcf8f6557a0eecf3eb4d7a295c876d6175598cb66a388efb8"-    , "ec13eadfcc84e77d2a2efa1a2cd8b1355587cb27feb3d19d75b37f0446333ddb8236e751c63b7a6e595ec24a25051a696dbe8c062dd8896d1446db228a2f10e8094ee07e7ee648ed6bebb2f5ec5aae24c9c640665c28355cc11c116795ecc070790f7fdfc4398900311b6695d5da0175091ed1828d2731085bfb4a20bd86cce0"-    ],-    -- COUNT = 9-    [ "491686c781e83eb4e21d9989e8d718100b0d21a2c56295888baef1a65f219651"-    , "499085296d21065feabf3106101c8d6f"-    , "d208a72f9ae34f0817669fb04f49239dd31700f3dc9a93db8d75fb79f9b686c1"-    , "9ffc61893a293a864008fdd56d3292600d9e2ec8a1ea8f34ac5931e968905a23"-    , "4ff3a397dfdae0912032a302a5e7a07dceca8d9013a21545689319b7c024cd07"-    , "3c258ebf2203fca3b322ad1b016e21c7f5c148425f81e4fb0a0e462dce9dfa569c37a006527768297a5b68461b08912642a341b88c85597e30e7561206886098c4e2d861f11513f0ffdbbc78d3a2dd60c105abbb33c5e05ae27081b690fb8b3610917aa9bf1a4ad74481b5ff8334f14e5ad6a6a1eb2259476078076fb7e3a992"-    ],-    -- COUNT = 10-    [ "36a5267eeeb5a1a7d46de0f8f9281f73cd9611f01198fdaa78c5315205e5a177"-    , "b66b5337970df36219321badacc624eb"-    , "c2a7b164949da102bece44a423197682ff97627d1fe9654266b8527f64e5b386"-    , "a977e2d8637b019c74063d163bb25387dc56f4eb40e502cefc5ae6ad26a6abdc"-    , "c5c9819557b1e7d8a86fa8c60be42993edc3ef539c13d9a51fb64b0de06e145e"-    , "b471711a4fc7ab7247e65d2c2fe49a50169187187b7978cd2fdb0f8318be3ec55fc68ed4577ad9b42cbb57100b5d35ac86c244c4c93a5b28c1a11c2dfe905d608ec7804dec5bb15cf8d79695534d5e13a6a7e18a887ec9cf184da0cbbc6267f3a952a769403bafcdbb559401be0d8b3300ea7258b4026fc892175efd55ba1a67"-    ],-    -- COUNT = 11-    [ "a76b0366df89e4073a6b6b9c04da1d6817ce26f1c4825cad4097bdf4d7b9445e"-    , "773d3cc3290176773847869be528d1a4"-    , "1bfd3bcfb9287a5ad055d1b2b8615fa81c94ac24bc1c219a0f8de58789e0404a"-    , "edd879fa56f21d93029da875b683ce50f6fdc4c0da41da051d000eed2afefefa"-    , "f528ffd29160039260133ed9654589ce60e39e7f667c34f82cda65ddcf5fff14"-    , "39d1ff8848e74dd2cdc6b818ad69823878062116fdf1679942f892c7e191be1c4b6ea268ecdff001b22af0d510f30c2c25b90fc34927f46e3f45d36b0e1848b3a5d54c36c7c65ee7287d325dfbb51b56a438feb6650ce13df88bf06b87ac4a35d2a199ea888629fb0d83f82f0ea160dc79ed220d8ef195b9e80c542f60c2d320"-    ],-    -- COUNT = 12-    [ "46571e1df43e5e141235e2a9ec85bb0faf1dc0566031e14d41a2fbd0315653ec"-    , "b60ef6a3347967519aabeaf748e4e991"-    , "759fd8593e3688b23c4a003b655311770d670789878570eb3b155a8e6c2d8c45"-    , "033128460b449e1accb0e9c54508759ddc2538bc64b51e6277553f0c60a02723"-    , "a5e4a717240bdeac18a0c0e231a11dc04a47d7550f342fa9a7a5ff334eb9327d"-    , "9d222df1d530ea7f8f2297a0c79d637da570b48042ecddded75956bba0f0e70b271ffa3c9a53bada6ee1b8a4203c22bfde82a5e2eb1b150f54c6483458569422c1a34a8997d42cc09750167a78bf52a0bd158397af9f83caabe689185c099bf0a9a4853dd3cf8b8e89efebb6a27dba873e65e9927741b22968f2875789b44e01"-    ],-    -- COUNT = 13-    [ "d63980e63bbe4ac08d2ac5646bf085b82c75995e3fdfc23bb9cc734cd85ca7d2"-    , "d33ed1dcae13fb634ba08272d6697590"-    , "acd0da070072a5340c4f5f4395568e1a36374e074196ae87f3692ee40487e1df"-    , "f567677b5e12e26f3544be3da9314c88fc475bf84804a89a51f12b191392c02b"-    , "c01cc7873e93c86e2bfb8fc984cfc2eab5cc58eeef018fedb5cba5aedd386156"-    , "b133446f633bcb40724bbf9fa187c39a44b9c094a0a0d40e98977e5466dc2c9adf62a5f4551eeb6406a14658de8a0ed7487c3bf6277e811101284a941745ce16176acc875f1435e14161772fa84609e8123c53dd03cbb868030835c0d11d8d6aa04a1b6f908248b028997737f54735ec4ed7a81fc868199ffb61a779d9340334"-    ],-    -- COUNT = 14-    [ "3d99f9b7ac3a2fbe9cf15d960bf41f5588fc4db1e0d2a5c9c0fe9059f03593fb"-    , "411f504bb63a9b3afa7ffa1357bb48be"-    , "0bb5ebd55981a25ba69164da49fa92f2871fd3fc65eb30d0f0d0b8d798a4f8f2"-    , "288e948a551284eb3cb23e26299955c2fb8f063c132a92683c1615ecaed80f30"-    , "d975b22f79e34acf5db25a2a167ef60a10682dd9964e15533d75f7fa9efc5dcb"-    , "ee8d707eea9bc7080d58768c8c64a991606bb808600cafab834db8bc884f866941b4a7eb8d0334d876c0f1151bccc7ce8970593dad0c1809075ce6dbca54c4d4667227331eeac97f83ccb76901762f153c5e8562a8ccf12c8a1f2f480ec6f1975ac097a49770219107d4edea54fb5ee23a8403874929d073d7ef0526a647011a"-    ]-    ]--{- Reseed test vectors -}--{--    [SHA-256]-    [PredictionResistance = False]-    [EntropyInputLen = 256]-    [NonceLen = 128]-    [PersonalizationStringLen = 0]-    [AdditionalInputLen = 0]-    [ReturnedBitsLen = 1024]--}--r1 :: [TestVector]-r1 =-    [-    -- COUNT = 0-    [ "06032cd5eed33f39265f49ecb142c511da9aff2af71203bffaf34a9ca5bd9c0d"-    , "0e66f71edc43e42a45ad3c6fc6cdc4df"-    , ""-    , "01920a4e669ed3a85ae8a33b35a74ad7fb2a6bb4cf395ce00334a9c9a5a5d552"-    , ""-    , ""-    , ""-    , "76fc79fe9b50beccc991a11b5635783a83536add03c157fb30645e611c2898bb2b1bc215000209208cd506cb28da2a51bdb03826aaf2bd2335d576d519160842e7158ad0949d1a9ec3e66ea1b1a064b005de914eac2e9d4f2d72a8616a80225422918250ff66a41bd2f864a6a38cc5b6499dc43f7f2bd09e1e0f8f5885935124"-    ],-    -- COUNT = 1-    [ "aadcf337788bb8ac01976640726bc51635d417777fe6939eded9ccc8a378c76a"-    , "9ccc9d80c89ac55a8cfe0f99942f5a4d"-    , ""-    , "03a57792547e0c98ea1776e4ba80c007346296a56a270a35fd9ea2845c7e81e2"-    , ""-    , ""-    , ""-    , "17d09f40a43771f4a2f0db327df637dea972bfff30c98ebc8842dc7a9e3d681c61902f71bffaf5093607fbfba9674a70d048e562ee88f027f630a78522ec6f706bb44ae130e05c8d7eac668bf6980d99b4c0242946452399cb032cc6f9fd96284709bd2fa565b9eb9f2004be6c9ea9ff9128c3f93b60dc30c5fc8587a10de68c"-    ],-    -- COUNT = 2-    [ "62cda441dd802c7652c00b99cac3652a64fc75388dc9adcf763530ac31df9214"-    , "5fdc897a0c1c482204ef07e0805c014b"-    , ""-    , "bd9bbf717467bf4b5db2aa344dd0d90997c8201b2265f4451270128f5ac05a1a"-    , ""-    , ""-    , ""-    , "7e41f9647a5e6750eb8acf13a02f23f3be77611e51992cedb6602c314531aff2a6e4c557da0777d4e85faefcb143f1a92e0dbac8de8b885ced62a124f0b10620f1409ae87e228994b830eca638ccdceedd3fcd07d024b646704f44d5d9c4c3a7b705f37104b45b9cfc2d933ae43c12f53e3e6f798c51be5f640115d45cf919a4"-    ],-    -- COUNT = 3-    [ "6bdc6ca8eef0e3533abd02580ebbc8a92f382c5b1c8e3eaa12566ecfb90389a3"-    , "8f8481cc7735827477e0e4acb7f4a0fa"-    , ""-    , "72eca6f1560720e6bd1ff0152c12eeff1f959462fd62c72b7dde96abcb7f79fb"-    , ""-    , ""-    , ""-    , "d5a2e2f254b5ae65590d4fd1ff5c758e425be4bacdeede7989669f0a22d34274fdfc2bf87135e30abdae2691629c2f6f425bd4e119904d4785ecd9328f15259563e5a71f915ec0c02b66655471067b01016fdf934a47b017e07c21332641400bbe5719050dba22c020b9b2d2cdb933dbc70f76fec4b1d83980fd1a13c4565836"-    ],-    -- COUNT = 4-    [ "096ef37294d369face1add3eb8b425895e921626495705c5a03ee566b34158ec"-    , "6e2e0825534d2989715cc85956e0148d"-    , ""-    , "1b4f7125f472c253837fa787d5acf0382a3b89c3f41c211d263052402dcc62c5"-    , ""-    , ""-    , ""-    , "4541f24f759b5f2ac2b57b51125077cc740b3859a719a9bab1196e6c0ca2bd057af9d3892386a1813fc8875d8d364f15e7fd69d1cc6659470415278164df656295ba9cfcee79f6cbe26ee136e6b45ec224ad379c6079b10a2e0cb5f7f785ef0ab7a7c3fcd9cb6506054d20e2f3ec610cbba9b045a248af56e4f6d3f0c8d96a23"-    ],-    -- COUNT = 5-    [ "a7dccdd431ae5726b83585b54eae4108f7b7a25c70187c0acbb94c96cc277aa8"-    , "94c8f4b8e195a47356a89a50d1389ab5"-    , ""-    , "51733eee2e922f4055e53939e222e71fae730eb037443db2c7679708abb86a65"-    , ""-    , ""-    , ""-    , "99ba2691a622afecc9472418e6a8f9f1cdc1e3583c3bc7a2a650a1ab79dcbccbd656636c573179276e782569420c97438c06be898867f628b1c01eb570263d2c0f09c7aab536f6fba7df6aad19e05c236b645674667c03d1b6a04d7fc11177fe78933b309679f5bf26a4632b9a13e314c4bf4532428d3d95c689002b6dc1fbb1"-    ],-    -- COUNT = 6-    [ "c286425ecf543a49bcc9196b0db1a80bc54e4948adba6f41712a350a02891fa6"-    , "957a659a4ec2e0b7ad185483c220fd61"-    , ""-    , "08c2129813eea0776fba72788fdf2718759cc3c4207fa20a5fe23ac6e32cc28e"-    , ""-    , ""-    , ""-    , "8e1020a4fd84c99e0fc7e3f7ce48de5ed9ec9a5c2ccd624dbe6f30e2f688a31dc55957630357a5d48ca2a456241a28bfb16d8bb000877697a7ce24d9ad4d22b0c15117996f1f270b94f46d7a9bdfa7608fa1dd849177a9b8049e51b6b7a2742623854a1fddb5efc447eed1ea1aed6f02b4b2754ecf71ea0509da2e54f524a7e7"-    ],-    -- COUNT = 7-    [ "02818bd7c1ec456ace55beeba99f646a6d3aa0ea78356ea726b763ff0dd2d656"-    , "c482687d508c9b5c2a75f7ce390014e8"-    , ""-    , "cf319bfa63980e3cb997fd28771bb5614e3acb1149ba45c133ffbbab17433193"-    , ""-    , ""-    , ""-    , "19a231ff26c1865ce75d7a7185c30dd0b333126433d0c8cbf1be0d2b384d4eb3a8aff03540fbfa5f5496521a4e4a64071b44c78bd0b7e68fac9e5695c5c13fd3b9dbe7f7739781a4c8f0b980f1b17d99bce17ceb52b56866ae02456ffef83399c8cf7826f3c45c8a19315890919d20f40fc4e18d07e9c8ccd16c3327b5988f71"-    ],-    -- COUNT = 8-    [ "77a5c86d99be7bc2502870f4025f9f7563e9174ec67c5f481f21fcf2b41cae4b"-    , "ed044ad72ee822506a6d0b1211502967"-    , ""-    , "778100749f01a4d35c3b4a958aafe296877e0acafd089f50bc7797a42a33ab71"-    , ""-    , ""-    , ""-    , "831a4da566f46289904893ef1cc1cd4ad19ee48f3857e2b69e936d10afbdc29822e85d02663d346ef3e09a848b1d9cc04f4c4c6e3b3b0e56a034e2334d34ca08f8097be307ba41d020bc94f8c1937fe85644eeb5592c2b5a2138f7ded9a5b44b200c8b5beb27597c790f94d660eb61e8248391edc3ae2d77656cbe8354275b13"-    ],-    -- COUNT = 9-    [ "0ea458cff8bfd1dd8b1addcba9c01317d53039e533104e32f96e7d342e6c7b9b"-    , "935a4b66fc74c2a48757a99c399e64e3"-    , ""-    , "6c5f3708e7b714c4ed139b4fa9e8c763af01773484005109a85e33653bb0ce98"-    , ""-    , ""-    , ""-    , "373a37af84fddec13645a9768d6a785ae5a2589d64cd9b37980dde2541499210c4f408335de1d585349064f3f53a2b4c5ec6dc2a09591f99ad9fad528ac83474164b45497bf167f81e66fa08463ffea917f6891e48f149fafc20622bb1172f34886feb45c26fd446a4a4e2891b4bc594186896141aaaeeb301b49e7c1a26fec7"-    ],-    -- COUNT = 10-    [ "bfb68be4ce1756d25bdfad5e0c2f8bec29360901cc4da51d423d1591cc57e1ba"-    , "98afe4bd194c143e099680c504cceaab"-    , ""-    , "b97caf210e82498c3408790d41c320dd4a72007778389b44b7bc3c1c4b8c53f8"-    , ""-    , ""-    , ""-    , "409e0aa949fb3b38231bf8732e7959e943a338ea399026b744df15cbfeff8d71b3da023dcce059a88cf0d4b7475f628e4764c8bef13c70cfbbbb6da2a18aabcad919db09d04fc59765edb165147c88dd473a0f3c5ee19237ca955697e001ba654c5ee0bd26761b49333154426bc63286298a8be634fe0d72cfdeef0f3fc48eca"-    ],-    -- COUNT = 11-    [ "4f6880a64610004463031d67d7924fa446c39138d4d41007e8df3d65691a9367"-    , "6b33b2c13600f4b1df6ca3d1960e8dd4"-    , ""-    , "57b87b8c8f48312b5333d43b367730c0a5ad4725a16778fcb53fe136d136cbfd"-    , ""-    , ""-    , ""-    , "73d0f324ed186e2ad06bd1800e262bdbda79ba54e626761bd60f74f43e3bb62958ec1e2f1d940af163e1cadc124e7ebaba2f72e67efd746c7f6d0cad53ef03d859d93cff778a32ee5be172fe7fdbdc232ded360d704a6fa0f70bebe942e56478345492f49dc5c6fc346b88a58947ad250e688e8c626fe1efe7624620e571976e"-    ],-    -- COUNT = 12-    [ "aae352e111843219cae8f70e7b8f6eb9bb53d246cbec1e4f07d42757143295b4"-    , "b84485dccd1bf93210e322eafcbebcd9"-    , ""-    , "f9237f00d744d8fbff21b9d0043c258e8731817e6a5fb7b4bf5011680e5bc642"-    , ""-    , ""-    , ""-    , "cfb28b93522c7d61d8d3ce3f080e435e4c83c7e13a9dab788db8fef0407267a14fbc9324e090e24df5491fedfa81116869983938d4d4d7324a310c3af33a6f7938f602c5e4e63f1771cdaabdab0782b5affb54eb53047c109a9606739dd0065bd21eca33132986554878354f5f9f852e674dd690163b0ff74c7a25e6bae8ce39"-    ],-    -- COUNT = 13-    [ "589e79e339b7d2a1b879f0b0e1a7d1ad2474eaa8025b070f1ffa877b7124d4ff"-    , "0961ed64dbd62065d96e75de6d2ff9d6"-    , ""-    , "e928388d3af48c2968527a4d2f9c2626fbc3f3f5a5d84e0583ab6f78e7f8b081"-    , ""-    , ""-    , ""-    , "fce6ced1ecf474d181ab331f79c3d2cc8a768ec2818de5b3fc7cf418322716d6a6853733561a497c0c25cb288d2c9fcfbca891bafd5a834c85f3603f402acf1a7b1ea92db847ed5c252a862ad4ab5e259715f1fc81da67f5230bf8be50ee8069758095f7d0e559e03f2c6072290e61794458437609e473eb66580cddaad19b71"-    ],-    -- COUNT = 14-    [ "714277d408ad87fde317f0a94732fce62f1352bdc90936673b4f1daa0925aa26"-    , "d16582a99f23010b4248b88d86485419"-    , ""-    , "bd9fc7cb2fd5063b2c3c0c4f346ad2e3879371a9c805e59b9f2cd2cc2a40894f"-    , ""-    , ""-    , ""-    , "62ef7a431288252e0d736c1d4e36cc9ac37107dcd0d0e971a22444a4adae73a41eff0b11c8625e118dbc9226142fd0a6aa10ac9b190919bda44e7248d6c88874612abd77fb3716ea515a2d563237c446e2a282e7c3b0a3aef27d3427cc7d0a7d38714659c3401dbc91d3595159318ebca01ae7d7fd1c89f6ad6b604173b0c744"-    ]-    ]--{--    [SHA-256]-    [PredictionResistance = False]-    [EntropyInputLen = 256]-    [NonceLen = 128]-    [PersonalizationStringLen = 0]-    [AdditionalInputLen = 256]-    [ReturnedBitsLen = 1024]--}--r2 :: [TestVector]-r2 =-    [-    -- COUNT = 0-    [ "05ac9fc4c62a02e3f90840da5616218c6de5743d66b8e0fbf833759c5928b53d"-    , "2b89a17904922ed8f017a63044848545"-    , ""-    , "2791126b8b52ee1fd9392a0a13e0083bed4186dc649b739607ac70ec8dcecf9b"-    , "43bac13bae715092cf7eb280a2e10a962faf7233c41412f69bc74a35a584e54c"-    , "3f2fed4b68d506ecefa21f3f5bb907beb0f17dbc30f6ffbba5e5861408c53a1e"-    , "529030df50f410985fde068df82b935ec23d839cb4b269414c0ede6cffea5b68"-    , "02ddff5173da2fcffa10215b030d660d61179e61ecc22609b1151a75f1cbcbb4363c3a89299b4b63aca5e581e73c860491010aa35de3337cc6c09ebec8c91a6287586f3a74d9694b462d2720ea2e11bbd02af33adefb4a16e6b370fa0effd57d607547bdcfbb7831f54de7073ad2a7da987a0016a82fa958779a168674b56524"-    ],-    -- COUNT = 1-    [ "1bea3296f24e9242b96ed00648ac6255007c91f7c1a5088b2482c28c834942bf"-    , "71073136a5cc1eb5b5fa09e1790a0bed"-    , ""-    , "d714329f3fbea1df9d0b0b0d88dfe3774beb63d011935923d048e521b710dc6f"-    , "4ef872fd211a426ea1085ab39eb220cc698fdfeabe49b8835d620ab7885de7a4"-    , "d74d1669e89875852d9ccbf11c20fe3c13a621ebcb3f7edeea39a2b3379fdcf5"-    , "0c8aa67ca310bd8e58c16aba35880f747266dbf624e88ec8f9ee9be5d08fdeb1"-    , "ce95b98f13adcdf7a32aa34709d6e02f658ae498d2ab01ce920f69e7e42c4be1d005acf0ca6b17891dfafc620dd4cd3894f8492a5c846089b9b452483eb0b91f3649ec0b6f98d1aaabc2e42cd39c2b25081b85ab50cb723007a0fd83550f32c210b7c4150b5a6bb3b0c9e3c971a09d43acb48e410a77f824b957092aa8ef98bc"-    ],-    -- COUNT = 2-    [ "a7ea449b49db48601fc3a3d5d77081fab092b8d420ed1b266f704f94352dd726"-    , "d11a159b60af8d20a0e37d27e6c74aa3"-    , ""-    , "50916ab47e8cb5dc843f9fba80639103711f86be8e3aa94f8a64a3fe0e6e5b35"-    , "e2bb6768120555e7b9e0d573537a82f8f32f54560e1050b6abb1588fb3441e66"-    , "a50cec9d1ecddb2c163d24019e81c31a2b350ccd3ad8181fd31bb8d1f64fa50e"-    , "591dbbd48b51abced67f9c6269cf0133cd3dcbb5cfafcb6ef758569c555a5773"-    , "0a464abcc8685158372d544635b953fcb1d3821c30aaa93982f9b788935f00f88115aad61d5cee003b3d1cb50f3e961a501e2dd0fc7e1724778b184a4bdf9f64e110dda7446e5544a30bd49a400ea1a5411800e1edfeea349323618afc5dc5782dc4b71d2da4d6a4785f8dd346feb9c8740ffd26bf644e3e4323ff24c30b9f10"-    ],-    -- COUNT = 3-    [ "14683ec508a29d7812e0f04a3e9d87897000dc07b4fbcfda58eb7cdabc492e58"-    , "b2243e744eb980b3ece25ce76383fd46"-    , ""-    , "18590e0ef4ee2bdae462f76d9324b3002559f74c370cfccf96a571d6955703a7"-    , "9ea3ccca1e8d791d22fcda621fc4d51b882df32d94ea8f20ee449313e6909b78"-    , "16366a578b5ea4d0cb547790ef5b4fd45d7cd845bc8a7c45e99419c8737debb4"-    , "a68caa29a53f1ba857e484d095805dc319fe6963e4c4daaf355f722eba746b92"-    , "c4e7532ee816789c2d3da9ff9f4b37139a8515dbf8f9e1d0bf00c12addd79ebbd76236f75f2aa705a09f7955038ebff0d566911c5ea13214e2c2eeb46d23ad86a33b60f7b9448d63eec3e1d59f48b39552857447dc5d7944667a230e3dbfa30ca322f6eacaf7536a286706a627c5083c32de0658b9073857c30fb1d86eb8ad1b"-    ],-    -- COUNT = 4-    [ "fa261fb230e2822458532ca2d5c39758750e6819a6fcebef10579ba995096959"-    , "564e1c9fbcb12878df2bd49202cbf821"-    , ""-    , "bf7de29e99e7f0e1b9f96f3b1902fb4049c8c6234d20de8316ebe66d97725457"-    , "8b7326621f6afbd44a726de48d03bcc5331f7306026c229ea9523497fbeaa88d"-    , "33b00b31623d6160c4c6740363a96481be14b19bc47be95641227284c366922a"-    , "2d812c8203575790ad6b6f2ed91a49d57460de779a3e881bef3be12e8766dc91"-    , "5574e0b4efc17e8ce136e592beabfe32551072bddd740929e698467b40b3991f028a22c760f7034853cc53007e3793e3c4a600d9e9d94528f8dc09aeba86146cdde2b7f71255ae0efc529b49be2205979dba6525bfe155e8819e8e2aeeaa285704242da90b4c4535101cc47d94b0e388a1b2e63ad0cbe158b9e1bbae9cc0007c"-    ],-    -- COUNT = 5-    [ "61f1471ced56aa04c57e1b512307d4cb92497d9592d7e9e35356e99d585cab1b"-    , "84714e960c403a4fac06b2828cc564d9"-    , ""-    , "7bf97db3c102edc81596d4757045fe6bdc008f35792fc6290b77d889c09c33a8"-    , "5b8bdc41f76d98cfa71ed976ea3994706375c8841adb8b6b3b6418e3132e8832"-    , "94c8a8fdf38a6ccb8571c89420d899adab169214bb0dfcd43a04622e289935b2"-    , "8a4b46e0a7a55907365f82d4ab9376509bd44728cab8cbafb0da901012ad8dcd"-    , "933eb159a6af7455b60e40586c064f05f1970f564281b1ebc4662701ac1f299e4eb908c4afcb2e065191281ab576f684aefedd6904bad04d96bd93c0516c62a496c3073a0cda0676a11cc08866b0cc74f62cb9d3db48673b2c3fbeada69f922b4b795ccba22df12ef7125909381f7d681f6b9caba02fb913c5437b98c040c576"-    ],-    -- COUNT = 6-    [ "a1d5bb7d70621dee6b668b28c56d5610c2f8ced30284cc3e0e48de331af05062"-    , "88a49e3e54c5ea54c98b95de81bcc807"-    , ""-    , "b4e2426e98f6eed97a6cdf690a89ee109e84c3dca16c883c26fa4ac671638d8d"-    , "5bd1e086ed228cfd8b55c1731fea40c3a63d022599ca2da4bb23118f4821ba62"-    , "b754b53ac226e8ebe47a3d31496ec822de06fca2e7ef5bf1dec6c83d05368ec3"-    , "fa7e76b2805d90b3d89fff545010d84f67aa3a2c9eb2ba232e75f4d53267dac3"-    , "df6b2460688fa537df3ddfe5575fca5eb8abad56cbc4e5a618a2b4a7daf6e215c3a497974c502f9d0ec35de3fc2ea5d4f10de9b2aee66dcc7e7ae6357983095959b817f0383e3030771bd2ed97406acf78a1a4a5f30fa0992289c9202e69e3eb1eabe227c11409ff430f6dfca1a923a8b17bc4b87e908007f5e9759c41482b01"-    ],-    -- COUNT = 7-    [ "68f21d14525d56233c7e263482d344c388a840103a77fb20ac60ce463cabdc79"-    , "59fa80ae570f3e0c60ac7e2578cec3cb"-    , ""-    , "7584b4166530442f06e241dd904f562167e2fdae3247ab853a4a9d4884a5fa46"-    , "f6a5482f139045c5389c9246d772c782c4ebf79c3a84b5cf779f458a69a52914"-    , "9d37b1ce99f8079993ddf0bd54bab218016685b22655a678ce4300105f3a45b7"-    , "4c97c67026ff43c2ee730e7b2ce8cce4794fd0588deb16185fa6792ddd0d46de"-    , "e5f8874be0a8345aabf2f829a7c06bb40e60869508c2bdef071d73692c0265f6a5bf9ca6cf47d75cbd9df88b9cb236cdfce37d2fd4913f177dbd41887dae116edfbdad4fd6e4c1a51aad9f9d6afe7fcafced45a4913d742a7ec00fd6170d63a68f986d8c2357765e4d38835d3fea301afab43a50bd9edd2dec6a979732b25292"-    ],-    -- COUNT = 8-    [ "7988146cbf9598d74cf88dc314af6b25c3f7de96ae9892fb0756318cea01987e"-    , "280bc1ae9bfdf8a73c2df07b82a32c9c"-    , ""-    , "2bbc607085232e5e12ccf7c0c19a5dc80e45eb4b3d4a147fe941fa6c13333474"-    , "f3f5c1bb5da59252861753c4980c23f72be1732f899fdea7183b5c024c858a12"-    , "44d0cfc4f56ab38fa465a659151b3461b65b2462d1ad6b3463b5cf96ad9dc577"-    , "34fb9a3cdacc834ff6241474c4f6e73ed6f5d9ea0337ab2b7468f01ad8a26e93"-    , "4caec9e760c4d468e47613fe50de4a366ae20ba76793744a4e14433ea4de79dc188601eb86c803b094641ab2337b99d459d37decc7d27473057be45ba848868ee0fb5f1cf303d2fcd0b3e0c36f65a65f81b3fee8778a1f22302e25dfe34e6d587fa8864e621121880f7cd55f350531c4ce0530099eec2d0059706dcd657708d9"-    ],-    -- COUNT = 9-    [ "1c974c953fa2a057c9fc9409a6843f6f839aa544bca4fa11e48afd77931d4656"-    , "ed7c08285464af7a5dbdc10b944a1270"-    , ""-    , "78146ad135acb836360d36afc50653dcc36c21662da2a6f6ae05222e75f34000"-    , "263c4984c238ded333c86472866353817379502157172cfa51371d82b1efd7b5"-    , "79b591529f9a26a0d7c8f8fd64e354b0c134ef1f757e43f9463b3dbb7a3da1ab"-    , "7d8f7204b0b5401ddce9e88dcf5facb9a44660a9f5f1c862748e7269c29f7964"-    , "72e2ca257b9edaf59b50e05a144f56fb517832fb9ad3489b1e664e3d5412cbf6b2883e891703b2e73aff9ab56da1009fcdef010ab4cdab996795c8f7c47fb1192bb160353997ad39d7d5fd0e2efc9103a7c3f158246afd53fe53ca6782f809698ef5f1f0d85536780a3fd6a8bafa475891c09213088bd1a3dc169257c34a517a"-    ],-    -- COUNT = 10-    [ "56216d71984a77154569122c777ce57e1d101a6025b28163a25971d39c1c5d0f"-    , "5cd148ba7e54f4975ac8e3e0f9b5d06a"-    , ""-    , "3580f8ca974626c77259c6e37383cb8150b4d0ab0b30e377bed0dc9d1ff1a1bf"-    , "15633e3a62b21594d49d3d26c4c3509f96011d4dbb9d48bbbea1b61c453f6abe"-    , "6068eaca85c14165b101bb3e8c387c41d3f298918c7f3da2a28786ab0738a6fc"-    , "e34f92d2b6aeeeea4ff49bfe7e4b1f462eabb853f0e86fbae0e8b3d51409ce49"-    , "587fdb856abc19ede9078797ecb44099e07aadcd83acdcb2b090601d653f4a14c68ab2ebdda63578c5633a825bae4c0c818f89aac58d30fd7b0b5d459a0f3d86fcad78f4bb14dfff08ad81e4ea9f487cb426e91d6e80dfed436ba38fce8d6f21ca2151c92dd5c323b077d6139c66395558f0537026c4a028affa271ef4e7ea23"-    ],-    -- COUNT = 11-    [ "83eb48bedc1e9294866ab8e5322ef83f6f271f8188e8fdabe5817788bd31570d"-    , "d6ed90bc692237f132441ede857a6629"-    , ""-    , "a4e5e127f992bd5ca79ee56bb8a9bccf74c21814bfaf97ffd052211e802e12e4"-    , "84136e403d9ed7f4515c188213abcfaca35715fa55de6d734aec63c4606a68f1"-    , "fe9d8ef26e2d2e94b99943148392b2b33a581b4b97a8d7a0ecd41660a61dd10b"-    , "594dad642183ce2cdc9494d6bcb358e0e7b767c5a0fa33e456971b8754a9abd5"-    , "86715d43ba95fbbca9b7193ea977a820f4b61ba1b7e3b8d161b6c51b09dfd5040d94c04338b14d97ed25af577186b36ae7251a486c8a2d24a35e84a95c89d669d49e307b4a368b72164135ac54d020a970a180dfbed135d2c86f01270846d5301bd73db2c431a8aa10a0a3d03d146e5fafb9a2aa0b4efc80edab06ff3b532236"-    ],-    -- COUNT = 12-    [ "ba2c94203dab2e6499d8c50dca7b5c34a6b4764834f9816631aa21b9f9c37361"-    , "67db133bdefb25e395085bceee5a0afc"-    , ""-    , "fa8984d16d35302cda35a3a355ab9242ec96fec0652d39282d4a0abf0a80df87"-    , "b6fed10255a3fea6772ae1ae6d9f6cbb9bfaa34804e58a5b786f9bc60b348ccd"-    , "445e072244edc716d3528f0e0a20ff0cd8f819c0d031736c8da122748f24d6c6"-    , "1f856e403c4fa035bac9aa81a20e347c7d8b213aab699d69d9d6186a06ac45c1"-    , "79f33fc36b3b47d9ac805bdbbe699909a8d0beb689a8b2723c291bd5bf7f3ce61343d4722a14e4add36312dbb0594910c8828aff1abc159915d498106f9ffb31147478d8c9ef75d1536ba5036506b313f6e85033f8f6fea2a4de817c867a59378c53c70a2f108275daedd415c05b61c4fd5d48c54be9adb9dea6c40a2ec99ee0"-    ],-    -- COUNT = 13-    [ "0db4c51492db4fe973b4bb1c52a1e873b58fc6bb37a3a4bfc252b03b994495d1"-    , "a2a3900f169bba3f78a42526c700de62"-    , ""-    , "29d5aab356876447e3a20d81c7e3fc6975e2b984180a91493044442999e1ca3a"-    , "40b34183b4e72cdff5952b317b3d45943d0fdcfa0527f3563055f7c73ae8f892"-    , "dc94220c99ffb595c7c4d6de8de5a6bb4b38847169e24a557ef6d879ad84149d"-    , "b2376626fd2f5218b3ed4a5609b43aa24d371cd2176ea017c2b99cf868060021"-    , "f0bd6bc4c506d9427a09352d9c1970b146360732841a6323f4cb602c87dedfb5ff7e6964b9144933af3c5c83017ccd6a94bdca467a504564aaa7b452591a16ff6a1e7e94ddc98f9a58016cdcb8caaed6c80671ba48cc81a832d341093dda1d4e5001ec6bf66348b21e3692a13df92538ad572bb2023822072fc95f9590293ffc"-    ],-    --  COUNT = 14-    [ "593845f0adfeffa7c169f8a610147ae8a08c0072fc0c14c3977d3de0d00b55af"-    , "9e0eb2507342ee01c02beadee7d077bd"-    , ""-    , "aefe591697eab678c52e20013aa424b95cfd217b259757fbe17335563f5b5706"-    , "cbb5be0ef9bf0555ee58955c4d971fb9baa6d6070c3f7244a4eb88b48f0793bf"-    , "6dd878394abdc0402146ba07005327c55f4d821bfebca08d04e66824e3760ab4"-    , "ba86a691d6cbf452b1e2fd1dfb5d31ef9ea5b8be92c4988dc5f560733b371f69"-    , "00735cbfafac5df82e5cb28fc619b01e2ba9571dc0023d26f09c37fb37d0e809066165a97e532bf86fa7d148078e865fe1a09e27a6889be1533b459cd9cd229494b5cf4d2abf28c38180278d47281f13820276ec85effb8d45284eb9eef5d179ab4880023ab2bd08ee3f766f990286bf32430c042f5521bbfd0c7ee09e2254d7"-    ]-    ]--{--    [SHA-256]-    [PredictionResistance = False]-    [EntropyInputLen = 256]-    [NonceLen = 128]-    [PersonalizationStringLen = 256]-    [AdditionalInputLen = 0]-    [ReturnedBitsLen = 1024]--}--r3 :: [TestVector]-r3 =-    [-    -- COUNT = 0-    [ "fa0ee1fe39c7c390aa94159d0de97564342b591777f3e5f6a4ba2aea342ec840"-    , "dd0820655cb2ffdb0da9e9310a67c9e5"-    , "f2e58fe60a3afc59dad37595415ffd318ccf69d67780f6fa0797dc9aa43e144c"-    , "e0629b6d7975ddfa96a399648740e60f1f9557dc58b3d7415f9ba9d4dbb501f6"-    , ""-    , ""-    , ""-    , "f92d4cf99a535b20222a52a68db04c5af6f5ffc7b66a473a37a256bd8d298f9b4aa4af7e8d181e02367903f93bdb744c6c2f3f3472626b40ce9bd6a70e7b8f93992a16a76fab6b5f162568e08ee6c3e804aefd952ddd3acb791c50f2ad69e9a04028a06a9c01d3a62aca2aaf6efe69ed97a016213a2dd642b4886764072d9cbe"-    ],-    -- COUNT = 1-    [ "cff72f345115376a57f4db8a5c9f64053e7379171a5a1e81e82aad3448d17d44"-    , "d1e971ec795d098b3dae14ffcbeecfd9"-    , "6ec0c798c240f22740cad7e27b41f5e42dccaf66def3b7f341c4d827294f83c9"-    , "45ec80f0c00cad0ff0b7616d2a930af3f5cf23cd61be7fbf7c65be0031e93e38"-    , ""-    , ""-    , ""-    , "17a7901e2550de088f472518d377cc4cc6979f4a64f4975c74344215e4807a1234eefef99f64cb8abc3fb86209f6fc7ddd03e94f83746c5abe5360cdde4f2525ccf7167e6f0befae05b38fd6089a2ab83719874ce8f670480d5f3ed9bf40538a15aaad112db1618a58b10687b68875f00f139a72bdf043f736e4a320c06efd2c"-    ],-    -- COUNT = 2-    [ "b7099b06fc7a8a74c58219729db6b0f780d7b4fa307bc3d3f9f22bfb763596a3"-    , "b8772059a135a6b61da72f375411de26"-    , "2ac1bfb24e0b8c6ac2803e89261822b7f72a0320df2b199171b79bcbdb40b719"-    , "9aec4f56ec5e96fbd96048b9a63ac8d047aedbbeea7712e241133b1a357ecfc4"-    , ""-    , ""-    , ""-    , "0e1f2bfef778f5e5be671ecb4971624ec784ed2732abc4fbb98a8b482fb68737df91fd15acfad2951403ac77c5ca3edffc1e03398ae6cf6ac24a91678db5c7290abc3fa001aa02d50399326f85d2b8942199a1575f6746364740a5910552c639804d7530c0d41339345a58ff0080eccf1711895192a3817a8dc3f00f28cc10cc"-    ],-    -- COUNT = 3-    [ "7ba02a734c8744b15ef8b4074fe639b32e4431762ab5b7cd4d5df675ea90672b"-    , "8a424f32108607c8f1f45d97f500ee12"-    , "3ad627433f465187c48141e30c2678106091e7a680229a534b851b8d46feb957"-    , "d8f02b59b6a3dd276bc69cba68efcf11ab83ead1397afd9841786bd1bb5da97a"-    , ""-    , ""-    , ""-    , "1fb91186ba4b4459d994b4b9f4ca252c7be6294d6cdb5fe56f8ff784d4b190a1c6456e0a41223bbbdf83ed8e7cfbfa765d9d8bc7ea5f4d79ea7eccb4928081a21de4cca36620d6267f55d9a352b76fc0a57375884112c31f65ff28e76d315698c29e6c4c05cb58b0a07ae66143b4abc78b9d25c78b4121e1e45bef1a6c1793e2"-    ],-    -- COUNT = 4-    [ "9a8865dfe053ae77cb6a9365b88f34eec17ea5cbfb0b1f04d1459e7fa9c4f3cb"-    , "180c0a74da3ec464df11fac172d1c632"-    , "336372ec82d0d68befad83691966ef6ffc65105388eb2d6eed826c2285037c77"-    , "75b95108eff1fabe83613e1c4de575e72a5cdc4bb9311dd006f971a052386692"-    , ""-    , ""-    , ""-    , "3c683f6d4f8f5a4018d01633dfee74266aaa68ed6fc649e81b64dfdf5f75e75d5c058d66cf5fd01a4f143a6ff695517a4a43bd3adfd1fb2c28ba9a41063140bedbffdb4d21b1ace1550d59209ec61f1e2dbacb2a9116a79cb1410bf2deca5218080aacd9c68e1d6557721a8913e23f617e30f2e594f61267d5ed81464ee730b2"-    ],-    -- COUNT = 5-    [ "22c1af2f2a4c885f06988567da9fc90f34f80f6dd5101c281beef497a6a1b2f8"-    , "3fafdecf79a4174801f133131629037b"-    , "80327dac486111b8a8b2c8e8381fb2d713a67695c2e660b2b0d4af696cc3e1de"-    , "f95a0e4bd24f0e2e9e444f511b7632868ead0d5bb3846771264e03f8ab8ed074"-    , ""-    , ""-    , ""-    , "77a7fea2f35a188f6d1bfdd49b569d8c45e2dd431d35a18c6f432c724f1e33ae92cb89a9cf91519e50705a53199f5b572dc85c1aef8f28fb52dc7986228f66954d54eda84a86962cf25cf765bd9949876349291b1aae5f88fcf4b376912d205add4f53b2770c657946c0d824281f441509153f48356d9d43f8a927e0693db8fc"-    ],-    -- COUNT = 6-    [ "d0840e3a8d629d5b883d33e053a341b21c674e67e1999f068c497ecfaabfd6f6"-    , "071de7244ecb2fdf7ab27f2d84aa7b7a"-    , "90d609527fad96ffe64ab153860346f3d237c8940555ae17b47842d82d3b0943"-    , "1dd1a8b59856c49a388f594c5f42cc2e4a56b3ccb8a65e7066e44c12f4344d50"-    , ""-    , ""-    , ""-    , "7ab28a9b2d3ae999195553e6550cced4c2daccbe7ec9dcbb0d467fabba185b727fbfd9830242cd098f4db3cf4a85e8bf8e8d5974b62b28550922b32ed5bfc1a522b6605cf93bf8d90bdec1c5b9e59c6fc37a817d437068a87254be1f7c4618ada46fbc3a2efb02e44524e21d91be7534cf05fbfd858304b706d6a91ea1cc6ad5"-    ],-    -- COUNT = 7-    [ "2e2dd56869104492767a59778652831919e1c8b970f84e824ae4116597a0ab7f"-    , "01c42a7e983641de46c82fd09b4f2f76"-    , "bcd9e1508fcc22820a8be07180fea5045367333b569e111b011cd57dc1858765"-    , "7306507cd3ca7eec667e640d270cfbb033063d97520b6b7e38ff3cea0e79d12b"-    , ""-    , ""-    , ""-    , "b915726c7b8c5dc3975f1a334684b973abf6a9495d930088cf5d071548e4fd29a67b55cc561ed6949ad28150a9fb4307c1fa5f783a7ea872e8d7c7e67ff0c2906081ee915737d813c25be5c30b952a36f393e6baa56ab01adc2b4776ad7b5d036a53659877c7a4e5220a897d6c0799af37beeed91173fbe9c613c3b6b9bb28e5"-    ],-    -- COUNT = 8-    [ "d1aab0f16bd47a5ccd67c22e094daa3735eae21aa57f0bcd9e053d9d0d545cb8"-    , "199310dfe1b01265b8c0d2b46d6c7c9f"-    , "625b4b8f4de72ea9cb6f70556322dc2a19d6b2b32de623f557e419a084ba60fd"-    , "f50cabae4e060f3971096b78e550cda2837a26a693d905db2d992d589b268f44"-    , ""-    , ""-    , ""-    , "987e1fdfe004c619cf1e9034576707eccd849400e19c87a1fef5b0179ec51c42a2f8c45d7942d0023a023c89f188b2634362703985695369863322f58619c50a7385a2dc91fc78f94b59f0131dc2b56a0d7c699d427285da1c104b0ad1739da10d8071c23993787045dc21f0070e1e9aa1658fc8e3add73dac7262e80e0aa2ee"-    ],-    -- COUNT = 9-    [ "449480eaa100aff6f48dc6286a5a81b9728b084864f78a9da98f606a00a6a41f"-    , "e53c6c5ac3da9f4726389a03f97bb640"-    , "6b8fedc084d8e28d333aef6db3702b6351f0d24e30908cccb63794282655886b"-    , "73a6d64e1966ae324388dc12c14544e9dc5ae4fcb331e99d350c456ff16f9aa0"-    , ""-    , ""-    , ""-    , "a06912d362da7eb25598857f6d65344c3e23ec3deb80c6e43158845b95eaeca241c0bbbd67ac385e24693444455cc1c2c08c1134d956b8bc93b28be9c2d3322b3e09252979dfb8d39d04c94f81bebda5c73110605a237b561216bda9ee9bdee1cc0c7728bcc8304682334ca944e467a27a85313fa5395a9c790e35defd2edb12"-    ],-    -- COUNT = 10-    [ "9a6174166e97aa4981ddf580bc01c96754b9f0ba042750aabfda1cffe56e8581"-    , "d7512ff6b7db7ce141b2bb01dcd0425e"-    , "ed75288f23275f9422444da5d3b53ccb3c4ac8acfb659a1e9b7655c2db52f879"-    , "6888b9277e57dc57663d402eba8d03cf56a070dc868e6a128b18040002baf690"-    , ""-    , ""-    , ""-    , "03519dfb2ff88cc2b53eecc48ae2a18ddcf91a5d69d5aefcdda8444e6df790a5240e67b2a4de75b4bb8a31f0f8aeb5e785ffb7a1341bb52fe00a05ee66fa2d44ea9956e055f9ffa6647c3bfe851ab364ade71a0d356de710ddafb7622b1da1bc53fd4d3210407289c68d8aeb346bf15806dbe787e781b94f63da3e1f61b5ac60"-    ],-    -- COUNT = 11-    [ "9c6ae1002ee1b0add0be563ce50f899da936e13efa620d08c2688c192514763a"-    , "fde7db5160c73044be73e9d4c1b22d86"-    , "8fdaaeffd64e53f7b4374d902d441209964e12b65d29afec258e65db6de167ca"-    , "bcc28fd58e397f53f494ad8132df82c5d8c4c22ea0b7139bd81eeba65667bb69"-    , ""-    , ""-    , ""-    , "021d938c9b4db780c7d8134aeff1053e5b8843370b8ae9a6749fca7199d809810f1bc8dfa49426470c30c3616f903e35fbacb23420a32f1bee567cc32300f704246ddc0217f236ef52c3ec9e2433ca66f05c25721f7661c43f22c1a125ed5db531bd0836eb435c27eefc7424ce9d845e1d4cc4c503097b4ffca788e674a5cb53"-    ],-    -- COUNT = 12-    [ "fe96a85b69d46b540918927bb609dc57642eeaefd46bb5da2163a0bc60294b58"-    , "22195a410d24db45589448dfe979d3fd"-    , "20f698833a4472fd7b78fb9b0c4eb68604f166a2694c4af48dac2b2376790e1e"-    , "09cb870879d3f734214f6a4bd2e08c62a2a954bebe559416d8c3551aafe71d6a"-    , ""-    , ""-    , ""-    , "d3e96dbe29e1fcb8ed83b19dbfb240e6f41679fbe83853aa71446617e63e5af78cf98b331d15bccb8c673c4e5d5dcec467a1fe26a6cd1696d0c9bc49f78139d051287df7f3ae0dbb4bbf581cb8211931063c3f4612ced53f59d1b4ebb875729139f5d2a7d60642e8f2835eed888b7e3e49c0dffd012cd746abfa3e1c5c2308c6"-    ],-    -- COUNT = 13-    [ "a4fd693ff0a8af24bcec352d3196549fd0da5ee5d99ca58416ca03ce4c50f38e"-    , "8cd67f2bf71d4366ce61396642531ff5"-    , "368969c15a4849d7593be8b162113b9298a535c148ff668a9e8b147fb3af4eba"-    , "83d2be9a0d74e6a42159ae630acebf4e15271ef7f14f3de14752be0e0e822b11"-    , ""-    , ""-    , ""-    , "e9188fc0eaec74b2608e21e3a40be94aaf4ae08eb684de8f8bba2d5fd3b073aa5531c938c0fc628da65725c54b5c68bb91d7d326565e96685e0a4e7b220c50e0caf1628edba5bd755b31894f8cb90afa76e88c5eb9e61b4932444c1397dee3e32241a3fb70a3929e49f6da02eea54812abb3d6b5cee18f03af1e0b4958430ab3"-    ],-    -- COUNT = 14-    [ "254ff5687a6dad3f1d237dc762f58d24ef2e2c084d0a48d26a3dc81e5490cda3"-    , "f2ec392acca491e03ce47b95963a49fc"-    , "f806b9b4a56682c61b55cb6a334caf87ffe135adfea6d0c3fc22b39898fbd078"-    , "b8494b1c1f1752fb6f80d732a89b08115857f7cc96e7dff05ebb822706889917"-    , ""-    , ""-    , ""-    , "0e527e00494d55564f9d9b28e7110f9a61ce36c883b5be2dcb055444164cdddd1a9f2731716f22d6ff476ce413c77abfc0e946871d5481345c2e97b4bfdd12ac03df606fc56bdb99ac7b71a69b5b9160373bbec3e9dde477180af454e7acc6bc58dc0afb4281c0de4354c1bf599054e3800c6d60d892858865b5361f50bfca9b"-    ]-    ]--{--    [SHA-256]-    [PredictionResistance = False]-    [EntropyInputLen = 256]-    [NonceLen = 128]-    [PersonalizationStringLen = 256]-    [AdditionalInputLen = 256]-    [ReturnedBitsLen = 1024]--}--r4 :: [TestVector]-r4 =-    [-    -- COUNT = 0-    [ "cdb0d9117cc6dbc9ef9dcb06a97579841d72dc18b2d46a1cb61e314012bdf416"-    , "d0c0d01d156016d0eb6b7e9c7c3c8da8"-    , "6f0fb9eab3f9ea7ab0a719bfa879bf0aaed683307fda0c6d73ce018b6e34faaa"-    , "8ec6f7d5a8e2e88f43986f70b86e050d07c84b931bcf18e601c5a3eee3064c82"-    , "1ab4ca9014fa98a55938316de8ba5a68c629b0741bdd058c4d70c91cda5099b3"-    , "16e2d0721b58d839a122852abd3bf2c942a31c84d82fca74211871880d7162ff"-    , "53686f042a7b087d5d2eca0d2a96de131f275ed7151189f7ca52deaa78b79fb2"-    , "dda04a2ca7b8147af1548f5d086591ca4fd951a345ce52b3cd49d47e84aa31a183e31fbc42a1ff1d95afec7143c8008c97bc2a9c091df0a763848391f68cb4a366ad89857ac725a53b303ddea767be8dc5f605b1b95f6d24c9f06be65a973a089320b3cc42569dcfd4b92b62a993785b0301b3fc452445656fce22664827b88f"-    ],-    -- COUNT = 1-    [ "3e42348bf76c0559cce9a44704308c85d9c205b676af0ac6ba377a5da12d3244"-    , "9af783973c632a490f03dbb4b4852b1e"-    , "2e51c7a8ac70adc37fc7e40d59a8e5bf8dfd8f7b027c77e6ec648bd0c41a78de"-    , "45718ac567fd2660b91c8f5f1f8f186c58c6284b6968eadc9810b7beeca148a1"-    , "63a107246a2070739aa4bed6746439d8c2ce678a54fc887c5aba29c502da7ba9"-    , "e4576291b1cde51c5044fdc5375624cebf63333c58c7457ca7490da037a9556e"-    , "b5a3fbd57784b15fd875e0b0c5e59ec5f089829fac51620aa998fff003534d6f"-    , "c624d26087ffb8f39836c067ba37217f1977c47172d5dcb7d40193a1cfe20158b774558cbee8eb6f9c62d629e1bcf70a1439e46c5709ba4c94a006ba94994796e10660d6cb1e150a243f7ba5d35c8572fd96f43c08490131797e86d3ed8467b692f92f668631b1d32862c3dc43bfba686fe72fdd947db2792463e920522eb4bc"-    ],-    -- COUNT = 2-    [ "b63fdd83c674699ba473faab9c358434771c5fa0348ca0faf7ebd7cf5891826b"-    , "5fd204e2598d9626edab4158a8cfd95f"-    , "2a5dfad8494306d9d4648a805c4602216a746ae3493492693a50a86d1ba05c64"-    , "adea5ba92f8010bb1a6a4b6fae2caa0b384165adf721253afd635d6021f764af"-    , "07c69d8d2b8aa1454c5c48083dd41477fda6bfcf0385638379933a60ed2e0a77"-    , "a14e902247a3d6493d3fbc8519518b71a660e5502cf7ecfc796cfaa5b4ee4baa"-    , "60e690e4a1eba14aec5187112a383e9991347fab7bac7cb2a40a52579a0d2718"-    , "792b47b6ed221623bb187d63e3f039c6983d94efd5771dc9b4c40bee65924513485a6332baeda6a96f9bb431f592d73462b61d9d914a72b56fa9d87597426fb246424ebcd7abd51b2eefec8f5b839c0b3c34015342ace296b5f2218fa194b50aea1c89663460292c92c45f112ddbf6b9406f6e7ccee9c47ed2d90a27be5dd73e"-    ],-    -- COUNT = 3-    [ "dab85f98eaf0cfba013b97de4d9c264ca6fe120366cb83e8b3113c68b34e39d5"-    , "d05108e1028ae67b4ea63bdc6d75eb88"-    , "09fed3822f6f5e5b9e575d31dc215de1607b0dfc927412618c2d8f79166dbaba"-    , "1794885a64470744198b7d0bc24472ffe8daf3c7eb219df6ddf180e484fe0aa5"-    , "8d74d01b582f70b92f53b43468084e1586d9b36465d333d5faaf6911e62fe40e"-    , "ef7f6b6eb479ab05b3f9ab6dd72eac8b1e86d887f1bcae363cae386d0275a06f"-    , "7442b2a792a6a29559bb8a515d56916ee18200580aa02e1237dd358619382d8f"-    , "49d2cbfa0897b7d961c293c1e572fb26f28e7b956e746f6eda90454c1370a29e25303ceadc7837514dc638553b487ef9487c977c10625409178ad6506d103c487a66655d08659d92a4d5994d1c8ddb28fe60f2e49577d6e80cae1478068c98268f45e6293c9326c7f726ec89601351c0a26fd3a6549f8a41c6f58692c86594c0"-    ],-    -- COUNT = 4-    [ "0f0aa84ef12e10ae2b279e799c683441862457b9bc25581c2cd3d5b58a5b3246"-    , "f74f4230c2427a52f01f39e825d250ac"-    , "d02b2f53da48b923c2921e0f75bd7e6139d7030aead5aeebe46c20b9ca47a38a"-    , "5222b26e79f7c3b7066d581185b1a1f6376796f3d67f59d025dd2a7b1886d258"-    , "d11512457bf3b92d1b1c0923989911f58f74e136b1436f00bad440dd1d6f1209"-    , "54d9ea7d40b7255ef3d0ab16ea9fdf29b9a281920962b5c72d97b0e371b9d816"-    , "601cef261da8864f1e30196c827143e4c363d3fa865b808e9450b13e251d47fa"-    , "e9847cefea3b88062ea63f92dc9e96767ce9202a6e049c98dc1dcbc6d707687bd0e98ed2cc215780c454936292e44a7c6856d664581220b8c8ca1d413a2b81120380bfd0da5ff2bf737b602727709523745c2ced8daef6f47d1e93ef9bc141a135674cba23045e1f99aa78f8cead12eeffff20de2008878b1f806a2652db565a"-    ],-    -- COUNT = 5-    [ "6a868ce39a3adcd189bd704348ba732936628f083de8208640dbd42731447d4e"-    , "efdde4e22b376e5e7385e79024350699"-    , "f7285cd5647ff0e2c71a9b54b57f04392641a4bde4a4024fa11c859fecaad713"-    , "0174f7f456ac06c1d789facc071701f8b60e9accebced73a634a6ad0e1a697d4"-    , "5463bb2241d10c970b68c3abc356c0fe5ef87439fc6457c5ee94be0a3fb89834"-    , "3ab62cdbc638c1b2b50533d28f31b1758c3b8435fe24bb6d4740005a73e54ce6"-    , "2dbf4c9123e97177969139f5d06466c272f60d067fefadf326ccc47971115469"-    , "8afce49dccc4ff64c65a83d8c0638bd8e3b7c13c52c3c59d110a8198753e96da512c7e03aeed30918706f3ad3b819e6571cfa87369c179fb9c9bbc88110baa490032a9d41f9931434e80c40ae0051400b7498810d769fb42dddbc7aa19bdf79603172efe9c0f5d1a65372b463a31178cbae581fa287f39c4fbf8434051b7419f"-    ],-    -- COUNT = 6-    [ "bb6b339eae26072487084ec9e4b53f2f1d4267d205042e74c77fb9ca0591ba50"-    , "c0e7bf6eb07feccbc494af4098e59d30"-    , "34aeec7ed0cae83701b6477709c8654a1114212401dc91cbe7de39d71f0c06e1"-    , "f47fc60afbeb807236f7974d837335bc0b22288ef09ddfcb684e16b4c36a050b"-    , "e8071ccd84ac4527e5c6e85b0709ed867776f25ae0e04180dcb7105ecd3e3490"-    , "fbac45b5952200ad7c4232500f2417a1c14723bdd1cc078821bc2fe138b86597"-    , "c4292d7dbef3ba7c18bf46bcf26776add22ab8ee206d6c722665dec6576b1bc0"-    , "228aa2a314fcbfe63089ce953ac457093deaa39dd9ce2a4ece56a6028a476a98129be516d6979eff5587c032cdf4739d7ac712970f600fa781a8e542e399661183e34e4b90c59ec5dc5cad86f91083529d41c77b8f36c5a8e28ba1a548223a02eaed8426f6fe9f349ebec11bc743e767482e3472ec2799c1f530ebdc6c03bc4b"-    ],-    -- COUNT = 7-    [ "be658e56f80436039e2a9c0a62952dd7d70842244b5ab10f3b8a87d36104e629"-    , "33c9627455dfde91865aee93e5071147"-    , "d3a6eb29b180b791984deb056d72c0608a2c9044237aecf100ccb03700064c5e"-    , "bef24dc9a5aa23003d3825f9b2b00e7dab571ea6ad86415dbd30c0bbdce7b972"-    , "047c29e4d1584fa70cb66e2aa148a2aa29837c5eee64dcac60fdba356cdf90bb"-    , "41c4792161b1b00d410cb79cd56bd311a714fb78dc3471c25bdd7479f2e9a952"-    , "cd4936d7bc3ea0e7201bcbefbc908215a97680ca6ce8672360aea600b6564308"-    , "2c25557f6db07db057f56ad5b6dc0427d1a0e825c48c19a526f9a65087c6d1ead7c78363a61616c84f1022653af65173a3f9ec3275f2b0a0d0bc750194673c0eaa6c623cd88abb0c8979baee4cd85bfce2e4a20bfebf2c3be61676563767dfe229e0b7be67ad6fcd116dd0b460708b1b0e5c3d60f3dd8138030404d197375d75"-    ],-    -- COUNT = 8-    [ "ae537f31a28ca14500e759716bc207983bfeab60b25079fa30b77b8d41244cb9"-    , "fca9e27d8ab84cf9b9ce491ec5d8cb67"-    , "8c9cb2b19aa3abe83c8fe7da96e9c11648252653a29dcd5bf0ac334ac587f032"-    , "1eb52777be480f05115ae6370f30159a94d50ffcc64454678ab1d1ac6f166fa7"-    , "9cdf6f1a2bc07acd4b0f43b5f2b892a1153e2669f237d257923636094fb40b54"-    , "692d512722de6ba720fd23c8994ac63179b5f7e611addf9cfacd60e06e144a6a"-    , "bbeea7b2bea821f339f494947c0b4bae8056119db69a3cbef21914953729cdef"-    , "c0c4fb7080c0fbe425c1b756fb3a090cb0d08c7027d1bb82ed3b07613e2a757f83a78d42f9d8653954b489f800a5e058ebc4f5a1747526541d8448cb72e2232db20569dc96342c36672c4be625b363b4587f44557e58cedb4597cb57d006fda27e027818ae89e15b4c6382b9e7a4453290ea43163b4f9cae38b1023de6a47f7b"-    ],-    -- COUNT = 9-    [ "2f8994c949e08862db0204008f55d3561f3e0362df13b9d9a70fda39938f2d33"-    , "1bf3e94ea858160b832fe85d301256f5"-    , "b46671cf7fa142e7012ed261e1fe86714711c246c7d1c0330fa692141e86d5d1"-    , "5ecdb1e8fe12260b9bfe12d6e6f161474fa2311e12e39b0beb0fcd92a6737b73"-    , "3ce9a29f0207d079e6dc81fb830356e555f96a23ea71424972ea9308965786d3"-    , "db950000c0776cc0e049929ce021020adc42d29cd9b5d8f7117fbe6bde3e594f"-    , "fc18ee6dd3dac2306774f0ac36cd789e33462d72a8c75df9057123db33e5f7bc"-    , "8546362cc8af9b78dd6e8eb2c37db96e70708852bfd9380abedc7f324575a167bea18f632f3e19d099cfbf310773f9719eec036d2e09f393a023add8ebdc4fb87af43b2fe6c7eaa4d39f8022ce247aa45fdc84d1b92cacce6eae8252a03ec2ec5330c01f56d113fd2ec3d0240af0afcf13ddde205bb5e7c2d912dcb4aee5dcf3"-    ],-    -- COUNT = 10-    [ "0c85e31487de1d7ba4a7b998ac56dc42c6dc0eae7bf5c8aaf1e4e78875f5fb47"-    , "de878f728f73f83dc2a2f550b96c8b97"-    , "9aac37bce1a6a81dc7934e23747991e3cf48c55ffe5a57781c41768a35220a01"-    , "2d5ca8af1a70cfdccd015ee3bf0665dd1941fc6a7317b9d0d06658f5744cfbd9"-    , "db881e6d0dc3b62793d7da5fe5a18e33be9b93f4a63a00a878dfbecf0d383bd2"-    , "f743ce1b72f3de4c901369eed581c626ed3081ca707e6634fdaff46721ce0878"-    , "cd52da3ec8a839c537dacdea8506a3eeee879de388ff5e513322d6d1bb3ff694"-    , "a5bdd57cb8fde6298e7c5e563afcca60dd472eca484bd8c3cc17f3307be09b601744dd3ab9e8a44107c5868824575f850c0f399b280cf198006f83ede8c0b537e9be227fa140b65995ad9dfa1f2303d560c3b7f59bedd93c1282ea263924469411c2653f87fd814c74cb91c148430481d64bad0fec3cbb3dd1f39aa55c36f81b"-    ],-    -- COUNT = 11-    [ "93161b2dc08cb0fd50171141c865a841ca935cfdd2b5907d6ff8ab0348c4ceb0"-    , "5cb9f6e5912b90c3349a50ab881b35a1"-    , "0dceb4a36326c4df1685df43fddeecb5d0c76f00eb44826694f27e610290f6e1"-    , "d8e9be44b5f293482548d4787762ebfb03c73c40e45385e8b98907cd66f493dd"-    , "105a8f85d6959f3e043ef508cfea21d52123f03b7aea8034c4eec761eaba1fee"-    , "bf781f7e489d9b4b5aa5ee6d1796468af672a8d25f311edf3c4b4dbf433d703f"-    , "c81d6bcf1e5bf37e39dda1735c6f193df115b1a854a12e7cafe060afe4589335"-    , "4306628124d0100fade7eaaf5edf227d50771f9e5f2e1e983800eef9a39fde0b0c280e63c8728d836b5b93ea794a32c1c04cfc54bd5300e3febb5fe2e1023eded8d7cd180279a598f76823e8d5a7dffcc93a09deec5d1f80838e938fba4de9f47e94b99382ae55f116df9c3b3ddf7e50516e203645852a415796f03a86418107"-    ],-    -- COUNT = 12-    [ "1ae12a5e4e9a4a5bfa79da30a9e6c62ffc639572ef1254194d129a16eb53c716"-    , "5399b3481fdf24d373222267790a0fec"-    , "8280cfdcd7a575816e0199e115da0ea77cae9d30b49c891a6c225e9037ba67e2"-    , "681554ff702658122e91ba017450cfdfc8e3f4911153f7bcc428403e9c7b9d68"-    , "226732b7a457cf0ac0ef09fd4f81296573b49a68de5e7ac3070e148c95e8e323"-    , "45942b5e9a1a128e85e12c34596374ddc85fd7502e5633c7390fc6e6f1e5ef56"-    , "6fc59929b41e77072886aff45f737b449b105ed7eacbd74c7cbfedf533dbeaa1"-    , "b7547332e1509663fcfea2128f7f3a3df484cd8df034b00199157d35d61e35f1a9d481c7d2e81305616d70fc371ee459b0b2267d627e928590edcac3231898b24ef378aa9c3d381619f665379be76c7c1bd535505c563db3725f034786e35bdd90429305fd71d7bf680e8cdd6d4c348d97078f5cf5e89dee2dc410fad4f2a30f"-    ],-    -- COUNT = 13-    [ "29e20d724dfa459960df21c6ec76b1e6cabd23a9e9456d6c591d7e4529da0ef8"-    , "95df1f837eba47a1687aa5c4ddcf8aaf"-    , "3713b601e164b1a51dda1ca9242ff477514648e90d311a06e10ce5aa15da5d7f"-    , "2a2a312626ca3e20034fc4f28033c7d573f66ef61ab2ea0c7bf0411a9d247264"-    , "ec68be33ac8ff3dd127e051604898c0f9a501271859376653a0516336180993d"-    , "9935499661d699a00c622a875441b4df5204958fe95892c8ce67f7dfb2be3e4a"-    , "256a4ba9e8f439d5487fa5eb45efcf1bc1120491724db3abe328d951f2739fc9"-    , "73114cb3624d687d4cd49a6e769dfc7a3f8901dc41f6ad1df4ce480536fa82e52ae958d0528640d92b8bb981b755058e32c4733682e5c4c0df41f3505a1643a0dd49cfdeaf7a18adffca88256c6d2cceb838af6c92a64bc21cb7a760a0391291bfe3575e014fc156323f8eb5e86518c669dad8d29ad5fd4ef6e296f4a0764c26"-    ],-    -- COUNT = 14-    [ "1353f3543eb1134980e061fc4382394975dbc74f1f1ea5ecc02780a813ac5ee6"-    , "cf584db2447afbe2c8fa0c15575ee391"-    , "345b0cc016f2765a8c33fc24f1dcfa182cbe29d7eacbcdc9bcda988521458fc2"-    , "ba60219332a67b95d90ec9de6b8453d4c8af991ae9277461ff3af1b92fc985d3"-    , "6964b9b9842aec9c7ec2aad926d701f30eec76fe699265ae2a7765d716958069"-    , "6a03c28a9365c558c33d3fdc7e5ebf0b4d32caac70df71403fd70ced09757528"-    , "a58546c72a0b4d47c9bd6c19e7cf4ab73b2d7ba36c6c6dc08606f608795ebd29"-    , "5b029ef68b6799868b04dc28dbea26bc2fa9fcc8c2b2795aafeed0127b7297fa19a4ef2ba60c42ff8259d5a759f92bd90fdfb27145e82d798bb3ab7fd60bfaefb7aefb116ca2a4fa8b01d96a03c47c8d987fdd33c460e560b138891278313bb619d0c3c6f9d7c5a37e88fce83e94943705c6ff68e00484e74ad4097b0c9e5f10"-    ]-    ]
− test/Network/Haskoin/Crypto/SignatureSpec.hs 
@@ -1,165 +0,0 @@-{-# 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.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-        prop "verify signature" $-            forAll arbitrarySignature $ \(msg, key, sig) ->-                verifyHashSig msg sig (derivePubKey key)-        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-        prop "encodes and decodes signature" $-            forAll arbitrarySignature $-            (\s -> decodeStrictSig (exportSig s) == Just s) . lst3-    describe "trezor rfc6979 test vectors" $ do-        it "rfc6979 test vector 1" (testSigning $ head detVec)-        it "rfc6979 test vector 2" (testSigning $ detVec !! 1)-        it "rfc6979 test vector 3" (testSigning $ detVec !! 2)-        it "rfc6979 test vector 4" (testSigning $ detVec !! 3)-        it "rfc6979 test vector 5" (testSigning $ detVec !! 4)-        it "rfc6979 test vector 6" (testSigning $ detVec !! 5)-        it "rfc6979 test vector 7" (testSigning $ detVec !! 6)-        it "rfc6979 test vector 8" (testSigning $ detVec !! 7)-        it "rfc6979 test vector 9" (testSigning $ detVec !! 8)-        it "rfc6979 test vector 10" (testSigning $ detVec !! 9)-        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 "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---{- ECDSA Canonical -}---- github.com/bitcoin/bitcoin/blob/master/src/script.cpp--- from function IsCanonicalSignature-testIsCanonical :: Sig -> Bool-testIsCanonical sig = not $-    -- Non-canonical signature: too short-    (len < 8) ||-    -- Non-canonical signature: too long-    (len > 72) ||-    -- Non-canonical signature: wrong type-    (BS.index s 0 /= 0x30) ||-    -- Non-canonical signature: wrong length marker-    (BS.index s 1 /= len - 2) ||-    -- Non-canonical signature: S length misplaced-    (5 + rlen >= len) ||-    -- Non-canonical signature: R+S length mismatch-    (rlen + slen + 6 /= len) ||-    -- Non-canonical signature: R value type mismatch-    (BS.index s 2 /= 0x02) ||-    -- Non-canonical signature: R length is zero-    (rlen == 0) ||-    -- Non-canonical signature: R value negative-    testBit (BS.index s 4) 7 ||-    -- Non-canonical signature: R value excessively padded-    (  rlen > 1-    && BS.index s 4 == 0-    && not (testBit (BS.index s 5) 7)-    ) ||-    -- Non-canonical signature: S value type mismatch-    (BS.index s (fromIntegral rlen + 4) /= 0x02) ||-    -- Non-canonical signature: S length is zero-    (slen == 0) ||-    -- Non-canonical signature: S value negative-    testBit (BS.index s (fromIntegral rlen+6)) 7 ||-    -- Non-canonical signature: S value excessively padded-    (  slen > 1-    && BS.index s (fromIntegral rlen + 6) == 0-    && not (testBit (BS.index s (fromIntegral rlen + 7)) 7)-    )-  where-    s = exportSig sig-    len = fromIntegral $ BS.length s-    rlen = BS.index s 3-    slen = BS.index s (fromIntegral rlen + 5)---{- Trezor RFC 6979 Test Vectors -}--- github.com/trezor/python-ecdsa/blob/master/ecdsa/test_pyecdsa.py--detVec :: [(SecKey, ByteString, Text)]-detVec =-    [-      ( "0000000000000000000000000000000000000000000000000000000000000001"-      , "Satoshi Nakamoto"-      , "934b1ea10a4b3c1757e2b0c017d0b6143ce3c9a7e6a4a49860d7a6ab210ee3d82442ce9d2b916064108014783e923ec36b49743e2ffa1c4496f01a512aafd9e5"-      )-    , ( "0000000000000000000000000000000000000000000000000000000000000001"-      , "All those moments will be lost in time, like tears in rain. Time to die..."-      , "8600dbd41e348fe5c9465ab92d23e3db8b98b873beecd930736488696438cb6b547fe64427496db33bf66019dacbf0039c04199abb0122918601db38a72cfc21"-      )-    , ( "fffffffffffffffffffffffffffffffebaaedce6af48a03bbfd25e8cd0364140"-      , "Satoshi Nakamoto"-      , "fd567d121db66e382991534ada77a6bd3106f0a1098c231e47993447cd6af2d06b39cd0eb1bc8603e159ef5c20a5c8ad685a45b06ce9bebed3f153d10d93bed5"-      )-    , ( "f8b8af8ce3c7cca5e300d33939540c10d45ce001b8f252bfbc57ba0342904181"-      , "Alan Turing"-      , "7063ae83e7f62bbb171798131b4a0564b956930092b33b07b395615d9ec7e15c58dfcc1e00a35e1572f366ffe34ba0fc47db1e7189759b9fb233c5b05ab388ea"-      )-    , ( "e91671c46231f833a6406ccbea0e3e392c76c167bac1cb013f6f1013980455c2"-      , "There is a computer disease that anybody who works with computers knows about. It's a very serious disease and it interferes completely with the work. The trouble with computers is that you 'play' with them!"-      , "b552edd27580141f3b2a5463048cb7cd3e047b97c9f98076c32dbdf85a68718b279fa72dd19bfae05577e06c7c0c1900c371fcd5893f7e1d56a37d30174671f6"-      )-    , ( "0000000000000000000000000000000000000000000000000000000000000001"-      , "Everything should be made as simple as possible, but not simpler."-      , "33a69cd2065432a30f3d1ce4eb0d59b8ab58c74f27c41a7fdb5696ad4e6108c96f807982866f785d3f6418d24163ddae117b7db4d5fdf0071de069fa54342262"-      )-    , ( "fffffffffffffffffffffffffffffffebaaedce6af48a03bbfd25e8cd0364140"-      , "Equations are more important to me, because politics is for the present, but an equation is something for eternity."-      , "54c4a33c6423d689378f160a7ff8b61330444abb58fb470f96ea16d99d4a2fed07082304410efa6b2943111b6a4e0aaa7b7db55a07e9861d1fb3cb1f421044a5"-      )-    , ( "fffffffffffffffffffffffffffffffebaaedce6af48a03bbfd25e8cd0364140"-      , "Not only is the Universe stranger than we think, it is stranger than we can think."-      , "ff466a9f1b7b273e2f4c3ffe032eb2e814121ed18ef84665d0f515360dab3dd06fc95f5132e5ecfdc8e5e6e616cc77151455d46ed48f5589b7db7771a332b283"-      )-    , ( "0000000000000000000000000000000000000000000000000000000000000001"-      , "How wonderful that we have met with a paradox. Now we have some hope of making progress."-      , "c0dafec8251f1d5010289d210232220b03202cba34ec11fec58b3e93a85b91d375afdc06b7d6322a590955bf264e7aaa155847f614d80078a90292fe205064d3"-      )-    , ( "69ec59eaa1f4f2e36b639716b7c30ca86d9a5375c7b38d8918bd9c0ebc80ba64"-      , "Computer science is no more about computers than astronomy is about telescopes."-      , "7186363571d65e084e7f02b0b77c3ec44fb1b257dee26274c38c928986fea45d0de0b38e06807e46bda1f1e293f4f6323e854c86d58abdd00c46c16441085df6"-      )-    , ( "00000000000000000000000000007246174ab1e92e9149c6e446fe194d072637"-      , "...if you aren't, at any given time, scandalized by code you wrote five or even three years ago, you're not learning anywhere near enough"-      , "fbfe5076a15860ba8ed00e75e9bd22e05d230f02a936b653eb55b61c99dda4870e68880ebb0050fe4312b1b1eb0899e1b82da89baa5b895f612619edf34cbd37"-      )-    , ( "000000000000000000000000000000000000000000056916d0f9b31dc9b637f3"-      , "The question of whether computers can think is like the question of whether submarines can swim."-      , "cde1302d83f8dd835d89aef803c74a119f561fbaef3eb9129e45f30de86abbf906ce643f5049ee1f27890467b77a6a8e11ec4661cc38cd8badf90115fbd03cef"-      )-    ]
− test/Network/Haskoin/CryptoSpec.hs 
@@ -1,165 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}-module Network.Haskoin.CryptoSpec (spec) where--import           Control.Monad-import           Data.ByteString           (ByteString)-import qualified Data.ByteString.Char8     as C (pack)-import           Data.Maybe                (fromMaybe, isJust, isNothing)-import           Data.Text                 (Text)-import           Network.Haskoin.Address-import           Network.Haskoin.Constants-import           Network.Haskoin.Crypto-import           Network.Haskoin.Keys-import           Network.Haskoin.Util-import           Test.Hspec-import           Test.HUnit                (Assertion, assertBool)---- Unit tests copied from bitcoind implementation--- https://github.com/bitcoin/bitcoin/blob/master/src/test/key_tests.cpp--strSecret1 :: Text-strSecret1  = "5HxWvvfubhXpYYpS3tJkw6fq9jE9j18THftkZjHHfmFiWtmAbrj"--strSecret2 :: Text-strSecret2  = "5KC4ejrDjv152FGwP386VD1i2NYc5KkfSMyv1nGy1VGDxGHqVY3"--strSecret1C :: Text-strSecret1C = "Kwr371tjA9u2rFSMZjTNun2PXXP3WPZu2afRHTcta6KxEUdm1vEw"--strSecret2C :: Text-strSecret2C = "L3Hq7a8FEQwJkW1M2GNKDW28546Vp5miewcCzSqUD9kCAXrJdS3g"--addr1 :: Text-addr1  = "1QFqqMUD55ZV3PJEJZtaKCsQmjLT6JkjvJ"--addr2 :: Text-addr2  = "1F5y5E5FMc5YzdJtB9hLaUe43GDxEKXENJ"--addr1C :: Text-addr1C = "1NoJrossxPBKfCHuJXT4HadJrXRE9Fxiqs"--addr2C :: Text-addr2C = "1CRj2HyM1CXWzHAXLQtiGLyggNT9WQqsDs"--strAddressBad :: Text-strAddressBad = "1HV9Lc3sNHZxwj4Zk6fB38tEmBryq2cBiF"--sigMsg :: [ByteString]-sigMsg =-    [ mconcat ["Very secret message ", C.pack (show (i :: Int)), ": 11"]-    | i <- [0..15]-    ]--sec1 :: SecKeyI-sec1 =-    fromMaybe (error "Could not decode WIF secret 1") (fromWif btc strSecret1)--sec2 :: SecKeyI-sec2 =-    fromMaybe (error "Could not decode WIF secret 2") (fromWif btc strSecret2)--sec1C :: SecKeyI-sec1C =-    fromMaybe-        (error "Could not decode WIF compressed secret 1")-        (fromWif btc strSecret1C)--sec2C :: SecKeyI-sec2C =-    fromMaybe-        (error "Could not decode WIF compressed secret 2")-        (fromWif btc strSecret2C)--pub1 :: PubKeyI-pub1  = derivePubKeyI sec1--pub2 :: PubKeyI-pub2  = derivePubKeyI sec2--pub1C :: PubKeyI-pub1C = derivePubKeyI sec1C--pub2C :: PubKeyI-pub2C = derivePubKeyI sec2C--spec :: Spec-spec =-    describe "bitcoind /src/test/key_tests.cpp" $ do-        it "decode valid wif" checkPrivkey-        it "decode invalid wif" checkInvalidKey-        it "decode minikey format" checkMiniKey-        it "check private key compression" checkPrvKeyCompressed-        it "check public key compression" checkKeyCompressed-        it "check matching address" checkMatchingAddress-        it "check various signatures" sigCheck--sigCheck :: Assertion-sigCheck = forM_ sigMsg $ checkSignatures . doubleSHA256--{- bitcoind /src/test/key_tests.cpp -}--checkPrivkey :: Assertion-checkPrivkey = do-    assertBool "Key 1"  $ isJust $ fromWif btc strSecret1-    assertBool "Key 2"  $ isJust $ fromWif btc strSecret2-    assertBool "Key 1C" $ isJust $ fromWif btc strSecret1C-    assertBool "Key 2C" $ isJust $ fromWif btc strSecret2C--checkInvalidKey :: Assertion-checkInvalidKey =-    assertBool "Bad key" $ isNothing $ fromWif btc strAddressBad--checkMiniKey :: Assertion-checkMiniKey =-    assertBool "Bad mini key" $-    isJust res && fromMiniKey "S6c56bnXQiBjk9mqSYE7ykVQ7NzrRy" == res-  where-    res = do-        bs <--            decodeHex-                "4C7A9640C72DC2099F23715D0C8A0D8A35F8906E3CAB61DD3F78B67BF887C9AB"-        wrapSecKey False <$> secKey bs--checkPrvKeyCompressed :: Assertion-checkPrvKeyCompressed = do-    assertBool "Key 1"  $ not $ secKeyCompressed sec1-    assertBool "Key 2"  $ not $ secKeyCompressed sec2-    assertBool "Key 1C" $ secKeyCompressed sec1C-    assertBool "Key 2C" $ secKeyCompressed sec2C--checkKeyCompressed :: Assertion-checkKeyCompressed = do-    assertBool "Key 1"  $ not $ pubKeyCompressed pub1-    assertBool "Key 2"  $ not $ pubKeyCompressed pub2-    assertBool "Key 1C" $ pubKeyCompressed pub1C-    assertBool "Key 2C" $ pubKeyCompressed pub2C--checkMatchingAddress :: Assertion-checkMatchingAddress = do-    assertBool "Key 1"  $ Just addr1  == addrToString btc (pubKeyAddr pub1)-    assertBool "Key 2"  $ Just addr2  == addrToString btc (pubKeyAddr pub2)-    assertBool "Key 1C" $ Just addr1C == addrToString btc (pubKeyAddr pub1C)-    assertBool "Key 2C" $ Just addr2C == addrToString btc (pubKeyAddr pub2C)--checkSignatures :: Hash256 -> Assertion-checkSignatures h = do-    let sign1  = signHash (secKeyData sec1) h-        sign2  = signHash (secKeyData sec2) h-        sign1C = signHash (secKeyData sec1C) h-        sign2C = signHash (secKeyData sec2C) h-    assertBool "Key 1, Sign1"   $ verifyHashSig h sign1 (pubKeyPoint pub1)-    assertBool "Key 1, Sign2"   $ not $ verifyHashSig h sign2 (pubKeyPoint pub1)-    assertBool "Key 1, Sign1C"  $ verifyHashSig h sign1C (pubKeyPoint pub1)-    assertBool "Key 1, Sign2C"  $ not $ verifyHashSig h sign2C (pubKeyPoint pub1)-    assertBool "Key 2, Sign1"   $ not $ verifyHashSig h sign1 (pubKeyPoint pub2)-    assertBool "Key 2, Sign2"   $ verifyHashSig h sign2 (pubKeyPoint pub2)-    assertBool "Key 2, Sign1C"  $ not $ verifyHashSig h sign1C (pubKeyPoint pub2)-    assertBool "Key 2, Sign2C"  $ verifyHashSig h sign2C (pubKeyPoint pub2)-    assertBool "Key 1C, Sign1"  $ verifyHashSig h sign1 (pubKeyPoint pub1C)-    assertBool "Key 1C, Sign2"  $ not $ verifyHashSig h sign2 (pubKeyPoint pub1C)-    assertBool "Key 1C, Sign1C" $ verifyHashSig h sign1C (pubKeyPoint pub1C)-    assertBool "Key 1C, Sign2C" $ not $ verifyHashSig h sign2C (pubKeyPoint pub1C)-    assertBool "Key 2C, Sign1"  $ not $ verifyHashSig h sign1 (pubKeyPoint pub2C)-    assertBool "Key 2C, Sign2"  $ verifyHashSig h sign2 (pubKeyPoint pub2C)-    assertBool "Key 2C, Sign1C" $ not $ verifyHashSig h sign1C (pubKeyPoint pub2C)-    assertBool "Key 2C, Sign2C" $ verifyHashSig h sign2C (pubKeyPoint pub2C)
− test/Network/Haskoin/Keys/ExtendedSpec.hs 
@@ -1,521 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}-module Network.Haskoin.Keys.ExtendedSpec (spec) where--import           Data.Aeson                 as A-import           Data.Aeson.Types           as A-import           Data.Bits                  ((.&.))-import qualified Data.ByteString.Lazy.Char8 as B8-import           Data.Either                (isLeft)-import           Data.Map.Strict            (singleton)-import           Data.Maybe                 (fromJust, isJust, isNothing)-import           Data.Serialize             as S-import           Data.String                (fromString)-import           Data.String.Conversions    (cs)-import           Data.Text                  (Text)-import           Data.Word                  (Word32)-import           Network.Haskoin.Address-import           Network.Haskoin.Constants-import           Network.Haskoin.Keys-import           Network.Haskoin.Test-import           Network.Haskoin.Util-import           Test.Hspec-import           Test.HUnit                 (Assertion, assertBool, assertEqual)-import           Test.QuickCheck            hiding ((.&.))--spec :: Spec-spec = do-    describe "bip32 derivation vector 1" $ do-        it "chain m" $ runXKeyVec (head xKeyVec)-        it "chain m/0'" $ runXKeyVec (xKeyVec !! 1)-        it "chain m/0'/1" $ runXKeyVec (xKeyVec !! 2)-        it "chain m/0'/1/2'" $ runXKeyVec (xKeyVec !! 3)-        it "chain m/0'/1/2'/2" $ runXKeyVec (xKeyVec !! 4)-        it "chain m/0'/1/2'/2/1000000000" $ runXKeyVec (xKeyVec !! 5)-    describe "bip32 subkey derivation vector 2" $ do-        it "chain m" $ runXKeyVec (head xKeyVec2)-        it "chain m/0" $ runXKeyVec (xKeyVec2 !! 1)-        it "chain m/0/2147483647'" $ runXKeyVec (xKeyVec2 !! 2)-        it "chain m/0/2147483647'/1" $ runXKeyVec (xKeyVec2 !! 3)-        it "chain m/0/2147483647'/1/2147483646'" $ runXKeyVec (xKeyVec2 !! 4)-        it "Chain m/0/2147483647'/1/2147483646'/2" $ runXKeyVec (xKeyVec2 !! 5)-    describe "bip32 subkey derivation using string path" $ do-        it "either derivations" testApplyPath-        it "either derivations" testBadApplyPath-        it "dublic derivations" testDerivePubPath-        it "private derivations" testDerivePrvPath-        it "path parsing" testParsePath-        it "from json" testFromJsonPath-        it "to json" testToJsonPath-    describe "extended keys" $ do-        let net = btc-        it "computes pubkey of a subkey is subkey of the pubkey" $-            property $ forAll arbitraryXPrvKey pubKeyOfSubKeyIsSubKeyOfPubKey-        it "exports and imports extended private key" $-            property $-            forAll arbitraryXPrvKey $ \k ->-                xPrvImport net (xPrvExport net k) == Just k-        it "exports and imports extended public key" $-            property $-            forAll arbitraryXPubKey $ \(_, k) ->-                xPubImport net (xPubExport net k) == Just k-        it "show and read derivation path" $-            property $ forAll arbitraryDerivPath $ \p -> read (show p) == p-        it "show and read hard derivation path" $-            property $ forAll arbitraryHardPath $ \p -> read (show p) == p-        it "show and read soft derivation path" $-            property $ forAll arbitrarySoftPath $ \p -> read (show p) == p-        it "from string derivation path" $-            property $-            forAll arbitraryDerivPath $ \p -> fromString (cs $ pathToStr p) == p-        it "from string hard derivation path" $-            property $-            forAll arbitraryHardPath $ \p -> fromString (cs $ pathToStr p) == p-        it "from string soft derivation path" $-            property $-            forAll arbitrarySoftPath $ \p -> fromString (cs $ pathToStr p) == p-        it "from and to lists of derivation paths" $-            property $-            forAll arbitraryDerivPath $ \p -> listToPath (pathToList p) == p-        it "from and to lists of hard derivation paths" $-            property $-            forAll arbitraryHardPath $ \p ->-                toHard (listToPath $ pathToList p) == Just p-        it "from and to lists of soft derivation paths" $-            property $-            forAll arbitrarySoftPath $ \p ->-                toSoft (listToPath $ pathToList p) == Just p-        it "read and show parsed path" $-            property $ forAll arbitraryParsedPath $ \p -> read (show p) == p-        it "encodes and decodes extended private key" $-            forAll-                arbitraryXPrvKey-                (testCustom (xPrvFromJSON net) (xPrvToJSON net))-        it "encodes and decodes extended public key" $-            forAll-                arbitraryXPubKey-                (testCustom (xPubFromJSON net) (xPubToJSON net) . snd)-        it "encodes and decodes derivation path" $-            forAll arbitraryDerivPath testID-        it "encodes and decodes parsed derivation path" $-            forAll arbitraryParsedPath testID-        it "encodes and decodes extended private key" $-            property $-            forAll arbitraryXPrvKey $-            testPutGet (getXPrvKey net) (putXPrvKey net)-        it "shows and reads extended private key" $-            property $-            forAll arbitraryXPrvKey $ \k -> read (show k) `shouldBe` k-        it "shows and reads extended private key" $-            property $-            forAll arbitraryXPubKey $ \(prv, pub) ->-                read (show (prv, pub)) `shouldBe` (prv, pub)--testFromJsonPath :: Assertion-testFromJsonPath =-    sequence_ $ do-        path <- jsonPathVectors-        return $-            assertEqual-                path-                (Just [fromString path :: DerivPath])-                (A.decode $ B8.pack $ "[\"" ++ path ++ "\"]")--testToJsonPath :: Assertion-testToJsonPath =-    sequence_ $ do-        path <- jsonPathVectors-        return $-            assertEqual-                path-                (B8.pack $ "[\"" ++ path ++ "\"]")-                (A.encode [fromString path :: ParsedPath])--jsonPathVectors :: [String]-jsonPathVectors =-    [ "m"-    , "m/0"-    , "m/0'"-    , "M/0'"-    , "m/2147483647"-    , "M/2147483647"-    , "m/1/2/3/4/5/6/7/8"-    , "M/1/2/3/4/5/6/7/8"-    , "m/1'/2'/3/4"-    , "M/1'/2'/3/4"-    ]--testParsePath :: Assertion-testParsePath =-    sequence_ $ do-        (path, t) <- parsePathVectors-        return $ assertBool path (t $ parsePath path)--parsePathVectors :: [(String, Maybe ParsedPath -> Bool)]-parsePathVectors =-    [ ("m", isJust)-    , ("m/0'", isJust)-    , ("M/0'", isJust)-    , ("m/2147483648", isNothing)-    , ("m/2147483647", isJust)-    , ("M/2147483648", isNothing)-    , ("M/2147483647", isJust)-    , ("M/-1", isNothing)-    , ("M/-2147483648", isNothing)-    , ("m/1/2/3/4/5/6/7/8", isJust)-    , ("M/1/2/3/4/5/6/7/8", isJust)-    , ("m/1'/2'/3/4", isJust)-    , ("M/1'/2'/3/4", isJust)-    , ("m/1/2'/3/4'", isJust)-    , ("M/1/2'/3/4'", isJust)-    , ("meh", isNothing)-    , ("infinity", isNothing)-    , ("NaN", isNothing)-    ]--testApplyPath :: Assertion-testApplyPath =-    sequence_ $ do-        (key, path, final) <- applyPathVectors-        return $-            assertEqual path final $ applyPath (fromJust $ parsePath path) key--testBadApplyPath :: Assertion-testBadApplyPath =-    sequence_ $ do-        (key, path) <- badApplyPathVectors-        return $-            assertBool path $ isLeft $ applyPath (fromJust $ parsePath path) key--testDerivePubPath :: Assertion-testDerivePubPath =-    sequence_ $ do-        (key, path, final) <- derivePubPathVectors-        return $-            assertEqual path final $-            derivePubPath (fromString path :: SoftPath) key--testDerivePrvPath :: Assertion-testDerivePrvPath =-    sequence_ $ do-        (key, path, final) <- derivePrvPathVectors-        return $-            assertEqual path final $-            derivePath (fromString path :: DerivPath) key--derivePubPathVectors :: [(XPubKey, String, XPubKey)]-derivePubPathVectors =-    [ ( xpub, "M", xpub )-    , ( xpub, "M/8", pubSubKey xpub 8 )-    , ( xpub, "M/8/30/1", foldl pubSubKey xpub [8,30,1] )-    ]-  where-    xprv = fromJust $ xPrvImport btc-        "xprv9s21ZrQH143K46iDVRSyFfGfMgQjzC4BV3ZUfNbG7PHQrJjE53ofAn5gYkp6KQ\-        \WzGmb8oageSRxBY8s4rjr9VXPVp2HQDbwPt4H31Gg4LpB"-    xpub = deriveXPubKey xprv--derivePrvPathVectors :: [(XPrvKey, String, XPrvKey)]-derivePrvPathVectors =-    [ ( xprv, "m", xprv )-    , ( xprv, "M", xprv )-    , ( xprv, "m/8'", hardSubKey xprv 8 )-    , ( xprv, "M/8'", hardSubKey xprv 8 )-    , ( xprv, "m/8'/30/1"-      , foldl prvSubKey (hardSubKey xprv 8) [30,1]-      )-    , ( xprv, "M/8'/30/1"-      , foldl prvSubKey (hardSubKey xprv 8) [30,1]-      )-    , ( xprv, "m/3/20"-      , foldl prvSubKey xprv [3,20]-      )-    , ( xprv, "M/3/20"-      , foldl prvSubKey xprv [3,20]-      )-    ]-  where-    xprv = fromJust $ xPrvImport btc-        "xprv9s21ZrQH143K46iDVRSyFfGfMgQjzC4BV3ZUfNbG7PHQrJjE53ofAn5gYkp6KQ\-        \WzGmb8oageSRxBY8s4rjr9VXPVp2HQDbwPt4H31Gg4LpB"--applyPathVectors :: [(XKey, String, Either String XKey)]-applyPathVectors =-    [ (XPrv xprv btc, "m", Right (XPrv xprv btc))-    , (XPrv xprv btc, "M", Right (XPub xpub btc))-    , (XPrv xprv btc, "m/8'", Right (XPrv (hardSubKey xprv 8) btc))-    , ( XPrv xprv btc-      , "M/8'"-      , Right (XPub (deriveXPubKey (hardSubKey xprv 8)) btc))-    , ( XPrv xprv btc-      , "m/8'/30/1"-      , Right (XPrv (foldl prvSubKey (hardSubKey xprv 8) [30, 1]) btc))-    , ( XPrv xprv btc-      , "M/8'/30/1"-      , Right-            (XPub-                 (deriveXPubKey (foldl prvSubKey (hardSubKey xprv 8) [30, 1]))-                 btc))-    , (XPrv xprv btc, "m/3/20", Right (XPrv (foldl prvSubKey xprv [3, 20]) btc))-    , ( XPrv xprv btc-      , "M/3/20"-      , Right (XPub (deriveXPubKey (foldl prvSubKey xprv [3, 20])) btc))-    , ( XPub xpub btc-      , "M/3/20"-      , Right (XPub (deriveXPubKey (foldl prvSubKey xprv [3, 20])) btc))-    ]-  where-    xprv =-        fromJust $-        xPrvImport-            btc-            "xprv9s21ZrQH143K46iDVRSyFfGfMgQjzC4BV3ZUfNbG7PHQrJjE53ofAn5gYkp6KQ\-        \WzGmb8oageSRxBY8s4rjr9VXPVp2HQDbwPt4H31Gg4LpB"-    xpub = deriveXPubKey xprv--badApplyPathVectors :: [(XKey, String)]-badApplyPathVectors =-    [ (XPub xpub btc, "m/8'")-    , (XPub xpub btc, "M/8'")-    , (XPub xpub btc, "M/1/2/3'/4/5")-    ]-  where-    xprv =-        fromJust $-        xPrvImport-            btc-            "xprv9s21ZrQH143K46iDVRSyFfGfMgQjzC4BV3ZUfNbG7PHQrJjE53ofAn5gYkp6KQ\-        \WzGmb8oageSRxBY8s4rjr9VXPVp2HQDbwPt4H31Gg4LpB"-    xpub = deriveXPubKey xprv---runXKeyVec :: ([Text], XPrvKey) -> Assertion-runXKeyVec (v, m) = do-    assertBool "xPrvID" $ encodeHex (S.encode $ xPrvID m) == head v-    assertBool "xPrvFP" $ encodeHex (S.encode $ xPrvFP m) == v !! 1-    assertBool "xPrvAddr" $-        addrToString btc (xPubAddr $ deriveXPubKey m) == Just (v !! 2)-    assertBool "prvKey" $ encodeHex (getSecKey $ xPrvKey m) == v !! 3-    assertBool "xPrvWIF" $ xPrvWif btc m == v !! 4-    assertBool "pubKey" $-        encodeHex (exportPubKey True $ xPubKey $ deriveXPubKey m) == v !! 5-    assertBool "chain code" $ encodeHex (S.encode $ xPrvChain m) == v !! 6-    assertBool "Hex PubKey" $-        encodeHex (runPut $ putXPubKey btc $ deriveXPubKey m) == v !! 7-    assertBool "Hex PrvKey" $ encodeHex (runPut (putXPrvKey btc m)) == v !! 8-    assertBool "Base58 PubKey" $ xPubExport btc (deriveXPubKey m) == v !! 9-    assertBool "Base58 PrvKey" $ xPrvExport btc m == v !! 10---- BIP 0032 Test Vectors--- https://en.bitcoin.it/wiki/BIP_0032_TestVectors--xKeyVec :: [([Text], XPrvKey)]-xKeyVec = zip xKeyResVec $ foldl f [m] der-    where f acc d = acc ++ [d $ last acc]-          m   = makeXPrvKey $ fromJust $ decodeHex m0-          der = [ flip hardSubKey 0-                , flip prvSubKey 1-                , flip hardSubKey 2-                , flip prvSubKey 2-                , flip prvSubKey 1000000000-                ]--xKeyVec2 :: [([Text], XPrvKey)]-xKeyVec2 = zip xKeyResVec2 $ foldl f [m] der-    where f acc d = acc ++ [d $ last acc]-          m   = makeXPrvKey $ fromJust $ decodeHex m1-          der = [ flip prvSubKey 0-                , flip hardSubKey 2147483647-                , flip prvSubKey 1-                , flip hardSubKey 2147483646-                , flip prvSubKey 2-                ]--m0 :: Text-m0 = "000102030405060708090a0b0c0d0e0f"--xKeyResVec :: [[Text]]-xKeyResVec =-    [-      -- m-      [ "3442193e1bb70916e914552172cd4e2dbc9df811"-      , "3442193e"-      , "15mKKb2eos1hWa6tisdPwwDC1a5J1y9nma"-      , "e8f32e723decf4051aefac8e2c93c9c5b214313817cdb01a1494b917c8436b35"-      , "L52XzL2cMkHxqxBXRyEpnPQZGUs3uKiL3R11XbAdHigRzDozKZeW"-      , "0339a36013301597daef41fbe593a02cc513d0b55527ec2df1050e2e8ff49c85c2"-      , "873dff81c02f525623fd1fe5167eac3a55a049de3d314bb42ee227ffed37d508"-      , "0488b21e000000000000000000873dff81c02f525623fd1fe5167eac3a55a049de3d314bb42ee227ffed37d5080339a36013301597daef41fbe593a02cc513d0b55527ec2df1050e2e8ff49c85c2"-      , "0488ade4000000000000000000873dff81c02f525623fd1fe5167eac3a55a049de3d314bb42ee227ffed37d50800e8f32e723decf4051aefac8e2c93c9c5b214313817cdb01a1494b917c8436b35"-      , "xpub661MyMwAqRbcFtXgS5sYJABqqG9YLmC4Q1Rdap9gSE8NqtwybGhePY2gZ29ESFjqJoCu1Rupje8YtGqsefD265TMg7usUDFdp6W1EGMcet8"-      , "xprv9s21ZrQH143K3QTDL4LXw2F7HEK3wJUD2nW2nRk4stbPy6cq3jPPqjiChkVvvNKmPGJxWUtg6LnF5kejMRNNU3TGtRBeJgk33yuGBxrMPHi"-      ]-      -- m/0'-    , [ "5c1bd648ed23aa5fd50ba52b2457c11e9e80a6a7"-      , "5c1bd648"-      , "19Q2WoS5hSS6T8GjhK8KZLMgmWaq4neXrh"-      , "edb2e14f9ee77d26dd93b4ecede8d16ed408ce149b6cd80b0715a2d911a0afea"-      , "L5BmPijJjrKbiUfG4zbiFKNqkvuJ8usooJmzuD7Z8dkRoTThYnAT"-      , "035a784662a4a20a65bf6aab9ae98a6c068a81c52e4b032c0fb5400c706cfccc56"-      , "47fdacbd0f1097043b78c63c20c34ef4ed9a111d980047ad16282c7ae6236141"-      , "0488b21e013442193e8000000047fdacbd0f1097043b78c63c20c34ef4ed9a111d980047ad16282c7ae6236141035a784662a4a20a65bf6aab9ae98a6c068a81c52e4b032c0fb5400c706cfccc56"-      , "0488ade4013442193e8000000047fdacbd0f1097043b78c63c20c34ef4ed9a111d980047ad16282c7ae623614100edb2e14f9ee77d26dd93b4ecede8d16ed408ce149b6cd80b0715a2d911a0afea"-      , "xpub68Gmy5EdvgibQVfPdqkBBCHxA5htiqg55crXYuXoQRKfDBFA1WEjWgP6LHhwBZeNK1VTsfTFUHCdrfp1bgwQ9xv5ski8PX9rL2dZXvgGDnw"-      , "xprv9uHRZZhk6KAJC1avXpDAp4MDc3sQKNxDiPvvkX8Br5ngLNv1TxvUxt4cV1rGL5hj6KCesnDYUhd7oWgT11eZG7XnxHrnYeSvkzY7d2bhkJ7"-      ]-      -- m/0'/1-    , [ "bef5a2f9a56a94aab12459f72ad9cf8cf19c7bbe"-      , "bef5a2f9"-      , "1JQheacLPdM5ySCkrZkV66G2ApAXe1mqLj"-      , "3c6cb8d0f6a264c91ea8b5030fadaa8e538b020f0a387421a12de9319dc93368"-      , "KyFAjQ5rgrKvhXvNMtFB5PCSKUYD1yyPEe3xr3T34TZSUHycXtMM"-      , "03501e454bf00751f24b1b489aa925215d66af2234e3891c3b21a52bedb3cd711c"-      , "2a7857631386ba23dacac34180dd1983734e444fdbf774041578e9b6adb37c19"-      , "0488b21e025c1bd648000000012a7857631386ba23dacac34180dd1983734e444fdbf774041578e9b6adb37c1903501e454bf00751f24b1b489aa925215d66af2234e3891c3b21a52bedb3cd711c"-      , "0488ade4025c1bd648000000012a7857631386ba23dacac34180dd1983734e444fdbf774041578e9b6adb37c19003c6cb8d0f6a264c91ea8b5030fadaa8e538b020f0a387421a12de9319dc93368"-      , "xpub6ASuArnXKPbfEwhqN6e3mwBcDTgzisQN1wXN9BJcM47sSikHjJf3UFHKkNAWbWMiGj7Wf5uMash7SyYq527Hqck2AxYysAA7xmALppuCkwQ"-      , "xprv9wTYmMFdV23N2TdNG573QoEsfRrWKQgWeibmLntzniatZvR9BmLnvSxqu53Kw1UmYPxLgboyZQaXwTCg8MSY3H2EU4pWcQDnRnrVA1xe8fs"-      ]-      -- m/0'/1/2'-    , [ "ee7ab90cde56a8c0e2bb086ac49748b8db9dce72"-      , "ee7ab90c"-      , "1NjxqbA9aZWnh17q1UW3rB4EPu79wDXj7x"-      , "cbce0d719ecf7431d88e6a89fa1483e02e35092af60c042b1df2ff59fa424dca"-      , "L43t3od1Gh7Lj55Bzjj1xDAgJDcL7YFo2nEcNaMGiyRZS1CidBVU"-      , "0357bfe1e341d01c69fe5654309956cbea516822fba8a601743a012a7896ee8dc2"-      , "04466b9cc8e161e966409ca52986c584f07e9dc81f735db683c3ff6ec7b1503f"-      , "0488b21e03bef5a2f98000000204466b9cc8e161e966409ca52986c584f07e9dc81f735db683c3ff6ec7b1503f0357bfe1e341d01c69fe5654309956cbea516822fba8a601743a012a7896ee8dc2"-      , "0488ade403bef5a2f98000000204466b9cc8e161e966409ca52986c584f07e9dc81f735db683c3ff6ec7b1503f00cbce0d719ecf7431d88e6a89fa1483e02e35092af60c042b1df2ff59fa424dca"-      , "xpub6D4BDPcP2GT577Vvch3R8wDkScZWzQzMMUm3PWbmWvVJrZwQY4VUNgqFJPMM3No2dFDFGTsxxpG5uJh7n7epu4trkrX7x7DogT5Uv6fcLW5"-      , "xprv9z4pot5VBttmtdRTWfWQmoH1taj2axGVzFqSb8C9xaxKymcFzXBDptWmT7FwuEzG3ryjH4ktypQSAewRiNMjANTtpgP4mLTj34bhnZX7UiM"-      ]-      -- m/0'/1/2'/2-    , [ "d880d7d893848509a62d8fb74e32148dac68412f"-      , "d880d7d8"-      , "1LjmJcdPnDHhNTUgrWyhLGnRDKxQjoxAgt"-      , "0f479245fb19a38a1954c5c7c0ebab2f9bdfd96a17563ef28a6a4b1a2a764ef4"-      , "KwjQsVuMjbCP2Zmr3VaFaStav7NvevwjvvkqrWd5Qmh1XVnCteBR"-      , "02e8445082a72f29b75ca48748a914df60622a609cacfce8ed0e35804560741d29"-      , "cfb71883f01676f587d023cc53a35bc7f88f724b1f8c2892ac1275ac822a3edd"-      , "0488b21e04ee7ab90c00000002cfb71883f01676f587d023cc53a35bc7f88f724b1f8c2892ac1275ac822a3edd02e8445082a72f29b75ca48748a914df60622a609cacfce8ed0e35804560741d29"-      , "0488ade404ee7ab90c00000002cfb71883f01676f587d023cc53a35bc7f88f724b1f8c2892ac1275ac822a3edd000f479245fb19a38a1954c5c7c0ebab2f9bdfd96a17563ef28a6a4b1a2a764ef4"-      , "xpub6FHa3pjLCk84BayeJxFW2SP4XRrFd1JYnxeLeU8EqN3vDfZmbqBqaGJAyiLjTAwm6ZLRQUMv1ZACTj37sR62cfN7fe5JnJ7dh8zL4fiyLHV"-      , "xprvA2JDeKCSNNZky6uBCviVfJSKyQ1mDYahRjijr5idH2WwLsEd4Hsb2Tyh8RfQMuPh7f7RtyzTtdrbdqqsunu5Mm3wDvUAKRHSC34sJ7in334"-      ]-      -- m/0'/1/2'/2/1000000000-    , [ "d69aa102255fed74378278c7812701ea641fdf32"-      , "d69aa102"-      , "1LZiqrop2HGR4qrH1ULZPyBpU6AUP49Uam"-      , "471b76e389e528d6de6d816857e012c5455051cad6660850e58372a6c3e6e7c8"-      , "Kybw8izYevo5xMh1TK7aUr7jHFCxXS1zv8p3oqFz3o2zFbhRXHYs"-      , "022a471424da5e657499d1ff51cb43c47481a03b1e77f951fe64cec9f5a48f7011"-      , "c783e67b921d2beb8f6b389cc646d7263b4145701dadd2161548a8b078e65e9e"-      , "0488b21e05d880d7d83b9aca00c783e67b921d2beb8f6b389cc646d7263b4145701dadd2161548a8b078e65e9e022a471424da5e657499d1ff51cb43c47481a03b1e77f951fe64cec9f5a48f7011"-      , "0488ade405d880d7d83b9aca00c783e67b921d2beb8f6b389cc646d7263b4145701dadd2161548a8b078e65e9e00471b76e389e528d6de6d816857e012c5455051cad6660850e58372a6c3e6e7c8"-      , "xpub6H1LXWLaKsWFhvm6RVpEL9P4KfRZSW7abD2ttkWP3SSQvnyA8FSVqNTEcYFgJS2UaFcxupHiYkro49S8yGasTvXEYBVPamhGW6cFJodrTHy"-      , "xprvA41z7zogVVwxVSgdKUHDy1SKmdb533PjDz7J6N6mV6uS3ze1ai8FHa8kmHScGpWmj4WggLyQjgPie1rFSruoUihUZREPSL39UNdE3BBDu76"-      ]-    ]--m1 :: Text-m1 = "fffcf9f6f3f0edeae7e4e1dedbd8d5d2cfccc9c6c3c0bdbab7b4b1aeaba8a5a29f9c999693908d8a8784817e7b7875726f6c696663605d5a5754514e4b484542"--xKeyResVec2 :: [[Text]]-xKeyResVec2 =-    [-      -- m-      [ "bd16bee53961a47d6ad888e29545434a89bdfe95"-      , "bd16bee5"-      , "1JEoxevbLLG8cVqeoGKQiAwoWbNYSUyYjg"-      , "4b03d6fc340455b363f51020ad3ecca4f0850280cf436c70c727923f6db46c3e"-      , "KyjXhyHF9wTphBkfpxjL8hkDXDUSbE3tKANT94kXSyh6vn6nKaoy"-      , "03cbcaa9c98c877a26977d00825c956a238e8dddfbd322cce4f74b0b5bd6ace4a7"-      , "60499f801b896d83179a4374aeb7822aaeaceaa0db1f85ee3e904c4defbd9689"-      , "0488b21e00000000000000000060499f801b896d83179a4374aeb7822aaeaceaa0db1f85ee3e904c4defbd968903cbcaa9c98c877a26977d00825c956a238e8dddfbd322cce4f74b0b5bd6ace4a7"-      , "0488ade400000000000000000060499f801b896d83179a4374aeb7822aaeaceaa0db1f85ee3e904c4defbd9689004b03d6fc340455b363f51020ad3ecca4f0850280cf436c70c727923f6db46c3e"-      , "xpub661MyMwAqRbcFW31YEwpkMuc5THy2PSt5bDMsktWQcFF8syAmRUapSCGu8ED9W6oDMSgv6Zz8idoc4a6mr8BDzTJY47LJhkJ8UB7WEGuduB"-      , "xprv9s21ZrQH143K31xYSDQpPDxsXRTUcvj2iNHm5NUtrGiGG5e2DtALGdso3pGz6ssrdK4PFmM8NSpSBHNqPqm55Qn3LqFtT2emdEXVYsCzC2U"-      ]-      -- m/0-    , [ "5a61ff8eb7aaca3010db97ebda76121610b78096"-      , "5a61ff8e"-      , "19EuDJdgfRkwCmRzbzVBHZWQG9QNWhftbZ"-      , "abe74a98f6c7eabee0428f53798f0ab8aa1bd37873999041703c742f15ac7e1e"-      , "L2ysLrR6KMSAtx7uPqmYpoTeiRzydXBattRXjXz5GDFPrdfPzKbj"-      , "02fc9e5af0ac8d9b3cecfe2a888e2117ba3d089d8585886c9c826b6b22a98d12ea"-      , "f0909affaa7ee7abe5dd4e100598d4dc53cd709d5a5c2cac40e7412f232f7c9c"-      , "0488b21e01bd16bee500000000f0909affaa7ee7abe5dd4e100598d4dc53cd709d5a5c2cac40e7412f232f7c9c02fc9e5af0ac8d9b3cecfe2a888e2117ba3d089d8585886c9c826b6b22a98d12ea"-      , "0488ade401bd16bee500000000f0909affaa7ee7abe5dd4e100598d4dc53cd709d5a5c2cac40e7412f232f7c9c00abe74a98f6c7eabee0428f53798f0ab8aa1bd37873999041703c742f15ac7e1e"-      , "xpub69H7F5d8KSRgmmdJg2KhpAK8SR3DjMwAdkxj3ZuxV27CprR9LgpeyGmXUbC6wb7ERfvrnKZjXoUmmDznezpbZb7ap6r1D3tgFxHmwMkQTPH"-      , "xprv9vHkqa6EV4sPZHYqZznhT2NPtPCjKuDKGY38FBWLvgaDx45zo9WQRUT3dKYnjwih2yJD9mkrocEZXo1ex8G81dwSM1fwqWpWkeS3v86pgKt"-      ]-      -- m/0/2147483647'-    , [ "d8ab493736da02f11ed682f88339e720fb0379d1"-      , "d8ab4937"-      , "1Lke9bXGhn5VPrBuXgN12uGUphrttUErmk"-      , "877c779ad9687164e9c2f4f0f4ff0340814392330693ce95a58fe18fd52e6e93"-      , "L1m5VpbXmMp57P3knskwhoMTLdhAAaXiHvnGLMribbfwzVRpz2Sr"-      , "03c01e7425647bdefa82b12d9bad5e3e6865bee0502694b94ca58b666abc0a5c3b"-      , "be17a268474a6bb9c61e1d720cf6215e2a88c5406c4aee7b38547f585c9a37d9"-      , "0488b21e025a61ff8effffffffbe17a268474a6bb9c61e1d720cf6215e2a88c5406c4aee7b38547f585c9a37d903c01e7425647bdefa82b12d9bad5e3e6865bee0502694b94ca58b666abc0a5c3b"-      , "0488ade4025a61ff8effffffffbe17a268474a6bb9c61e1d720cf6215e2a88c5406c4aee7b38547f585c9a37d900877c779ad9687164e9c2f4f0f4ff0340814392330693ce95a58fe18fd52e6e93"-      , "xpub6ASAVgeehLbnwdqV6UKMHVzgqAG8Gr6riv3Fxxpj8ksbH9ebxaEyBLZ85ySDhKiLDBrQSARLq1uNRts8RuJiHjaDMBU4Zn9h8LZNnBC5y4a"-      , "xprv9wSp6B7kry3Vj9m1zSnLvN3xH8RdsPP1Mh7fAaR7aRLcQMKTR2vidYEeEg2mUCTAwCd6vnxVrcjfy2kRgVsFawNzmjuHc2YmYRmagcEPdU9"-      ]-      -- m/0/2147483647'/1-    , [ "78412e3a2296a40de124307b6485bd19833e2e34"-      , "78412e3a"-      , "1BxrAr2pHpeBheusmd6fHDP2tSLAUa3qsW"-      , "704addf544a06e5ee4bea37098463c23613da32020d604506da8c0518e1da4b7"-      , "KzyzXnznxSv249b4KuNkBwowaN3akiNeEHy5FWoPCJpStZbEKXN2"-      , "03a7d1d856deb74c508e05031f9895dab54626251b3806e16b4bd12e781a7df5b9"-      , "f366f48f1ea9f2d1d3fe958c95ca84ea18e4c4ddb9366c336c927eb246fb38cb"-      , "0488b21e03d8ab493700000001f366f48f1ea9f2d1d3fe958c95ca84ea18e4c4ddb9366c336c927eb246fb38cb03a7d1d856deb74c508e05031f9895dab54626251b3806e16b4bd12e781a7df5b9"-      , "0488ade403d8ab493700000001f366f48f1ea9f2d1d3fe958c95ca84ea18e4c4ddb9366c336c927eb246fb38cb00704addf544a06e5ee4bea37098463c23613da32020d604506da8c0518e1da4b7"-      , "xpub6DF8uhdarytz3FWdA8TvFSvvAh8dP3283MY7p2V4SeE2wyWmG5mg5EwVvmdMVCQcoNJxGoWaU9DCWh89LojfZ537wTfunKau47EL2dhHKon"-      , "xprv9zFnWC6h2cLgpmSA46vutJzBcfJ8yaJGg8cX1e5StJh45BBciYTRXSd25UEPVuesF9yog62tGAQtHjXajPPdbRCHuWS6T8XA2ECKADdw4Ef"-      ]-      -- m/0/2147483647'/1/2147483646'-    , [ "31a507b815593dfc51ffc7245ae7e5aee304246e"-      , "31a507b8"-      , "15XVotxCAV7sRx1PSCkQNsGw3W9jT9A94R"-      , "f1c7c871a54a804afe328b4c83a1c33b8e5ff48f5087273f04efa83b247d6a2d"-      , "L5KhaMvPYRW1ZoFmRjUtxxPypQ94m6BcDrPhqArhggdaTbbAFJEF"-      , "02d2b36900396c9282fa14628566582f206a5dd0bcc8d5e892611806cafb0301f0"-      , "637807030d55d01f9a0cb3a7839515d796bd07706386a6eddf06cc29a65a0e29"-      , "0488b21e0478412e3afffffffe637807030d55d01f9a0cb3a7839515d796bd07706386a6eddf06cc29a65a0e2902d2b36900396c9282fa14628566582f206a5dd0bcc8d5e892611806cafb0301f0"-      , "0488ade40478412e3afffffffe637807030d55d01f9a0cb3a7839515d796bd07706386a6eddf06cc29a65a0e2900f1c7c871a54a804afe328b4c83a1c33b8e5ff48f5087273f04efa83b247d6a2d"-      , "xpub6ERApfZwUNrhLCkDtcHTcxd75RbzS1ed54G1LkBUHQVHQKqhMkhgbmJbZRkrgZw4koxb5JaHWkY4ALHY2grBGRjaDMzQLcgJvLJuZZvRcEL"-      , "xprvA1RpRA33e1JQ7ifknakTFpgNXPmW2YvmhqLQYMmrj4xJXXWYpDPS3xz7iAxn8L39njGVyuoseXzU6rcxFLJ8HFsTjSyQbLYnMpCqE2VbFWc"-      ]-      -- m/0/2147483647'/1/2147483646'/2-    , [ "26132fdbe7bf89cbc64cf8dafa3f9f88b8666220"-      , "26132fdb"-      , "14UKfRV9ZPUp6ZC9PLhqbRtxdihW9em3xt"-      , "bb7d39bdb83ecf58f2fd82b6d918341cbef428661ef01ab97c28a4842125ac23"-      , "L3WAYNAZPxx1fr7KCz7GN9nD5qMBnNiqEJNJMU1z9MMaannAt4aK"-      , "024d902e1a2fc7a8755ab5b694c575fce742c48d9ff192e63df5193e4c7afe1f9c"-      , "9452b549be8cea3ecb7a84bec10dcfd94afe4d129ebfd3b3cb58eedf394ed271"-      , "0488b21e0531a507b8000000029452b549be8cea3ecb7a84bec10dcfd94afe4d129ebfd3b3cb58eedf394ed271024d902e1a2fc7a8755ab5b694c575fce742c48d9ff192e63df5193e4c7afe1f9c"-      , "0488ade40531a507b8000000029452b549be8cea3ecb7a84bec10dcfd94afe4d129ebfd3b3cb58eedf394ed27100bb7d39bdb83ecf58f2fd82b6d918341cbef428661ef01ab97c28a4842125ac23"-      , "xpub6FnCn6nSzZAw5Tw7cgR9bi15UV96gLZhjDstkXXxvCLsUXBGXPdSnLFbdpq8p9HmGsApME5hQTZ3emM2rnY5agb9rXpVGyy3bdW6EEgAtqt"-      , "xprvA2nrNbFZABcdryreWet9Ea4LvTJcGsqrMzxHx98MMrotbir7yrKCEXw7nadnHM8Dq38EGfSh6dqA9QWTyefMLEcBYJUuekgW4BYPJcr9E7j"-      ]-    ]--pubKeyOfSubKeyIsSubKeyOfPubKey :: XPrvKey -> Word32 -> Bool-pubKeyOfSubKeyIsSubKeyOfPubKey k i =-    deriveXPubKey (prvSubKey k i') == pubSubKey (deriveXPubKey k) i'-  where-    i' = fromIntegral $ i .&. 0x7fffffff -- make it a public derivation---testID :: (FromJSON a, ToJSON a, Eq a) => a -> Bool-testID x =-    (A.decode . A.encode) (singleton ("object" :: String) x) ==-    Just (singleton ("object" :: String) x)--testCustom :: Eq a => (Value -> Parser a) -> (a -> Value) -> a -> Bool-testCustom f g x = parseMaybe f (g x) == Just x--testPutGet :: Eq a => Get a -> Putter a -> a -> Bool-testPutGet g p a = runGet g (runPut (p a)) == Right a
− test/Network/Haskoin/Keys/MnemonicSpec.hs 
@@ -1,494 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}-module Network.Haskoin.Keys.MnemonicSpec (spec) where--import           Control.Monad           (zipWithM_)-import           Data.Bits               (shiftR, (.&.))-import           Data.ByteString         (ByteString)-import qualified Data.ByteString         as BS-import qualified Data.ByteString.Char8   as C-import           Data.Either             (fromRight)-import           Data.List               (isPrefixOf)-import           Data.Maybe              (fromJust)-import           Data.Serialize          (Serialize, encode)-import           Data.String.Conversions (cs)-import           Data.Text               (Text)-import qualified Data.Text               as T-import           Data.Word               (Word32, Word64)-import           Network.Haskoin.Crypto-import           Network.Haskoin.Keys-import           Network.Haskoin.Test-import           Network.Haskoin.Util-import           Test.Hspec-import           Test.HUnit-import           Test.QuickCheck         hiding ((.&.))--spec :: Spec-spec =-    describe "mnemonic" $ do-        it "entropy to mnemonic sentence" toMnemonicTest-        it "mnemonic sentence to entropy" fromMnemonicTest-        it "mnemonic sentence to seed" mnemonicToSeedTest-        it "mnemonic sentence with invalid checksum" fromMnemonicInvalidTest-        it "empty mnemonic sentence is invalid" $ sequence_ [emptyMnemonicTest]-        it "generate 12 words" $ property toMnemonic128-        it "generate 18 words" $ property toMnemonic160-        it "generate 24 words" $ property toMnemonic256-        it "generate 48 words" $ property toMnemonic512-        it "generate any number of words" $ property toMnemonicVar-        it "encode and decode 128-bit entropy" $ property fromToMnemonic128-        it "encode and decode 160-bit entropy" $ property fromToMnemonic160-        it "encode and decode 256-bit entropy" $ property fromToMnemonic256-        it "encode and decode 512-bit entropy" $ property fromToMnemonic512-        it "encode and decode n-bit entropy" $ property fromToMnemonicVar-        it "convert 128-bit mnemonic to seed" $ property mnemonicToSeed128-        it "convert 160-bit mnemonic to seed" $ property mnemonicToSeed160-        it "convert 256-bit mnemonic to seed" $ property mnemonicToSeed256-        it "convert 512-bit mnemonic to seed" $ property mnemonicToSeed512-        it "convert n-bit mnemonic to seed" $ property mnemonicToSeedVar-        it "get bits" $ property getBitsByteCount-        it "get end bits" $ property getBitsEndBits--toMnemonicTest :: Assertion-toMnemonicTest = zipWithM_ f ents mss-  where-    f e m = assertEqual "" m . h $ e-    h =-        fromRight (error "Could not decode mnemonic sentence") .-        toMnemonic . fromJust . decodeHex--fromMnemonicTest :: Assertion-fromMnemonicTest = zipWithM_ f ents mss-  where-    f e = assertEqual "" e . h-    h =-        encodeHex .-        fromRight (error "Could not decode mnemonic sentence") . fromMnemonic--mnemonicToSeedTest :: Assertion-mnemonicToSeedTest = zipWithM_ f mss seeds-  where-    f m s = assertEqual "" s . h $ m-    h =-        encodeHex .-        fromRight (error "Could not decode mnemonic seed") .-        mnemonicToSeed "TREZOR"--fromMnemonicInvalidTest :: Assertion-fromMnemonicInvalidTest = mapM_ f invalidMss-  where-    f = assertBool "" . h-    h m = case fromMnemonic m of-            Right _  -> False-            Left err -> "fromMnemonic: checksum failed:" `isPrefixOf` err--emptyMnemonicTest :: Assertion-emptyMnemonicTest =-    assertBool "" $-    case fromMnemonic "" of-        Right _  -> False-        Left err -> "fromMnemonic: empty mnemonic" `isPrefixOf` err--ents :: [Text]-ents =-    [ "00000000000000000000000000000000"-    , "7f7f7f7f7f7f7f7f7f7f7f7f7f7f7f7f"-    , "80808080808080808080808080808080"-    , "ffffffffffffffffffffffffffffffff"-    , "000000000000000000000000000000000000000000000000"-    , "7f7f7f7f7f7f7f7f7f7f7f7f7f7f7f7f7f7f7f7f7f7f7f7f"-    , "808080808080808080808080808080808080808080808080"-    , "ffffffffffffffffffffffffffffffffffffffffffffffff"-    , "0000000000000000000000000000000000000000000000000000000000000000"-    , "7f7f7f7f7f7f7f7f7f7f7f7f7f7f7f7f7f7f7f7f7f7f7f7f7f7f7f7f7f7f7f7f"-    , "8080808080808080808080808080808080808080808080808080808080808080"-    , "ffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff"-    , "77c2b00716cec7213839159e404db50d"-    , "b63a9c59a6e641f288ebc103017f1da9f8290b3da6bdef7b"-    , "3e141609b97933b66a060dcddc71fad1d91677db872031e85f4c015c5e7e8982"-    , "0460ef47585604c5660618db2e6a7e7f"-    , "72f60ebac5dd8add8d2a25a797102c3ce21bc029c200076f"-    , "2c85efc7f24ee4573d2b81a6ec66cee209b2dcbd09d8eddc51e0215b0b68e416"-    , "eaebabb2383351fd31d703840b32e9e2"-    , "7ac45cfe7722ee6c7ba84fbc2d5bd61b45cb2fe5eb65aa78"-    , "4fa1a8bc3e6d80ee1316050e862c1812031493212b7ec3f3bb1b08f168cabeef"-    , "18ab19a9f54a9274f03e5209a2ac8a91"-    , "18a2e1d81b8ecfb2a333adcb0c17a5b9eb76cc5d05db91a4"-    , "15da872c95a13dd738fbf50e427583ad61f18fd99f628c417a61cf8343c90419"-    ]--mss :: [Mnemonic]-mss =-    [ "abandon abandon abandon abandon abandon abandon abandon abandon abandon\-      \ abandon abandon about"-    , "legal winner thank year wave sausage worth useful legal winner thank\-      \ yellow"-    , "letter advice cage absurd amount doctor acoustic avoid letter advice\-      \ cage above"-    , "zoo zoo zoo zoo zoo zoo zoo zoo zoo zoo zoo wrong"-    , "abandon abandon abandon abandon abandon abandon abandon abandon abandon\-      \ abandon abandon abandon abandon abandon abandon abandon abandon agent"-    , "legal winner thank year wave sausage worth useful legal winner thank\-      \ year wave sausage worth useful legal will"-    , "letter advice cage absurd amount doctor acoustic avoid letter advice\-      \ cage absurd amount doctor acoustic avoid letter always"-    , "zoo zoo zoo zoo zoo zoo zoo zoo zoo zoo zoo zoo zoo zoo zoo zoo zoo\-      \ when"-    , "abandon abandon abandon abandon abandon abandon abandon abandon abandon\-      \ abandon abandon abandon abandon abandon abandon abandon abandon abandon\-      \ abandon abandon abandon abandon abandon art"-    , "legal winner thank year wave sausage worth useful legal winner thank\-      \ year wave sausage worth useful legal winner thank year wave sausage\-      \ worth title"-    , "letter advice cage absurd amount doctor acoustic avoid letter advice\-      \ cage absurd amount doctor acoustic avoid letter advice cage absurd\-      \ amount doctor acoustic bless"-    , "zoo zoo zoo zoo zoo zoo zoo zoo zoo zoo zoo zoo zoo zoo zoo zoo zoo zoo\-      \ zoo zoo zoo zoo zoo vote"-    , "jelly better achieve collect unaware mountain thought cargo oxygen act\-      \ hood bridge"-    , "renew stay biology evidence goat welcome casual join adapt armor shuffle\-      \ fault little machine walk stumble urge swap"-    , "dignity pass list indicate nasty swamp pool script soccer toe leaf photo\-      \ multiply desk host tomato cradle drill spread actor shine dismiss\-      \ champion exotic"-    , "afford alter spike radar gate glance object seek swamp infant panel\-      \ yellow"-    , "indicate race push merry suffer human cruise dwarf pole review arch keep\-      \ canvas theme poem divorce alter left"-    , "clutch control vehicle tonight unusual clog visa ice plunge glimpse\-      \ recipe series open hour vintage deposit universe tip job dress radar\-      \ refuse motion taste"-    , "turtle front uncle idea crush write shrug there lottery flower risk\-      \ shell"-    , "kiss carry display unusual confirm curtain upgrade antique rotate hello\-      \ void custom frequent obey nut hole price segment"-    , "exile ask congress lamp submit jacket era scheme attend cousin alcohol\-      \ catch course end lucky hurt sentence oven short ball bird grab wing top"-    , "board flee heavy tunnel powder denial science ski answer betray cargo\-      \ cat"-    , "board blade invite damage undo sun mimic interest slam gaze truly\-      \ inherit resist great inject rocket museum chief"-    , "beyond stage sleep clip because twist token leaf atom beauty genius food\-      \ business side grid unable middle armed observe pair crouch tonight away\-      \ coconut"-    ]--seeds :: [Text]-seeds =-    [ "c55257c360c07c72029aebc1b53c05ed0362ada38ead3e3e9efa3708e53495531f09a69\-      \87599d18264c1e1c92f2cf141630c7a3c4ab7c81b2f001698e7463b04"-    , "2e8905819b8723fe2c1d161860e5ee1830318dbf49a83bd451cfb8440c28bd6fa457fe1\-      \296106559a3c80937a1c1069be3a3a5bd381ee6260e8d9739fce1f607"-    , "d71de856f81a8acc65e6fc851a38d4d7ec216fd0796d0a6827a3ad6ed5511a30fa280f1\-      \2eb2e47ed2ac03b5c462a0358d18d69fe4f985ec81778c1b370b652a8"-    , "ac27495480225222079d7be181583751e86f571027b0497b5b5d11218e0a8a133325729\-      \17f0f8e5a589620c6f15b11c61dee327651a14c34e18231052e48c069"-    , "035895f2f481b1b0f01fcf8c289c794660b289981a78f8106447707fdd9666ca06da5a9\-      \a565181599b79f53b844d8a71dd9f439c52a3d7b3e8a79c906ac845fa"-    , "f2b94508732bcbacbcc020faefecfc89feafa6649a5491b8c952cede496c214a0c7b3c3\-      \92d168748f2d4a612bada0753b52a1c7ac53c1e93abd5c6320b9e95dd"-    , "107d7c02a5aa6f38c58083ff74f04c607c2d2c0ecc55501dadd72d025b751bc27fe913f\-      \fb796f841c49b1d33b610cf0e91d3aa239027f5e99fe4ce9e5088cd65"-    , "0cd6e5d827bb62eb8fc1e262254223817fd068a74b5b449cc2f667c3f1f985a76379b43\-      \348d952e2265b4cd129090758b3e3c2c49103b5051aac2eaeb890a528"-    , "bda85446c68413707090a52022edd26a1c9462295029f2e60cd7c4f2bbd3097170af7a4\-      \d73245cafa9c3cca8d561a7c3de6f5d4a10be8ed2a5e608d68f92fcc8"-    , "bc09fca1804f7e69da93c2f2028eb238c227f2e9dda30cd63699232578480a4021b146a\-      \d717fbb7e451ce9eb835f43620bf5c514db0f8add49f5d121449d3e87"-    , "c0c519bd0e91a2ed54357d9d1ebef6f5af218a153624cf4f2da911a0ed8f7a09e2ef61a\-      \f0aca007096df430022f7a2b6fb91661a9589097069720d015e4e982f"-    , "dd48c104698c30cfe2b6142103248622fb7bb0ff692eebb00089b32d22484e1613912f0\-      \a5b694407be899ffd31ed3992c456cdf60f5d4564b8ba3f05a69890ad"-    , "b5b6d0127db1a9d2226af0c3346031d77af31e918dba64287a1b44b8ebf63cdd52676f6\-      \72a290aae502472cf2d602c051f3e6f18055e84e4c43897fc4e51a6ff"-    , "9248d83e06f4cd98debf5b6f010542760df925ce46cf38a1bdb4e4de7d21f5c39366941\-      \c69e1bdbf2966e0f6e6dbece898a0e2f0a4c2b3e640953dfe8b7bbdc5"-    , "ff7f3184df8696d8bef94b6c03114dbee0ef89ff938712301d27ed8336ca89ef9635da2\-      \0af07d4175f2bf5f3de130f39c9d9e8dd0472489c19b1a020a940da67"-    , "65f93a9f36b6c85cbe634ffc1f99f2b82cbb10b31edc7f087b4f6cb9e976e9faf76ff41\-      \f8f27c99afdf38f7a303ba1136ee48a4c1e7fcd3dba7aa876113a36e4"-    , "3bbf9daa0dfad8229786ace5ddb4e00fa98a044ae4c4975ffd5e094dba9e0bb289349db\-      \e2091761f30f382d4e35c4a670ee8ab50758d2c55881be69e327117ba"-    , "fe908f96f46668b2d5b37d82f558c77ed0d69dd0e7e043a5b0511c48c2f1064694a956f\-      \86360c93dd04052a8899497ce9e985ebe0c8c52b955e6ae86d4ff4449"-    , "bdfb76a0759f301b0b899a1e3985227e53b3f51e67e3f2a65363caedf3e32fde42a66c4\-      \04f18d7b05818c95ef3ca1e5146646856c461c073169467511680876c"-    , "ed56ff6c833c07982eb7119a8f48fd363c4a9b1601cd2de736b01045c5eb8ab4f57b079\-      \403485d1c4924f0790dc10a971763337cb9f9c62226f64fff26397c79"-    , "095ee6f817b4c2cb30a5a797360a81a40ab0f9a4e25ecd672a3f58a0b5ba0687c096a6b\-      \14d2c0deb3bdefce4f61d01ae07417d502429352e27695163f7447a8c"-    , "6eff1bb21562918509c73cb990260db07c0ce34ff0e3cc4a8cb3276129fbcb300bddfe0\-      \05831350efd633909f476c45c88253276d9fd0df6ef48609e8bb7dca8"-    , "f84521c777a13b61564234bf8f8b62b3afce27fc4062b51bb5e62bdfecb23864ee6ecf0\-      \7c1d5a97c0834307c5c852d8ceb88e7c97923c0a3b496bedd4e5f88a9"-    , "b15509eaa2d09d3efd3e006ef42151b30367dc6e3aa5e44caba3fe4d3e352e65101fbdb\-      \86a96776b91946ff06f8eac594dc6ee1d3e82a42dfe1b40fef6bcc3fd"-    ]--invalidMss :: [Mnemonic]-invalidMss =-    [ "abandon abandon abandon abandon abandon abandon abandon abandon abandon\-      \ abandon abandon abandon"-    , "legal winner thank year wave sausage worth useful legal winner thank\-      \ thank"-    , "letter advice cage absurd amount doctor acoustic avoid letter advice\-      \ cage sausage"-    , "zoo zoo zoo zoo zoo zoo zoo zoo zoo zoo zoo zoo"-    , "abandon abandon abandon abandon abandon abandon abandon abandon abandon\-      \ abandon abandon abandon abandon abandon abandon abandon abandon abandon"-    , "legal winner thank year wave sausage worth useful legal winner thank\-      \ year wave sausage worth useful legal letter"-    , "letter advice cage absurd amount doctor acoustic avoid letter advice\-      \ cage absurd amount doctor acoustic avoid letter abandon"-    , "zoo zoo zoo zoo zoo zoo zoo zoo zoo zoo zoo zoo zoo zoo zoo zoo zoo\-      \ zoo"-    , "abandon abandon abandon abandon abandon abandon abandon abandon abandon\-      \ abandon abandon abandon abandon abandon abandon abandon abandon abandon\-      \ abandon abandon abandon abandon abandon abandon"-    , "legal winner thank year wave sausage worth useful legal winner thank\-      \ year wave sausage worth useful legal winner thank year wave sausage\-      \ worth letter"-    , "letter advice cage absurd amount doctor acoustic avoid letter advice\-      \ cage absurd amount doctor acoustic avoid letter advice cage absurd\-      \ amount doctor acoustic letter"-    , "zoo zoo zoo zoo zoo zoo zoo zoo zoo zoo zoo zoo zoo zoo zoo zoo zoo zoo\-      \ zoo zoo zoo zoo zoo zoo"-    , "jelly better achieve collect unaware mountain thought cargo oxygen act\-      \ hood zoo"-    , "renew stay biology evidence goat welcome casual join adapt armor shuffle\-      \ fault little machine walk stumble urge zoo"-    , "dignity pass list indicate nasty swamp pool script soccer toe leaf photo\-      \ multiply desk host tomato cradle drill spread actor shine dismiss\-      \ champion zoo"-    , "afford alter spike radar gate glance object seek swamp infant panel\-      \ zoo"-    , "indicate race push merry suffer human cruise dwarf pole review arch keep\-      \ canvas theme poem divorce alter zoo"-    , "clutch control vehicle tonight unusual clog visa ice plunge glimpse\-      \ recipe series open hour vintage deposit universe tip job dress radar\-      \ refuse motion zoo"-    , "turtle front uncle idea crush write shrug there lottery flower risk\-      \ zoo"-    , "kiss carry display unusual confirm curtain upgrade antique rotate hello\-      \ void custom frequent obey nut hole price zoo"-    , "exile ask congress lamp submit jacket era scheme attend cousin alcohol\-      \ catch course end lucky hurt sentence oven short ball bird grab wing zoo"-    , "board flee heavy tunnel powder denial science ski answer betray cargo\-      \ zoo"-    , "board blade invite damage undo sun mimic interest slam gaze truly\-      \ inherit resist great inject rocket museum zoo"-    , "beyond stage sleep clip because twist token leaf atom beauty genius food\-      \ business side grid unable middle armed observe pair crouch tonight away\-      \ zoo"-    ]--binWordsToBS :: Serialize a => [a] -> BS.ByteString-binWordsToBS = foldr f BS.empty-  where-    f b a = a `BS.append` encode b--{- Encode mnemonic -}--toMnemonic128 :: (Word64, Word64) -> Bool-toMnemonic128 (a, b) = l == 12-  where-    bs = encode a `BS.append` encode b-    l =-        length .-        T.words . fromRight (error "Could not decode mnemonic senttence") $-        toMnemonic bs--toMnemonic160 :: (Word32, Word64, Word64) -> Bool-toMnemonic160 (a, b, c) = l == 15-  where-    bs = BS.concat [encode a, encode b, encode c]-    l =-        length .-        T.words . fromRight (error "Could not decode mnemonic sentence") $-        toMnemonic bs--toMnemonic256 :: (Word64, Word64, Word64, Word64) -> Bool-toMnemonic256 (a, b, c, d) = l == 24-  where-    bs = BS.concat [encode a, encode b, encode c, encode d]-    l =-        length .-        T.words . fromRight (error "Could not decode mnemonic sentence") $-        toMnemonic bs--toMnemonic512 ::-    ((Word64, Word64, Word64, Word64), (Word64, Word64, Word64, Word64)) -> Bool-toMnemonic512 ((a, b, c, d), (e, f, g, h)) = l == 48-  where-    bs =-        BS.concat-            [ encode a-            , encode b-            , encode c-            , encode d-            , encode e-            , encode f-            , encode g-            , encode h-            ]-    l =-        length .-        T.words . fromRight (error "Could not decode mnemonic sentence") $-        toMnemonic bs--toMnemonicVar :: [Word32] -> Property-toMnemonicVar ls = not (null ls) && length ls <= 8 ==> l == wc-  where-    bs = binWordsToBS ls-    bl = BS.length bs-    cb = bl `div` 4-    wc = (cb + bl * 8) `div` 11-    l =-        length . T.words .-        fromRight (error "Could not decode mnemonic sentence") $-        toMnemonic bs--{- Encode/Decode -}--fromToMnemonic128 :: (Word64, Word64) -> Bool-fromToMnemonic128 (a, b) = bs == bs'-  where-    bs = encode a `BS.append` encode b-    bs' =-        fromRight-            (error "Could not decode mnemonic entropy")-            (fromMnemonic =<< toMnemonic bs)--fromToMnemonic160 :: (Word32, Word64, Word64) -> Bool-fromToMnemonic160 (a, b, c) = bs == bs'-  where-    bs = BS.concat [encode a, encode b, encode c]-    bs' =-        fromRight-            (error "Could not decode mnemonic entropy")-            (fromMnemonic =<< toMnemonic bs)--fromToMnemonic256 :: (Word64, Word64, Word64, Word64) -> Bool-fromToMnemonic256 (a, b, c, d) = bs == bs'-  where-    bs = BS.concat [encode a, encode b, encode c, encode d]-    bs' =-        fromRight-            (error "Could not decode mnemonic entropy")-            (fromMnemonic =<< toMnemonic bs)--fromToMnemonic512 ::-    ((Word64, Word64, Word64, Word64), (Word64, Word64, Word64, Word64)) -> Bool-fromToMnemonic512 ((a, b, c, d), (e, f, g, h)) = bs == bs'-  where-    bs =-        BS.concat-            [ encode a-            , encode b-            , encode c-            , encode d-            , encode e-            , encode f-            , encode g-            , encode h-            ]-    bs' =-        fromRight-            (error "Could not decode mnemonic entropy")-            (fromMnemonic =<< toMnemonic bs)--fromToMnemonicVar :: [Word32] -> Property-fromToMnemonicVar ls = not (null ls) && length ls <= 8 ==> bs == bs'-  where-    bs = binWordsToBS ls-    bs' =-        fromRight-            (error "Could not decode mnemonic entropy")-            (fromMnemonic =<< toMnemonic bs)--{- Mnemonic to seed -}--mnemonicToSeed128 :: (Word64, Word64) -> Bool-mnemonicToSeed128 (a, b) = l == 64-  where-    bs = encode a `BS.append` encode b-    seed =-        fromRight-            (error "Could not decode mnemonic seed")-            (mnemonicToSeed "" =<< toMnemonic bs)-    l = BS.length seed--mnemonicToSeed160 :: (Word32, Word64, Word64) -> Bool-mnemonicToSeed160 (a, b, c) = l == 64-  where-    bs = BS.concat [encode a, encode b, encode c]-    seed =-        fromRight-            (error "Could not decode mnemonic seed")-            (mnemonicToSeed "" =<< toMnemonic bs)-    l = BS.length seed--mnemonicToSeed256 :: (Word64, Word64, Word64, Word64) -> Bool-mnemonicToSeed256 (a, b, c, d) = l == 64-  where-    bs = BS.concat [encode a, encode b, encode c, encode d]-    seed =-        fromRight-            (error "Could not decode mnemonic seed")-            (mnemonicToSeed "" =<< toMnemonic bs)-    l = BS.length seed--mnemonicToSeed512 ::-    ((Word64, Word64, Word64, Word64), (Word64, Word64, Word64, Word64)) -> Bool-mnemonicToSeed512 ((a, b, c, d), (e, f, g, h)) = l == 64-  where-    bs =-        BS.concat-            [ encode a-            , encode b-            , encode c-            , encode d-            , encode e-            , encode f-            , encode g-            , encode h-            ]-    seed =-        fromRight-            (error "Could not decode mnemonic seed")-            (mnemonicToSeed "" =<< toMnemonic bs)-    l = BS.length seed--mnemonicToSeedVar :: [Word32] -> Property-mnemonicToSeedVar ls = not (null ls) && length ls <= 16 ==> l == 64-  where-    bs = binWordsToBS ls-    seed =-        fromRight-            (error "Could not decode mnemonic seed")-            (mnemonicToSeed "" =<< toMnemonic bs)-    l = BS.length seed--{- Get bits from ByteString -}--data ByteCountGen = ByteCountGen BS.ByteString Int deriving Show--instance Arbitrary ByteCountGen where-    arbitrary = do-        bs <- arbitraryBS-        i <- choose (0, BS.length bs * 8)-        return $ ByteCountGen bs i--getBitsByteCount :: ByteCountGen -> Bool-getBitsByteCount (ByteCountGen bs i) = BS.length bits == l-  where-    (q, r) = i `quotRem` 8-    bits = getBits i bs-    l = if r == 0 then q else q + 1--getBitsEndBits :: ByteCountGen -> Bool-getBitsEndBits (ByteCountGen bs i) =-    (r == 0) || (BS.last bits .&. (0xff `shiftR` r) == 0x00)-  where-    r = i `mod` 8-    bits = getBits i bs
− test/Network/Haskoin/KeysSpec.hs 
@@ -1,72 +0,0 @@-module Network.Haskoin.KeysSpec (spec) where--import           Data.Aeson                as A-import qualified Data.ByteString           as BS-import           Data.Map.Strict           (singleton)-import           Data.Serialize            as S-import           Data.String               (fromString)-import           Data.String.Conversions   (cs)-import           Network.Haskoin.Address-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.QuickCheck--spec :: Spec-spec =-    describe "keys" $ do-        let net = btc-        it "is public key canonical" $-            property $ forAll arbitraryKeyPair (isCanonicalPubKey . snd)-        it "encode and decode wif private keys" $-            property $-            forAll arbitraryKeyPair $ \(pk, _) ->-                fromWif net (toWif net pk) == Just pk-        it "encode and decode serialized private key" $-            property $ forAll arbitrary binaryPrvKey-        it "read and show public key" $-            property $ forAll arbitraryKeyPair $ \(_, k) -> read (show k) == k-        it "read and show private key" $-            property $ forAll arbitrarySecKeyI $ \k -> read (show k) == k-        it "from string public key" $-            property $-            forAll arbitraryKeyPair $ \(_, k) ->-                fromString (cs . encodeHex $ S.encode k) == k-        it "encode and decode json public key" $-            property $ forAll arbitraryKeyPair (testID . snd)-        it "encodes and decodes serialized public key" $-            property $ forAll arbitraryKeyPair $ cerealID . snd----- github.com/bitcoin/bitcoin/blob/master/src/script.cpp--- from function IsCanonicalPubKey-isCanonicalPubKey :: PubKeyI -> Bool-isCanonicalPubKey p = not $-    -- Non-canonical public key: too short-    (BS.length bs < 33) ||-    -- Non-canonical public key: invalid length for uncompressed key-    (BS.index bs 0 == 4 && BS.length bs /= 65) ||-    -- Non-canonical public key: invalid length for compressed key-    (BS.index bs 0 `elem` [2,3] && BS.length bs /= 33) ||-    -- Non-canonical public key: compressed nor uncompressed-    (BS.index bs 0 `notElem` [2,3,4])-  where-    bs = S.encode p--{- Key formats -}--binaryPrvKey :: SecKey -> Bool-binaryPrvKey k =-    Right k == runGet secKeyGet (runPut (secKeyPut k)) &&-    Just k == secKey (getSecKey k)--testID :: (FromJSON a, ToJSON a, Eq a) => a -> Bool-testID x =-    (A.decode . A.encode) (singleton ("object" :: String) x) ==-    Just (singleton ("object" :: String) x)--cerealID :: (Serialize a, Eq a) => a -> Bool-cerealID x = S.decode (S.encode x) == Right x
− test/Network/Haskoin/NetworkSpec.hs 
@@ -1,187 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}-module Network.Haskoin.NetworkSpec (spec) where--import           Data.Maybe                  (fromJust)-import           Data.Serialize              as S-import           Data.Text                   (Text)-import           Data.Word                   (Word32)-import           Network.Haskoin.Address-import           Network.Haskoin.Constants-import           Network.Haskoin.Keys-import           Network.Haskoin.Network-import           Network.Haskoin.Test-import           Network.Haskoin.Transaction-import           Network.Haskoin.Util-import           Test.Hspec-import           Test.HUnit                  (Assertion, assertBool,-                                              assertEqual)-import           Test.QuickCheck--spec :: Spec-spec = do-    let net = btc-    describe "bloom filters" $ do-        it "bloom filter vector 1" bloomFilter1-        it "bloom filter vector 2" bloomFilter2-        it "bloom filter vector 3" bloomFilter3-    describe "relevant bloom filter update" $ do-        it "Relevant Update" relevantOutputUpdated-        it "Irrelevant Update" irrelevantOutputNotUpdated-    describe "serialization of protocol types" $ do-        it "encodes and decodes varint" $-            property $ forAll arbitraryVarInt cerealID-        it "encodes and decodes varstring" $-            property $ forAll arbitraryVarString cerealID-        it "encodes and decodes network address" $-            property $ forAll arbitraryNetworkAddress cerealID-        it "encodes and decodes invtype" $-            property $ forAll arbitraryInvType cerealID-        it "encodes and decodes invvector" $-            property $ forAll arbitraryInvVector cerealID-        it "encodes and decodes inv" $ property $ forAll arbitraryInv1 cerealID-        it "encodes and decodes version" $-            property $ forAll arbitraryVersion cerealID-        it "encodes and decodes addr" $ property $ forAll arbitraryAddr1 cerealID-        it "encodes and decodes alert" $ property $ forAll arbitraryAlert cerealID-        it "encodes and decodes reject" $-            property $ forAll arbitraryReject cerealID-        it "encodes and decodes getdata" $-            property $ forAll arbitraryGetData cerealID-        it "encodes and decodes notfound" $-            property $ forAll arbitraryNotFound cerealID-        it "encodes and decodes ping" $ property $ forAll arbitraryPing cerealID-        it "encodes and decodes pong" $ property $ forAll arbitraryPong cerealID-        it "encodes and decodes message command" $-            property $ forAll arbitraryMessageCommand cerealID-        it "encodes and decodes message header" $-            property $ forAll arbitraryMessageHeader cerealID-        it "encodes and decodes message" $-            property $-            forAll (arbitraryMessage net) $-            testPutGet (getMessage net) (putMessage net)-    describe "serialization of bloom types" $ do-        it "encodes and decodes bloom flags" $-            property $ forAll arbitraryBloomFlags cerealID-        it "encodes and decodes bloom filter" $-            property $ forAll arbitraryBloomFilter $ cerealID . lst3-        it "encodes and decodes filterload" $-            property $ forAll arbitraryFilterLoad cerealID-        it "encodes and decodes filteradd" $-            property $ forAll arbitraryFilterAdd cerealID--bloomFilter :: Word32 -> Text -> Assertion-bloomFilter n x = do-    assertBool "Bloom filter doesn't contain vector 1" $ bloomContains f1 v1-    assertBool "Bloom filter contains something it should not" $-        not $ bloomContains f1 v2-    assertBool "Bloom filter doesn't contain vector 3" $ bloomContains f3 v3-    assertBool "Bloom filter doesn't contain vector 4" $ bloomContains f4 v4-    assertBool "Bloom filter serialization is incorrect" $-        S.encode f4 == bs-  where-    f0 = bloomCreate 3 0.01 n BloomUpdateAll-    f1 = bloomInsert f0 v1-    f3 = bloomInsert f1 v3-    f4 = bloomInsert f3 v4-    v1 = fromJust $ decodeHex "99108ad8ed9bb6274d3980bab5a85c048f0950c8"-    v2 = fromJust $ decodeHex "19108ad8ed9bb6274d3980bab5a85c048f0950c8"-    v3 = fromJust $ decodeHex "b5a2c786d9ef4658287ced5914b37a1b4aa32eee"-    v4 = fromJust $ decodeHex "b9300670b4c5366e95b2699e8b18bc75e5f729c5"-    bs = fromJust $ decodeHex x--bloomFilter1 :: Assertion-bloomFilter1 = bloomFilter 0 "03614e9b050000000000000001"--bloomFilter2 :: Assertion-bloomFilter2 = bloomFilter 2147483649 "03ce4299050000000100008001"--bloomFilter3 :: Assertion-bloomFilter3 =-    assertBool "Bloom filter serialization is incorrect" $-        S.encode f2 == bs-  where-    f0 = bloomCreate 2 0.001 0 BloomUpdateAll-    f1 = bloomInsert f0 $ S.encode p-    f2 = bloomInsert f1 $ S.encode $ getAddrHash160 $ pubKeyAddr p-    k = fromJust $ fromWif btc "5Kg1gnAjaLfKiwhhPpGS3QfRg2m6awQvaj98JCZBZQ5SuS2F15C"-    p = derivePubKeyI k-    bs = fromJust $ decodeHex "038fc16b080000000000000001"--cerealID :: (Serialize a, Eq a) => a -> Bool-cerealID x = S.decode (S.encode x) == Right x--testPutGet :: Eq a => Get a -> Putter a -> a -> Bool-testPutGet g p a = runGet g (runPut (p a)) == Right a--relevantOutputUpdated :: Assertion-relevantOutputUpdated = assertBool "Bloom filter output updated" $-    any (bloomContains bf2) spendTxInput-    where-        bf0 = bloomCreate 10 0.000001 0 BloomUpdateAll-        relevantOutputHash = fromJust $ decodeHex"03f47604ea2736334151081e13265b4fe38e6fa8"-        bf1 = bloomInsert bf0 relevantOutputHash-        bf2 = fromJust $ bloomRelevantUpdate bf1 relevantTx-        spendTxInput = (encode .prevOutput) <$> txIn spendRelevantTx--irrelevantOutputNotUpdated :: Assertion-irrelevantOutputNotUpdated = assertEqual "Bloom filter not updated" Nothing bf2-    where-        bf0 = bloomCreate 10 0.000001 0 BloomUpdateAll-        relevantOutputHash = fromJust $ decodeHex"03f47604ea2736334151081e13265b4fe38e6fa8"-        bf1 = bloomInsert bf0 relevantOutputHash-        bf2 = bloomRelevantUpdate bf1 unrelatedTx-        spendTxInput = (encode .prevOutput) <$> txIn spendRelevantTx---- Random transaction (57dc904f32ad4daab7b321dd469e8791ad09df784cdd273a73985150a4f225e9)-relevantTx :: Tx-relevantTx = Tx-        { txVersion = 1-        , txIn = [ TxIn-            { prevOutput = OutPoint "35fe9017b7e3af592920b56fa06ac02faf0c52cdb19dcb416129ac71c95d060e" 1-            , scriptInput = fromJust $ decodeHex "473044022032fc8eef299b7e94b9a986a6aa2dcb9733ab804bef80df995e443b9c1f8c604202203335df7a2e2b4789451cdb4b2b05a786a81c51519eb6a567fd6fe8cd7b2d33fe014104272502dc63a512dad1473cb82a71be9baf4f4303abd1ff6028fc8a78e1f3aec1218907119dec14f07354850758ff0948e88a904fa411c4df7d5444414ec64ad6"-            , txInSequence = 4294967295-            } ]-        , txOut =-            [ TxOut { outValue = 100000000, scriptOutput = fromJust $ decodeHex "76a91403f47604ea2736334151081e13265b4fe38e6fa888ac" }-            , TxOut { outValue = 107980000, scriptOutput = fromJust $ decodeHex "76a91481cc186a2f4a69f633ed4bf10ef4a78be13effdd88ac" }-            ]-        , txWitness = []-        , txLockTime = 0-        }---- Transaction that spends above (fd6e3b693b844aa431fad46765c1aa019a6b13aebfa9dae916b3ffa43283a300)-spendRelevantTx :: Tx-spendRelevantTx = Tx-        { txVersion = 1-        , txIn = [ TxIn-            { prevOutput = OutPoint "57dc904f32ad4daab7b321dd469e8791ad09df784cdd273a73985150a4f225e9" 0-            , scriptInput = fromJust $ decodeHex "483045022100ecc334821e4e94cc2fdc841d5ad147d5bb942b993ba81460cc446e0410afa811022015fcbc542b734dbb61a05ec06012095096de5839c50808fe56f2b315e877c20d012103fb64e5792fa586172339b776b7017d3d529358cb73be6406a1fc994228d14f88"-            , txInSequence = 4294967295-            }, TxIn-            { prevOutput = OutPoint "cfee6a8d6e68e8fd16df6fff010afffcd19d7e075aa7b707dd1bae6adc420042" 0-            , scriptInput = fromJust $ decodeHex "47304402200e6bb95fa606f254d17089d83c4ceeb19c5d1699b4faddcd4f1f1568286e6b650220087fb8439f31e1b30e47710d095422405f601d6151f2f93e125e1a08a6e29ad4012103b49252e8fc6d5b49c8d14ee71fab45591df4a126a6c453c724f3d356e38f0cee"-            , txInSequence = 4294967295-            } ]-        , txOut =-            [ TxOut { outValue = 3851100, scriptOutput = fromJust $ decodeHex "76a914a297cae82a9a3b932bf023ae274fe2585295c9ca88ac" }-            , TxOut { outValue = 111000000, scriptOutput = fromJust $ decodeHex "76a9148f952c38600a61385974acc30a64f74407f9801488ac" }-            ]-        , txWitness = []-        , txLockTime = 0-        }---- This random transaction is unrelated to the others-unrelatedTx :: Tx-unrelatedTx = Tx-        { txVersion = 1-        , txIn = [ TxIn-            { prevOutput = OutPoint "3ec3a71431c68e5d978a5fb4a0a1081d8bee8384d8aa4c06b1fbaf9413e2214f" 20-            , scriptInput = fromJust $ decodeHex "483045022100ec9c202c9d3140b973aca9d7f21a82138aa4cfa43fddc5419098ac5e26a6f152022010848fd688f290ae010fb5cb493410caa03145fc12445900ec1ad2bde33aecd9012102c7445e72d723f99a0064526c28269d07f47c8fd81531a94a8d3bf5ebd5e23ef1"-            , txInSequence = 4294967295-            }]-        , txOut =-            [ TxOut { outValue = 12600000, scriptOutput = fromJust $ decodeHex "76a9148fef3b7051de8cc44e966159e7ea37f4520187e888ac" }-            ]-        , txWitness = []-        , txLockTime = 0-        }
− test/Network/Haskoin/ScriptSpec.hs 
@@ -1,406 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}-module Network.Haskoin.ScriptSpec (spec) where--import           Control.Monad-import           Data.Aeson                  as A-import           Data.ByteString             (ByteString)-import qualified Data.ByteString             as B-import qualified Data.ByteString.Lazy        as L-import           Data.Either-import           Data.List-import           Data.Map.Strict             (singleton)-import           Data.Maybe-import           Data.Monoid                 ((<>))-import           Data.Serialize              as S-import           Data.String-import           Data.String.Conversions     (cs)-import           Data.Text                   (Text)-import           Data.Word-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.Util-import           Test.Hspec-import           Test.HUnit                  as HUnit-import           Test.QuickCheck-import           Text.Read--spec :: Spec-spec = do-    let net = btc-    describe "btc scripts" $ props btc-    describe "bch scripts" $ props bch-    describe "multi signatures" $-        zipWithM_ (curry mapMulSigVector) mulSigVectors [0 ..]-    describe "signature decoding" $-        zipWithM_ (curry (sigDecodeMap net)) scriptSigSignatures [0 ..]-    describe "json serialization" $ do-        it "encodes and decodes script output" $-            forAll (arbitraryScriptOutput net) testID-        it "encodes and decodes outpoint" $ forAll arbitraryOutPoint testID-        it "encodes and decodes sighash" $ forAll arbitrarySigHash testID-        it "encodes and decodes siginput" $-            forAll (arbitrarySigInput net) (testID . fst)-    describe "script serialization" $ do-        it "encodes and decodes script op" $-            property $ forAll arbitraryScriptOp cerealID-        it "encodes and decodes script" $-            property $ forAll arbitraryScript cerealID--props :: Network -> Spec-props net = do-    standardSpec net-    strictSigSpec net-    scriptSpec net-    txSigHashForkIdSpec net-    forkIdScriptSpec net-    sigHashSpec net-    txSigHashSpec net--cerealID :: (Serialize a, Eq a) => a -> Bool-cerealID x = S.decode (S.encode x) == Right x--standardSpec :: Network -> Spec-standardSpec net = do-    it "has intToScriptOp . scriptOpToInt identity" $-        property $-        forAll arbitraryIntScriptOp $ \i ->-            intToScriptOp <$> scriptOpToInt i `shouldBe` Right i-    it "has decodeOutput . encodeOutput identity" $-        property $-        forAll (arbitraryScriptOutput net) $ \so ->-            decodeOutput (encodeOutput so) `shouldBe` Right so-    it "has decodeInput . encodeOutput identity" $-        property $-        forAll (arbitraryScriptInput net) $ \si ->-            decodeInput net (encodeInput si) `shouldBe` Right si-    it "can sort multisig scripts" $-        forAll arbitraryMSOutput $ \out ->-            map S.encode (getOutputMulSigKeys (sortMulSig out)) `shouldSatisfy` \xs ->-                xs == sort xs-    it "can decode inputs with empty signatures" $ do-        decodeInput net (Script [OP_0]) `shouldBe`-            Right (RegularInput (SpendPK TxSignatureEmpty))-        decodeInput net (Script [opPushData ""]) `shouldBe`-            Right (RegularInput (SpendPK TxSignatureEmpty))-        let pk =-                derivePubKeyI $-                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`-            Right (RegularInput (SpendMulSig [TxSignatureEmpty]))-        decodeInput net (Script [OP_0, OP_0, OP_0, OP_0]) `shouldBe`-            Right (RegularInput (SpendMulSig $ replicate 3 TxSignatureEmpty))--scriptSpec :: Network -> Spec-scriptSpec net =-    when (getNetworkName net == "btc") $-    it "can verify standard scripts from script_tests.json file" $ do-        xs <- readTestFile "script_tests" :: IO [A.Value]-        let vectorsA =-                mapMaybe (A.decode . A.encode) xs :: [( String-                                                      , String-                                                      , String-                                                      , String-                                                      , String)]-            vectorsB =-                mapMaybe (A.decode . A.encode) xs :: [( [Word64]-                                                      , String-                                                      , String-                                                      , String-                                                      , String-                                                      , String)]-            vectors =-                map (\(a, b, c, d, e) -> ([0], a, b, c, d, e)) vectorsA <>-                vectorsB-        length vectors `shouldBe` 86-        forM_ vectors $ \([val], siStr, soStr, flags, res, desc)-          -- We can disable specific tests by adding a DISABLED flag in the data-         ->-            unless ("DISABLED" `isInfixOf` flags) $ do-                let _strict =-                        "DERSIG" `isInfixOf` flags ||-                        "STRICTENC" `isInfixOf` flags ||-                        "NULLDUMMY" `isInfixOf` flags-                    scriptSig     = parseScript siStr-                    scriptPubKey  = parseScript soStr-                    decodedOutput = decodeOutputBS scriptPubKey-                    ver = either (const False) $ \so ->-                        verifyStdInput-                            net-                            (spendTx scriptPubKey 0 scriptSig)-                            0-                            so-                            (val * 100000000)-                case res of-                    "OK" -> assertBool desc $ ver decodedOutput-                    _    -> assertBool desc (not $ ver decodedOutput)--forkIdScriptSpec :: Network -> Spec-forkIdScriptSpec net =-    when (isJust (getSigHashForkId net)) $-    it "can verify scripts from forkid_script_tests.json file" $ do-        xs <- readTestFile "forkid_script_tests" :: IO [A.Value]-        let vectors =-                mapMaybe (A.decode . A.encode) xs :: [( [Word64]-                                                      , String-                                                      , String-                                                      , String-                                                      , String-                                                      , String)]-        length vectors `shouldBe` 3-        forM_ vectors $ \([valBTC], siStr, soStr, _, res, _) -> do-            let val = valBTC * 100000000-                scriptSig = parseScript siStr-                scriptPubKey = parseScript soStr-                decodedOutput =-                    fromRight (error $ "Could not decode output: " <> soStr) $-                    decodeOutputBS scriptPubKey-                ver =-                    verifyStdInput-                        net-                        (spendTx scriptPubKey val scriptSig)-                        0-                        decodedOutput-                        val-            case res of-                "OK" -> ver `shouldBe` True-                _    -> ver `shouldBe` False--creditTx :: ByteString -> Word64 -> Tx-creditTx scriptPubKey val =-    Tx 1 [txI] [txO] [] 0-  where-    txO = TxOut {outValue = val, scriptOutput = scriptPubKey}-    txI =-        TxIn-        { prevOutput = nullOutPoint-        , scriptInput = S.encode $ Script [OP_0, OP_0]-        , txInSequence = maxBound-        }--spendTx :: ByteString -> Word64 -> ByteString -> Tx-spendTx scriptPubKey val scriptSig =-    Tx 1 [txI] [txO] [] 0-  where-    txO = TxOut {outValue = val, scriptOutput = B.empty}-    txI =-        TxIn-        { prevOutput = OutPoint (txHash $ creditTx scriptPubKey val) 0-        , scriptInput = scriptSig-        , txInSequence = maxBound-        }--parseScript :: String -> ByteString-parseScript str =-    B.concat $ fromMaybe err $ mapM f $ words str-  where-    f = decodeHex . cs . dropHex . replaceToken-    dropHex ('0':'x':xs) = xs-    dropHex xs           = xs-    err = error $ "Could not decode script: " <> str--replaceToken :: String -> String-replaceToken str = case readMaybe $ "OP_" <> str of-    Just opcode -> "0x" <> cs (encodeHex $ S.encode (opcode :: ScriptOp))-    _           -> str--strictSigSpec :: Network -> Spec-strictSigSpec net =-    when (getNetworkName net == "btc") $ do-        it "can decode strict signatures" $ do-            xs <- readTestFile "sig_strict"-            let vectors = mapMaybe decodeHex xs-            length vectors `shouldBe` 3-            forM_ vectors $ \sig ->-                decodeTxSig net sig `shouldSatisfy` isRight-        it "can detect non-strict signatures" $ do-            xs <- readTestFile "sig_nonstrict"-            let vectors = mapMaybe decodeHex xs-            length vectors `shouldBe` 17-            forM_ vectors $ \sig ->-                decodeTxSig net sig `shouldSatisfy` isLeft--txSigHashSpec :: Network -> Spec-txSigHashSpec net =-    when (getNetworkName net == "btc") $-    it "can produce valid sighashes from sighash.json test vectors" $ do-        xs <- readTestFile "sighash" :: IO [A.Value]-        let vectors =-                mapMaybe (A.decode . A.encode) xs :: [( String-                                                      , String-                                                      , Int-                                                      , Integer-                                                      , String)]-        length vectors `shouldBe` 500-        forM_ vectors $ \(txStr, scpStr, i, shI, resStr) -> do-            let tx = fromString txStr-                s =-                    fromMaybe (error $ "Could not decode script: " <> cs scpStr) $-                    eitherToMaybe . S.decode =<< decodeHex (cs scpStr)-                sh = fromIntegral shI-                res =-                    eitherToMaybe . S.decode . B.reverse =<<-                    decodeHex (cs resStr)-            Just (txSigHash net tx s 0 i sh) `shouldBe` res--txSigHashForkIdSpec :: Network -> Spec-txSigHashForkIdSpec net =-    when (getNetworkName net == "btc") $-    it "can produce valid sighashes from forkid_sighash.json test vectors" $ do-        xs <- readTestFile "forkid_sighash" :: IO [A.Value]-        let vectors =-                mapMaybe (A.decode . A.encode) xs :: [( String-                                                      , String-                                                      , Int-                                                      , Word64-                                                      , Integer-                                                      , String)]-        length vectors `shouldBe` 13-        forM_ vectors $ \(txStr, scpStr, i, val, shI, resStr) -> do-            let tx = fromString txStr-                s =-                    fromMaybe (error $ "Could not decode script: " <> cs scpStr) $-                    eitherToMaybe . S.decode =<< decodeHex (cs scpStr)-                sh = fromIntegral shI-                res = eitherToMaybe . S.decode =<< decodeHex (cs resStr)-            Just (txSigHashForkId net tx s val i sh) `shouldBe` res--sigHashSpec :: Network -> Spec-sigHashSpec net = do-    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 :: 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-        0xffff `sigHashAddForkId` 0x00aaaaaa `shouldBe` 0xaaaaaaff-        0xffff `sigHashAddForkId` 0xaaaaaaaa `shouldBe` 0xaaaaaaff-        0xffff `sigHashAddForkId` 0x00004444 `shouldBe` 0x004444ff-        0xff01 `sigHashAddForkId` 0x44440000 `shouldBe` 0x44000001-        0xff03 `sigHashAddForkId` 0x00550000 `shouldBe` 0x55000003-    it "can extract a forkid" $ do-        sigHashGetForkId 0x00000000 `shouldBe` 0x00000000-        sigHashGetForkId 0x80000000 `shouldBe` 0x00800000-        sigHashGetForkId 0xffffffff `shouldBe` 0x00ffffff-        sigHashGetForkId 0xabac3403 `shouldBe` 0x00abac34-    it "can build some vectors" $ do-        sigHashAll `shouldBe` 0x01-        sigHashNone `shouldBe` 0x02-        sigHashSingle `shouldBe` 0x03-        setForkIdFlag sigHashAll `shouldBe` 0x41-        setAnyoneCanPayFlag sigHashAll `shouldBe` 0x81-        setAnyoneCanPayFlag (setForkIdFlag sigHashAll) `shouldBe` 0xc1-    it "can test flags" $ do-        hasForkIdFlag sigHashAll `shouldBe` False-        hasForkIdFlag (setForkIdFlag sigHashAll) `shouldBe` True-        hasAnyoneCanPayFlag sigHashAll `shouldBe` False-        hasAnyoneCanPayFlag (setAnyoneCanPayFlag sigHashAll) `shouldBe` True-        isSigHashAll sigHashNone `shouldBe` False-        isSigHashAll sigHashAll `shouldBe` True-        isSigHashNone sigHashSingle `shouldBe` False-        isSigHashNone sigHashNone `shouldBe` True-        isSigHashSingle sigHashAll `shouldBe` False-        isSigHashSingle sigHashSingle `shouldBe` True-        isSigHashUnknown sigHashAll `shouldBe` False-        isSigHashUnknown sigHashNone `shouldBe` False-        isSigHashUnknown sigHashSingle `shouldBe` False-        isSigHashUnknown 0x00 `shouldBe` True-        isSigHashUnknown 0x04 `shouldBe` True-    it "can decodeTxSig . encode a TxSignature" $-        property $-        forAll (arbitraryTxSignature net) $ \(_, _, ts) ->-            decodeTxSig net (encodeTxSig ts) `shouldBe` Right ts-    it "can produce the sighash one" $-        property $-        forAll (arbitraryTx net) $ forAll arbitraryScript . testSigHashOne net--testSigHashOne :: Network -> Tx -> Script -> Word64 -> Bool -> Property-testSigHashOne net tx s val acp =-    not (null $ txIn tx) ==>-    if length (txIn tx) > length (txOut tx)-        then res `shouldBe` one-        else res `shouldNotBe` one-  where-    res = txSigHash net tx s val (length (txIn tx) - 1) (f sigHashSingle)-    one = "0100000000000000000000000000000000000000000000000000000000000000"-    f =-        if acp-            then setAnyoneCanPayFlag-            else id--{-- Test Utilities --}--readTestFile :: A.FromJSON a => FilePath -> IO a-readTestFile fp = do-    bs <- L.readFile $ "data/" <> fp <> ".json"-    maybe (error $ "Could not read test file " <> fp) return $ A.decode bs--{- Parse tests from bitcoin-qt repository -}--mapMulSigVector :: ((Text, Text), Int) -> Spec-mapMulSigVector (v, i) =-    it name $ runMulSigVector v-  where-    name = "check multisig vector " <> show i--runMulSigVector :: (Text, Text) -> Assertion-runMulSigVector (a, ops) = assertBool "multisig vector" $ Just a == b-  where-    s = do-        s' <- decodeHex ops-        eitherToMaybe $ S.decode s'-    b = do-        o <- s-        d <- eitherToMaybe $ decodeOutput o-        addrToString btc $ payToScriptAddress d--sigDecodeMap :: Network -> (Text, Int) -> Spec-sigDecodeMap net (_, i) =-    it ("check signature " ++ show i) func-  where-    func = testSigDecode net $ scriptSigSignatures !! i--testSigDecode :: Network -> Text -> Assertion-testSigDecode net str =-    let bs = fromJust $ decodeHex str-        eitherSig = decodeTxSig net bs-    in assertBool-           (unwords-                [ "Decode failed:"-                , fromLeft (error "Decode did not fail") eitherSig-                ]) $-       isRight eitherSig--mulSigVectors :: [(Text, Text)]-mulSigVectors =-    [ ( "3QJmV3qfvL9SuYo34YihAf3sRCW3qSinyC"-      , "52410491bba2510912a5bd37da1fb5b1673010e43d2c6d812c514e91bfa9f2eb129e1c183329db55bd868e209aac2fbc02cb33d98fe74bf23f0c235d6126b1d8334f864104865c40293a680cb9c020e7b1e106d8c1916d3cef99aa431a56d253e69256dac09ef122b1a986818a7cb624532f062c1d1f8722084861c5c3291ccffef4ec687441048d2455d2403e08708fc1f556002f1b6cd83f992d085097f9974ab08a28838f07896fbab08f39495e15fa6fad6edbfb1e754e35fa1c7844c41f322a1863d4621353ae"-      )-    ]--scriptSigSignatures :: [Text]-scriptSigSignatures =-     -- Signature in input of txid 1983a69265920c24f89aac81942b1a59f7eb30821a8b3fb258f88882b6336053-    [ "304402205ca6249f43538908151fe67b26d020306c0e59fa206cf9f3ccf641f33357119d02206c82f244d04ac0a48024fb9cc246b66e58598acf206139bdb7b75a2941a2b1e401"-      -- Signature in input of txid-      -- fb0a1d8d34fa5537e461ac384bac761125e1bfa7fec286fa72511240fa66864d.-      -- Strange DER sizes, but in Blockchain. Now invalid as Haskoin can only-      -- decode strict signatures.-      -- "3048022200002b83d59c1d23c08efd82ee0662fec23309c3adbcbd1f0b8695378db4b14e736602220000334a96676e58b1bb01784cb7c556dd8ce1c220171904da22e18fe1e7d1510db501"-    ]---testID :: (FromJSON a, ToJSON a, Eq a) => a -> Bool-testID x =-    (A.decode . A.encode) (singleton ("object" :: String) x) ==-    Just (singleton ("object" :: String) x)
− test/Network/Haskoin/Test.hs 
@@ -1,23 +0,0 @@-{-|-Module      : Network.Haskoin.Test-Copyright   : No rights reserved-License     : UNLICENSE-Maintainer  : jprupp@protonmail.ch-Stability   : experimental-Portability : POSIX--Arbitrary instances for testing.--}-module Network.Haskoin.Test-    ( module X-    ) where--import           Network.Haskoin.Test.Address     as X-import           Network.Haskoin.Test.Block       as X-import           Network.Haskoin.Test.Crypto      as X-import           Network.Haskoin.Test.Keys        as X-import           Network.Haskoin.Test.Message     as X-import           Network.Haskoin.Test.Network     as X-import           Network.Haskoin.Test.Script      as X-import           Network.Haskoin.Test.Transaction as X-import           Network.Haskoin.Test.Util        as X
− test/Network/Haskoin/Test/Address.hs 
@@ -1,25 +0,0 @@-{-|-Module      : Network.Haskoin.Test.Address-Copyright   : No rights reserved-License     : UNLICENSE-Maintainer  : jprupp@protonmail.ch-Stability   : experimental-Portability : POSIX--}-module Network.Haskoin.Test.Address where--import           Network.Haskoin.Address-import           Network.Haskoin.Test.Crypto-import           Test.QuickCheck---- | Arbitrary pay-to-public-key-hash or pay-to-script-hash address.-arbitraryAddress :: Gen Address-arbitraryAddress = oneof [arbitraryPubKeyAddress, arbitraryScriptAddress]---- | Arbitrary pay-to-public-key-hash address.-arbitraryPubKeyAddress :: Gen Address-arbitraryPubKeyAddress = p2pkhAddr <$> arbitraryHash160---- | Arbitrary pay-to-script-hash address.-arbitraryScriptAddress :: Gen Address-arbitraryScriptAddress = p2shAddr <$> arbitraryHash160
− test/Network/Haskoin/Test/Block.hs 
@@ -1,69 +0,0 @@-{-|-Module      : Network.Haskoin.Test.Block-Copyright   : No rights reserved-License     : UNLICENSE-Maintainer  : jprupp@protonmail.ch-Stability   : experimental-Portability : POSIX--}-module Network.Haskoin.Test.Block where--import           Network.Haskoin.Block.Merkle-import           Network.Haskoin.Block.Common-import           Network.Haskoin.Constants-import           Network.Haskoin.Test.Crypto-import           Network.Haskoin.Test.Network-import           Network.Haskoin.Test.Transaction-import           Test.QuickCheck---- | Block full or arbitrary transactions.-arbitraryBlock :: Network -> Gen Block-arbitraryBlock net = do-    h   <- arbitraryBlockHeader-    c   <- choose (0,10)-    txs <- vectorOf c (arbitraryTx net)-    return $ Block h txs---- | Block header with random hash.-arbitraryBlockHeader :: Gen BlockHeader-arbitraryBlockHeader =-    BlockHeader <$> arbitrary-                      <*> arbitraryBlockHash-                      <*> arbitraryHash256-                      <*> arbitrary-                      <*> arbitrary-                      <*> arbitrary---- | Arbitrary block hash.-arbitraryBlockHash :: Gen BlockHash-arbitraryBlockHash = BlockHash <$> arbitraryHash256---- | Arbitrary 'GetBlocks' object with at least one block hash.-arbitraryGetBlocks :: Gen GetBlocks-arbitraryGetBlocks =-    GetBlocks <$> arbitrary-              <*> listOf1 arbitraryBlockHash-              <*> arbitraryBlockHash---- | Arbitrary 'GetHeaders' object with at least one block header.-arbitraryGetHeaders :: Gen GetHeaders-arbitraryGetHeaders =-    GetHeaders <$> arbitrary-               <*> listOf1 arbitraryBlockHash-               <*> arbitraryBlockHash---- | Arbitrary 'Headers' object with at least one block header.-arbitraryHeaders :: Gen Headers-arbitraryHeaders =-    Headers <$> listOf1 ((,) <$> arbitraryBlockHeader <*> arbitraryVarInt)---- | Arbitrary 'MerkleBlock' with at least one hash.-arbitraryMerkleBlock :: Gen MerkleBlock-arbitraryMerkleBlock = do-    bh     <- arbitraryBlockHeader-    ntx    <- arbitrary-    hashes <- listOf1 arbitraryHash256-    c      <- choose (1,10)-    flags  <- vectorOf (c*8) arbitrary-    return $ MerkleBlock bh ntx hashes flags-
− test/Network/Haskoin/Test/Crypto.hs 
@@ -1,33 +0,0 @@-{-|-Module      : Network.Haskoin.Test.Crypto-Copyright   : No rights reserved-License     : UNLICENSE-Maintainer  : jprupp@protonmail.ch-Stability   : experimental-Portability : POSIX--}-module Network.Haskoin.Test.Crypto where--import           Network.Haskoin.Crypto.Hash-import           Network.Haskoin.Test.Util-import           Test.QuickCheck---- | Arbitrary 160-bit hash.-arbitraryHash160 :: Gen Hash160-arbitraryHash160 =-    ripemd160 <$> arbitraryBSn 20---- | Arbitrary 256-bit hash.-arbitraryHash256 :: Gen Hash256-arbitraryHash256 =-    sha256 <$> arbitraryBSn 32---- | Arbitrary 512-bit hash.-arbitraryHash512 :: Gen Hash512-arbitraryHash512 =-    sha512 <$> arbitraryBSn 64---- | Arbitrary 32-bit checksum.-arbitraryCheckSum32 :: Gen CheckSum32-arbitraryCheckSum32 =-    checkSum32 <$> arbitraryBSn 4
− test/Network/Haskoin/Test/Keys.hs 
@@ -1,85 +0,0 @@-{-|-Module      : Network.Haskoin.Test.Keys-Copyright   : No rights reserved-License     : UNLICENSE-Maintainer  : jprupp@protonmail.ch-Stability   : experimental-Portability : POSIX--}-module Network.Haskoin.Test.Keys where--import           Data.Bits                     (clearBit)-import           Data.List                     (foldl')-import           Data.Word                     (Word32)-import           Network.Haskoin.Crypto-import           Network.Haskoin.Keys.Common-import           Network.Haskoin.Keys.Extended-import           Network.Haskoin.Test.Crypto-import           Test.QuickCheck---- | Arbitrary private key with arbitrary compressed flag.-arbitrarySecKeyI :: Gen SecKeyI-arbitrarySecKeyI = wrapSecKey <$> arbitrary <*> arbitrary---- | Arbitrary keypair, both either compressed or not.-arbitraryKeyPair :: Gen (SecKeyI, PubKeyI)-arbitraryKeyPair = do-    k <- arbitrarySecKeyI-    return (k, derivePubKeyI k)---- | Arbitrary extended private key.-arbitraryXPrvKey :: Gen XPrvKey-arbitraryXPrvKey =-    XPrvKey <$> arbitrary-            <*> arbitrary-            <*> arbitrary-            <*> arbitraryHash256-            <*> arbitrary---- | Arbitrary extended public key with its corresponding private key.-arbitraryXPubKey :: Gen (XPrvKey, XPubKey)-arbitraryXPubKey = (\k -> (k, deriveXPubKey k)) <$> arbitraryXPrvKey--{- Custom derivations -}---- | Arbitrary derivation index with last bit unset.-genIndex :: Gen Word32-genIndex = (`clearBit` 31) <$> arbitrary---- | Arbitrary BIP-32 path index. Can be hardened or not.-arbitraryBip32PathIndex :: Gen Bip32PathIndex-arbitraryBip32PathIndex =-    oneof [ Bip32SoftIndex <$> genIndex-          , Bip32HardIndex <$> genIndex-          ]---- | Arbitrary BIP-32 derivation path composed of only hardened derivations.-arbitraryHardPath :: Gen HardPath-arbitraryHardPath = foldl' (:|) Deriv <$> listOf genIndex---- | Arbitrary BIP-32 derivation path composed of only non-hardened derivations.-arbitrarySoftPath :: Gen SoftPath-arbitrarySoftPath = foldl' (:/) Deriv <$> listOf genIndex---- | Arbitrary derivation path composed of hardened and non-hardened derivations.-arbitraryDerivPath :: Gen DerivPath-arbitraryDerivPath = concatBip32Segments <$> listOf arbitraryBip32PathIndex---- | Arbitrary parsed derivation path. Can contain 'ParsedPrv', 'ParsedPub' or--- 'ParsedEmpty' elements.-arbitraryParsedPath :: Gen ParsedPath-arbitraryParsedPath =-    oneof [ ParsedPrv <$> arbitraryDerivPath-          , ParsedPub <$> arbitraryDerivPath-          , ParsedEmpty <$> arbitraryDerivPath-          ]---- | Arbitrary message hash, private key, nonce and corresponding signature. The--- signature is generated with a random message, random private key and a random--- nonce.-arbitrarySignature :: Gen (Hash256, SecKey, Sig)-arbitrarySignature = do-    m <- arbitraryHash256-    key <- arbitrary-    let sig = signHash key m-    return (m, key, sig)
− test/Network/Haskoin/Test/Message.hs 
@@ -1,52 +0,0 @@-{-|-Module      : Network.Haskoin.Test.Message-Copyright   : No rights reserved-License     : UNLICENSE-Maintainer  : jprupp@protonmail.ch-Stability   : experimental-Portability : POSIX--}-module Network.Haskoin.Test.Message where--import           Network.Haskoin.Constants-import           Network.Haskoin.Network.Message-import           Network.Haskoin.Test.Block-import           Network.Haskoin.Test.Crypto-import           Network.Haskoin.Test.Network-import           Network.Haskoin.Test.Transaction-import           Test.QuickCheck---- | Arbitrary 'MessageHeader'.-arbitraryMessageHeader :: Gen MessageHeader-arbitraryMessageHeader =-    MessageHeader <$> arbitrary-                  <*> arbitraryMessageCommand-                  <*> arbitrary-                  <*> arbitraryCheckSum32---- | Arbitrary 'Message'.-arbitraryMessage :: Network -> Gen Message-arbitraryMessage net =-    oneof-        [ MVersion <$> arbitraryVersion-        , return MVerAck-        , MAddr <$> arbitraryAddr1-        , MInv <$> arbitraryInv1-        , MGetData <$> arbitraryGetData-        , MNotFound <$> arbitraryNotFound-        , MGetBlocks <$> arbitraryGetBlocks-        , MGetHeaders <$> arbitraryGetHeaders-        , MTx <$> arbitraryTx net-        , MBlock <$> arbitraryBlock net-        , MMerkleBlock <$> arbitraryMerkleBlock-        , MHeaders <$> arbitraryHeaders-        , return MGetAddr-        , MFilterLoad <$> arbitraryFilterLoad-        , MFilterAdd <$> arbitraryFilterAdd-        , return MFilterClear-        , MPing <$> arbitraryPing-        , MPong <$> arbitraryPong-        , MAlert <$> arbitraryAlert-        , MReject <$> arbitraryReject-        , return MSendHeaders-        ]
− test/Network/Haskoin/Test/Network.hs 
@@ -1,178 +0,0 @@-{-|-Module      : Network.Haskoin.Test.Network-Copyright   : No rights reserved-License     : UNLICENSE-Maintainer  : jprupp@protonmail.ch-Stability   : experimental-Portability : POSIX--}-module Network.Haskoin.Test.Network where--import qualified Data.ByteString             as BS (empty, pack)-import qualified Data.ByteString.Char8       as C8-import           Data.Word                   (Word16, Word32)-import           Network.Haskoin.Network-import           Network.Haskoin.Test.Crypto-import           Network.Haskoin.Test.Util-import           Network.Socket              (SockAddr (..))-import           Test.QuickCheck---- | Arbitrary 'VarInt'.-arbitraryVarInt :: Gen VarInt-arbitraryVarInt = VarInt <$> arbitrary---- | Arbitrary 'VarString'.-arbitraryVarString :: Gen VarString-arbitraryVarString = VarString <$> arbitraryBS---- | Arbitrary 'NetworkAddress'.-arbitraryNetworkAddress :: Gen NetworkAddress-arbitraryNetworkAddress = do-    s <- arbitrary-    a <- arbitrary-    p <- arbitrary-    d <- oneof-        [ do-            b <- arbitrary-            c <- arbitrary-            d <- arbitrary-            return $ SockAddrInet6 (fromIntegral p) 0 (a,b,c,d) 0-        , return $ SockAddrInet (fromIntegral (p :: Word16)) a-        ]-    let n = sockToHostAddress d-    return $ NetworkAddress s n---- | Arbitrary 'NetworkAddressTime'.-arbitraryNetworkAddressTime :: Gen (Word32, NetworkAddress)-arbitraryNetworkAddressTime = (,) <$> arbitrary <*> arbitraryNetworkAddress---- | Arbitrary 'InvType'.-arbitraryInvType :: Gen InvType-arbitraryInvType = elements [InvError, InvTx, InvBlock, InvMerkleBlock]---- | Arbitrary 'InvVector'.-arbitraryInvVector :: Gen InvVector-arbitraryInvVector = InvVector <$> arbitraryInvType <*> arbitraryHash256---- | Arbitrary non-empty 'Inv'.-arbitraryInv1 :: Gen Inv-arbitraryInv1 = Inv <$> listOf1 arbitraryInvVector---- | Arbitrary 'Version'.-arbitraryVersion :: Gen Version-arbitraryVersion =-    Version <$> arbitrary-            <*> arbitrary-            <*> arbitrary-            <*> arbitraryNetworkAddress-            <*> arbitraryNetworkAddress-            <*> arbitrary-            <*> arbitraryVarString-            <*> arbitrary-            <*> arbitrary---- | Arbitrary non-empty 'Addr'.-arbitraryAddr1 :: Gen Addr-arbitraryAddr1 = Addr <$> listOf1 arbitraryNetworkAddressTime---- | Arbitrary 'Alert' with random payload and signature. Signature is not--- valid.-arbitraryAlert :: Gen Alert-arbitraryAlert = Alert <$> arbitraryVarString <*> arbitraryVarString---- | Arbitrary 'Reject'.-arbitraryReject :: Gen Reject-arbitraryReject = do-    m <- arbitraryMessageCommand-    c <- arbitraryRejectCode-    s <- arbitraryVarString-    d <- oneof [ return BS.empty-               , BS.pack <$> vectorOf 32 arbitrary-               ]-    return $ Reject m c s d---- | Arbitrary 'RejectCode'.-arbitraryRejectCode :: Gen RejectCode-arbitraryRejectCode =-    elements-        [ RejectMalformed-        , RejectInvalid-        , RejectInvalid-        , RejectDuplicate-        , RejectNonStandard-        , RejectDust-        , RejectInsufficientFee-        , RejectCheckpoint-        ]---- | Arbitrary non-empty 'GetData'.-arbitraryGetData :: Gen GetData-arbitraryGetData = GetData <$> listOf1 arbitraryInvVector---- | Arbitrary 'NotFound'.-arbitraryNotFound :: Gen NotFound-arbitraryNotFound = NotFound <$> listOf1 arbitraryInvVector---- | Arbitrary 'Ping'.-arbitraryPing :: Gen Ping-arbitraryPing = Ping <$> arbitrary---- | Arbitrary 'Pong'.-arbitraryPong :: Gen Pong-arbitraryPong = Pong <$> arbitrary---- | Arbitrary bloom filter flags.-arbitraryBloomFlags :: Gen BloomFlags-arbitraryBloomFlags =-    elements-        [ BloomUpdateNone-        , BloomUpdateAll-        , BloomUpdateP2PubKeyOnly-        ]---- | Arbitrary bloom filter with its corresponding number of elements--- and false positive rate.-arbitraryBloomFilter :: Gen (Int, Double, BloomFilter)-arbitraryBloomFilter = do-    n     <- choose (0,100000)-    fp    <- choose (1e-8,1)-    tweak <- arbitrary-    fl    <- arbitraryBloomFlags-    return (n, fp, bloomCreate n fp tweak fl)---- | Arbitrary 'FilterLoad'.-arbitraryFilterLoad :: Gen FilterLoad-arbitraryFilterLoad = do-    (_, _, bf) <- arbitraryBloomFilter-    return $ FilterLoad bf---- | Arbitrary 'FilterAdd'.-arbitraryFilterAdd :: Gen FilterAdd-arbitraryFilterAdd = FilterAdd <$> arbitraryBS---- | Arbitrary 'MessageCommand'.-arbitraryMessageCommand :: Gen MessageCommand-arbitraryMessageCommand = do-    ASCIIString str <- arbitrary-    elements-        [ MCVersion-        , MCVerAck-        , MCAddr-        , MCInv-        , MCGetData-        , MCNotFound-        , MCGetBlocks-        , MCGetHeaders-        , MCTx-        , MCBlock-        , MCMerkleBlock-        , MCHeaders-        , MCGetAddr-        , MCFilterLoad-        , MCFilterAdd-        , MCFilterClear-        , MCPing-        , MCPong-        , MCAlert-        , MCOther (C8.take 12 (C8.pack (filter (/= '\NUL') str)))-        ]
− test/Network/Haskoin/Test/Script.hs 
@@ -1,374 +0,0 @@-{-# LANGUAGE LambdaCase #-}-{-|-Module      : Network.Haskoin.Test.Script-Copyright   : No rights reserved-License     : UNLICENSE-Maintainer  : jprupp@protonmail.ch-Stability   : experimental-Portability : POSIX--}-module Network.Haskoin.Test.Script where--import           Crypto.Secp256k1-import           Data.Maybe-import           Data.Word-import           Network.Haskoin.Address-import           Network.Haskoin.Constants-import           Network.Haskoin.Keys.Common-import           Network.Haskoin.Script-import           Network.Haskoin.Test.Address-import           Network.Haskoin.Test.Crypto-import           Network.Haskoin.Test.Keys-import           Network.Haskoin.Test.Util-import           Network.Haskoin.Transaction.Common-import           Network.Haskoin.Util-import           Test.QuickCheck---- | Arbitrary 'Script' with random script ops.-arbitraryScript :: Gen Script-arbitraryScript = Script <$> listOf arbitraryScriptOp---- | Arbitrary 'ScriptOp' (push operations have random data).-arbitraryScriptOp :: Gen ScriptOp-arbitraryScriptOp =-    oneof-          -- Pushing Data-        [ opPushData <$> arbitraryBS1-        , return OP_0-        , return OP_1NEGATE-        , return OP_RESERVED-        , return OP_1-        , return OP_2-        , return OP_3-        , return OP_4-        , return OP_5-        , return OP_6-        , return OP_7-        , return OP_8-        , return OP_9-        , return OP_10-        , return OP_11-        , return OP_12-        , return OP_13-        , return OP_14-        , return OP_15-        , return OP_16-        -- Flow control-        , return OP_NOP-        , return OP_VER-        , return OP_IF-        , return OP_NOTIF-        , return OP_VERIF-        , return OP_VERNOTIF-        , return OP_ELSE-        , return OP_ENDIF-        , return OP_VERIFY-        , return OP_RETURN-        -- Stack operations-        , return OP_TOALTSTACK-        , return OP_FROMALTSTACK-        , return OP_IFDUP-        , return OP_DEPTH-        , return OP_DROP-        , return OP_DUP-        , return OP_NIP-        , return OP_OVER-        , return OP_PICK-        , return OP_ROLL-        , return OP_ROT-        , return OP_SWAP-        , return OP_TUCK-        , return OP_2DROP-        , return OP_2DUP-        , return OP_3DUP-        , return OP_2OVER-        , return OP_2ROT-        , return OP_2SWAP-        -- Splice-        , return OP_CAT-        , return OP_SUBSTR-        , return OP_LEFT-        , return OP_RIGHT-        , return OP_SIZE-        -- Bitwise logic-        , return OP_INVERT-        , return OP_AND-        , return OP_OR-        , return OP_XOR-        , return OP_EQUAL-        , return OP_EQUALVERIFY-        , return OP_RESERVED1-        , return OP_RESERVED2-        -- Arithmetic-        , return OP_1ADD-        , return OP_1SUB-        , return OP_2MUL-        , return OP_2DIV-        , return OP_NEGATE-        , return OP_ABS-        , return OP_NOT-        , return OP_0NOTEQUAL-        , return OP_ADD-        , return OP_SUB-        , return OP_MUL-        , return OP_DIV-        , return OP_MOD-        , return OP_LSHIFT-        , return OP_RSHIFT-        , return OP_BOOLAND-        , return OP_BOOLOR-        , return OP_NUMEQUAL-        , return OP_NUMEQUALVERIFY-        , return OP_NUMNOTEQUAL-        , return OP_LESSTHAN-        , return OP_GREATERTHAN-        , return OP_LESSTHANOREQUAL-        , return OP_GREATERTHANOREQUAL-        , return OP_MIN-        , return OP_MAX-        , return OP_WITHIN-        -- Crypto-        , return OP_RIPEMD160-        , return OP_SHA1-        , return OP_SHA256-        , return OP_HASH160-        , return OP_HASH256-        , return OP_CODESEPARATOR-        , return OP_CHECKSIG-        , return OP_CHECKSIGVERIFY-        , return OP_CHECKMULTISIG-        , return OP_CHECKMULTISIGVERIFY-        -- Expansion-        , return OP_NOP1-        , return OP_NOP2-        , return OP_NOP3-        , return OP_NOP4-        , return OP_NOP5-        , return OP_NOP6-        , return OP_NOP7-        , return OP_NOP8-        , return OP_NOP9-        , return OP_NOP10-        -- Other-        , return OP_PUBKEYHASH-        , return OP_PUBKEY-        , return $ OP_INVALIDOPCODE 0xff-        ]---- | Arbtirary 'ScriptOp' with a value in @[OP_1 .. OP_16]@.-arbitraryIntScriptOp :: Gen ScriptOp-arbitraryIntScriptOp =-    elements-        [ OP_1,  OP_2,  OP_3,  OP_4-        , OP_5,  OP_6,  OP_7,  OP_8-        , OP_9,  OP_10, OP_11, OP_12-        , OP_13, OP_14, OP_15, OP_16-        ]---- | Arbitrary 'PushDataType'.-arbitraryPushDataType :: Gen PushDataType-arbitraryPushDataType = elements [OPCODE, OPDATA1, OPDATA2, OPDATA4]---- | Arbitrary 'SigHash' (including invalid/unknown sighash codes).-arbitrarySigHash :: Gen SigHash-arbitrarySigHash = fromIntegral <$> (arbitrary :: Gen Word32)---- | Arbitrary valid 'SigHash'.-arbitraryValidSigHash :: Network -> Gen SigHash-arbitraryValidSigHash net = do-    sh <- elements [sigHashAll, sigHashNone, sigHashSingle]-    f1 <--        elements $-        if isJust (getSigHashForkId net)-            then [id, setForkIdFlag]-            else [id]-    f2 <- elements [id, setAnyoneCanPayFlag]-    return $ f1 $ f2 sh---- | Arbitrary message hash, private key and corresponding 'TxSignature'. The--- signature is generated deterministically using a random message and a random--- private key.-arbitraryTxSignature :: Network -> Gen (TxHash, SecKey, TxSignature)-arbitraryTxSignature net = do-    (m, key, sig) <- arbitrarySignature-    sh <- (fromIntegral <$> (arbitrary :: Gen Word8)) `suchThat` filterBad-    let txsig = TxSignature sig sh-    return (TxHash m, key, txsig)-  where-    filterBad sh = not $-        isSigHashUnknown sh ||-        isNothing (getSigHashForkId net) && hasForkIdFlag sh---- | Arbitrary transaction signature that could also be empty.-arbitraryTxSignatureEmpty :: Network -> Gen TxSignature-arbitraryTxSignatureEmpty net =-    frequency [ (1, return TxSignatureEmpty)-              , (10, lst3 <$> arbitraryTxSignature net)-              ]---- | Arbitrary m of n parameters.-arbitraryMSParam :: Gen (Int, Int)-arbitraryMSParam = do-    m <- choose (1,16)-    n <- choose (m,16)-    return (m, n)---- | Arbitrary 'ScriptOutput' (Can by any valid type).-arbitraryScriptOutput :: Network -> Gen ScriptOutput-arbitraryScriptOutput net =-    oneof $-    [ arbitraryPKOutput-    , arbitraryPKHashOutput-    , arbitraryMSOutput-    , arbitrarySHOutput-    , arbitraryDCOutput-    ] ++-    if getSegWit net-        then [arbitraryWPKHashOutput, arbitraryWSHOutput]-        else []---- | Arbitrary 'ScriptOutput' of type 'PayPK', 'PayPKHash' or 'PayMS'--- (Not 'PayScriptHash', 'DataCarrier', or SegWit)-arbitrarySimpleOutput :: Gen ScriptOutput-arbitrarySimpleOutput =-    oneof-        [ arbitraryPKOutput-        , arbitraryPKHashOutput-        , arbitraryMSOutput-        ]---- | Arbitrary 'ScriptOutput' of type 'PayPK'-arbitraryPKOutput :: Gen ScriptOutput-arbitraryPKOutput =  PayPK . snd <$> arbitraryKeyPair---- | Arbitrary 'ScriptOutput' of type 'PayPKHash'-arbitraryPKHashOutput :: Gen ScriptOutput-arbitraryPKHashOutput = PayPKHash <$> arbitraryHash160---- | Arbitrary 'PayWitnessPKHash' output.-arbitraryWPKHashOutput :: Gen ScriptOutput-arbitraryWPKHashOutput = PayWitnessPKHash <$> arbitraryHash160---- | Arbitrary 'PayWitnessScriptHash' output.-arbitraryWSHOutput :: Gen ScriptOutput-arbitraryWSHOutput = PayWitnessScriptHash <$> arbitraryHash256---- | Arbitrary 'ScriptOutput' of type 'PayMS'.-arbitraryMSOutput :: Gen ScriptOutput-arbitraryMSOutput = do-    (m, n) <- arbitraryMSParam-    keys <- map snd <$> vectorOf n arbitraryKeyPair-    return $ PayMulSig keys m---- | Arbitrary 'ScriptOutput' of type 'PayMS', only using compressed keys.-arbitraryMSOutputC :: Gen ScriptOutput-arbitraryMSOutputC = do-    (m, n) <- arbitraryMSParam-    keys <--        map snd <$>-        vectorOf n (arbitraryKeyPair `suchThat` (pubKeyCompressed . snd))-    return $ PayMulSig keys m---- | Arbitrary 'ScriptOutput' of type 'PayScriptHash'.-arbitrarySHOutput :: Gen ScriptOutput-arbitrarySHOutput = PayScriptHash . getAddrHash160 <$> arbitraryScriptAddress---- | Arbitrary 'ScriptOutput' of type 'DataCarrier'.-arbitraryDCOutput :: Gen ScriptOutput-arbitraryDCOutput = DataCarrier <$> arbitraryBS1---- | Arbitrary 'ScriptInput'.-arbitraryScriptInput :: Network -> Gen ScriptInput-arbitraryScriptInput net =-    oneof-        [ arbitraryPKInput net-        , arbitraryPKHashInput net-        , arbitraryMSInput net-        , arbitrarySHInput net-        ]---- | Arbitrary 'ScriptInput' of type 'SpendPK', 'SpendPKHash' or 'SpendMulSig'--- (not 'ScriptHashInput')-arbitrarySimpleInput :: Network -> Gen ScriptInput-arbitrarySimpleInput net =-    oneof-        [ arbitraryPKInput net-        , arbitraryPKHashInput net-        , arbitraryMSInput net-        ]---- | Arbitrary 'ScriptInput' of type 'SpendPK'.-arbitraryPKInput :: Network -> Gen ScriptInput-arbitraryPKInput net = RegularInput . SpendPK <$> arbitraryTxSignatureEmpty net---- | Arbitrary 'ScriptInput' of type 'SpendPK'.-arbitraryPKHashInput :: Network -> Gen ScriptInput-arbitraryPKHashInput net = do-    sig <- arbitraryTxSignatureEmpty net-    key <- snd <$> arbitraryKeyPair-    return $ RegularInput $ SpendPKHash sig key---- | Like 'arbitraryPKHashInput' without empty signatures.-arbitraryPKHashInputFull :: Network -> Gen ScriptInput-arbitraryPKHashInputFull net = do-    sig <- lst3 <$> arbitraryTxSignature net-    key <- snd <$> arbitraryKeyPair-    return $ RegularInput $ SpendPKHash sig key---- | Like above but only compressed.-arbitraryPKHashInputFullC :: Network -> Gen ScriptInput-arbitraryPKHashInputFullC net = do-    sig <- lst3 <$> arbitraryTxSignature net-    key <- fmap snd $ arbitraryKeyPair `suchThat` (pubKeyCompressed . snd)-    return $ RegularInput $ SpendPKHash sig key---- | Arbitrary 'ScriptInput' of type 'SpendMulSig'.-arbitraryMSInput :: Network -> Gen ScriptInput-arbitraryMSInput net = do-    m    <- fst <$> arbitraryMSParam-    sigs <- vectorOf m (arbitraryTxSignatureEmpty net)-    return $ RegularInput $ SpendMulSig sigs---- | Arbitrary 'ScriptInput' of type 'ScriptHashInput'.-arbitrarySHInput :: Network -> Gen ScriptInput-arbitrarySHInput net = do-    i <- arbitrarySimpleInput net-    ScriptHashInput (getRegularInput i) <$> arbitrarySimpleOutput---- | Arbitrary 'ScriptInput' of type 'ScriptHashInput' containing a--- 'RedeemScript' of type 'PayMulSig' and an input of type 'SpendMulSig'.-arbitraryMulSigSHInput :: Network -> Gen ScriptInput-arbitraryMulSigSHInput net =-    arbitraryMSOutput >>= \case-        rdm@(PayMulSig _ m) -> do-            sigs <- vectorOf m (arbitraryTxSignatureEmpty net)-            return $ ScriptHashInput (SpendMulSig sigs) rdm-        _ -> undefined---- | Arbitrary 'ScriptInput' of type 'ScriptHashInput' containing a--- 'RedeemScript' of type 'PayMulSig' and an input of type 'SpendMulSig'.-arbitraryMulSigSHInputC :: Network -> Gen ScriptInput-arbitraryMulSigSHInputC net =-    arbitraryMSOutputC >>= \case-        rdm@(PayMulSig _ m) -> do-          sigs <- vectorOf m (arbitraryTxSignatureEmpty net)-          return $ ScriptHashInput (SpendMulSig sigs) rdm-        _ -> undefined---- | Like 'arbitraryMulSigSHCInput' with no empty signatures.-arbitraryMulSigSHInputFull :: Network -> Gen ScriptInput-arbitraryMulSigSHInputFull net =-    arbitraryMSOutput >>= \case-        rdm@(PayMulSig _ m) -> do-            sigs <- map lst3 <$> vectorOf m (arbitraryTxSignature net)-            return $ ScriptHashInput (SpendMulSig sigs) rdm-        _ -> undefined---- | Like 'arbitraryMulSigSHCInput' with no empty signatures.-arbitraryMulSigSHInputFullC :: Network -> Gen ScriptInput-arbitraryMulSigSHInputFullC net =-    arbitraryMSOutputC >>= \case-        rdm@(PayMulSig _ m) -> do-            sigs <- map lst3 <$> vectorOf m (arbitraryTxSignature net)-            return $ ScriptHashInput (SpendMulSig sigs) rdm-        _ -> undefined
− test/Network/Haskoin/Test/Transaction.hs 
@@ -1,275 +0,0 @@-{-|-Module      : Network.Haskoin.Test.Transaction-Copyright   : No rights reserved-License     : UNLICENSE-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)-import           Data.List                   (nub, nubBy, permutations)-import           Data.Word                   (Word64)-import           Network.Haskoin.Address-import           Network.Haskoin.Constants-import           Network.Haskoin.Keys.Common-import           Network.Haskoin.Script-import           Network.Haskoin.Test.Crypto-import           Network.Haskoin.Test.Keys-import           Network.Haskoin.Test.Script-import           Network.Haskoin.Test.Util-import           Network.Haskoin.Transaction-import           Test.QuickCheck---- | Wrapped coin value for testing.-newtype TestCoin = TestCoin { getTestCoin :: Word64 }-    deriving (Eq, Show)--instance Coin TestCoin where-    coinValue = getTestCoin---- | Arbitrary transaction hash (for non-existent transaction).-arbitraryTxHash :: Gen TxHash-arbitraryTxHash = TxHash <$> arbitraryHash256---- | Arbitrary amount of Satoshi as 'Word64' (Between 1 and 21e14)-arbitrarySatoshi :: Network -> Gen TestCoin-arbitrarySatoshi net = TestCoin <$> choose (1, getMaxSatoshi net)---- | Arbitrary 'OutPoint'.-arbitraryOutPoint :: Gen OutPoint-arbitraryOutPoint = OutPoint <$> arbitraryTxHash <*> arbitrary---- | Arbitrary 'TxOut'.-arbitraryTxOut :: Network -> Gen TxOut-arbitraryTxOut net =-    TxOut <$> (getTestCoin <$> arbitrarySatoshi net)-          <*> (encodeOutputBS <$> arbitraryScriptOutput net)---- | Arbitrary 'TxIn'.-arbitraryTxIn :: Network -> Gen TxIn-arbitraryTxIn net =-    TxIn <$> arbitraryOutPoint-         <*> (encodeInputBS <$> arbitraryScriptInput net)-         <*> arbitrary---- | Arbitrary transaction. Can be regular or with witnesses.-arbitraryTx :: Network -> Gen Tx-arbitraryTx net = oneof [arbitraryLegacyTx net, arbitraryWitnessTx net]---- | Arbitrary regular transaction.-arbitraryLegacyTx :: Network -> Gen Tx-arbitraryLegacyTx net = arbitraryWLTx net False---- | Arbitrary witness transaction (witness data is fake).-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)-    no <--        if wit-            then choose (0, 5)-            else choose-                     ( if ni == 0-                           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-    w <- if wit then vectorOf (length uniqueInps) (listOf arbitraryBS) else return []-    Tx <$> arbitrary <*> pure uniqueInps <*> pure outs <*> pure w <*> arbitrary---- | Arbitrary transaction containing only inputs of type 'SpendPKHash',--- 'SpendScriptHash' (multisig) and outputs of type 'PayPKHash' and 'PaySH'.--- Only compressed public keys are used.-arbitraryAddrOnlyTx :: Network -> Gen Tx-arbitraryAddrOnlyTx net = do-    ni <- choose (0, 5)-    no <- choose (0, 5)-    inps <- vectorOf ni (arbitraryAddrOnlyTxIn net)-    outs <- vectorOf no (arbitraryAddrOnlyTxOut net)-    Tx <$> arbitrary <*> pure inps <*> pure outs <*> pure [] <*> arbitrary---- | Like 'arbitraryAddrOnlyTx' without empty signatures in the inputs.-arbitraryAddrOnlyTxFull :: Network -> Gen Tx-arbitraryAddrOnlyTxFull net = do-    ni <- choose (0, 5)-    no <- choose (0, 5)-    inps <- vectorOf ni (arbitraryAddrOnlyTxInFull net)-    outs <- vectorOf no (arbitraryAddrOnlyTxOut net)-    Tx <$> arbitrary <*> pure inps <*> pure outs <*> pure [] <*> arbitrary---- | Arbitrary TxIn that can only be of type 'SpendPKHash' or 'SpendScriptHash'--- (multisig). Only compressed public keys are used.-arbitraryAddrOnlyTxIn :: Network -> Gen TxIn-arbitraryAddrOnlyTxIn net = do-    inp <- oneof [arbitraryPKHashInput net, arbitraryMulSigSHInput net]-    TxIn <$> arbitraryOutPoint <*> pure (encodeInputBS inp) <*> arbitrary---- | like 'arbitraryAddrOnlyTxIn' with no empty signatures.-arbitraryAddrOnlyTxInFull :: Network -> Gen TxIn-arbitraryAddrOnlyTxInFull net = do-    inp <--        oneof [arbitraryPKHashInputFullC net, arbitraryMulSigSHInputFullC net]-    TxIn <$> arbitraryOutPoint <*> pure (encodeInputBS inp) <*> arbitrary---- | Arbitrary 'TxOut' that can only be of type 'PayPKHash' or 'PaySH'.-arbitraryAddrOnlyTxOut :: Network -> Gen TxOut-arbitraryAddrOnlyTxOut net = do-    v <- getTestCoin <$> arbitrarySatoshi net-    out <- oneof [arbitraryPKHashOutput, arbitrarySHOutput]-    return $ TxOut v $ encodeOutputBS out---- | Arbitrary 'SigInput' with the corresponding private keys used--- to generate the 'ScriptOutput' or 'RedeemScript'.-arbitrarySigInput :: Network -> Gen (SigInput, [SecKeyI])-arbitrarySigInput net =-    oneof-        [ wrapKey <$> arbitraryPKSigInput net-        , wrapKey <$> arbitraryPKHashSigInput net-        , arbitraryMSSigInput net-        , arbitrarySHSigInput net-        , wrapKey <$> arbitraryWPKHSigInput net-        , arbitraryWSHSigInput net-        ]---- | Arbitrary 'SigInput' with a 'ScriptOutput' of type 'PayPK'.-arbitraryPKSigInput :: Network -> Gen (SigInput, SecKeyI)-arbitraryPKSigInput net = arbitraryAnyInput net False---- | Arbitrary 'SigInput' with a 'ScriptOutput' of type 'PayPKHash'.-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-    let out | pkh = PayPKHash $ getAddrHash160 $ pubKeyAddr p-            | otherwise = PayPK p-    (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-    op <- arbitraryOutPoint-    sh <- arbitraryValidSigHash net-    return (val, op, sh)---- | Arbitrary 'SigInput' with a 'ScriptOutput' of type 'PayMulSig'.-arbitraryMSSigInput :: Network -> Gen (SigInput, [SecKeyI])-arbitraryMSSigInput net = do-    (m, n) <- arbitraryMSParam-    ks <- vectorOf n arbitraryKeyPair-    let out = PayMulSig (map snd ks) m-    (val, op, sh) <- arbitraryInputStuff net-    perm <- choose (0, n - 1)-    let ksPerm = map fst $ take m $ permutations ks !! perm-    return (SigInput out val op sh Nothing, ksPerm)---- | Arbitrary 'SigInput' with 'ScriptOutput' of type 'PaySH' and a--- 'RedeemScript'.-arbitrarySHSigInput :: Network -> Gen (SigInput, [SecKeyI])-arbitrarySHSigInput net = do-    (SigInput rdm val op sh _, ks) <- oneof-        [ wrapKey <$> arbitraryPKSigInput net-        , wrapKey <$> arbitraryPKHashSigInput net-        , arbitraryMSSigInput net-        ]-    let out = PayScriptHash $ getAddrHash160 $ payToScriptAddress rdm-    return (SigInput out val op sh $ Just rdm, ks)--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])-arbitrarySigningData net = do-    v <- arbitrary-    ni <- choose (1, 5)-    no <- choose (1, 5)-    sigis <- vectorOf ni (arbitrarySigInput net)-    let uSigis = nubBy (\(a, _) (b, _) -> sigInputOP a == sigInputOP b) sigis-    inps <- forM uSigis $ \(s, _) -> TxIn (sigInputOP s) BS.empty <$> arbitrary-    outs <- vectorOf no (arbitraryTxOut net)-    l <- arbitrary-    perm <- choose (0, length inps - 1)-    let tx = Tx v (permutations inps !! perm) outs [] l-        keys = concatMap snd uSigis-    return (tx, map fst uSigis, keys)---- | Arbitrary transaction with empty inputs.-arbitraryEmptyTx :: Network -> Gen Tx-arbitraryEmptyTx net = do-    v    <- arbitrary-    no   <- choose (1,5)-    ni   <- choose (1,5)-    outs <- vectorOf no (arbitraryTxOut net)-    ops  <- vectorOf ni arbitraryOutPoint-    t    <- arbitrary-    s    <- arbitrary-    return $ Tx v (map (\op -> TxIn op BS.empty s) (nub ops)) outs [] t---- | Arbitrary partially-signed transactions.-arbitraryPartialTxs ::-       Network -> Gen ([Tx], [(ScriptOutput, Word64, OutPoint, Int, Int)])-arbitraryPartialTxs net = do-    tx <- arbitraryEmptyTx net-    res <--        forM (map prevOutput $ txIn tx) $ \op -> do-            (so, val, rdmM, prvs, m, n) <- arbitraryData-            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-    singleSig so val rdmM tx op prv = do-        sh <- arbitraryValidSigHash net-        let sigi = SigInput so val op sh rdmM-        return . fromRight (error "Could not decode transaction") $-            signTx net tx [sigi] [prv]-    arbitraryData = do-        (m, n) <- arbitraryMSParam-        val <- getTestCoin <$> arbitrarySatoshi net-        nPrv <- choose (m, n)-        keys <- vectorOf n arbitraryKeyPair-        perm <- choose (0, length keys - 1)-        let pubKeys = map snd keys-            prvKeys = take nPrv $ permutations (map fst keys) !! perm-        let so = PayMulSig pubKeys m-        elements-            [ (so, val, Nothing, prvKeys, m, n)-            , ( PayScriptHash $ getAddrHash160 $ payToScriptAddress so-              , val-              , Just so-              , prvKeys-              , m-              , n)-            ]--wrapKey :: (SigInput, SecKeyI) -> (SigInput, [SecKeyI])-wrapKey (s, k) = (s, [k])
− test/Network/Haskoin/Test/Util.hs 
@@ -1,40 +0,0 @@-{-|-Module      : Network.Haskoin.Test.Util-Copyright   : No rights reserved-License     : UNLICENSE-Maintainer  : jprupp@protonmail.ch-Stability   : experimental-Portability : POSIX--}-module Network.Haskoin.Test.Util where--import           Data.ByteString       (ByteString, pack)-import           Data.Time.Clock       (UTCTime (..))-import           Data.Time.Clock.POSIX (posixSecondsToUTCTime)-import           Data.Word             (Word32)-import           Test.QuickCheck---- | Arbitrary strict 'ByteString'.-arbitraryBS :: Gen ByteString-arbitraryBS = pack <$> arbitrary---- | Arbitrary non-empty strict ByteString-arbitraryBS1 :: Gen ByteString-arbitraryBS1 = pack <$> listOf1 arbitrary---- | Arbitrary strict ByteString of a given length-arbitraryBSn :: Int -> Gen ByteString-arbitraryBSn n = pack <$> vectorOf n arbitrary---- | Arbitrary UTCTime that generates dates after 01 Jan 1970 01:00:00 CET-arbitraryUTCTime :: Gen UTCTime-arbitraryUTCTime = do-    w <- arbitrary :: Gen Word32-    return $ posixSecondsToUTCTime $ realToFrac w---- | Generate a Maybe from a Gen a-arbitraryMaybe :: Gen a -> Gen (Maybe a)-arbitraryMaybe g = frequency [ (1, return Nothing)-                             , (5, Just <$> g)-                             ]-
− test/Network/Haskoin/Transaction/PartialSpec.hs 
@@ -1,336 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}--module Network.Haskoin.Transaction.PartialSpec (spec) where--import           Control.Monad.Fail                  (MonadFail)-import           Data.ByteString                     (ByteString)-import           Data.Either                         (fromRight, isLeft,-                                                      isRight)-import           Data.HashMap.Strict                 (fromList, singleton)-import           Data.Maybe                          (fromJust, isJust)-import           Data.Serialize                      as S-import           Data.Text                           (Text)-import           Test.Hspec-import           Test.HUnit                          (Assertion, assertBool,-                                                      assertEqual)-import           Test.QuickCheck--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.Transaction.Partial-import           Network.Haskoin.Util--spec :: Spec-spec = describe "partially signed bitcoin transaction unit tests" $ do-    it "encodes trivial psbt" $-        encodeHex (S.encode trivialPSBT) == trivialPSBTHex-    it "decodes trivial psbt" $-        decodeHexPSBT trivialPSBTHex == Right trivialPSBT-    it "encodes and decodes non-empty transactions" $-        S.decode (S.encode nonEmptyTransactionPSBT) == Right nonEmptyTransactionPSBT-    it "does not decode invalid bip vectors" $-        mapM_ invalidVecTest invalidVec-    it "encodes valid bip vecs" $-        mapM_ (uncurry encodeVecTest) validEncodeVec-    it "decodes valid bip vecs" $-        mapM_ (uncurry decodeVecTest) $ zip [1..] validVec-    it "decodes vector 2" vec2Test-    it "decodes vector 3" vec3Test-    it "decodes vector 4" vec4Test-    it "decodes vector 5" vec5Test-    it "decodes vector 6" vec6Test-    it "signed and finalized p2pkh PSBTs verify" $ property $-        forAll arbitraryKeyPair $ verifyNonWitnessPSBT btc . unfinalizedPkhPSBT btc-    it "signed and finalized multisig PSBTs verify" $ property $-        forAll arbitraryMultiSig $ verifyNonWitnessPSBT btc . unfinalizedMsPSBT btc--vec2Test :: Assertion-vec2Test = do-    psbt <- decodeHexPSBTM "Cannot parse validVec2" validVec2Hex-    assertEqual "2 inputs" 2 (length $ inputs psbt)-    assertEqual "2 outputs" 2 (length $ outputs psbt)-    assertBool "final script sig" $ isJust (finalScriptSig . head $ inputs psbt)--    let rdmScript = fromJust . inputRedeemScript $ inputs psbt !! 1-    assertBool "p2wpkh" $ (isPayWitnessPKHash <$> decodeOutput rdmScript) == Right True--    let scrptPubKey = witnessScriptPubKey $ inputs psbt !! 1-        rdmScriptP2SH = toP2SH rdmScript-    assertEqual "redeem script pubkey equal" rdmScriptP2SH scrptPubKey-    assertEqual "expected redeem script"  expectedOut rdmScriptP2SH--    mapM_ (assertEqual "outputs are empty" emptyOutput) (outputs psbt)--vec3Test :: Assertion-vec3Test = do-    psbt <- decodeHexPSBTM "Cannot parse validVec3" validVec3Hex-    assertEqual "1 input" 1 (length $ inputs psbt)-    assertEqual "2 outputs" 2 (length $ outputs psbt)-    let txInput = head . txIn $ unsignedTransaction psbt-        firstInput = head $ inputs psbt-        Just utx = nonWitnessUtxo firstInput-        OutPoint prevHash prevVOut = prevOutput txInput-    assertEqual "txids of inputs match" prevHash (txHash utx)-    let prevOutputKey = fromRight (error "Could not decode key")-                      . decodeOutputBS . scriptOutput $ txOut utx !! fromIntegral prevVOut-    assertBool "p2pkh" $ isPayPKHash prevOutputKey-    assertEqual "sighash type" sigHashAll (fromJust $ sigHashType firstInput)--vec4Test :: Assertion-vec4Test = do-    psbt <- decodeHexPSBTM "Cannot parse validVec4" validVec4Hex-    assertEqual "2 inputs" 2 (length $ inputs psbt)-    assertEqual "2 outputs" 2 (length $ outputs psbt)-    let firstInput = head $ inputs psbt-        secondInput = inputs psbt !! 1-    assertEqual "first input not final script sig" Nothing (finalScriptSig firstInput)-    assertEqual "second input not final script sig" Nothing (finalScriptSig secondInput)--    let rdmScript = fromJust $ inputRedeemScript secondInput-    assertBool "p2wpkh" $ (isPayWitnessPKHash <$> decodeOutput rdmScript) == Right True--    let scrptPubKey = witnessScriptPubKey secondInput-        rdmScriptP2SH = toP2SH rdmScript-    assertEqual "redeem script pubkey equal" rdmScriptP2SH scrptPubKey-    assertEqual "expected redeem script"  expectedOut rdmScriptP2SH--    assertBool "all non-empty outputs" $ emptyOutput `notElem` outputs psbt--vec5Test :: Assertion-vec5Test = do-    psbt <- decodeHexPSBTM "Cannot parse validVec5" validVec5Hex-    assertEqual "1 input" 1 (length $ inputs psbt)-    assertEqual "1 output" 1 (length $ outputs psbt)-    let input = head $ inputs psbt-    assertEqual "input not final script sig" Nothing (finalScriptSig input)--    let rdmScript = fromJust $ inputRedeemScript input-    assertBool "p2wsh" $ (isPayWitnessScriptHash <$> decodeOutput rdmScript) == Right True--    let scrptPubKey = witnessScriptPubKey input-        rdmScriptP2SH = toP2SH rdmScript-    assertEqual "redeem script pubkey equal" rdmScriptP2SH scrptPubKey-    assertEqual "expected redeem script"  expectedOut2 rdmScriptP2SH-  where-    expectedOut2 = fromRight (error "could not decode expected output")-                . decodeOutputBS . fromJust $ decodeHex "a9146345200f68d189e1adc0df1c4d16ea8f14c0dbeb87"--vec6Test :: Assertion-vec6Test = do-    psbt <- decodeHexPSBTM "Cannot parse validVec6" validVec6Hex-    assertEqual "1 input" 1 (length $ inputs psbt)-    assertEqual "1 output" 1 (length $ outputs psbt)--    let tx = unsignedTransaction psbt-    assertEqual "correct transaction" "75c5c9665a570569ad77dd1279e6fd4628a093c4dcbf8d41532614044c14c115" (txHash tx)--    assertEqual "correct unknowns" expectedUnknowns (inputUnknown . head $ inputs psbt)-  where-    expectedUnknowns = UnknownMap $ singleton-        (Key 0x0f (fromJust $ decodeHex "010203040506070809"))-        (fromJust $ decodeHex "0102030405060708090a0b0c0d0e0f")--expectedOut :: ScriptOutput-expectedOut = fromRight (error "could not decode expected output")-            . decodeOutputBS . fromJust $ decodeHex "a9143545e6e33b832c47050f24d3eeb93c9c03948bc787"--witnessScriptPubKey :: Input -> ScriptOutput-witnessScriptPubKey = fromRight (error "could not decode witness utxo")-                    . decodeOutputBS . scriptOutput . fromJust . witnessUtxo--decodeHexPSBT :: Text -> Either String PartiallySignedTransaction-decodeHexPSBT = S.decode . fromJust . decodeHex--decodeHexPSBTM :: (Monad m, MonadFail m) => String -> Text -> m PartiallySignedTransaction-decodeHexPSBTM errMsg = either (fail . (errMsg <>) . (": " <>)) return . decodeHexPSBT--hexScript :: Text -> ByteString-hexScript =-    either (error "Could not decode script") encodeScript . S.decode . fromJust . decodeHex-  where-    encodeScript :: Script -> ByteString-    encodeScript = S.encode--invalidVecTest :: Text -> Assertion-invalidVecTest = assertBool "invalid psbt" . isLeft . decodeHexPSBT--decodeVecTest :: Int -> Text -> Assertion-decodeVecTest i = assertBool (show i <> " decodes correctly") . isRight . decodeHexPSBT--encodeVecTest :: PartiallySignedTransaction -> Text -> Assertion-encodeVecTest psbt hex = assertEqual "encodes correctly" (S.encode psbt) (fromJust $ decodeHex hex)--trivialPSBT :: PartiallySignedTransaction-trivialPSBT = PartiallySignedTransaction-    { unsignedTransaction = Tx { txVersion = 2, txIn = [], txOut = [], txWitness = [], txLockTime = 0 }-    , globalUnknown = UnknownMap mempty-    , inputs = []-    , outputs = []-    }--trivialPSBTHex :: Text-trivialPSBTHex = "70736274ff01000a0200000000000000000000"--nonEmptyTransactionPSBT :: PartiallySignedTransaction-nonEmptyTransactionPSBT = emptyPSBT testTx1--verifyNonWitnessPSBT :: Network -> PartiallySignedTransaction -> Bool-verifyNonWitnessPSBT net psbt = verifyStdTx net (finalTransaction (complete psbt)) sigData-  where-    sigData = inputSigData =<< zip (inputs psbt) (txIn $ unsignedTransaction psbt)-    decodeOutScript = fromRight (error "Could not parse output script") . decodeOutputBS-    inputSigData (input, txInput) =-        map (\(TxOut val script) -> (decodeOutScript script, val, prevOutput txInput))-            (txOut . fromJust $ nonWitnessUtxo input)--unfinalizedPkhPSBT :: Network -> (SecKeyI, PubKeyI) -> PartiallySignedTransaction-unfinalizedPkhPSBT net (prvKey, pubKey) = (emptyPSBT currTx)-    { inputs = [ emptyInput { nonWitnessUtxo = Just prevTx, partialSigs = singleton pubKey sig } ] }-  where-    currTx = unfinalizedTx (txHash prevTx)-    prevTx = testUtxo [prevOut]-    prevOutScript = addressToScript (pubKeyAddr pubKey)-    prevOut = TxOut { outValue = 200000000, scriptOutput = S.encode prevOutScript }-    h = txSigHash net currTx prevOutScript (outValue prevOut) 0 sigHashAll-    sig = encodeTxSig $ TxSignature (signHash (secKeyData prvKey) h) sigHashAll--arbitraryMultiSig :: Gen ([(SecKeyI, PubKeyI)], Int)-arbitraryMultiSig = do-    (m, n) <- arbitraryMSParam-    keys <- vectorOf n arbitraryKeyPair-    return (keys, m)--unfinalizedMsPSBT :: Network -> ([(SecKeyI, PubKeyI)], Int) -> PartiallySignedTransaction-unfinalizedMsPSBT net (keys, m) = (emptyPSBT currTx)-    { inputs = [ emptyInput { nonWitnessUtxo = Just prevTx, partialSigs = sigs-                            , inputRedeemScript = Just prevOutScript-                            } ] }-  where-    currTx = unfinalizedTx (txHash prevTx)-    prevTx = testUtxo [prevOut]-    prevOutScript = encodeOutput $ PayMulSig (map snd keys) m-    prevOut = TxOut { outValue = 200000000, scriptOutput = encodeOutputBS (toP2SH prevOutScript) }-    h = txSigHash net currTx prevOutScript (outValue prevOut) 0 sigHashAll-    sigs = fromList $ map sig keys-    sig (prvKey, pubKey) = (pubKey, encodeTxSig $ TxSignature (signHash (secKeyData prvKey) h) sigHashAll)--unfinalizedTx :: TxHash -> Tx-unfinalizedTx prevHash = Tx-        { txVersion = 2-        , txIn = [ TxIn-            { prevOutput = OutPoint prevHash 0-            , scriptInput = ""-            , txInSequence = 4294967294-            } ]-        , txOut =-            [ TxOut { outValue = 99999699, scriptOutput = hexScript "76a914d0c59903c5bac2868760e90fd521a4665aa7652088ac" }-            , TxOut { outValue = 100000000, scriptOutput = hexScript "a9143545e6e33b832c47050f24d3eeb93c9c03948bc787" }-            ]-        , txWitness = []-        , txLockTime = 1257139-        }--invalidVec :: [Text]-invalidVec =-    [ "0200000001268171371edff285e937adeea4b37b78000c0566cbb3ad64641713ca42171bf6000000006a473044022070b2245123e6bf474d60c5b50c043d4c691a5d2435f09a34a7662a9dc251790a022001329ca9dacf280bdf30740ec0390422422c81cb45839457aeb76fc12edd95b3012102657d118d3357b8e0f4c2cd46db7b39f6d9c38d9a70abcb9b2de5dc8dbfe4ce31feffffff02d3dff505000000001976a914d0c59903c5bac2868760e90fd521a4665aa7652088ac00e1f5050000000017a9143545e6e33b832c47050f24d3eeb93c9c03948bc787b32e1300"-    , "70736274ff0100750200000001268171371edff285e937adeea4b37b78000c0566cbb3ad64641713ca42171bf60000000000feffffff02d3dff505000000001976a914d0c59903c5bac2868760e90fd521a4665aa7652088ac00e1f5050000000017a9143545e6e33b832c47050f24d3eeb93c9c03948bc787b32e1300000100fda5010100000000010289a3c71eab4d20e0371bbba4cc698fa295c9463afa2e397f8533ccb62f9567e50100000017160014be18d152a9b012039daf3da7de4f53349eecb985ffffffff86f8aa43a71dff1448893a530a7237ef6b4608bbb2dd2d0171e63aec6a4890b40100000017160014fe3e9ef1a745e974d902c4355943abcb34bd5353ffffffff0200c2eb0b000000001976a91485cff1097fd9e008bb34af709c62197b38978a4888ac72fef84e2c00000017a914339725ba21efd62ac753a9bcd067d6c7a6a39d05870247304402202712be22e0270f394f568311dc7ca9a68970b8025fdd3b240229f07f8a5f3a240220018b38d7dcd314e734c9276bd6fb40f673325bc4baa144c800d2f2f02db2765c012103d2e15674941bad4a996372cb87e1856d3652606d98562fe39c5e9e7e413f210502483045022100d12b852d85dcd961d2f5f4ab660654df6eedcc794c0c33ce5cc309ffb5fce58d022067338a8e0e1725c197fb1a88af59f51e44e4255b20167c8684031c05d1f2592a01210223b72beef0965d10be0778efecd61fcac6f79a4ea169393380734464f84f2ab30000000000"-    , "70736274ff0100fd0a010200000002ab0949a08c5af7c49b8212f417e2f15ab3f5c33dcf153821a8139f877a5b7be4000000006a47304402204759661797c01b036b25928948686218347d89864b719e1f7fcf57d1e511658702205309eabf56aa4d8891ffd111fdf1336f3a29da866d7f8486d75546ceedaf93190121035cdc61fc7ba971c0b501a646a2a83b102cb43881217ca682dc86e2d73fa88292feffffffab0949a08c5af7c49b8212f417e2f15ab3f5c33dcf153821a8139f877a5b7be40100000000feffffff02603bea0b000000001976a914768a40bbd740cbe81d988e71de2a4d5c71396b1d88ac8e240000000000001976a9146f4620b553fa095e721b9ee0efe9fa039cca459788ac00000000000001012000e1f5050000000017a9143545e6e33b832c47050f24d3eeb93c9c03948bc787010416001485d13537f2e265405a34dbafa9e3dda01fb82308000000"-    , "70736274ff000100fda5010100000000010289a3c71eab4d20e0371bbba4cc698fa295c9463afa2e397f8533ccb62f9567e50100000017160014be18d152a9b012039daf3da7de4f53349eecb985ffffffff86f8aa43a71dff1448893a530a7237ef6b4608bbb2dd2d0171e63aec6a4890b40100000017160014fe3e9ef1a745e974d902c4355943abcb34bd5353ffffffff0200c2eb0b000000001976a91485cff1097fd9e008bb34af709c62197b38978a4888ac72fef84e2c00000017a914339725ba21efd62ac753a9bcd067d6c7a6a39d05870247304402202712be22e0270f394f568311dc7ca9a68970b8025fdd3b240229f07f8a5f3a240220018b38d7dcd314e734c9276bd6fb40f673325bc4baa144c800d2f2f02db2765c012103d2e15674941bad4a996372cb87e1856d3652606d98562fe39c5e9e7e413f210502483045022100d12b852d85dcd961d2f5f4ab660654df6eedcc794c0c33ce5cc309ffb5fce58d022067338a8e0e1725c197fb1a88af59f51e44e4255b20167c8684031c05d1f2592a01210223b72beef0965d10be0778efecd61fcac6f79a4ea169393380734464f84f2ab30000000000"-    , "70736274ff0100750200000001268171371edff285e937adeea4b37b78000c0566cbb3ad64641713ca42171bf60000000000feffffff02d3dff505000000001976a914d0c59903c5bac2868760e90fd521a4665aa7652088ac00e1f5050000000017a9143545e6e33b832c47050f24d3eeb93c9c03948bc787b32e1300000100fda5010100000000010289a3c71eab4d20e0371bbba4cc698fa295c9463afa2e397f8533ccb62f9567e50100000017160014be18d152a9b012039daf3da7de4f53349eecb985ffffffff86f8aa43a71dff1448893a530a7237ef6b4608bbb2dd2d0171e63aec6a4890b40100000017160014fe3e9ef1a745e974d902c4355943abcb34bd5353ffffffff0200c2eb0b000000001976a91485cff1097fd9e008bb34af709c62197b38978a4888ac72fef84e2c00000017a914339725ba21efd62ac753a9bcd067d6c7a6a39d05870247304402202712be22e0270f394f568311dc7ca9a68970b8025fdd3b240229f07f8a5f3a240220018b38d7dcd314e734c9276bd6fb40f673325bc4baa144c800d2f2f02db2765c012103d2e15674941bad4a996372cb87e1856d3652606d98562fe39c5e9e7e413f210502483045022100d12b852d85dcd961d2f5f4ab660654df6eedcc794c0c33ce5cc309ffb5fce58d022067338a8e0e1725c197fb1a88af59f51e44e4255b20167c8684031c05d1f2592a01210223b72beef0965d10be0778efecd61fcac6f79a4ea169393380734464f84f2ab30000000001003f0200000001ffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff0000000000ffffffff010000000000000000036a010000000000000000"-    , "70736274ff020001550200000001279a2323a5dfb51fc45f220fa58b0fc13e1e3342792a85d7e36cd6333b5cbc390000000000ffffffff01a05aea0b000000001976a914ffe9c0061097cc3b636f2cb0460fa4fc427d2b4588ac0000000000010120955eea0b0000000017a9146345200f68d189e1adc0df1c4d16ea8f14c0dbeb87220203b1341ccba7683b6af4f1238cd6e97e7167d569fac47f1e48d47541844355bd4646304302200424b58effaaa694e1559ea5c93bbfd4a89064224055cdf070b6771469442d07021f5c8eb0fea6516d60b8acb33ad64ede60e8785bfb3aa94b99bdf86151db9a9a010104220020771fd18ad459666dd49f3d564e3dbc42f4c84774e360ada16816a8ed488d5681010547522103b1341ccba7683b6af4f1238cd6e97e7167d569fac47f1e48d47541844355bd462103de55d1e1dac805e3f8a58c1fbf9b94c02f3dbaafe127fefca4995f26f82083bd52ae220603b1341ccba7683b6af4f1238cd6e97e7167d569fac47f1e48d47541844355bd4610b4a6ba67000000800000008004000080220603de55d1e1dac805e3f8a58c1fbf9b94c02f3dbaafe127fefca4995f26f82083bd10b4a6ba670000008000000080050000800000"-    , "70736274ff0100550200000001279a2323a5dfb51fc45f220fa58b0fc13e1e3342792a85d7e36cd6333b5cbc390000000000ffffffff01a05aea0b000000001976a914ffe9c0061097cc3b636f2cb0460fa4fc427d2b4588ac000000000002010020955eea0b0000000017a9146345200f68d189e1adc0df1c4d16ea8f14c0dbeb87220203b1341ccba7683b6af4f1238cd6e97e7167d569fac47f1e48d47541844355bd4646304302200424b58effaaa694e1559ea5c93bbfd4a89064224055cdf070b6771469442d07021f5c8eb0fea6516d60b8acb33ad64ede60e8785bfb3aa94b99bdf86151db9a9a010104220020771fd18ad459666dd49f3d564e3dbc42f4c84774e360ada16816a8ed488d5681010547522103b1341ccba7683b6af4f1238cd6e97e7167d569fac47f1e48d47541844355bd462103de55d1e1dac805e3f8a58c1fbf9b94c02f3dbaafe127fefca4995f26f82083bd52ae220603b1341ccba7683b6af4f1238cd6e97e7167d569fac47f1e48d47541844355bd4610b4a6ba67000000800000008004000080220603de55d1e1dac805e3f8a58c1fbf9b94c02f3dbaafe127fefca4995f26f82083bd10b4a6ba670000008000000080050000800000"-    , "70736274ff0100550200000001279a2323a5dfb51fc45f220fa58b0fc13e1e3342792a85d7e36cd6333b5cbc390000000000ffffffff01a05aea0b000000001976a914ffe9c0061097cc3b636f2cb0460fa4fc427d2b4588ac0000000000010120955eea0b0000000017a9146345200f68d189e1adc0df1c4d16ea8f14c0dbeb87210203b1341ccba7683b6af4f1238cd6e97e7167d569fac47f1e48d47541844355bd46304302200424b58effaaa694e1559ea5c93bbfd4a89064224055cdf070b6771469442d07021f5c8eb0fea6516d60b8acb33ad64ede60e8785bfb3aa94b99bdf86151db9a9a010104220020771fd18ad459666dd49f3d564e3dbc42f4c84774e360ada16816a8ed488d5681010547522103b1341ccba7683b6af4f1238cd6e97e7167d569fac47f1e48d47541844355bd462103de55d1e1dac805e3f8a58c1fbf9b94c02f3dbaafe127fefca4995f26f82083bd52ae220603b1341ccba7683b6af4f1238cd6e97e7167d569fac47f1e48d47541844355bd4610b4a6ba67000000800000008004000080220603de55d1e1dac805e3f8a58c1fbf9b94c02f3dbaafe127fefca4995f26f82083bd10b4a6ba670000008000000080050000800000"-    , "70736274ff0100550200000001279a2323a5dfb51fc45f220fa58b0fc13e1e3342792a85d7e36cd6333b5cbc390000000000ffffffff01a05aea0b000000001976a914ffe9c0061097cc3b636f2cb0460fa4fc427d2b4588ac0000000000010120955eea0b0000000017a9146345200f68d189e1adc0df1c4d16ea8f14c0dbeb87220203b1341ccba7683b6af4f1238cd6e97e7167d569fac47f1e48d47541844355bd4646304302200424b58effaaa694e1559ea5c93bbfd4a89064224055cdf070b6771469442d07021f5c8eb0fea6516d60b8acb33ad64ede60e8785bfb3aa94b99bdf86151db9a9a01020400220020771fd18ad459666dd49f3d564e3dbc42f4c84774e360ada16816a8ed488d5681010547522103b1341ccba7683b6af4f1238cd6e97e7167d569fac47f1e48d47541844355bd462103de55d1e1dac805e3f8a58c1fbf9b94c02f3dbaafe127fefca4995f26f82083bd52ae220603b1341ccba7683b6af4f1238cd6e97e7167d569fac47f1e48d47541844355bd4610b4a6ba67000000800000008004000080220603de55d1e1dac805e3f8a58c1fbf9b94c02f3dbaafe127fefca4995f26f82083bd10b4a6ba670000008000000080050000800000"-    , "70736274ff0100550200000001279a2323a5dfb51fc45f220fa58b0fc13e1e3342792a85d7e36cd6333b5cbc390000000000ffffffff01a05aea0b000000001976a914ffe9c0061097cc3b636f2cb0460fa4fc427d2b4588ac0000000000010120955eea0b0000000017a9146345200f68d189e1adc0df1c4d16ea8f14c0dbeb87220203b1341ccba7683b6af4f1238cd6e97e7167d569fac47f1e48d47541844355bd4646304302200424b58effaaa694e1559ea5c93bbfd4a89064224055cdf070b6771469442d07021f5c8eb0fea6516d60b8acb33ad64ede60e8785bfb3aa94b99bdf86151db9a9a010104220020771fd18ad459666dd49f3d564e3dbc42f4c84774e360ada16816a8ed488d568102050047522103b1341ccba7683b6af4f1238cd6e97e7167d569fac47f1e48d47541844355bd462103de55d1e1dac805e3f8a58c1fbf9b94c02f3dbaafe127fefca4995f26f82083bd52ae220603b1341ccba7683b6af4f1238cd6e97e7167d569fac47f1e48d47541844355bd4610b4a6ba67000000800000008004000080220603de55d1e1dac805e3f8a58c1fbf9b94c02f3dbaafe127fefca4995f26f82083bd10b4a6ba670000008000000080050000800000"-    , "70736274ff0100550200000001279a2323a5dfb51fc45f220fa58b0fc13e1e3342792a85d7e36cd6333b5cbc390000000000ffffffff01a05aea0b000000001976a914ffe9c0061097cc3b636f2cb0460fa4fc427d2b4588ac0000000000010120955eea0b0000000017a9146345200f68d189e1adc0df1c4d16ea8f14c0dbeb87220203b1341ccba7683b6af4f1238cd6e97e7167d569fac47f1e48d47541844355bd4646304302200424b58effaaa694e1559ea5c93bbfd4a89064224055cdf070b6771469442d07021f5c8eb0fea6516d60b8acb33ad64ede60e8785bfb3aa94b99bdf86151db9a9a010104220020771fd18ad459666dd49f3d564e3dbc42f4c84774e360ada16816a8ed488d5681010547522103b1341ccba7683b6af4f1238cd6e97e7167d569fac47f1e48d47541844355bd462103de55d1e1dac805e3f8a58c1fbf9b94c02f3dbaafe127fefca4995f26f82083bd52ae210603b1341ccba7683b6af4f1238cd6e97e7167d569fac47f1e48d47541844355bd10b4a6ba67000000800000008004000080220603de55d1e1dac805e3f8a58c1fbf9b94c02f3dbaafe127fefca4995f26f82083bd10b4a6ba670000008000000080050000800000"-    , "70736274ff01009a020000000258e87a21b56daf0c23be8e7070456c336f7cbaa5c8757924f545887bb2abdd750000000000ffffffff838d0427d0ec650a68aa46bb0b098aea4422c071b2ca78352a077959d07cea1d0100000000ffffffff0270aaf00800000000160014d85c2b71d0060b09c9886aeb815e50991dda124d00e1f5050000000016001400aea9a2e5f0f876a588df5546e8742d1d87008f0000000000020000bb0200000001aad73931018bd25f84ae400b68848be09db706eac2ac18298babee71ab656f8b0000000048473044022058f6fc7c6a33e1b31548d481c826c015bd30135aad42cd67790dab66d2ad243b02204a1ced2604c6735b6393e5b41691dd78b00f0c5942fb9f751856faa938157dba01feffffff0280f0fa020000000017a9140fb9463421696b82c833af241c78c17ddbde493487d0f20a270100000017a91429ca74f8a08f81999428185c97b5d852e4063f6187650000000107da00473044022074018ad4180097b873323c0015720b3684cc8123891048e7dbcd9b55ad679c99022073d369b740e3eb53dcefa33823c8070514ca55a7dd9544f157c167913261118c01483045022100f61038b308dc1da865a34852746f015772934208c6d24454393cd99bdf2217770220056e675a675a6d0a02b85b14e5e29074d8a25a9b5760bea2816f661910a006ea01475221029583bf39ae0a609747ad199addd634fa6108559d6c5cd39b4c2183f1ab96e07f2102dab61ff49a14db6a7d02b0cd1fbb78fc4b18312b5b4e54dae4dba2fbfef536d752ae0001012000c2eb0b0000000017a914b7f5faf40e3d40a5a459b1db3535f2b72fa921e8870107232200208c2353173743b595dfb4a07b72ba8e42e3797da74e87fe7d9d7497e3b20289030108da0400473044022062eb7a556107a7c73f45ac4ab5a1dddf6f7075fb1275969a7f383efff784bcb202200c05dbb7470dbf2f08557dd356c7325c1ed30913e996cd3840945db12228da5f01473044022065f45ba5998b59a27ffe1a7bed016af1f1f90d54b3aa8f7450aa5f56a25103bd02207f724703ad1edb96680b284b56d4ffcb88f7fb759eabbe08aa30f29b851383d20147522103089dc10c7ac6db54f91329af617333db388cead0c231f723379d1b99030b02dc21023add904f3d6dcf59ddb906b0dee23529b7ffb9ed50e5e86151926860221f0e7352ae00220203a9a4c37f5996d3aa25dbac6b570af0650394492942460b354753ed9eeca5877110d90c6a4f000000800000008004000080002202027f6399757d2eff55a136ad02c684b1838b6556e5f1b6b34282a94b6b5005109610d90c6a4f00000080000000800500008000"-    , "70736274ff01009a020000000258e87a21b56daf0c23be8e7070456c336f7cbaa5c8757924f545887bb2abdd750000000000ffffffff838d0427d0ec650a68aa46bb0b098aea4422c071b2ca78352a077959d07cea1d0100000000ffffffff0270aaf00800000000160014d85c2b71d0060b09c9886aeb815e50991dda124d00e1f5050000000016001400aea9a2e5f0f876a588df5546e8742d1d87008f00000000000100bb0200000001aad73931018bd25f84ae400b68848be09db706eac2ac18298babee71ab656f8b0000000048473044022058f6fc7c6a33e1b31548d481c826c015bd30135aad42cd67790dab66d2ad243b02204a1ced2604c6735b6393e5b41691dd78b00f0c5942fb9f751856faa938157dba01feffffff0280f0fa020000000017a9140fb9463421696b82c833af241c78c17ddbde493487d0f20a270100000017a91429ca74f8a08f81999428185c97b5d852e4063f618765000000020700da00473044022074018ad4180097b873323c0015720b3684cc8123891048e7dbcd9b55ad679c99022073d369b740e3eb53dcefa33823c8070514ca55a7dd9544f157c167913261118c01483045022100f61038b308dc1da865a34852746f015772934208c6d24454393cd99bdf2217770220056e675a675a6d0a02b85b14e5e29074d8a25a9b5760bea2816f661910a006ea01475221029583bf39ae0a609747ad199addd634fa6108559d6c5cd39b4c2183f1ab96e07f2102dab61ff49a14db6a7d02b0cd1fbb78fc4b18312b5b4e54dae4dba2fbfef536d752ae0001012000c2eb0b0000000017a914b7f5faf40e3d40a5a459b1db3535f2b72fa921e8870107232200208c2353173743b595dfb4a07b72ba8e42e3797da74e87fe7d9d7497e3b20289030108da0400473044022062eb7a556107a7c73f45ac4ab5a1dddf6f7075fb1275969a7f383efff784bcb202200c05dbb7470dbf2f08557dd356c7325c1ed30913e996cd3840945db12228da5f01473044022065f45ba5998b59a27ffe1a7bed016af1f1f90d54b3aa8f7450aa5f56a25103bd02207f724703ad1edb96680b284b56d4ffcb88f7fb759eabbe08aa30f29b851383d20147522103089dc10c7ac6db54f91329af617333db388cead0c231f723379d1b99030b02dc21023add904f3d6dcf59ddb906b0dee23529b7ffb9ed50e5e86151926860221f0e7352ae00220203a9a4c37f5996d3aa25dbac6b570af0650394492942460b354753ed9eeca5877110d90c6a4f000000800000008004000080002202027f6399757d2eff55a136ad02c684b1838b6556e5f1b6b34282a94b6b5005109610d90c6a4f00000080000000800500008000"-    , "70736274ff01009a020000000258e87a21b56daf0c23be8e7070456c336f7cbaa5c8757924f545887bb2abdd750000000000ffffffff838d0427d0ec650a68aa46bb0b098aea4422c071b2ca78352a077959d07cea1d0100000000ffffffff0270aaf00800000000160014d85c2b71d0060b09c9886aeb815e50991dda124d00e1f5050000000016001400aea9a2e5f0f876a588df5546e8742d1d87008f00000000000100bb0200000001aad73931018bd25f84ae400b68848be09db706eac2ac18298babee71ab656f8b0000000048473044022058f6fc7c6a33e1b31548d481c826c015bd30135aad42cd67790dab66d2ad243b02204a1ced2604c6735b6393e5b41691dd78b00f0c5942fb9f751856faa938157dba01feffffff0280f0fa020000000017a9140fb9463421696b82c833af241c78c17ddbde493487d0f20a270100000017a91429ca74f8a08f81999428185c97b5d852e4063f6187650000000107da00473044022074018ad4180097b873323c0015720b3684cc8123891048e7dbcd9b55ad679c99022073d369b740e3eb53dcefa33823c8070514ca55a7dd9544f157c167913261118c01483045022100f61038b308dc1da865a34852746f015772934208c6d24454393cd99bdf2217770220056e675a675a6d0a02b85b14e5e29074d8a25a9b5760bea2816f661910a006ea01475221029583bf39ae0a609747ad199addd634fa6108559d6c5cd39b4c2183f1ab96e07f2102dab61ff49a14db6a7d02b0cd1fbb78fc4b18312b5b4e54dae4dba2fbfef536d752ae0001012000c2eb0b0000000017a914b7f5faf40e3d40a5a459b1db3535f2b72fa921e8870107232200208c2353173743b595dfb4a07b72ba8e42e3797da74e87fe7d9d7497e3b2028903020800da0400473044022062eb7a556107a7c73f45ac4ab5a1dddf6f7075fb1275969a7f383efff784bcb202200c05dbb7470dbf2f08557dd356c7325c1ed30913e996cd3840945db12228da5f01473044022065f45ba5998b59a27ffe1a7bed016af1f1f90d54b3aa8f7450aa5f56a25103bd02207f724703ad1edb96680b284b56d4ffcb88f7fb759eabbe08aa30f29b851383d20147522103089dc10c7ac6db54f91329af617333db388cead0c231f723379d1b99030b02dc21023add904f3d6dcf59ddb906b0dee23529b7ffb9ed50e5e86151926860221f0e7352ae00220203a9a4c37f5996d3aa25dbac6b570af0650394492942460b354753ed9eeca5877110d90c6a4f000000800000008004000080002202027f6399757d2eff55a136ad02c684b1838b6556e5f1b6b34282a94b6b5005109610d90c6a4f00000080000000800500008000"-    , "70736274ff01009a020000000258e87a21b56daf0c23be8e7070456c336f7cbaa5c8757924f545887bb2abdd750000000000ffffffff838d0427d0ec650a68aa46bb0b098aea4422c071b2ca78352a077959d07cea1d0100000000ffffffff0270aaf00800000000160014d85c2b71d0060b09c9886aeb815e50991dda124d00e1f5050000000016001400aea9a2e5f0f876a588df5546e8742d1d87008f00000000000100bb0200000001aad73931018bd25f84ae400b68848be09db706eac2ac18298babee71ab656f8b0000000048473044022058f6fc7c6a33e1b31548d481c826c015bd30135aad42cd67790dab66d2ad243b02204a1ced2604c6735b6393e5b41691dd78b00f0c5942fb9f751856faa938157dba01feffffff0280f0fa020000000017a9140fb9463421696b82c833af241c78c17ddbde493487d0f20a270100000017a91429ca74f8a08f81999428185c97b5d852e4063f6187650000000107da00473044022074018ad4180097b873323c0015720b3684cc8123891048e7dbcd9b55ad679c99022073d369b740e3eb53dcefa33823c8070514ca55a7dd9544f157c167913261118c01483045022100f61038b308dc1da865a34852746f015772934208c6d24454393cd99bdf2217770220056e675a675a6d0a02b85b14e5e29074d8a25a9b5760bea2816f661910a006ea01475221029583bf39ae0a609747ad199addd634fa6108559d6c5cd39b4c2183f1ab96e07f2102dab61ff49a14db6a7d02b0cd1fbb78fc4b18312b5b4e54dae4dba2fbfef536d752ae0001012000c2eb0b0000000017a914b7f5faf40e3d40a5a459b1db3535f2b72fa921e8870107232200208c2353173743b595dfb4a07b72ba8e42e3797da74e87fe7d9d7497e3b20289030108da0400473044022062eb7a556107a7c73f45ac4ab5a1dddf6f7075fb1275969a7f383efff784bcb202200c05dbb7470dbf2f08557dd356c7325c1ed30913e996cd3840945db12228da5f01473044022065f45ba5998b59a27ffe1a7bed016af1f1f90d54b3aa8f7450aa5f56a25103bd02207f724703ad1edb96680b284b56d4ffcb88f7fb759eabbe08aa30f29b851383d20147522103089dc10c7ac6db54f91329af617333db388cead0c231f723379d1b99030b02dc21023add904f3d6dcf59ddb906b0dee23529b7ffb9ed50e5e86151926860221f0e7352ae00210203a9a4c37f5996d3aa25dbac6b570af0650394492942460b354753ed9eeca58710d90c6a4f000000800000008004000080002202027f6399757d2eff55a136ad02c684b1838b6556e5f1b6b34282a94b6b5005109610d90c6a4f00000080000000800500008000"-    , "70736274ff0100730200000001301ae986e516a1ec8ac5b4bc6573d32f83b465e23ad76167d68b38e730b4dbdb0000000000ffffffff02747b01000000000017a91403aa17ae882b5d0d54b25d63104e4ffece7b9ea2876043993b0000000017a914b921b1ba6f722e4bfa83b6557a3139986a42ec8387000000000001011f00ca9a3b00000000160014d2d94b64ae08587eefc8eeb187c601e939f9037c0203000100000000010016001462e9e982fff34dd8239610316b090cd2a3b747cb000100220020876bad832f1d168015ed41232a9ea65a1815d9ef13c0ef8759f64b5b2b278a65010125512103b7ce23a01c5b4bf00a642537cdfabb315b668332867478ef51309d2bd57f8a8751ae00"-    , "70736274ff0100730200000001301ae986e516a1ec8ac5b4bc6573d32f83b465e23ad76167d68b38e730b4dbdb0000000000ffffffff02747b01000000000017a91403aa17ae882b5d0d54b25d63104e4ffece7b9ea2876043993b0000000017a914b921b1ba6f722e4bfa83b6557a3139986a42ec8387000000000001011f00ca9a3b00000000160014d2d94b64ae08587eefc8eeb187c601e939f9037c0002000016001462e9e982fff34dd8239610316b090cd2a3b747cb000100220020876bad832f1d168015ed41232a9ea65a1815d9ef13c0ef8759f64b5b2b278a65010125512103b7ce23a01c5b4bf00a642537cdfabb315b668332867478ef51309d2bd57f8a8751ae00"-    , "70736274ff0100730200000001301ae986e516a1ec8ac5b4bc6573d32f83b465e23ad76167d68b38e730b4dbdb0000000000ffffffff02747b01000000000017a91403aa17ae882b5d0d54b25d63104e4ffece7b9ea2876043993b0000000017a914b921b1ba6f722e4bfa83b6557a3139986a42ec8387000000000001011f00ca9a3b00000000160014d2d94b64ae08587eefc8eeb187c601e939f9037c00010016001462e9e982fff34dd8239610316b090cd2a3b747cb000100220020876bad832f1d168015ed41232a9ea65a1815d9ef13c0ef8759f64b5b2b278a6521010025512103b7ce23a01c5b4bf00a642537cdfabb315b668332867478ef51309d2bd57f8a8751ae00"-    ]---validEncodeVec :: [(PartiallySignedTransaction, Text)]-validEncodeVec = [(validVec1, validVec1Hex)]--testTx1 :: Tx-testTx1 = Tx-        { txVersion = 2-        , txIn = [ TxIn-            { prevOutput = OutPoint "f61b1742ca13176464adb3cb66050c00787bb3a4eead37e985f2df1e37718126" 0-            , scriptInput = ""-            , txInSequence = 4294967294-            } ]-        , txOut =-            [ TxOut { outValue = 99999699, scriptOutput = hexScript "76a914d0c59903c5bac2868760e90fd521a4665aa7652088ac" }-            , TxOut { outValue = 100000000, scriptOutput = hexScript "a9143545e6e33b832c47050f24d3eeb93c9c03948bc787" }-            ]-        , txWitness = []-        , txLockTime = 1257139-        }--testUtxo :: [TxOut] -> Tx-testUtxo prevOuts = Tx-        { txVersion = 1-        , txIn =-            [ TxIn-                { prevOutput = OutPoint "e567952fb6cc33857f392efa3a46c995a28f69cca4bb1b37e0204dab1ec7a389" 1-                , scriptInput = hexScript "160014be18d152a9b012039daf3da7de4f53349eecb985"-                , txInSequence = 4294967295-                }-            , TxIn-                { prevOutput = OutPoint "b490486aec3ae671012dddb2bb08466bef37720a533a894814ff1da743aaf886" 1-                , scriptInput = hexScript "160014fe3e9ef1a745e974d902c4355943abcb34bd5353"-                , txInSequence = 4294967295-                }-            ]-        , txOut = prevOuts-        , txWitness =-            [-              [ fromJust $ decodeHex "304402202712be22e0270f394f568311dc7ca9a68970b8025fdd3b240229f07f8a5f3a240220018b38d7dcd314e734c9276bd6fb40f673325bc4baa144c800d2f2f02db2765c01"-              , fromJust $ decodeHex "03d2e15674941bad4a996372cb87e1856d3652606d98562fe39c5e9e7e413f2105"-              ]-            , [ fromJust $ decodeHex "3045022100d12b852d85dcd961d2f5f4ab660654df6eedcc794c0c33ce5cc309ffb5fce58d022067338a8e0e1725c197fb1a88af59f51e44e4255b20167c8684031c05d1f2592a01"-              , fromJust $ decodeHex "0223b72beef0965d10be0778efecd61fcac6f79a4ea169393380734464f84f2ab3"-              ]-            ]-        , txLockTime = 0-        }--testUtxo1 :: Tx-testUtxo1 = testUtxo-    [ TxOut { outValue = 200000000, scriptOutput = hexScript "76a91485cff1097fd9e008bb34af709c62197b38978a4888ac" }-    , TxOut { outValue = 190303501938, scriptOutput = hexScript "a914339725ba21efd62ac753a9bcd067d6c7a6a39d0587" }-    ]--validVec1 :: PartiallySignedTransaction-validVec1 = (emptyPSBT testTx1) { inputs = [ emptyInput { nonWitnessUtxo = Just testUtxo1 } ] }--validVec :: [Text]-validVec = [validVec1Hex, validVec2Hex, validVec3Hex, validVec4Hex, validVec5Hex, validVec6Hex]--validVec1Hex :: Text-validVec1Hex = "70736274ff0100750200000001268171371edff285e937adeea4b37b78000c0566cbb3ad64641713ca42171bf60000000000feffffff02d3dff505000000001976a914d0c59903c5bac2868760e90fd521a4665aa7652088ac00e1f5050000000017a9143545e6e33b832c47050f24d3eeb93c9c03948bc787b32e1300000100fda5010100000000010289a3c71eab4d20e0371bbba4cc698fa295c9463afa2e397f8533ccb62f9567e50100000017160014be18d152a9b012039daf3da7de4f53349eecb985ffffffff86f8aa43a71dff1448893a530a7237ef6b4608bbb2dd2d0171e63aec6a4890b40100000017160014fe3e9ef1a745e974d902c4355943abcb34bd5353ffffffff0200c2eb0b000000001976a91485cff1097fd9e008bb34af709c62197b38978a4888ac72fef84e2c00000017a914339725ba21efd62ac753a9bcd067d6c7a6a39d05870247304402202712be22e0270f394f568311dc7ca9a68970b8025fdd3b240229f07f8a5f3a240220018b38d7dcd314e734c9276bd6fb40f673325bc4baa144c800d2f2f02db2765c012103d2e15674941bad4a996372cb87e1856d3652606d98562fe39c5e9e7e413f210502483045022100d12b852d85dcd961d2f5f4ab660654df6eedcc794c0c33ce5cc309ffb5fce58d022067338a8e0e1725c197fb1a88af59f51e44e4255b20167c8684031c05d1f2592a01210223b72beef0965d10be0778efecd61fcac6f79a4ea169393380734464f84f2ab300000000000000"--validVec2Hex :: Text-validVec2Hex = "70736274ff0100a00200000002ab0949a08c5af7c49b8212f417e2f15ab3f5c33dcf153821a8139f877a5b7be40000000000feffffffab0949a08c5af7c49b8212f417e2f15ab3f5c33dcf153821a8139f877a5b7be40100000000feffffff02603bea0b000000001976a914768a40bbd740cbe81d988e71de2a4d5c71396b1d88ac8e240000000000001976a9146f4620b553fa095e721b9ee0efe9fa039cca459788ac000000000001076a47304402204759661797c01b036b25928948686218347d89864b719e1f7fcf57d1e511658702205309eabf56aa4d8891ffd111fdf1336f3a29da866d7f8486d75546ceedaf93190121035cdc61fc7ba971c0b501a646a2a83b102cb43881217ca682dc86e2d73fa882920001012000e1f5050000000017a9143545e6e33b832c47050f24d3eeb93c9c03948bc787010416001485d13537f2e265405a34dbafa9e3dda01fb82308000000"--validVec3Hex :: Text-validVec3Hex = "70736274ff0100750200000001268171371edff285e937adeea4b37b78000c0566cbb3ad64641713ca42171bf60000000000feffffff02d3dff505000000001976a914d0c59903c5bac2868760e90fd521a4665aa7652088ac00e1f5050000000017a9143545e6e33b832c47050f24d3eeb93c9c03948bc787b32e1300000100fda5010100000000010289a3c71eab4d20e0371bbba4cc698fa295c9463afa2e397f8533ccb62f9567e50100000017160014be18d152a9b012039daf3da7de4f53349eecb985ffffffff86f8aa43a71dff1448893a530a7237ef6b4608bbb2dd2d0171e63aec6a4890b40100000017160014fe3e9ef1a745e974d902c4355943abcb34bd5353ffffffff0200c2eb0b000000001976a91485cff1097fd9e008bb34af709c62197b38978a4888ac72fef84e2c00000017a914339725ba21efd62ac753a9bcd067d6c7a6a39d05870247304402202712be22e0270f394f568311dc7ca9a68970b8025fdd3b240229f07f8a5f3a240220018b38d7dcd314e734c9276bd6fb40f673325bc4baa144c800d2f2f02db2765c012103d2e15674941bad4a996372cb87e1856d3652606d98562fe39c5e9e7e413f210502483045022100d12b852d85dcd961d2f5f4ab660654df6eedcc794c0c33ce5cc309ffb5fce58d022067338a8e0e1725c197fb1a88af59f51e44e4255b20167c8684031c05d1f2592a01210223b72beef0965d10be0778efecd61fcac6f79a4ea169393380734464f84f2ab30000000001030401000000000000"--validVec4Hex :: Text-validVec4Hex = "70736274ff0100a00200000002ab0949a08c5af7c49b8212f417e2f15ab3f5c33dcf153821a8139f877a5b7be40000000000feffffffab0949a08c5af7c49b8212f417e2f15ab3f5c33dcf153821a8139f877a5b7be40100000000feffffff02603bea0b000000001976a914768a40bbd740cbe81d988e71de2a4d5c71396b1d88ac8e240000000000001976a9146f4620b553fa095e721b9ee0efe9fa039cca459788ac00000000000100df0200000001268171371edff285e937adeea4b37b78000c0566cbb3ad64641713ca42171bf6000000006a473044022070b2245123e6bf474d60c5b50c043d4c691a5d2435f09a34a7662a9dc251790a022001329ca9dacf280bdf30740ec0390422422c81cb45839457aeb76fc12edd95b3012102657d118d3357b8e0f4c2cd46db7b39f6d9c38d9a70abcb9b2de5dc8dbfe4ce31feffffff02d3dff505000000001976a914d0c59903c5bac2868760e90fd521a4665aa7652088ac00e1f5050000000017a9143545e6e33b832c47050f24d3eeb93c9c03948bc787b32e13000001012000e1f5050000000017a9143545e6e33b832c47050f24d3eeb93c9c03948bc787010416001485d13537f2e265405a34dbafa9e3dda01fb8230800220202ead596687ca806043edc3de116cdf29d5e9257c196cd055cf698c8d02bf24e9910b4a6ba670000008000000080020000800022020394f62be9df19952c5587768aeb7698061ad2c4a25c894f47d8c162b4d7213d0510b4a6ba6700000080010000800200008000"--validVec5Hex :: Text-validVec5Hex = "70736274ff0100550200000001279a2323a5dfb51fc45f220fa58b0fc13e1e3342792a85d7e36cd6333b5cbc390000000000ffffffff01a05aea0b000000001976a914ffe9c0061097cc3b636f2cb0460fa4fc427d2b4588ac0000000000010120955eea0b0000000017a9146345200f68d189e1adc0df1c4d16ea8f14c0dbeb87220203b1341ccba7683b6af4f1238cd6e97e7167d569fac47f1e48d47541844355bd4646304302200424b58effaaa694e1559ea5c93bbfd4a89064224055cdf070b6771469442d07021f5c8eb0fea6516d60b8acb33ad64ede60e8785bfb3aa94b99bdf86151db9a9a010104220020771fd18ad459666dd49f3d564e3dbc42f4c84774e360ada16816a8ed488d5681010547522103b1341ccba7683b6af4f1238cd6e97e7167d569fac47f1e48d47541844355bd462103de55d1e1dac805e3f8a58c1fbf9b94c02f3dbaafe127fefca4995f26f82083bd52ae220603b1341ccba7683b6af4f1238cd6e97e7167d569fac47f1e48d47541844355bd4610b4a6ba67000000800000008004000080220603de55d1e1dac805e3f8a58c1fbf9b94c02f3dbaafe127fefca4995f26f82083bd10b4a6ba670000008000000080050000800000"--validVec6Hex :: Text-validVec6Hex = "70736274ff01003f0200000001ffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff0000000000ffffffff010000000000000000036a010000000000000a0f0102030405060708090f0102030405060708090a0b0c0d0e0f0000"
− test/Network/Haskoin/TransactionSpec.hs 
@@ -1,396 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}--module Network.Haskoin.TransactionSpec (spec) where--import           Data.Aeson                         as A-import qualified Data.ByteString                    as B-import           Data.Either-import           Data.Map.Strict                    (singleton)-import           Data.Maybe-import           Data.Serialize                     as S-import           Data.String                        (fromString)-import           Data.String.Conversions-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           Test.Hspec-import           Test.HUnit                         (Assertion, assertBool)-import           Test.QuickCheck--spec :: Spec-spec = do-    let net = btc-    describe "transaction unit tests" $ do-        it "compute txid from tx" $-            mapM_ runTxIDVec txIDVec-        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 $-            forAll arbitraryTxHash $ \h -> hexToTxHash (txHashToHex h) == Just h-        it "from string transaction id" $-            property $-            forAll arbitraryTxHash $ \h -> fromString (cs $ txHashToHex h) == h-        it "building address tx" $-            property $-            forAll arbitraryAddress $-            forAll (arbitrarySatoshi net) . testBuildAddrTx net-        it "guess transaction size" $-            property $ forAll (arbitraryAddrOnlyTxFull net) (testGuessSize net)-        it "choose coins" $-            property $ forAll (listOf (arbitrarySatoshi net)) testChooseCoins-        it "choose multisig coins" $-            property $-            forAll arbitraryMSParam $-            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-        it "encodes and decodes transaction" $-            property $ forAll (arbitraryTx net) testID-        it "encodes and decodes transaction hash" $-            property $ forAll arbitraryTxHash testID-    describe "transaction serialization" $ do-        it "encodes and decodes tx input" $-            property $ forAll (arbitraryTxIn net) cerealID-        it "encodes and decodes tx output" $-            property $ forAll (arbitraryTxOut net) cerealID-        it "encodes and decodes outpoint" $-            property $ forAll arbitraryOutPoint cerealID-        it "encodes and decodes transaction" $-            property $ forAll (arbitraryTx net) cerealID-        it "encodes and decodes witness transaction" $-            property $ forAll (arbitraryWitnessTx net) cerealID-        it "encodes and decodes legacy transaction" $-            property $ forAll (arbitraryLegacyTx net) cerealID--cerealID :: (Serialize a, Eq a) => a -> Bool-cerealID x = S.decode (S.encode x) == Right x--runTxIDVec :: (Text, Text) -> Assertion-runTxIDVec (tid, tx) = assertBool "txid" $ txHashToHex (txHash txBS) == tid-  where-    txBS = fromJust $ either (const Nothing) return . S.decode =<< decodeHex tx--txIDVec :: [(Text, Text)]-txIDVec =-    [ ( "23b397edccd3740a74adb603c9756370fafcde9bcc4483eb271ecad09a94dd63"-      , "0100000001b14bdcbc3e01bdaad36cc08e81e69c82e1060bc14e518db2b49aa43ad90ba26000000000490047304402203f16c6f40162ab686621ef3000b04e75418a0c0cb2d8aebeac894ae360ac1e780220ddc15ecdfc3507ac48e1681a33eb60996631bf6bf5bc0a0682c4db743ce7ca2b01ffffffff0140420f00000000001976a914660d4ef3a743e3e696ad990364e555c271ad504b88ac00000000"-      )-    , ( "c99c49da4c38af669dea436d3e73780dfdb6c1ecf9958baa52960e8baee30e73"-      , "01000000010276b76b07f4935c70acf54fbf1f438a4c397a9fb7e633873c4dd3bc062b6b40000000008c493046022100d23459d03ed7e9511a47d13292d3430a04627de6235b6e51a40f9cd386f2abe3022100e7d25b080f0bb8d8d5f878bba7d54ad2fda650ea8d158a33ee3cbd11768191fd004104b0e2c879e4daf7b9ab68350228c159766676a14f5815084ba166432aab46198d4cca98fa3e9981d0a90b2effc514b76279476550ba3663fdcaff94c38420e9d5000000000100093d00000000001976a9149a7b0f3b80c6baaeedce0a0842553800f832ba1f88ac00000000"-      )-    , ( "f7fdd091fa6d8f5e7a8c2458f5c38faffff2d3f1406b6e4fe2c99dcc0d2d1cbb"-      , "01000000023d6cf972d4dff9c519eff407ea800361dd0a121de1da8b6f4138a2f25de864b4000000008a4730440220ffda47bfc776bcd269da4832626ac332adfca6dd835e8ecd83cd1ebe7d709b0e022049cffa1cdc102a0b56e0e04913606c70af702a1149dc3b305ab9439288fee090014104266abb36d66eb4218a6dd31f09bb92cf3cfa803c7ea72c1fc80a50f919273e613f895b855fb7465ccbc8919ad1bd4a306c783f22cd3227327694c4fa4c1c439affffffff21ebc9ba20594737864352e95b727f1a565756f9d365083eb1a8596ec98c97b7010000008a4730440220503ff10e9f1e0de731407a4a245531c9ff17676eda461f8ceeb8c06049fa2c810220c008ac34694510298fa60b3f000df01caa244f165b727d4896eb84f81e46bcc4014104266abb36d66eb4218a6dd31f09bb92cf3cfa803c7ea72c1fc80a50f919273e613f895b855fb7465ccbc8919ad1bd4a306c783f22cd3227327694c4fa4c1c439affffffff01f0da5200000000001976a914857ccd42dded6df32949d4646dfa10a92458cfaa88ac00000000"-      )-    , ( "afd9c17f8913577ec3509520bd6e5d63e9c0fd2a5f70c787993b097ba6ca9fae"-      , "010000000370ac0a1ae588aaf284c308d67ca92c69a39e2db81337e563bf40c59da0a5cf63000000006a4730440220360d20baff382059040ba9be98947fd678fb08aab2bb0c172efa996fd8ece9b702201b4fb0de67f015c90e7ac8a193aeab486a1f587e0f54d0fb9552ef7f5ce6caec032103579ca2e6d107522f012cd00b52b9a65fb46f0c57b9b8b6e377c48f526a44741affffffff7d815b6447e35fbea097e00e028fb7dfbad4f3f0987b4734676c84f3fcd0e804010000006b483045022100c714310be1e3a9ff1c5f7cacc65c2d8e781fc3a88ceb063c6153bf950650802102200b2d0979c76e12bb480da635f192cc8dc6f905380dd4ac1ff35a4f68f462fffd032103579ca2e6d107522f012cd00b52b9a65fb46f0c57b9b8b6e377c48f526a44741affffffff3f1f097333e4d46d51f5e77b53264db8f7f5d2e18217e1099957d0f5af7713ee010000006c493046022100b663499ef73273a3788dea342717c2640ac43c5a1cf862c9e09b206fcb3f6bb8022100b09972e75972d9148f2bdd462e5cb69b57c1214b88fc55ca638676c07cfc10d8032103579ca2e6d107522f012cd00b52b9a65fb46f0c57b9b8b6e377c48f526a44741affffffff0380841e00000000001976a914bfb282c70c4191f45b5a6665cad1682f2c9cfdfb88ac80841e00000000001976a9149857cc07bed33a5cf12b9c5e0500b675d500c81188ace0fd1c00000000001976a91443c52850606c872403c0601e69fa34b26f62db4a88ac00000000"-      )-    ]--runPKHashVec :: ([(Text, Word32)], [(Text, Word64)], Text) -> Assertion-runPKHashVec (xs, ys, res) =-    assertBool "Build PKHash Tx" $ encodeHex (S.encode tx) == res-  where-    tx =-        fromRight (error "Could not decode transaction") $-        buildAddrTx btc (map f xs) ys-    f (tid, ix) = OutPoint (fromJust $ hexToTxHash tid) ix---- These test vectors have been generated from bitcoind raw transaction api--pkHashVec :: [([(Text, Word32)], [(Text, Word64)], Text)]-pkHashVec =-    [-      ( [("eb29eba154166f6541ebcc9cbdf5088756e026af051f123bcfb526df594549db",14)]-      , [("14LsRquZfURNFrzpcLVGdaHTfAPjjwiSPb",90000000)]-      , "0100000001db494559df26b5cf3b121f05af26e0568708f5bd9ccceb41656f1654a1eb29eb0e00000000ffffffff01804a5d05000000001976a91424aa604689cc582292b97668bedd91dd5bf9374c88ac00000000"-      )-    , ( [ ("eb29eba154166f6541ebcc9cbdf5088756e026af051f123bcfb526df594549db",0)-        , ("0001000000000000000000000000000000000000000000000000000000000000",2147483647)-        ]-      , [ ("14LsRquZfURNFrzpcLVGdaHTfAPjjwiSPb",1)-        , ("19VCgS642vzEA1sdByoSn6GsWBwraV8D4n",2100000000000000)-        ]-      , "0100000002db494559df26b5cf3b121f05af26e0568708f5bd9ccceb41656f1654a1eb29eb0000000000ffffffff0000000000000000000000000000000000000000000000000000000000000100ffffff7f00ffffffff0201000000000000001976a91424aa604689cc582292b97668bedd91dd5bf9374c88ac0040075af07507001976a9145d16672f53981ff21c5f42b40d1954993cbca54f88ac00000000"-      )-    , ( [ ("eb29eba154166f6541ebcc9cbdf5088756e026af051f123bcfb526df594549db",0)-        , ("0001000000000000000000000000000000000000000000000000000000000000",2147483647)-        ]-      , []-      , "0100000002db494559df26b5cf3b121f05af26e0568708f5bd9ccceb41656f1654a1eb29eb0000000000ffffffff0000000000000000000000000000000000000000000000000000000000000100ffffff7f00ffffffff0000000000"-      )-    , ( []-      , [ ("14LsRquZfURNFrzpcLVGdaHTfAPjjwiSPb",1)-        , ("19VCgS642vzEA1sdByoSn6GsWBwraV8D4n",2100000000000000)-        ]-      , "01000000000201000000000000001976a91424aa604689cc582292b97668bedd91dd5bf9374c88ac0040075af07507001976a9145d16672f53981ff21c5f42b40d1954993cbca54f88ac00000000"-      )-    ]--tEncodeSatoshiCoreScriptPubKey :: Assertion-tEncodeSatoshiCoreScriptPubKey = assertBool "tEncodeSatoshiCoreScriptPubKey" $-  t1BsOutputScriptPubKey == encodeSatoshiCoreScriptPubKey t1SatoshiCoreJsonScriptPubKey-  where-    t1BsOutputScriptPubKey :: Text-    t1BsOutputScriptPubKey = "514104cc71eb30d653c0c3163990c47b976f3fb3f37cccdcbedb169a1dfef58bbfbfaff7d8a473e7e2e6d317b87bafe8bde97e3cf8f065dec022b51d11fcdd0d348ac4410461cbdcc5409fb4b4d42b51d33381354d80e550078cb532a34bfa2fcfdeb7d76519aecc62770f5b0e4ef8551946d8a540911abe3e7854a26f39f58b25c15342af52ae"-    t1SatoshiCoreJsonScriptPubKey :: String-    t1SatoshiCoreJsonScriptPubKey = "1 0x41 0x04cc71eb30d653c0c3163990c47b976f3fb3f37cccdcbedb169a1dfef58bbfbfaff7d8a473e7e2e6d317b87bafe8bde97e3cf8f065dec022b51d11fcdd0d348ac4 0x41 0x0461cbdcc5409fb4b4d42b51d33381354d80e550078cb532a34bfa2fcfdeb7d76519aecc62770f5b0e4ef8551946d8a540911abe3e7854a26f39f58b25c15342af 2 OP_CHECKMULTISIG"--encodeSatoshiCoreScriptPubKey :: String -> Text-encodeSatoshiCoreScriptPubKey =-  mconcat . map encodeSatoshiCoreScriptPiece . words-  where-    encodeSatoshiCoreScriptPiece :: String -> Text-    encodeSatoshiCoreScriptPiece s = case (readMay ("OP_" ++ s) :: Maybe ScriptOp) of-      Just op -> encodeHex . S.encode $ op-      Nothing -> case take 2 s of-          "OP" -> encodeHex . S.encode . (read :: String -> ScriptOp) $ s-          "0x" -> (fromString . drop 2 :: String -> Text) s-          _ -> case (readMay s :: Maybe Int) of -- can we get rid of this case now?-            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-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 [] [(fromJust (addrToString net a), v)]-    out =-        decodeOutputBS $-        scriptOutput $-        head $ txOut (fromRight (error "Could not build transaction") tx)--testGuessSize :: Network -> Tx -> Bool-testGuessSize net tx-    -- We compute an upper bound but it should be close enough to the real size-    -- We give 2 bytes of slack on every signature (1 on r and 1 on s)- = guess >= len && guess <= len + 2 * delta-  where-    delta = pki + sum (map fst msi)-    guess = guessTxSize pki msi pkout msout-    len = B.length $ S.encode tx-    ins = map f $ txIn tx-    f i =-        fromRight (error "Could not decode input") $-        decodeInputBS net $ scriptInput i-    pki = length $ filter isSpendPKHash ins-    msi = concatMap shData ins-    shData (ScriptHashInput _ (PayMulSig keys r)) = [(r, length keys)]-    shData _                                      = []-    out =-        map-            (fromRight (error "Could not decode transaction output") .-             decodeOutputBS . scriptOutput) $-        txOut tx-    pkout = length $ filter isPayPKHash out-    msout = length $ filter isPayScriptHash out--testChooseCoins :: [TestCoin] -> Word64 -> Word64 -> Int -> Property-testChooseCoins coins target byteFee nOut = nOut >= 0 ==>-    case chooseCoins target byteFee nOut True coins of-        Right (chosen, change) ->-            let outSum = sum $ map coinValue chosen-                fee    = guessTxFee byteFee nOut (length chosen)-            in outSum == target + change + fee-        Left _ ->-            let fee = guessTxFee byteFee nOut (length coins)-            in target == 0 || s < target + fee-  where-    s  = sum $ map coinValue coins--testChooseMSCoins :: (Int, Int) -> [TestCoin]-                  -> Word64 -> Word64 -> Int -> Property-testChooseMSCoins (m, n) coins target byteFee nOut = nOut >= 0 ==>-    case chooseMSCoins target byteFee (m,n) nOut True coins of-        Right (chosen,change) ->-            let outSum = sum $ map coinValue chosen-                fee    = guessMSTxFee byteFee (m,n) nOut (length chosen)-            in outSum == target + change + fee-        Left _ ->-            let fee = guessMSTxFee byteFee (m,n) nOut (length coins)-            in target == 0 || s < target + fee-  where-    s = sum $ map coinValue coins--{- Signing Transactions -}--testDetSignTx :: Network -> (Tx, [SigInput], [SecKeyI]) -> Bool-testDetSignTx 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") $-        signTx net tx sigis (map secKeyData (tail prv))-    txSigC =-        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-    [ isRight mergeRes-    , length (txIn mergedTx) == length os-    , if enoughSigs then isValid else not isValid-    -- Signature count == min (length txs) (sum required signatures)-    , sum (map snd sigMap) == min (length txs) (sum (map fst sigMap))-    ]-  where-    outs = map (\(so, val, op, _, _) -> (so, val, op)) os-    mergeRes = mergeTxs net txs outs-    mergedTx = fromRight (error "Could not merge") mergeRes-    isValid = verifyStdTx net mergedTx outs-    enoughSigs = all (\(m,c) -> c >= m) sigMap-    sigMap = map (\((_,_,_,m,_), inp) -> (m, sigCnt inp)) $ zip os $ txIn mergedTx-    sigCnt inp = case decodeInputBS net $ scriptInput inp of-        Right (RegularInput (SpendMulSig sigs)) -> length sigs-        Right (ScriptHashInput (SpendMulSig sigs) _) -> length sigs-        _ -> error "Invalid input script type"--testID :: (FromJSON a, ToJSON a, Eq a) => a -> Bool-testID x =-    (A.decode . A.encode) (singleton ("object" :: String) x) ==-    Just (singleton ("object" :: String) x)
− test/Network/Haskoin/UtilSpec.hs 
@@ -1,64 +0,0 @@-module Network.Haskoin.UtilSpec (spec) where--import qualified Data.ByteString      as BS-import           Data.Either          (fromLeft, fromRight, isLeft, isRight)-import           Data.Foldable        (toList)-import           Data.List            (permutations)-import           Data.Maybe-import qualified Data.Sequence        as Seq-import           Network.Haskoin.Test-import           Network.Haskoin.Util-import           Test.Hspec-import           Test.QuickCheck--spec :: Spec-spec =-    describe "utility functions" $ do-        it "bsToInteger . integerToBS" $ property getPutInteger-        it "decodeHex . encodeHex" $ property $ forAll arbitraryBS fromToHex-        it "compare updateIndex with Data.Sequence" $ property testUpdateIndex-        it "matchTemplate" $ property testMatchTemplate-        it "testing matchTemplate with two lists" $-            property testMatchTemplateLen-        it "either helper functions" $ property testEither--{- Various utilities -}--getPutInteger :: Integer -> Bool-getPutInteger i = bsToInteger (integerToBS $ abs i) == abs i--fromToHex :: BS.ByteString -> Bool-fromToHex bs = decodeHex (encodeHex bs) == Just bs--testUpdateIndex :: [Int] -> Int -> Int -> Bool-testUpdateIndex xs v i =-    updateIndex i xs (const v) == toList (Seq.update i v $ Seq.fromList xs)--testMatchTemplate :: [Int] -> Int -> Bool-testMatchTemplate as i = catMaybes res == bs-  where-    res = matchTemplate as bs (==)-    idx =-        if null as-            then 0-            else i `mod` length as-    bs = permutations as !! idx--testMatchTemplateLen :: [Int] -> [Int] -> Bool-testMatchTemplateLen as bs = length bs == length res-  where-    res = matchTemplate as bs (==)--testEither :: Either String Int -> Bool-testEither e =-    case e of-        (Right v) ->-            isRight e &&-            not (isLeft e) &&-            fromRight (error "Unexpected Left") e == v &&-            eitherToMaybe e == Just v-        (Left v) ->-            isLeft e &&-            not (isRight e) &&-            fromLeft (error "Unexpected Right") e == v &&-            isNothing (eitherToMaybe e)