diff --git a/Network/Haskoin/Wallet.hs b/Network/Haskoin/Wallet.hs --- a/Network/Haskoin/Wallet.hs +++ b/Network/Haskoin/Wallet.hs @@ -82,7 +82,7 @@ , importTx , importNetTx , signAccountTx -, createTx +, createWalletTx , signOfflineTx , getOfflineTxData diff --git a/Network/Haskoin/Wallet/Accounts.hs b/Network/Haskoin/Wallet/Accounts.hs --- a/Network/Haskoin/Wallet/Accounts.hs +++ b/Network/Haskoin/Wallet/Accounts.hs @@ -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 diff --git a/Network/Haskoin/Wallet/Client/Commands.hs b/Network/Haskoin/Wallet/Client/Commands.hs --- a/Network/Haskoin/Wallet/Client/Commands.hs +++ b/Network/Haskoin/Wallet/Client/Commands.hs @@ -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) ] ] diff --git a/Network/Haskoin/Wallet/Server/Handler.hs b/Network/Haskoin/Wallet/Server/Handler.hs --- a/Network/Haskoin/Wallet/Server/Handler.hs +++ b/Network/Haskoin/Wallet/Server/Handler.hs @@ -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 diff --git a/Network/Haskoin/Wallet/Transaction.hs b/Network/Haskoin/Wallet/Transaction.hs --- a/Network/Haskoin/Wallet/Transaction.hs +++ b/Network/Haskoin/Wallet/Transaction.hs @@ -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 diff --git a/Network/Haskoin/Wallet/Types.hs b/Network/Haskoin/Wallet/Types.hs --- a/Network/Haskoin/Wallet/Types.hs +++ b/Network/Haskoin/Wallet/Types.hs @@ -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 diff --git a/haskoin-wallet.cabal b/haskoin-wallet.cabal --- a/haskoin-wallet.cabal +++ b/haskoin-wallet.cabal @@ -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 diff --git a/tests/Network/Haskoin/Wallet/Units.hs b/tests/Network/Haskoin/Wallet/Units.hs --- a/tests/Network/Haskoin/Wallet/Units.hs +++ b/tests/Network/Haskoin/Wallet/Units.hs @@ -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 )