haskoin-wallet (empty) → 0.0.1
raw patch · 21 files changed
+6677/−0 lines, 21 filesdep +HUnitdep +QuickCheckdep +aesonsetup-changed
Dependencies added: HUnit, QuickCheck, aeson, aeson-pretty, base, binary, bytestring, conduit, containers, directory, either, haskoin-crypto, haskoin-protocol, haskoin-script, haskoin-util, mtl, persistent, persistent-sqlite, persistent-template, test-framework, test-framework-hunit, test-framework-quickcheck2, text, time, unordered-containers, vector, yaml
Files
- Network/Haskoin/Wallet.hs +128/−0
- Network/Haskoin/Wallet/Arbitrary.hs +136/−0
- Network/Haskoin/Wallet/Keys.hs +322/−0
- Network/Haskoin/Wallet/Manager.hs +292/−0
- Network/Haskoin/Wallet/Store.hs +534/−0
- Network/Haskoin/Wallet/Store/CoinStatus.hs +51/−0
- Network/Haskoin/Wallet/Store/DbAccount.hs +153/−0
- Network/Haskoin/Wallet/Store/DbAddress.hs +199/−0
- Network/Haskoin/Wallet/Store/DbCoin.hs +91/−0
- Network/Haskoin/Wallet/Store/DbTx.hs +441/−0
- Network/Haskoin/Wallet/Store/Util.hs +337/−0
- Network/Haskoin/Wallet/TxBuilder.hs +357/−0
- Setup.hs +2/−0
- UNLICENSE +24/−0
- haskoin-wallet.cabal +126/−0
- script/hw.hs +269/−0
- tests/Main.hs +15/−0
- tests/Network/Haskoin/Wallet/Store/Units.hs +2548/−0
- tests/Network/Haskoin/Wallet/Tests.hs +156/−0
- tests/QuickCheckUtils.hs +44/−0
- tests/Units.hs +452/−0
+ Network/Haskoin/Wallet.hs view
@@ -0,0 +1,128 @@+{-|+ This package provides functions for generating hierarchical deterministic+ keys (BIP32). It also provides functions for building and signing both+ simple transactions and multisignature transactions. This package also+ provides a command line application called /hw/ (haskoin wallet). It is a+ lightweight bitcoin wallet featuring BIP32 key management, deterministic+ signatures (RFC-6979) and first order support for multisignature+ transactions. A library API for /hw/ is also exposed.+-}+module Network.Haskoin.Wallet+( + -- *Extended Keys+ ChainCode++ -- **Extended Private Keys+, XPrvKey(..)+, makeXPrvKey+, xPrvIsPrime+, xPrvChild+, xPrvID+, xPrvFP+, xPrvExport+, xPrvImport+, xPrvWIF++ -- **Extended Public Keys+, XPubKey(..)+, deriveXPubKey+, xPubIsPrime+, xPubChild+, xPubID+, xPubFP+, xPubAddr+, xPubExport+, xPubImport++ -- **Child key derivations+, prvSubKey+, pubSubKey+, primeSubKey+, prvSubKeys+, pubSubKeys+, primeSubKeys++ -- ***Multisig derivations+, mulSigSubKey+, mulSigSubKeys++ -- *Derivation tree interoperability++ -- | To improve BIP32 wallet interoperability, a standard derivation tree+ -- is used. All accounts are generated through prime derivations from the+ -- master key. This ensures that the master key is not compromised if+ -- an account is compromised. Every account will generate receiving+ -- addresses from the non-prime subtree index 0 and internal change+ -- addresses from the non-prime subtree index 1. MasterKey, AccountKey+ -- and AddressKey types are defined to conform to the wallet interoperability+ -- format.++, KeyIndex++ -- **Master keys+, MasterKey(..)+, makeMasterKey+, loadMasterKey++ -- **Account keys+, AccPrvKey(..)+, AccPubKey(..)+, loadPrvAcc+, loadPubAcc+, accPrvKey+, accPubKey+, accPrvKeys+, accPubKeys++ -- **Address keys+, AddrPrvKey(..)+, AddrPubKey(..)+, addr+, extPrvKey+, extPubKey+, intPrvKey+, intPubKey+, extPrvKeys+, extPubKeys+, intPrvKeys+, intPubKeys+, extAddr+, intAddr+, extAddrs+, intAddrs+, extAddrs'+, intAddrs'++ -- ***Multisig address keys+, extMulSigKey+, intMulSigKey+, extMulSigKeys+, intMulSigKeys+, extMulSigAddr+, intMulSigAddr+, extMulSigAddrs+, intMulSigAddrs++ -- *Build Transactions+, buildTx+, buildAddrTx++ -- *Transaction signing+, SigInput(..)+, signTx+, detSignTx+, isTxComplete++ -- *Coin selection+, Coin(..)+, chooseCoins+, chooseMSCoins+, guessTxSize++) where++import Network.Haskoin.Wallet.Keys+import Network.Haskoin.Wallet.Manager+import Network.Haskoin.Wallet.TxBuilder++
+ Network/Haskoin/Wallet/Arbitrary.hs view
@@ -0,0 +1,136 @@+{-|+ Arbitrary instances for wallet data types.+-}+module Network.Haskoin.Wallet.Arbitrary +( genPubKeyC+, genMulSigInput+, genRegularInput +, genAddrOutput+, RegularTx(..)+, MSParam(..)+) where++import Test.QuickCheck + ( Gen+ , Arbitrary+ , arbitrary+ , vectorOf+ , oneof+ , choose+ , elements+ )++import Control.Monad (liftM)+import Control.Applicative ((<$>),(<*>))++import Data.Maybe (fromJust)++import Network.Haskoin.Crypto.Arbitrary +import Network.Haskoin.Protocol.Arbitrary ()+import Network.Haskoin.Script.Arbitrary ()++import Network.Haskoin.Wallet+import Network.Haskoin.Script+import Network.Haskoin.Protocol+import Network.Haskoin.Crypto++-- | Data type for generating arbitrary valid multisignature parameters (m of n)+data MSParam = MSParam Int Int deriving (Eq, Show)++instance Arbitrary MSParam where+ arbitrary = do+ n <- choose (1,16)+ m <- choose (1,n)+ return $ MSParam m n++-- | Data type for generating arbitrary transaction with inputs and outputs+-- consisting only of script hash or pub key hash scripts.+data RegularTx = RegularTx Tx deriving (Eq, Show)++-- | Generate an arbitrary compressed public key.+genPubKeyC :: Gen PubKey+genPubKeyC = derivePubKey <$> genPrvKeyC++-- | Generate an arbitrary script hash input spending a multisignature+-- pay to script hash.+genMulSigInput :: Gen ScriptHashInput+genMulSigInput = do+ (MSParam m n) <- arbitrary+ rdm <- PayMulSig <$> (vectorOf n genPubKeyC) <*> (return m)+ inp <- SpendMulSig <$> (vectorOf m arbitrary) <*> (return m)+ return $ ScriptHashInput inp rdm++-- | Generate an arbitrary transaction input spending a public key hash or+-- script hash output.+genRegularInput :: Gen TxIn+genRegularInput = do+ op <- arbitrary+ sq <- arbitrary+ sc <- oneof [ encodeScriptHash <$> genMulSigInput+ , encodeInput <$> (SpendPKHash <$> arbitrary <*> genPubKeyC)+ ]+ return $ TxIn op sc sq++-- | Generate an arbitrary output paying to a public key hash or script hash+-- address.+genAddrOutput :: Gen TxOut+genAddrOutput = do+ v <- arbitrary+ sc <- oneof [ (PayPKHash . pubKeyAddr) <$> arbitrary+ , (PayScriptHash . scriptAddr) <$> arbitrary+ ]+ return $ TxOut v $ encodeOutput sc++instance Arbitrary RegularTx where+ arbitrary = do+ x <- choose (1,10)+ y <- choose (1,10)+ liftM RegularTx $ Tx <$> arbitrary + <*> (vectorOf x genRegularInput) + <*> (vectorOf y genAddrOutput) + <*> arbitrary++instance Arbitrary XPrvKey where+ arbitrary = XPrvKey <$> arbitrary+ <*> arbitrary+ <*> arbitrary+ <*> arbitrary+ <*> genPrvKeyC++instance Arbitrary XPubKey where+ arbitrary = deriveXPubKey <$> arbitrary++instance Arbitrary MasterKey where+ arbitrary = fromJust . makeMasterKey <$> arbitrary++instance Arbitrary AccPrvKey where+ arbitrary = do+ master <- arbitrary+ index <- choose (0,0x7fffffff)+ return $ fromJust $ accPrvKey master index++instance Arbitrary AccPubKey where+ arbitrary = do+ master <- arbitrary+ index <- choose (0,0x7fffffff)+ return $ fromJust $ accPubKey master index++instance Arbitrary AddrPrvKey where+ arbitrary = do+ accKey <- arbitrary+ index <- arbitrary+ elements [ fromJust $ extPrvKey accKey index+ , fromJust $ intPrvKey accKey index+ ]++instance Arbitrary AddrPubKey where+ arbitrary = do+ accKey <- arbitrary+ index <- arbitrary+ elements [ fromJust $ extPubKey accKey index+ , fromJust $ intPubKey accKey index+ ]++instance Arbitrary Coin where+ arbitrary = Coin <$> arbitrary <*> arbitrary <*> arbitrary+
+ Network/Haskoin/Wallet/Keys.hs view
@@ -0,0 +1,322 @@+module Network.Haskoin.Wallet.Keys+( XPubKey(..)+, XPrvKey(..)+, ChainCode+, makeXPrvKey+, deriveXPubKey+, prvSubKey+, pubSubKey+, primeSubKey+, prvSubKeys+, pubSubKeys+, primeSubKeys+, mulSigSubKey+, mulSigSubKeys+, xPrvIsPrime+, xPubIsPrime+, xPrvChild+, xPubChild+, xPubID+, xPrvID+, xPubFP+, xPrvFP+, xPubAddr+, xPubExport+, xPrvExport+, xPubImport+, xPrvImport+, xPrvWIF+, cycleIndex+, cycleIndex'+) where++import Control.Monad + ( guard+ , unless+ , when+ , liftM2+ )+import Data.Binary (Binary, get, put)+import Data.Binary.Get (Get, getWord8, getWord32be)+import Data.Binary.Put (Put, runPut, putWord8, putWord32be)+import Data.Word (Word8, Word32)+import Data.Bits + ( shiftR+ , setBit+ , testBit+ , clearBit+ )+import Data.Maybe (mapMaybe)+import qualified Data.ByteString as BS + ( ByteString+ , append+ )++import Network.Haskoin.Util+import Network.Haskoin.Util.Network+import Network.Haskoin.Crypto++{- See BIP32 for details: https://en.bitcoin.it/wiki/BIP_0032 -}++type ChainCode = Hash256++-- | 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 of key derivations.+ , xPrvParent :: !Word32 -- ^ Fingerprint of the parent key.+ , xPrvIndex :: !Word32 -- ^ Key derivation index.+ , xPrvChain :: !ChainCode -- ^ Chain code.+ , xPrvKey :: !PrvKey -- ^ The private key of this extended key node.+ } deriving (Eq, Show)++-- | Data type representing an extended BIP32 public key.+data XPubKey = XPubKey+ { xPubDepth :: !Word8 -- ^ Depth in the tree of key derivations.+ , xPubParent :: !Word32 -- ^ Fingerprint of the parent key.+ , xPubIndex :: !Word32 -- ^ Key derivation index.+ , xPubChain :: !ChainCode -- ^ Chain code.+ , xPubKey :: !PubKey -- ^ The public key of this extended key node.+ } deriving (Eq, Show)++-- | Build a BIP32 compatible extended private key from a bytestring. This will+-- produce a root node (depth=0 and parent=0).+makeXPrvKey :: BS.ByteString -> Maybe XPrvKey+makeXPrvKey bs = do+ pk' <- makePrvKey $ fromIntegral pk+ return $ XPrvKey 0 0 0 c pk'+ where (pk,c) = split512 $ hmac512 (stringToBS "Bitcoin seed") bs++-- | 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, non-prime child key derivation. A private non-prime+-- 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\/. +--+-- Non-prime 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+ -> Word32 -- ^ Child derivation index+ -> Maybe XPrvKey -- ^ Extended child private key +prvSubKey xkey child = guardIndex child >> do+ k <- addPrvKeys (xPrvKey xkey) a+ return $ XPrvKey (xPrvDepth xkey + 1) (xPrvFP xkey) child c k+ where pK = xPubKey $ deriveXPubKey xkey+ msg = BS.append (encode' pK) (encode' child)+ (a,c) = split512 $ hmac512 (encode' $ xPrvChain xkey) msg++-- | Compute a public, non-prime 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+ -> Word32 -- ^ Child derivation index+ -> Maybe XPubKey -- ^ Extended child public key+pubSubKey xKey child = guardIndex child >> do+ pK <- addPubKeys (xPubKey xKey) a+ return $ XPubKey (xPubDepth xKey + 1) (xPubFP xKey) child c pK+ where msg = BS.append (encode' $ xPubKey xKey) (encode' child)+ (a,c) = split512 $ hmac512 (encode' $ xPubChain xKey) msg++-- | Compute a prime child key derivation. Prime derivations can only be+-- computed for private keys. Prime 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'\/.+primeSubKey :: XPrvKey -- ^ Extended Parent private key+ -> Word32 -- ^ Child derivation index+ -> Maybe XPrvKey -- ^ Extended child private key+primeSubKey xkey child = guardIndex child >> do+ k <- addPrvKeys (xPrvKey xkey) a+ return $ XPrvKey (xPrvDepth xkey + 1) (xPrvFP xkey) i c k+ where i = setBit child 31+ msg = BS.append (bsPadPrvKey $ xPrvKey xkey) (encode' i)+ (a,c) = split512 $ hmac512 (encode' $ xPrvChain xkey) msg++-- | Cyclic list of all private non-prime child key derivations of a parent key+-- starting from an offset index.+prvSubKeys :: XPrvKey -> Word32 -> [(XPrvKey,Word32)]+prvSubKeys k i = mapMaybe f $ cycleIndex i+ where f j = liftM2 (,) (prvSubKey k j) (return j)++-- | Cyclic list of all public non-prime child key derivations of a parent key+-- starting from an offset index.+pubSubKeys :: XPubKey -> Word32 -> [(XPubKey,Word32)]+pubSubKeys k i = mapMaybe f $ cycleIndex i+ where f j = liftM2 (,) (pubSubKey k j) (return j)++-- | Cyclic list of all prime child key derivations of a parent key starting+-- from an offset index.+primeSubKeys :: XPrvKey -> Word32 -> [(XPrvKey,Word32)]+primeSubKeys k i = mapMaybe f $ cycleIndex i+ where f j = liftM2 (,) (primeSubKey k j) (return j)++-- | Compute a public, non-prime subkey derivation for all of the parent public+-- keys in the input. This function will succeed only if the child key+-- derivations for all the parent keys are valid. +--+-- This function is intended to be used in the context of multisignature+-- accounts. Parties exchanging their master public keys to create a+-- multisignature account can then individually generate all the receiving+-- multisignature addresses without further communication.+mulSigSubKey :: [XPubKey] -- ^ List of extended parent public keys+ -> Word32 -- ^ Child key derivation index+ -> Maybe [XPubKey] -- ^ List of extended child public keys+mulSigSubKey pubs i = mapM (flip pubSubKey i) pubs++-- | Cyclic list of all public, non-prime multisig key derivations of a list+-- of parent keys starting from an offset index.+mulSigSubKeys :: [XPubKey] -> Word32 -> [([XPubKey],Word32)]+mulSigSubKeys pubs i = mapMaybe f $ cycleIndex i+ where f j = liftM2 (,) (mulSigSubKey pubs j) (return j)++cycleIndex :: Word32 -> [Word32]+cycleIndex i+ | i == 0 = cycle [0..0x7fffffff]+ | i < 0x80000000 = cycle $ [i..0x7fffffff] ++ [0..(i-1)]+ | otherwise = error $ "cycleIndex: invalid index " ++ (show i)++-- Cycle in reverse+cycleIndex' :: Word32 -> [Word32]+cycleIndex' i+ | i == 0 = cycle $ 0 : [0x7fffffff,0x7ffffffe..1]+ | i == 0x7fffffff = cycle [0x7fffffff,0x7ffffffe..0]+ | i == 0x7ffffffe = cycle $ [0x7ffffffe,0x7ffffffd..0] ++ [0x7fffffff]+ | i < 0x80000000 = cycle $ [i,(i-1)..0] ++ [0x7fffffff,0x7ffffffe..(i+1)]+ | otherwise = error $ "cycleIndex: invalid index " ++ (show i)++guardIndex :: Word32 -> Maybe ()+guardIndex child = guard $ child >= 0 && child < 0x80000000++-- | Returns True if the extended private key was derived through a prime+-- derivation.+xPrvIsPrime :: XPrvKey -> Bool+xPrvIsPrime k = testBit (xPrvIndex k) 31++-- | Returns True if the extended public key was derived through a prime+-- derivation.+xPubIsPrime :: XPubKey -> Bool+xPubIsPrime k = testBit (xPubIndex k) 31++-- | Returns the derivation index of this extended private key without the+-- prime bit set.+xPrvChild :: XPrvKey -> Word32+xPrvChild k = clearBit (xPrvIndex k) 31++-- | Returns the derivation index of this extended public key without the prime+-- bit set.+xPubChild :: XPubKey -> Word32+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 = hash160 . hash256BS . encode' . xPubKey ++-- | Computes the key fingerprint of an extended private key.+xPrvFP :: XPrvKey -> Word32+xPrvFP = fromIntegral . (`shiftR` 128) . xPrvID++-- | Computes the key fingerprint of an extended public key.+xPubFP :: XPubKey -> Word32+xPubFP = fromIntegral . (`shiftR` 128) . xPubID++-- | Computer the 'Address' of an extended public key.+xPubAddr :: XPubKey -> Address+xPubAddr = pubKeyAddr . xPubKey++-- | Exports an extended private key to the BIP32 key export format (base 58).+xPrvExport :: XPrvKey -> String+xPrvExport = bsToString . encodeBase58Check . encode' ++-- | Exports an extended public key to the BIP32 key export format (base 58).+xPubExport :: XPubKey -> String+xPubExport = bsToString . encodeBase58Check . encode'++-- | Decodes a BIP32 encoded extended private key. This function will fail if+-- invalid base 58 characters are detected or if the checksum fails.+xPrvImport :: String -> Maybe XPrvKey+xPrvImport str = decodeToMaybe =<< (decodeBase58Check $ stringToBS str)++-- | Decodes a BIP32 encoded extended public key. This function will fail if+-- invalid base 58 characters are detected or if the checksum fails.+xPubImport :: String -> Maybe XPubKey+xPubImport str = decodeToMaybe =<< (decodeBase58Check $ stringToBS str)++-- | Export an extended private key to WIF (Wallet Import Format).+xPrvWIF :: XPrvKey -> String+xPrvWIF = toWIF . xPrvKey++instance Binary XPrvKey where++ get = do+ ver <- getWord32be+ unless (ver == extSecretPrefix) $ fail $+ "Get: Invalid version for extended private key"+ dep <- getWord8+ par <- getWord32be+ idx <- getWord32be+ chn <- get + prv <- getPadPrvKey+ return $ XPrvKey dep par idx chn prv++ put k = do+ putWord32be extSecretPrefix+ putWord8 $ xPrvDepth k+ putWord32be $ xPrvParent k+ putWord32be $ xPrvIndex k+ put $ xPrvChain k+ putPadPrvKey $ xPrvKey k++instance Binary XPubKey where++ get = do+ ver <- getWord32be+ unless (ver == extPubKeyPrefix) $ fail $+ "Get: Invalid version for extended public key"+ dep <- getWord8+ par <- getWord32be+ idx <- getWord32be+ chn <- get + pub <- get + when (isPubKeyU pub) $ fail $+ "Invalid public key. Only compressed format is supported"+ return $ XPubKey dep par idx chn pub++ put k = do+ putWord32be extPubKeyPrefix+ putWord8 $ xPubDepth k+ putWord32be $ xPubParent k+ putWord32be $ xPubIndex k+ put $ xPubChain k+ when (isPubKeyU (xPubKey k)) $ fail $+ "Only compressed public keys are supported"+ put $ xPubKey k+ +{- Utilities for extended keys -}++-- De-serialize HDW-specific private key+getPadPrvKey :: Get PrvKey+getPadPrvKey = do+ pad <- getWord8+ unless (pad == 0x00) $ fail $+ "Private key must be padded with 0x00"+ getPrvKey -- Compressed version++-- Serialize HDW-specific private key+putPadPrvKey :: PrvKey -> Put +putPadPrvKey p = putWord8 0x00 >> putPrvKey p++bsPadPrvKey :: PrvKey -> BS.ByteString+bsPadPrvKey = toStrictBS . runPut . putPadPrvKey +
+ Network/Haskoin/Wallet/Manager.hs view
@@ -0,0 +1,292 @@+module Network.Haskoin.Wallet.Manager+( MasterKey(..)+, AccPrvKey(..)+, AccPubKey(..)+, AddrPrvKey(..)+, AddrPubKey(..)+, KeyIndex+, makeMasterKey+, loadMasterKey+, loadPrvAcc+, loadPubAcc+, addr+, accPrvKey+, accPubKey+, extPrvKey+, extPubKey+, intPrvKey+, intPubKey+, accPrvKeys+, accPubKeys+, extPrvKeys+, extPubKeys+, intPrvKeys+, intPubKeys+, extAddr+, intAddr+, extAddrs+, intAddrs+, extAddrs'+, intAddrs'+, extMulSigKey+, intMulSigKey+, extMulSigKeys+, intMulSigKeys+, extMulSigAddr+, intMulSigAddr+, extMulSigAddrs+, intMulSigAddrs+) where++import Control.Monad (liftM2, guard)+import Control.Applicative ((<$>))++import Data.Word (Word32)+import Data.Maybe (mapMaybe, fromJust, isJust)+import qualified Data.ByteString as BS (ByteString)++import Network.Haskoin.Crypto+import Network.Haskoin.Script+import Network.Haskoin.Wallet.Keys++type KeyIndex = Word32++-- | Data type representing an extended private key at the root of the+-- derivation tree. Master keys have depth 0 and no parents. They are+-- represented as m\/ in BIP32 notation.+newtype MasterKey = MasterKey { masterKey :: XPrvKey }+ deriving (Eq, Show)++-- | Data type representing a private account key. Account keys are generated+-- from a 'MasterKey' through prime derivation. This guarantees that the+-- 'MasterKey' will not be compromised if the account key is compromised. +-- 'AccPrvKey' is represented as m\/i'\/ in BIP32 notation.+newtype AccPrvKey = AccPrvKey { getAccPrvKey :: XPrvKey }+ deriving (Eq, Show)++-- | Data type representing a public account key. It is computed through+-- derivation from an 'AccPrvKey'. It can not be derived from the 'MasterKey'+-- directly (property of prime derivation). It is represented as M\/i'\/ in+-- BIP32 notation. 'AccPubKey' is used for generating receiving payment+-- addresses without the knowledge of the 'AccPrvKey'.+newtype AccPubKey = AccPubKey { getAccPubKey :: XPubKey }+ deriving (Eq, Show)++-- | Data type representing a private address key. Private address keys are+-- generated through a non-prime derivation from an 'AccPrvKey'. Non-prime+-- derivation is used so that the public account key can generate the receiving+-- payment addresses without knowledge of the private account key. 'AccPrvKey'+-- is represented as m\/i'\/0\/j\/ in BIP32 notation if it is a regular+-- receiving address. Internal (change) addresses are represented as+-- m\/i'\/1\/j\/. Non-prime subtree 0 is used for regular receiving addresses+-- and non-prime subtree 1 for internal (change) addresses.+newtype AddrPrvKey = AddrPrvKey { getAddrPrvKey :: XPrvKey }+ deriving (Eq, Show)++-- | Data type representing a public address key. They are generated through+-- non-prime derivation from an 'AccPubKey'. This is a useful feature for+-- read-only wallets. They are represented as M\/i'\/0\/j in BIP32 notation+-- for regular receiving addresses and by M\/i'\/1\/j for internal (change)+-- addresses.+newtype AddrPubKey = AddrPubKey { getAddrPubKey :: XPubKey }+ deriving (Eq, Show)++-- | Create a 'MasterKey' from a seed.+makeMasterKey :: BS.ByteString -> Maybe MasterKey+makeMasterKey bs = MasterKey <$> makeXPrvKey bs++-- | Load a 'MasterKey' from an 'XPrvKey'. This function will fail if the+-- extended private key does not have the properties of a 'MasterKey'.+loadMasterKey :: XPrvKey -> Maybe MasterKey+loadMasterKey k+ | xPrvDepth k == 0 && + xPrvParent k == 0 && + xPrvIndex k == 0 = Just $ MasterKey k+ | otherwise = Nothing++-- | Load a private account key from an 'XPrvKey'. This function will fail if+-- the extended private key does not have the properties of a 'AccPrvKey'.+loadPrvAcc :: XPrvKey -> Maybe AccPrvKey+loadPrvAcc k+ | xPrvDepth k == 1 &&+ xPrvIsPrime k = Just $ AccPrvKey k+ | otherwise = Nothing++-- | Load a public account key from an 'XPubKey'. This function will fail if+-- the extended public key does not have the properties of a 'AccPubKey'.+loadPubAcc :: XPubKey -> Maybe AccPubKey+loadPubAcc k+ | xPubDepth k == 1 &&+ xPubIsPrime k = Just $ AccPubKey k+ | otherwise = Nothing++-- | Computes an 'AccPrvKey' from a 'MasterKey' and a derivation index.+accPrvKey :: MasterKey -> KeyIndex -> Maybe AccPrvKey+accPrvKey (MasterKey par) i = AccPrvKey <$> (f =<< primeSubKey par i)+ where f k = guard (isJust $ prvSubKey k 0) >>+ guard (isJust $ prvSubKey k 1) >>+ return k++-- | Computes an 'AccPubKey' from a 'MasterKey' and a derivation index.+accPubKey :: MasterKey -> KeyIndex -> Maybe AccPubKey+accPubKey (MasterKey par) i = f <$> primeSubKey par i+ where f = AccPubKey . deriveXPubKey++-- | Computes an external 'AddrPrvKey' from an 'AccPrvKey' and a derivation+-- index.+extPrvKey :: AccPrvKey -> KeyIndex -> Maybe AddrPrvKey+extPrvKey (AccPrvKey par) i = AddrPrvKey <$> prvSubKey extKey i+ where extKey = fromJust $ prvSubKey par 0++-- | Computes an external 'AddrPubKey' from an 'AccPubKey' and a derivation+-- index.+extPubKey :: AccPubKey -> KeyIndex -> Maybe AddrPubKey+extPubKey (AccPubKey par) i = AddrPubKey <$> pubSubKey extKey i+ where extKey = fromJust $ pubSubKey par 0++-- | Computes an internal 'AddrPrvKey' from an 'AccPrvKey' and a derivation+-- index.+intPrvKey :: AccPrvKey -> KeyIndex -> Maybe AddrPrvKey+intPrvKey (AccPrvKey par) i = AddrPrvKey <$> prvSubKey intKey i+ where intKey = fromJust $ prvSubKey par 1++-- | Computes an internal 'AddrPubKey' from an 'AccPubKey' and a derivation+-- index.+intPubKey :: AccPubKey -> KeyIndex -> Maybe AddrPubKey+intPubKey (AccPubKey par) i = AddrPubKey <$> pubSubKey intKey i+ where intKey = fromJust $ pubSubKey par 1++-- | Cyclic list of all valid 'AccPrvKey' derived from a 'MasterKey' and+-- starting from an offset index.+accPrvKeys :: MasterKey -> KeyIndex -> [(AccPrvKey,KeyIndex)]+accPrvKeys m i = mapMaybe f $ cycleIndex i+ where f j = liftM2 (,) (accPrvKey m j) (return j)++-- | Cyclic list of all valid 'AccPubKey' derived from a 'MasterKey' and+-- starting from an offset index.+accPubKeys :: MasterKey -> KeyIndex -> [(AccPubKey,KeyIndex)]+accPubKeys m i = mapMaybe f $ cycleIndex i+ where f j = liftM2 (,) (accPubKey m j) (return j)++-- | Cyclic list of all valid external 'AddrPrvKey' derived from a 'AccPrvKey'+-- and starting from an offset index.+extPrvKeys :: AccPrvKey -> KeyIndex -> [(AddrPrvKey,KeyIndex)]+extPrvKeys a i = mapMaybe f $ cycleIndex i+ where f j = liftM2 (,) (extPrvKey a j) (return j)++-- | Cyclic list of all valid external 'AddrPubKey' derived from a 'AccPubKey'+-- and starting from an offset index.+extPubKeys :: AccPubKey -> KeyIndex -> [(AddrPubKey,KeyIndex)]+extPubKeys a i = mapMaybe f $ cycleIndex i+ where f j = liftM2 (,) (extPubKey a j) (return j)++-- | Cyclic list of all internal 'AddrPrvKey' derived from a 'AccPrvKey' and+-- starting from an offset index.+intPrvKeys :: AccPrvKey -> KeyIndex -> [(AddrPrvKey,KeyIndex)]+intPrvKeys a i = mapMaybe f $ cycleIndex i+ where f j = liftM2 (,) (intPrvKey a j) (return j)++-- | Cyclic list of all internal 'AddrPubKey' derived from a 'AccPubKey' and+-- starting from an offset index.+intPubKeys :: AccPubKey -> KeyIndex -> [(AddrPubKey,KeyIndex)]+intPubKeys a i = mapMaybe f $ cycleIndex i+ where f j = liftM2 (,) (intPubKey a j) (return j)++{- Generate addresses -}++-- | Computes an 'Address' from an 'AddrPubKey'.+addr :: AddrPubKey -> Address+addr = xPubAddr . getAddrPubKey++-- | Computes an external base58 address from an 'AccPubKey' and a +-- derivation index.+extAddr :: AccPubKey -> KeyIndex -> Maybe String+extAddr a i = addrToBase58 . addr <$> extPubKey a i++-- | Computes an internal base58 addres from an 'AccPubKey' and a +-- derivation index.+intAddr :: AccPubKey -> KeyIndex -> Maybe String+intAddr a i = addrToBase58 . addr <$> intPubKey a i++-- | Cyclic list of all external base58 addresses derived from a 'AccPubKey'+-- and starting from an offset index.+extAddrs :: AccPubKey -> KeyIndex -> [(String,KeyIndex)]+extAddrs a i = mapMaybe f $ cycleIndex i+ where f j = liftM2 (,) (extAddr a j) (return j)++-- | Cyclic list of all internal base58 addresses derived from a 'AccPubKey'+-- and starting from an offset index.+intAddrs :: AccPubKey -> KeyIndex -> [(String,KeyIndex)]+intAddrs a i = mapMaybe f $ cycleIndex i+ where f j = liftM2 (,) (intAddr a j) (return j)++-- | Same as 'extAddrs' with the list reversed.+extAddrs' :: AccPubKey -> KeyIndex -> [(String,KeyIndex)]+extAddrs' a i = mapMaybe f $ cycleIndex' i+ where f j = liftM2 (,) (extAddr a j) (return j)++-- | Same as 'intAddrs' with the list reversed.+intAddrs' :: AccPubKey -> KeyIndex -> [(String,KeyIndex)]+intAddrs' a i = mapMaybe f $ cycleIndex' i+ where f j = liftM2 (,) (intAddr a j) (return j)++{- MultiSig -}++-- | Computes a list of external 'AddrPubKey' from an 'AccPubKey', a list+-- of thirdparty multisig keys and a derivation index. This is useful for +-- computing the public keys associated with a derivation index for+-- multisig accounts.+extMulSigKey :: AccPubKey -> [XPubKey] -> KeyIndex -> Maybe [AddrPubKey]+extMulSigKey a ps i = (map AddrPubKey) <$> mulSigSubKey keys i+ where keys = map (fromJust . (flip pubSubKey 0)) $ (getAccPubKey a) : ps++-- | Computes a list of internal 'AddrPubKey' from an 'AccPubKey', a list+-- of thirdparty multisig keys and a derivation index. This is useful for +-- computing the public keys associated with a derivation index for+-- multisig accounts.+intMulSigKey :: AccPubKey -> [XPubKey] -> KeyIndex -> Maybe [AddrPubKey]+intMulSigKey a ps i = (map AddrPubKey) <$> mulSigSubKey keys i+ where keys = map (fromJust . (flip pubSubKey 1)) $ (getAccPubKey a) : ps++-- | Cyclic list of all external multisignature 'AddrPubKey' derivations +-- starting from an offset index.+extMulSigKeys :: AccPubKey -> [XPubKey] -> KeyIndex -> [([AddrPubKey],KeyIndex)]+extMulSigKeys a ps i = mapMaybe f $ cycleIndex i+ where f j = liftM2 (,) (extMulSigKey a ps j) (return j)++-- | Cyclic list of all internal multisignature 'AddrPubKey' derivations+-- starting from an offset index.+intMulSigKeys :: AccPubKey -> [XPubKey] -> KeyIndex -> [([AddrPubKey],KeyIndex)]+intMulSigKeys a ps i = mapMaybe f $ cycleIndex i+ where f j = liftM2 (,) (intMulSigKey a ps j) (return j)++-- | Computes an external base58 multisig address from an 'AccPubKey', a+-- list of thirdparty multisig keys and a derivation index.+extMulSigAddr :: AccPubKey -> [XPubKey] -> Int -> KeyIndex -> Maybe String+extMulSigAddr a ps r i = do+ xs <- (map (xPubKey . getAddrPubKey)) <$> extMulSigKey a ps i+ return $ addrToBase58 $ scriptAddr $ sortMulSig $ PayMulSig xs r++-- | Computes an internal base58 multisig address from an 'AccPubKey', a+-- list of thirdparty multisig keys and a derivation index.+intMulSigAddr :: AccPubKey -> [XPubKey] -> Int -> KeyIndex -> Maybe String+intMulSigAddr a ps r i = do+ xs <- (map (xPubKey . getAddrPubKey)) <$> intMulSigKey a ps i+ return $ addrToBase58 $ scriptAddr $ sortMulSig $ PayMulSig xs r++-- | Cyclic list of all external base58 multisig addresses derived from+-- an 'AccPubKey' and a list of thirdparty multisig keys. The list starts+-- at an offset index.+extMulSigAddrs :: AccPubKey -> [XPubKey] -> Int -> KeyIndex + -> [(String,KeyIndex)]+extMulSigAddrs a ps r i = mapMaybe f $ cycleIndex i+ where f j = liftM2 (,) (extMulSigAddr a ps r j) (return j)++-- | Cyclic list of all internal base58 multisig addresses derived from+-- an 'AccPubKey' and a list of thirdparty multisig keys. The list starts+-- at an offset index.+intMulSigAddrs :: AccPubKey -> [XPubKey] -> Int -> KeyIndex + -> [(String,KeyIndex)]+intMulSigAddrs a ps r i = mapMaybe f $ cycleIndex i+ where f j = liftM2 (,) (intMulSigAddr a ps r j) (return j)+
+ Network/Haskoin/Wallet/Store.hs view
@@ -0,0 +1,534 @@+{-# LANGUAGE GADTs #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE OverloadedStrings #-}+{-|+ This module provides an API to the Haskoin wallet. All commands return a+ 'Value' result which can be encoded to JSON or YAML. The wallet commands+ run within the Persistent framework for database support:++ <http://hackage.haskell.org/package/persistent>+-}+module Network.Haskoin.Wallet.Store+( + cmdInit++-- *Account Commands+, cmdNewAcc+, cmdNewMS+, cmdAddKeys+, cmdAccInfo+, cmdListAcc+, cmdDumpKeys++-- *Address Commands+, cmdList+, cmdGenAddrs+, cmdGenWithLabel+, cmdLabel+, cmdWIF++-- *Coin Commands+, cmdBalance+, cmdBalances+, cmdCoins+, cmdAllCoins++-- *Tx Commands+, cmdImportTx +, cmdRemoveTx+, cmdListTx+, cmdSend+, cmdSendMany+, cmdSignTx++-- *Utility Commands+, cmdDecodeTx+, cmdBuildRawTx+, cmdSignRawTx++) where++import Control.Applicative ((<$>))+import Control.Monad (when)+import Control.Monad.Trans (liftIO)+import Control.Monad.Trans.Either (EitherT, left)++import Data.Time (getCurrentTime)+import Data.Yaml + ( Value (Null)+ , object + , (.=)+ , toJSON+ )+import Data.Maybe (isJust, fromJust)+import Data.List (sortBy)+import qualified Data.Aeson as Json (decode)+import qualified Data.Text as T (pack)++import Database.Persist+ ( PersistStore+ , PersistUnique+ , PersistQuery+ , PersistMonadBackend+ , Entity(..)+ , entityVal+ , entityKey+ , get+ , getBy+ , selectList+ , insert_+ , replace+ , count+ , (<=.), (==.)+ , SelectOpt( Asc, OffsetBy, LimitTo )+ )+import Database.Persist.Sqlite (SqlBackend)++import Network.Haskoin.Wallet.Keys+import Network.Haskoin.Wallet.Manager+import Network.Haskoin.Wallet.TxBuilder+import Network.Haskoin.Wallet.Store.DbAccount+import Network.Haskoin.Wallet.Store.DbAddress+import Network.Haskoin.Wallet.Store.DbCoin+import Network.Haskoin.Wallet.Store.DbTx+import Network.Haskoin.Wallet.Store.Util+import Network.Haskoin.Script+import Network.Haskoin.Protocol+import Network.Haskoin.Crypto+import Network.Haskoin.Util+import Network.Haskoin.Util.BuildMonad++-- | Initialize a wallet from a secret seed. This function will fail if the+-- wallet is already initialized.+cmdInit :: PersistUnique m+ => String -- ^ Secret seed.+ -> EitherT String m Value -- ^ Returns Null.+cmdInit seed + | null seed = left "cmdInit: seed can not be empty"+ | otherwise = do+ time <- liftIO getCurrentTime+ master <- liftMaybe err $ makeMasterKey $ stringToBS seed+ let str = xPrvExport $ masterKey master+ prev <- getBy $ UniqueWalletName "main"+ when (isJust prev) $ left+ "cmdInit: Wallet is already initialized"+ insert_ $ DbWallet "main" "full" str (-1) time+ return Null+ where + err = "cmdInit: Invalid master key generated from seed"++{- Account Commands -}++-- | Create a new account from an account name. Accounts are identified by+-- their name and they must be unique.+cmdNewAcc :: (PersistUnique m, PersistQuery m) + => String -- ^ Account name.+ -> EitherT String m Value -- ^ Returns the new account information.+cmdNewAcc name = do+ acc <- dbNewAcc name+ -- Generate gap addresses+ dbSetGap name 30 False+ dbSetGap name 30 True+ return $ yamlAcc acc++-- | Create a new multisignature account. The thirdparty keys can be provided+-- now or later using the 'cmdAddKeys' command. The number of thirdparty keys+-- can not exceed n-1 as your own account key will be used as well in the+-- multisignature scheme. If less than n-1 keys are provided, the account will+-- be in a pending state and no addresses can be generated.+--+-- In order to prevent usage mistakes, you can not create a multisignature +-- account with other keys from your own wallet.+cmdNewMS :: (PersistUnique m, PersistQuery m)+ => String -- ^ Account name.+ -> Int -- ^ Required number of keys (m in m of n).+ -> Int -- ^ Total number of keys (n in m of n).+ -> [XPubKey] -- ^ Thirdparty public keys.+ -> EitherT String m Value -- ^ Returns the new account information.+cmdNewMS name m n mskeys = do+ acc <- dbNewMS name m n mskeys+ when (length (dbAccountMsKeys acc) == n - 1) $ do+ -- Generate gap addresses+ dbSetGap name 30 False+ dbSetGap name 30 True+ return $ yamlAcc acc++-- | Add new thirdparty keys to a multisignature account. This function can+-- fail if the multisignature account already has all required keys. In order+-- to prevent usage mistakes, adding a key from your own wallet will fail.+cmdAddKeys :: (PersistUnique m, PersistQuery m)+ => AccountName -- ^ Account name.+ -> [XPubKey] -- ^ Thirdparty public keys to add.+ -> EitherT String m Value -- ^ Returns the account information.+cmdAddKeys name keys = do+ acc <- dbAddKeys name keys+ let n = fromJust $ dbAccountMsTotal acc+ when (length (dbAccountMsKeys acc) == n - 1) $ do+ -- Generate gap addresses+ dbSetGap name 30 False+ dbSetGap name 30 True+ return $ yamlAcc acc++-- | Returns information on an account.+cmdAccInfo :: PersistUnique m + => AccountName -- ^ Account name.+ -> EitherT String m Value -- ^ Account information.+cmdAccInfo name = yamlAcc . entityVal <$> dbGetAcc name++-- | Returns a list of all accounts in the wallet.+cmdListAcc :: PersistQuery m + => EitherT String m Value -- ^ List of accounts+cmdListAcc = toJSON . (map (yamlAcc . entityVal)) <$> selectList [] []++-- | Returns information on extended public and private keys of an account.+-- For a multisignature account, thirdparty keys are also returned.+cmdDumpKeys :: PersistUnique m+ => AccountName -- ^ Account name.+ -> EitherT String m Value -- ^ Extended key information.+cmdDumpKeys name = do+ (Entity _ acc) <- dbGetAcc name+ w <- liftMaybe walErr =<< (get $ dbAccountWallet acc)+ let keyM = loadMasterKey =<< (xPrvImport $ dbWalletMaster w)+ master <- liftMaybe keyErr keyM+ prv <- liftMaybe prvErr $ + accPrvKey master (fromIntegral $ dbAccountIndex acc)+ let prvKey = getAccPrvKey prv+ pubKey = deriveXPubKey prvKey+ ms | isMSAcc acc = ["MSKeys" .= (toJSON $ dbAccountMsKeys acc)]+ | otherwise = []+ return $ object $+ [ "Account" .= yamlAcc acc+ , "PubKey" .= xPubExport pubKey + , "PrvKey" .= xPrvExport prvKey + ] ++ ms+ where keyErr = "cmdDumpKeys: Could not decode master key"+ prvErr = "cmdDumpKeys: Could not derive account private key"+ walErr = "cmdDumpKeys: Could not find account wallet"++{- Address Commands -}++-- | Returns a page of addresses for an account. Pages are numbered starting+-- from page 1. Requesting page 0 will return the last page. +cmdList :: (PersistUnique m, PersistQuery m) + => AccountName -- ^ Account name.+ -> Int -- ^ Requested page number.+ -> Int -- ^ Number of addresses per page.+ -> EitherT String m Value -- ^ The requested page.+cmdList name pageNum resPerPage + | pageNum < 0 = left $ + unwords ["cmdList: Invalid page number", show pageNum]+ | resPerPage < 1 = left $ + unwords ["cmdList: Invalid results per page",show resPerPage]+ | otherwise = do+ (Entity ai acc) <- dbGetAcc name+ addrCount <- count + [ DbAddressAccount ==. ai+ , DbAddressInternal ==. False+ , DbAddressIndex <=. dbAccountExtIndex acc+ ] + let maxPage = max 1 $ (addrCount + resPerPage - 1) `div` resPerPage+ page | pageNum == 0 = maxPage+ | otherwise = pageNum+ when (page > maxPage) $ left "cmdList: Page number too high"+ addrs <- selectList [ DbAddressAccount ==. ai+ , DbAddressInternal ==. False+ , DbAddressIndex <=. dbAccountExtIndex acc+ ] + [ Asc DbAddressId+ , LimitTo resPerPage+ , OffsetBy $ (page - 1) * resPerPage+ ]+ return $ yamlAddrList (map entityVal addrs) page resPerPage addrCount++-- | Generate new payment addresses for an account. +cmdGenAddrs :: (PersistUnique m, PersistQuery m)+ => AccountName -- ^ Account name.+ -> Int -- ^ Number of addresses to generate.+ -> EitherT String m Value -- ^ List of new addresses.+cmdGenAddrs name c = cmdGenWithLabel name (replicate c "")++-- | Generate new payment addresses with labels for an account.+cmdGenWithLabel :: (PersistUnique m, PersistQuery m)+ => AccountName -- ^ Account name.+ -> [String] -- ^ List of address labels. + -> EitherT String m Value -- ^ List of new addresses.+cmdGenWithLabel name labels = do+ addrs <- dbGenAddrs name labels False+ return $ toJSON $ map yamlAddr addrs++-- | Add a label to an address.+cmdLabel :: PersistUnique m+ => AccountName -- ^ Account name.+ -> Int -- ^ Derivation index of the address. + -> String -- ^ New label.+ -> EitherT String m Value -- ^ New address information.+cmdLabel name key label = do+ (Entity ai acc) <- dbGetAcc name+ (Entity i add) <- liftMaybe keyErr =<< + (getBy $ UniqueAddressKey ai key False)+ when (dbAddressIndex add > dbAccountExtIndex acc) $ left keyErr+ let newAddr = add{dbAddressLabel = label}+ replace i newAddr+ return $ yamlAddr newAddr+ where + keyErr = unwords ["cmdLabel: Key",show key,"does not exist"]++-- | Returns the private key tied to a payment address in WIF format.+cmdWIF :: PersistUnique m+ => AccountName -- ^ Account name.+ -> Int -- ^ Derivation index of the address. + -> EitherT String m Value -- ^ WIF value.+cmdWIF name key = do+ (Entity _ w) <- dbGetWallet "main"+ (Entity ai acc) <- dbGetAcc name+ (Entity _ add) <- liftMaybe keyErr =<< + (getBy $ UniqueAddressKey ai key False)+ when (dbAddressIndex add > dbAccountExtIndex acc) $ left keyErr+ mst <- liftMaybe mstErr $ loadMasterKey =<< xPrvImport (dbWalletMaster w)+ aKey <- liftMaybe prvErr $ accPrvKey mst $ fromIntegral $ dbAccountIndex acc+ let index = fromIntegral $ dbAddressIndex add+ addrPrvKey <- liftMaybe addErr $ extPrvKey aKey index+ let prvKey = xPrvKey $ getAddrPrvKey addrPrvKey+ return $ object [ "WIF" .= T.pack (toWIF prvKey) ]+ where + keyErr = unwords ["cmdWIF: Key",show key,"does not exist"]+ mstErr = "cmdWIF: Could not load master key"+ prvErr = "cmdWIF: Invalid account derivation index"+ addErr = "cmdWIF: Invalid address derivation index"++{- Coin Commands -}++-- | Returns the balance of an account.+cmdBalance :: (PersistUnique m, PersistQuery m)+ => AccountName -- ^ Account name.+ -> EitherT String m Value -- ^ Account balance.+cmdBalance name = do+ acc <- dbGetAcc name+ balance <- dbBalance acc+ return $ object [ "Balance" .= toJSON balance ]++-- | Returns a list of balances for every account in the wallet.+cmdBalances :: PersistQuery m+ => EitherT String m Value -- ^ All account balances+cmdBalances = do+ accs <- selectList [] []+ bals <- mapM dbBalance accs+ return $ toJSON $ map f $ zip accs bals+ where + f (acc,b) = object+ [ "Account" .= (dbAccountName $ entityVal acc)+ , "Balance" .= b+ ]++-- | Returns the list of unspent coins for an account.+cmdCoins :: ( PersistQuery m, PersistUnique m + , PersistMonadBackend m ~ SqlBackend+ )+ => AccountName -- ^ Account name.+ -> EitherT String m Value -- ^ List of unspent coins.+cmdCoins name = do+ (Entity ai _) <- dbGetAcc name+ coins <- dbCoins ai+ return $ toJSON $ map yamlCoin coins++-- | Returns a list of all the unspent coins for every account in the wallet.+cmdAllCoins :: ( PersistQuery m, PersistUnique m+ , PersistMonadBackend m ~ SqlBackend+ )+ => EitherT String m Value -- ^ Unspent coins for all accounts.+cmdAllCoins = do+ accs <- selectList [] []+ coins <- mapM (dbCoins . entityKey) accs+ return $ toJSON $ map g $ zip accs coins+ where + g (acc,cs) = object+ [ "Account" .= (dbAccountName $ entityVal acc)+ , "Coins" .= (toJSON $ map yamlCoin cs)+ ]++{- Tx Commands -}++-- | Import a transaction into the wallet. If called multiple times, this+-- command will only update the existing transaction in the wallet. A new+-- transaction entry will be created for every account affected by this+-- transaction. Every transaction entry will summarize the information related+-- to its account only (such as total movement for this account).+cmdImportTx :: ( PersistQuery m, PersistUnique m+ , PersistMonadBackend m ~ SqlBackend+ ) + => Tx -- ^ Transaction to import.+ -> EitherT String m Value -- ^ New transaction entries created.+cmdImportTx tx = do+ accTx <- dbImportTx tx+ return $ toJSON $ map yamlTx $ sortBy f accTx+ where+ f a b = (dbTxCreated a) `compare` (dbTxCreated b)+++-- | Remove a transaction from the database. This will remove all transaction+-- entries for this transaction as well as any child transactions and coins+-- deriving from it.+cmdRemoveTx :: PersistQuery m+ => String -- ^ Transaction id (txid)+ -> EitherT String m Value -- ^ List of removed transaction entries+cmdRemoveTx tid = do+ removed <- dbRemoveTx tid+ return $ toJSON removed++-- | List all the transaction entries for an account. Transaction entries+-- summarize information for a transaction in a specific account only (such as+-- the total movement of for this account).+--+-- Transaction entries can also be tagged as /Orphan/ or /Partial/. Orphaned+-- transactions are transactions with a parent transaction that should be in+-- the wallet but has not been imported yet. Balances for orphaned transactions+-- can not be accurately computed until the parent transaction is imported.+--+-- Partial transactions are transactions that are not fully signed yet, such+-- as a partially signed multisignature transaction. Partial transactions+-- are visible in the wallet mostly for informational purposes. They can not+-- generate any coins as the txid or partial transactions will change once+-- they are fully signed. However, importing a partial transaction will /lock/+-- the coins that it spends so that you don't mistakenly spend them. Partial+-- transactions are replaced once the fully signed transaction is imported.+cmdListTx :: (PersistQuery m, PersistUnique m)+ => AccountName -- ^ Account name.+ -> EitherT String m Value -- ^ List of transaction entries.+cmdListTx name = do+ (Entity ai _) <- dbGetAcc name+ txs <- selectList [ DbTxAccount ==. ai+ ] + [ Asc DbTxCreated ]+ return $ toJSON $ map (yamlTx . entityVal) txs++-- | Create a transaction sending some coins to a single recipient address.+cmdSend :: ( PersistQuery m, PersistUnique m+ , PersistMonadBackend m ~ SqlBackend+ )+ => AccountName -- ^ Account name.+ -> String -- ^ Recipient address. + -> Int -- ^ Amount to send. + -> Int -- ^ Fee per 1000 bytes. + -> EitherT String m Value -- ^ Payment transaction.+cmdSend name a v fee = do+ (tx,complete) <- dbSendTx name [(a,fromIntegral v)] (fromIntegral fee)+ return $ object [ "Tx" .= (toJSON $ bsToHex $ encode' tx)+ , "Complete" .= complete+ ]++-- | Create a transaction sending some coins to a list of recipient addresses.+cmdSendMany :: ( PersistQuery m, PersistUnique m+ , PersistMonadBackend m ~ SqlBackend+ )+ => AccountName -- ^ Account name.+ -> [(String,Int)] + -- ^ List of recipient addresses and amounts. + -> Int -- ^ Fee per 1000 bytes. + -> EitherT String m Value -- ^ Payment transaction.+cmdSendMany name dests fee = do+ (tx,complete) <- dbSendTx name dests' (fromIntegral fee)+ return $ object [ "Tx" .= (toJSON $ bsToHex $ encode' tx)+ , "Complete" .= complete+ ]+ where dests' = map (\(a,b) -> (a,fromIntegral b)) dests++-- | Try to sign the inputs of an existing transaction using the private keys+-- of an account. This command will return an indication if the transaction is+-- fully signed or if additional signatures are required. This command will+-- work for both normal inputs and multisignature inputs. Signing is limited to+-- the keys of one account only to allow for more control when the wallet is+-- used as the backend of a web service.+cmdSignTx :: PersistUnique m+ => AccountName -- ^ Account name.+ -> Tx -- ^ Transaction to sign. + -> SigHash -- ^ Signature type to create. + -> EitherT String m Value -- ^ Signed transaction.+cmdSignTx name tx sh = do+ (newTx,complete) <- dbSignTx name tx sh+ return $ object + [ (T.pack "Tx") .= (toJSON $ bsToHex $ encode' newTx)+ , (T.pack "Complete") .= complete+ ]++{- Utility Commands -}++-- | Decodes a transaction, providing structural information on the inputs+-- and the outputs of the transaction.+cmdDecodeTx :: Monad m + => String -- ^ HEX encoded transaction+ -> EitherT String m Value -- ^ Decoded transaction+cmdDecodeTx str = do+ tx <- liftMaybe txErr $ decodeToMaybe =<< (hexToBS str)+ return $ toJSON (tx :: Tx)+ where txErr = "cmdDecodeTx: Could not decode transaction"++-- | Build a raw transaction from a list of outpoints and recipients encoded+-- in JSON.+--+-- Outpoint format as JSON:+--+-- > [ +-- > { "txid": txid+-- > , "vout": n+-- > },...+-- > ] +--+-- Recipient list as JSON:+--+-- > { addr: amnt,... }+--+cmdBuildRawTx :: Monad m + => String -- ^ List of JSON encoded Outpoints.+ -> String -- ^ List of JSON encoded Recipients.+ -> EitherT String m Value -- ^ Transaction result.+cmdBuildRawTx i o = do+ (RawTxOutPoints ops) <- liftMaybe opErr $ + Json.decode $ toLazyBS $ stringToBS i+ (RawTxDests dests) <- liftMaybe dsErr $ + Json.decode $ toLazyBS $ stringToBS o+ tx <- liftEither $ buildAddrTx ops dests+ return $ object [ (T.pack "Tx") .= (bsToHex $ encode' tx) ]+ where+ opErr = "cmdBuildRawTx: Could not parse OutPoints"+ dsErr = "cmdBuildRawTx: Could not parse recipients"+++-- | Sign a raw transaction by providing the signing parameters and private+-- keys manually. None of the keys in the wallet will be used for signing.+--+-- Signing data as JSON (scriptRedeem is optional):+--+-- > [ +-- > { "txid": txid+-- > , "vout": n+-- > , "scriptPubKey": hex+-- > , "scriptRedeem": hex+-- > },...+-- > ]+--+-- Private keys in JSON foramt:+--+-- > [ WIF,... ]+cmdSignRawTx :: Monad m + => Tx -- ^ Transaction to sign.+ -> String + -- ^ List of JSON encoded signing parameters.+ -> String + -- ^ List of JSON encoded WIF private keys.+ -> SigHash -- ^ Signature type. + -> EitherT String m Value+cmdSignRawTx tx strSigi strKeys sh = do+ (RawSigInput fs) <- liftMaybe sigiErr $ + Json.decode $ toLazyBS $ stringToBS strSigi+ (RawPrvKey keys) <- liftMaybe keysErr $+ Json.decode $ toLazyBS $ stringToBS strKeys+ let sigTx = detSignTx tx (map (\f -> f sh) fs) keys+ bsTx <- liftEither $ buildToEither sigTx+ return $ object [ (T.pack "Tx") .= (toJSON $ bsToHex $ encode' bsTx)+ , (T.pack "Complete") .= isComplete sigTx+ ]+ where+ sigiErr = "cmdSignRawTx: Could not parse parent transaction data"+ keysErr = "cmdSignRawTx: Could not parse private keys (WIF)"++
+ Network/Haskoin/Wallet/Store/CoinStatus.hs view
@@ -0,0 +1,51 @@+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE OverloadedStrings #-}+module Network.Haskoin.Wallet.Store.CoinStatus+( CoinStatus(..)+, catStatus+) where++import Control.Monad (mzero)+import Control.Applicative ((<$>))++import Database.Persist.TH (derivePersistField)++import Data.Yaml+import qualified Data.Text as T (pack)++-- |Spent if a complete transaction spends this coin+-- Reserved if a partial transaction is spending these coins+-- Unspent if the coins are still available+-- The purpose of the Reserved status is to block this coin from being used in+-- subsequent coin selection algorithms. However, Reserved coins can always be+-- spent (set status to Spent) by complete transactions.+data CoinStatus = Spent String | Reserved String | Unspent+ deriving (Show, Read, Eq)+derivePersistField "CoinStatus"++instance ToJSON CoinStatus where+ toJSON (Spent tid) = + object [ "Status".= T.pack "Spent"+ , "Txid" .= T.pack tid + ]+ toJSON (Reserved tid) = + object [ "Status".= T.pack "Reserved"+ , "Txid" .= T.pack tid + ]+ toJSON Unspent = object [ "Status".= T.pack "Unspent" ]++instance FromJSON CoinStatus where+ parseJSON (Object obj) = obj .: "Status" >>= \status -> case status of+ (String "Spent") -> Spent <$> obj .: "Txid"+ (String "Reserved") -> Reserved <$> obj .: "Txid"+ (String "Unspent") -> return Unspent+ _ -> mzero+ parseJSON _ = mzero++catStatus :: [CoinStatus] -> [String]+catStatus = foldr f []+ where+ f (Spent str) acc = str:acc+ f (Reserved str) acc = str:acc+ f _ acc = acc+
+ Network/Haskoin/Wallet/Store/DbAccount.hs view
@@ -0,0 +1,153 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE TypeFamilies #-}+module Network.Haskoin.Wallet.Store.DbAccount +( dbGetAcc+, dbNewAcc+, dbNewMS+, dbAddKeys+, yamlAcc+, isMSAcc+) where++import Control.Monad (when, unless)+import Control.Monad.Trans (liftIO)+import Control.Monad.Trans.Either (EitherT, left)++import Data.Time (getCurrentTime)+import Data.Yaml (Value, object, (.=))+import Data.Maybe (fromJust, isJust)+import Data.List (nub)+import qualified Data.Text as T (pack)++import Database.Persist + ( PersistQuery+ , PersistUnique+ , PersistStore+ , PersistMonadBackend+ , Entity(..)+ , getBy+ , insert_+ , update+ , count+ , replace+ , (==.), (=.)+ )++import Network.Haskoin.Wallet.Keys+import Network.Haskoin.Wallet.Manager+import Network.Haskoin.Wallet.Store.Util++yamlAcc :: DbAccountGeneric b -> Value+yamlAcc acc = object $ concat+ [ [ "Name" .= dbAccountName acc+ , "Tree" .= dbAccountTree acc+ ]+ , datType, datWarn+ ]+ where msReq = fromJust $ dbAccountMsRequired acc+ msTot = fromJust $ dbAccountMsTotal acc+ ms = unwords [show msReq,"of",show msTot]+ miss = msTot - length (dbAccountMsKeys acc) - 1+ datType | isMSAcc acc = ["Type" .= unwords [ "Multisig", ms ]]+ | otherwise = ["Type" .= ("Regular" :: String)]+ datWarn | isMSAcc acc && miss > 0 =+ [ (T.pack "Warning") .= + unwords [show miss,"multisig keys missing"]+ ]+ | otherwise = []++isMSAcc :: DbAccountGeneric b -> Bool+isMSAcc acc = (isJust $ dbAccountMsRequired acc) && + (isJust $ dbAccountMsTotal acc) ++dbGetAcc :: (PersistUnique m, PersistMonadBackend m ~ b)+ => String + -> EitherT String m (Entity (DbAccountGeneric b))+dbGetAcc name = liftMaybe accErr =<< (getBy $ UniqueAccName name)+ where + accErr = unwords ["dbGetAcc: Invalid account", name]++dbNewAcc :: ( PersistUnique m+ , PersistQuery m+ , PersistMonadBackend m ~ b+ ) + => String -> EitherT String m (DbAccountGeneric b)+dbNewAcc name = do+ time <- liftIO getCurrentTime+ (Entity wk w) <- dbGetWallet "main"+ let keyM = loadMasterKey =<< (xPrvImport $ dbWalletMaster w)+ master <- liftMaybe keyErr keyM+ let deriv = fromIntegral $ dbWalletAccIndex w + 1+ (k,i) = head $ accPubKeys master deriv+ acc = DbAccount name + (fromIntegral i) + (concat ["m/",show i,"'/"])+ (xPubExport $ getAccPubKey k)+ (-1) (-1) (-1) (-1)+ Nothing Nothing [] wk time+ insert_ acc+ update wk [DbWalletAccIndex =. fromIntegral i]+ return acc+ where + keyErr = "dbNewAcc: Could not load master key"++dbNewMS :: ( PersistUnique m+ , PersistQuery m+ , PersistMonadBackend m ~ b+ )+ => String -> Int -> Int -> [XPubKey]+ -> EitherT String m (DbAccountGeneric b)+dbNewMS name m n mskeys = do+ time <- liftIO getCurrentTime+ let keys = nub mskeys+ unless (n >= 1 && n <= 16 && m >= 1 && m <= n) $ left+ "cmdNewMS: Invalid multisig parameters"+ unless (length keys < n) $ left + "cmdNewMS: Too many keys"+ (Entity wk w) <- dbGetWallet "main"+ let keyM = loadMasterKey =<< (xPrvImport $ dbWalletMaster w)+ master <- liftMaybe keyErr keyM+ let deriv = fromIntegral $ dbWalletAccIndex w + 1+ (k,i) = head $ accPubKeys master deriv+ acc = DbAccount name + (fromIntegral i) + (concat ["m/",show i,"'/"])+ (xPubExport $ getAccPubKey k)+ (-1) (-1) (-1) (-1) + (Just m) (Just n) + (map xPubExport keys)+ wk time+ insert_ acc+ update wk [DbWalletAccIndex =. fromIntegral i]+ return acc+ where + keyErr = "dbNewMS: Could not load master key"++dbAddKeys :: ( PersistUnique m+ , PersistQuery m+ , PersistMonadBackend m ~ b+ )+ => AccountName -> [XPubKey] + -> EitherT String m (DbAccountGeneric b)+dbAddKeys name keys + | null keys = left "dbAddKeys: Keys can not be empty"+ | otherwise = do+ (Entity ai acc) <- dbGetAcc name+ unless (isMSAcc acc) $ left $ + "dbAddKeys: Can only add keys to a multisig account"+ exists <- mapM (\x -> count [DbAccountKey ==. (xPubExport x)]) keys+ unless (sum exists == 0) $ left $+ "dbAddKeys: Can not add your own keys to a multisig account"+ prevKeys <- liftMaybe keyErr $ mapM xPubImport $ dbAccountMsKeys acc+ when (length prevKeys == (fromJust $ dbAccountMsTotal acc) - 1) $ left $+ "dbAddKeys: Account is complete. No more keys can be added"+ let newKeys = nub $ prevKeys ++ keys+ newAcc = acc{ dbAccountMsKeys = map xPubExport newKeys }+ unless (length newKeys < (fromJust $ dbAccountMsTotal acc)) $ left $+ "dbAddKeys: Too many keys"+ replace ai newAcc+ return newAcc+ where + keyErr = "dbAddKeys: Invalid keys found in account"+
+ Network/Haskoin/Wallet/Store/DbAddress.hs view
@@ -0,0 +1,199 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE TypeFamilies #-}+module Network.Haskoin.Wallet.Store.DbAddress +( dbGenIntAddrs+, dbGenAddrs+, dbAdjustGap+, dbSetGap+, dbGetAddr+, yamlAddr+, yamlAddrList+) where++import Control.Applicative ((<$>),(<*>))+import Control.Monad (when, forM)+import Control.Monad.Trans (liftIO)+import Control.Monad.Trans.Either (EitherT, left)++import Data.Time (getCurrentTime)+import Data.Yaml (Value, object, (.=), toJSON)++import Database.Persist+ ( PersistQuery+ , PersistUnique+ , PersistStore+ , PersistMonadBackend+ , Entity(..)+ , get+ , getBy+ , selectList+ , insertMany+ , count+ , replace+ , (==.), (>.), (<=.)+ , SelectOpt( Asc, Desc, LimitTo )+ )++import Network.Haskoin.Wallet.Keys+import Network.Haskoin.Wallet.Manager+import Network.Haskoin.Wallet.Store.DbAccount+import Network.Haskoin.Wallet.Store.Util++yamlAddr :: DbAddressGeneric b -> Value+yamlAddr a+ | null $ dbAddressLabel a = object base+ | otherwise = object $ label:base+ where + base = [ "Addr" .= dbAddressBase58 a+ , "Key" .= dbAddressIndex a+ , "Tree" .= dbAddressTree a+ ]+ label = "Label" .= dbAddressLabel a++yamlAddrList :: [DbAddressGeneric b] -> Int -> Int -> Int -> Value+yamlAddrList addrs pageNum resPerPage addrCount = object+ [ "Addresses" .= (toJSON $ map yamlAddr addrs)+ , "Page results" .= object+ [ "Current page" .= pageNum+ , "Results per page" .= resPerPage+ , "Total pages" .= totPages+ , "Total addresses" .= addrCount+ ]+ ]+ where totPages = max 1 $ (addrCount + resPerPage - 1) `div` resPerPage++dbGetAddr :: (PersistUnique m, PersistMonadBackend m ~ b)+ => String + -> EitherT String m (Entity (DbAddressGeneric b))+dbGetAddr addrStr = + liftMaybe addrErr =<< (getBy $ UniqueAddress addrStr)+ where + addrErr = unwords ["dbGetAddr: Invalid address", addrStr]++dbGenIntAddrs :: ( PersistUnique m+ , PersistQuery m+ , PersistMonadBackend m ~ b+ )+ => AccountName -> Int + -> EitherT String m [DbAddressGeneric b]+dbGenIntAddrs name c + | c <= 0 = left "dbGenIntAddrs: Count argument must be greater than 0"+ | otherwise = dbGenAddrs name (replicate c "") True++dbAdjustGap :: ( PersistUnique m+ , PersistQuery m+ , PersistMonadBackend m ~ b+ )+ => DbAddressGeneric b -> EitherT String m ()+dbAdjustGap a = do+ acc <- liftMaybe accErr =<< (get $ dbAddressAccount a)+ let fIndex | dbAddressInternal a = dbAccountIntIndex + | otherwise = dbAccountExtIndex+ diff <- count [ DbAddressIndex >. fIndex acc+ , DbAddressIndex <=. dbAddressIndex a+ , DbAddressAccount ==. dbAddressAccount a+ , DbAddressInternal ==. dbAddressInternal a+ ]+ when (diff > 0) $ do+ _ <- dbGenAddrs (dbAccountName acc) + (replicate diff "") + (dbAddressInternal a)+ return ()+ where+ accErr = "dbAdjustGap: Could not load address account"++dbSetGap :: ( PersistUnique m+ , PersistQuery m+ )+ => AccountName -> Int -> Bool -> EitherT String m ()+dbSetGap name gap internal = do+ (Entity ai acc) <- dbGetAcc name + diff <- count [ DbAddressIndex >. fIndex acc+ , DbAddressIndex <=. fGap acc+ , DbAddressAccount ==. ai+ , DbAddressInternal ==. internal+ ]+ when (diff < gap) $ do+ _ <- dbGenAddrs name (replicate (gap - diff) "") internal+ return ()+ res <- (map entityVal) <$> selectList + [ DbAddressAccount ==. ai+ , DbAddressInternal ==. internal+ ]+ [ Desc DbAddressIndex+ , LimitTo (gap + 1)+ ]+ let lastIndex | length res <= gap = (-1)+ | otherwise = dbAddressIndex $ last res+ lastGap = dbAddressIndex $ head res+ newAcc | internal = acc{ dbAccountIntIndex = lastIndex + , dbAccountIntGap = lastGap+ }+ | otherwise = acc{ dbAccountExtIndex = lastIndex + , dbAccountExtGap = lastGap+ }+ replace ai newAcc+ where + fIndex | internal = dbAccountIntIndex + | otherwise = dbAccountExtIndex+ fGap | internal = dbAccountIntGap + | otherwise = dbAccountExtGap++dbGenAddrs :: ( PersistUnique m+ , PersistQuery m+ , PersistMonadBackend m ~ b+ )+ => AccountName -> [String] -> Bool + -> EitherT String m [DbAddressGeneric b]+dbGenAddrs name labels internal+ | null labels = left "dbGenAddr: Labels can not be empty"+ | otherwise = do+ time <- liftIO getCurrentTime+ (Entity ai acc) <- dbGetAcc name+ let tree | internal = "1/"+ | otherwise = "0/"+ build (s,i) = DbAddress + s "" (fromIntegral i)+ (concat [dbAccountTree acc,tree,show i,"/"])+ ai internal time+ ls <- liftMaybe keyErr $ f acc+ let gapAddr = map build $ take (length labels) ls+ _ <- insertMany gapAddr+ resAddr <- selectList + [ DbAddressIndex >. fIndex acc+ , DbAddressAccount ==. ai+ , DbAddressInternal ==. internal+ ]+ [ Asc DbAddressIndex+ , LimitTo $ length labels+ ]+ let lastGap = dbAddressIndex $ last gapAddr+ lastIndex = dbAddressIndex $ entityVal $ last resAddr+ newAcc | internal = acc{ dbAccountIntGap = lastGap+ , dbAccountIntIndex = lastIndex+ }+ | otherwise = acc{ dbAccountExtGap = lastGap+ , dbAccountExtIndex = lastIndex+ }+ replace ai newAcc+ forM (zip resAddr labels) $ \(Entity idx a,l) -> do+ let newAddr = a{ dbAddressLabel = l }+ replace idx newAddr + return newAddr+ where + keyErr = "dbGenAddr: Error decoding account keys"+ f acc | isMSAcc acc = (if internal then intMulSigAddrs else extMulSigAddrs)+ <$> (loadPubAcc =<< (xPubImport $ dbAccountKey acc))+ <*> (mapM xPubImport $ dbAccountMsKeys acc) + <*> (dbAccountMsRequired acc)+ <*> (return $ fromIntegral $ fGap acc + 1)+ | otherwise = (if internal then intAddrs else extAddrs)+ <$> (loadPubAcc =<< (xPubImport $ dbAccountKey acc))+ <*> (return $ fromIntegral $ fGap acc + 1)+ fGap | internal = dbAccountIntGap+ | otherwise = dbAccountExtGap+ fIndex | internal = dbAccountIntIndex+ | otherwise = dbAccountExtIndex++
+ Network/Haskoin/Wallet/Store/DbCoin.hs view
@@ -0,0 +1,91 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE TypeFamilies #-}+module Network.Haskoin.Wallet.Store.DbCoin +( dbCoins+, dbBalance+, yamlCoin+, toCoin+) where++import Control.Applicative ((<$>))+import Control.Monad.Trans.Either (EitherT)++import Data.Yaml+ ( Value + , object + , (.=)+ )+import Data.Maybe (isJust, fromJust)++import Database.Persist+ ( PersistStore+ , PersistQuery+ , PersistMonadBackend+ , Entity(..)+ , entityVal+ , selectList+ , (==.)+ , SelectOpt(Asc)+ )+import Database.Persist.Sqlite (SqlBackend)++import Network.Haskoin.Wallet.TxBuilder+import Network.Haskoin.Wallet.Store.Util+import Network.Haskoin.Protocol+import Network.Haskoin.Util++toCoin :: DbCoinGeneric b -> Either String Coin+toCoin c = do+ scp <- decodeScriptOps =<< maybeToEither scpErr (hexToBS $ dbCoinScript c)+ rdm <- if isJust $ dbCoinRdmScript c+ then do+ bs <- maybeToEither rdmErr $ hexToBS =<< dbCoinRdmScript c+ Just <$> decodeScriptOps bs+ else return Nothing+ h <- maybeToEither tidErr $ decodeTxid $ dbCoinTxid c+ return $ Coin (TxOut (fromIntegral $ dbCoinValue c) scp)+ (OutPoint h (fromIntegral $ dbCoinPos c))+ rdm+ where+ scpErr = "toCoin: Could not decode coin script"+ tidErr = "toCoin: Could not decode coin txid"+ rdmErr = "toCoin: Could not decode coin redeem script"++yamlCoin :: DbCoinGeneric b -> Value+yamlCoin coin = object $ concat+ [ [ "TxID" .= dbCoinTxid coin + , "Index" .= dbCoinPos coin+ , "Value" .= dbCoinValue coin+ , "Script" .= dbCoinScript coin+ , "Address" .= dbCoinAddress coin+ ] + , if isJust $ dbCoinRdmScript coin + then ["Redeem" .= fromJust (dbCoinRdmScript coin)] + else []+ , if dbCoinOrphan coin then ["Orphan" .= True] else []+ ]++dbBalance :: (PersistQuery m, PersistMonadBackend m ~ b)+ => Entity (DbAccountGeneric b)+ -> EitherT String m Int+dbBalance (Entity ai _) = do+ coins <- selectList + [ DbCoinAccount ==. ai+ , DbCoinStatus ==. Unspent+ , DbCoinOrphan ==. False+ ] []+ return $ sum $ map (dbCoinValue . entityVal) coins++dbCoins :: (PersistQuery m, PersistMonadBackend m ~ SqlBackend) + => DbAccountId + -> EitherT String m [DbCoinGeneric SqlBackend]+dbCoins ai = do+ coins <- selectList + [ DbCoinAccount ==. ai+ , DbCoinStatus ==. Unspent+ , DbCoinOrphan ==. False+ ] [Asc DbCoinCreated]+ return $ map entityVal coins++
+ Network/Haskoin/Wallet/Store/DbTx.hs view
@@ -0,0 +1,441 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE TypeFamilies #-}+module Network.Haskoin.Wallet.Store.DbTx+( dbImportTx+, dbRemoveTx+, dbSendTx+, dbSendSolution+, dbSendCoins+, dbSignTx+, yamlTx+, RawTxOutPoints(..)+, RawTxDests(..)+, RawSigInput(..)+, RawPrvKey(..)+) where++import Control.Applicative ((<$>), (<*>))+import Control.Monad (forM, unless, when, mzero)+import Control.Monad.Trans (liftIO)+import Control.Monad.Trans.Either (EitherT, left)++import Data.Time (UTCTime, getCurrentTime)+import Data.Word (Word32, Word64)+import Data.List ((\\), nub)+import Data.Maybe (catMaybes, isNothing, isJust, fromJust)+import Data.Either (rights)+import Data.Yaml + ( Value+ , object + , (.=), (.:), (.:?)+ , parseJSON+ , Parser+ )+import qualified Data.Aeson as Json + ( FromJSON+ , withObject+ , withArray+ )+import qualified Data.Vector as V (toList)+import qualified Data.HashMap.Strict as H (toList)+import qualified Data.Map.Strict as M + ( toList+ , empty+ , lookup+ , insert+ )+import qualified Data.Text as T (pack, unpack)++import Database.Persist + ( PersistStore+ , PersistUnique+ , PersistQuery+ , PersistMonadBackend+ , Entity(..)+ , entityVal+ , entityKey+ , get+ , getBy+ , selectList+ , deleteWhere+ , updateWhere+ , update+ , insert_+ , insertUnique+ , replace+ , (=.), (==.), (<-.)+ )+import Database.Persist.Sql (SqlBackend)++import Network.Haskoin.Wallet.Keys+import Network.Haskoin.Wallet.Manager+import Network.Haskoin.Wallet.TxBuilder+import Network.Haskoin.Wallet.Store.DbAccount+import Network.Haskoin.Wallet.Store.DbAddress+import Network.Haskoin.Wallet.Store.DbCoin+import Network.Haskoin.Wallet.Store.Util+import Network.Haskoin.Script+import Network.Haskoin.Protocol+import Network.Haskoin.Crypto+import Network.Haskoin.Util+import Network.Haskoin.Util.BuildMonad++yamlTx :: DbTxGeneric b -> Value+yamlTx tx = object $ concat+ [ [ "Recipients" .= dbTxRecipients tx+ , "Value" .= dbTxValue tx+ ]+ , if dbTxOrphan tx then ["Orphan" .= True] else []+ , if dbTxPartial tx then ["Partial" .= True] else []+ ]++-- |Remove a transaction from the database and any parent transaction+dbRemoveTx :: PersistQuery m => String -> EitherT String m [String]+dbRemoveTx tid = do+ -- Find all parents of this transaction+ -- Partial transactions should not have any coins. Won't check for it+ coins <- selectList [ DbCoinTxid ==. tid ] []+ let parents = nub $ catStatus $ map (dbCoinStatus . entityVal) coins+ -- Recursively remove parents+ pids <- forM parents dbRemoveTx+ -- Delete output coins generated from this transaction+ deleteWhere [ DbCoinTxid ==. tid ]+ -- Delete account transactions+ deleteWhere [ DbTxTxid ==. tid ]+ -- Delete transaction blob+ deleteWhere [ DbTxBlobTxid ==. tid ]+ -- Delete orphaned input coins spent by this transaction+ deleteWhere [ DbCoinOrphan ==. True+ , DbCoinStatus <-. [Spent tid, Reserved tid]+ ]+ -- Unspend input coins that were previously spent by this transaction+ updateWhere [ DbCoinStatus <-. [Spent tid, Reserved tid] ]+ [ DbCoinStatus =. Unspent ]+ return $ tid:(concat pids)+ +-- |Import a transaction into the database+dbImportTx :: ( PersistQuery m, PersistUnique m+ , PersistMonadBackend m ~ SqlBackend+ ) + => Tx -> EitherT String m [DbTxGeneric SqlBackend]+dbImportTx tx = do+ coinsM <- mapM (getBy . f) $ map prevOutput $ txIn tx+ let inCoins = catMaybes coinsM+ -- Unspent coins in the wallet related to this transaction+ unspent = filter ((== Unspent) . dbCoinStatus . entityVal) inCoins+ -- OutPoints from this transaction with no associated coins+ unknown = map snd $ filter (isNothing . fst) $ zip coinsM $ txIn tx+ -- Fail if an input is spent by a transaction which is not this one+ unless (isImportValid tid $ map entityVal inCoins) $ left+ "dbImportTx: Double spend detected. Import failed"+ let toRemove = txToRemove $ map entityVal inCoins+ if length toRemove > 0+ then do+ -- Partial transactions need to be removed + -- before trying to re-import+ _ <- mapM dbRemoveTx toRemove+ dbImportTx tx+ else do+ time <- liftIO getCurrentTime+ -- Change status of all the unspent coins+ _ <- forM unspent $ \(Entity ci _) -> + update ci [DbCoinStatus =. status]+ -- Insert orphaned coins+ orphans <- catMaybes <$> mapM (dbImportOrphan status) unknown+ -- Import new coins and update existing coins+ outCoins <- catMaybes <$> + (mapM (dbImportCoin tid complete) $ zip (txOut tx) [0..])+ let accTxs = buildAccTx tx ((map entityVal inCoins) ++ orphans)+ outCoins (not complete) time+ -- Insert transaction blob. Ignore if already exists+ _ <- insertUnique $ DbTxBlob tid (encode' tx) time+ -- insert account transactions into database, + -- rewriting if they exist+ _ <- forM accTxs $ \accTx -> do+ prev <- getBy $ UniqueTx (dbTxTxid accTx) (dbTxAccount accTx)+ if isNothing prev + then insert_ accTx + else replace (entityKey $ fromJust prev) accTx+ -- Re-import parent transactions (transactions spending this one)+ if complete+ then do+ let ids = nub $ catStatus $ map dbCoinStatus outCoins+ blobs <- mapM dbGetTxBlob ids+ reImported <- forM blobs $ (dbImportTx =<<) . dec+ return $ accTxs ++ (concat reImported)+ else return accTxs+ where+ tid = encodeTxid $ txid tx+ f (OutPoint h i) = CoinOutPoint (encodeTxid h) (fromIntegral i)+ complete = isTxComplete tx+ status = if complete then Spent tid else Reserved tid+ dec = liftEither . decodeToEither . dbTxBlobValue . entityVal++-- |A transaction can not be imported if it double spends coins in the wallet.+-- Upstream code needs to remove the conflicting transaction first using+-- dbTxRemove function+isImportValid :: String -> [DbCoinGeneric b] -> Bool+isImportValid tid coins = all (f . dbCoinStatus) coins+ where+ f (Spent parent) = parent == tid+ f _ = True++-- When a transaction spends coins previously spent by a partial transaction,+-- we need to remove the partial transactions from the database and try to+-- re-import the transaction. Coins with Reserved status are spent by a partial+-- transaction.+txToRemove :: [DbCoinGeneric b] -> [String]+txToRemove coins = catMaybes $ map (f . dbCoinStatus) coins+ where+ f (Reserved parent) = Just parent+ f _ = Nothing++-- |Group input and output coins by accounts and create +-- account-level transaction+buildAccTx :: Tx -> [DbCoinGeneric b] -> [DbCoinGeneric b]+ -> Bool -> UTCTime -> [DbTxGeneric b]+buildAccTx tx inCoins outCoins partial time = map build $ M.toList oMap+ where+ iMap = foldr (f (\(i,o) x -> (x:i,o))) M.empty inCoins+ oMap = foldr (f (\(i,o) x -> (i,x:o))) iMap outCoins+ f g coin accMap = case M.lookup (dbCoinAccount coin) accMap of+ Just tuple -> M.insert (dbCoinAccount coin) (g tuple coin) accMap+ Nothing -> M.insert (dbCoinAccount coin) (g ([],[]) coin) accMap+ allRecip = rights $ map toAddr $ txOut tx+ toAddr = (addrToBase58 <$>) . scriptRecipient . scriptOutput+ sumVal = sum . (map dbCoinValue)+ build (ai,(i,o)) = + DbTx (encodeTxid $ txid tx) recips total ai orphan partial time+ where+ orphan = or $ map dbCoinOrphan i+ total | orphan = 0+ | otherwise = sumVal o - sumVal i+ addrs = map dbCoinAddress o+ recips | null addrs = allRecip+ | orphan = allRecip \\ addrs -- assume this is an outgoing tx+ | total < 0 = allRecip \\ addrs -- remove the change+ | otherwise = addrs++-- |Create an orphaned coin if the input spends from an address in the wallet+-- but the coin doesn't exist in the wallet. This allows out-of-order tx import+dbImportOrphan :: (PersistUnique m, PersistMonadBackend m ~ SqlBackend) + => CoinStatus -> TxIn + -> EitherT String m (Maybe (DbCoinGeneric SqlBackend))+dbImportOrphan status (TxIn (OutPoint h i) s _)+ | isLeft a = return Nothing+ | otherwise = getBy (UniqueAddress b58) >>= \addrM -> case addrM of+ Nothing -> return Nothing+ Just (Entity _ add) -> do+ time <- liftIO $ getCurrentTime+ rdm <- dbGetRedeem add+ let coin = build rdm add time+ insert_ coin >> return (Just coin)+ where+ a = scriptSender s+ b58 = addrToBase58 $ fromRight a+ build rdm add time = + DbCoin (encodeTxid h) (fromIntegral i) 0 "" rdm b58 status+ (dbAddressAccount add) True time++-- |Create a new coin for an output if it sends coins to an +-- address in the wallet. Does not actually write anything to the database+-- if commit is False. This is for correctly reporting on partial transactions+-- without creating coins in the database from a partial transaction+dbImportCoin :: ( PersistQuery m, PersistUnique m+ , PersistMonadBackend m ~ SqlBackend+ )+ => String -> Bool -> (TxOut,Int) + -> EitherT String m (Maybe (DbCoinGeneric SqlBackend))+dbImportCoin tid commit ((TxOut v s), index) + | isLeft a = return Nothing+ | otherwise = getBy (UniqueAddress b58) >>= \addrM -> case addrM of+ Nothing -> return Nothing+ Just (Entity _ add) -> do+ time <- liftIO getCurrentTime+ coinM <- getBy $ CoinOutPoint tid index+ case coinM of+ Just (Entity ci coin) -> do+ -- Update existing coin with up to date information+ let newCoin = coin{ dbCoinOrphan = False+ , dbCoinValue = (fromIntegral v)+ , dbCoinScript = scp+ , dbCoinCreated = time+ }+ when commit $ replace ci newCoin+ return $ Just newCoin+ Nothing -> do+ rdm <- dbGetRedeem add+ let coin = build rdm add time+ when commit $ insert_ coin+ dbAdjustGap add -- Adjust address gap+ return $ Just coin+ where+ a = scriptRecipient s+ b58 = addrToBase58 $ fromRight a+ scp = bsToHex $ encodeScriptOps s+ build rdm add time = + DbCoin tid index (fromIntegral v) scp rdm b58 Unspent+ (dbAddressAccount add) False time+ +-- |Builds a redeem script given an address. Only relevant for addresses+-- linked to multisig accounts. Otherwise it returns Nothing+dbGetRedeem :: (PersistStore m, PersistMonadBackend m ~ SqlBackend) + => DbAddressGeneric SqlBackend -> EitherT String m (Maybe String)+dbGetRedeem add = do+ acc <- liftMaybe accErr =<< (get $ dbAddressAccount add)+ rdm <- if isMSAcc acc + then Just <$> liftMaybe rdmErr (getRdm acc)+ else return Nothing+ return $ bsToHex . encodeScriptOps . encodeOutput <$> rdm+ where+ getRdm acc = do+ key <- loadPubAcc =<< (xPubImport $ dbAccountKey acc)+ msKeys <- mapM xPubImport $ dbAccountMsKeys acc+ addrKeys <- f key msKeys $ fromIntegral $ dbAddressIndex add+ let pks = map (xPubKey . getAddrPubKey) addrKeys+ sortMulSig . (PayMulSig pks) <$> dbAccountMsRequired acc+ where+ f = if dbAddressInternal add then intMulSigKey else extMulSigKey+ accErr = "dbImportOut: Invalid address account"+ rdmErr = "dbGetRedeem: Could not generate redeem script"++-- |Build and sign a transactoin given a list of recipients+dbSendTx :: ( PersistUnique m, PersistQuery m+ , PersistMonadBackend m ~ SqlBackend+ )+ => AccountName -> [(String,Word64)] -> Word64+ -> EitherT String m (Tx, Bool)+dbSendTx name dests fee = do+ (coins,recips) <- dbSendSolution name dests fee+ dbSendCoins coins recips (SigAll False)++-- |Given a list of recipients and a fee, finds a valid combination of coins+dbSendSolution :: ( PersistUnique m, PersistQuery m+ , PersistMonadBackend m ~ SqlBackend+ )+ => AccountName -> [(String,Word64)] -> Word64+ -> EitherT String m ([Coin],[(String,Word64)])+dbSendSolution name dests fee = do+ (Entity ai acc) <- dbGetAcc name+ unspent <- liftEither . (mapM toCoin) =<< dbCoins ai+ (coins,change) <- liftEither $ if isMSAcc acc+ then let msParam = ( fromJust $ dbAccountMsRequired acc+ , fromJust $ dbAccountMsTotal acc+ )+ in chooseMSCoins tot fee msParam unspent+ else chooseCoins tot fee unspent+ recips <- if change < 5000 then return dests else do+ cAddr <- dbGenIntAddrs name 1+ return $ dests ++ [(dbAddressBase58 $ head cAddr,change)]+ return (coins,recips)+ where+ tot = sum $ map snd dests+ +-- | Build and sign a transaction by providing coins and recipients+dbSendCoins :: PersistUnique m+ => [Coin] -> [(String,Word64)] -> SigHash+ -> EitherT String m (Tx, Bool)+dbSendCoins coins recipients sh = do+ tx <- liftEither $ buildAddrTx (map coinOutPoint coins) recipients+ ys <- mapM (dbGetSigData sh) coins+ let sigTx = detSignTx tx (map fst ys) (map snd ys)+ bsTx <- liftEither $ buildToEither sigTx+ return (bsTx, isComplete sigTx)++dbSignTx :: PersistUnique m+ => AccountName -> Tx -> SigHash -> EitherT String m (Tx, Bool)+dbSignTx name tx sh = do+ (Entity ai _) <- dbGetAcc name+ coins <- catMaybes <$> (mapM (getBy . f) $ map prevOutput $ txIn tx)+ -- Filter coins for this account only+ let accCoins = filter ((== ai) . dbCoinAccount . entityVal) coins+ ys <- forM accCoins g+ let sigTx = detSignTx tx (map fst ys) (map snd ys)+ bsTx <- liftEither $ buildToEither sigTx+ return (bsTx, isComplete sigTx)+ where+ f (OutPoint h i) = CoinOutPoint (encodeTxid h) (fromIntegral i)+ g = ((dbGetSigData sh) =<<) . liftEither . toCoin . entityVal++-- |Given a coin, retrieves the necessary data to sign a transaction+dbGetSigData :: PersistUnique m+ => SigHash -> Coin -> EitherT String m (SigInput,PrvKey)+dbGetSigData sh coin = do+ (Entity _ w) <- dbGetWallet "main"+ a <- liftEither $ scriptRecipient out+ (Entity _ add) <- dbGetAddr $ addrToBase58 a+ acc <- liftMaybe accErr =<< get (dbAddressAccount add)+ mst <- liftMaybe mstErr $ loadMasterKey =<< xPrvImport (dbWalletMaster w)+ aKey <- liftMaybe prvErr $ accPrvKey mst $ fromIntegral $ dbAccountIndex acc+ let g = if dbAddressInternal add then intPrvKey else extPrvKey+ sigKey <- liftMaybe addErr $ g aKey $ fromIntegral $ dbAddressIndex add+ return (sigi, xPrvKey $ getAddrPrvKey sigKey)+ where+ out = scriptOutput $ coinTxOut coin+ rdm = coinRedeem coin+ sigi | isJust rdm = SigInputSH out (coinOutPoint coin) (fromJust rdm) sh+ | otherwise = SigInput out (coinOutPoint coin) sh+ mstErr = "dbGetSigData: Could not load master key"+ accErr = "dbGetSigData: Could not load address account"+ prvErr = "dbGetSigData: Invalid account derivation index"+ addErr = "dbGetSigData: Invalid address derivation index"++data RawTxOutPoints = RawTxOutPoints [OutPoint] + deriving (Eq, Show)++data RawTxDests = RawTxDests [(String,Word64)]+ deriving (Eq, Show)++instance Json.FromJSON RawTxOutPoints where+ parseJSON = Json.withArray "Expected: Array" $ \arr -> do+ RawTxOutPoints <$> (mapM f $ V.toList arr)+ where+ f = Json.withObject "Expected: Object" $ \obj -> do+ tid <- obj .: T.pack "txid" :: Parser String+ vout <- obj .: T.pack "vout" :: Parser Word32+ let i = maybeToEither ("Failed to decode txid" :: String)+ (decodeTxid tid)+ o = OutPoint <$> i <*> (return vout)+ either (const mzero) return o++instance Json.FromJSON RawTxDests where+ parseJSON = Json.withObject "Expected: Object" $ \obj ->+ RawTxDests <$> (mapM f $ H.toList obj)+ where+ f (add,v) = do+ amnt <- parseJSON v :: Parser Word64+ return (T.unpack add, amnt)++data RawSigInput = RawSigInput [(SigHash -> SigInput)]++data RawPrvKey = RawPrvKey [PrvKey]+ deriving (Eq, Show)++instance Json.FromJSON RawSigInput where+ parseJSON = Json.withArray "Expected: Array" $ \arr -> do+ RawSigInput <$> (mapM f $ V.toList arr)+ where+ f = Json.withObject "Expected: Object" $ \obj -> do+ tid <- obj .: T.pack "txid" :: Parser String+ vout <- obj .: T.pack "vout" :: Parser Word32+ scp <- obj .: T.pack "scriptPubKey" :: Parser String+ rdm <- obj .:? T.pack "scriptRedeem" :: Parser (Maybe String)+ let s = decodeScriptOps =<< maybeToEither "Hex parsing failed" + (hexToBS scp)+ i = maybeToEither "Failed to decode txid" (decodeTxid tid)+ o = OutPoint <$> i <*> (return vout)+ r = decodeScriptOps =<< maybeToEither "Hex parsing failed" + (hexToBS $ fromJust rdm)+ res | isJust rdm = SigInputSH <$> s <*> o <*> r+ | otherwise = SigInput <$> s <*> o+ either (const mzero) return res++instance Json.FromJSON RawPrvKey where+ parseJSON = Json.withArray "Expected: Array" $ \arr ->+ RawPrvKey <$> (mapM f $ V.toList arr)+ where+ f v = do+ str <- parseJSON v :: Parser String + maybe mzero return $ fromWIF str+
+ Network/Haskoin/Wallet/Store/Util.hs view
@@ -0,0 +1,337 @@+{-# LANGUAGE EmptyDataDecls #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeFamilies #-}+module Network.Haskoin.Wallet.Store.Util +( DbWalletGeneric(..)+, DbAccountGeneric(..)+, DbAddressGeneric(..)+, DbCoinGeneric(..)+, DbTxGeneric(..)+, DbTxBlobGeneric(..)+, DbWalletId+, DbAccountId+, DbAddressId+, DbCoinId+, DbTxId+, DbTxBlobId+, Unique(..)+, EntityField(..)+, AccountName+, CoinStatus(..)+, catStatus+, dbGetWallet+, dbGetTxBlob+, liftEither+, liftMaybe+, migrateAll+) where++import Control.Monad.Trans (lift)+import Control.Monad.Trans.Either (EitherT, hoistEither)++import Data.Time (UTCTime)+import Data.Yaml+ ( ToJSON, toJSON+ , object, (.=)+ )+import qualified Data.Text as T (pack)+import qualified Data.ByteString as BS (ByteString)+import qualified Data.Conduit as C (transPipe)++import Database.Persist + ( PersistStore+ , PersistUnique+ , PersistQuery+ , PersistMonadBackend+ , Entity+ , EntityField+ , Unique+ , get+ , getBy+ , insert_+ , insert+ , count+ , selectKeys+ , selectFirst+ , selectSource+ , updateWhere+ , deleteBy+ , insertUnique+ , updateGet+ , replace+ , repsert+ , insertKey+ , insertMany+ , delete+ , deleteWhere+ , update+ )+import Database.Persist.TH + ( mkPersist+ , sqlSettings+ , mkMigrate+ , persistLowerCase+ , share+ )++import Network.Haskoin.Wallet.Store.CoinStatus+import Network.Haskoin.Script+import Network.Haskoin.Protocol+import Network.Haskoin.Crypto+import Network.Haskoin.Util++type AccountName = String++liftEither :: Monad m => Either String a -> EitherT String m a+liftEither = hoistEither++liftMaybe :: Monad m => String -> Maybe a -> EitherT String m a+liftMaybe err = liftEither . (maybeToEither err)++share [mkPersist sqlSettings, mkMigrate "migrateAll"] [persistLowerCase|+DbWallet json+ name String+ type String+ master String + accIndex Int+ created UTCTime default=CURRENT_TIME+ UniqueWalletName name+ deriving Show++DbAccount json+ name String+ index Int+ tree String+ key String+ extIndex Int+ extGap Int+ intIndex Int+ intGap Int+ msRequired Int Maybe+ msTotal Int Maybe+ msKeys [String] + wallet DbWalletId+ created UTCTime default=CURRENT_TIME+ UniqueAccName name+ deriving Show++DbAddress json+ base58 String+ label String+ index Int+ tree String+ account DbAccountId+ internal Bool+ created UTCTime default=CURRENT_TIME+ UniqueAddress base58+ UniqueAddressKey account index internal+ deriving Show++DbCoin json+ txid String+ pos Int+ value Int+ script String+ rdmScript String Maybe+ address String + status CoinStatus+ account DbAccountId+ orphan Bool+ created UTCTime default=CURRENT_TIME+ CoinOutPoint txid pos+ deriving Show++DbTx json+ txid String+ recipients [String]+ value Int+ account DbAccountId+ orphan Bool+ partial Bool+ created UTCTime default=CURRENT_TIME+ UniqueTx txid account+ deriving Show++DbTxBlob json+ txid String+ value BS.ByteString + created UTCTime default=CURRENT_TIME+ UniqueTxBlob txid+ deriving Show++|]++dbGetWallet :: (PersistUnique m, PersistMonadBackend m ~ b)+ => String -> EitherT String m (Entity (DbWalletGeneric b))+dbGetWallet name = liftMaybe walletErr =<< (getBy $ UniqueWalletName name)+ where + walletErr = unwords ["dbGetWallet: Invalid wallet", name]++dbGetTxBlob :: (PersistUnique m, PersistMonadBackend m ~ b)+ => String -> EitherT String m (Entity (DbTxBlobGeneric b))+dbGetTxBlob tid = liftMaybe txErr =<< (getBy $ UniqueTxBlob tid)+ where+ txErr = unwords ["dbGetTxBlob: Invalid txid", tid]++instance PersistStore m => PersistStore (EitherT e m) where+ type PersistMonadBackend (EitherT e m) = PersistMonadBackend m+ get = lift . get+ insert = lift . insert+ insert_ = lift . insert_+ insertMany = lift . insertMany+ insertKey k = lift . (insertKey k)+ repsert k = lift . (repsert k)+ replace k = lift . (replace k)+ delete = lift . delete++instance PersistUnique m => PersistUnique (EitherT e m) where+ getBy = lift . getBy+ deleteBy = lift . deleteBy+ insertUnique = lift . insertUnique++instance PersistQuery m => PersistQuery (EitherT e m) where+ update k = lift . (update k)+ updateGet k = lift . (updateGet k)+ updateWhere f = lift . (updateWhere f)+ deleteWhere = lift . deleteWhere+ selectSource f = (C.transPipe lift) . (selectSource f)+ selectFirst f = lift . (selectFirst f)+ selectKeys f = (C.transPipe lift) . (selectKeys f)+ count = lift . count++{- YAML templates -}++instance ToJSON OutPoint where+ toJSON (OutPoint h i) = object+ [ (T.pack "TxID") .= encodeTxid h+ , (T.pack "Index") .= toJSON i+ ]++instance ToJSON TxOut where+ toJSON (TxOut v s) = object $+ [ (T.pack "Value") .= toJSON v+ , (T.pack "Raw Script") .= (bsToHex $ encodeScriptOps s)+ , (T.pack "Script") .= toJSON s+ ] ++ scptPair + where scptPair = + either (const [])+ (\out -> [(T.pack "Decoded Script") .= toJSON out]) + (decodeOutput s)++instance ToJSON TxIn where+ toJSON (TxIn o s i) = object $ concat+ [ [ (T.pack "OutPoint") .= toJSON o+ , (T.pack "Sequence") .= toJSON i+ , (T.pack "Raw Script") .= (bsToHex $ encodeScriptOps s)+ , (T.pack "Script") .= toJSON s+ ] + , decoded + ]+ where decoded = either (const $ either (const []) f $ decodeInput s) + f $ decodeScriptHash s+ f inp = [(T.pack "Decoded Script") .= toJSON inp]+ +instance ToJSON Tx where+ toJSON tx@(Tx v is os i) = object+ [ (T.pack "TxID") .= encodeTxid (txid tx)+ , (T.pack "Version") .= toJSON v+ , (T.pack "Inputs") .= (toJSON $ map input $ zip is [0..])+ , (T.pack "Outputs") .= (toJSON $ map output $ zip os [0..])+ , (T.pack "LockTime") .= toJSON i+ ]+ where input (x,j) = object + [(T.pack $ unwords ["Input", show (j :: Int)]) .= toJSON x]+ output (x,j) = object + [(T.pack $ unwords ["Output", show (j :: Int)]) .= toJSON x]++instance ToJSON Script where+ toJSON (Script ops) = toJSON $ map show ops++instance ToJSON ScriptOutput where+ toJSON (PayPK p) = object + [ (T.pack "PayToPublicKey") .= object+ [ (T.pack "Public Key") .= (bsToHex $ encode' p)+ ]+ ]+ toJSON (PayPKHash a) = object + [ (T.pack "PayToPublicKeyHash") .= object+ [ (T.pack "Address Hash160") .= (bsToHex $ encode' $ getAddress a)+ , (T.pack "Address Base58") .= addrToBase58 a+ ]+ ]+ toJSON (PayMulSig ks r) = object + [ (T.pack "PayToMultiSig") .= object+ [ (T.pack "Required Keys (M)") .= toJSON r+ , (T.pack "Public Keys") .= (toJSON $ map (bsToHex . encode') ks)+ ]+ ]+ toJSON (PayScriptHash a) = object + [ (T.pack "PayToScriptHash") .= object+ [ (T.pack "Address Hash160") .= (bsToHex $ encode' $ getAddress a)+ , (T.pack "Address Base58") .= addrToBase58 a+ ]+ ]++instance ToJSON ScriptInput where+ toJSON (SpendPK s) = object + [ (T.pack "SpendPublicKey") .= object+ [ (T.pack "Signature") .= toJSON s+ ]+ ]+ toJSON (SpendPKHash s p) = object + [ (T.pack "SpendPublicKeyHash") .= object+ [ (T.pack "Signature") .= toJSON s+ , (T.pack "Public Key") .= (bsToHex $ encode' p)+ , (T.pack "Sender Addr") .= addrToBase58 (pubKeyAddr p)+ ]+ ]+ toJSON (SpendMulSig sigs r) = object + [ (T.pack "SpendMultiSig") .= object+ [ (T.pack "Required Keys (M)") .= toJSON r+ , (T.pack "Signatures") .= (toJSON $ map toJSON sigs)+ ]+ ]++instance ToJSON ScriptHashInput where+ toJSON (ScriptHashInput s r) = object+ [ (T.pack "SpendScriptHash") .= object+ [ (T.pack "ScriptInput") .= toJSON s+ , (T.pack "RedeemScript") .= toJSON r+ , (T.pack "Raw Redeem Script") .= + (bsToHex $ encodeScriptOps $ encodeOutput r)+ , (T.pack "Sender Addr") .= (addrToBase58 $ scriptAddr r)+ ]+ ]++instance ToJSON TxSignature where+ toJSON ts@(TxSignature _ h) = object+ [ (T.pack "Raw Sig") .= (bsToHex $ encodeSig ts)+ , (T.pack "SigHash") .= toJSON h+ ]++instance ToJSON SigHash where+ toJSON sh = case sh of+ (SigAll acp) -> object+ [ (T.pack "Type") .= T.pack "SigAll"+ , (T.pack "AnyoneCanPay") .= acp+ ]+ (SigNone acp) -> object+ [ (T.pack "Type") .= T.pack "SigNone"+ , (T.pack "AnyoneCanPay") .= acp+ ]+ (SigSingle acp) -> object+ [ (T.pack "Type") .= T.pack "SigSingle"+ , (T.pack "AnyoneCanPay") .= acp+ ]+ (SigUnknown acp v) -> object+ [ (T.pack "Type") .= T.pack "SigUnknown"+ , (T.pack "AnyoneCanPay") .= acp+ , (T.pack "Value") .= v+ ]+++
+ Network/Haskoin/Wallet/TxBuilder.hs view
@@ -0,0 +1,357 @@+module Network.Haskoin.Wallet.TxBuilder +( Coin(..)+, buildTx+, buildAddrTx+, SigInput(..)+, signTx+, detSignTx+, verifyTx+, guessTxSize+, chooseCoins+, chooseMSCoins+, getFee+, getMSFee+, isTxComplete+) where++import Control.Monad (when, guard, liftM2)+import Control.Applicative ((<$>))+import Control.Monad.Trans (lift)++import Data.Maybe (catMaybes, maybeToList, fromMaybe)+import Data.List (sortBy, find)+import Data.Word (Word64)+import qualified Data.ByteString as BS (length, replicate)++import Network.Haskoin.Util+import Network.Haskoin.Util.BuildMonad+import Network.Haskoin.Crypto+import Network.Haskoin.Protocol+import Network.Haskoin.Script++-- | A Coin is something that can be spent by a transaction and is+-- represented by a transaction output, an outpoint and optionally a+-- redeem script.+data Coin = + Coin { coinTxOut :: TxOut -- ^ Transaction output+ , coinOutPoint :: OutPoint -- ^ Previous outpoint+ , coinRedeem :: Maybe Script -- ^ Redeem script+ } deriving (Eq, Show)++-- | 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 :: Word64 -- ^ Target price to pay.+ -> Word64 -- ^ Fee price per 1000 bytes.+ -> [Coin] -- ^ List of coins to choose from.+ -> Either String ([Coin],Word64) + -- ^ Coin selection result and change amount.+chooseCoins target kbfee xs + | target > 0 = maybeToEither err $ greedyAdd target (getFee kbfee) xs+ | otherwise = Left "chooseCoins: Target must be > 0"+ where err = "chooseCoins: No solution found"++-- | Coin selection algorithm for multisignature 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 :: Word64 -- ^ Target price to pay.+ -> Word64 -- ^ Fee price per 1000 bytes.+ -> (Int,Int) -- ^ Multisig parameters m of n (m,n).+ -> [Coin] -- ^ List of coins to choose from.+ -> Either String ([Coin],Word64) + -- ^ Coin selection result and change amount.+chooseMSCoins target kbfee ms xs + | target > 0 = maybeToEither err $ greedyAdd target (getMSFee kbfee ms) xs+ | otherwise = Left "chooseMSCoins: Target must be > 0"+ where err = "chooseMSCoins: No solution found"++-- Select coins greedily by starting from an empty solution+greedyAdd :: Word64 -> (Int -> Word64) -> [Coin] -> Maybe ([Coin],Word64)+greedyAdd target fee xs = go [] 0 [] 0 $ sortBy desc xs+ where desc a b = compare (outValue $ coinTxOut b) (outValue $ coinTxOut a)+ goal c = target + fee c+ go _ _ [] _ [] = Nothing+ go _ _ ps pTot [] = return (ps,pTot - (goal $ length ps))+ go acc aTot ps pTot (y:ys)+ | val + aTot >= (goal $ length acc + 1) =+ if aTot + val - target < pTot - target+ then go [] 0 (y:acc) (aTot + val) ys+ else return (ps,pTot - (goal $ length ps))+ | otherwise = go (y:acc) (aTot + val) ps pTot ys+ where val = outValue $ coinTxOut y++{-+-- Start from a solution containing all coins and greedily remove them+greedyRem :: Word64 -> (Int -> Word64) -> [Coin] -> Maybe ([Coin],Word64)+greedyRem target fee xs + | s < goal (length xs) = Nothing+ | otherwise = return $ go [] s $ sortBy desc xs+ where desc a b = compare (outValue $ coinTxOut b) (outValue $ coinTxOut a)+ s = sum $ map (outValue . coinTxOut) xs+ goal c = target + fee c+ go acc tot [] = (acc,tot - (goal $ length acc))+ go acc tot (y:ys) + | tot - val >= (goal $ length ys + length acc) = + go acc (tot - val) ys+ | otherwise = go (y:acc) tot ys+ where val = outValue $ coinTxOut y+-}++getFee :: Word64 -> Int -> Word64+getFee kbfee count = kbfee*((len + 999) `div` 1000)+ where len = fromIntegral $ guessTxSize count [] 2 0++getMSFee :: Word64 -> (Int,Int) -> Int -> Word64+getMSFee kbfee ms count = kbfee*((len + 999) `div` 1000)+ where len = fromIntegral $ guessTxSize 0 (replicate count ms) 2 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)] + -- ^ For every multisig input in the transaction, provide+ -- the multisig parameters m of n (m,n) for that input.+ -> Int -- ^ Number of pay to public key hash outputs.+ -> Int -- ^ Number of pay to script hash outputs.+ -> Int -- ^ Upper bound on the transaction size.+guessTxSize pki msi pkout msout = 8 + inpLen + inp + outLen + out+ where inpLen = BS.length $ encode' $ + VarInt $ fromIntegral $ (length msi) + pki+ outLen = BS.length $ encode' $ + VarInt $ fromIntegral $ pkout + msout+ 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 pay2sh input+guessMSSize :: (Int,Int) -> Int+ -- OutPoint (36) + Sequence (4) + Script+guessMSSize (m,n) = 40 + (BS.length $ encode' $ VarInt $ fromIntegral scp) + scp+ -- OP_M + n*PubKey + OP_N + OP_CHECKMULTISIG+ where rdm = BS.length $ encode' $ OP_PUSHDATA $ BS.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 recipients addresses and amounts as outputs. +buildAddrTx :: [OutPoint] -> [(String,Word64)] -> Either String Tx+buildAddrTx xs ys = buildTx xs =<< mapM f ys+ where f (s,v) = case base58ToAddr s of+ Just a@(PubKeyAddress _) -> return (PayPKHash a,v)+ Just a@(ScriptAddress _) -> return (PayScriptHash a,v)+ _ -> Left $ "buildAddrTx: Invalid address " ++ s++-- | 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 (Script []) maxBound+ fo (o,v) | v <= 2100000000000000 = return $ TxOut v $ encodeOutput o+ | otherwise = Left $ "buildTx: Invalid amount " ++ (show v)++-- | Data type used to specify the signing parameters of a transaction input.+-- To sign an input, the previous output script, outpoint and sighash are+-- required. When signing a pay to script hash output, an additional redeem+-- script is required.+data SigInput + -- | Parameters for signing a pay to public key hash output.+ = SigInput { sigDataOut :: Script -- ^ Output script to spend.+ , sigDataOP :: OutPoint + -- ^ Reference to the transaction output to spend.+ , sigDataSH :: SigHash -- ^ Signature type.+ } + -- | Parameters for signing a pay to script hash output.+ | SigInputSH { sigDataOut :: Script + , sigDataOP :: OutPoint + , sigRedeem :: Script -- ^ Redeem script.+ , sigDataSH :: SigHash + } deriving (Eq, Show)++liftSecret :: Monad m => Build a -> SecretT (BuildT m) a+liftSecret = lift . liftBuild++-- | Returns True if all the inputs of a transactions are non-empty and if+-- all multisignature inputs are fully signed.+isTxComplete :: Tx -> Bool+isTxComplete = isComplete . (mapM toBuildTxIn) . txIn++-- | Sign a transaction by providing the 'SigInput' signing parameters and a+-- list of private keys. The signature is computed within the 'SecretT' monad+-- to generate the random signing nonce and within the 'BuildT' monad to add+-- information on wether the result was fully or partially signed.+signTx :: Monad m + => Tx -- ^ Transaction to sign+ -> [SigInput] -- ^ SigInput signing parameters+ -> [PrvKey] -- ^ List of private keys to use for signing+ -> SecretT (BuildT m) Tx -- ^ Signed transaction+signTx tx@(Tx _ ti _ _) sigis keys = do+ liftSecret $ when (null ti) $ Broken "signTx: Transaction has no inputs"+ newIn <- mapM sign $ orderSigInput ti sigis+ return tx{ txIn = newIn }+ where sign (maybeSI,txin,i) = case maybeSI of+ Just sigi -> signTxIn txin sigi tx i keys+ _ -> liftSecret $ toBuildTxIn txin++signTxIn :: Monad m => TxIn -> SigInput -> Tx -> Int -> [PrvKey] + -> SecretT (BuildT m) TxIn+signTxIn txin sigi tx i keys = do+ (out,vKeys,pubs,buildf) <- liftSecret $ decodeSigInput sigi keys+ let msg = txSigHash tx (encodeOutput out) i sh+ sigs <- mapM (signMsg msg) vKeys+ liftSecret $ buildf txin tx out i pubs $ map (flip TxSignature sh) sigs+ where sh = sigDataSH sigi++-- | Sign a transaction by providing the 'SigInput' signing paramters and +-- a list of private keys. The signature is computed deterministically as+-- defined in RFC-6979. The signature is computed within the 'Build' monad+-- to add information on wether the result was fully or partially signed.+detSignTx :: Tx -- ^ Transaction to sign+ -> [SigInput] -- ^ SigInput signing parameters+ -> [PrvKey] -- ^ List of private keys to use for signing+ -> Build Tx -- ^ Signed transaction+detSignTx tx@(Tx _ ti _ _) sigis keys = do+ when (null ti) $ Broken "detSignTx: Transaction has no inputs"+ newIn <- mapM sign $ orderSigInput ti sigis+ return tx{ txIn = newIn }+ where sign (maybeSI,txin,i) = case maybeSI of+ Just sigi -> detSignTxIn txin sigi tx i keys+ _ -> toBuildTxIn txin++detSignTxIn :: TxIn -> SigInput -> Tx -> Int -> [PrvKey] -> Build TxIn+detSignTxIn txin sigi tx i keys = do+ (out,vKeys,pubs,buildf) <- decodeSigInput sigi keys+ let msg = txSigHash tx (encodeOutput out) i sh+ sigs = map (detSignMsg msg) vKeys+ buildf txin tx out i pubs $ map (flip TxSignature sh) sigs+ where sh = sigDataSH sigi++{- Helpers for signing transactions -}++-- |Decides if a TxIn is complete. If the TxIn could not be decoded and it+-- is not empty, we consider it complete.+toBuildTxIn :: TxIn -> Build TxIn+toBuildTxIn txin@(TxIn _ s _)+ | null $ scriptOps s = Partial txin+ | otherwise = case decodeScriptHash s of+ Right (ScriptHashInput (SpendMulSig xs r) _) -> + guardPartial (length xs == r) >> return txin+ Right _ -> return txin+ Left _ -> case decodeInput s of+ Right (SpendMulSig xs r) ->+ guardPartial (length xs == r) >> return txin+ _ -> return txin+++orderSigInput :: [TxIn] -> [SigInput] -> [(Maybe SigInput, TxIn, Int)]+orderSigInput ti si = zip3 (matchTemplate si ti f) ti [0..]+ where f s txin = sigDataOP s == prevOutput txin++type BuildFunction = TxIn -> Tx -> ScriptOutput -> Int + -> [PubKey] -> [TxSignature] -> Build TxIn++decodeSigInput :: SigInput -> [PrvKey] -> + Build (ScriptOutput, [PrvKey], [PubKey], BuildFunction)+decodeSigInput sigi keys = case sigi of+ SigInput s _ _ -> do+ out <- eitherToBuild $ decodeOutput s+ (vKeys,pubs) <- sigKeys out keys+ return (out,vKeys,pubs,buildTxIn)+ SigInputSH s _ sr _ -> do+ out <- eitherToBuild $ decodeOutput s+ rdm <- eitherToBuild $ decodeOutput sr+ (vKeys,pubs) <- sigKeysSH out rdm keys+ return (rdm,vKeys,pubs,buildTxInSH)++buildTxInSH :: BuildFunction+buildTxInSH txin tx rdm i pubs sigs = do+ s <- scriptInput <$> buildTxIn txin tx rdm i pubs sigs+ res <- either emptyIn return $ + encodeScriptHash . (flip ScriptHashInput rdm) <$> decodeInput s+ return txin{ scriptInput = res }+ where emptyIn = const $ Partial $ Script []++buildTxIn :: BuildFunction+buildTxIn txin tx out i pubs sigs + | null sigs = Partial txin{ scriptInput = Script [] }+ | otherwise = buildRes <$> case out of+ PayPK _ -> return $ SpendPK $ head sigs+ PayPKHash _ -> return $ SpendPKHash (head sigs) (head pubs)+ PayMulSig msPubs r -> do+ let mSigs = take r $ catMaybes $ matchTemplate aSigs msPubs f+ guardPartial $ length mSigs == r+ return $ SpendMulSig mSigs r+ _ -> Broken "buildTxIn: Can't sign a P2SH script here"+ where buildRes res = txin{ scriptInput = encodeInput res }+ aSigs = concat+ [ sigs + , case decodeScriptHash $ scriptInput txin of+ Right (ScriptHashInput (SpendMulSig xs _) _) -> xs+ _ -> case decodeInput $ scriptInput txin of+ Right (SpendMulSig xs _) -> xs+ _ -> []+ ]+ f (TxSignature sig sh) pub = + verifySig (txSigHash tx (encodeOutput out) i sh) sig pub++sigKeysSH :: ScriptOutput -> RedeemScript -> [PrvKey]+ -> Build ([PrvKey],[PubKey])+sigKeysSH out rdm keys = case out of+ PayScriptHash a -> if scriptAddr rdm == a+ then sigKeys rdm keys+ else Broken "sigKeys: Redeem script does not match P2SH script"+ _ -> Broken "sigKeys: Can only decode P2SH script here"++sigKeys :: ScriptOutput -> [PrvKey] -> Build ([PrvKey],[PubKey])+sigKeys out keys = unzip <$> case out of+ PayPK p -> return $ maybeToList $ + find ((== p) . snd) zipKeys+ PayPKHash a -> return $ maybeToList $ + find ((== a) . pubKeyAddr . snd) zipKeys+ PayMulSig ps r -> return $ take r $ + filter ((`elem` ps) . snd) zipKeys+ _ -> Broken "sigKeys: Can't decode P2SH here" + where zipKeys = zip keys $ map derivePubKey keys++{- Tx verification -}++verifyTx :: Tx -> [(Script,OutPoint)] -> Bool+verifyTx tx xs = flip all z3 $ \(maybeS,txin,i) -> fromMaybe False $ do+ (out,inp) <- maybeS >>= flip decodeVerifySigInput txin+ let so = encodeOutput out+ case (out,inp) of+ (PayPK pub,SpendPK (TxSignature sig sh)) -> + return $ verifySig (txSigHash tx so i sh) sig pub+ (PayPKHash a,SpendPKHash (TxSignature sig sh) pub) -> do+ guard $ pubKeyAddr pub == a+ return $ verifySig (txSigHash tx so i sh) sig pub+ (PayMulSig pubs r,SpendMulSig sigs _) ->+ (== r) <$> countMulSig tx so i pubs sigs + _ -> Nothing+ where m = map (fst <$>) $ matchTemplate xs (txIn tx) f+ f (_,o) txin = o == prevOutput txin+ z3 = zip3 m (txIn tx) [0..]+ +-- Count the number of valid signatures+countMulSig :: Tx -> Script -> Int -> [PubKey] -> [TxSignature] -> Maybe Int+countMulSig _ _ _ [] _ = return 0+countMulSig _ _ _ _ [] = return 0+countMulSig tx so i (pub:pubs) sigs@(TxSignature sig sh:rest)+ | verifySig (txSigHash tx so i sh) sig pub = + (+1) <$> countMulSig tx so i pubs rest+ | otherwise = countMulSig tx so i pubs sigs+ +decodeVerifySigInput :: Script -> TxIn -> Maybe (ScriptOutput, ScriptInput)+decodeVerifySigInput so (TxIn _ si _ ) = case decodeOutput so of+ Right (PayScriptHash a) -> do+ (ScriptHashInput inp rdm) <- eitherToMaybe $ decodeScriptHash si+ guard $ scriptAddr rdm == a+ return (rdm,inp)+ out -> eitherToMaybe $ liftM2 (,) out (decodeInput si)+
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ UNLICENSE view
@@ -0,0 +1,24 @@+This is free and unencumbered software released into the public domain.++Anyone is free to copy, modify, publish, use, compile, sell, or+distribute this software, either in source code form or as a compiled+binary, for any purpose, commercial or non-commercial, and by any+means.++In jurisdictions that recognize copyright laws, the author or authors+of this software dedicate any and all copyright interest in the+software to the public domain. We make this dedication for the benefit+of the public at large and to the detriment of our heirs and+successors. We intend this dedication to be an overt act of+relinquishment in perpetuity of all present and future rights to this+software under copyright law.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.+IN NO EVENT SHALL THE AUTHORS BE LIABLE FOR ANY CLAIM, DAMAGES OR+OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE,+ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR+OTHER DEALINGS IN THE SOFTWARE.++For more information, please refer to <http://unlicense.org/>
+ haskoin-wallet.cabal view
@@ -0,0 +1,126 @@+name: haskoin-wallet+version: 0.0.1+synopsis: + Implementation of a Bitcoin hierarchical deterministric wallet (BIP32).+description: + This package provides functions for generating hierarchical deterministic+ keys (BIP32). It also provides functions for building and signing both+ simple transactions and multisignature transactions. This package also+ provides a command lines application called hw (haskoin wallet). It is a+ lightweight bitcoin wallet featuring BIP32 key management, deterministic+ signatures (RFC-6979) and first order support for multisignature+ transactions. A library API for hw is also exposed.+homepage: http://github.com/plaprade/haskoin-wallet+bug-reports: http://github.com/plaprade/haskoin-wallet/issues+license: PublicDomain+license-file: UNLICENSE+author: Philippe Laprade+maintainer: plaprade+hackage@gmail.com+category: Bitcoin, Finance, Network+build-type: Simple+cabal-version: >= 1.9.2++source-repository head+ type: git+ location: git://github.com/plaprade/haskoin-wallet.git++library+ exposed-modules: Network.Haskoin.Wallet,+ Network.Haskoin.Wallet.Store,+ Network.Haskoin.Wallet.Arbitrary+ other-modules: Network.Haskoin.Wallet.Keys,+ Network.Haskoin.Wallet.Manager,+ Network.Haskoin.Wallet.TxBuilder,+ Network.Haskoin.Wallet.Store.DbAccount,+ Network.Haskoin.Wallet.Store.DbAddress,+ Network.Haskoin.Wallet.Store.DbCoin,+ Network.Haskoin.Wallet.Store.DbTx,+ Network.Haskoin.Wallet.Store.CoinStatus,+ Network.Haskoin.Wallet.Store.Util+ build-depends: base >= 4.6 && < 4.7, + binary >= 0.7 && < 0.8, + bytestring >= 0.10 && < 0.11, + mtl >= 2.1 && < 2.2,+ containers >= 0.5 && < 0.6,+ unordered-containers >= 0.2 && < 0.3,+ vector >= 0.10 && < 0.11,+ either >= 4.0 && < 4.1,+ text >= 0.11 && < 0.12,+ yaml >= 0.8 && < 0.9,+ time >= 1.4 && < 1.5,+ aeson >= 0.6 && < 0.7,+ aeson-pretty >= 0.7 && < 0.8,+ conduit >= 1.0 && < 1.1,+ persistent >= 1.2 && < 1.3,+ persistent-template >= 1.2 && < 1.3,+ persistent-sqlite >= 1.2 && < 1.3,+ haskoin-util >= 0.0 && < 0.1, + haskoin-crypto >= 0.0 && < 0.1, + haskoin-protocol >= 0.0 && < 0.1,+ haskoin-script >= 0.0 && < 0.1,+ QuickCheck >= 2.6 && < 2.7+ ghc-options: -Wall -fno-warn-orphans++executable hw+ main-is: hw.hs+ build-depends: base >= 4.6 && < 4.7, + binary >= 0.7 && < 0.8, + bytestring >= 0.10 && < 0.11, + mtl >= 2.1 && < 2.2,+ containers >= 0.5 && < 0.6,+ unordered-containers >= 0.2 && < 0.3,+ vector >= 0.10 && < 0.11,+ directory >= 1.2 && < 1.3,+ either >= 4.0 && < 4.1,+ text >= 0.11 && < 0.12,+ yaml >= 0.8 && < 0.9,+ time >= 1.4 && < 1.5,+ aeson >= 0.6 && < 0.7,+ aeson-pretty >= 0.7 && < 0.8,+ conduit >= 1.0 && < 1.1,+ persistent >= 1.2 && < 1.3,+ persistent-template >= 1.2 && < 1.3,+ persistent-sqlite >= 1.2 && < 1.3,+ haskoin-util >= 0.0 && < 0.1, + haskoin-crypto >= 0.0 && < 0.1, + haskoin-protocol >= 0.0 && < 0.1,+ haskoin-script >= 0.0 && < 0.1+ hs-source-dirs: . script+ ghc-options: -Wall -fno-warn-orphans++test-suite test-haskoin-wallet+ type: exitcode-stdio-1.0+ main-is: Main.hs+ other-modules: Network.Haskoin.Wallet.Tests,+ Network.Haskoin.Wallet.Store.Units,+ QuickCheckUtils,+ Units+ build-depends: base >= 4.6 && < 4.7, + binary >= 0.7 && < 0.8, + bytestring >= 0.10 && < 0.11, + mtl >= 2.1 && < 2.2,+ containers >= 0.5 && < 0.6,+ unordered-containers >= 0.2 && < 0.3,+ vector >= 0.10 && < 0.11,+ either >= 4.0 && < 4.1,+ text >= 0.11 && < 0.12,+ yaml >= 0.8 && < 0.9,+ time >= 1.4 && < 1.5,+ aeson >= 0.6 && < 0.7,+ aeson-pretty >= 0.7 && < 0.8,+ conduit >= 1.0 && < 1.1,+ persistent >= 1.2 && < 1.3,+ persistent-template >= 1.2 && < 1.3,+ persistent-sqlite >= 1.2 && < 1.3,+ haskoin-util >= 0.0 && < 0.1, + haskoin-crypto >= 0.0 && < 0.1, + haskoin-protocol >= 0.0 && < 0.1,+ haskoin-script >= 0.0 && < 0.1,+ QuickCheck >= 2.6 && < 2.7, + test-framework >= 0.8 && < 0.9, + test-framework-quickcheck2 >= 0.3 && < 0.4, + test-framework-hunit >= 0.3 && < 0.4, + HUnit >= 1.2 && < 1.3+ hs-source-dirs: . tests+ ghc-options: -Wall -fno-warn-orphans+
+ script/hw.hs view
@@ -0,0 +1,269 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE TypeFamilies #-}+module Main where++import System.Directory + ( getAppUserDataDirectory+ , createDirectoryIfMissing+ )+import System.IO.Error (ioeGetErrorString)+import System.Console.GetOpt + ( getOpt+ , usageInfo+ , OptDescr( Option )+ , ArgDescr( NoArg, ReqArg )+ , ArgOrder( Permute )+ )+import qualified System.Environment as E (getArgs)++import Control.Monad (forM_, join)+import Control.Monad.Trans (lift)+import Control.Monad.Trans.Either (EitherT, runEitherT, left)+import Control.Exception (tryJust)++import Database.Persist+ ( PersistStore+ , PersistUnique+ , PersistQuery+ , PersistMonadBackend+ )+import Database.Persist.Sql ()+import Database.Persist.Sqlite (SqlBackend, runSqlite, runMigration)++import qualified Data.Text as T (pack, unpack, splitOn)+import qualified Data.Yaml as YAML + ( Value(Null)+ , encode+ )+import qualified Data.Aeson.Encode.Pretty as JSON+ ( encodePretty'+ , defConfig+ , confIndent+ )++import Network.Haskoin.Wallet.Keys+import Network.Haskoin.Wallet.Store+import Network.Haskoin.Wallet.Store.Util+import Network.Haskoin.Script+import Network.Haskoin.Util+import Network.Haskoin.Util.Network++data Options = Options+ { optCount :: Int+ , optSigHash :: SigHash+ , optFee :: Int+ , optJson :: Bool+ , optHelp :: Bool+ , optVersion :: Bool+ } deriving (Eq, Show)++defaultOptions :: Options+defaultOptions = Options+ { optCount = 5+ , optSigHash = SigAll False+ , optFee = 10000+ , optJson = False+ , optHelp = False+ , optVersion = False+ } ++options :: [OptDescr (Options -> IO Options)]+options =+ [ Option ['c'] ["count"] (ReqArg parseCount "INT") $+ "Count: see commands for details"+ , Option ['s'] ["sighash"] (ReqArg parseSigHash "SIGHASH") $+ "Signature type = ALL|NONE|SINGLE"+ , Option ['a'] ["anyonecanpay"]+ (NoArg $ \opts -> do+ let sh = optSigHash opts+ return opts{ optSigHash = sh{ anyoneCanPay = True } }+ ) $ "Set signature flag AnyoneCanPay"+ , Option ['f'] ["fee"] (ReqArg parseCount "INT") $+ "Transaction fee (default: 10000)"+ , Option ['j'] ["json"]+ (NoArg $ \opts -> return opts{ optJson = True }) $+ "Format result as JSON (default: YAML)"+ , Option ['h'] ["help"]+ (NoArg $ \opts -> return opts{ optHelp = True }) $+ "Display this help message"+ , Option ['v'] ["version"]+ (NoArg $ \opts -> return opts{ optVersion = True }) $+ "Show version information"+ ]++parseCount :: String -> Options -> IO Options+parseCount s opts + | res > 0 = return opts{ optCount = res }+ | otherwise = error $ unwords ["Invalid count option:", s]+ where res = read s++parseSigHash :: String -> Options -> IO Options+parseSigHash s opts = return opts{ optSigHash = res }+ where acp = anyoneCanPay $ optSigHash opts+ res | s == "ALL" = SigAll acp+ | s == "NONE" = SigNone acp+ | s == "SINGLE" = SigSingle acp+ | otherwise = error "SigHash must be one of ALL|NONE|SINGLE"++usageHeader :: String+usageHeader = "Usage: hw [<options>] <command> [<args>]"++cmdHelp :: [String]+cmdHelp = + [ "hw wallet commands: " + , " init seed Initialize a wallet"+ , " list acc Display last page of addresses"+ , " listpage acc page [-c res/page] Display addresses by page"+ , " new acc {labels...} Generate address with labels"+ , " genaddr acc [-c count] Generate new addresses"+ , " label acc index label Add a label to an address"+ , " balance acc Display account balance"+ , " balances Display all balances"+ , " tx acc Display transactions"+ , " send acc addr amount Send coins to an address"+ , " sendmany acc {addr:amount...} Send coins to many addresses"+ , " newacc name Create a new account"+ , " newms name M N [pubkey...] Create a new multisig account"+ , " addkeys acc {pubkey...} Add pubkeys to a multisig account"+ , " accinfo acc Display account information"+ , " listacc List all accounts"+ , " dumpkeys acc Dump account keys to stdout"+ , " wif acc index Dump prvkey as WIF to stdout"+ , " coins acc List coins"+ , " allcoins List all coins per account"+ , " signtx acc tx Sign a transaction"+ , " importtx tx Import transaction"+ , " removetx txid Remove transaction"+ , ""+ , "hw utility commands: "+ , " decodetx tx Decode HEX transaction"+ , " buildrawtx"+ , " '[{\"txid\":txid,\"vout\":n},...]' '{addr:amnt,...}'"+ , " signrawtx " + , " tx" + , " " ++ sigdata+ , " '[prvkey,...]' [-s SigHash]" + ]+ where + sigdata = concat+ [ "'[{"+ , "\"txid\":txid,"+ , "\"vout\":n,"+ , "\"scriptPubKey\":hex,"+ , "\"scriptRedeem\":hex"+ , "},...]'"+ ]++warningMsg :: String+warningMsg = unwords [ "***"+ , "This software is experimental."+ , "Use only small amounts of Bitcoins"+ , "***"+ ]++versionMsg :: String+versionMsg = "haskoin wallet version 0.0.1"++usage :: String+usage = unlines $ [warningMsg, usageInfo usageHeader options] ++ cmdHelp++formatStr :: String -> IO ()+formatStr str = forM_ (lines str) putStrLn++main :: IO ()+main = E.getArgs >>= \args -> case getOpt Permute options args of+ (o,xs,[]) -> do+ opts <- foldl (>>=) (return defaultOptions) o+ process opts xs+ (_,_,msgs) -> print $ unlines $ msgs ++ [usage]++-- Create and return haskoin working directory+getWorkDir :: IO FilePath+getWorkDir = do+ dir <- getAppUserDataDirectory "haskoin"+ createDirectoryIfMissing True dir+ return $ concat [dir, "/", walletFile]++catchEx :: IOError -> Maybe String+catchEx = return . ioeGetErrorString++process :: Options -> [String] -> IO ()+process opts xs + -- -h and -v can be called without a command+ | optHelp opts = formatStr usage+ | optVersion opts = print versionMsg+ -- otherwise require a command+ | null xs = formatStr usage+ | otherwise = getWorkDir >>= \dir -> do+ let (cmd,args) = (head xs, tail xs)+ res <- tryJust catchEx $ runSqlite (T.pack dir) $ runEitherT $ do+ lift $ runMigration migrateAll+ dispatchCommand cmd opts args + case join res of+ Left err -> formatStr err+ Right val -> if val == YAML.Null then return () else if optJson opts + then formatStr $ bsToString $ toStrictBS $ + JSON.encodePretty' JSON.defConfig{ JSON.confIndent = 2 } val+ else formatStr $ bsToString $ YAML.encode val++type Command m = EitherT String m YAML.Value+type Args = [String]++whenArgs :: Monad m => Args -> (Int -> Bool) -> Command m -> Command m+whenArgs args f cmd = if f $ length args then cmd else argErr+ where argErr = left "Invalid number of arguments"++dispatchCommand :: ( PersistStore m, PersistUnique m, PersistQuery m+ , PersistMonadBackend m ~ SqlBackend+ ) + => String -> Options -> Args -> Command m+dispatchCommand cmd opts args = case cmd of+ "init" -> whenArgs args (== 1) $ cmdInit $ head args+ "list" -> whenArgs args (== 1) $ cmdList (head args) 0 (optCount opts)+ "listpage" -> whenArgs args (== 2) $ + cmdList (head args) (read $ args !! 1) (optCount opts)+ "new" -> whenArgs args (>= 2) $ cmdGenWithLabel (head args) $ drop 1 args+ "genaddr" -> whenArgs args (== 1) $ cmdGenAddrs (head args) (optCount opts)+ "label" -> whenArgs args (== 3) $ + cmdLabel (head args) (read $ args !! 1) (args !! 2)+ "balance" -> whenArgs args (== 1) $ cmdBalance $ head args+ "balances" -> whenArgs args (== 0) cmdBalances+ "tx" -> whenArgs args (== 1) $ cmdListTx $ head args+ "send" -> whenArgs args (== 3) $ + cmdSend (head args) (args !! 1) (read $ args !! 2) (optFee opts)+ "sendmany" -> whenArgs args (>= 2) $ do+ let f [a,b] = (T.unpack a,read $ T.unpack b)+ f _ = error "sendmany: Invalid format addr:amount"+ dests = map (f . (T.splitOn (T.pack ":")) . T.pack) $ drop 1 args+ cmdSendMany (head args) dests (optFee opts)+ "newacc" -> whenArgs args (== 1) $ cmdNewAcc $ head args+ "newms" -> whenArgs args (>= 3) $ do+ keys <- liftMaybe "newms: Invalid keys" $ mapM xPubImport $ drop 3 args+ cmdNewMS (args !! 0) (read $ args !! 1) (read $ args !! 2) keys+ "addkeys" -> whenArgs args (>= 2) $ do+ keys <- liftMaybe "newms: Invalid keys" $ mapM xPubImport $ drop 1 args+ cmdAddKeys (head args) keys+ "accinfo" -> whenArgs args (== 1) $ cmdAccInfo $ head args+ "listacc" -> whenArgs args (== 0) cmdListAcc + "dumpkeys" -> whenArgs args (== 1) $ cmdDumpKeys $ head args+ "wif" -> whenArgs args (== 2) $ cmdWIF (head args) (read $ args !! 1)+ "coins" -> whenArgs args (== 1) $ cmdCoins $ head args+ "allcoins" -> whenArgs args (== 0) cmdAllCoins+ "signtx" -> whenArgs args (== 2) $ do+ bs <- liftMaybe "signtx: Invalid HEX encoding" $ hexToBS $ args !! 1+ tx <- liftEither $ decodeToEither bs+ cmdSignTx (head args) tx (optSigHash opts)+ "importtx" -> whenArgs args (== 1) $ do+ bs <- liftMaybe "signtx: Invalid HEX encoding" $ hexToBS $ head args+ tx <- liftEither $ decodeToEither bs+ cmdImportTx tx+ "removetx" -> whenArgs args (== 1) $ cmdRemoveTx $ head args+ "decodetx" -> whenArgs args (== 1) $ cmdDecodeTx $ head args+ "buildrawtx" -> whenArgs args (== 2) $ cmdBuildRawTx (head args) (args !! 1)+ "signrawtx" -> whenArgs args (== 3) $ do + bs <- liftMaybe "signtx: Invalid HEX encoding" $ hexToBS $ head args+ tx <- liftEither $ decodeToEither bs+ cmdSignRawTx tx (args !! 1) (args !! 2) (optSigHash opts)+ _ -> left $ unwords ["Invalid command:", cmd]+
+ tests/Main.hs view
@@ -0,0 +1,15 @@+module Main where++import Test.Framework (defaultMain)++import qualified Network.Haskoin.Wallet.Tests (tests)+import qualified Network.Haskoin.Wallet.Store.Units (tests)+import qualified Units (tests)++main :: IO ()+main = defaultMain+ ( Network.Haskoin.Wallet.Tests.tests + ++ Network.Haskoin.Wallet.Store.Units.tests+ ++ Units.tests + )+
+ tests/Network/Haskoin/Wallet/Store/Units.hs view
@@ -0,0 +1,2548 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE TypeFamilies #-}+module Network.Haskoin.Wallet.Store.Units (tests) where++import Test.HUnit (Assertion, assertBool, assertEqual)+import Test.Framework (Test, testGroup)+import Test.Framework.Providers.HUnit (testCase)++import Control.Applicative ((<$>))+import Control.Monad.Trans (liftIO, lift)+import Control.Monad.Trans.Either (EitherT, runEitherT)++import Data.Maybe (fromJust, isJust)+import Data.Yaml as YAML+ ( Value+ , object + , toJSON+ , (.=)+ )+import qualified Data.Text as T (pack)++import Database.Persist + ( PersistStore+ , PersistUnique+ , PersistQuery+ , PersistMonadBackend+ , Entity(..)+ , entityVal+ , getBy+ , selectList+ , count+ , (==.)+ , Filter+ , SelectOpt(Asc)+ )+import Database.Persist.Sqlite (SqlBackend, runSqlite, runMigration)++import Network.Haskoin.Wallet+import Network.Haskoin.Wallet.Store+import Network.Haskoin.Wallet.Store.DbAddress+import Network.Haskoin.Wallet.Store.DbAccount+import Network.Haskoin.Wallet.Store.Util+import Network.Haskoin.Script+import Network.Haskoin.Util++tests :: [Test]+tests =+ [ testGroup "Wallet persistence tests" + [ testCase "Wallet tests" runTests+ ] + ]++runTests :: Assertion+runTests = do+ _ <- runSqlite ":memory:" $ runEitherT $ do+ lift $ runMigration migrateAll+ liftIO . (assertBool "Pre init") . isRight =<< runEitherT testPreInit+ liftIO . (assertBool "Init") . isRight =<< runEitherT testInit+ liftIO . (assertBool "New Acc") . isRight =<< runEitherT testNewAcc+ liftIO . (assertBool "New MS") . isRight =<< runEitherT testNewMS+ liftIO . (assertBool "Gen Addr") . isRight =<< runEitherT testGenAddr+ liftIO . (assertBool "Import Tx") . isRight =<< runEitherT testImport+ liftIO . (assertBool "Orphan Tx") . isRight =<< runEitherT testOrphan+ liftIO . (assertBool "Send Tx") . isRight =<< runEitherT testSend+ liftIO . (assertBool "Utilities") . isRight =<< runEitherT testUtil+ return ()++testPreInit :: (PersistStore m, PersistUnique m, PersistQuery m) + => EitherT String m ()+testPreInit = do + -- Creating a new account without initializing the wallet should fail+ runEitherT (cmdNewAcc "default") >>= + liftIO . assertEqual "Invalid wallet" + (Left "dbGetWallet: Invalid wallet main")++ -- Listing addresses without initializing the wallet should fail+ runEitherT (cmdList "default" 0 1) >>= + liftIO . assertEqual "Invalid account" + (Left "dbGetAcc: Invalid account default")++ -- Displaying page numbe -1 should fail+ runEitherT (cmdList "default" (-1) 1) >>= + liftIO . assertEqual "Invalid page number" + (Left "cmdList: Invalid page number -1")++ -- Displaying 0 results per page should fail+ runEitherT (cmdList "default" 0 0) >>= + liftIO . assertEqual "Invalid results per page" + (Left "cmdList: Invalid results per page 0")++testInit :: (PersistStore m, PersistUnique m, PersistQuery m) + => EitherT String m ()+testInit = do ++ -- Initializing the wallet with an empty seed should fail+ runEitherT (cmdInit "") >>= liftIO . assertEqual "Init empty seed" + (Left "cmdInit: seed can not be empty") ++ -- Initialize wallet with seed "Hello World"+ _ <- cmdInit "Hello World" ++ walletE <- getBy $ UniqueWalletName "main"+ + -- Get the "main" wallet from the database+ liftIO $ assertBool "Wallet init" $ isJust walletE++ let (Entity _ w) = fromJust walletE+ key = fromJust $ makeMasterKey $ stringToBS "Hello World"+ keystr = xPrvExport $ masterKey key++ -- Check wallet master key+ liftIO $ assertEqual "Wallet master key" keystr $ dbWalletMaster w++ -- Check wallet name+ liftIO $ assertEqual "Wallet name" "main" $ dbWalletName w++ -- Generate addresses on an invalid account should fail+ runEitherT (cmdGenAddrs "default" 5) >>= liftIO . + assertEqual "Invalid account" + (Left "dbGetAcc: Invalid account default") ++ -- Address count in the database should be 0 at this point+ count ([] :: [Filter (DbAddressGeneric b)]) >>= + liftIO . assertEqual "Address count" 0++testNewAcc :: (PersistStore m, PersistUnique m, PersistQuery m) + => EitherT String m ()+testNewAcc = do ++ -- Create a new account with empty name ""+ cmdNewAcc "" >>= liftIO . assertEqual "New acc 1"+ ( object + [ "Name" .= T.pack ""+ , "Tree" .= T.pack "m/0'/"+ , "Type" .= T.pack "Regular"+ ] + )++ -- Check the wallet account index+ (dbWalletAccIndex . entityVal <$> dbGetWallet "main") >>= + liftIO . assertEqual "acc index 0" 0++ -- Create a new account named "acc1"+ cmdNewAcc "acc1" >>= liftIO . assertEqual "New acc 2"+ ( object + [ "Name" .= T.pack "acc1"+ , "Tree" .= T.pack "m/1'/"+ , "Type" .= T.pack "Regular"+ ] + )++ -- Check the wallet account index+ (dbWalletAccIndex . entityVal <$> dbGetWallet "main") >>= + liftIO . assertEqual "acc index 1" 1++ -- Create a new account named "acc2"+ cmdNewAcc "acc2" >>= liftIO . assertEqual "New acc 3"+ ( object + [ "Name" .= T.pack "acc2"+ , "Tree" .= T.pack "m/2'/"+ , "Type" .= T.pack "Regular"+ ] + )++ -- Check the wallet account index+ (dbWalletAccIndex . entityVal <$> dbGetWallet "main") >>= + liftIO . assertEqual "acc index 2" 2++ -- List all accounts created up to now+ cmdListAcc >>= liftIO . assertEqual "List accs"+ ( toJSON+ [ object + [ "Name" .= T.pack ""+ , "Tree" .= T.pack "m/0'/"+ , "Type" .= T.pack "Regular"+ ] + , object + [ "Name" .= T.pack "acc1"+ , "Tree" .= T.pack "m/1'/"+ , "Type" .= T.pack "Regular"+ ] + , object + [ "Name" .= T.pack "acc2"+ , "Tree" .= T.pack "m/2'/"+ , "Type" .= T.pack "Regular"+ ] + ]+ )++ -- Initialize some keys for future tests+ let mstKey = fromJust $ makeMasterKey $ stringToBS "Hello World"+ prvKey = getAccPrvKey $ fromJust $ accPrvKey mstKey 1+ pubKey = deriveXPubKey prvKey+ + -- Dump keys for account "acc1"+ cmdDumpKeys "acc1" >>= liftIO . assertEqual "Dump keys"+ ( object + [ "Account" .= object + [ "Name" .= T.pack "acc1"+ , "Tree" .= T.pack "m/1'/"+ , "Type" .= T.pack "Regular"+ ] + , "PubKey" .= xPubExport pubKey+ , "PrvKey" .= xPrvExport prvKey+ ]+ )++ -- Display account information for account "acc2"+ cmdAccInfo "acc2" >>= liftIO . assertEqual "Acc info" + ( object + [ "Name" .= T.pack "acc2"+ , "Tree" .= T.pack "m/2'/"+ , "Type" .= T.pack "Regular"+ ] + )++ -- Count accounts in the database created up to now+ count ([] :: [Filter (DbAccountGeneric b)]) >>= + liftIO . assertEqual "Acc count" 3++ -- Check that address-related data and gaps are correct+ (Entity a1 acc1) <- dbGetAcc ""+ (Entity a2 acc2) <- dbGetAcc "acc1"+ (Entity a3 acc3) <- dbGetAcc "acc2"++ count [DbAddressAccount ==. a1, DbAddressInternal ==. True] >>=+ liftIO . assertEqual "Int gap address count" 30++ count [DbAddressAccount ==. a1, DbAddressInternal ==. False] >>=+ liftIO . assertEqual "Ext gap address count" 30++ count [DbAddressAccount ==. a2, DbAddressInternal ==. True] >>=+ liftIO . assertEqual "Int gap address count 2" 30++ count [DbAddressAccount ==. a2, DbAddressInternal ==. False] >>=+ liftIO . assertEqual "Ext gap address count 2" 30++ count [DbAddressAccount ==. a3, DbAddressInternal ==. True] >>=+ liftIO . assertEqual "Int gap address count 3" 30++ count [DbAddressAccount ==. a3, DbAddressInternal ==. False] >>=+ liftIO . assertEqual "Ext gap address count 3" 30++ liftIO $ assertEqual "ExtIndex acc 1" (-1) (dbAccountExtIndex acc1)+ liftIO $ assertEqual "IntIndex acc 1" (-1) (dbAccountIntIndex acc1)+ liftIO $ assertEqual "ExtGap acc 1" 29 (dbAccountExtGap acc1)+ liftIO $ assertEqual "IntGap acc 1" 29 (dbAccountIntGap acc1)++ liftIO $ assertEqual "ExtIndex acc 2" (-1) (dbAccountExtIndex acc2)+ liftIO $ assertEqual "IntIndex acc 2" (-1) (dbAccountIntIndex acc2)+ liftIO $ assertEqual "ExtGap acc 2" 29 (dbAccountExtGap acc2)+ liftIO $ assertEqual "IntGap acc 2" 29 (dbAccountIntGap acc2)++ liftIO $ assertEqual "ExtIndex acc 3" (-1) (dbAccountExtIndex acc3)+ liftIO $ assertEqual "IntIndex acc 3" (-1) (dbAccountIntIndex acc3)+ liftIO $ assertEqual "ExtGap acc 3" 29 (dbAccountExtGap acc3)+ liftIO $ assertEqual "IntGap acc 3" 29 (dbAccountIntGap acc3)++ cmdList "" 0 5 >>= liftIO . assertEqual "check empty addrs 1"+ ( object+ [ "Addresses" .= toJSON ([] :: [Value])+ , "Page results" .= object+ [ "Current page" .= (1 :: Int)+ , "Results per page" .= (5 :: Int)+ , "Total pages" .= (1 :: Int)+ , "Total addresses" .= (0 :: Int)+ ]+ ]+ )++ cmdList "acc1" 0 5 >>= liftIO . assertEqual "check empty addrs 2"+ ( object+ [ "Addresses" .= toJSON ([] :: [Value])+ , "Page results" .= object+ [ "Current page" .= (1 :: Int)+ , "Results per page" .= (5 :: Int)+ , "Total pages" .= (1 :: Int)+ , "Total addresses" .= (0 :: Int)+ ]+ ]+ )++ cmdList "acc2" 0 5 >>= liftIO . assertEqual "check empty addrs 3"+ ( object+ [ "Addresses" .= toJSON ([] :: [Value])+ , "Page results" .= object+ [ "Current page" .= (1 :: Int)+ , "Results per page" .= (5 :: Int)+ , "Total pages" .= (1 :: Int)+ , "Total addresses" .= (0 :: Int)+ ]+ ]+ )+ ++testNewMS :: (PersistStore m, PersistUnique m, PersistQuery m) + => EitherT String m ()+testNewMS = do ++ -- Creating invalid multisig accounts should fail+ runEitherT (cmdNewMS "ms1" (-1) 0 []) >>= liftIO . assertEqual "Invalid ms 1"+ (Left "cmdNewMS: Invalid multisig parameters")++ -- Creating invalid multisig accounts should fail+ runEitherT (cmdNewMS "ms1" 0 (-1) []) >>= liftIO . assertEqual "Invalid ms 2"+ (Left "cmdNewMS: Invalid multisig parameters")++ -- Creating invalid multisig accounts should fail+ runEitherT (cmdNewMS "ms1" 0 0 []) >>= liftIO . assertEqual "Invalid ms 3"+ (Left "cmdNewMS: Invalid multisig parameters")++ -- Creating invalid multisig accounts should fail+ runEitherT (cmdNewMS "ms1" 0 3 []) >>= liftIO . assertEqual "Invalid ms 4"+ (Left "cmdNewMS: Invalid multisig parameters")++ -- Creating invalid multisig accounts should fail+ runEitherT (cmdNewMS "ms1" 3 0 []) >>= liftIO . assertEqual "Invalid ms 5"+ (Left "cmdNewMS: Invalid multisig parameters")++ -- Creating invalid multisig accounts should fail+ runEitherT (cmdNewMS "ms1" 3 17 []) >>= liftIO . assertEqual "Invalid ms 6"+ (Left "cmdNewMS: Invalid multisig parameters")++ -- Creating invalid multisig accounts should fail+ runEitherT (cmdNewMS "ms1" 17 3 []) >>= liftIO . assertEqual "Invalid ms 7"+ (Left "cmdNewMS: Invalid multisig parameters")++ -- Creating invalid multisig accounts should fail+ runEitherT (cmdNewMS "ms1" 3 2 []) >>= liftIO . assertEqual "Invalid ms 8"+ (Left "cmdNewMS: Invalid multisig parameters")++ -- Create a new 2 of 3 multisig account name "ms1"+ cmdNewMS "ms1" 2 3 [] >>= liftIO . assertEqual "New ms 1" + ( object + [ "Name" .= T.pack "ms1"+ , "Tree" .= T.pack "m/3'/"+ , "Type" .= T.pack "Multisig 2 of 3"+ , "Warning" .= T.pack "2 multisig keys missing"+ ] + )++ -- Check the wallet account index+ (dbWalletAccIndex . entityVal <$> dbGetWallet "main") >>= + liftIO . assertEqual "acc index 3" 3++ -- Display account information for account "ms1"+ cmdAccInfo "ms1" >>= liftIO . assertEqual "MS info"+ ( object + [ "Name" .= T.pack "ms1"+ , "Tree" .= T.pack "m/3'/"+ , "Type" .= T.pack "Multisig 2 of 3"+ , "Warning" .= T.pack "2 multisig keys missing"+ ] + )++ -- List all accounts created up to now (include the "ms1")+ cmdListAcc >>= liftIO . assertEqual "List accs"+ ( toJSON+ [ object + [ "Name" .= T.pack ""+ , "Tree" .= T.pack "m/0'/"+ , "Type" .= T.pack "Regular"+ ] + , object + [ "Name" .= T.pack "acc1"+ , "Tree" .= T.pack "m/1'/"+ , "Type" .= T.pack "Regular"+ ] + , object + [ "Name" .= T.pack "acc2"+ , "Tree" .= T.pack "m/2'/"+ , "Type" .= T.pack "Regular"+ ] + , object + [ "Name" .= T.pack "ms1"+ , "Tree" .= T.pack "m/3'/"+ , "Type" .= T.pack "Multisig 2 of 3"+ , "Warning" .= T.pack "2 multisig keys missing"+ ] + ]+ )++ -- Initialize some keys for the next tests+ let mstKey = fromJust $ makeMasterKey $ stringToBS "Hello World"+ mstKey2 = fromJust $ makeMasterKey $ stringToBS "Hello World 2"+ prvs = map (getAccPrvKey . fst) $ accPrvKeys mstKey 0+ pubs = map deriveXPubKey prvs+ prvs2 = map (getAccPrvKey . fst) $ accPrvKeys mstKey2 0+ pubs2 = map deriveXPubKey prvs2++ -- Count the number of accounts in the database+ count ([] :: [Filter (DbAccountGeneric b)]) >>= + liftIO . assertEqual "MS count" 4++ -- Adding empty key list should fail+ runEitherT (cmdAddKeys "ms1" []) >>= liftIO . assertEqual "Empty addKey"+ (Left "dbAddKeys: Keys can not be empty")++ -- Adding keys to a non-multisig account should fail+ runEitherT (cmdAddKeys "acc1" [pubs !! 0]) >>= + liftIO . assertEqual "Invalid addKey 1" + (Left "dbAddKeys: Can only add keys to a multisig account")++ -- Adding your own keys to a multisig account should fail+ runEitherT (cmdAddKeys "ms1" [pubs !! 0]) >>=+ liftIO . assertEqual "Invalid addKey 2" + (Left "dbAddKeys: Can not add your own keys to a multisig account")++ -- Adding your own keys to a multisig account should fail+ runEitherT (cmdAddKeys "ms1" [pubs2 !! 0,pubs !! 1]) >>=+ liftIO . assertEqual "Invalid addKey 3" + (Left "dbAddKeys: Can not add your own keys to a multisig account")+ + -- Adding too many keys to a multisig account should fail+ runEitherT (cmdAddKeys "ms1" $ take 4 pubs2) >>=+ liftIO . assertEqual "Invalid addKey 4" + (Left "dbAddKeys: Too many keys")++ -- Display account information for account "ms1". Shold not have changed+ cmdAccInfo "ms1" >>= liftIO . assertEqual "MS info 2"+ ( object + [ "Name" .= T.pack "ms1"+ , "Tree" .= T.pack "m/3'/"+ , "Type" .= T.pack "Multisig 2 of 3"+ , "Warning" .= T.pack "2 multisig keys missing"+ ] + )+ + -- Check that address-related data and gaps are correct+ (Entity a1 acc1) <- dbGetAcc "ms1"++ count [DbAddressAccount ==. a1, DbAddressInternal ==. True] >>=+ liftIO . assertEqual "Int gap address count MS 1" 0++ count [DbAddressAccount ==. a1, DbAddressInternal ==. False] >>=+ liftIO . assertEqual "Ext gap address count MS 1" 0++ liftIO $ assertEqual "ExtIndex acc MS" (-1) (dbAccountExtIndex acc1)+ liftIO $ assertEqual "IntIndex acc MS" (-1) (dbAccountIntIndex acc1)+ liftIO $ assertEqual "ExtGap acc MS" (-1) (dbAccountExtGap acc1)+ liftIO $ assertEqual "IntGap acc MS" (-1) (dbAccountIntGap acc1)++ cmdList "ms1" 0 5 >>= liftIO . assertEqual "check empty addrs MS 1"+ ( object+ [ "Addresses" .= toJSON ([] :: [Value])+ , "Page results" .= object+ [ "Current page" .= (1 :: Int)+ , "Results per page" .= (5 :: Int)+ , "Total pages" .= (1 :: Int)+ , "Total addresses" .= (0 :: Int)+ ]+ ]+ )++ -- Adding a key to the multisig account "ms1". One should still be missing+ cmdAddKeys "ms1" [pubs2 !! 0] >>= liftIO . assertEqual "MS addkey 1"+ ( object + [ "Name" .= T.pack "ms1"+ , "Tree" .= T.pack "m/3'/"+ , "Type" .= T.pack "Multisig 2 of 3"+ , "Warning" .= T.pack "1 multisig keys missing"+ ] + )++ -- Dump the keys of account "ms1". One account should be listed under MSKeys+ cmdDumpKeys "ms1" >>= liftIO . assertEqual "MS dumpkey 2" + ( object + [ "Account" .= object + [ "Name" .= T.pack "ms1"+ , "Tree" .= T.pack "m/3'/"+ , "Type" .= T.pack "Multisig 2 of 3"+ , "Warning" .= T.pack "1 multisig keys missing"+ ] + , "PubKey" .= (xPubExport $ pubs !! 3)+ , "PrvKey" .= (xPrvExport $ prvs !! 3)+ , "MSKeys" .= toJSON [xPubExport $ pubs2 !! 0]+ ]+ )++ -- Check that address-related data and gaps are correct+ (Entity a2 acc2) <- dbGetAcc "ms1"++ count [DbAddressAccount ==. a2, DbAddressInternal ==. True] >>=+ liftIO . assertEqual "Int gap address count MS 2" 0++ count [DbAddressAccount ==. a2, DbAddressInternal ==. False] >>=+ liftIO . assertEqual "Ext gap address count MS 2" 0++ liftIO $ assertEqual "ExtIndex acc MS 2" (-1) (dbAccountExtIndex acc2)+ liftIO $ assertEqual "IntIndex acc MS 2" (-1) (dbAccountIntIndex acc2)+ liftIO $ assertEqual "ExtGap acc MS 2" (-1) (dbAccountExtGap acc2)+ liftIO $ assertEqual "IntGap acc MS 2" (-1) (dbAccountIntGap acc2)++ cmdList "ms1" 0 5 >>= liftIO . assertEqual "check empty addrs MS 2"+ ( object+ [ "Addresses" .= toJSON ([] :: [Value])+ , "Page results" .= object+ [ "Current page" .= (1 :: Int)+ , "Results per page" .= (5 :: Int)+ , "Total pages" .= (1 :: Int)+ , "Total addresses" .= (0 :: Int)+ ]+ ]+ )++ -- Add second key to account "ms1". Account should be complete now+ cmdAddKeys "ms1" [pubs2 !! 1] >>= liftIO . assertEqual "MS addkey 2" + ( object + [ "Name" .= T.pack "ms1"+ , "Tree" .= T.pack "m/3'/"+ , "Type" .= T.pack "Multisig 2 of 3"+ ] + )++ -- Dumping "ms1" keys should now display all keys+ cmdDumpKeys "ms1" >>= liftIO . assertEqual "MS dumpkey 2" + ( object + [ "Account" .= object + [ "Name" .= T.pack "ms1"+ , "Tree" .= T.pack "m/3'/"+ , "Type" .= T.pack "Multisig 2 of 3"+ ] + , "PubKey" .= (xPubExport $ pubs !! 3)+ , "PrvKey" .= (xPrvExport $ prvs !! 3)+ , "MSKeys" .= toJSON [ xPubExport $ pubs2 !! 0+ , xPubExport $ pubs2 !! 1+ ]+ ]+ )++ -- Check that address-related data and gaps are correct+ (Entity a3 acc3) <- dbGetAcc "ms1"++ count [DbAddressAccount ==. a3, DbAddressInternal ==. True] >>=+ liftIO . assertEqual "Int gap address count MS 3" 30++ count [DbAddressAccount ==. a3, DbAddressInternal ==. False] >>=+ liftIO . assertEqual "Ext gap address count MS 3" 30++ liftIO $ assertEqual "ExtIndex acc MS 3" (-1) (dbAccountExtIndex acc3)+ liftIO $ assertEqual "IntIndex acc MS 3" (-1) (dbAccountIntIndex acc3)+ liftIO $ assertEqual "ExtGap acc MS 3" 29 (dbAccountExtGap acc3)+ liftIO $ assertEqual "IntGap acc MS 3" 29 (dbAccountIntGap acc3)++ cmdList "ms1" 0 5 >>= liftIO . assertEqual "check empty addrs MS 3"+ ( object+ [ "Addresses" .= toJSON ([] :: [Value])+ , "Page results" .= object+ [ "Current page" .= (1 :: Int)+ , "Results per page" .= (5 :: Int)+ , "Total pages" .= (1 :: Int)+ , "Total addresses" .= (0 :: Int)+ ]+ ]+ )++ -- Adding another key now should fail as the account "ms1" is complete+ runEitherT (cmdAddKeys "ms1" [pubs2 !! 2]) >>=+ liftIO . assertEqual "Invalid addKey 5" + (Left "dbAddKeys: Account is complete. No more keys can be added")++testGenAddr :: (PersistStore m, PersistUnique m, PersistQuery m) + => EitherT String m ()+testGenAddr = do ++ -- List addresses from an empty account+ cmdList "" 0 5 >>= liftIO . assertEqual "list empty addr" + ( object+ [ "Addresses" .= toJSON ([] :: [Value])+ , "Page results" .= object+ [ "Current page" .= (1 :: Int)+ , "Results per page" .= (5 :: Int)+ , "Total pages" .= (1 :: Int)+ , "Total addresses" .= (0 :: Int)+ ]+ ]+ )++ -- Generate 5 addresses on the account "" (empty string)+ cmdGenAddrs "" 5 >>= liftIO . assertEqual "gen addr"+ ( toJSON + [ object [ "Addr" .= T.pack "1LaPZtFWAWRP8eLNZRLLPGaB3dn19Nb6wi"+ , "Key" .= (0 :: Int)+ , "Tree" .= T.pack "m/0'/0/0/"+ ]+ , object [ "Addr" .= T.pack "1NkXvbrHPGC2vjtmL2mup1sWi2TU8LW6XB"+ , "Key" .= (1 :: Int)+ , "Tree" .= T.pack "m/0'/0/1/"+ ]+ , object [ "Addr" .= T.pack "1AZimU5FfTQyF4GMsEKLZ32773TtPKczdY"+ , "Key" .= (2 :: Int)+ , "Tree" .= T.pack "m/0'/0/2/"+ ]+ , object [ "Addr" .= T.pack "1Erwcuqn1dHm8r6fNxogGmCHYuNfwKNwer"+ , "Key" .= (3 :: Int)+ , "Tree" .= T.pack "m/0'/0/3/"+ ]+ , object [ "Addr" .= T.pack "18aT8MJ15VV26nx29xmbu5fzvqE6sqh6i9"+ , "Key" .= (4 :: Int)+ , "Tree" .= T.pack "m/0'/0/4/"+ ]+ ]+ )++ -- Check account external index+ (dbAccountExtIndex . entityVal <$> dbGetAcc "") >>= + liftIO . assertEqual "acc ext index" 4++ -- Check account internal index+ (dbAccountIntIndex . entityVal <$> dbGetAcc "") >>= + liftIO . assertEqual "acc int index" (-1)++ -- Check account external gap+ (dbAccountExtGap . entityVal <$> dbGetAcc "") >>= + liftIO . assertEqual "acc ext gap" 34++ -- Check account internal gap+ (dbAccountIntGap . entityVal <$> dbGetAcc "") >>= + liftIO . assertEqual "acc int gap" 29++ -- Count all addresses in the Address table+ -- 60*4 + 5+ count ([] :: [Filter (DbAddressGeneric b)]) >>= + liftIO . assertEqual "Count addr" 245++ let f x = (dbAddressBase58 x,dbAddressTree x,dbAddressIndex x)+ (map f <$> dbGenIntAddrs "" 4) >>= liftIO . assertEqual "Internal addr"+ [ ("19RtLtmuuxscgg5TXkCsSJ7bCdEzci5XTm","m/0'/1/0/",0)+ , ("1E75f3kuDanTHeTa8nvJCxYF8MXaud4QPE","m/0'/1/1/",1)+ , ("1NXkqUpqM23p6u44nAhoP1wVd2BdCEr4Zm","m/0'/1/2/",2)+ , ("1AjBQfprusZGGnD4jCmexizJxKBcAw4cdc","m/0'/1/3/",3)+ ]++ -- Check account external index+ (dbAccountExtIndex . entityVal <$> dbGetAcc "") >>= + liftIO . assertEqual "acc ext index 2" 4++ -- Check account internal index+ (dbAccountIntIndex . entityVal <$> dbGetAcc "") >>= + liftIO . assertEqual "acc int index" 3++ -- Check account external gap+ (dbAccountExtGap . entityVal <$> dbGetAcc "") >>= + liftIO . assertEqual "acc ext gap" 34++ -- Check account internal gap+ (dbAccountIntGap . entityVal <$> dbGetAcc "") >>= + liftIO . assertEqual "acc int gap" 33++ -- Count all addresses in the Address table+ -- 60*4 + 5+ count ([] :: [Filter (DbAddressGeneric b)]) >>= + liftIO . assertEqual "Count addr" 249++ -- List addresses from the ms1 account. Should be empty+ cmdList "ms1" 0 5 >>= liftIO . assertEqual "list empty addr 2"+ ( object+ [ "Addresses" .= toJSON ([] :: [Value])+ , "Page results" .= object+ [ "Current page" .= (1 :: Int)+ , "Results per page" .= (5 :: Int)+ , "Total pages" .= (1 :: Int)+ , "Total addresses" .= (0 :: Int)+ ]+ ]+ )++ -- List page 1 with 1 result per page+ cmdList "" 1 1 >>= liftIO . assertEqual "list addr 1"+ ( object + [ "Addresses" .= toJSON + [ object [ "Addr" .= T.pack "1LaPZtFWAWRP8eLNZRLLPGaB3dn19Nb6wi"+ , "Key" .= (0 :: Int)+ , "Tree" .= T.pack "m/0'/0/0/"+ ]+ ]+ , "Page results" .= object+ [ "Current page" .= (1 :: Int)+ , "Results per page" .= (1 :: Int)+ , "Total pages" .= (5 :: Int)+ , "Total addresses" .= (5 :: Int)+ ]+ ]+ )++ -- List page 2 with 1 result per page+ cmdList "" 2 1 >>= liftIO . assertEqual "list addr 2"+ ( object + [ "Addresses" .= toJSON + [ object [ "Addr" .= T.pack "1NkXvbrHPGC2vjtmL2mup1sWi2TU8LW6XB"+ , "Key" .= (1 :: Int)+ , "Tree" .= T.pack "m/0'/0/1/"+ ]+ ]+ , "Page results" .= object+ [ "Current page" .= (2 :: Int)+ , "Results per page" .= (1 :: Int)+ , "Total pages" .= (5 :: Int)+ , "Total addresses" .= (5 :: Int)+ ]+ ]+ )++ -- List page 0 (last page) with 1 result per page+ cmdList "" 0 1 >>= liftIO . assertEqual "list addr 2"+ ( object + [ "Addresses" .= toJSON + [ object [ "Addr" .= T.pack "18aT8MJ15VV26nx29xmbu5fzvqE6sqh6i9"+ , "Key" .= (4 :: Int)+ , "Tree" .= T.pack "m/0'/0/4/"+ ]+ ]+ , "Page results" .= object+ [ "Current page" .= (5 :: Int)+ , "Results per page" .= (1 :: Int)+ , "Total pages" .= (5 :: Int)+ , "Total addresses" .= (5 :: Int)+ ]+ ]+ )++ -- Listing page > maxpage should fail+ runEitherT (cmdList "" 6 1) >>= liftIO . assertEqual "list addr 2"+ (Left "cmdList: Page number too high")++ -- List page 0 (last page) with 3 result per page+ cmdList "" 0 3 >>= liftIO . assertEqual "list addr 2"+ ( object + [ "Addresses" .= toJSON + [ object [ "Addr" .= T.pack "1Erwcuqn1dHm8r6fNxogGmCHYuNfwKNwer"+ , "Key" .= (3 :: Int)+ , "Tree" .= T.pack "m/0'/0/3/"+ ]+ , object [ "Addr" .= T.pack "18aT8MJ15VV26nx29xmbu5fzvqE6sqh6i9"+ , "Key" .= (4 :: Int)+ , "Tree" .= T.pack "m/0'/0/4/"+ ]+ ]+ , "Page results" .= object+ [ "Current page" .= (2 :: Int)+ , "Results per page" .= (3 :: Int)+ , "Total pages" .= (2 :: Int)+ , "Total addresses" .= (5 :: Int)+ ]+ ]+ )++ -- Generating multisig addresses with labels+ cmdGenWithLabel "ms1" ["","addr1","addr2","Two Words"] >>= + liftIO . assertEqual "gen ms addr" + ( toJSON + [ object [ "Addr" .= T.pack "32VCGK4pbvVsFvSGfmLpmNTu4JjhuR3WmM"+ , "Key" .= (0 :: Int)+ , "Tree" .= T.pack "m/3'/0/0/"+ ]+ , object [ "Addr" .= T.pack "38kc3Sw4fwkvXMyGPmjQqp7WXMdGQG3Lki"+ , "Key" .= (1 :: Int)+ , "Tree" .= T.pack "m/3'/0/1/"+ , "Label" .= T.pack "addr1"+ ]+ , object [ "Addr" .= T.pack "3E3qvGPki6sypXdyL6CMxBQwzFkY7iKrGW"+ , "Key" .= (2 :: Int)+ , "Tree" .= T.pack "m/3'/0/2/"+ , "Label" .= T.pack "addr2"+ ]+ , object [ "Addr" .= T.pack "3QqkesBZx7WBSLcdy5e1PmRU1QLdYTG49Q"+ , "Key" .= (3 :: Int)+ , "Tree" .= T.pack "m/3'/0/3/"+ , "Label" .= T.pack "Two Words"+ ]+ ]+ )++ -- Check account external index+ (dbAccountExtIndex . entityVal <$> dbGetAcc "ms1") >>= + liftIO . assertEqual "acc ext index 3" 3++ -- Check account internal index+ (dbAccountIntIndex . entityVal <$> dbGetAcc "ms1") >>= + liftIO . assertEqual "acc int index 3" (-1)++ -- Check account external gap+ (dbAccountExtGap . entityVal <$> dbGetAcc "ms1") >>= + liftIO . assertEqual "acc ext gap 3" 33++ -- Check account internal gap+ (dbAccountIntGap . entityVal <$> dbGetAcc "ms1") >>= + liftIO . assertEqual "acc int gap 3" 29++ -- Count addresses+ count ([] :: [Filter (DbAddressGeneric b)]) >>= + liftIO . assertEqual "Count addr 3" 253++ let h x = (dbAddressBase58 x,dbAddressTree x,dbAddressIndex x)+ (map h <$> dbGenIntAddrs "ms1" 6) >>= liftIO . assertEqual "Internal addr 2"+ [ ("34rWmp9DmxFbqXLHvzhMGATWDfsnLF8wiR","m/3'/1/0/",0)+ , ("3As9nWqHcWavv3MxSeZKYjMQ9SgE8zVaJ1","m/3'/1/1/",1)+ , ("3QYVvQrjtK5w8s6uE8T8ZLeXBEe7aTtVdj","m/3'/1/2/",2)+ , ("3GS2h9uZ3akS9GQbXDGZtWgAvzLFnjWrsS","m/3'/1/3/",3)+ , ("3CAF8PpJirGsqTxzK2aPao2MQSGkiC3gPN","m/3'/1/4/",4)+ , ("3Kcd2Nz1XYv25U6xUzjAycVBz9rp6r2Tf2","m/3'/1/5/",5)+ ]++ -- Check account external index+ (dbAccountExtIndex . entityVal <$> dbGetAcc "ms1") >>= + liftIO . assertEqual "acc ext index 4" 3++ -- Check account internal index+ (dbAccountIntIndex . entityVal <$> dbGetAcc "ms1") >>= + liftIO . assertEqual "acc int index 4" 5++ -- Check account external gap+ (dbAccountExtGap . entityVal <$> dbGetAcc "ms1") >>= + liftIO . assertEqual "acc ext gap 4" 33++ -- Check account internal gap+ (dbAccountIntGap . entityVal <$> dbGetAcc "ms1") >>= + liftIO . assertEqual "acc int gap 4" 35++ -- Count addresses+ count ([] :: [Filter (DbAddressGeneric b)]) >>= + liftIO . assertEqual "Count addr 4" 259++ -- Rename the first multisig address label+ cmdLabel "ms1" 0 "alpha" >>= liftIO . assertEqual "label ms"+ ( object + [ "Addr" .= T.pack "32VCGK4pbvVsFvSGfmLpmNTu4JjhuR3WmM"+ , "Key" .= (0 :: Int)+ , "Tree" .= T.pack "m/3'/0/0/"+ , "Label" .= T.pack "alpha"+ ]+ )++ -- Rename the last multisig address label+ _ <- cmdLabel "ms1" 3 "beta"++ -- Setting a label on an invalid address should fail+ runEitherT (cmdLabel "ms1" (-1) "theta") >>= + liftIO . assertEqual "set label fail"+ (Left "cmdLabel: Key -1 does not exist")++ -- Setting a label on an invalid address should fail+ runEitherT (cmdLabel "ms1" 4 "theta") >>= + liftIO . assertEqual "set label fail 2"+ (Left "cmdLabel: Key 4 does not exist")++ -- Setting a label on an invalid address should fail+ runEitherT (cmdLabel "ms1" 100 "theta") >>= + liftIO . assertEqual "set label fail 3"+ (Left "cmdLabel: Key 100 does not exist")++ -- List page 1 with 5 result per page+ cmdList "ms1" 1 5 >>= liftIO . assertEqual "list ms"+ ( object + [ "Addresses" .= toJSON + [ object [ "Addr" .= T.pack "32VCGK4pbvVsFvSGfmLpmNTu4JjhuR3WmM"+ , "Key" .= (0 :: Int)+ , "Tree" .= T.pack "m/3'/0/0/"+ , "Label" .= T.pack "alpha"+ ]+ , object [ "Addr" .= T.pack "38kc3Sw4fwkvXMyGPmjQqp7WXMdGQG3Lki"+ , "Key" .= (1 :: Int)+ , "Tree" .= T.pack "m/3'/0/1/"+ , "Label" .= T.pack "addr1"+ ]+ , object [ "Addr" .= T.pack "3E3qvGPki6sypXdyL6CMxBQwzFkY7iKrGW"+ , "Key" .= (2 :: Int)+ , "Tree" .= T.pack "m/3'/0/2/"+ , "Label" .= T.pack "addr2"+ ]+ , object [ "Addr" .= T.pack "3QqkesBZx7WBSLcdy5e1PmRU1QLdYTG49Q"+ , "Key" .= (3 :: Int)+ , "Tree" .= T.pack "m/3'/0/3/"+ , "Label" .= T.pack "beta"+ ]+ ]+ , "Page results" .= object+ [ "Current page" .= (1 :: Int)+ , "Results per page" .= (5 :: Int)+ , "Total pages" .= (1 :: Int)+ , "Total addresses" .= (4 :: Int)+ ]+ ]+ )++{- Payments sent to:+ - 1LaPZtFWAWRP8eLNZRLLPGaB3dn19Nb6wi:100000 (in wallet)+ - 1AZimU5FfTQyF4GMsEKLZ32773TtPKczdY:200000 (in wallet)+ - 1Azso1Fz77buNc8p7sm3myVXZxqwQopMtp:240000 (not in wallet)+ - 1L1ryKs82ucjNmGwKT9kAsxeSVX1mhJyo5:122000 (not in wallet)+ - 38kc3Sw4fwkvXMyGPmjQqp7WXMdGQG3Lki:150000 (in wallet)+ - 3QqkesBZx7WBSLcdy5e1PmRU1QLdYTG49Q:400000 (in wallet)+ -}++-- ID: a156f308b7c3dab42d98729fefc3dfa944d84f3ac48c7e603a58885d2b34a996+tx1 :: String+tx1 = "01000000010000000000000000000000000000000000000000000000000000000000000001010000006b483045022100bf1c6e0720284bcefa2e104b5eea27fb3f11a8ebce1d7c06a99567473f9524a202201ed0baafcac25f9aa3c81fb26a3476f559169f4c7f5a64e43a2eebb6b0a1aae001210290a14bce9d363667574a29da1b2e38d106968969f449588713bb271e28a9a4a0ffffffff06a0860100000000001976a914d6baf45f52b4cccc7ac1ba3a35dd739497f8e98988ac400d0300000000001976a91468e94ed1e88f7e942bf4aaa25fcf5930f517730888ac80a90300000000001976a9146dab3dec58a7ab13267c4ec8c60b516cbe7a3c9f88ac90dc0100000000001976a914d0941a8b2ce829d8692bf6af24f67c485ff9a20b88acf04902000000000017a9144d769c08d79eed22532e044213bef3174f05158487801a06000000000017a914fdf1e3c1a936ab1dde0d7a305d28df396949ffd08700000000"++-- ID: 319f26fb4638f038008e3a9da98177f7a7cfaee64bab77328cf69e39c7fce785+tx2 :: String+tx2 = "01000000010000000000000000000000000000000000000000000000000000000000000002010000006b483045022100bf1c6e0720284bcefa2e104b5eea27fb3f11a8ebce1d7c06a99567473f9524a202201ed0baafcac25f9aa3c81fb26a3476f559169f4c7f5a64e43a2eebb6b0a1aae001210290a14bce9d363667574a29da1b2e38d106968969f449588713bb271e28a9a4a0ffffffff06a0860100000000001976a914d6baf45f52b4cccc7ac1ba3a35dd739497f8e98988ac400d0300000000001976a91468e94ed1e88f7e942bf4aaa25fcf5930f517730888ac80a90300000000001976a9146dab3dec58a7ab13267c4ec8c60b516cbe7a3c9f88ac90dc0100000000001976a914d0941a8b2ce829d8692bf6af24f67c485ff9a20b88acf04902000000000017a9144d769c08d79eed22532e044213bef3174f05158487801a06000000000017a914fdf1e3c1a936ab1dde0d7a305d28df396949ffd08700000000"++testImport :: ( PersistStore m, PersistUnique m, PersistQuery m+ , PersistMonadBackend m ~ SqlBackend+ ) + => EitherT String m ()+testImport = do ++ -- Importin transaction sending funds to two different accounts+ cmdImportTx (decode' $ fromJust $ hexToBS tx1) >>= + liftIO . assertEqual "Import tx 1"+ ( toJSON+ [ object [ "Recipients" .= toJSON+ [ T.pack "1LaPZtFWAWRP8eLNZRLLPGaB3dn19Nb6wi"+ , T.pack "1AZimU5FfTQyF4GMsEKLZ32773TtPKczdY"+ ]+ , "Value" .= (300000 :: Int)+ ]+ , object [ "Recipients" .= toJSON+ [ T.pack "38kc3Sw4fwkvXMyGPmjQqp7WXMdGQG3Lki"+ , T.pack "3QqkesBZx7WBSLcdy5e1PmRU1QLdYTG49Q"+ ]+ , "Value" .= (550000 :: Int)+ ]+ ]+ )++ -- Importin similar transaction sending funds to two different accounts+ cmdImportTx (decode' $ fromJust $ hexToBS tx2) >>= + liftIO . assertEqual "Import tx 2"+ ( toJSON+ [ object [ "Recipients" .= toJSON+ [ T.pack "1LaPZtFWAWRP8eLNZRLLPGaB3dn19Nb6wi"+ , T.pack "1AZimU5FfTQyF4GMsEKLZ32773TtPKczdY"+ ]+ , "Value" .= (300000 :: Int)+ ]+ , object [ "Recipients" .= toJSON+ [ T.pack "38kc3Sw4fwkvXMyGPmjQqp7WXMdGQG3Lki"+ , T.pack "3QqkesBZx7WBSLcdy5e1PmRU1QLdYTG49Q"+ ]+ , "Value" .= (550000 :: Int)+ ]+ ]+ )++ -- List transactions of account ""+ cmdListTx "" >>= liftIO . assertEqual "List tx 1"+ ( toJSON+ [ object [ "Recipients" .= toJSON+ [ T.pack "1LaPZtFWAWRP8eLNZRLLPGaB3dn19Nb6wi"+ , T.pack "1AZimU5FfTQyF4GMsEKLZ32773TtPKczdY"+ ]+ , "Value" .= (300000 :: Int)+ ]+ , object [ "Recipients" .= toJSON+ [ T.pack "1LaPZtFWAWRP8eLNZRLLPGaB3dn19Nb6wi"+ , T.pack "1AZimU5FfTQyF4GMsEKLZ32773TtPKczdY"+ ]+ , "Value" .= (300000 :: Int)+ ]+ ]+ )++ -- List transactions of account "ms1"+ cmdListTx "ms1" >>= liftIO . assertEqual "List tx 2"+ ( toJSON+ [ object [ "Recipients" .= toJSON+ [ T.pack "38kc3Sw4fwkvXMyGPmjQqp7WXMdGQG3Lki"+ , T.pack "3QqkesBZx7WBSLcdy5e1PmRU1QLdYTG49Q"+ ]+ , "Value" .= (550000 :: Int)+ ]+ , object [ "Recipients" .= toJSON+ [ T.pack "38kc3Sw4fwkvXMyGPmjQqp7WXMdGQG3Lki"+ , T.pack "3QqkesBZx7WBSLcdy5e1PmRU1QLdYTG49Q"+ ]+ , "Value" .= (550000 :: Int)+ ]+ ]+ )++ -- Verify the balance of account ""+ cmdBalance "" >>= liftIO . assertEqual "Balance 1" + (object ["Balance" .= (600000 :: Int)])++ -- Verify the balance of account "ms1"+ cmdBalance "ms1" >>= liftIO . assertEqual "Balance 2" + (object ["Balance" .= (1100000 :: Int)])++ -- Get coins of account ""+ cmdCoins "" >>= liftIO . assertEqual "Get coins 1"+ ( toJSON+ [ object+ [ "TxID" .= T.pack "a156f308b7c3dab42d98729fefc3dfa944d84f3ac48c7e603a58885d2b34a996"+ , "Index" .= (0 :: Int)+ , "Value" .= (100000 :: Int)+ , "Script" .= T.pack "76a914d6baf45f52b4cccc7ac1ba3a35dd739497f8e98988ac"+ , "Address" .= T.pack "1LaPZtFWAWRP8eLNZRLLPGaB3dn19Nb6wi"+ ]+ , object+ [ "TxID" .= T.pack "a156f308b7c3dab42d98729fefc3dfa944d84f3ac48c7e603a58885d2b34a996"+ , "Index" .= (1 :: Int)+ , "Value" .= (200000 :: Int)+ , "Script" .= T.pack "76a91468e94ed1e88f7e942bf4aaa25fcf5930f517730888ac"+ , "Address" .= T.pack "1AZimU5FfTQyF4GMsEKLZ32773TtPKczdY"+ ]+ , object+ [ "TxID" .= T.pack "319f26fb4638f038008e3a9da98177f7a7cfaee64bab77328cf69e39c7fce785"+ , "Index" .= (0 :: Int)+ , "Value" .= (100000 :: Int)+ , "Script" .= T.pack "76a914d6baf45f52b4cccc7ac1ba3a35dd739497f8e98988ac"+ , "Address" .= T.pack "1LaPZtFWAWRP8eLNZRLLPGaB3dn19Nb6wi"+ ]+ , object+ [ "TxID" .= T.pack "319f26fb4638f038008e3a9da98177f7a7cfaee64bab77328cf69e39c7fce785"+ , "Index" .= (1 :: Int)+ , "Value" .= (200000 :: Int)+ , "Script" .= T.pack "76a91468e94ed1e88f7e942bf4aaa25fcf5930f517730888ac"+ , "Address" .= T.pack "1AZimU5FfTQyF4GMsEKLZ32773TtPKczdY"+ ]+ ]+ )++ -- Get coins of account "ms1"+ cmdCoins "ms1" >>= liftIO . assertEqual "Get coins 2"+ ( toJSON+ [ object+ [ "TxID" .= T.pack "a156f308b7c3dab42d98729fefc3dfa944d84f3ac48c7e603a58885d2b34a996"+ , "Index" .= (4 :: Int)+ , "Value" .= (150000 :: Int)+ , "Script" .= T.pack "a9144d769c08d79eed22532e044213bef3174f05158487"+ , "Redeem" .= T.pack "5221026e294fcecdcbae12a0aba1685db35c54ddfc1375d48f96ff1b8805a4bb57bfc921028bc8d8377f44de8ac8beff0dc9ccefde4cd5dded7b8cd8babe02c7147a90ba6c21039cf5d06e79871043c420fabc652f8082e702e0094f91ec14c020e9fcf48fa4d853ae"+ , "Address" .= T.pack "38kc3Sw4fwkvXMyGPmjQqp7WXMdGQG3Lki"+ ]+ , object+ [ "TxID" .= T.pack "a156f308b7c3dab42d98729fefc3dfa944d84f3ac48c7e603a58885d2b34a996"+ , "Index" .= (5 :: Int)+ , "Value" .= (400000 :: Int)+ , "Script" .= T.pack "a914fdf1e3c1a936ab1dde0d7a305d28df396949ffd087"+ , "Redeem" .= T.pack "5221020f7ead178316e8414d128712a23cde2e843d1a0f66afc0bfa600ab90deefd5f321023182b240cb2607ed03f76c9dca37c4b9fcb3b763b776223cc94808f7e67fb03a2102648dbcbc9f44fb55a992efe7b3ab214306cc72cdcae2a7cf6f9d44262a53c3b353ae"+ , "Address" .= T.pack "3QqkesBZx7WBSLcdy5e1PmRU1QLdYTG49Q"+ ]+ , object+ [ "TxID" .= T.pack "319f26fb4638f038008e3a9da98177f7a7cfaee64bab77328cf69e39c7fce785"+ , "Index" .= (4 :: Int)+ , "Value" .= (150000 :: Int)+ , "Script" .= T.pack "a9144d769c08d79eed22532e044213bef3174f05158487"+ , "Redeem" .= T.pack "5221026e294fcecdcbae12a0aba1685db35c54ddfc1375d48f96ff1b8805a4bb57bfc921028bc8d8377f44de8ac8beff0dc9ccefde4cd5dded7b8cd8babe02c7147a90ba6c21039cf5d06e79871043c420fabc652f8082e702e0094f91ec14c020e9fcf48fa4d853ae"+ , "Address" .= T.pack "38kc3Sw4fwkvXMyGPmjQqp7WXMdGQG3Lki"+ ]+ , object+ [ "TxID" .= T.pack "319f26fb4638f038008e3a9da98177f7a7cfaee64bab77328cf69e39c7fce785"+ , "Index" .= (5 :: Int)+ , "Value" .= (400000 :: Int)+ , "Script" .= T.pack "a914fdf1e3c1a936ab1dde0d7a305d28df396949ffd087"+ , "Redeem" .= T.pack "5221020f7ead178316e8414d128712a23cde2e843d1a0f66afc0bfa600ab90deefd5f321023182b240cb2607ed03f76c9dca37c4b9fcb3b763b776223cc94808f7e67fb03a2102648dbcbc9f44fb55a992efe7b3ab214306cc72cdcae2a7cf6f9d44262a53c3b353ae"+ , "Address" .= T.pack "3QqkesBZx7WBSLcdy5e1PmRU1QLdYTG49Q"+ ]+ ]+ )++ -- ID: 9062c5ae9a4e84e37e712387a111f2dba6be57de4235df8dd1fae67cc2071771+ -- Input: 200000 and 200000 = 400000+ -- Output = 340000 + 50000 change = 390000+ -- Fee = 10000++ let txRes = "010000000285e7fcc7399ef68c3277ab4be6aecfa7f77781a99d3a8e0038f03846fb269f31010000006a47304402200f4bc4dba8e47e810362d48502329a75624d8863d8bd22618bd47c5fff8bd9e402200531318470a60b4d898b2061c3eef96ad9129ca758e7f55bd120a81569a7196201210250f4e42bb94ed8b27c6c8b728c0bd02828af1d4ebf8e3f0a6e7da3f53369c104ffffffff96a9342b5d88583a607e8cc43a4fd844a9dfc3ef9f72982db4dac3b708f356a1010000006a4730440220566d57667786d93551976f2bf890de9d623820c02c2e6d4476a71c27b771eae6022004227d27972a1f0933bf50472d85644cc5dbbc277f1370c171f80e95ed834ca401210250f4e42bb94ed8b27c6c8b728c0bd02828af1d4ebf8e3f0a6e7da3f53369c104ffffffff04c0d401000000000017a9144d769c08d79eed22532e044213bef3174f0515848780380100000000001976a914980b9c708958bbe4cc05d0b302d4f12625a5d88c88ace0220200000000001976a9147f77d7a91f8e53a387530c58139290211579dd2b88ac50c30000000000001976a914bb498fb0f0d0639193660b40a9a91e1b3eb60bab88ac00000000"++ cmdSendMany "" + [ ("38kc3Sw4fwkvXMyGPmjQqp7WXMdGQG3Lki",120000) -- In wallet+ , ("1Erwcuqn1dHm8r6fNxogGmCHYuNfwKNwer", 80000) -- In wallet+ , ("1CczPAHXrwyiCeJfx5Bifaoo4NBQr3TPpJ",140000) -- Not in wallet+ ] 10000 >>= liftIO . assertEqual "sendMany tx"+ (object + [ "Tx" .= T.pack txRes+ , "Complete" .= True+ ]+ )++ -- Check that the internal change address was correctly generated+ (dbAddressIndex . entityVal) <$> + (dbGetAddr "1J5HV12wGbPj5SUryku2zFoaxnC1AngqcH") >>= + liftIO . assertEqual "check internal address" 4++ (dbAddressTree . entityVal) <$> + (dbGetAddr "1J5HV12wGbPj5SUryku2zFoaxnC1AngqcH") >>= + liftIO . assertEqual "check internal address tree" "m/0'/1/4/"++ (dbAddressInternal . entityVal) <$> + (dbGetAddr "1J5HV12wGbPj5SUryku2zFoaxnC1AngqcH") >>= + liftIO . assertEqual "check internal address tree" True++ -- Check account external index+ (dbAccountExtIndex . entityVal <$> dbGetAcc "") >>= + liftIO . assertEqual "acc ext index 5" 4++ -- Check account internal index+ (dbAccountIntIndex . entityVal <$> dbGetAcc "") >>= + liftIO . assertEqual "acc int index 5" 4++ -- Check account external gap+ (dbAccountExtGap . entityVal <$> dbGetAcc "") >>= + liftIO . assertEqual "acc ext gap 5" 34++ -- Check account internal gap+ (dbAccountIntGap . entityVal <$> dbGetAcc "") >>= + liftIO . assertEqual "acc int gap 5" 34++ -- Count addresses+ count ([] :: [Filter (DbAddressGeneric b)]) >>= + liftIO . assertEqual "Count addr 5" 260+++ (cmdImportTx $ decode' $ fromJust $ hexToBS txRes) >>=+ liftIO . assertEqual "import send tx"+ ( toJSON+ [ object [ "Recipients" .= toJSON+ [ T.pack "38kc3Sw4fwkvXMyGPmjQqp7WXMdGQG3Lki"+ , T.pack "1CczPAHXrwyiCeJfx5Bifaoo4NBQr3TPpJ"+ ]+ , "Value" .= (-270000 :: Int)+ ]+ , object [ "Recipients" .= toJSON+ [ T.pack "38kc3Sw4fwkvXMyGPmjQqp7WXMdGQG3Lki" ]+ , "Value" .= (120000 :: Int)+ ]+ ]+ )++ -- Get coins of account ""+ cmdCoins "" >>= liftIO . assertEqual "Get coins 2"+ ( toJSON+ [ object+ [ "TxID" .= T.pack "a156f308b7c3dab42d98729fefc3dfa944d84f3ac48c7e603a58885d2b34a996"+ , "Index" .= (0 :: Int)+ , "Value" .= (100000 :: Int)+ , "Script" .= T.pack "76a914d6baf45f52b4cccc7ac1ba3a35dd739497f8e98988ac"+ , "Address" .= T.pack "1LaPZtFWAWRP8eLNZRLLPGaB3dn19Nb6wi"+ ]+ , object+ [ "TxID" .= T.pack "319f26fb4638f038008e3a9da98177f7a7cfaee64bab77328cf69e39c7fce785"+ , "Index" .= (0 :: Int)+ , "Value" .= (100000 :: Int)+ , "Script" .= T.pack "76a914d6baf45f52b4cccc7ac1ba3a35dd739497f8e98988ac"+ , "Address" .= T.pack "1LaPZtFWAWRP8eLNZRLLPGaB3dn19Nb6wi"+ ]+ , object+ [ "TxID" .= T.pack "9062c5ae9a4e84e37e712387a111f2dba6be57de4235df8dd1fae67cc2071771"+ , "Index" .= (1 :: Int)+ , "Value" .= (80000 :: Int)+ , "Script" .= T.pack "76a914980b9c708958bbe4cc05d0b302d4f12625a5d88c88ac"+ , "Address" .= T.pack "1Erwcuqn1dHm8r6fNxogGmCHYuNfwKNwer"+ ]+ , object+ [ "TxID" .= T.pack "9062c5ae9a4e84e37e712387a111f2dba6be57de4235df8dd1fae67cc2071771"+ , "Index" .= (3 :: Int)+ , "Value" .= (50000 :: Int)+ , "Script" .= T.pack "76a914bb498fb0f0d0639193660b40a9a91e1b3eb60bab88ac"+ , "Address" .= T.pack "1J5HV12wGbPj5SUryku2zFoaxnC1AngqcH"+ ]+ ]+ )++ -- List transactions of account ""+ cmdListTx "" >>= liftIO . assertEqual "List tx 2"+ ( toJSON+ [ object [ "Recipients" .= toJSON+ [ T.pack "1LaPZtFWAWRP8eLNZRLLPGaB3dn19Nb6wi"+ , T.pack "1AZimU5FfTQyF4GMsEKLZ32773TtPKczdY"+ ]+ , "Value" .= (300000 :: Int)+ ]+ , object [ "Recipients" .= toJSON+ [ T.pack "1LaPZtFWAWRP8eLNZRLLPGaB3dn19Nb6wi"+ , T.pack "1AZimU5FfTQyF4GMsEKLZ32773TtPKczdY"+ ]+ , "Value" .= (300000 :: Int)+ ]+ , object [ "Recipients" .= toJSON+ [ T.pack "38kc3Sw4fwkvXMyGPmjQqp7WXMdGQG3Lki"+ , T.pack "1CczPAHXrwyiCeJfx5Bifaoo4NBQr3TPpJ"+ ]+ , "Value" .= (-270000 :: Int)+ ]+ ]+ )+ + -- Verify the balance of account ""+ cmdBalance "" >>= liftIO . assertEqual "Balance 3" + (object ["Balance" .= (330000 :: Int)])++ -- Verify the balance of account "ms1"+ cmdBalance "ms1" >>= liftIO . assertEqual "Balance 4" + (object ["Balance" .= (1220000 :: Int)])++-- Building tx link:+-- txA : outside => acc1+-- txB : acc1 => (acc1,acc2,outside)+-- txC : acc2 => (acc1,outside) +-- tcD : acc1 => outside+-- import order: txC, tcB, txA++{- TxID: 23c5dcac6ef51d36ca63cf7f3dc30163939bb208eb8e12b92183ccc1333c20bd+ - Payments sent to:+ - 1ChqhDvLVx5bjRHbdUweCsd4mgwD4fvdGL : 100000 (acc1)+ - 1DKe1dvRznGqmBFsHY7MmvJy3DtcfBDZbw : 200000 (acc1)+ - 17yJQpBHpWyVHNshgGpCK876Nb8qqvp3rG : 300000 (acc1)+ -}++txA :: String+txA = "01000000010000000000000000000000000000000000000000000000000000000000000001090000006a4730440220464686ba44f82d76bc3687399f971fe86661241b9698308711e099fab785ef140220074de9e525ae379fc7ab676fbeb475e7c8aa7268afb0c3f48ea18137bf069f7d01210290a14bce9d363667574a29da1b2e38d106968969f449588713bb271e28a9a4a0ffffffff03a0860100000000001976a9148062ab5c3fdf5f8f0d41fccacbb3ea8058b911ae88ac400d0300000000001976a9148727e4552058a555d0ce269d8cf8c850785666f688ace0930400000000001976a9144c769509bb3e22c2275cd025fcb55ebc5dc1e39f88ac00000000"++{- TxID: 53fe1114579ef53affe2339d3cd5010b054515556bc9749351e96b24f9cba3d0+ - inputs: acc1 (index 1 and index 2 = 500000)+ - Payments sent to:+ - 14JcRDidCbYFBwWjP9PGJL1MRKCzUWCmaS : 100000 (acc1)+ - 16mrBKvB9DV5YAYw7a8kYDvqwh1tJGMR5M : 200000 (acc2)+ - 1FLRUj4iGRZHpr9WJq3RG64cL2vEbccQ86 : 150000 (outside)+ - 1Baez98Lapiu7mQLfXuUCjBreEAwFrWNd2 : 40000 (change to acc1)+ -}++txB :: String+txB = "0100000002bd203c33c1cc8321b9128eeb08b29b936301c33d7fcf63ca361df56eacdcc523010000006b4830450221009c061ca53ccfdd379f883857466103308f54c764e7acd94f5eb23d40bb5ce1cc022074f40ed51bbdc295307db177c15679939e104bcc8944b54eb3ac681992f27a10012103a40f6bd1d59440a007aa8ec93875d07f234ffebe76df311c1b610fc1c0d22dd9ffffffffbd203c33c1cc8321b9128eeb08b29b936301c33d7fcf63ca361df56eacdcc523020000006a47304402204e3c85a423066ef44a7d25d0ee0352d8dd5e7628e989aa9f0833abe681405610022030638452839cbb210bf7589e16beb0a737ecbc4a6560e28cd3b11517c83ff225012103a0d2cdf936eca39cfd6407393f8f0f2af932bdea6271d559308075b77d2ec080ffffffff04a0860100000000001976a914243d03889d49470ee721d44596fd146440e1167c88ac400d0300000000001976a9143f53fba59a1c17f17cf3c4b5cfcf15fa0087f1c188acf0490200000000001976a9149d3e18f3cd8edf442c31cb5cc5b0acf8e4e96a1e88ac409c0000000000001976a914740eb168ae243882a73f5467b9024431443ef12988ac00000000"++{- TxID: 2255db56e3ff00c36461da3d7251065b0cefc657a3343146cf69dc0f418ab150+ - inputs: acc2 (index 1 = 200000)+ - Payments sent to:+ - 14MZHk4dkM3ZM7bBcET4ELuyozXqCCsQpb : 120000 (acc1)+ - 13GTKCtWbpRpPGca3uhTjwZWiQcqAMPh6n : 40000 (outside)+ - 13wD1L9PvEgBytP5X6ykiuhB8gRP58CB5J : 30000 (change to acc2)+ -}++txC :: String+txC = "0100000001d0a3cbf9246be9519374c96b551545050b01d53c9d33e2ff3af59e571411fe53010000006b483045022100ff41f0cb1ce0f7f6d07b93c9f3c43480f843092a14618b2b20c2fad90d003216022049069460cbf2355f03ed31ac25cc086057aa752bd53f9de558f33e565369d11e012103b4b925d5967a00d2540115f035aa10290853d39e3c20591d711680cac5e2b4efffffffff03c0d40100000000001976a91424cba659aad4563de9199f3fe273bac07f170eb088ac409c0000000000001976a91418dc74eb38930493ce81b8f1d3fd0f15e43e96b288ac30750000000000001976a9142030bc3fec2b3783acd9e83f6e24d57568be69a988ac00000000"++{- TxID: 03e0ce2206a300bfc718afd25e1d34bc3a0b61e570913c4ab94884219b031582+ - inputs: acc1 (index 0 = 120000)+ - Payments sent to:+ - 13s6R8TRWTk5DZaSQ2pKn3hfdugvEZEdZf : 110000 (outside)+ -}++txD :: String+txD = "010000000150b18a410fdc69cf463134a357c6ef0c5b0651723dda6164c300ffe356db5522000000006b483045022100f9a43bc03aa44ea2e97873d73f522680a7967f71ad9406de380aafd8f1afc1260220790f82a126d2a5a5404ea2632c99e90e55484e1d16dba1842884bc740add3f23012103a104bc20b43f7f10f89f0519b12bd828dfb7c7969e4c833eadfc6badda334bc0ffffffff01b0ad0100000000001976a9141f69921a4f95254ee2aaa181381439bbc8b2645788ac00000000"++testOrphan :: ( PersistStore m, PersistUnique m, PersistQuery m+ , PersistMonadBackend m ~ SqlBackend+ ) + => EitherT String m ()+testOrphan = do ++ -- import transaction D+ cmdImportTx (decode' $ fromJust $ hexToBS txD) >>= + liftIO . assertEqual "import txD"+ ( toJSON+ [ object [ "Recipients" .= toJSON+ [ T.pack "13s6R8TRWTk5DZaSQ2pKn3hfdugvEZEdZf"+ ]+ , "Value" .= (0 :: Int)+ , "Orphan" .= True+ ]+ ]+ )++ -- import transaction D a second time. Operation should be idempotent+ cmdImportTx (decode' $ fromJust $ hexToBS txD) >>= + liftIO . assertEqual "import txD 2"+ ( toJSON+ [ object [ "Recipients" .= toJSON+ [ T.pack "13s6R8TRWTk5DZaSQ2pKn3hfdugvEZEdZf"+ ]+ , "Value" .= (0 :: Int)+ , "Orphan" .= True+ ]+ ]+ )++ (Entity ai1 _) <- dbGetAcc "acc1"+ (Entity ai2 _) <- dbGetAcc "acc2"++ let f (Entity _ c) = ( dbCoinTxid c, dbCoinPos c+ , dbCoinValue c, dbCoinScript c+ , dbCoinRdmScript c, dbCoinAddress c+ , dbCoinStatus c, dbCoinOrphan c+ )+ g (Entity _ t) = ( dbTxTxid t, dbTxRecipients t+ , dbTxValue t, dbTxOrphan t, dbTxPartial t+ )++ ((map f) <$> selectList [DbCoinAccount ==. ai1] [Asc DbCoinCreated]) >>= + liftIO . assertEqual "Check import txD coins"+ [ ( "2255db56e3ff00c36461da3d7251065b0cefc657a3343146cf69dc0f418ab150"+ , 0, 0, "", Nothing + , "14MZHk4dkM3ZM7bBcET4ELuyozXqCCsQpb"+ , Spent "03e0ce2206a300bfc718afd25e1d34bc3a0b61e570913c4ab94884219b031582"+ , True+ )+ ]++ ((map g) <$> selectList [DbTxAccount ==. ai1] [Asc DbTxCreated]) >>=+ liftIO . assertEqual "Check import txD tx"+ [ ( "03e0ce2206a300bfc718afd25e1d34bc3a0b61e570913c4ab94884219b031582"+ , ["13s6R8TRWTk5DZaSQ2pKn3hfdugvEZEdZf"]+ , 0, True, False+ )+ ]++ cmdCoins "acc1" >>= liftIO . assertEqual "Check empty coins txD" + (toJSON ([] :: [DbCoinGeneric b]))++ cmdListTx "acc1" >>= liftIO . assertEqual "Check listTx txD"+ ( toJSON+ [ object [ "Recipients" .= toJSON+ [ T.pack "13s6R8TRWTk5DZaSQ2pKn3hfdugvEZEdZf"+ ]+ , "Value" .= (0 :: Int)+ , "Orphan" .= True+ ]+ ]+ )++ cmdBalance "acc1" >>= liftIO . assertEqual "Check 0 balance txD" + (object ["Balance" .= (0 :: Int)])++ -- import transaction C+ cmdImportTx (decode' $ fromJust $ hexToBS txC) >>= + liftIO . assertEqual "import txC"+ ( toJSON+ [ object [ "Recipients" .= toJSON+ [ T.pack "14MZHk4dkM3ZM7bBcET4ELuyozXqCCsQpb"+ ]+ , "Value" .= (120000 :: Int)+ ]+ , object [ "Recipients" .= toJSON+ [ T.pack "14MZHk4dkM3ZM7bBcET4ELuyozXqCCsQpb"+ , T.pack "13GTKCtWbpRpPGca3uhTjwZWiQcqAMPh6n"+ ]+ , "Value" .= (0 :: Int)+ , "Orphan" .= True+ ]+ , object [ "Recipients" .= toJSON+ [ T.pack "13s6R8TRWTk5DZaSQ2pKn3hfdugvEZEdZf"+ ]+ , "Value" .= (-120000 :: Int)+ ]+ ]+ )++ -- import transaction C again (operation should be idempotent)+ cmdImportTx (decode' $ fromJust $ hexToBS txC) >>= + liftIO . assertEqual "import txC 2"+ ( toJSON+ [ object [ "Recipients" .= toJSON+ [ T.pack "14MZHk4dkM3ZM7bBcET4ELuyozXqCCsQpb"+ ]+ , "Value" .= (120000 :: Int)+ ]+ , object [ "Recipients" .= toJSON+ [ T.pack "14MZHk4dkM3ZM7bBcET4ELuyozXqCCsQpb"+ , T.pack "13GTKCtWbpRpPGca3uhTjwZWiQcqAMPh6n"+ ]+ , "Value" .= (0 :: Int)+ , "Orphan" .= True+ ]+ , object [ "Recipients" .= toJSON+ [ T.pack "13s6R8TRWTk5DZaSQ2pKn3hfdugvEZEdZf"+ ]+ , "Value" .= (-120000 :: Int)+ ]+ ]+ )++ -- The previous orphaned coin should be un-orphaned now+ ((map f) <$> selectList [DbCoinAccount ==. ai1] [Asc DbCoinCreated]) >>= + liftIO . assertEqual "Check import txC coins 2"+ [ ( "2255db56e3ff00c36461da3d7251065b0cefc657a3343146cf69dc0f418ab150"+ , 0, 120000+ , "76a91424cba659aad4563de9199f3fe273bac07f170eb088ac", Nothing + , "14MZHk4dkM3ZM7bBcET4ELuyozXqCCsQpb"+ , Spent "03e0ce2206a300bfc718afd25e1d34bc3a0b61e570913c4ab94884219b031582"+ , False+ )+ ]++ -- The creation time of the transactions should reflect their dependencies+ ((map g) <$> selectList [DbTxAccount ==. ai1] [Asc DbTxCreated]) >>=+ liftIO . assertEqual "Check import txC tx"+ [ ( "2255db56e3ff00c36461da3d7251065b0cefc657a3343146cf69dc0f418ab150"+ , ["14MZHk4dkM3ZM7bBcET4ELuyozXqCCsQpb"]+ , 120000, False, False+ )+ , ( "03e0ce2206a300bfc718afd25e1d34bc3a0b61e570913c4ab94884219b031582"+ , ["13s6R8TRWTk5DZaSQ2pKn3hfdugvEZEdZf"]+ , -120000, False, False+ )+ ]++ -- Check coins of account 2+ ((map f) <$> selectList [DbCoinAccount ==. ai2] [Asc DbCoinCreated]) >>= + liftIO . assertEqual "Check import txC coins 3"+ [ ( "53fe1114579ef53affe2339d3cd5010b054515556bc9749351e96b24f9cba3d0"+ , 1, 0+ , "", Nothing + , "16mrBKvB9DV5YAYw7a8kYDvqwh1tJGMR5M"+ , Spent "2255db56e3ff00c36461da3d7251065b0cefc657a3343146cf69dc0f418ab150" + , True+ )+ , ( "2255db56e3ff00c36461da3d7251065b0cefc657a3343146cf69dc0f418ab150"+ , 2, 30000+ , "76a9142030bc3fec2b3783acd9e83f6e24d57568be69a988ac", Nothing + , "13wD1L9PvEgBytP5X6ykiuhB8gRP58CB5J"+ , Unspent , False+ )+ ]++ -- Check transactions of account 2+ ((map g) <$> selectList [DbTxAccount ==. ai2] [Asc DbTxCreated]) >>=+ liftIO . assertEqual "Check import txC tx 2"+ [ ( "2255db56e3ff00c36461da3d7251065b0cefc657a3343146cf69dc0f418ab150"+ , [ "14MZHk4dkM3ZM7bBcET4ELuyozXqCCsQpb"+ , "13GTKCtWbpRpPGca3uhTjwZWiQcqAMPh6n"+ ]+ , 0, True, False+ )+ ]++ -- list cmdCoins of acc 1 (should be empty)+ cmdCoins "acc1" >>= liftIO . assertEqual "Check cmdCoins txC 1" + (toJSON ([] :: [DbCoinGeneric b]))++ -- list cmdCoins of acc 2+ cmdCoins "acc2" >>= liftIO . assertEqual "Check cmdCoins txC 2" + (toJSON + [ object [ "TxID" .= T.pack "2255db56e3ff00c36461da3d7251065b0cefc657a3343146cf69dc0f418ab150"+ , "Index" .= (2 :: Int)+ , "Value" .= (30000 :: Int)+ , "Script" .= T.pack "76a9142030bc3fec2b3783acd9e83f6e24d57568be69a988ac"+ , "Address" .= T.pack "13wD1L9PvEgBytP5X6ykiuhB8gRP58CB5J"+ ] + ]+ )++ -- list cmdListTx of acc1+ cmdListTx "acc1" >>= liftIO . assertEqual "Check listTx txC 1"+ ( toJSON+ [ object [ "Recipients" .= toJSON+ [ T.pack "14MZHk4dkM3ZM7bBcET4ELuyozXqCCsQpb"+ ]+ , "Value" .= (120000 :: Int)+ ]+ , object [ "Recipients" .= toJSON+ [ T.pack "13s6R8TRWTk5DZaSQ2pKn3hfdugvEZEdZf"+ ]+ , "Value" .= (-120000 :: Int)+ ]+ ]+ )++ -- list cmdListTx of acc2+ cmdListTx "acc2" >>= liftIO . assertEqual "Check listTx txC 2"+ ( toJSON+ [ object [ "Recipients" .= toJSON+ [ T.pack "14MZHk4dkM3ZM7bBcET4ELuyozXqCCsQpb"+ , T.pack "13GTKCtWbpRpPGca3uhTjwZWiQcqAMPh6n"+ ]+ , "Value" .= (0 :: Int)+ , "Orphan" .= True+ ]+ ]+ )++ -- Check balance of acc1+ cmdBalance "acc1" >>= liftIO . assertEqual "Check balance txC 1" + (object ["Balance" .= (0 :: Int)])++ -- Balance of acc2 is 30000 but pending orphaned coins+ cmdBalance "acc2" >>= liftIO . assertEqual "Check balance txC 2" + (object ["Balance" .= (30000 :: Int)])++ -- Importing txB+ cmdImportTx (decode' $ fromJust $ hexToBS txB) >>= + liftIO . assertEqual "import txB 1"+ ( toJSON+ [ object [ "Recipients" .= toJSON+ [ T.pack "16mrBKvB9DV5YAYw7a8kYDvqwh1tJGMR5M"+ , T.pack "1FLRUj4iGRZHpr9WJq3RG64cL2vEbccQ86"+ ]+ , "Value" .= (0 :: Int)+ , "Orphan" .= True+ ]+ , object [ "Recipients" .= toJSON+ [ T.pack "16mrBKvB9DV5YAYw7a8kYDvqwh1tJGMR5M" ]+ , "Value" .= (200000 :: Int)+ ]+ , object [ "Recipients" .= toJSON+ [ T.pack "14MZHk4dkM3ZM7bBcET4ELuyozXqCCsQpb"+ ]+ , "Value" .= (120000 :: Int)+ ]+ , object [ "Recipients" .= toJSON+ [ T.pack "14MZHk4dkM3ZM7bBcET4ELuyozXqCCsQpb"+ , T.pack "13GTKCtWbpRpPGca3uhTjwZWiQcqAMPh6n"+ ]+ , "Value" .= (-170000 :: Int)+ ]+ , object [ "Recipients" .= toJSON+ [ T.pack "13s6R8TRWTk5DZaSQ2pKn3hfdugvEZEdZf"+ ]+ , "Value" .= (-120000 :: Int)+ ]+ ]+ )++ -- Importing txB again. Import is idempotent so this should work fine+ cmdImportTx (decode' $ fromJust $ hexToBS txB) >>= + liftIO . assertEqual "import txB 1"+ ( toJSON+ [ object [ "Recipients" .= toJSON+ [ T.pack "16mrBKvB9DV5YAYw7a8kYDvqwh1tJGMR5M"+ , T.pack "1FLRUj4iGRZHpr9WJq3RG64cL2vEbccQ86"+ ]+ , "Value" .= (0 :: Int)+ , "Orphan" .= True+ ]+ , object [ "Recipients" .= toJSON+ [ T.pack "16mrBKvB9DV5YAYw7a8kYDvqwh1tJGMR5M" ]+ , "Value" .= (200000 :: Int)+ ]+ , object [ "Recipients" .= toJSON+ [ T.pack "14MZHk4dkM3ZM7bBcET4ELuyozXqCCsQpb"+ ]+ , "Value" .= (120000 :: Int)+ ]+ , object [ "Recipients" .= toJSON+ [ T.pack "14MZHk4dkM3ZM7bBcET4ELuyozXqCCsQpb"+ , T.pack "13GTKCtWbpRpPGca3uhTjwZWiQcqAMPh6n"+ ]+ , "Value" .= (-170000 :: Int)+ ]+ , object [ "Recipients" .= toJSON+ [ T.pack "13s6R8TRWTk5DZaSQ2pKn3hfdugvEZEdZf"+ ]+ , "Value" .= (-120000 :: Int)+ ]+ ]+ )++ -- List coins of account 1 after importing txB+ ((map f) <$> selectList [DbCoinAccount ==. ai1] [Asc DbCoinCreated]) >>= + liftIO . assertEqual "Check import txB coins"+ [ ( "23c5dcac6ef51d36ca63cf7f3dc30163939bb208eb8e12b92183ccc1333c20bd"+ , 1, 0+ , "", Nothing + , "1DKe1dvRznGqmBFsHY7MmvJy3DtcfBDZbw"+ , Spent "53fe1114579ef53affe2339d3cd5010b054515556bc9749351e96b24f9cba3d0"+ , True+ )+ , ( "23c5dcac6ef51d36ca63cf7f3dc30163939bb208eb8e12b92183ccc1333c20bd"+ , 2, 0+ , "", Nothing + , "17yJQpBHpWyVHNshgGpCK876Nb8qqvp3rG"+ , Spent "53fe1114579ef53affe2339d3cd5010b054515556bc9749351e96b24f9cba3d0"+ , True+ )+ , ( "53fe1114579ef53affe2339d3cd5010b054515556bc9749351e96b24f9cba3d0"+ , 0, 100000+ , "76a914243d03889d49470ee721d44596fd146440e1167c88ac", Nothing + , "14JcRDidCbYFBwWjP9PGJL1MRKCzUWCmaS"+ , Unspent+ , False+ )+ , ( "53fe1114579ef53affe2339d3cd5010b054515556bc9749351e96b24f9cba3d0"+ , 3, 40000+ , "76a914740eb168ae243882a73f5467b9024431443ef12988ac", Nothing + , "1Baez98Lapiu7mQLfXuUCjBreEAwFrWNd2"+ , Unspent+ , False+ )+ , ( "2255db56e3ff00c36461da3d7251065b0cefc657a3343146cf69dc0f418ab150"+ , 0, 120000+ , "76a91424cba659aad4563de9199f3fe273bac07f170eb088ac", Nothing + , "14MZHk4dkM3ZM7bBcET4ELuyozXqCCsQpb"+ , Spent "03e0ce2206a300bfc718afd25e1d34bc3a0b61e570913c4ab94884219b031582"+ , False+ )+ ]++ -- List of transactions for account 1+ ((map g) <$> selectList [DbTxAccount ==. ai1] [Asc DbTxCreated]) >>=+ liftIO . assertEqual "Check transactions import txB"+ [ ( "53fe1114579ef53affe2339d3cd5010b054515556bc9749351e96b24f9cba3d0"+ , [ "16mrBKvB9DV5YAYw7a8kYDvqwh1tJGMR5M"+ , "1FLRUj4iGRZHpr9WJq3RG64cL2vEbccQ86"+ ]+ , 0, True, False+ )+ , ( "2255db56e3ff00c36461da3d7251065b0cefc657a3343146cf69dc0f418ab150"+ , ["14MZHk4dkM3ZM7bBcET4ELuyozXqCCsQpb"]+ , 120000, False, False+ )+ , ( "03e0ce2206a300bfc718afd25e1d34bc3a0b61e570913c4ab94884219b031582"+ , ["13s6R8TRWTk5DZaSQ2pKn3hfdugvEZEdZf"]+ , -120000, False, False+ )+ ]++ -- List coins of account 2. The first coin is not orphaned anymore+ ((map f) <$> selectList [DbCoinAccount ==. ai2] [Asc DbCoinCreated]) >>= + liftIO . assertEqual "Check coins txB 2"+ [ ( "53fe1114579ef53affe2339d3cd5010b054515556bc9749351e96b24f9cba3d0"+ , 1, 200000+ , "76a9143f53fba59a1c17f17cf3c4b5cfcf15fa0087f1c188ac", Nothing + , "16mrBKvB9DV5YAYw7a8kYDvqwh1tJGMR5M"+ , Spent "2255db56e3ff00c36461da3d7251065b0cefc657a3343146cf69dc0f418ab150" + , False+ )+ , ( "2255db56e3ff00c36461da3d7251065b0cefc657a3343146cf69dc0f418ab150"+ , 2, 30000+ , "76a9142030bc3fec2b3783acd9e83f6e24d57568be69a988ac", Nothing + , "13wD1L9PvEgBytP5X6ykiuhB8gRP58CB5J"+ , Unspent , False+ )+ ]++ -- Check transactions of account 2+ ((map g) <$> selectList [DbTxAccount ==. ai2] [Asc DbTxCreated]) >>=+ liftIO . assertEqual "Check transactions import txB 2"+ [ ( "53fe1114579ef53affe2339d3cd5010b054515556bc9749351e96b24f9cba3d0"+ , [ "16mrBKvB9DV5YAYw7a8kYDvqwh1tJGMR5M" ]+ , 200000, False, False+ )+ , ( "2255db56e3ff00c36461da3d7251065b0cefc657a3343146cf69dc0f418ab150"+ , [ "14MZHk4dkM3ZM7bBcET4ELuyozXqCCsQpb"+ , "13GTKCtWbpRpPGca3uhTjwZWiQcqAMPh6n"+ ]+ , -170000, False, False+ )+ ]++ -- list cmdCoins of acc 1+ cmdCoins "acc1" >>= liftIO . assertEqual "Check cmdCoins txB 1" + (toJSON + [ object [ "TxID" .= T.pack "53fe1114579ef53affe2339d3cd5010b054515556bc9749351e96b24f9cba3d0"+ , "Index" .= (0 :: Int)+ , "Value" .= (100000 :: Int)+ , "Script" .= T.pack "76a914243d03889d49470ee721d44596fd146440e1167c88ac"+ , "Address" .= T.pack "14JcRDidCbYFBwWjP9PGJL1MRKCzUWCmaS"+ ] + , object [ "TxID" .= T.pack "53fe1114579ef53affe2339d3cd5010b054515556bc9749351e96b24f9cba3d0"+ , "Index" .= (3 :: Int)+ , "Value" .= (40000 :: Int)+ , "Script" .= T.pack "76a914740eb168ae243882a73f5467b9024431443ef12988ac"+ , "Address" .= T.pack "1Baez98Lapiu7mQLfXuUCjBreEAwFrWNd2"+ ] + ]+ )++ -- list cmdCoins of acc 2+ cmdCoins "acc2" >>= liftIO . assertEqual "Check cmdCoins txB 2" + (toJSON + [ object [ "TxID" .= T.pack "2255db56e3ff00c36461da3d7251065b0cefc657a3343146cf69dc0f418ab150"+ , "Index" .= (2 :: Int)+ , "Value" .= (30000 :: Int)+ , "Script" .= T.pack "76a9142030bc3fec2b3783acd9e83f6e24d57568be69a988ac"+ , "Address" .= T.pack "13wD1L9PvEgBytP5X6ykiuhB8gRP58CB5J"+ ] + ]+ )++ -- list cmdListTx of acc1+ cmdListTx "acc1" >>= liftIO . assertEqual "Check listTx txB 1"+ ( toJSON+ [ object [ "Recipients" .= toJSON+ [ T.pack "16mrBKvB9DV5YAYw7a8kYDvqwh1tJGMR5M"+ , T.pack "1FLRUj4iGRZHpr9WJq3RG64cL2vEbccQ86"+ ]+ , "Value" .= (0 :: Int)+ , "Orphan" .= True+ ]+ , object [ "Recipients" .= toJSON+ [ T.pack "14MZHk4dkM3ZM7bBcET4ELuyozXqCCsQpb"+ ]+ , "Value" .= (120000 :: Int)+ ]+ , object [ "Recipients" .= toJSON+ [ T.pack "13s6R8TRWTk5DZaSQ2pKn3hfdugvEZEdZf"+ ]+ , "Value" .= (-120000 :: Int)+ ]+ ]+ )++ -- list cmdListTx of acc2+ cmdListTx "acc2" >>= liftIO . assertEqual "Check listTx txB 2"+ ( toJSON+ [ object [ "Recipients" .= toJSON+ [ T.pack "16mrBKvB9DV5YAYw7a8kYDvqwh1tJGMR5M" ]+ , "Value" .= (200000 :: Int)+ ]+ , object [ "Recipients" .= toJSON+ [ T.pack "14MZHk4dkM3ZM7bBcET4ELuyozXqCCsQpb"+ , T.pack "13GTKCtWbpRpPGca3uhTjwZWiQcqAMPh6n"+ ]+ , "Value" .= (-170000 :: Int)+ ]+ ]+ )++ -- Check balance of acc1+ cmdBalance "acc1" >>= liftIO . assertEqual "Check balance txB 1" + (object ["Balance" .= (140000 :: Int)])++ -- Balance of acc2 + cmdBalance "acc2" >>= liftIO . assertEqual "Check balance txB 2" + (object ["Balance" .= (30000 :: Int)])++ -- Importing txA (Partial)+ cmdImportTx (decode' $ fromJust $ hexToBS txA) >>= + liftIO . assertEqual "import txA 1"+ ( toJSON+ [ object [ "Recipients" .= toJSON+ [ T.pack "1ChqhDvLVx5bjRHbdUweCsd4mgwD4fvdGL"+ , T.pack "1DKe1dvRznGqmBFsHY7MmvJy3DtcfBDZbw"+ , T.pack "17yJQpBHpWyVHNshgGpCK876Nb8qqvp3rG"+ ]+ , "Value" .= (600000 :: Int)+ ]+ , object [ "Recipients" .= toJSON+ [ T.pack "16mrBKvB9DV5YAYw7a8kYDvqwh1tJGMR5M"+ , T.pack "1FLRUj4iGRZHpr9WJq3RG64cL2vEbccQ86"+ ]+ , "Value" .= (-360000 :: Int)+ ]+ , object [ "Recipients" .= toJSON+ [ T.pack "16mrBKvB9DV5YAYw7a8kYDvqwh1tJGMR5M" ]+ , "Value" .= (200000 :: Int)+ ]+ , object [ "Recipients" .= toJSON+ [ T.pack "14MZHk4dkM3ZM7bBcET4ELuyozXqCCsQpb"+ ]+ , "Value" .= (120000 :: Int)+ ]+ , object [ "Recipients" .= toJSON+ [ T.pack "14MZHk4dkM3ZM7bBcET4ELuyozXqCCsQpb"+ , T.pack "13GTKCtWbpRpPGca3uhTjwZWiQcqAMPh6n"+ ]+ , "Value" .= (-170000 :: Int)+ ]+ , object [ "Recipients" .= toJSON+ [ T.pack "13s6R8TRWTk5DZaSQ2pKn3hfdugvEZEdZf" ]+ , "Value" .= (-120000 :: Int)+ ]+ ]+ )++ -- Importing txA a second time+ cmdImportTx (decode' $ fromJust $ hexToBS txA) >>= + liftIO . assertEqual "import txA 1"+ ( toJSON+ [ object [ "Recipients" .= toJSON+ [ T.pack "1ChqhDvLVx5bjRHbdUweCsd4mgwD4fvdGL"+ , T.pack "1DKe1dvRznGqmBFsHY7MmvJy3DtcfBDZbw"+ , T.pack "17yJQpBHpWyVHNshgGpCK876Nb8qqvp3rG"+ ]+ , "Value" .= (600000 :: Int)+ ]+ , object [ "Recipients" .= toJSON+ [ T.pack "16mrBKvB9DV5YAYw7a8kYDvqwh1tJGMR5M"+ , T.pack "1FLRUj4iGRZHpr9WJq3RG64cL2vEbccQ86"+ ]+ , "Value" .= (-360000 :: Int)+ ]+ , object [ "Recipients" .= toJSON+ [ T.pack "16mrBKvB9DV5YAYw7a8kYDvqwh1tJGMR5M" ]+ , "Value" .= (200000 :: Int)+ ]+ , object [ "Recipients" .= toJSON+ [ T.pack "14MZHk4dkM3ZM7bBcET4ELuyozXqCCsQpb"+ ]+ , "Value" .= (120000 :: Int)+ ]+ , object [ "Recipients" .= toJSON+ [ T.pack "14MZHk4dkM3ZM7bBcET4ELuyozXqCCsQpb"+ , T.pack "13GTKCtWbpRpPGca3uhTjwZWiQcqAMPh6n"+ ]+ , "Value" .= (-170000 :: Int)+ ]+ , object [ "Recipients" .= toJSON+ [ T.pack "13s6R8TRWTk5DZaSQ2pKn3hfdugvEZEdZf" ]+ , "Value" .= (-120000 :: Int)+ ]+ ]+ )++ -- List coins of account 1 after importing txA+ ((map f) <$> selectList [DbCoinAccount ==. ai1] [Asc DbCoinCreated]) >>= + liftIO . assertEqual "Check import txB coins"+ [ ( "23c5dcac6ef51d36ca63cf7f3dc30163939bb208eb8e12b92183ccc1333c20bd"+ , 0, 100000+ , "76a9148062ab5c3fdf5f8f0d41fccacbb3ea8058b911ae88ac", Nothing + , "1ChqhDvLVx5bjRHbdUweCsd4mgwD4fvdGL"+ , Unspent, False+ )+ , ( "23c5dcac6ef51d36ca63cf7f3dc30163939bb208eb8e12b92183ccc1333c20bd"+ , 1, 200000+ , "76a9148727e4552058a555d0ce269d8cf8c850785666f688ac", Nothing + , "1DKe1dvRznGqmBFsHY7MmvJy3DtcfBDZbw"+ , Spent "53fe1114579ef53affe2339d3cd5010b054515556bc9749351e96b24f9cba3d0"+ , False+ )+ , ( "23c5dcac6ef51d36ca63cf7f3dc30163939bb208eb8e12b92183ccc1333c20bd"+ , 2, 300000+ , "76a9144c769509bb3e22c2275cd025fcb55ebc5dc1e39f88ac", Nothing + , "17yJQpBHpWyVHNshgGpCK876Nb8qqvp3rG"+ , Spent "53fe1114579ef53affe2339d3cd5010b054515556bc9749351e96b24f9cba3d0"+ , False+ )+ , ( "53fe1114579ef53affe2339d3cd5010b054515556bc9749351e96b24f9cba3d0"+ , 0, 100000+ , "76a914243d03889d49470ee721d44596fd146440e1167c88ac", Nothing + , "14JcRDidCbYFBwWjP9PGJL1MRKCzUWCmaS"+ , Unspent, False+ )+ , ( "53fe1114579ef53affe2339d3cd5010b054515556bc9749351e96b24f9cba3d0"+ , 3, 40000+ , "76a914740eb168ae243882a73f5467b9024431443ef12988ac", Nothing + , "1Baez98Lapiu7mQLfXuUCjBreEAwFrWNd2"+ , Unspent, False+ )+ , ( "2255db56e3ff00c36461da3d7251065b0cefc657a3343146cf69dc0f418ab150"+ , 0, 120000+ , "76a91424cba659aad4563de9199f3fe273bac07f170eb088ac", Nothing + , "14MZHk4dkM3ZM7bBcET4ELuyozXqCCsQpb"+ , Spent "03e0ce2206a300bfc718afd25e1d34bc3a0b61e570913c4ab94884219b031582"+ , False+ )+ ]++ -- List of transactions for account 1+ ((map g) <$> selectList [DbTxAccount ==. ai1] [Asc DbTxCreated]) >>=+ liftIO . assertEqual "Check transactions import txA"+ [ ( "23c5dcac6ef51d36ca63cf7f3dc30163939bb208eb8e12b92183ccc1333c20bd"+ , [ "1ChqhDvLVx5bjRHbdUweCsd4mgwD4fvdGL"+ , "1DKe1dvRznGqmBFsHY7MmvJy3DtcfBDZbw"+ , "17yJQpBHpWyVHNshgGpCK876Nb8qqvp3rG"+ ]+ , 600000, False, False+ )+ , ( "53fe1114579ef53affe2339d3cd5010b054515556bc9749351e96b24f9cba3d0"+ , [ "16mrBKvB9DV5YAYw7a8kYDvqwh1tJGMR5M"+ , "1FLRUj4iGRZHpr9WJq3RG64cL2vEbccQ86"+ ]+ , -360000, False, False+ )+ , ( "2255db56e3ff00c36461da3d7251065b0cefc657a3343146cf69dc0f418ab150"+ , ["14MZHk4dkM3ZM7bBcET4ELuyozXqCCsQpb"]+ , 120000, False, False+ )+ , ( "03e0ce2206a300bfc718afd25e1d34bc3a0b61e570913c4ab94884219b031582"+ , ["13s6R8TRWTk5DZaSQ2pKn3hfdugvEZEdZf"]+ , -120000, False, False+ )+ ]++ -- List coins of account 2+ ((map f) <$> selectList [DbCoinAccount ==. ai2] [Asc DbCoinCreated]) >>= + liftIO . assertEqual "Check coins txA 2"+ [ ( "53fe1114579ef53affe2339d3cd5010b054515556bc9749351e96b24f9cba3d0"+ , 1, 200000+ , "76a9143f53fba59a1c17f17cf3c4b5cfcf15fa0087f1c188ac", Nothing + , "16mrBKvB9DV5YAYw7a8kYDvqwh1tJGMR5M"+ , Spent "2255db56e3ff00c36461da3d7251065b0cefc657a3343146cf69dc0f418ab150" + , False+ )+ , ( "2255db56e3ff00c36461da3d7251065b0cefc657a3343146cf69dc0f418ab150"+ , 2, 30000+ , "76a9142030bc3fec2b3783acd9e83f6e24d57568be69a988ac", Nothing + , "13wD1L9PvEgBytP5X6ykiuhB8gRP58CB5J"+ , Unspent , False+ )+ ]++ -- Check transactions of account 2+ ((map g) <$> selectList [DbTxAccount ==. ai2] [Asc DbTxCreated]) >>=+ liftIO . assertEqual "Check transactions import txA 2"+ [ ( "53fe1114579ef53affe2339d3cd5010b054515556bc9749351e96b24f9cba3d0"+ , [ "16mrBKvB9DV5YAYw7a8kYDvqwh1tJGMR5M" ]+ , 200000, False, False+ )+ , ( "2255db56e3ff00c36461da3d7251065b0cefc657a3343146cf69dc0f418ab150"+ , [ "14MZHk4dkM3ZM7bBcET4ELuyozXqCCsQpb"+ , "13GTKCtWbpRpPGca3uhTjwZWiQcqAMPh6n"+ ]+ , -170000, False, False+ )+ ]++ -- list cmdCoins of acc 1+ cmdCoins "acc1" >>= liftIO . assertEqual "Check cmdCoins txA 1" + (toJSON + [ object [ "TxID" .= T.pack "23c5dcac6ef51d36ca63cf7f3dc30163939bb208eb8e12b92183ccc1333c20bd"+ , "Index" .= (0 :: Int)+ , "Value" .= (100000 :: Int)+ , "Script" .= T.pack "76a9148062ab5c3fdf5f8f0d41fccacbb3ea8058b911ae88ac"+ , "Address" .= T.pack "1ChqhDvLVx5bjRHbdUweCsd4mgwD4fvdGL"+ ] + , object [ "TxID" .= T.pack "53fe1114579ef53affe2339d3cd5010b054515556bc9749351e96b24f9cba3d0"+ , "Index" .= (0 :: Int)+ , "Value" .= (100000 :: Int)+ , "Script" .= T.pack "76a914243d03889d49470ee721d44596fd146440e1167c88ac"+ , "Address" .= T.pack "14JcRDidCbYFBwWjP9PGJL1MRKCzUWCmaS"+ ] + , object [ "TxID" .= T.pack "53fe1114579ef53affe2339d3cd5010b054515556bc9749351e96b24f9cba3d0"+ , "Index" .= (3 :: Int)+ , "Value" .= (40000 :: Int)+ , "Script" .= T.pack "76a914740eb168ae243882a73f5467b9024431443ef12988ac"+ , "Address" .= T.pack "1Baez98Lapiu7mQLfXuUCjBreEAwFrWNd2"+ ] + ]+ )++ -- list cmdCoins of acc 2+ cmdCoins "acc2" >>= liftIO . assertEqual "Check cmdCoins txA 2" + (toJSON + [ object [ "TxID" .= T.pack "2255db56e3ff00c36461da3d7251065b0cefc657a3343146cf69dc0f418ab150"+ , "Index" .= (2 :: Int)+ , "Value" .= (30000 :: Int)+ , "Script" .= T.pack "76a9142030bc3fec2b3783acd9e83f6e24d57568be69a988ac"+ , "Address" .= T.pack "13wD1L9PvEgBytP5X6ykiuhB8gRP58CB5J"+ ] + ]+ )++ -- list cmdListTx of acc1+ cmdListTx "acc1" >>= liftIO . assertEqual "Check listTx txA 1"+ ( toJSON+ [ object [ "Recipients" .= toJSON+ [ T.pack "1ChqhDvLVx5bjRHbdUweCsd4mgwD4fvdGL"+ , T.pack "1DKe1dvRznGqmBFsHY7MmvJy3DtcfBDZbw"+ , T.pack "17yJQpBHpWyVHNshgGpCK876Nb8qqvp3rG"+ ]+ , "Value" .= (600000 :: Int)+ ]+ , object [ "Recipients" .= toJSON+ [ T.pack "16mrBKvB9DV5YAYw7a8kYDvqwh1tJGMR5M"+ , T.pack "1FLRUj4iGRZHpr9WJq3RG64cL2vEbccQ86"+ ]+ , "Value" .= (-360000 :: Int)+ ]+ , object [ "Recipients" .= toJSON+ [ T.pack "14MZHk4dkM3ZM7bBcET4ELuyozXqCCsQpb"+ ]+ , "Value" .= (120000 :: Int)+ ]+ , object [ "Recipients" .= toJSON+ [ T.pack "13s6R8TRWTk5DZaSQ2pKn3hfdugvEZEdZf"+ ]+ , "Value" .= (-120000 :: Int)+ ]+ ]+ )++ -- list cmdListTx of acc2+ cmdListTx "acc2" >>= liftIO . assertEqual "Check listTx txA 2"+ ( toJSON+ [ object [ "Recipients" .= toJSON+ [ T.pack "16mrBKvB9DV5YAYw7a8kYDvqwh1tJGMR5M" ]+ , "Value" .= (200000 :: Int)+ ]+ , object [ "Recipients" .= toJSON+ [ T.pack "14MZHk4dkM3ZM7bBcET4ELuyozXqCCsQpb"+ , T.pack "13GTKCtWbpRpPGca3uhTjwZWiQcqAMPh6n"+ ]+ , "Value" .= (-170000 :: Int)+ ]+ ]+ )++ -- Check balance of acc1+ cmdBalance "acc1" >>= liftIO . assertEqual "Check balance txA 1" + (object ["Balance" .= (240000 :: Int)])++ -- Balance of acc2 + cmdBalance "acc2" >>= liftIO . assertEqual "Check balance txA 2" + (object ["Balance" .= (30000 :: Int)])++ -- Re-Importing a transaction in the middle of the chain+ cmdImportTx (decode' $ fromJust $ hexToBS txC) >>= + liftIO . assertEqual "import txC BIS"+ ( toJSON+ [ object [ "Recipients" .= toJSON+ [ T.pack "14MZHk4dkM3ZM7bBcET4ELuyozXqCCsQpb"+ ]+ , "Value" .= (120000 :: Int)+ ]+ , object [ "Recipients" .= toJSON+ [ T.pack "14MZHk4dkM3ZM7bBcET4ELuyozXqCCsQpb"+ , T.pack "13GTKCtWbpRpPGca3uhTjwZWiQcqAMPh6n"+ ]+ , "Value" .= (-170000 :: Int)+ ]+ , object [ "Recipients" .= toJSON+ [ T.pack "13s6R8TRWTk5DZaSQ2pKn3hfdugvEZEdZf"+ ]+ , "Value" .= (-120000 :: Int)+ ]+ ]+ )++ -- Verify that the transaction orders haven't changed+ ((map g) <$> selectList [DbTxAccount ==. ai1] [Asc DbTxCreated]) >>=+ liftIO . assertEqual "Last order verification"+ [ ( "23c5dcac6ef51d36ca63cf7f3dc30163939bb208eb8e12b92183ccc1333c20bd"+ , [ "1ChqhDvLVx5bjRHbdUweCsd4mgwD4fvdGL"+ , "1DKe1dvRznGqmBFsHY7MmvJy3DtcfBDZbw"+ , "17yJQpBHpWyVHNshgGpCK876Nb8qqvp3rG"+ ]+ , 600000, False, False+ )+ , ( "53fe1114579ef53affe2339d3cd5010b054515556bc9749351e96b24f9cba3d0"+ , [ "16mrBKvB9DV5YAYw7a8kYDvqwh1tJGMR5M"+ , "1FLRUj4iGRZHpr9WJq3RG64cL2vEbccQ86"+ ]+ , -360000, False, False+ )+ , ( "2255db56e3ff00c36461da3d7251065b0cefc657a3343146cf69dc0f418ab150"+ , ["14MZHk4dkM3ZM7bBcET4ELuyozXqCCsQpb"]+ , 120000, False, False+ )+ , ( "03e0ce2206a300bfc718afd25e1d34bc3a0b61e570913c4ab94884219b031582"+ , ["13s6R8TRWTk5DZaSQ2pKn3hfdugvEZEdZf"]+ , -120000, False, False+ )+ ]++ -- Verify that the transaction order haven't changed+ ((map g) <$> selectList [DbTxAccount ==. ai2] [Asc DbTxCreated]) >>=+ liftIO . assertEqual "Last order verification 2"+ [ ( "53fe1114579ef53affe2339d3cd5010b054515556bc9749351e96b24f9cba3d0"+ , [ "16mrBKvB9DV5YAYw7a8kYDvqwh1tJGMR5M" ]+ , 200000, False, False+ )+ , ( "2255db56e3ff00c36461da3d7251065b0cefc657a3343146cf69dc0f418ab150"+ , [ "14MZHk4dkM3ZM7bBcET4ELuyozXqCCsQpb"+ , "13GTKCtWbpRpPGca3uhTjwZWiQcqAMPh6n"+ ]+ , -170000, False, False+ )+ ]+++testSend :: ( PersistStore m, PersistUnique m, PersistQuery m+ , PersistMonadBackend m ~ SqlBackend+ ) + => EitherT String m ()+testSend = do ++ -- Send some money to an outside address+ cmdSendMany "acc1" + [ ("19w9Btacp9tYgbhWE9d8yEdhR15XcjE9XZ", 20000) -- outside+ , ("1D8KWhk1x2EGqEUXi1GMJmqmRRWebH8XmT", 30000) -- outside+ ] 10000 >>= liftIO . assertEqual "send normal tx"+ ( object [ "Tx" .= T.pack "0100000001bd203c33c1cc8321b9128eeb08b29b936301c33d7fcf63ca361df56eacdcc523000000006b483045022100b45842dae5f62c6564c9133891bab410ec8b9129580bf98762fc66ae6be45b6c02207cf90bdc82e2d538a46e3580a7b639737c2d334cdd74df65ee24770d2ac8fb940121020ab91e1cdcaf0d13ca13f1b0b975184882a90ee369f4ac6eab00caacca36b423ffffffff03204e0000000000001976a91461fe4d90fbb250c29e24aaff95f14218c0d39f3388ac30750000000000001976a9148503dfd0281b679af0770d5894cdf0402047befa88ac409c0000000000001976a9146d1523de2ac60a29e60f6584956032054302e73a88ac00000000"+ , "Complete" .= True+ ]+ )++ -- Same as before but set the amount such that the change would+ -- result in dust. The dust should be donated as tx fee+ cmdSendMany "acc1" + [ ("19w9Btacp9tYgbhWE9d8yEdhR15XcjE9XZ", 44000) -- outside+ , ("1D8KWhk1x2EGqEUXi1GMJmqmRRWebH8XmT", 44000) -- outside+ ] 10000 >>= liftIO . assertEqual "send normal tx no change"+ ( object [ "Tx" .= T.pack "0100000001bd203c33c1cc8321b9128eeb08b29b936301c33d7fcf63ca361df56eacdcc523000000006a47304402207a68a43941c387787a611b7775e487dced559f7331f00aa143d87bf4c6dc447802203d56aa3c9e3b209da4396e771c734d68b6b99c52528c8255dc552fe42a7d67be0121020ab91e1cdcaf0d13ca13f1b0b975184882a90ee369f4ac6eab00caacca36b423ffffffff02e0ab0000000000001976a91461fe4d90fbb250c29e24aaff95f14218c0d39f3388ace0ab0000000000001976a9148503dfd0281b679af0770d5894cdf0402047befa88ac00000000"+ , "Complete" .= True+ ]+ )++ let emptyTx = "0100000001bd203c33c1cc8321b9128eeb08b29b936301c33d7fcf63ca361df56eacdcc5230000000000ffffffff02e0ab0000000000001976a91461fe4d90fbb250c29e24aaff95f14218c0d39f3388ace0ab0000000000001976a9148503dfd0281b679af0770d5894cdf0402047befa88ac00000000"++ -- Sign an empty shell transaction with cmdSignTx+ cmdSignTx "acc1" (decode' $ fromJust $ hexToBS emptyTx) (SigAll False) >>= + liftIO . assertEqual "sign empty transaction"+ ( object [ "Tx" .= T.pack "0100000001bd203c33c1cc8321b9128eeb08b29b936301c33d7fcf63ca361df56eacdcc523000000006a47304402207a68a43941c387787a611b7775e487dced559f7331f00aa143d87bf4c6dc447802203d56aa3c9e3b209da4396e771c734d68b6b99c52528c8255dc552fe42a7d67be0121020ab91e1cdcaf0d13ca13f1b0b975184882a90ee369f4ac6eab00caacca36b423ffffffff02e0ab0000000000001976a91461fe4d90fbb250c29e24aaff95f14218c0d39f3388ace0ab0000000000001976a9148503dfd0281b679af0770d5894cdf0402047befa88ac00000000"+ , "Complete" .= True+ ]+ )++ -- Sign an empty shell transaction with cmdSignTx. Should fail as+ -- acc2 does not have any of the inputs+ cmdSignTx "acc2" (decode' $ fromJust $ hexToBS emptyTx) (SigAll False) >>= + liftIO . assertEqual "sign empty transaction 2"+ ( object [ "Tx" .= T.pack emptyTx+ , "Complete" .= False+ ]+ )++ -- Sending more coins than you have should fail+ (runEitherT $ cmdSendMany "acc1" + [ ("15WAh7HRms3HDFLEAtMuBM4aUcwvN7B2QY", 300000) -- outside+ , ("1CzjVJfn1RmNes4ZEKGRA8VJcpCB1xfNvp", 110000) -- outside+ ] 10000) >>= liftIO . assertEqual "Send too many coins"+ (Left "chooseCoins: No solution found")++ -- Spending coins from a multisignature account+ cmdSendMany "ms1" + [ ("15WAh7HRms3HDFLEAtMuBM4aUcwvN7B2QY", 300000) -- outside+ , ("1CzjVJfn1RmNes4ZEKGRA8VJcpCB1xfNvp", 110000) -- outside+ ] 10000 >>= liftIO . assertEqual "Send coins from multisig coins"+ ( object [ "Tx" .= T.pack "0100000003711707c27ce6fad18ddf3542de57bea6dbf211a18723717ee3844e9aaec5629000000000b50047304402206fa37ea2fcc6467c788b321be6c8db6b52c1c328dfe3397c1d0c3f06b13ef1bc02203afdcca94843391019cf0a38331a85f7ae5b24df28c397adb4ebecbd5390db2901004c695221026e294fcecdcbae12a0aba1685db35c54ddfc1375d48f96ff1b8805a4bb57bfc921028bc8d8377f44de8ac8beff0dc9ccefde4cd5dded7b8cd8babe02c7147a90ba6c21039cf5d06e79871043c420fabc652f8082e702e0094f91ec14c020e9fcf48fa4d853aeffffffff85e7fcc7399ef68c3277ab4be6aecfa7f77781a99d3a8e0038f03846fb269f3104000000b600483045022100caeda000f0a7144721439020edee8c9f20f41afc63288ea732b2483f1f3b77a202207d727f06e2a5661eff977a7f29bf563a9e3fc11bc3e191a246a722cfc9ab9a6601004c695221026e294fcecdcbae12a0aba1685db35c54ddfc1375d48f96ff1b8805a4bb57bfc921028bc8d8377f44de8ac8beff0dc9ccefde4cd5dded7b8cd8babe02c7147a90ba6c21039cf5d06e79871043c420fabc652f8082e702e0094f91ec14c020e9fcf48fa4d853aeffffffff96a9342b5d88583a607e8cc43a4fd844a9dfc3ef9f72982db4dac3b708f356a104000000b500473044022070bdccc43981a4a341f27b4e8ed146301ce82c1c571f483b7d457f20bc754b4402201deefab82e52a0235c336fd24e7ccf1ec47b5751f4b8a472b0a23543d9b7e42401004c695221026e294fcecdcbae12a0aba1685db35c54ddfc1375d48f96ff1b8805a4bb57bfc921028bc8d8377f44de8ac8beff0dc9ccefde4cd5dded7b8cd8babe02c7147a90ba6c21039cf5d06e79871043c420fabc652f8082e702e0094f91ec14c020e9fcf48fa4d853aeffffffff02e0930400000000001976a9143164a7f65ce9d354a8ded150547a9523df056b3588acb0ad0100000000001976a91483948f86afa40df4836e88f402aff1e540469ba588ac00000000"+ , "Complete" .= False+ ]+ )++ _ <- cmdNewMS "signms" 2 3 []+ + _ <- cmdAddKeys "signms" [fromJust $ xPubImport "xpub69QmF5x2m5duxo856Dg622vDjsxtDCwMAaLyhVjBZDDTaKbenBfMByNJVMYKAVTEpGPDePdgjDpDyPvBPx4WpFV8zmNEa6Cx7Lk4Bn9PDcE"]++ _ <- cmdAddKeys "signms" [fromJust $ xPubImport "xpub69QmF5x2m5dv1r2xNBLTq6HGKjFDyE4iAhxhdL4FgVR8vQprruLcauxJNdASANJaZc65bmoD1snK4db9DDYAuEBo3ANZik9SHnTAKQZLDt1"]++-- cmdNewMS "test2" 2 3 []+-- cmdNewMS "test3" 2 3 []+--+-- deleteBy $ UniqueAccName "signms"+-- deleteBy $ UniqueAccName "test2"+--+-- cmdAddKeys "test3" [fromJust $ xPubImport "xpub69QmF5x2m5duvyfWu3DjU9r9CkTKp5poGCnVLBmRBgJaye7LQ9yPs55z7zPZDpp6X4BHru9EpF8hqQGNa2ipEmBx9rYq6LdvNht6M2qqxUm"]+--+-- cmdAddKeys "test3" [fromJust $ xPubImport "xpub69QmF5x2m5duxo856Dg622vDjsxtDCwMAaLyhVjBZDDTaKbenBfMByNJVMYKAVTEpGPDePdgjDpDyPvBPx4WpFV8zmNEa6Cx7Lk4Bn9PDcE"]++{- TxID: 62e7897c97eb791998d790c114c09141849c6e9aaa31d9266ab984105bda3589+ - Input: 03-01+ - Outputs:+ - 3EyLoBudu2fNY7hnQDX7iZ3kn1d9wyPc2E : 100000+ - 3EBJj6Z2FrrGUytJabTrJRD6mxCgF3d7JW : 200000+ - 3ETVUh7mn1sSiLrhUQYMByfuo32DauHKdR : 150000+ - 3AWd6mZHrvMbocVRp752ExTGnUhh1huWQp : 180000 + -}++ let fundingTx = decode' $ fromJust $ hexToBS "01000000010000000000000000000000000000000000000000000000000000000000000001030000006a47304402206992bec0f95102a9994dd77e0b910af0b19b0b94d94423c68bb49ed57890238402203b15cbb6e1edcb686891138b057acac4cb67247f6bf693f38bd35d8c6605bca201210290a14bce9d363667574a29da1b2e38d106968969f449588713bb271e28a9a4a0ffffffff04a08601000000000017a91491b00b8d4d4b8909d5d17fe8da3b09fbd64e003c87400d03000000000017a91488fb2eb63c1f992d801f538340180527510464c787f04902000000000017a9148c0ad01947abab4985837a24be0d2141dcba06398720bf02000000000017a91460c1eb9034130684ece4594384e984325d1280ad8700000000"++{- TxID: 74ea8680000dd5e4f0122e47c73de7b0b02aae478a03930c5f547f67ed3dabcb+ - Inputs: 1,2,3+ - Outputs: + - 13LjjLQGGiTL8AYMbYqBmQVyAMyQnjPZK3 : 300000+ - 1MK3xFQSekQPuety1oaVTmvLRusFYsTq3d : 140000+ - 3CDgiQ2TnKvy1AovxwFy2jsDqURN8bq856 : 80000 (Change)+ -}+ let partialTx = "01000000038935da5b1084b96a26d931aa9a6e9c844191c014c190d7981979eb977c89e76202000000b6004830450221009d876833374da1714aa42945b73fe2af9ee37fdf32b4db9dd10297c0a9a18257022065618d04ead4ba5e4201bf15f149f1429e83173d42e31246d3164f2072e6605901004c69522102779d361a5d534dfca9d480eb60a1b14741a98d29f5c984fc1afd68a8c50981232102f579364c0d0971ec9ae52f2fc870204bce00438be1b6fa695d27c9d01cfb0956210383787221b68f601aa4695c27e7eebb0d15de2ed7ef7b9981fba8cad71ae2d84253aeffffffff8935da5b1084b96a26d931aa9a6e9c844191c014c190d7981979eb977c89e76203000000b600483045022100f8f9274fcf04200031578f5bfa0ecd108f5c945d7efef5f4fe519943d945594502200941f22088458750894005366a74857b72fb59197405bd2298947d96456d165b01004c6952210285bd8161363c6e2d2c075e08ed8a956c4706ccd77497a31327bf92b2208c3587210286e3177a8ca61d2d9426b4230735631e8552cc4d6e87e1277960461b0d26aac42103e2e138589e064f347238c2ca46c1d7deb8dd9472d065d7c5cb0f91aa5cc210a953aeffffffff8935da5b1084b96a26d931aa9a6e9c844191c014c190d7981979eb977c89e76201000000b50047304402200469180f9e94bf6d1d03ce07411bfd107b78f2fb1b1a862fc39dfeece417d14b02206696f963f97d3a6aaddc295c8eaf1846fef07f44c46d3aa97f09a4c0b72476c101004c695221023206a385544defd500a54d3d3fd8982d35fa7f877fa721beb59e440186183e8a210352b7c1f82593abebcb4ad0bbf28a4317b49efc1cc3e647453c09c6375122e8f621035c9ca1f7825d2cf025f42e636f57f193dbaae5c18b08dca10bf996ddb58eb8e853aeffffffff03e0930400000000001976a91419abd2efb4cd44b132ffd6206aa35e60f9d3e4b988ace0220200000000001976a914decc77b87d2199a51532034ad63f59cae6e6c4f588ac803801000000000017a914737e1e10bbf4290c82681745b5a54449ca83d1848700000000"++-- ID: a7274a15719099c5de37741bfd70efa15bb22a9de5507d966ccdf528a4f8f4c3++ let finalTx = "01000000038935da5b1084b96a26d931aa9a6e9c844191c014c190d7981979eb977c89e76202000000fdfd00004830450221009d876833374da1714aa42945b73fe2af9ee37fdf32b4db9dd10297c0a9a18257022065618d04ead4ba5e4201bf15f149f1429e83173d42e31246d3164f2072e6605901473044022065316243de4edd6e1741580a11489a5445b4fc35efcb13aa6189f1a524f6745a022003fdf5273c90ac7d906cba33f42661dcac45e80aab9aecd4fcd5ed5e9595c239014c69522102779d361a5d534dfca9d480eb60a1b14741a98d29f5c984fc1afd68a8c50981232102f579364c0d0971ec9ae52f2fc870204bce00438be1b6fa695d27c9d01cfb0956210383787221b68f601aa4695c27e7eebb0d15de2ed7ef7b9981fba8cad71ae2d84253aeffffffff8935da5b1084b96a26d931aa9a6e9c844191c014c190d7981979eb977c89e76203000000fdfd000047304402205c1bd8303745cbcc3f3412ee6f19090519ef2b72a03c799325ebd2188783bc670220298b8b13cf726beccf0909c83016a22c8429df4a2982f7ea54b24f40dd6a27ac01483045022100f8f9274fcf04200031578f5bfa0ecd108f5c945d7efef5f4fe519943d945594502200941f22088458750894005366a74857b72fb59197405bd2298947d96456d165b014c6952210285bd8161363c6e2d2c075e08ed8a956c4706ccd77497a31327bf92b2208c3587210286e3177a8ca61d2d9426b4230735631e8552cc4d6e87e1277960461b0d26aac42103e2e138589e064f347238c2ca46c1d7deb8dd9472d065d7c5cb0f91aa5cc210a953aeffffffff8935da5b1084b96a26d931aa9a6e9c844191c014c190d7981979eb977c89e76201000000fdfd000047304402200469180f9e94bf6d1d03ce07411bfd107b78f2fb1b1a862fc39dfeece417d14b02206696f963f97d3a6aaddc295c8eaf1846fef07f44c46d3aa97f09a4c0b72476c101483045022100e865ba910c96823cc9ddf6b65d62f6d107ca5589a866f3814d048ada70a01b3102201025101604ccf2f639a7f7176517665656b04c9a531d3e542eb495095148b802014c695221023206a385544defd500a54d3d3fd8982d35fa7f877fa721beb59e440186183e8a210352b7c1f82593abebcb4ad0bbf28a4317b49efc1cc3e647453c09c6375122e8f621035c9ca1f7825d2cf025f42e636f57f193dbaae5c18b08dca10bf996ddb58eb8e853aeffffffff03e0930400000000001976a91419abd2efb4cd44b132ffd6206aa35e60f9d3e4b988ace0220200000000001976a914decc77b87d2199a51532034ad63f59cae6e6c4f588ac803801000000000017a914737e1e10bbf4290c82681745b5a54449ca83d1848700000000"++ liftIO $ assertBool "Partial transaction not complete" $ + not $ isTxComplete (decode' $ fromJust $ hexToBS partialTx)++ liftIO $ assertBool "Final transaction complete" $ + isTxComplete (decode' $ fromJust $ hexToBS finalTx)++ -- trying to sign the multisig transaction before importing the transaction+ -- funding the account. This should return the original transaction+ cmdSignTx "signms" (decode' $ fromJust $ hexToBS partialTx) (SigAll False)+ >>= liftIO . assertEqual "Sign partial multisig without coins" + ( object [ "Tx" .= T.pack partialTx+ , "Complete" .= False+ ]+ )++ -- Import the funding transaction into the wallet+ cmdImportTx fundingTx >>= liftIO . assertEqual "Importing funding tx"+ ( toJSON+ [ object [ "Recipients" .= toJSON+ [ T.pack "3EyLoBudu2fNY7hnQDX7iZ3kn1d9wyPc2E"+ , T.pack "3EBJj6Z2FrrGUytJabTrJRD6mxCgF3d7JW"+ , T.pack "3ETVUh7mn1sSiLrhUQYMByfuo32DauHKdR"+ , T.pack "3AWd6mZHrvMbocVRp752ExTGnUhh1huWQp"+ ]+ , "Value" .= (630000:: Int)+ ]+ ]+ )++ -- Import the funding transaction again. The process should be idempotent+ cmdImportTx fundingTx >>= liftIO . assertEqual "Importing funding tx"+ ( toJSON+ [ object [ "Recipients" .= toJSON+ [ T.pack "3EyLoBudu2fNY7hnQDX7iZ3kn1d9wyPc2E"+ , T.pack "3EBJj6Z2FrrGUytJabTrJRD6mxCgF3d7JW"+ , T.pack "3ETVUh7mn1sSiLrhUQYMByfuo32DauHKdR"+ , T.pack "3AWd6mZHrvMbocVRp752ExTGnUhh1huWQp"+ ]+ , "Value" .= (630000:: Int)+ ]+ ]+ )++ -- We should have 4 coins in the database+ cmdCoins "signms" >>= liftIO . assertEqual "Check coins after funding tx import" + (toJSON + [ object [ "TxID" .= T.pack "62e7897c97eb791998d790c114c09141849c6e9aaa31d9266ab984105bda3589"+ , "Index" .= (0 :: Int)+ , "Value" .= (100000 :: Int)+ , "Script" .= T.pack "a91491b00b8d4d4b8909d5d17fe8da3b09fbd64e003c87"+ , "Redeem" .= T.pack "522102690c830a595721558e2bf6c58f6ed269c3b9fa194523326bb26d9a20b0cf49532102c98a1bde30c9fd0b71e88792b512963ce8b956f8735dbb0b1a2d6da7f1385e8d2102e7166192bf2bb2433daad4ab396fc2dc09785df716ca992f8bf76ff0aed6695053ae"+ , "Address" .= T.pack "3EyLoBudu2fNY7hnQDX7iZ3kn1d9wyPc2E"+ ] + , object [ "TxID" .= T.pack "62e7897c97eb791998d790c114c09141849c6e9aaa31d9266ab984105bda3589"+ , "Index" .= (1 :: Int)+ , "Value" .= (200000 :: Int)+ , "Script" .= T.pack "a91488fb2eb63c1f992d801f538340180527510464c787"+ , "Redeem" .= T.pack "5221023206a385544defd500a54d3d3fd8982d35fa7f877fa721beb59e440186183e8a210352b7c1f82593abebcb4ad0bbf28a4317b49efc1cc3e647453c09c6375122e8f621035c9ca1f7825d2cf025f42e636f57f193dbaae5c18b08dca10bf996ddb58eb8e853ae"+ , "Address" .= T.pack "3EBJj6Z2FrrGUytJabTrJRD6mxCgF3d7JW"+ ] + , object [ "TxID" .= T.pack "62e7897c97eb791998d790c114c09141849c6e9aaa31d9266ab984105bda3589"+ , "Index" .= (2 :: Int)+ , "Value" .= (150000 :: Int)+ , "Script" .= T.pack "a9148c0ad01947abab4985837a24be0d2141dcba063987"+ , "Redeem" .= T.pack "522102779d361a5d534dfca9d480eb60a1b14741a98d29f5c984fc1afd68a8c50981232102f579364c0d0971ec9ae52f2fc870204bce00438be1b6fa695d27c9d01cfb0956210383787221b68f601aa4695c27e7eebb0d15de2ed7ef7b9981fba8cad71ae2d84253ae"+ , "Address" .= T.pack "3ETVUh7mn1sSiLrhUQYMByfuo32DauHKdR"+ ] + , object [ "TxID" .= T.pack "62e7897c97eb791998d790c114c09141849c6e9aaa31d9266ab984105bda3589"+ , "Index" .= (3 :: Int)+ , "Value" .= (180000 :: Int)+ , "Script" .= T.pack "a91460c1eb9034130684ece4594384e984325d1280ad87"+ , "Redeem" .= T.pack "52210285bd8161363c6e2d2c075e08ed8a956c4706ccd77497a31327bf92b2208c3587210286e3177a8ca61d2d9426b4230735631e8552cc4d6e87e1277960461b0d26aac42103e2e138589e064f347238c2ca46c1d7deb8dd9472d065d7c5cb0f91aa5cc210a953ae"+ , "Address" .= T.pack "3AWd6mZHrvMbocVRp752ExTGnUhh1huWQp"+ ] + ]+ )++ -- Import the partially signed transaction into the wallet+ -- This should yield a partial transaction and no output coins+ cmdImportTx (decode' $ fromJust $ hexToBS $ partialTx) >>= + liftIO . assertEqual "Importing partial tx 1"+ ( toJSON+ [ object [ "Recipients" .= toJSON+ [ T.pack "13LjjLQGGiTL8AYMbYqBmQVyAMyQnjPZK3"+ , T.pack "1MK3xFQSekQPuety1oaVTmvLRusFYsTq3d"+ ]+ , "Value" .= (-450000 :: Int)+ , "Partial" .= True+ ]+ ]+ )++ -- Re-importing the partial transaction should be an idempotent process+ cmdImportTx (decode' $ fromJust $ hexToBS $ partialTx) >>= + liftIO . assertEqual "Importing partial tx 2"+ ( toJSON+ [ object [ "Recipients" .= toJSON+ [ T.pack "13LjjLQGGiTL8AYMbYqBmQVyAMyQnjPZK3"+ , T.pack "1MK3xFQSekQPuety1oaVTmvLRusFYsTq3d"+ ]+ , "Value" .= (-450000 :: Int)+ , "Partial" .= True+ ]+ ]+ )++ -- After importing the partially signed transaction in the wallet, we should+ -- have some of the coins in "reserved" status. Additionally, the change+ -- coin should not be displayed here as importing partial transactions does+ -- not produce coins (would not make sense as TxID is wrong)+ cmdCoins "signms" >>= liftIO . assertEqual "Check coins after importing partial tx" + (toJSON + [ object [ "TxID" .= T.pack "62e7897c97eb791998d790c114c09141849c6e9aaa31d9266ab984105bda3589"+ , "Index" .= (0 :: Int)+ , "Value" .= (100000 :: Int)+ , "Script" .= T.pack "a91491b00b8d4d4b8909d5d17fe8da3b09fbd64e003c87"+ , "Redeem" .= T.pack "522102690c830a595721558e2bf6c58f6ed269c3b9fa194523326bb26d9a20b0cf49532102c98a1bde30c9fd0b71e88792b512963ce8b956f8735dbb0b1a2d6da7f1385e8d2102e7166192bf2bb2433daad4ab396fc2dc09785df716ca992f8bf76ff0aed6695053ae"+ , "Address" .= T.pack "3EyLoBudu2fNY7hnQDX7iZ3kn1d9wyPc2E"+ ] + ]+ )++ -- Now we should have the funding transaction followed by a+ -- a partially signed multisig transaction+ cmdListTx "signms" >>= liftIO . assertEqual "Final tx check MS"+ ( toJSON+ [ object [ "Recipients" .= toJSON+ [ T.pack "3EyLoBudu2fNY7hnQDX7iZ3kn1d9wyPc2E"+ , T.pack "3EBJj6Z2FrrGUytJabTrJRD6mxCgF3d7JW"+ , T.pack "3ETVUh7mn1sSiLrhUQYMByfuo32DauHKdR"+ , T.pack "3AWd6mZHrvMbocVRp752ExTGnUhh1huWQp"+ ]+ , "Value" .= (630000 :: Int)+ ]+ , object [ "Recipients" .= toJSON+ [ T.pack "13LjjLQGGiTL8AYMbYqBmQVyAMyQnjPZK3"+ , T.pack "1MK3xFQSekQPuety1oaVTmvLRusFYsTq3d"+ ]+ , "Value" .= (-450000 :: Int)+ , "Partial" .= True+ ]+ ]+ )+++ let f (Entity _ c) = ( dbCoinTxid c, dbCoinPos c+ , dbCoinValue c, dbCoinScript c+ , dbCoinRdmScript c, dbCoinAddress c+ , dbCoinStatus c, dbCoinOrphan c+ )+ g (Entity _ t) = ( dbTxTxid t, dbTxRecipients t+ , dbTxValue t, dbTxOrphan t, dbTxPartial t+ )++ (Entity msi _) <- dbGetAcc "signms"++ -- Checking the coins directly in the database+ ((map f) <$> selectList [DbCoinAccount ==. msi] [Asc DbCoinCreated]) >>= + liftIO . assertEqual "Check DB coins after importing Partial tx"+ [ ( "62e7897c97eb791998d790c114c09141849c6e9aaa31d9266ab984105bda3589"+ , 0, 100000, "a91491b00b8d4d4b8909d5d17fe8da3b09fbd64e003c87"+ , Just "522102690c830a595721558e2bf6c58f6ed269c3b9fa194523326bb26d9a20b0cf49532102c98a1bde30c9fd0b71e88792b512963ce8b956f8735dbb0b1a2d6da7f1385e8d2102e7166192bf2bb2433daad4ab396fc2dc09785df716ca992f8bf76ff0aed6695053ae"+ , "3EyLoBudu2fNY7hnQDX7iZ3kn1d9wyPc2E"+ , Unspent+ , False+ )+ , ( "62e7897c97eb791998d790c114c09141849c6e9aaa31d9266ab984105bda3589"+ , 1, 200000, "a91488fb2eb63c1f992d801f538340180527510464c787"+ , Just "5221023206a385544defd500a54d3d3fd8982d35fa7f877fa721beb59e440186183e8a210352b7c1f82593abebcb4ad0bbf28a4317b49efc1cc3e647453c09c6375122e8f621035c9ca1f7825d2cf025f42e636f57f193dbaae5c18b08dca10bf996ddb58eb8e853ae"+ , "3EBJj6Z2FrrGUytJabTrJRD6mxCgF3d7JW"+ , Reserved "74ea8680000dd5e4f0122e47c73de7b0b02aae478a03930c5f547f67ed3dabcb"+ , False+ )+ , ( "62e7897c97eb791998d790c114c09141849c6e9aaa31d9266ab984105bda3589"+ , 2, 150000, "a9148c0ad01947abab4985837a24be0d2141dcba063987"+ , Just "522102779d361a5d534dfca9d480eb60a1b14741a98d29f5c984fc1afd68a8c50981232102f579364c0d0971ec9ae52f2fc870204bce00438be1b6fa695d27c9d01cfb0956210383787221b68f601aa4695c27e7eebb0d15de2ed7ef7b9981fba8cad71ae2d84253ae"+ , "3ETVUh7mn1sSiLrhUQYMByfuo32DauHKdR"+ , Reserved "74ea8680000dd5e4f0122e47c73de7b0b02aae478a03930c5f547f67ed3dabcb"+ , False+ )+ , ( "62e7897c97eb791998d790c114c09141849c6e9aaa31d9266ab984105bda3589"+ , 3, 180000, "a91460c1eb9034130684ece4594384e984325d1280ad87"+ , Just "52210285bd8161363c6e2d2c075e08ed8a956c4706ccd77497a31327bf92b2208c3587210286e3177a8ca61d2d9426b4230735631e8552cc4d6e87e1277960461b0d26aac42103e2e138589e064f347238c2ca46c1d7deb8dd9472d065d7c5cb0f91aa5cc210a953ae"+ , "3AWd6mZHrvMbocVRp752ExTGnUhh1huWQp"+ , Reserved "74ea8680000dd5e4f0122e47c73de7b0b02aae478a03930c5f547f67ed3dabcb"+ , False+ )+ ]++ -- Checking the transactions directly in the database+ ((map g) <$> selectList [DbTxAccount ==. msi] [Asc DbTxCreated]) >>=+ liftIO . assertEqual "Check DB transactions after importing Partial tx"+ [ ( "62e7897c97eb791998d790c114c09141849c6e9aaa31d9266ab984105bda3589"+ , [ "3EyLoBudu2fNY7hnQDX7iZ3kn1d9wyPc2E"+ , "3EBJj6Z2FrrGUytJabTrJRD6mxCgF3d7JW"+ , "3ETVUh7mn1sSiLrhUQYMByfuo32DauHKdR"+ , "3AWd6mZHrvMbocVRp752ExTGnUhh1huWQp"+ ]+ , 630000 , False, False+ )+ , ( "74ea8680000dd5e4f0122e47c73de7b0b02aae478a03930c5f547f67ed3dabcb"+ , [ "13LjjLQGGiTL8AYMbYqBmQVyAMyQnjPZK3"+ , "1MK3xFQSekQPuety1oaVTmvLRusFYsTq3d"+ ]+ , -450000, False, True+ )+ ]++ -- Completing a multisig transaction+ cmdSignTx "signms" (decode' $ fromJust $ hexToBS partialTx) (SigAll False) + >>= liftIO . assertEqual "Sign partial multisig" + ( object [ "Tx" .= T.pack finalTx+ , "Complete" .= True+ ]+ )++ -- this should return the partial signature as the account is wrong+ cmdSignTx "ms1" (decode' $ fromJust $ hexToBS partialTx) (SigAll False) + >>= liftIO . assertEqual "Sign partial multisig bad acc" + ( object [ "Tx" .= T.pack partialTx+ , "Complete" .= False+ ]+ )++ -- Importing the full transaction into the wallet+ cmdImportTx (decode' $ fromJust $ hexToBS finalTx) >>= + liftIO . assertEqual "Final tx import"+ ( toJSON+ [ object [ "Recipients" .= toJSON+ [ T.pack "13LjjLQGGiTL8AYMbYqBmQVyAMyQnjPZK3"+ , T.pack "1MK3xFQSekQPuety1oaVTmvLRusFYsTq3d"+ ]+ , "Value" .= (-450000 :: Int)+ ]+ ]+ )++ -- Importing the full transaction into the wallet (again)+ cmdImportTx (decode' $ fromJust $ hexToBS finalTx) >>= + liftIO . assertEqual "Final tx import again"+ ( toJSON+ [ object [ "Recipients" .= toJSON+ [ T.pack "13LjjLQGGiTL8AYMbYqBmQVyAMyQnjPZK3"+ , T.pack "1MK3xFQSekQPuety1oaVTmvLRusFYsTq3d"+ ]+ , "Value" .= (-450000 :: Int)+ ]+ ]+ )++ -- The change coin should now be there+ cmdCoins "signms" >>= liftIO . assertEqual "Check coins after importing final tx" + (toJSON + [ object [ "TxID" .= T.pack "62e7897c97eb791998d790c114c09141849c6e9aaa31d9266ab984105bda3589"+ , "Index" .= (0 :: Int)+ , "Value" .= (100000 :: Int)+ , "Script" .= T.pack "a91491b00b8d4d4b8909d5d17fe8da3b09fbd64e003c87"+ , "Redeem" .= T.pack "522102690c830a595721558e2bf6c58f6ed269c3b9fa194523326bb26d9a20b0cf49532102c98a1bde30c9fd0b71e88792b512963ce8b956f8735dbb0b1a2d6da7f1385e8d2102e7166192bf2bb2433daad4ab396fc2dc09785df716ca992f8bf76ff0aed6695053ae"+ , "Address" .= T.pack "3EyLoBudu2fNY7hnQDX7iZ3kn1d9wyPc2E"+ ] + , object [ "TxID" .= T.pack "a7274a15719099c5de37741bfd70efa15bb22a9de5507d966ccdf528a4f8f4c3"+ , "Index" .= (2 :: Int)+ , "Value" .= (80000 :: Int)+ , "Script" .= T.pack "a914737e1e10bbf4290c82681745b5a54449ca83d18487"+ , "Redeem" .= T.pack "5221021190e8331245f9455d0b027cd9f53e2e5f530ffa48aaa4f6b9fc7657c8cd5ebe21030e08ad2233845f90e958988768b42f8e53d358efc371149049a5399ae0d3b334210380f8240eb12a1bbe20c2f441d6c2216d5eb84bbb4b926aa801180de13dbdf7c553ae"+ , "Address" .= T.pack "3CDgiQ2TnKvy1AovxwFy2jsDqURN8bq856"+ ] + ]+ )++ -- The transaction list should be the funding transaction followed by+ -- the multisig spending transaction+ cmdListTx "signms" >>= liftIO . assertEqual "Check tx after importing final tx"+ ( toJSON+ [ object [ "Recipients" .= toJSON+ [ T.pack "3EyLoBudu2fNY7hnQDX7iZ3kn1d9wyPc2E"+ , T.pack "3EBJj6Z2FrrGUytJabTrJRD6mxCgF3d7JW"+ , T.pack "3ETVUh7mn1sSiLrhUQYMByfuo32DauHKdR"+ , T.pack "3AWd6mZHrvMbocVRp752ExTGnUhh1huWQp"+ ]+ , "Value" .= (630000 :: Int)+ ]+ , object [ "Recipients" .= toJSON+ [ T.pack "13LjjLQGGiTL8AYMbYqBmQVyAMyQnjPZK3"+ , T.pack "1MK3xFQSekQPuety1oaVTmvLRusFYsTq3d"+ ]+ , "Value" .= (-450000 :: Int)+ ]+ ]+ )++ -- Checking the coins directly in the database+ ((map f) <$> selectList [DbCoinAccount ==. msi] [Asc DbCoinCreated]) >>= + liftIO . assertEqual "Check DB coins after importing Final tx"+ [ ( "62e7897c97eb791998d790c114c09141849c6e9aaa31d9266ab984105bda3589"+ , 0, 100000, "a91491b00b8d4d4b8909d5d17fe8da3b09fbd64e003c87"+ , Just "522102690c830a595721558e2bf6c58f6ed269c3b9fa194523326bb26d9a20b0cf49532102c98a1bde30c9fd0b71e88792b512963ce8b956f8735dbb0b1a2d6da7f1385e8d2102e7166192bf2bb2433daad4ab396fc2dc09785df716ca992f8bf76ff0aed6695053ae"+ , "3EyLoBudu2fNY7hnQDX7iZ3kn1d9wyPc2E"+ , Unspent+ , False+ )+ , ( "62e7897c97eb791998d790c114c09141849c6e9aaa31d9266ab984105bda3589"+ , 1, 200000, "a91488fb2eb63c1f992d801f538340180527510464c787"+ , Just "5221023206a385544defd500a54d3d3fd8982d35fa7f877fa721beb59e440186183e8a210352b7c1f82593abebcb4ad0bbf28a4317b49efc1cc3e647453c09c6375122e8f621035c9ca1f7825d2cf025f42e636f57f193dbaae5c18b08dca10bf996ddb58eb8e853ae"+ , "3EBJj6Z2FrrGUytJabTrJRD6mxCgF3d7JW"+ , Spent "a7274a15719099c5de37741bfd70efa15bb22a9de5507d966ccdf528a4f8f4c3"+ , False+ )+ , ( "62e7897c97eb791998d790c114c09141849c6e9aaa31d9266ab984105bda3589"+ , 2, 150000, "a9148c0ad01947abab4985837a24be0d2141dcba063987"+ , Just "522102779d361a5d534dfca9d480eb60a1b14741a98d29f5c984fc1afd68a8c50981232102f579364c0d0971ec9ae52f2fc870204bce00438be1b6fa695d27c9d01cfb0956210383787221b68f601aa4695c27e7eebb0d15de2ed7ef7b9981fba8cad71ae2d84253ae"+ , "3ETVUh7mn1sSiLrhUQYMByfuo32DauHKdR"+ , Spent "a7274a15719099c5de37741bfd70efa15bb22a9de5507d966ccdf528a4f8f4c3"+ , False+ )+ , ( "62e7897c97eb791998d790c114c09141849c6e9aaa31d9266ab984105bda3589"+ , 3, 180000, "a91460c1eb9034130684ece4594384e984325d1280ad87"+ , Just "52210285bd8161363c6e2d2c075e08ed8a956c4706ccd77497a31327bf92b2208c3587210286e3177a8ca61d2d9426b4230735631e8552cc4d6e87e1277960461b0d26aac42103e2e138589e064f347238c2ca46c1d7deb8dd9472d065d7c5cb0f91aa5cc210a953ae"+ , "3AWd6mZHrvMbocVRp752ExTGnUhh1huWQp"+ , Spent "a7274a15719099c5de37741bfd70efa15bb22a9de5507d966ccdf528a4f8f4c3"+ , False+ )+ , ( "a7274a15719099c5de37741bfd70efa15bb22a9de5507d966ccdf528a4f8f4c3"+ , 2, 80000, "a914737e1e10bbf4290c82681745b5a54449ca83d18487"+ , Just "5221021190e8331245f9455d0b027cd9f53e2e5f530ffa48aaa4f6b9fc7657c8cd5ebe21030e08ad2233845f90e958988768b42f8e53d358efc371149049a5399ae0d3b334210380f8240eb12a1bbe20c2f441d6c2216d5eb84bbb4b926aa801180de13dbdf7c553ae"+ , "3CDgiQ2TnKvy1AovxwFy2jsDqURN8bq856"+ , Unspent+ , False+ )+ ]++ -- Checking the transactions directly in the database+ ((map g) <$> selectList [DbTxAccount ==. msi] [Asc DbTxCreated]) >>=+ liftIO . assertEqual "Check DB transactions after importing Final tx"+ [ ( "62e7897c97eb791998d790c114c09141849c6e9aaa31d9266ab984105bda3589"+ , [ "3EyLoBudu2fNY7hnQDX7iZ3kn1d9wyPc2E"+ , "3EBJj6Z2FrrGUytJabTrJRD6mxCgF3d7JW"+ , "3ETVUh7mn1sSiLrhUQYMByfuo32DauHKdR"+ , "3AWd6mZHrvMbocVRp752ExTGnUhh1huWQp"+ ]+ , 630000 , False, False+ )+ , ( "a7274a15719099c5de37741bfd70efa15bb22a9de5507d966ccdf528a4f8f4c3"+ , [ "13LjjLQGGiTL8AYMbYqBmQVyAMyQnjPZK3"+ , "1MK3xFQSekQPuety1oaVTmvLRusFYsTq3d"+ ]+ , -450000, False, False+ )+ ]++testUtil :: ( PersistStore m, PersistUnique m, PersistQuery m+ , PersistMonadBackend m ~ SqlBackend+ ) + => EitherT String m ()+testUtil = do ++ cmdBuildRawTx "[{\"txid\":\"0100000000000000000000000000000000000000000000000000000000000000\",\"vout\":10},{\"txid\":\"0200000000000000000000000000000000000000000000000000000000000000\",\"vout\":11}]" "{\"1EWdRnLVsncoJjrfShHQxPDJPZNGNGFKgx\":100000,\"3ETVUh7mn1sSiLrhUQYMByfuo32DauHKdR\":200000}" >>= liftIO . assertEqual "Build Raw Tx"+ (toJSON $ object ["Tx" .= T.pack "010000000200000000000000000000000000000000000000000000000000000000000000010a00000000ffffffff00000000000000000000000000000000000000000000000000000000000000020b00000000ffffffff02a0860100000000001976a91494341b2515efda20f26d37a2f4f5abd424cf71f688ac400d03000000000017a9148c0ad01947abab4985837a24be0d2141dcba06398700000000"])++ let partialTx = "01000000038935da5b1084b96a26d931aa9a6e9c844191c014c190d7981979eb977c89e76202000000b6004830450221009d876833374da1714aa42945b73fe2af9ee37fdf32b4db9dd10297c0a9a18257022065618d04ead4ba5e4201bf15f149f1429e83173d42e31246d3164f2072e6605901004c69522102779d361a5d534dfca9d480eb60a1b14741a98d29f5c984fc1afd68a8c50981232102f579364c0d0971ec9ae52f2fc870204bce00438be1b6fa695d27c9d01cfb0956210383787221b68f601aa4695c27e7eebb0d15de2ed7ef7b9981fba8cad71ae2d84253aeffffffff8935da5b1084b96a26d931aa9a6e9c844191c014c190d7981979eb977c89e76203000000b600483045022100f8f9274fcf04200031578f5bfa0ecd108f5c945d7efef5f4fe519943d945594502200941f22088458750894005366a74857b72fb59197405bd2298947d96456d165b01004c6952210285bd8161363c6e2d2c075e08ed8a956c4706ccd77497a31327bf92b2208c3587210286e3177a8ca61d2d9426b4230735631e8552cc4d6e87e1277960461b0d26aac42103e2e138589e064f347238c2ca46c1d7deb8dd9472d065d7c5cb0f91aa5cc210a953aeffffffff8935da5b1084b96a26d931aa9a6e9c844191c014c190d7981979eb977c89e76201000000b50047304402200469180f9e94bf6d1d03ce07411bfd107b78f2fb1b1a862fc39dfeece417d14b02206696f963f97d3a6aaddc295c8eaf1846fef07f44c46d3aa97f09a4c0b72476c101004c695221023206a385544defd500a54d3d3fd8982d35fa7f877fa721beb59e440186183e8a210352b7c1f82593abebcb4ad0bbf28a4317b49efc1cc3e647453c09c6375122e8f621035c9ca1f7825d2cf025f42e636f57f193dbaae5c18b08dca10bf996ddb58eb8e853aeffffffff03e0930400000000001976a91419abd2efb4cd44b132ffd6206aa35e60f9d3e4b988ace0220200000000001976a914decc77b87d2199a51532034ad63f59cae6e6c4f588ac803801000000000017a914737e1e10bbf4290c82681745b5a54449ca83d1848700000000"++ let resultTx = "01000000038935da5b1084b96a26d931aa9a6e9c844191c014c190d7981979eb977c89e76202000000fdfd00004830450221009d876833374da1714aa42945b73fe2af9ee37fdf32b4db9dd10297c0a9a18257022065618d04ead4ba5e4201bf15f149f1429e83173d42e31246d3164f2072e6605901473044022065316243de4edd6e1741580a11489a5445b4fc35efcb13aa6189f1a524f6745a022003fdf5273c90ac7d906cba33f42661dcac45e80aab9aecd4fcd5ed5e9595c239014c69522102779d361a5d534dfca9d480eb60a1b14741a98d29f5c984fc1afd68a8c50981232102f579364c0d0971ec9ae52f2fc870204bce00438be1b6fa695d27c9d01cfb0956210383787221b68f601aa4695c27e7eebb0d15de2ed7ef7b9981fba8cad71ae2d84253aeffffffff8935da5b1084b96a26d931aa9a6e9c844191c014c190d7981979eb977c89e76203000000b600483045022100f8f9274fcf04200031578f5bfa0ecd108f5c945d7efef5f4fe519943d945594502200941f22088458750894005366a74857b72fb59197405bd2298947d96456d165b01004c6952210285bd8161363c6e2d2c075e08ed8a956c4706ccd77497a31327bf92b2208c3587210286e3177a8ca61d2d9426b4230735631e8552cc4d6e87e1277960461b0d26aac42103e2e138589e064f347238c2ca46c1d7deb8dd9472d065d7c5cb0f91aa5cc210a953aeffffffff8935da5b1084b96a26d931aa9a6e9c844191c014c190d7981979eb977c89e76201000000fdfd000047304402200469180f9e94bf6d1d03ce07411bfd107b78f2fb1b1a862fc39dfeece417d14b02206696f963f97d3a6aaddc295c8eaf1846fef07f44c46d3aa97f09a4c0b72476c101483045022100e865ba910c96823cc9ddf6b65d62f6d107ca5589a866f3814d048ada70a01b3102201025101604ccf2f639a7f7176517665656b04c9a531d3e542eb495095148b802014c695221023206a385544defd500a54d3d3fd8982d35fa7f877fa721beb59e440186183e8a210352b7c1f82593abebcb4ad0bbf28a4317b49efc1cc3e647453c09c6375122e8f621035c9ca1f7825d2cf025f42e636f57f193dbaae5c18b08dca10bf996ddb58eb8e853aeffffffff03e0930400000000001976a91419abd2efb4cd44b132ffd6206aa35e60f9d3e4b988ace0220200000000001976a914decc77b87d2199a51532034ad63f59cae6e6c4f588ac803801000000000017a914737e1e10bbf4290c82681745b5a54449ca83d1848700000000"++ let sigi = concat+ [ "[{"+ , "\"txid\":\"62e7897c97eb791998d790c114c09141849c6e9aaa31d9266ab984105bda3589\","+ , "\"vout\":2,"+ , "\"scriptPubKey\":\"a9148c0ad01947abab4985837a24be0d2141dcba063987\","+ , "\"scriptRedeem\":\"522102779d361a5d534dfca9d480eb60a1b14741a98d29f5c984fc1afd68a8c50981232102f579364c0d0971ec9ae52f2fc870204bce00438be1b6fa695d27c9d01cfb0956210383787221b68f601aa4695c27e7eebb0d15de2ed7ef7b9981fba8cad71ae2d84253ae\""+ , "},{"+ , "\"txid\":\"62e7897c97eb791998d790c114c09141849c6e9aaa31d9266ab984105bda3589\","+ , "\"vout\":1,"+ , "\"scriptPubKey\":\"a91488fb2eb63c1f992d801f538340180527510464c787\","+ , "\"scriptRedeem\":\"5221023206a385544defd500a54d3d3fd8982d35fa7f877fa721beb59e440186183e8a210352b7c1f82593abebcb4ad0bbf28a4317b49efc1cc3e647453c09c6375122e8f621035c9ca1f7825d2cf025f42e636f57f193dbaae5c18b08dca10bf996ddb58eb8e853ae\""+ , "}]"+ ]++ -- WIF for 3ETVUh7mn1sSiLrhUQYMByfuo32DauHKdR (input 0)+ let prv = concat+ [ "["+ , "\"L4rxfXmwUDpmkpfmUAaJo7ChfPgAAj18pdpF8GTVkJRheJZaFikf\","+ , "\"L5ZencGKZqtiDk2DjFn23PjMdzGo9ZNpDw5wpcgN2cX1Qzjg6zzr\""+ , "]"+ ]+ tx = decode' $ fromJust $ hexToBS partialTx++ cmdSignRawTx tx sigi prv (SigAll False) >>=+ liftIO . assertEqual "Sign raw transaction"+ ( object [ (T.pack "Tx") .= T.pack resultTx+ , (T.pack "Complete") .= False+ ]+ )+
+ tests/Network/Haskoin/Wallet/Tests.hs view
@@ -0,0 +1,156 @@+module Network.Haskoin.Wallet.Tests (tests) where++import Test.Framework (Test, testGroup)+import Test.Framework.Providers.QuickCheck2 (testProperty)++import Control.Monad (liftM2)+import Control.Applicative ((<$>))++import Data.Word (Word32, Word64)+import Data.Bits ((.&.))+import Data.Maybe (fromJust)+import qualified Data.ByteString as BS (length)++import QuickCheckUtils+import Network.Haskoin.Wallet.Arbitrary++import Network.Haskoin.Wallet+import Network.Haskoin.Wallet.TxBuilder+import Network.Haskoin.Script+import Network.Haskoin.Crypto+import Network.Haskoin.Protocol+import Network.Haskoin.Util+import Network.Haskoin.Util.BuildMonad++tests :: [Test]+tests = + [ testGroup "HDW Extended Keys"+ [ testProperty "prvSubKey(k,c)*G = pubSubKey(k*G,c)" subkeyTest+ , testProperty "decode . encode prvKey" binXPrvKey+ , testProperty "decode . encode pubKey" binXPubKey+ , testProperty "fromB58 . toB58 prvKey" b58PrvKey+ , testProperty "fromB58 . toB58 pubKey" b58PubKey+ ]+ , testGroup "HDW Extended Key Manager"+ [ testProperty "decode . encode masterKey" decEncMaster+ , testProperty "decode . encode prvAccKey" decEncPrvAcc+ , testProperty "decode . encode pubAccKey" decEncPubAcc+ ]+ , testGroup "Building Transactions"+ [ testProperty "building address tx" testBuildAddrTx+ , testProperty "testing guessTxSize function" testGuessSize+ , testProperty "testing chooseCoins function" testChooseCoins+ , testProperty "testing chooseMSCoins function" testChooseMSCoins+ ]+ , testGroup "Signing Transactions"+ [ testProperty "Check signed transaction status" testSignTxBuild+ , testProperty "Sign and validate transactions" testSignTxValidate+ ]+ ]++{- HDW Extended Keys -}++subkeyTest :: XPrvKey -> Word32 -> Bool+subkeyTest k i = fromJust $ liftM2 (==) + (deriveXPubKey <$> prvSubKey k i') (pubSubKey (deriveXPubKey k) i')+ where i' = fromIntegral $ i .&. 0x7fffffff -- make it a public derivation++binXPrvKey :: XPrvKey -> Bool+binXPrvKey k = (decode' $ encode' k) == k++binXPubKey :: XPubKey -> Bool+binXPubKey k = (decode' $ encode' k) == k++b58PrvKey :: XPrvKey -> Bool+b58PrvKey k = (fromJust $ xPrvImport $ xPrvExport k) == k++b58PubKey :: XPubKey -> Bool+b58PubKey k = (fromJust $ xPubImport $ xPubExport k) == k++{- HDW Extended Key Manager -}++decEncMaster :: MasterKey -> Bool+decEncMaster k = (fromJust $ loadMasterKey $ decode' bs) == k+ where bs = encode' $ masterKey k++decEncPrvAcc :: AccPrvKey -> Bool+decEncPrvAcc k = (fromJust $ loadPrvAcc $ decode' bs) == k+ where bs = encode' $ getAccPrvKey k++decEncPubAcc :: AccPubKey -> Bool+decEncPubAcc k = (fromJust $ loadPubAcc $ decode' bs) == k+ where bs = encode' $ getAccPubKey k++{- Building Transactions -}++testBuildAddrTx :: [OutPoint] -> Address -> Word64 -> Bool+testBuildAddrTx os a v + | v <= 2100000000000000 = isRight tx && case a of+ x@(PubKeyAddress _) -> Right (PayPKHash x) == out+ x@(ScriptAddress _) -> Right (PayScriptHash x) == out+ | otherwise = isLeft tx+ where tx = buildAddrTx os [(addrToBase58 a,v)]+ out = decodeOutput $ scriptOutput $ txOut (fromRight tx) !! 0++testGuessSize :: RegularTx -> Bool+testGuessSize (RegularTx tx) =+ -- We compute an upper bound but it should be close enough to the real size+ -- We give 3 bytes of slack on every signature (1 on r and 2 on s)+ guess >= len && guess - 3*delta <= len+ where delta = pki + (sum $ map fst msi)+ guess = guessTxSize pki msi pkout msout+ len = BS.length $ encode' tx+ rIns = map (decodeInput . scriptInput) $ txIn tx+ mIns = map (decodeScriptHash . scriptInput) $ txIn tx+ pki = length $ filter (isSpendPKHash . fromRight) $ + filter isRight rIns+ msi = concat $ map (shData . fromRight) $ filter isRight mIns+ shData (ScriptHashInput _ (PayMulSig keys r)) = [(r,length keys)]+ shData _ = []+ out = map (fromRight . decodeOutput . scriptOutput) $ txOut tx+ pkout = length $ filter isPayPKHash out+ msout = length $ filter isPayScriptHash out++testChooseCoins :: Word64 -> Word64 -> [Coin] -> Bool+testChooseCoins target kbfee xs = case chooseCoins target kbfee xs of+ Right (chosen,change) ->+ let outSum = sum $ map (outValue . coinTxOut) chosen+ fee = getFee kbfee (length chosen) + in outSum == target + change + fee+ Left _ -> + let fee = getFee kbfee (length xs) + in target == 0 || s < target || s < target + fee+ where s = sum $ map (outValue . coinTxOut) xs++testChooseMSCoins :: Word64 -> Word64 -> MSParam -> [Coin] -> Bool+testChooseMSCoins target kbfee (MSParam m n) xs = + case chooseMSCoins target kbfee (m,n) xs of+ Right (chosen,change) ->+ let outSum = sum $ map (outValue . coinTxOut) chosen+ fee = getMSFee kbfee (m,n) (length chosen) + in outSum == target + change + fee+ Left _ -> + let fee = getMSFee kbfee (m,n) (length xs) + in target == 0 || s < target + fee+ where s = sum $ map (outValue . coinTxOut) xs++{- Signing Transactions -}++testSignTxBuild :: PKHashSigTemplate -> Bool+testSignTxBuild (PKHashSigTemplate tx sigi prv)+ | null $ txIn tx = isBroken txSig && isBroken txSigP+ | otherwise = isComplete txSig && isPartial txSigP+ where txSig = detSignTx tx sigi prv+ txSigP = detSignTx tx (tail sigi) (tail prv)+ +testSignTxValidate :: PKHashSigTemplate -> Bool+testSignTxValidate (PKHashSigTemplate tx sigi prv) =+ case detSignTx tx sigi prv of+ (Broken _) -> True+ (Partial btx) -> not $ verifyTx btx $ map f sigi+ (Complete btx) -> verifyTx btx $ map f sigi+ where f si = (sigDataOut si, sigDataOP si)++-- todo: test p2sh transactions++
+ tests/QuickCheckUtils.hs view
@@ -0,0 +1,44 @@+module QuickCheckUtils where++import Test.QuickCheck + ( Arbitrary+ , arbitrary+ , vectorOf+ , choose+ )++import Control.Applicative ((<$>))+import Data.List (permutations)++import Network.Haskoin.Wallet+import Network.Haskoin.Wallet.Arbitrary ()+import Network.Haskoin.Script+import Network.Haskoin.Crypto+import Network.Haskoin.Protocol+import Network.Haskoin.Util++data PKHashSigTemplate = PKHashSigTemplate Tx [SigInput] [PrvKey]+ deriving (Eq, Show)++-- Generates data for signing a PKHash transaction+instance Arbitrary PKHashSigTemplate where+ arbitrary = do+ inCount <- choose (0,10)+ perm <- choose (0,max 0 $ inCount-1)+ outPoints <- vectorOf inCount arbitrary+ prvKeys <- vectorOf inCount arbitrary+ sigHashes <- vectorOf inCount arbitrary+ payTo <- choose (0,10) >>= \n -> do+ h <- (map (addrToBase58 . PubKeyAddress)) <$> vectorOf n arbitrary + v <- vectorOf n $ choose (1,2100000000000000)+ return $ zip h v+ let pubKeys = map derivePubKey prvKeys+ scriptOut = map (PayPKHash . pubKeyAddr) pubKeys+ scripts = map encodeOutput scriptOut+ sigInputs = map (\(s,o,h) -> SigInput s o h) + (zip3 scripts outPoints sigHashes)+ perInputs = (permutations sigInputs) !! perm+ perKeys = (permutations prvKeys) !! perm+ tx = fromRight $ buildAddrTx outPoints payTo+ return $ PKHashSigTemplate tx perInputs perKeys+
+ tests/Units.hs view
@@ -0,0 +1,452 @@+module Units (tests) where++import Test.HUnit (Assertion, assertBool)+import Test.Framework (Test, testGroup)+import Test.Framework.Providers.HUnit (testCase)++import Data.Word (Word32, Word64)+import Data.Maybe (fromJust, catMaybes)+import Data.Binary.Get (getWord32le)+import qualified Data.ByteString as BS (reverse)++import Network.Haskoin.Wallet+import Network.Haskoin.Wallet.TxBuilder+import Network.Haskoin.Protocol+import Network.Haskoin.Crypto+import Network.Haskoin.Util++tests :: [Test]+tests =+ [ testGroup "BIP32 derivation vector 1" + [ testCase "Chain m" $ runXKeyVec (xKeyVec !! 0)+ , testCase "Chain m/0'" $ runXKeyVec (xKeyVec !! 1)+ , testCase "Chain m/0'/1" $ runXKeyVec (xKeyVec !! 2)+ , testCase "Chain m/0'/1/2'" $ runXKeyVec (xKeyVec !! 3)+ , testCase "Chain m/0'/1/2'/2" $ runXKeyVec (xKeyVec !! 4)+ , testCase "Chain m/0'/1/2'/2/1000000000" $ + runXKeyVec (xKeyVec !! 5)+ ] + , testGroup "BIP32 subkey derivation vector 2" + [ testCase "Chain m" $ runXKeyVec (xKeyVec2 !! 0)+ , testCase "Chain m/0" $ runXKeyVec (xKeyVec2 !! 1)+ , testCase "Chain m/0/2147483647'" $ + runXKeyVec (xKeyVec2 !! 2)+ , testCase "Chain m/0/2147483647'/1" $ + runXKeyVec (xKeyVec2 !! 3)+ , testCase "Chain m/0/2147483647'/1/2147483646'" $ + runXKeyVec (xKeyVec2 !! 4)+ , testCase "Chain m/0/2147483647'/1/2147483646'/2" $ + runXKeyVec (xKeyVec2 !! 5)+ ] + , testGroup "Build PKHash Transaction (generated from bitcoind)" + ( map mapPKHashVec $ zip pkHashVec [0..] )+ , testGroup "Verify transaction (bitcoind /test/data/tx_valid.json)" + ( map mapVerifyVec $ zip verifyVec [0..] )+ ]+++runXKeyVec :: ([String],XPrvKey) -> Assertion+runXKeyVec (v,m) = do+ assertBool "xPrvID" $ (bsToHex $ encode' $ xPrvID m) == v !! 0+ assertBool "xPrvFP" $ (bsToHex $ encode' $ xPrvFP m) == v !! 1+ assertBool "xPrvAddr" $ + (addrToBase58 $ xPubAddr $ deriveXPubKey m) == v !! 2+ assertBool "prvKey" $ (bsToHex $ runPut' $ putPrvKey $ xPrvKey m) == v !! 3+ assertBool "xPrvWIF" $ xPrvWIF m == v !! 4+ assertBool "pubKey" $ + (bsToHex $ encode' $ xPubKey $ deriveXPubKey m) == v !! 5+ assertBool "chain code" $ (bsToHex $ encode' $ xPrvChain m) == v !! 6+ assertBool "Hex PubKey" $ (bsToHex $ encode' $ deriveXPubKey m) == v !! 7+ assertBool "Hex PrvKey" $ (bsToHex $ encode' m) == v !! 8+ assertBool "Base58 PubKey" $ (xPubExport $ deriveXPubKey m) == v !! 9+ assertBool "Base58 PrvKey" $ xPrvExport m == v !! 10++mapPKHashVec :: (([(String,Word32)],[(String,Word64)],String),Int)+ -> Test.Framework.Test+mapPKHashVec (v,i) = testCase name $ runPKHashVec v+ where name = "Build PKHash Tx " ++ (show i)++runPKHashVec :: ([(String,Word32)],[(String,Word64)],String) -> Assertion+runPKHashVec (xs,ys,res) = + assertBool "Build PKHash Tx" $ (bsToHex $ encode' tx) == res+ where tx = fromRight $ buildAddrTx (map f xs) ys+ f (tid,ix) = OutPoint (fromJust $ decodeTxid tid) ix+++mapVerifyVec :: (([(String,String,String)],String),Int) + -> Test.Framework.Test+mapVerifyVec (v,i) = testCase name $ runVerifyVec v i+ where name = "Verify Tx " ++ (show i)++runVerifyVec :: ([(String,String,String)],String) -> Int -> Assertion+runVerifyVec (is,bsTx) i = + assertBool name $ verifyTx tx $ map f is+ where name = " > Verify transaction " ++ (show i)+ tx = decode' (fromJust $ hexToBS bsTx)+ f (o1,o2,bsScript) = + let ops = runGet' getScriptOps (fromJust $ hexToBS bsScript)+ op = OutPoint (decode' $ BS.reverse $ fromJust $ hexToBS o1) + (runGet' getWord32le $ fromJust $ hexToBS o2)+ in (Script ops,op)++-- BIP 0032 Test Vectors+-- https://en.bitcoin.it/wiki/BIP_0032_TestVectors++xKeyVec :: [([String],XPrvKey)]+xKeyVec = zip xKeyResVec $ catMaybes $ foldl f [m] der+ where f acc d = acc ++ [d =<< last acc]+ m = makeXPrvKey $ fromJust $ hexToBS m0+ der = [ flip primeSubKey 0+ , flip prvSubKey 1+ , flip primeSubKey 2+ , flip prvSubKey 2+ , flip prvSubKey 1000000000+ ]++xKeyVec2 :: [([String],XPrvKey)]+xKeyVec2 = zip xKeyResVec2 $ catMaybes $ foldl f [m] der+ where f acc d = acc ++ [d =<< last acc]+ m = makeXPrvKey $ fromJust $ hexToBS m1+ der = [ flip prvSubKey 0+ , flip primeSubKey 2147483647+ , flip prvSubKey 1+ , flip primeSubKey 2147483646+ , flip prvSubKey 2+ ]++m0 :: String+m0 = "000102030405060708090a0b0c0d0e0f"++xKeyResVec :: [[String]]+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 :: String+m1 = "fffcf9f6f3f0edeae7e4e1dedbd8d5d2cfccc9c6c3c0bdbab7b4b1aeaba8a5a29f9c999693908d8a8784817e7b7875726f6c696663605d5a5754514e4b484542"++xKeyResVec2 :: [[String]]+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"+ ]+ ]++-- These test vectors have been generated from bitcoind raw transaction api++pkHashVec :: [([(String,Word32)],[(String,Word64)],String)]+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"+ )+ ]++{- Test vectors from bitcoind -}+-- github.com/bitcoin/bitcoin/blob/master/src/test/data/tx_valid.json+++verifyVec :: [([(String,String,String)],String)]+verifyVec = + [+ -- It is of particular interest because it contains an invalidly-encoded signature which OpenSSL accepts+ ( [ + ( "60a20bd93aa49ab4b28d514ec10b06e1829ce6818ec06cd3aabd013ebcdc4bb1"+ , "00000000"+ , "514104cc71eb30d653c0c3163990c47b976f3fb3f37cccdcbedb169a1dfef58bbfbfaff7d8a473e7e2e6d317b87bafe8bde97e3cf8f065dec022b51d11fcdd0d348ac4410461cbdcc5409fb4b4d42b51d33381354d80e550078cb532a34bfa2fcfdeb7d76519aecc62770f5b0e4ef8551946d8a540911abe3e7854a26f39f58b25c15342af52ae"+ )+ ]+ , "0100000001b14bdcbc3e01bdaad36cc08e81e69c82e1060bc14e518db2b49aa43ad90ba26000000000490047304402203f16c6f40162ab686621ef3000b04e75418a0c0cb2d8aebeac894ae360ac1e780220ddc15ecdfc3507ac48e1681a33eb60996631bf6bf5bc0a0682c4db743ce7ca2b01ffffffff0140420f00000000001976a914660d4ef3a743e3e696ad990364e555c271ad504b88ac00000000"+ )+ -- It has an arbitrary extra byte stuffed into the signature at pos length - 2+ , ( [+ ( "60a20bd93aa49ab4b28d514ec10b06e1829ce6818ec06cd3aabd013ebcdc4bb1"+ , "00000000"+ , "514104cc71eb30d653c0c3163990c47b976f3fb3f37cccdcbedb169a1dfef58bbfbfaff7d8a473e7e2e6d317b87bafe8bde97e3cf8f065dec022b51d11fcdd0d348ac4410461cbdcc5409fb4b4d42b51d33381354d80e550078cb532a34bfa2fcfdeb7d76519aecc62770f5b0e4ef8551946d8a540911abe3e7854a26f39f58b25c15342af52ae"+ )+ ]+ , "0100000001b14bdcbc3e01bdaad36cc08e81e69c82e1060bc14e518db2b49aa43ad90ba260000000004A0048304402203f16c6f40162ab686621ef3000b04e75418a0c0cb2d8aebeac894ae360ac1e780220ddc15ecdfc3507ac48e1681a33eb60996631bf6bf5bc0a0682c4db743ce7ca2bab01ffffffff0140420f00000000001976a914660d4ef3a743e3e696ad990364e555c271ad504b88ac00000000"+ )+ -- it is of interest because it contains a 0-sequence as well as a signature of SIGHASH type 0 (which is not a real type)+ , ( [+ ( "406b2b06bcd34d3c8733e6b79f7a394c8a431fbf4ff5ac705c93f4076bb77602"+ , "00000000"+ , "76a914dc44b1164188067c3a32d4780f5996fa14a4f2d988ac"+ )+ ]+ , "01000000010276b76b07f4935c70acf54fbf1f438a4c397a9fb7e633873c4dd3bc062b6b40000000008c493046022100d23459d03ed7e9511a47d13292d3430a04627de6235b6e51a40f9cd386f2abe3022100e7d25b080f0bb8d8d5f878bba7d54ad2fda650ea8d158a33ee3cbd11768191fd004104b0e2c879e4daf7b9ab68350228c159766676a14f5815084ba166432aab46198d4cca98fa3e9981d0a90b2effc514b76279476550ba3663fdcaff94c38420e9d5000000000100093d00000000001976a9149a7b0f3b80c6baaeedce0a0842553800f832ba1f88ac00000000"+ )+ -- It caught a bug in the workaround for 23b397edccd3740a74adb603c9756370fafcde9bcc4483eb271ecad09a94dd63 in an overly simple implementation+ , ( [+ ( "b464e85df2a238416f8bdae11d120add610380ea07f4ef19c5f9dfd472f96c3d"+ , "00000000"+ , "76a914bef80ecf3a44500fda1bc92176e442891662aed288ac"+ )+ , ( "b7978cc96e59a8b13e0865d3f95657561a7f725be952438637475920bac9eb21"+ , "01000000"+ , "76a914bef80ecf3a44500fda1bc92176e442891662aed288ac"+ )+ ]+ , "01000000023d6cf972d4dff9c519eff407ea800361dd0a121de1da8b6f4138a2f25de864b4000000008a4730440220ffda47bfc776bcd269da4832626ac332adfca6dd835e8ecd83cd1ebe7d709b0e022049cffa1cdc102a0b56e0e04913606c70af702a1149dc3b305ab9439288fee090014104266abb36d66eb4218a6dd31f09bb92cf3cfa803c7ea72c1fc80a50f919273e613f895b855fb7465ccbc8919ad1bd4a306c783f22cd3227327694c4fa4c1c439affffffff21ebc9ba20594737864352e95b727f1a565756f9d365083eb1a8596ec98c97b7010000008a4730440220503ff10e9f1e0de731407a4a245531c9ff17676eda461f8ceeb8c06049fa2c810220c008ac34694510298fa60b3f000df01caa244f165b727d4896eb84f81e46bcc4014104266abb36d66eb4218a6dd31f09bb92cf3cfa803c7ea72c1fc80a50f919273e613f895b855fb7465ccbc8919ad1bd4a306c783f22cd3227327694c4fa4c1c439affffffff01f0da5200000000001976a914857ccd42dded6df32949d4646dfa10a92458cfaa88ac00000000"+ )+ -- It results in signing the constant 1, instead of something generated based on the transaction,+ -- when the input doing the signing has an index greater than the maximum output index+ , ( [ + ( "0000000000000000000000000000000000000000000000000000000000000100"+ , "00000000"+ , "76a914e52b482f2faa8ecbf0db344f93c84ac908557f3388ac"+ )+ , ( "0000000000000000000000000000000000000000000000000000000000000200"+ , "00000000"+ , "76a914751e76e8199196d454941c45d1b3a323f1433bd688ac"+ )+ ]+ , "01000000020002000000000000000000000000000000000000000000000000000000000000000000006a47304402200469f169b8091cd18a2770136be7411f079b3ac2b5c199885eb66a80aa3ed75002201fa89f3e6f80974e1b3474e70a0fbe907c766137ff231e4dd05a555d8544536701210279be667ef9dcbbac55a06295ce870b07029bfcdb2dce28d959f2815b16f81798ffffffff0001000000000000000000000000000000000000000000000000000000000000000000006b483045022100c9cdd08798a28af9d1baf44a6c77bcc7e279f47dc487c8c899911bc48feaffcc0220503c5c50ae3998a733263c5c0f7061b483e2b56c4c41b456e7d2f5a78a74c077032102d5c25adb51b61339d2b05315791e21bbe80ea470a49db0135720983c905aace0ffffffff010000000000000000015100000000"+ )+ -- A valid P2SH Transaction using the standard transaction type put forth in BIP 16+ , ( [+ ( "0000000000000000000000000000000000000000000000000000000000000100"+ , "00000000"+ , "a9148febbed40483661de6958d957412f82deed8e2f787"+ )+ ]+ , "01000000010001000000000000000000000000000000000000000000000000000000000000000000006e493046022100c66c9cdf4c43609586d15424c54707156e316d88b0a1534c9e6b0d4f311406310221009c0fe51dbc9c4ab7cc25d3fdbeccf6679fe6827f08edf2b4a9f16ee3eb0e438a0123210338e8034509af564c62644c07691942e0c056752008a173c89f60ab2a88ac2ebfacffffffff010000000000000000015100000000"+ )+ -- MAX_MONEY output+ , ( [+ ( "0000000000000000000000000000000000000000000000000000000000000100"+ , "00000000"+ , "a91432afac281462b822adbec5094b8d4d337dd5bd6a87"+ )+ ]+ , "01000000010001000000000000000000000000000000000000000000000000000000000000000000006e493046022100e1eadba00d9296c743cb6ecc703fd9ddc9b3cd12906176a226ae4c18d6b00796022100a71aef7d2874deff681ba6080f1b278bac7bb99c61b08a85f4311970ffe7f63f012321030c0588dc44d92bdcbf8e72093466766fdc265ead8db64517b0c542275b70fffbacffffffff010040075af0750700015100000000"+ )+ -- MAX_MONEY output + 0 output+ , ( [+ ( "0000000000000000000000000000000000000000000000000000000000000100"+ , "00000000"+ , "a914b558cbf4930954aa6a344363a15668d7477ae71687"+ )+ ]+ , "01000000010001000000000000000000000000000000000000000000000000000000000000000000006d483045022027deccc14aa6668e78a8c9da3484fbcd4f9dcc9bb7d1b85146314b21b9ae4d86022100d0b43dece8cfb07348de0ca8bc5b86276fa88f7f2138381128b7c36ab2e42264012321029bb13463ddd5d2cc05da6e84e37536cb9525703cfd8f43afdb414988987a92f6acffffffff020040075af075070001510000000000000000015100000000"+ )+ -- Simple transaction with first input is signed with SIGHASH_ALL, second with SIGHASH_ANYONECANPAY+ , ( [+ ( "0000000000000000000000000000000000000000000000000000000000000100"+ , "00000000"+ , "21035e7f0d4d0841bcd56c39337ed086b1a633ee770c1ffdd94ac552a95ac2ce0efcac"+ )+ , ( "0000000000000000000000000000000000000000000000000000000000000200"+ , "00000000"+ , "21035e7f0d4d0841bcd56c39337ed086b1a633ee770c1ffdd94ac552a95ac2ce0efcac"+ )+ ]+ , "010000000200010000000000000000000000000000000000000000000000000000000000000000000049483045022100d180fd2eb9140aeb4210c9204d3f358766eb53842b2a9473db687fa24b12a3cc022079781799cd4f038b85135bbe49ec2b57f306b2bb17101b17f71f000fcab2b6fb01ffffffff0002000000000000000000000000000000000000000000000000000000000000000000004847304402205f7530653eea9b38699e476320ab135b74771e1c48b81a5d041e2ca84b9be7a802200ac8d1f40fb026674fe5a5edd3dea715c27baa9baca51ed45ea750ac9dc0a55e81ffffffff010100000000000000015100000000"+ )+ -- Same as above, but we change the sequence number of the first input to check that SIGHASH_ANYONECANPAY is being followed+ , ( [+ ( "0000000000000000000000000000000000000000000000000000000000000100"+ , "00000000"+ , "21035e7f0d4d0841bcd56c39337ed086b1a633ee770c1ffdd94ac552a95ac2ce0efcac"+ )+ , ( "0000000000000000000000000000000000000000000000000000000000000200"+ , "00000000"+ , "21035e7f0d4d0841bcd56c39337ed086b1a633ee770c1ffdd94ac552a95ac2ce0efcac"+ )+ ]+ , "01000000020001000000000000000000000000000000000000000000000000000000000000000000004948304502203a0f5f0e1f2bdbcd04db3061d18f3af70e07f4f467cbc1b8116f267025f5360b022100c792b6e215afc5afc721a351ec413e714305cb749aae3d7fee76621313418df101010000000002000000000000000000000000000000000000000000000000000000000000000000004847304402205f7530653eea9b38699e476320ab135b74771e1c48b81a5d041e2ca84b9be7a802200ac8d1f40fb026674fe5a5edd3dea715c27baa9baca51ed45ea750ac9dc0a55e81ffffffff010100000000000000015100000000"+ )+ -- several SIGHASH_SINGLE signatures+ , ( [+ ( "63cfa5a09dc540bf63e53713b82d9ea3692ca97cd608c384f2aa88e51a0aac70"+ , "00000000"+ , "76a914dcf72c4fd02f5a987cf9b02f2fabfcac3341a87d88ac"+ )+ , ( "04e8d0fcf3846c6734477b98f0f3d4badfb78f020ee097a0be5fe347645b817d"+ , "01000000"+ , "76a914dcf72c4fd02f5a987cf9b02f2fabfcac3341a87d88ac"+ )+ , ( "ee1377aff5d0579909e11782e1d2f5f7b84d26537be7f5516dd4e43373091f3f"+ , "01000000"+ , "76a914dcf72c4fd02f5a987cf9b02f2fabfcac3341a87d88ac"+ )+ ]+ , "010000000370ac0a1ae588aaf284c308d67ca92c69a39e2db81337e563bf40c59da0a5cf63000000006a4730440220360d20baff382059040ba9be98947fd678fb08aab2bb0c172efa996fd8ece9b702201b4fb0de67f015c90e7ac8a193aeab486a1f587e0f54d0fb9552ef7f5ce6caec032103579ca2e6d107522f012cd00b52b9a65fb46f0c57b9b8b6e377c48f526a44741affffffff7d815b6447e35fbea097e00e028fb7dfbad4f3f0987b4734676c84f3fcd0e804010000006b483045022100c714310be1e3a9ff1c5f7cacc65c2d8e781fc3a88ceb063c6153bf950650802102200b2d0979c76e12bb480da635f192cc8dc6f905380dd4ac1ff35a4f68f462fffd032103579ca2e6d107522f012cd00b52b9a65fb46f0c57b9b8b6e377c48f526a44741affffffff3f1f097333e4d46d51f5e77b53264db8f7f5d2e18217e1099957d0f5af7713ee010000006c493046022100b663499ef73273a3788dea342717c2640ac43c5a1cf862c9e09b206fcb3f6bb8022100b09972e75972d9148f2bdd462e5cb69b57c1214b88fc55ca638676c07cfc10d8032103579ca2e6d107522f012cd00b52b9a65fb46f0c57b9b8b6e377c48f526a44741affffffff0380841e00000000001976a914bfb282c70c4191f45b5a6665cad1682f2c9cfdfb88ac80841e00000000001976a9149857cc07bed33a5cf12b9c5e0500b675d500c81188ace0fd1c00000000001976a91443c52850606c872403c0601e69fa34b26f62db4a88ac00000000"+ )+ ]+