haskoin-wallet 0.3.1 → 0.4.0
raw patch · 8 files changed
+107/−84 lines, 8 filesdep +cerealdep −binarydep ~lifted-asyncdep ~stm-conduit
Dependencies added: cereal
Dependencies removed: binary
Dependency ranges changed: lifted-async, stm-conduit
Files
- Network/Haskoin/Wallet.hs +1/−1
- Network/Haskoin/Wallet/Accounts.hs +3/−2
- Network/Haskoin/Wallet/Client/Commands.hs +19/−17
- Network/Haskoin/Wallet/Server/Handler.hs +1/−1
- Network/Haskoin/Wallet/Transaction.hs +20/−18
- Network/Haskoin/Wallet/Types.hs +33/−18
- haskoin-wallet.cabal +4/−4
- tests/Network/Haskoin/Wallet/Units.hs +26/−23
Network/Haskoin/Wallet.hs view
@@ -82,7 +82,7 @@ , importTx , importNetTx , signAccountTx-, createTx+, createWalletTx , signOfflineTx , getOfflineTxData
Network/Haskoin/Wallet/Accounts.hs view
@@ -51,6 +51,7 @@ import Data.List (nub) import Data.Word (Word32) import Data.String.Conversions (cs)+import Data.Serialize (encode) import qualified Database.Persist as P (updateWhere, update , (=.)) import Database.Esqueleto@@ -589,13 +590,13 @@ pks = mapMaybe walletAddrKey addrs rdms = mapMaybe walletAddrRedeem addrs -- Add the Hash160 of the addresses- f1 b a = bloomInsert b $ encode' $ getAddrHash a+ f1 b a = bloomInsert b $ encode $ getAddrHash a bloom1 = foldl f1 bloom $ map walletAddrAddress addrs -- Add the redeem scripts f2 b r = bloomInsert b $ encodeOutputBS r bloom2 = foldl f2 bloom1 rdms -- Add the public keys- f3 b p = bloomInsert b $ encode' p+ f3 b p = bloomInsert b $ encode p bloom3 = foldl f3 bloom2 pks -- | Returns a bloom filter containing all the addresses in this wallet. This
Network/Haskoin/Wallet/Client/Commands.hs view
@@ -41,8 +41,9 @@ import qualified Control.Monad.Reader as R (ReaderT, ask, asks) import Control.Monad.Trans (liftIO) import Data.Aeson (FromJSON, ToJSON, Value (..),- decode, eitherDecode, encode,- object, toJSON, (.=))+ decode, eitherDecode, object,+ toJSON, (.=))+import qualified Data.Aeson as Aeson (encode) import qualified Data.Aeson.Encode.Pretty as JSON (Config (..), defConfig, encodePretty')@@ -53,6 +54,7 @@ listToMaybe, maybeToList) import Data.Monoid ((<>)) import Data.Restricted (rvalue)+import Data.Serialize (encode) import Data.String.Conversions (cs) import Data.Text (Text, pack, splitOn, unpack) import Data.Word (Word32, Word64)@@ -409,9 +411,9 @@ resE <- sendZmq (GetOfflineTxR (pack name) tid) handleResponse resE $ \(OfflineTxData tx dat) -> do liftIO $ putStrLn $ unwords- [ "Tx :", cs $ encodeHex $ encode' tx ]+ [ "Tx :", cs $ encodeHex $ encode tx ] liftIO $ putStrLn $ unwords- [ "CoinData:", cs $ encodeHex $ cs $ encode dat ]+ [ "CoinData:", cs $ encodeHex $ cs $ Aeson.encode dat ] _ -> error "Could not parse txid" where tidM = hexToTxHash $ cs tidStr@@ -423,7 +425,7 @@ resE <- sendZmq (PostOfflineTxR (pack name) masterM tx dat) handleResponse resE $ \(TxCompleteRes tx' c) -> do liftIO $ putStrLn $ unwords- [ "Tx :", cs $ encodeHex $ encode' tx' ]+ [ "Tx :", cs $ encodeHex $ encode tx' ] liftIO $ putStrLn $ unwords [ "Complete:", if c then "Yes" else "No" ] _ -> error "Could not decode input data"@@ -562,7 +564,7 @@ -> Handler (Either String (WalletResponse a)) sendZmq req = do cfg <- R.ask- let msg = cs $ encode req+ let msg = cs $ Aeson.encode req when (configVerbose cfg) $ liftIO $ B8.hPutStrLn stderr $ "Outgoing JSON: " `mappend` msg -- TODO: If I do this in the same thread I have to ^C twice to exit@@ -571,7 +573,7 @@ setLinger (restrict (0 :: Int)) sock setupAuth cfg sock connect sock (configConnect cfg)- send sock [] (cs $ encode req)+ send sock [] (cs $ Aeson.encode req) eitherDecode . cs <$> receive sock wait a @@ -598,12 +600,12 @@ formatStr str = forM_ (lines str) putStrLn encodeTxJSON :: Tx -> Value-encodeTxJSON tx@(Tx v is os i) = object+encodeTxJSON tx = object [ "txid" .= (cs $ txHashToHex (txHash tx) :: Text)- , "version" .= v- , "inputs" .= map encodeTxInJSON is- , "outputs" .= map encodeTxOutJSON os- , "locktime" .= i+ , "version" .= txVersion tx+ , "inputs" .= map encodeTxInJSON (txIn tx)+ , "outputs" .= map encodeTxOutJSON (txOut tx)+ , "locktime" .= txLockTime tx ] encodeTxInJSON :: TxIn -> Value@@ -651,7 +653,7 @@ RegularInput (SpendPKHash s p) -> object [ "spendpubkeyhash" .= object [ "sig" .= encodeSigJSON s- , "pubkey" .= (cs $ encodeHex (encode' p) :: Text)+ , "pubkey" .= (cs $ encodeHex (encode p) :: Text) , "sender-address" .= (cs $ addrToBase58 (pubKeyAddr p) :: Text) ] ]@@ -670,24 +672,24 @@ encodeScriptOutputJSON so = case so of PayPK p -> object [ "pay2pubkey" .= object- [ "pubkey" .= (cs $ encodeHex (encode' p) :: Text) ]+ [ "pubkey" .= (cs $ encodeHex (encode p) :: Text) ] ] PayPKHash a -> object [ "pay2pubkeyhash" .= object [ "address-base64" .=- (cs $ encodeHex (encode' $ getAddrHash a) :: Text)+ (cs $ encodeHex (encode $ getAddrHash a) :: Text) , "address-base58" .= (cs $ addrToBase58 a :: Text) ] ] PayMulSig ks r -> object [ "pay2mulsig" .= object [ "required-keys" .= r- , "pubkeys" .= (map (cs . encodeHex . encode') ks :: [Text])+ , "pubkeys" .= (map (cs . encodeHex . encode) ks :: [Text]) ] ] PayScriptHash a -> object [ "pay2scripthash" .= object- [ "address-base64" .= (cs $ encodeHex $ encode' $ getAddrHash a :: Text)+ [ "address-base64" .= (cs $ encodeHex $ encode $ getAddrHash a :: Text) , "address-base58" .= (cs (addrToBase58 a) :: Text) ] ]
Network/Haskoin/Wallet/Server/Handler.hs view
@@ -382,7 +382,7 @@ , " Rcpt. Fee : " ++ show rcptFee , " Sign : " ++ show sign ]- runDB $ createTx+ runDB $ createWalletTx accE (Just notif) masterM rs fee minconf rcptFee sign ImportTx tx -> do $(logInfo) $ format $ unlines
Network/Haskoin/Wallet/Transaction.hs view
@@ -12,7 +12,7 @@ , importTx , importNetTx , signAccountTx-, createTx+, createWalletTx , signOfflineTx , getOfflineTxData , killTxs@@ -567,12 +567,12 @@ getDataFromOutput :: TxOut -> Either String (Address, ScriptOutput) getDataFromOutput out = do so <- decodeOutputBS $ scriptOutput out- addr <- scriptRecipient $ encodeOutput so+ addr <- outputAddress so return (addr, so) isCoinbaseTx :: Tx -> Bool-isCoinbaseTx (Tx _ tin _ _) =- length tin == 1 && outPointHash (prevOutput $ head tin) ==+isCoinbaseTx tx =+ length (txIn tx) == 1 && outPointHash (prevOutput $ head (txIn tx)) == "0000000000000000000000000000000000000000000000000000000000000000" -- | Spend the given input coins. We also create dummy coins for the inputs@@ -726,13 +726,14 @@ -- List of all the decodable input addresses in the transaction allInAddrs = let f inp = do- addr <- scriptSender =<< decodeToEither (scriptInput inp)+ input <- decodeInputBS (scriptInput inp)+ addr <- inputAddress input return (addr, prevOutput inp) in rights $ map f $ txIn tx -- List of all the decodable output addresses in the transaction allOutAddrs = let f op i = do- addr <- scriptRecipient =<< decodeToEither (scriptOutput op)+ addr <- outputAddress =<< decodeOutputBS (scriptOutput op) return (addr, i, outValue op) in rights $ zipWith f (txOut tx) [0..] changeAddrs@@ -982,18 +983,19 @@ {- Transaction creation and signing (local wallet functions) -} -- | Create a transaction sending some coins to a list of recipient addresses.-createTx :: (MonadIO m, MonadThrow m, MonadBase IO m, MonadResource m)- => Entity Account -- ^ Account Entity- -> Maybe (TBMChan Notif) -- ^ Notification channel- -> Maybe XPrvKey -- ^ Key if not provided by account- -> [(Address,Word64)] -- ^ List of recipient addresses and amounts- -> Word64 -- ^ Fee per 1000 bytes- -> Word32 -- ^ Minimum confirmations- -> Bool -- ^ Should fee be paid by recipient- -> Bool -- ^ Should the transaction be signed- -> SqlPersistT m (WalletTx, [WalletAddr])- -- ^ (New transaction hash, Completed flag)-createTx accE@(Entity ai acc) notifM masterM dests fee minConf rcptFee sign = do+createWalletTx+ :: (MonadIO m, MonadThrow m, MonadBase IO m, MonadResource m)+ => Entity Account -- ^ Account Entity+ -> Maybe (TBMChan Notif) -- ^ Notification channel+ -> Maybe XPrvKey -- ^ Key if not provided by account+ -> [(Address,Word64)] -- ^ List of recipient addresses and amounts+ -> Word64 -- ^ Fee per 1000 bytes+ -> Word32 -- ^ Minimum confirmations+ -> Bool -- ^ Should fee be paid by recipient+ -> Bool -- ^ Should the transaction be signed+ -> SqlPersistT m (WalletTx, [WalletAddr])+ -- ^ (New transaction hash, Completed flag)+createWalletTx accE@(Entity ai acc) notifM masterM dests fee minConf rcptFee sign = do -- Build an unsigned transaction from the given recipient values and fee (unsignedTx, inCoins, newChangeAddrs) <- buildUnsignedTx accE dests fee minConf rcptFee
Network/Haskoin/Wallet/Types.hs view
@@ -54,19 +54,21 @@ import Control.Monad (forM, forM_, mzero, when) import Control.Monad.Trans (MonadIO) import Data.Aeson (FromJSON, ToJSON, Value (..),- decodeStrict', encode, object,+ decodeStrict', object, parseJSON, toJSON, withObject, (.!=), (.:), (.:?), (.=))+import qualified Data.Aeson as Aeson import Data.Aeson.TH (deriveJSON) import Data.Aeson.Types (Options (..), SumEncoding (..), defaultOptions, defaultTaggedObject)-import Data.Binary (Binary) import Data.Char (toLower) import Data.Int (Int64) import Data.List.Split (chunksOf) import Data.Maybe (maybeToList)+import Data.Serialize (Serialize, decode, encode)+import Data.String (fromString) import Data.String.Conversions (cs) import Data.Text (Text) import Data.Time (UTCTime)@@ -133,7 +135,7 @@ } deriving (Eq, Show, Read, Generic) -instance Binary AddressInfo+instance Serialize AddressInfo $(deriveJSON (dropFieldLabel 11) ''AddressInfo) @@ -513,7 +515,7 @@ sqlType _ = SqlString instance PersistField [XPubKey] where- toPersistValue = PersistText . cs . encode+ toPersistValue = PersistText . cs . Aeson.encode fromPersistValue (PersistText txt) = maybeToEither "Invalid Persistent XPubKey" $ decodeStrict' $ cs txt fromPersistValue (PersistByteString bs) =@@ -559,7 +561,7 @@ sqlType _ = SqlString instance PersistField AccountType where- toPersistValue = PersistText . cs . encode+ toPersistValue = PersistText . cs . Aeson.encode fromPersistValue (PersistText txt) = maybeToEither "Invalid Persistent AccountType" $ decodeStrict' $ cs txt fromPersistValue (PersistByteString bs) = maybeToEither@@ -621,9 +623,11 @@ sqlType _ = SqlString instance PersistField BloomFilter where- toPersistValue = PersistByteString . encode'+ toPersistValue = PersistByteString . encode fromPersistValue (PersistByteString bs) =- maybeToEither "Invalid Persistent BloomFilter" $ decodeToMaybe bs+ case decode bs of+ Right x -> Right x+ Left e -> Left (fromString e) fromPersistValue _ = Left "Invalid Persistent BloomFilter" instance PersistFieldSql BloomFilter where@@ -678,22 +682,30 @@ sqlType _ = SqlString instance PersistField Tx where- toPersistValue = PersistByteString . encode'+ toPersistValue = PersistByteString . encode fromPersistValue (PersistByteString bs) =- maybeToEither "Invalid Persistent Tx" $ decodeToMaybe bs+ case decode bs of+ Right x -> Right x+ Left e -> Left (fromString e) fromPersistValue _ = Left "Invalid Persistent Tx" instance PersistFieldSql Tx where sqlType _ = SqlOther "MEDIUMBLOB" instance PersistField PubKeyC where- toPersistValue = PersistText . cs . encodeHex . encode'+ toPersistValue = PersistText . cs . encodeHex . encode fromPersistValue (PersistText txt) =- maybeToEither "Invalid Persistent PubKeyC" $- decodeToMaybe =<< decodeHex (cs txt)+ case hex >>= decode of+ Right x -> Right x+ Left e -> Left (fromString e)+ where+ hex = maybeToEither "Could not decode hex" (decodeHex (cs txt)) fromPersistValue (PersistByteString bs) =- maybeToEither "Invalid Persistent PubKeyC" $- decodeToMaybe =<< decodeHex bs+ case hex >>= decode of+ Right x -> Right x+ Left e -> Left (fromString e)+ where+ hex = maybeToEither "Could not decode hex" (decodeHex bs) fromPersistValue _ = Left "Invalid Persistent PubKeyC" instance PersistFieldSql PubKeyC where@@ -702,17 +714,20 @@ instance PersistField ScriptOutput where toPersistValue = PersistByteString . encodeOutputBS fromPersistValue (PersistByteString bs) =- maybeToEither "Invalid Persistent ScriptOutput" $- eitherToMaybe $ decodeOutputBS bs+ case decodeOutputBS bs of+ Right x -> Right x+ Left e -> Left (fromString e) fromPersistValue _ = Left "Invalid Persistent ScriptOutput" instance PersistFieldSql ScriptOutput where sqlType _ = SqlBlob instance PersistField [AddressInfo] where- toPersistValue = PersistByteString . encode'+ toPersistValue = PersistByteString . encode fromPersistValue (PersistByteString bs) =- maybeToEither "Invalid Persistent AddressInfo" $ decodeToMaybe bs+ case decode bs of+ Right x -> Right x+ Left e -> Left (fromString e) fromPersistValue _ = Left "Invalid Persistent AddressInfo" instance PersistFieldSql [AddressInfo] where
haskoin-wallet.cabal view
@@ -1,5 +1,5 @@ name: haskoin-wallet-version: 0.3.1+version: 0.4.0 synopsis: Implementation of a Bitcoin SPV Wallet with BIP32 and multisig support. description:@@ -60,8 +60,8 @@ build-depends: aeson >= 0.7 && < 0.12 , aeson-pretty >= 0.7 && < 0.8 , base >= 4.8 && < 5- , binary >= 0.7 && < 0.9 , bytestring >= 0.10 && < 0.11+ , cereal >= 0.5 && < 0.6 , containers >= 0.5 && < 0.6 , conduit >= 1.2 && < 1.3 , deepseq >= 1.4 && < 1.5@@ -75,7 +75,7 @@ , haskeline , haskoin-core >= 0.3 && < 0.5 , haskoin-node >= 0.3 && < 0.5- , lifted-async >= 0.2 && < 0.9+ , lifted-async >= 0.2 && < 0.10 , lifted-base >= 0.2 && < 0.3 , monad-logger >= 0.3.13 && < 0.4 , monad-control >= 1.0 && < 1.1@@ -88,7 +88,7 @@ , split >= 0.2 && < 0.3 , stm >= 2.4 && < 2.5 , stm-chans >= 3.0 && < 3.1- , stm-conduit >= 2.6 && < 2.8+ , stm-conduit >= 2.6 && < 2.9 , string-conversions >= 0.4 && < 0.5 , text >= 0.11 && < 1.3 , time >= 1.5 && < 1.7
tests/Network/Haskoin/Wallet/Units.hs view
@@ -303,14 +303,13 @@ fakeNode parent tids chain nonce = nodeBlock parent chain header where- header = BlockHeader- { blockVersion = blockVersion $ nodeHeader parent- , prevBlock = nodeHash parent- , merkleRoot = if null tids then z else buildMerkleRoot tids- , blockTimestamp = nodeTimestamp parent + 600- , blockBits = blockBits $ nodeHeader parent- , bhNonce = nonce- }+ header = createBlockHeader+ (blockVersion $ nodeHeader parent)+ (nodeHash parent)+ (if null tids then z else buildMerkleRoot tids)+ (nodeTimestamp parent + 600)+ (blockBits $ nodeHeader parent)+ nonce -- -- Creates fake testing blocks -- fakeNode :: Word32 -> BlockHash -> NodeBlock@@ -328,7 +327,7 @@ fakeTx :: [(TxHash, Word32)] -> [(BS.ByteString, Word64)] -> Tx fakeTx xs ys =- Tx 1 txi txo 0+ createTx 1 txi txo 0 where txi = map (\(h,p) -> TxIn (OutPoint h p) (BS.pack [1]) maxBound) xs f = encodeOutputBS . PayPKHash . fromJust . base58ToAddr@@ -1085,12 +1084,14 @@ , newAccountKeys = ["xpub68kRFKHWxUt3mfJjcXdLeuDjCHnByqKSBVfMktJRXM6LSNNDR4ae6Nw1Kh621fzyKiBf6ssyZWPPTDUTQp1BhuZQuoVdtb8j2TRzqDLHmY7"] , newAccountReadOnly = False }- let fundingTx =- Tx 1 [ TxIn (OutPoint tid1 0) (BS.pack [1]) maxBound ] -- dummy input- [ TxOut 10000000 $- encodeOutputBS $ PayScriptHash $ fromJust $- base58ToAddr "32RexHZdsMoV8yzL1pQyFhYY6XeUNcWP78"- ] 0+ let fundingTx = createTx+ 1+ [ TxIn (OutPoint tid1 0) (BS.pack [1]) maxBound ] -- dummy input+ [ TxOut 10000000 $+ encodeOutputBS $ PayScriptHash $ fromJust $+ base58ToAddr "32RexHZdsMoV8yzL1pQyFhYY6XeUNcWP78"+ ]+ 0 importNetTx fundingTx Nothing >>= liftIO@@ -1099,7 +1100,7 @@ . testTx -- Create a transaction which has 0 signatures in ms1- tx1 <- fst <$> createTx accE1 Nothing Nothing+ tx1 <- fst <$> createWalletTx accE1 Nothing Nothing [ ( fromJust $ base58ToAddr "3BYWaQHz6AVXx7wXmCka4846tRfa1ccWvh" , 5000000 )@@ -1289,12 +1290,14 @@ , newAccountKeys = ["xpub68kRFKHWxUt3mfJjcXdLeuDjCHnByqKSBVfMktJRXM6LSNNDR4ae6Nw1Kh621fzyKiBf6ssyZWPPTDUTQp1BhuZQuoVdtb8j2TRzqDLHmY7"] , newAccountReadOnly = False }- let fundingTx =- Tx 1 [ TxIn (OutPoint tid1 0) (BS.pack [1]) maxBound ] -- dummy input- [ TxOut 10000000 $- encodeOutputBS $ PayScriptHash $ fromJust $- base58ToAddr "32RexHZdsMoV8yzL1pQyFhYY6XeUNcWP78"- ] 0+ let fundingTx = createTx+ 1+ [ TxIn (OutPoint tid1 0) (BS.pack [1]) maxBound ] -- dummy input+ [ TxOut 10000000 $+ encodeOutputBS $ PayScriptHash $ fromJust $+ base58ToAddr "32RexHZdsMoV8yzL1pQyFhYY6XeUNcWP78"+ ]+ 0 importNetTx fundingTx Nothing >>= liftIO@@ -1303,7 +1306,7 @@ . testTx -- Create a transaction which has 0 signatures in ms1- tx1 <- fst <$> createTx accE1 Nothing Nothing+ tx1 <- fst <$> createWalletTx accE1 Nothing Nothing [ ( fromJust $ base58ToAddr "3BYWaQHz6AVXx7wXmCka4846tRfa1ccWvh" , 5000000 )