diff --git a/Network/Haskoin/Wallet.hs b/Network/Haskoin/Wallet.hs new file mode 100644 --- /dev/null +++ b/Network/Haskoin/Wallet.hs @@ -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 + + diff --git a/Network/Haskoin/Wallet/Arbitrary.hs b/Network/Haskoin/Wallet/Arbitrary.hs new file mode 100644 --- /dev/null +++ b/Network/Haskoin/Wallet/Arbitrary.hs @@ -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 + diff --git a/Network/Haskoin/Wallet/Keys.hs b/Network/Haskoin/Wallet/Keys.hs new file mode 100644 --- /dev/null +++ b/Network/Haskoin/Wallet/Keys.hs @@ -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 + diff --git a/Network/Haskoin/Wallet/Manager.hs b/Network/Haskoin/Wallet/Manager.hs new file mode 100644 --- /dev/null +++ b/Network/Haskoin/Wallet/Manager.hs @@ -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) + diff --git a/Network/Haskoin/Wallet/Store.hs b/Network/Haskoin/Wallet/Store.hs new file mode 100644 --- /dev/null +++ b/Network/Haskoin/Wallet/Store.hs @@ -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: + + +-} +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)" + + diff --git a/Network/Haskoin/Wallet/Store/CoinStatus.hs b/Network/Haskoin/Wallet/Store/CoinStatus.hs new file mode 100644 --- /dev/null +++ b/Network/Haskoin/Wallet/Store/CoinStatus.hs @@ -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 + diff --git a/Network/Haskoin/Wallet/Store/DbAccount.hs b/Network/Haskoin/Wallet/Store/DbAccount.hs new file mode 100644 --- /dev/null +++ b/Network/Haskoin/Wallet/Store/DbAccount.hs @@ -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" + diff --git a/Network/Haskoin/Wallet/Store/DbAddress.hs b/Network/Haskoin/Wallet/Store/DbAddress.hs new file mode 100644 --- /dev/null +++ b/Network/Haskoin/Wallet/Store/DbAddress.hs @@ -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 + + diff --git a/Network/Haskoin/Wallet/Store/DbCoin.hs b/Network/Haskoin/Wallet/Store/DbCoin.hs new file mode 100644 --- /dev/null +++ b/Network/Haskoin/Wallet/Store/DbCoin.hs @@ -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 + + diff --git a/Network/Haskoin/Wallet/Store/DbTx.hs b/Network/Haskoin/Wallet/Store/DbTx.hs new file mode 100644 --- /dev/null +++ b/Network/Haskoin/Wallet/Store/DbTx.hs @@ -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 + diff --git a/Network/Haskoin/Wallet/Store/Util.hs b/Network/Haskoin/Wallet/Store/Util.hs new file mode 100644 --- /dev/null +++ b/Network/Haskoin/Wallet/Store/Util.hs @@ -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 + ] + + + diff --git a/Network/Haskoin/Wallet/TxBuilder.hs b/Network/Haskoin/Wallet/TxBuilder.hs new file mode 100644 --- /dev/null +++ b/Network/Haskoin/Wallet/TxBuilder.hs @@ -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) + diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/UNLICENSE b/UNLICENSE new file mode 100644 --- /dev/null +++ b/UNLICENSE @@ -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 diff --git a/haskoin-wallet.cabal b/haskoin-wallet.cabal new file mode 100644 --- /dev/null +++ b/haskoin-wallet.cabal @@ -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 + diff --git a/script/hw.hs b/script/hw.hs new file mode 100644 --- /dev/null +++ b/script/hw.hs @@ -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 [] []" + +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] + diff --git a/tests/Main.hs b/tests/Main.hs new file mode 100644 --- /dev/null +++ b/tests/Main.hs @@ -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 + ) + diff --git a/tests/Network/Haskoin/Wallet/Store/Units.hs b/tests/Network/Haskoin/Wallet/Store/Units.hs new file mode 100644 --- /dev/null +++ b/tests/Network/Haskoin/Wallet/Store/Units.hs @@ -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 + ] + ) + diff --git a/tests/Network/Haskoin/Wallet/Tests.hs b/tests/Network/Haskoin/Wallet/Tests.hs new file mode 100644 --- /dev/null +++ b/tests/Network/Haskoin/Wallet/Tests.hs @@ -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 + + diff --git a/tests/QuickCheckUtils.hs b/tests/QuickCheckUtils.hs new file mode 100644 --- /dev/null +++ b/tests/QuickCheckUtils.hs @@ -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 + diff --git a/tests/Units.hs b/tests/Units.hs new file mode 100644 --- /dev/null +++ b/tests/Units.hs @@ -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" + ) + ] +