diff --git a/CHANGELOG.md b/CHANGELOG.md index 2ebaabf..11b8225 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -5,38 +5,7 @@ All notable changes to this project will be documented in this file. The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.0.0/), and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0.html). -## [0.5.0.0] - -### Added - -- Core functions for sending transactions - -## [0.4.6.0] - -### Added - -- Display of account balance -- Functions to identify spends -- Functions to display transactions per address - -### Changed - -- Update `zcash-haskell` - -## [0.4.5.0] - -### Added - -- Functions to scan relevant transparent notes -- Functions to scan relevant Sapling notes -- Functions to scan relevant Orchard notes -- Function to query `zebrad` for commitment trees - -### Changed - -- Update `zcash-haskell` - -## [0.4.4.3] +## [Unreleased] ### Added @@ -46,7 +15,6 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 - Command line arguments to switch to legacy version - New configuration parameter for Zebra port - New functions to call `getinfo` and `getblockchaininfo` RPC methods -- `Scanner` module ## [0.4.1] diff --git a/README.md b/README.md index efabca0..2c0cfe0 100644 --- a/README.md +++ b/README.md @@ -13,25 +13,19 @@ [![Please don't upload to GitHub](https://nogithub.codeberg.page/badge.svg)](https://nogithub.codeberg.page) ![](https://img.shields.io/badge/License-MIT-green ) -Zenith is a wallet for the [Zebra](https://zfnd.org/zebra/) Zcash node . It has the following features: +Zenith is a command-line interface for the Zcash Full Node (`zcashd`). It has the following features: -- Creating new wallets. -- Creating new accounts. -- Creating new Unified Addresses. +- Listing transparent and shielded addresses and balances known to the node, including viewing-only. - Listing transactions for specific addresses, decoding memos for easy reading. - Copying addresses to the clipboard. +- Creating new Unified Addresses. - Sending transactions with shielded memo support. ## Installation - Install dependencies: - - [Cabal](https://www.haskell.org/cabal/#install-upgrade) - - [Zebra](https://zfnd.org/zebra/) - - [Cargo](https://doc.rust-lang.org/cargo/getting-started/installation.html) - - Install `cargo-c`: - ```shell - cargo install cargo-c - ``` + - [Stack](https://docs.haskellstack.org/en/stable/README/#how-to-install) + - [Zcash Full Node v.5.0.0](https://zcash.readthedocs.io/en/latest/rtd_pages/zcashd.html#install) - `xclip` - `libsecp256k1-dev` - `libxss-dev` @@ -53,16 +47,30 @@ cabal install ## Configuration -- Copy the sample `zenith.cfg` file to your home directory and update the values of your Zebra host and port. +- Copy the sample `zenith.cfg` file to a location of your choice and update the values of the user and password for the `zcashd` node. These values can be found in the `zcash.conf` file for the Zcash node. ## Usage -**Note:** This is beta software under active development. We recommend to use it on testnet. Zenith runs on the network Zebra is running, to use the testnet you need to configure your Zebra node to run on testnet. +From the location where the configured `zenith.cfg` file is placed, use `zenith` to start. -From the location where the configured `zenith.cfg` file is placed, use `zenith cli` to start. +Zenith will attempt to connect to the node and check compatibility. Connections to `zcashd` versions less than 5.0.0 will fail. -Zenith will attempt to connect to the node and start up, the app will guide you through the creation of the first wallet. +### Available commands + +- `?`: Lists available commands. +- `list`: Lists all transparent and shielded addresses and their balance. + - Notes about balances: + - Addresses from an imported viewing key will list a balance but it may be inaccurate, as viewing keys cannot see ZEC spent out of that address. + - Balances for Unified Addresses *belonging to the same account* are shared. Zenith will list the full account balances for each of the UAs in the account. +- `txs `: Lists all transactions belonging to the address corresponding to the `id` given, in chronological order. +- `copy`: Copies the selected address to the clipboard. +- `new`: Prompts the user for the option to include a transparent receiver, a Sapling receiver or both. An Orchard receiver is always included. +- `send`: Prompts the user to prepare an outgoing transaction, selecting the source address, validating the destination address, the amount and the memo. + - If the source is a transparent address, the privacy policy is set to `AllowRevealedSenders`, favoring the shielding of funds when sent to a UA. + - If the source is a shielded address, the privacy policy is set to `AllowRevealedAmounts`, favoring the move of funds from legacy shielded pools to Orchard. +- `uri`: Prompts the user to select the source account and to enter a [ZIP-321](https://zips.z.cash/zip-0321) compliant URI to generate and send a transaction. +- `exit`: Ends the session. ### Support -If you would have any questions or suggestions, please join us on our [Support channel](https://matrix.to/#/#support:vergara.tech) +If you would like to support the development of Zenith, please visit our [Free2Z](https://free2z.com/zenith-full-node-cli) page. diff --git a/app/Main.hs b/app/Main.hs index 5911cfc..d3c271b 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -16,10 +16,8 @@ import System.Environment (getArgs) import System.Exit import System.IO import Text.Read (readMaybe) -import ZcashHaskell.Types import Zenith.CLI -import Zenith.Core (clearSync, testSync) -import Zenith.Types (Config(..), ZcashAddress(..), ZcashPool(..), ZcashTx(..)) +import Zenith.Types (ZcashAddress(..), ZcashPool(..), ZcashTx(..)) import Zenith.Utils import Zenith.Zcashd @@ -206,7 +204,6 @@ main = do nodePwd <- require config "nodePwd" zebraPort <- require config "zebraPort" zebraHost <- require config "zebraHost" - let myConfig = Config dbFilePath zebraHost zebraPort if not (null args) then do case head args of @@ -220,8 +217,7 @@ main = do " ______ _ _ _ \n |___ / (_) | | | \n / / ___ _ __ _| |_| |__ \n / / / _ \\ '_ \\| | __| '_ \\ \n / /_| __/ | | | | |_| | | |\n /_____\\___|_| |_|_|\\__|_| |_|\n Zcash Full Node CLI v0.4.0" } (root nodeUser nodePwd) - "cli" -> runZenithCLI myConfig - "rescan" -> clearSync myConfig + "cli" -> runZenithCLI zebraHost zebraPort dbFilePath _ -> printUsage else printUsage @@ -231,4 +227,3 @@ printUsage = do putStrLn "Available commands:" putStrLn "legacy\tLegacy CLI for zcashd" putStrLn "cli\tCLI for zebrad" - putStrLn "rescan\tRescan the existing wallet(s)" diff --git a/app/ZenScan.hs b/app/ZenScan.hs deleted file mode 100644 index 05059ca..0000000 --- a/app/ZenScan.hs +++ /dev/null @@ -1,15 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} - -module ZenScan where - -import Control.Monad.Logger (runNoLoggingT) -import Data.Configurator -import Zenith.Scanner (scanZebra) - -main :: IO () -main = do - config <- load ["zenith.cfg"] - dbFilePath <- require config "dbFilePath" - zebraPort <- require config "zebraPort" - zebraHost <- require config "zebraHost" - runNoLoggingT $ scanZebra 2762066 zebraHost zebraPort dbFilePath diff --git a/sapling-output.params b/sapling-output.params deleted file mode 100644 index 01760fa..0000000 Binary files a/sapling-output.params and /dev/null differ diff --git a/sapling-spend.params b/sapling-spend.params deleted file mode 100644 index b91cd77..0000000 Binary files a/sapling-spend.params and /dev/null differ diff --git a/src/Zenith/CLI.hs b/src/Zenith/CLI.hs index 73409e8..8855d4e 100644 --- a/src/Zenith/CLI.hs +++ b/src/Zenith/CLI.hs @@ -1,31 +1,24 @@ {-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE TypeApplications #-} {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE ScopedTypeVariables #-} module Zenith.CLI where import qualified Brick.AttrMap as A -import qualified Brick.BChan as BC import qualified Brick.Focus as F import Brick.Forms ( Form(..) , (@@=) - , allFieldsValid - , editShowableFieldWithValidate , editTextField , focusedFormInputAttr , handleFormEvent - , invalidFormInputAttr , newForm , renderForm - , setFieldValid , updateFormState ) import qualified Brick.Main as M import qualified Brick.Types as BT import Brick.Types (Widget) -import Brick.Util (bg, clamp, fg, on, style) +import Brick.Util (fg, on, style) import qualified Brick.Widgets.Border as B import Brick.Widgets.Border.Style (unicode, unicodeBold) import qualified Brick.Widgets.Center as C @@ -42,61 +35,35 @@ import Brick.Widgets.Core , padBottom , str , strWrap - , strWrapWith , txt , txtWrap , txtWrapWith - , updateAttrMap , vBox , vLimit , withAttr , withBorderStyle ) import qualified Brick.Widgets.Dialog as D -import qualified Brick.Widgets.Edit as E import qualified Brick.Widgets.List as L -import qualified Brick.Widgets.ProgressBar as P -import Control.Concurrent (forkIO, threadDelay) -import Control.Exception (catch, throw, throwIO, try) -import Control.Monad (forever, void) +import Control.Exception (throw, throwIO, try) +import Control.Monad (void) import Control.Monad.IO.Class (liftIO) -import Control.Monad.Logger (LoggingT, runFileLoggingT, runNoLoggingT) -import Data.Aeson -import Data.HexString (toText) import Data.Maybe import qualified Data.Text as T import qualified Data.Text.Encoding as E -import Data.Time.Clock.POSIX (posixSecondsToUTCTime) import qualified Data.Vector as Vec import Database.Persist -import Database.Persist.Sqlite import qualified Graphics.Vty as V -import qualified Graphics.Vty.CrossPlatform as VC import Lens.Micro ((&), (.~), (^.), set) import Lens.Micro.Mtl import Lens.Micro.TH -import System.Hclip import Text.Wrap (FillScope(..), FillStrategy(..), WrapSettings(..), wrapText) import ZcashHaskell.Keys (generateWalletSeedPhrase, getWalletSeed) -import ZcashHaskell.Orchard (getSaplingFromUA, isValidUnifiedAddress) -import ZcashHaskell.Sapling (decodeSaplingAddress, isValidShieldedAddress) -import ZcashHaskell.Transparent - ( decodeExchangeAddress - , decodeTransparentAddress - , encodeTransparentReceiver - ) import ZcashHaskell.Types -import ZcashHaskell.Utils (getBlockTime, makeZebraCall) import Zenith.Core import Zenith.DB -import Zenith.Scanner (processTx) -import Zenith.Types - ( Config(..) - , PhraseDB(..) - , UnifiedAddressDB(..) - , ZcashNetDB(..) - ) -import Zenith.Utils (displayTaz, displayZec, jsonNumber, showAddress) +import Zenith.Types (PhraseDB(..), UnifiedAddressDB(..), ZcashNetDB(..)) +import Zenith.Utils (showAddress) data Name = WList @@ -105,9 +72,6 @@ data Name | TList | HelpDialog | DialogInputField - | RecField - | AmtField - | MemoField deriving (Eq, Show, Ord) data DialogInput = DialogInput @@ -116,42 +80,26 @@ data DialogInput = DialogInput makeLenses ''DialogInput -data SendInput = SendInput - { _sendTo :: !T.Text - , _sendAmt :: !Float - , _sendMemo :: !T.Text - } deriving (Show) - -makeLenses ''SendInput - data DialogType = WName | AName | AdName | WSelect | ASelect - | SendTx | Blank data DisplayType = AddrDisplay | MsgDisplay | PhraseDisplay - | TxDisplay - | SyncDisplay - | SendDisplay | BlankDisplay -data Tick - = TickVal !Float - | TickMsg !String - data State = State { _network :: !ZcashNet , _wallets :: !(L.List Name (Entity ZcashWallet)) , _accounts :: !(L.List Name (Entity ZcashAccount)) , _addresses :: !(L.List Name (Entity WalletAddress)) - , _transactions :: !(L.List Name (Entity UserTx)) + , _transactions :: !(L.List Name String) , _msg :: !String , _helpBox :: !Bool , _dialogBox :: !DialogType @@ -160,15 +108,7 @@ data State = State , _focusRing :: !(F.FocusRing Name) , _startBlock :: !Int , _dbPath :: !T.Text - , _zebraHost :: !T.Text - , _zebraPort :: !Int , _displayBox :: !DisplayType - , _syncBlock :: !Int - , _balance :: !Integer - , _barValue :: !Float - , _eventDispatch :: !(BC.BChan Tick) - , _timer :: !Int - , _txForm :: !(Form SendInput () Name) } makeLenses ''State @@ -198,23 +138,14 @@ drawUI s = [splashDialog s, helpDialog s, displayDialog s, inputDialog s, ui s] "(None)" (\(_, a) -> zcashAccountName $ entityVal a) (L.listSelectedElement (st ^. accounts))))) <=> - C.hCenter - (str - ("Balance: " ++ - if st ^. network == MainNet - then displayZec (st ^. balance) - else displayTaz (st ^. balance))) <=> listAddressBox "Addresses" (st ^. addresses) <+> - B.vBorder <+> - (C.hCenter (str ("Last block seen: " ++ show (st ^. syncBlock))) <=> - listTxBox "Transactions" (st ^. network) (st ^. transactions))) <=> + B.vBorder <+> C.center (listBox "Transactions" (st ^. transactions))) <=> C.hCenter (hBox [ capCommand "W" "allets" , capCommand "A" "ccounts" , capCommand "V" "iew address" , capCommand "Q" "uit" - , str $ show (st ^. timer) ]) listBox :: Show e => String -> L.List Name e -> Widget Name listBox titleLabel l = @@ -248,28 +179,7 @@ drawUI s = [splashDialog s, helpDialog s, displayDialog s, inputDialog s, ui s] (B.borderWithLabel (str titleLabel) $ hLimit 40 $ vLimit 15 $ L.renderList listDrawAddress True a) , str " " - , C.hCenter - (hBox - [ capCommand "↑↓ " "move" - , capCommand "↲ " "select" - , capCommand "Tab " "->" - ]) - ] - listTxBox :: - String -> ZcashNet -> L.List Name (Entity UserTx) -> Widget Name - listTxBox titleLabel znet tx = - C.vCenter $ - vBox - [ C.hCenter - (B.borderWithLabel (str titleLabel) $ - hLimit 50 $ vLimit 15 $ L.renderList (listDrawTx znet) True tx) - , str " " - , C.hCenter - (hBox - [ capCommand "↑↓ " "move" - , capCommand "T" "x Display" - , capCommand "Tab " "<-" - ]) + , C.hCenter $ str "Use arrows to select" ] helpDialog :: State -> Widget Name helpDialog st = @@ -329,12 +239,6 @@ drawUI s = [splashDialog s, helpDialog s, displayDialog s, inputDialog s, ui s] , capCommand "N" "ew" , xCommand ])) - SendTx -> - D.renderDialog - (D.dialog (Just (str "Send Transaction")) Nothing 50) - (renderForm (st ^. txForm) <=> - C.hCenter - (hBox [capCommand "↲ " "Send", capCommand " " "Cancel"])) Blank -> emptyWidget splashDialog :: State -> Widget Name splashDialog st = @@ -346,8 +250,7 @@ drawUI s = [splashDialog s, helpDialog s, displayDialog s, inputDialog s, ui s] titleAttr (str " _____ _ _ _ \n|__ /___ _ __ (_) |_| |__\n / // _ \\ '_ \\| | __| '_ \\\n / /| __/ | | | | |_| | | |\n/____\\___|_| |_|_|\\__|_| |_|") <=> - C.hCenter - (withAttr titleAttr (str "Zcash Wallet v0.5.1.0-beta")) <=> + C.hCenter (withAttr titleAttr (str "Zcash Wallet v0.4.4.0")) <=> C.hCenter (withAttr blinkAttr $ str "Press any key...")) else emptyWidget capCommand :: String -> String -> Widget Name @@ -367,33 +270,8 @@ drawUI s = [splashDialog s, helpDialog s, displayDialog s, inputDialog s, ui s] Nothing 60) (padAll 1 $ - B.borderWithLabel - (str "Unified") - (txtWrapWith (WrapSettings False True NoFill FillAfterFirst) $ - getUA $ walletAddressUAddress $ entityVal a) <=> - B.borderWithLabel - (str "Legacy Shielded") - (txtWrapWith (WrapSettings False True NoFill FillAfterFirst) $ - fromMaybe "None" $ - (getSaplingFromUA . - E.encodeUtf8 . getUA . walletAddressUAddress) - (entityVal a)) <=> - B.borderWithLabel - (str "Transparent") - (txtWrapWith (WrapSettings False True NoFill FillAfterFirst) $ - maybe "None" (encodeTransparentReceiver (st ^. network)) $ - t_rec =<< - (isValidUnifiedAddress . - E.encodeUtf8 . getUA . walletAddressUAddress) - (entityVal a)) <=> - C.hCenter - (hBox - [ str "Copy: " - , capCommand "U" "nified" - , capCommand "S" "apling" - , capCommand "T" "ransparent" - ]) <=> - C.hCenter xCommand) + txtWrapWith (WrapSettings False True NoFill FillAfterFirst) $ + getUA $ walletAddressUAddress $ entityVal a) Nothing -> emptyWidget PhraseDisplay -> case L.listSelectedElement $ st ^. wallets of @@ -411,54 +289,6 @@ drawUI s = [splashDialog s, helpDialog s, displayDialog s, inputDialog s, ui s] D.renderDialog (D.dialog (Just $ txt "Message") Nothing 50) (padAll 1 $ strWrap $ st ^. msg) - TxDisplay -> - case L.listSelectedElement $ st ^. transactions of - Nothing -> emptyWidget - Just (_, tx) -> - withBorderStyle unicodeBold $ - D.renderDialog - (D.dialog (Just $ txt "Transaction") Nothing 50) - (padAll - 1 - (str - ("Date: " ++ - show - (posixSecondsToUTCTime - (fromIntegral (userTxTime $ entityVal tx)))) <=> - (str "Tx ID: " <+> - strWrapWith - (WrapSettings False True NoFill FillAfterFirst) - (show (userTxHex $ entityVal tx))) <=> - str - ("Amount: " ++ - if st ^. network == MainNet - then displayZec - (fromIntegral $ userTxAmount $ entityVal tx) - else displayTaz - (fromIntegral $ userTxAmount $ entityVal tx)) <=> - (txt "Memo: " <+> - txtWrapWith - (WrapSettings False True NoFill FillAfterFirst) - (userTxMemo (entityVal tx))))) - SyncDisplay -> - withBorderStyle unicodeBold $ - D.renderDialog - (D.dialog (Just $ txt "Sync") Nothing 50) - (padAll - 1 - (updateAttrMap - (A.mapAttrNames - [ (barDoneAttr, P.progressCompleteAttr) - , (barToDoAttr, P.progressIncompleteAttr) - ]) - (P.progressBar - (Just $ show (st ^. barValue * 100)) - (_barValue st)))) - SendDisplay -> - withBorderStyle unicodeBold $ - D.renderDialog - (D.dialog (Just $ txt "Sending Transaction") Nothing 50) - (padAll 1 (str $ st ^. msg)) BlankDisplay -> emptyWidget mkInputForm :: DialogInput -> Form DialogInput e Name @@ -469,33 +299,6 @@ mkInputForm = label s w = padBottom (Pad 1) $ vLimit 1 (hLimit 15 $ str s <+> fill ' ') <+> w -mkSendForm :: Integer -> SendInput -> Form SendInput e Name -mkSendForm bal = - newForm - [ label "To: " @@= editTextField sendTo RecField (Just 1) - , label "Amount: " @@= - editShowableFieldWithValidate sendAmt AmtField (isAmountValid bal) - , label "Memo: " @@= editTextField sendMemo MemoField (Just 1) - ] - where - isAmountValid :: Integer -> Float -> Bool - isAmountValid b i = (fromIntegral b * 100000000.0) >= i - label s w = - padBottom (Pad 1) $ vLimit 1 (hLimit 15 $ str s <+> fill ' ') <+> w - -isRecipientValid :: T.Text -> Bool -isRecipientValid a = - case isValidUnifiedAddress (E.encodeUtf8 a) of - Just _a1 -> True - Nothing -> - isValidShieldedAddress (E.encodeUtf8 a) || - (case decodeTransparentAddress (E.encodeUtf8 a) of - Just _a3 -> True - Nothing -> - case decodeExchangeAddress a of - Just _a4 -> True - Nothing -> False) - listDrawElement :: (Show a) => Bool -> a -> Widget Name listDrawElement sel a = let selStr s = @@ -531,27 +334,6 @@ listDrawAddress sel w = walletAddressName (entityVal w) <> ": " <> showAddress (walletAddressUAddress (entityVal w)) -listDrawTx :: ZcashNet -> Bool -> Entity UserTx -> Widget Name -listDrawTx znet sel tx = - selStr $ - T.pack - (show $ posixSecondsToUTCTime (fromIntegral (userTxTime $ entityVal tx))) <> - " " <> T.pack fmtAmt - where - amt = fromIntegral $ userTxAmount $ entityVal tx - dispAmount = - if znet == MainNet - then displayZec amt - else displayTaz amt - fmtAmt = - if amt > 0 - then "↘" <> dispAmount <> " " - else " " <> dispAmount <> "↗" - selStr s = - if sel - then withAttr customAttr (txt $ "> " <> s) - else txt $ " " <> s - customAttr :: A.AttrName customAttr = L.listSelectedAttr <> A.attrName "custom" @@ -561,142 +343,7 @@ titleAttr = A.attrName "title" blinkAttr :: A.AttrName blinkAttr = A.attrName "blink" -baseAttr :: A.AttrName -baseAttr = A.attrName "base" - -barDoneAttr :: A.AttrName -barDoneAttr = A.attrName "done" - -barToDoAttr :: A.AttrName -barToDoAttr = A.attrName "remaining" - -validBarValue :: Float -> Float -validBarValue = clamp 0 1 - -scanZebra :: T.Text -> T.Text -> Int -> Int -> BC.BChan Tick -> IO () -scanZebra dbP zHost zPort b eChan = do - _ <- liftIO $ initDb dbP - bStatus <- liftIO $ checkBlockChain zHost zPort - pool <- runNoLoggingT $ initPool dbP - dbBlock <- runNoLoggingT $ getMaxBlock pool - let sb = max dbBlock b - if sb > zgb_blocks bStatus || sb < 1 - then do - liftIO $ BC.writeBChan eChan $ TickMsg "Invalid starting block for scan" - else do - let bList = [(sb + 1) .. (zgb_blocks bStatus)] - let step = (1.0 :: Float) / fromIntegral (zgb_blocks bStatus - (sb + 1)) - mapM_ (processBlock pool step) bList - where - processBlock :: ConnectionPool -> Float -> Int -> IO () - processBlock pool step bl = do - r <- - liftIO $ - makeZebraCall - zHost - zPort - "getblock" - [Data.Aeson.String $ T.pack $ show bl, jsonNumber 1] - case r of - Left e1 -> do - liftIO $ BC.writeBChan eChan $ TickMsg e1 - Right blk -> do - r2 <- - liftIO $ - makeZebraCall - zHost - zPort - "getblock" - [Data.Aeson.String $ T.pack $ show bl, jsonNumber 0] - case r2 of - Left e2 -> do - liftIO $ BC.writeBChan eChan $ TickMsg e2 - Right hb -> do - let blockTime = getBlockTime hb - mapM_ (runNoLoggingT . processTx zHost zPort blockTime pool) $ - bl_txs $ addTime blk blockTime - liftIO $ BC.writeBChan eChan $ TickVal step - addTime :: BlockResponse -> Int -> BlockResponse - addTime bl t = - BlockResponse - (bl_confirmations bl) - (bl_height bl) - (fromIntegral t) - (bl_txs bl) - -appEvent :: BT.BrickEvent Name Tick -> BT.EventM Name State () -appEvent (BT.AppEvent t) = do - s <- BT.get - pool <- liftIO $ runNoLoggingT $ initPool $ s ^. dbPath - case t of - TickMsg m -> do - case s ^. displayBox of - AddrDisplay -> return () - MsgDisplay -> return () - PhraseDisplay -> return () - TxDisplay -> return () - SyncDisplay -> return () - SendDisplay -> do - BT.modify $ set msg m - BlankDisplay -> return () - TickVal v -> do - case s ^. displayBox of - AddrDisplay -> return () - MsgDisplay -> return () - PhraseDisplay -> return () - TxDisplay -> return () - SendDisplay -> return () - SyncDisplay -> do - if s ^. barValue == 1.0 - then do - selWallet <- - do case L.listSelectedElement $ s ^. wallets of - Nothing -> do - let fWall = - L.listSelectedElement $ - L.listMoveToBeginning $ s ^. wallets - case fWall of - Nothing -> throw $ userError "Failed to select wallet" - Just (_j, w1) -> return w1 - Just (_k, w) -> return w - _ <- - liftIO $ - syncWallet - (Config (s ^. dbPath) (s ^. zebraHost) (s ^. zebraPort)) - selWallet - BT.modify $ set displayBox BlankDisplay - BT.modify $ set barValue 0.0 - updatedState <- BT.get - ns <- liftIO $ refreshWallet updatedState - BT.put ns - else BT.modify $ set barValue $ validBarValue (v + s ^. barValue) - BlankDisplay -> do - case s ^. dialogBox of - AName -> return () - AdName -> return () - WName -> return () - WSelect -> return () - ASelect -> return () - SendTx -> return () - Blank -> do - if s ^. timer == 90 - then do - BT.modify $ set barValue 0.0 - BT.modify $ set displayBox SyncDisplay - sBlock <- liftIO $ getMinBirthdayHeight pool - _ <- - liftIO $ - forkIO $ - scanZebra - (s ^. dbPath) - (s ^. zebraHost) - (s ^. zebraPort) - sBlock - (s ^. eventDispatch) - BT.modify $ set timer 0 - return () - else do - BT.modify $ set timer $ 1 + s ^. timer +appEvent :: BT.BrickEvent Name e -> BT.EventM Name State () appEvent (BT.VtyEvent e) = do r <- F.focusGetCurrent <$> use focusRing s <- BT.get @@ -710,63 +357,9 @@ appEvent (BT.VtyEvent e) = do _ev -> return () else do case s ^. displayBox of - AddrDisplay -> do - case e of - V.EvKey (V.KChar 'x') [] -> - BT.modify $ set displayBox BlankDisplay - V.EvKey (V.KChar 'u') [] -> do - case L.listSelectedElement $ s ^. addresses of - Just (_, a) -> do - liftIO $ - setClipboard $ - T.unpack $ - getUA $ walletAddressUAddress $ entityVal a - BT.modify $ - set msg $ - "Copied Unified Address <" ++ - T.unpack (walletAddressName (entityVal a)) ++ ">!" - BT.modify $ set displayBox MsgDisplay - Nothing -> return () - V.EvKey (V.KChar 's') [] -> do - case L.listSelectedElement $ s ^. addresses of - Just (_, a) -> do - liftIO $ - setClipboard $ - maybe "None" T.unpack $ - getSaplingFromUA $ - E.encodeUtf8 $ - getUA $ walletAddressUAddress $ entityVal a - BT.modify $ - set msg $ - "Copied Sapling Address <" ++ - T.unpack (walletAddressName (entityVal a)) ++ ">!" - BT.modify $ set displayBox MsgDisplay - Nothing -> return () - V.EvKey (V.KChar 't') [] -> do - case L.listSelectedElement $ s ^. addresses of - Just (_, a) -> do - liftIO $ - setClipboard $ - T.unpack $ - maybe - "None" - (encodeTransparentReceiver (s ^. network)) $ - t_rec =<< - (isValidUnifiedAddress . - E.encodeUtf8 . getUA . walletAddressUAddress) - (entityVal a) - BT.modify $ - set msg $ - "Copied Transparent Address <" ++ - T.unpack (walletAddressName (entityVal a)) ++ ">!" - BT.modify $ set displayBox MsgDisplay - Nothing -> return () - _ev -> return () + AddrDisplay -> BT.modify $ set displayBox BlankDisplay MsgDisplay -> BT.modify $ set displayBox BlankDisplay PhraseDisplay -> BT.modify $ set displayBox BlankDisplay - TxDisplay -> BT.modify $ set displayBox BlankDisplay - SendDisplay -> BT.modify $ set displayBox BlankDisplay - SyncDisplay -> BT.modify $ set displayBox BlankDisplay BlankDisplay -> do case s ^. dialogBox of WName -> do @@ -850,77 +443,9 @@ appEvent (BT.VtyEvent e) = do s ^. inputForm BT.modify $ set dialogBox AName ev -> BT.zoom accounts $ L.handleListEvent ev - SendTx -> do - case e of - V.EvKey V.KEsc [] -> BT.modify $ set dialogBox Blank - V.EvKey V.KEnter [] -> do - if allFieldsValid (s ^. txForm) - then do - pool <- - liftIO $ runNoLoggingT $ initPool $ s ^. dbPath - selWal <- - do case L.listSelectedElement $ s ^. wallets of - Nothing -> do - let fWall = - L.listSelectedElement $ - L.listMoveToBeginning $ s ^. wallets - case fWall of - Nothing -> - throw $ - userError "Failed to select wallet" - Just (_j, w1) -> return w1 - Just (_k, w) -> return w - selAcc <- - do case L.listSelectedElement $ s ^. accounts of - Nothing -> do - let fAcc = - L.listSelectedElement $ - L.listMoveToBeginning $ - s ^. accounts - case fAcc of - Nothing -> - throw $ - userError "Failed to select wallet" - Just (_j, w1) -> return w1 - Just (_k, w) -> return w - fs1 <- BT.zoom txForm $ BT.gets formState - bl <- - liftIO $ getLastSyncBlock pool $ entityKey selWal - _ <- - liftIO $ - forkIO $ - sendTransaction - pool - (s ^. eventDispatch) - (s ^. zebraHost) - (s ^. zebraPort) - (s ^. network) - (entityKey selAcc) - bl - (fs1 ^. sendAmt) - (fs1 ^. sendTo) - (fs1 ^. sendMemo) - BT.modify $ set msg "Preparing transaction..." - BT.modify $ set displayBox SendDisplay - BT.modify $ set dialogBox Blank - else do - BT.modify $ set msg "Invalid inputs" - BT.modify $ set displayBox MsgDisplay - BT.modify $ set dialogBox Blank - ev -> do - BT.zoom txForm $ do - handleFormEvent (BT.VtyEvent ev) - fs <- BT.gets formState - BT.modify $ - setFieldValid - (isRecipientValid (fs ^. sendTo)) - RecField Blank -> do case e of V.EvKey (V.KChar '\t') [] -> focusRing %= F.focusNext - V.EvKey V.KEnter [] -> do - ns <- liftIO $ refreshTxs s - BT.put ns V.EvKey (V.KChar 'q') [] -> M.halt V.EvKey (V.KChar '?') [] -> BT.modify $ set helpBox True V.EvKey (V.KChar 'n') [] -> @@ -929,15 +454,8 @@ appEvent (BT.VtyEvent e) = do BT.modify $ set displayBox AddrDisplay V.EvKey (V.KChar 'w') [] -> BT.modify $ set dialogBox WSelect - V.EvKey (V.KChar 't') [] -> - BT.modify $ set displayBox TxDisplay V.EvKey (V.KChar 'a') [] -> BT.modify $ set dialogBox ASelect - V.EvKey (V.KChar 's') [] -> do - BT.modify $ - set txForm $ - mkSendForm (s ^. balance) (SendInput "" 0.0 "") - BT.modify $ set dialogBox SendTx ev -> case r of Just AList -> @@ -962,15 +480,9 @@ theMap = , (titleAttr, V.withStyle (fg V.brightGreen) V.bold) , (blinkAttr, style V.blink) , (focusedFormInputAttr, V.white `on` V.blue) - , (invalidFormInputAttr, V.red `on` V.black) - , (E.editAttr, V.white `on` V.blue) - , (E.editFocusedAttr, V.blue `on` V.white) - , (baseAttr, bg V.brightBlack) - , (barDoneAttr, V.white `on` V.blue) - , (barToDoAttr, V.white `on` V.black) ] -theApp :: M.App State Tick Name +theApp :: M.App State e Name theApp = M.App { M.appDraw = drawUI @@ -980,59 +492,33 @@ theApp = , M.appAttrMap = const theMap } -runZenithCLI :: Config -> IO () -runZenithCLI config = do - let host = c_zebraHost config - let port = c_zebraPort config - let dbFilePath = c_dbPath config - pool <- runNoLoggingT $ initPool dbFilePath - w <- try $ checkZebra host port :: IO (Either IOError ZebraGetInfo) - case w of - Right zebra -> do - bc <- - try $ checkBlockChain host port :: IO - (Either IOError ZebraGetBlockChainInfo) - case bc of - Left e1 -> throwIO e1 - Right chainInfo -> do +runZenithCLI :: T.Text -> Int -> T.Text -> IO () +runZenithCLI host port dbFilePath = do + w <- checkZebra host port + case (w :: Maybe ZebraGetInfo) of + Just zebra -> do + bc <- checkBlockChain host port + case (bc :: Maybe ZebraGetBlockChainInfo) of + Nothing -> throwIO $ userError "Unable to determine blockchain status" + Just chainInfo -> do initDb dbFilePath - walList <- getWallets pool $ zgb_net chainInfo + walList <- getWallets dbFilePath $ zgb_net chainInfo accList <- if not (null walList) - then runNoLoggingT $ getAccounts pool $ entityKey $ head walList + then getAccounts dbFilePath $ entityKey $ head walList else return [] addrList <- if not (null accList) - then runNoLoggingT $ getAddresses pool $ entityKey $ head accList + then getAddresses dbFilePath $ entityKey $ head accList else return [] - txList <- - if not (null addrList) - then getUserTx pool $ entityKey $ head addrList - else return [] - let block = - if not (null walList) - then zcashWalletLastSync $ entityVal $ head walList - else 0 - bal <- - if not (null accList) - then getBalance pool $ entityKey $ head accList - else return 0 - eventChan <- BC.newBChan 10 - _ <- - forkIO $ - forever $ do - BC.writeBChan eventChan (TickVal 0.0) - threadDelay 1000000 - let buildVty = VC.mkVty V.defaultConfig - initialVty <- buildVty void $ - M.customMain initialVty buildVty (Just eventChan) theApp $ + M.defaultMain theApp $ State (zgb_net chainInfo) (L.list WList (Vec.fromList walList) 1) (L.list AcList (Vec.fromList accList) 0) (L.list AList (Vec.fromList addrList) 1) - (L.list TList (Vec.fromList txList) 1) + (L.list TList (Vec.fromList ["tx1", "tx2", "tx3"]) 1) ("Start up Ok! Connected to Zebra " ++ (T.unpack . zgi_build) zebra ++ " on port " ++ show port ++ ".") False @@ -1044,81 +530,14 @@ runZenithCLI config = do (F.focusRing [AList, TList]) (zgb_blocks chainInfo) dbFilePath - host - port MsgDisplay - block - bal - 1.0 - eventChan - 0 - (mkSendForm 0 $ SendInput "" 0.0 "") - Left e -> do + Nothing -> do print $ "No Zebra node available on port " <> - show port <> ". Check your configuration." + show port <> ". Check your configuration" refreshWallet :: State -> IO State refreshWallet s = do - pool <- runNoLoggingT $ initPool $ s ^. dbPath - walList <- getWallets pool $ s ^. network - (ix, selWallet) <- - do case L.listSelectedElement $ s ^. wallets of - Nothing -> do - let fWall = - L.listSelectedElement $ L.listMoveToBeginning $ s ^. wallets - case fWall of - Nothing -> throw $ userError "Failed to select wallet" - Just (j, w1) -> return (j, w1) - Just (k, w) -> return (k, w) - aL <- runNoLoggingT $ getAccounts pool $ entityKey selWallet - let bl = zcashWalletLastSync $ entityVal selWallet - addrL <- - if not (null aL) - then runNoLoggingT $ getAddresses pool $ entityKey $ head aL - else return [] - bal <- - if not (null aL) - then getBalance pool $ entityKey $ head aL - else return 0 - txL <- - if not (null addrL) - then getUserTx pool $ entityKey $ head addrL - else return [] - let wL = L.listReplace (Vec.fromList walList) (Just ix) (s ^. wallets) - let aL' = L.listReplace (Vec.fromList aL) (Just 0) (s ^. accounts) - let addrL' = L.listReplace (Vec.fromList addrL) (Just 0) (s ^. addresses) - let txL' = L.listReplace (Vec.fromList txL) (Just 0) (s ^. transactions) - return $ - s & wallets .~ wL & accounts .~ aL' & syncBlock .~ bl & balance .~ bal & - addresses .~ - addrL' & - transactions .~ - txL' & - msg .~ - "Switched to wallet: " ++ - T.unpack (zcashWalletName $ entityVal selWallet) - -addNewWallet :: T.Text -> State -> IO State -addNewWallet n s = do - sP <- generateWalletSeedPhrase - pool <- runNoLoggingT $ initPool $ s ^. dbPath - let bH = s ^. startBlock - let netName = s ^. network - r <- saveWallet pool $ ZcashWallet n (ZcashNetDB netName) (PhraseDB sP) bH 0 - case r of - Nothing -> do - return $ s & msg .~ ("Wallet already exists: " ++ T.unpack n) - Just _ -> do - wL <- getWallets pool netName - let aL = - L.listFindBy (\x -> zcashWalletName (entityVal x) == n) $ - L.listReplace (Vec.fromList wL) (Just 0) (s ^. wallets) - return $ (s & wallets .~ aL) & msg .~ "Created new wallet: " ++ T.unpack n - -addNewAccount :: T.Text -> State -> IO State -addNewAccount n s = do - pool <- runNoLoggingT $ initPool $ s ^. dbPath selWallet <- do case L.listSelectedElement $ s ^. wallets of Nothing -> do @@ -1128,19 +547,59 @@ addNewAccount n s = do Nothing -> throw $ userError "Failed to select wallet" Just (_j, w1) -> return w1 Just (_k, w) -> return w - aL' <- getMaxAccount pool (entityKey selWallet) + aL <- getAccounts (s ^. dbPath) $ entityKey selWallet + addrL <- + if not (null aL) + then getAddresses (s ^. dbPath) $ entityKey $ head aL + else return [] + let aL' = L.listReplace (Vec.fromList aL) (Just 0) (s ^. accounts) + let addrL' = L.listReplace (Vec.fromList addrL) (Just 0) (s ^. addresses) + return $ + (s & accounts .~ aL') & addresses .~ addrL' & msg .~ "Switched to wallet: " ++ + T.unpack (zcashWalletName $ entityVal selWallet) + +addNewWallet :: T.Text -> State -> IO State +addNewWallet n s = do + sP <- generateWalletSeedPhrase + let bH = s ^. startBlock + let netName = s ^. network + r <- + saveWallet (s ^. dbPath) $ + ZcashWallet n (ZcashNetDB netName) (PhraseDB sP) bH + case r of + Nothing -> do + return $ s & msg .~ ("Wallet already exists: " ++ T.unpack n) + Just _ -> do + wL <- getWallets (s ^. dbPath) netName + let aL = + L.listFindBy (\x -> zcashWalletName (entityVal x) == n) $ + L.listReplace (Vec.fromList wL) (Just 0) (s ^. wallets) + return $ (s & wallets .~ aL) & msg .~ "Created new wallet: " ++ T.unpack n + +addNewAccount :: T.Text -> State -> IO State +addNewAccount n s = do + selWallet <- + do case L.listSelectedElement $ s ^. wallets of + Nothing -> do + let fWall = + L.listSelectedElement $ L.listMoveToBeginning $ s ^. wallets + case fWall of + Nothing -> throw $ userError "Failed to select wallet" + Just (_j, w1) -> return w1 + Just (_k, w) -> return w + aL' <- getMaxAccount (s ^. dbPath) (entityKey selWallet) zA <- try $ createZcashAccount n (aL' + 1) selWallet :: IO (Either IOError ZcashAccount) case zA of Left e -> return $ s & msg .~ ("Error: " ++ show e) Right zA' -> do - r <- saveAccount pool zA' + r <- saveAccount (s ^. dbPath) zA' case r of Nothing -> return $ s & msg .~ ("Account already exists: " ++ T.unpack n) Just x -> do - aL <- runNoLoggingT $ getAccounts pool (entityKey selWallet) + aL <- getAccounts (s ^. dbPath) (entityKey selWallet) let nL = L.listMoveToElement x $ L.listReplace (Vec.fromList aL) (Just 0) (s ^. accounts) @@ -1149,7 +608,6 @@ addNewAccount n s = do refreshAccount :: State -> IO State refreshAccount s = do - pool <- runNoLoggingT $ initPool $ s ^. dbPath selAccount <- do case L.listSelectedElement $ s ^. accounts of Nothing -> do @@ -1159,48 +617,14 @@ refreshAccount s = do Nothing -> throw $ userError "Failed to select account" Just (_j, w1) -> return w1 Just (_k, w) -> return w - aL <- runNoLoggingT $ getAddresses pool $ entityKey selAccount - bal <- getBalance pool $ entityKey selAccount + aL <- getAddresses (s ^. dbPath) $ entityKey selAccount let aL' = L.listReplace (Vec.fromList aL) (Just 0) (s ^. addresses) - selAddress <- - do case L.listSelectedElement aL' of - Nothing -> do - let fAdd = L.listSelectedElement $ L.listMoveToBeginning aL' - return fAdd - Just a2 -> return $ Just a2 - case selAddress of - Nothing -> - return $ - s & balance .~ bal & addresses .~ aL' & msg .~ "Switched to account: " ++ - T.unpack (zcashAccountName $ entityVal selAccount) - Just (_i, a) -> do - tList <- getUserTx pool $ entityKey a - let tL' = L.listReplace (Vec.fromList tList) (Just 0) (s ^. transactions) - return $ - s & balance .~ bal & addresses .~ aL' & transactions .~ tL' & msg .~ - "Switched to account: " ++ - T.unpack (zcashAccountName $ entityVal selAccount) - -refreshTxs :: State -> IO State -refreshTxs s = do - pool <- runNoLoggingT $ initPool $ s ^. dbPath - selAddress <- - do case L.listSelectedElement $ s ^. addresses of - Nothing -> do - let fAdd = - L.listSelectedElement $ L.listMoveToBeginning $ s ^. addresses - return fAdd - Just a2 -> return $ Just a2 - case selAddress of - Nothing -> return s - Just (_i, a) -> do - tList <- getUserTx pool $ entityKey a - let tL' = L.listReplace (Vec.fromList tList) (Just 0) (s ^. transactions) - return $ s & transactions .~ tL' + return $ + s & addresses .~ aL' & msg .~ "Switched to account: " ++ + T.unpack (zcashAccountName $ entityVal selAccount) addNewAddress :: T.Text -> Scope -> State -> IO State addNewAddress n scope s = do - pool <- runNoLoggingT $ initPool $ s ^. dbPath selAccount <- do case L.listSelectedElement $ s ^. accounts of Nothing -> do @@ -1210,19 +634,19 @@ addNewAddress n scope s = do Nothing -> throw $ userError "Failed to select account" Just (_j, a1) -> return a1 Just (_k, a) -> return a - maxAddr <- getMaxAddress pool (entityKey selAccount) scope + maxAddr <- getMaxAddress (s ^. dbPath) (entityKey selAccount) scope uA <- try $ createWalletAddress n (maxAddr + 1) (s ^. network) scope selAccount :: IO (Either IOError WalletAddress) case uA of Left e -> return $ s & msg .~ ("Error: " ++ show e) Right uA' -> do - nAddr <- saveAddress pool uA' + nAddr <- saveAddress (s ^. dbPath) uA' case nAddr of Nothing -> return $ s & msg .~ ("Address already exists: " ++ T.unpack n) Just x -> do - addrL <- runNoLoggingT $ getAddresses pool (entityKey selAccount) + addrL <- getAddresses (s ^. dbPath) (entityKey selAccount) let nL = L.listMoveToElement x $ L.listReplace (Vec.fromList addrL) (Just 0) (s ^. addresses) @@ -1231,51 +655,3 @@ addNewAddress n scope s = do T.unpack n ++ "(" ++ T.unpack (showAddress $ walletAddressUAddress $ entityVal x) ++ ")" - -sendTransaction :: - ConnectionPool - -> BC.BChan Tick - -> T.Text - -> Int - -> ZcashNet - -> ZcashAccountId - -> Int - -> Float - -> T.Text - -> T.Text - -> IO () -sendTransaction pool chan zHost zPort znet accId bl amt ua memo = do - BC.writeBChan chan $ TickMsg "Preparing transaction..." - outUA <- parseAddress ua - res <- - runFileLoggingT "zenith.log" $ - prepareTx pool zHost zPort znet accId bl amt outUA memo - BC.writeBChan chan $ TickMsg "Transaction ready, sending to Zebra..." - case res of - Left e -> BC.writeBChan chan $ TickMsg $ show e - Right rawTx -> do - resp <- - makeZebraCall - zHost - zPort - "sendrawtransaction" - [Data.Aeson.String $ toText rawTx] - case resp of - Left e1 -> BC.writeBChan chan $ TickMsg $ "Zebra error: " ++ show e1 - Right txId -> BC.writeBChan chan $ TickMsg $ "Tx ID: " ++ txId - where - parseAddress :: T.Text -> IO UnifiedAddress - parseAddress a = - case isValidUnifiedAddress (E.encodeUtf8 a) of - Just a1 -> return a1 - Nothing -> - case decodeSaplingAddress (E.encodeUtf8 a) of - Just a2 -> - return $ - UnifiedAddress znet Nothing (Just $ sa_receiver a2) Nothing - Nothing -> - case decodeTransparentAddress (E.encodeUtf8 a) of - Just a3 -> - return $ - UnifiedAddress znet Nothing Nothing (Just $ ta_receiver a3) - Nothing -> throwIO $ userError "Incorrect address" diff --git a/src/Zenith/Core.hs b/src/Zenith/Core.hs index a8dc6f2..4e1d2c6 100644 --- a/src/Zenith/Core.hs +++ b/src/Zenith/Core.hs @@ -1,85 +1,37 @@ {-# LANGUAGE OverloadedStrings #-} --- | Core wallet functionality for Zenith +-- Core wallet functionality for Zenith module Zenith.Core where -import Control.Exception (throwIO, try) -import Control.Monad (forM, when) -import Control.Monad.IO.Class (liftIO) -import Control.Monad.Logger - ( LoggingT - , MonadLoggerIO - , NoLoggingT - , logDebugN - , logErrorN - , logInfoN - , logWarnN - , runFileLoggingT - , runNoLoggingT - , runStdoutLoggingT - ) -import Crypto.Secp256k1 (SecKey(..)) +import Control.Exception (throwIO) import Data.Aeson -import Data.Binary.Get hiding (getBytes) -import qualified Data.ByteString as BS -import qualified Data.ByteString.Lazy as LBS -import Data.Digest.Pure.MD5 -import Data.HexString (HexString, hexString, toBytes) -import Data.List -import Data.Maybe (fromJust) -import Data.Pool (Pool) +import Data.HexString (hexString) import qualified Data.Text as T -import qualified Data.Text.Encoding as E -import Data.Time -import qualified Database.Esqueleto.Experimental as ESQ import Database.Persist -import Database.Persist.Sqlite -import GHC.Float.RealFracMethods (floorFloatInteger) -import Haskoin.Crypto.Keys (XPrvKey(..)) -import Lens.Micro ((&), (.~), (^.), set) import Network.HTTP.Client import ZcashHaskell.Keys import ZcashHaskell.Orchard - ( decryptOrchardActionSK - , encodeUnifiedAddress + ( encodeUnifiedAddress , genOrchardReceiver , genOrchardSpendingKey - , getOrchardNotePosition - , getOrchardWitness - , isValidUnifiedAddress - , updateOrchardCommitmentTree - , updateOrchardWitness ) import ZcashHaskell.Sapling - ( decodeSaplingOutputEsk - , genSaplingInternalAddress + ( genSaplingInternalAddress , genSaplingPaymentAddress , genSaplingSpendingKey - , getSaplingNotePosition - , getSaplingWitness - , updateSaplingCommitmentTree - , updateSaplingWitness - ) -import ZcashHaskell.Transparent - ( genTransparentPrvKey - , genTransparentReceiver - , genTransparentSecretKey ) +import ZcashHaskell.Transparent (genTransparentPrvKey, genTransparentReceiver) import ZcashHaskell.Types import ZcashHaskell.Utils import Zenith.DB import Zenith.Types - ( Config(..) - , HexStringDB(..) - , OrchardSpendingKeyDB(..) + ( OrchardSpendingKeyDB(..) , PhraseDB(..) - , RseedDB(..) , SaplingSpendingKeyDB(..) , ScopeDB(..) , TransparentSpendingKeyDB(..) , UnifiedAddressDB(..) , ZcashNetDB(..) - , ZebraTreeInfo(..) ) -- * Zebra Node interaction @@ -87,40 +39,28 @@ import Zenith.Types checkZebra :: T.Text -- ^ Host where `zebrad` is available -> Int -- ^ Port where `zebrad` is available - -> IO ZebraGetInfo + -> IO (Maybe ZebraGetInfo) checkZebra nodeHost nodePort = do res <- makeZebraCall nodeHost nodePort "getinfo" [] - case res of - Left e -> throwIO $ userError e - Right bi -> return bi + let body = responseBody (res :: Response (RpcResponse ZebraGetInfo)) + return $ result body -- | Checks the status of the Zcash blockchain checkBlockChain :: T.Text -- ^ Host where `zebrad` is available -> Int -- ^ Port where `zebrad` is available - -> IO ZebraGetBlockChainInfo + -> IO (Maybe ZebraGetBlockChainInfo) checkBlockChain nodeHost nodePort = do - r <- makeZebraCall nodeHost nodePort "getblockchaininfo" [] - case r of - Left e -> throwIO $ userError e - Right bci -> return bci + let f = makeZebraCall nodeHost nodePort + result . responseBody <$> f "getblockchaininfo" [] --- | Get commitment trees from Zebra -getCommitmentTrees :: - T.Text -- ^ Host where `zebrad` is avaiable - -> Int -- ^ Port where `zebrad` is available - -> Int -- ^ Block height - -> IO ZebraTreeInfo -getCommitmentTrees nodeHost nodePort block = do - r <- - makeZebraCall - nodeHost - nodePort - "z_gettreestate" - [Data.Aeson.String $ T.pack $ show block] - case r of - Left e -> throwIO $ userError e - Right zti -> return zti +-- | Generic RPC call function +connectZebra :: + FromJSON a => T.Text -> Int -> T.Text -> [Data.Aeson.Value] -> IO (Maybe a) +connectZebra nodeHost nodePort m params = do + res <- makeZebraCall nodeHost nodePort m params + let body = responseBody res + return $ result body -- * Spending Keys -- | Create an Orchard Spending Key for the given wallet and account index @@ -222,553 +162,3 @@ createWalletAddress n i zNet scope za = do (UnifiedAddressDB $ encodeUnifiedAddress $ UnifiedAddress zNet oRec sRec (Just tRec)) (ScopeDB scope) - --- * Wallet --- | Find the Sapling notes that match the given spending key -findSaplingOutputs :: - Config -- ^ the configuration parameters - -> Int -- ^ the starting block - -> ZcashNetDB -- ^ The network - -> Entity ZcashAccount -- ^ The account to use - -> IO () -findSaplingOutputs config b znet za = do - let dbPath = c_dbPath config - let zebraHost = c_zebraHost config - let zebraPort = c_zebraPort config - let zn = getNet znet - pool <- runNoLoggingT $ initPool dbPath - tList <- getShieldedOutputs pool b - trees <- getCommitmentTrees zebraHost zebraPort (b - 1) - let sT = SaplingCommitmentTree $ ztiSapling trees - decryptNotes sT zn pool tList - sapNotes <- getWalletSapNotes pool (entityKey za) - findSapSpends pool (entityKey za) sapNotes - where - sk :: SaplingSpendingKeyDB - sk = zcashAccountSapSpendKey $ entityVal za - decryptNotes :: - SaplingCommitmentTree - -> ZcashNet - -> ConnectionPool - -> [(Entity ZcashTransaction, Entity ShieldOutput)] - -> IO () - decryptNotes _ _ _ [] = return () - decryptNotes st n pool ((zt, o):txs) = do - let updatedTree = - updateSaplingCommitmentTree - st - (getHex $ shieldOutputCmu $ entityVal o) - case updatedTree of - Nothing -> throwIO $ userError "Failed to update commitment tree" - Just uT -> do - let noteWitness = getSaplingWitness uT - let notePos = getSaplingNotePosition <$> noteWitness - case notePos of - Nothing -> throwIO $ userError "Failed to obtain note position" - Just nP -> do - case decodeShOut External n nP o of - Nothing -> do - case decodeShOut Internal n nP o of - Nothing -> do - decryptNotes uT n pool txs - Just dn1 -> do - wId <- saveWalletTransaction pool (entityKey za) zt - saveWalletSapNote - pool - wId - nP - (fromJust noteWitness) - True - (entityKey za) - (entityKey o) - dn1 - decryptNotes uT n pool txs - Just dn0 -> do - wId <- saveWalletTransaction pool (entityKey za) zt - saveWalletSapNote - pool - wId - nP - (fromJust noteWitness) - False - (entityKey za) - (entityKey o) - dn0 - decryptNotes uT n pool txs - decodeShOut :: - Scope - -> ZcashNet - -> Integer - -> Entity ShieldOutput - -> Maybe DecodedNote - decodeShOut scope n pos s = do - decodeSaplingOutputEsk - (getSapSK sk) - (ShieldedOutput - (getHex $ shieldOutputCv $ entityVal s) - (getHex $ shieldOutputCmu $ entityVal s) - (getHex $ shieldOutputEphKey $ entityVal s) - (getHex $ shieldOutputEncCipher $ entityVal s) - (getHex $ shieldOutputOutCipher $ entityVal s) - (getHex $ shieldOutputProof $ entityVal s)) - n - scope - pos - --- | Get Orchard actions -findOrchardActions :: - Config -- ^ the configuration parameters - -> Int -- ^ the starting block - -> ZcashNetDB -- ^ The network - -> Entity ZcashAccount -- ^ The account to use - -> IO () -findOrchardActions config b znet za = do - let dbPath = c_dbPath config - let zebraHost = c_zebraHost config - let zebraPort = c_zebraPort config - let zn = getNet znet - pool <- runNoLoggingT $ initPool dbPath - tList <- getOrchardActions pool b - trees <- getCommitmentTrees zebraHost zebraPort (b - 1) - let sT = OrchardCommitmentTree $ ztiOrchard trees - decryptNotes sT zn pool tList - orchNotes <- getWalletOrchNotes pool (entityKey za) - findOrchSpends pool (entityKey za) orchNotes - where - decryptNotes :: - OrchardCommitmentTree - -> ZcashNet - -> ConnectionPool - -> [(Entity ZcashTransaction, Entity OrchAction)] - -> IO () - decryptNotes _ _ _ [] = return () - decryptNotes ot n pool ((zt, o):txs) = do - let updatedTree = - updateOrchardCommitmentTree - ot - (getHex $ orchActionCmx $ entityVal o) - case updatedTree of - Nothing -> throwIO $ userError "Failed to update commitment tree" - Just uT -> do - let noteWitness = getOrchardWitness uT - let notePos = getOrchardNotePosition <$> noteWitness - case notePos of - Nothing -> throwIO $ userError "Failed to obtain note position" - Just nP -> - case decodeOrchAction External nP o of - Nothing -> - case decodeOrchAction Internal nP o of - Nothing -> decryptNotes uT n pool txs - Just dn1 -> do - wId <- saveWalletTransaction pool (entityKey za) zt - saveWalletOrchNote - pool - wId - nP - (fromJust noteWitness) - True - (entityKey za) - (entityKey o) - dn1 - decryptNotes uT n pool txs - Just dn -> do - wId <- saveWalletTransaction pool (entityKey za) zt - saveWalletOrchNote - pool - wId - nP - (fromJust noteWitness) - False - (entityKey za) - (entityKey o) - dn - decryptNotes uT n pool txs - sk :: OrchardSpendingKeyDB - sk = zcashAccountOrchSpendKey $ entityVal za - decodeOrchAction :: - Scope -> Integer -> Entity OrchAction -> Maybe DecodedNote - decodeOrchAction scope pos o = - decryptOrchardActionSK (getOrchSK sk) scope $ - OrchardAction - (getHex $ orchActionNf $ entityVal o) - (getHex $ orchActionRk $ entityVal o) - (getHex $ orchActionCmx $ entityVal o) - (getHex $ orchActionEphKey $ entityVal o) - (getHex $ orchActionEncCipher $ entityVal o) - (getHex $ orchActionOutCipher $ entityVal o) - (getHex $ orchActionCv $ entityVal o) - (getHex $ orchActionAuth $ entityVal o) - -updateSaplingWitnesses :: ConnectionPool -> IO () -updateSaplingWitnesses pool = do - sapNotes <- getUnspentSapNotes pool - maxId <- liftIO $ getMaxSaplingNote pool - mapM_ (updateOneNote maxId) sapNotes - where - updateOneNote :: ShieldOutputId -> Entity WalletSapNote -> IO () - updateOneNote maxId n = do - let noteSync = walletSapNoteWitPos $ entityVal n - when (noteSync < maxId) $ do - cmus <- liftIO $ getSaplingCmus pool $ walletSapNoteWitPos $ entityVal n - let cmuList = map (\(ESQ.Value x) -> getHex x) cmus - let newWitness = - updateSaplingWitness - (SaplingWitness $ getHex $ walletSapNoteWitness $ entityVal n) - cmuList - liftIO $ updateSapNoteRecord pool (entityKey n) newWitness maxId - -updateOrchardWitnesses :: ConnectionPool -> IO () -updateOrchardWitnesses pool = do - orchNotes <- getUnspentOrchNotes pool - maxId <- getMaxOrchardNote pool - mapM_ (updateOneNote maxId) orchNotes - where - updateOneNote :: OrchActionId -> Entity WalletOrchNote -> IO () - updateOneNote maxId n = do - let noteSync = walletOrchNoteWitPos $ entityVal n - when (noteSync < maxId) $ do - cmxs <- liftIO $ getOrchardCmxs pool noteSync - let cmxList = map (\(ESQ.Value x) -> getHex x) cmxs - let newWitness = - updateOrchardWitness - (OrchardWitness $ getHex $ walletOrchNoteWitness $ entityVal n) - cmxList - liftIO $ updateOrchNoteRecord pool (entityKey n) newWitness maxId - --- | Calculate fee per ZIP-317 -calculateTxFee :: - ([Entity WalletTrNote], [Entity WalletSapNote], [Entity WalletOrchNote]) - -> Int - -> Integer -calculateTxFee (t, s, o) i = - fromIntegral - (5000 * (max (length t) tout + max (length s) sout + length o + oout)) - where - tout = - if i == 1 || i == 2 - then 1 - else 0 - sout = - if i == 3 - then 1 - else 0 - oout = - if i == 4 - then 1 - else 0 - --- | Prepare a transaction for sending -prepareTx :: - ConnectionPool - -> T.Text - -> Int - -> ZcashNet - -> ZcashAccountId - -> Int - -> Float - -> UnifiedAddress - -> T.Text - -> LoggingT IO (Either TxError HexString) -prepareTx pool zebraHost zebraPort zn za bh amt ua memo = do - accRead <- liftIO $ getAccountById pool za - let recipient = - case o_rec ua of - Nothing -> - case s_rec ua of - Nothing -> - case t_rec ua of - Nothing -> (0, "") - Just r3 -> - case tr_type r3 of - P2PKH -> (1, toBytes $ tr_bytes r3) - P2SH -> (2, toBytes $ tr_bytes r3) - Just r2 -> (3, getBytes r2) - Just r1 -> (4, getBytes r1) - logDebugN $ T.pack $ show recipient - logDebugN $ T.pack $ "Target block: " ++ show bh - trees <- liftIO $ getCommitmentTrees zebraHost zebraPort bh - let sT = SaplingCommitmentTree $ ztiSapling trees - let oT = OrchardCommitmentTree $ ztiOrchard trees - case accRead of - Nothing -> do - logErrorN "Can't find Account" - return $ Left ZHError - Just acc -> do - logDebugN $ T.pack $ show acc - spParams <- liftIO $ BS.readFile "sapling-spend.params" - outParams <- liftIO $ BS.readFile "sapling-output.params" - if show (md5 $ LBS.fromStrict spParams) /= - "0f44c12ef115ae019decf18ade583b20" - then logErrorN "Can't validate sapling parameters" - else logInfoN "Valid Sapling spend params" - if show (md5 $ LBS.fromStrict outParams) /= - "924daf81b87a81bbbb9c7d18562046c8" - then logErrorN "Can't validate sapling parameters" - else logInfoN "Valid Sapling output params" - --print $ BS.length spParams - --print $ BS.length outParams - logDebugN "Read Sapling params" - let zats = fromIntegral $ floorFloatInteger $ amt * (10 ^ 8) - logDebugN $ T.pack $ show zats - {-firstPass <- liftIO $ selectUnspentNotes pool za zats-} - --let fee = calculateTxFee firstPass $ fst recipient - --logDebugN $ T.pack $ "calculated fee " ++ show fee - (tList, sList, oList) <- liftIO $ selectUnspentNotes pool za (zats + 5000) - logDebugN "selected notes" - logDebugN $ T.pack $ show tList - logDebugN $ T.pack $ show sList - logDebugN $ T.pack $ show oList - let noteTotal = getTotalAmount (tList, sList, oList) - tSpends <- - liftIO $ - prepTSpends (getTranSK $ zcashAccountTPrivateKey $ entityVal acc) tList - --print tSpends - sSpends <- - liftIO $ - prepSSpends (getSapSK $ zcashAccountSapSpendKey $ entityVal acc) sList - --print sSpends - oSpends <- - liftIO $ - prepOSpends (getOrchSK $ zcashAccountOrchSpendKey $ entityVal acc) oList - --print oSpends - dummy <- - liftIO $ makeOutgoing acc recipient zats (noteTotal - 5000 - zats) - logDebugN "Calculating fee" - let feeResponse = - createTransaction - (Just sT) - (Just oT) - tSpends - sSpends - oSpends - dummy - (SaplingSpendParams spParams) - (SaplingOutputParams outParams) - zn - (bh + 3) - False - case feeResponse of - Left e1 -> return $ Left Fee - Right fee -> do - let feeAmt = - fromIntegral (runGet getInt64le $ LBS.fromStrict $ toBytes fee) - (tList1, sList1, oList1) <- - liftIO $ selectUnspentNotes pool za (zats + feeAmt) - logDebugN $ T.pack $ "selected notes with fee" ++ show feeAmt - logDebugN $ T.pack $ show tList - logDebugN $ T.pack $ show sList - logDebugN $ T.pack $ show oList - outgoing <- - liftIO $ makeOutgoing acc recipient zats (noteTotal - feeAmt - zats) - logDebugN $ T.pack $ show outgoing - let tx = - createTransaction - (Just sT) - (Just oT) - tSpends - sSpends - oSpends - outgoing - (SaplingSpendParams spParams) - (SaplingOutputParams outParams) - zn - (bh + 3) - True - return tx - where - makeOutgoing :: - Entity ZcashAccount - -> (Int, BS.ByteString) - -> Integer - -> Integer - -> IO [OutgoingNote] - makeOutgoing acc (k, recvr) zats chg = do - chgAddr <- runNoLoggingT $ getInternalAddresses pool $ entityKey acc - let internalUA = getUA $ walletAddressUAddress $ entityVal $ head chgAddr - let chgRcvr = - fromJust $ o_rec =<< isValidUnifiedAddress (E.encodeUtf8 internalUA) - return - [ OutgoingNote - 4 - (getBytes $ getOrchSK $ zcashAccountOrchSpendKey $ entityVal acc) - (getBytes chgRcvr) - (fromIntegral chg) - "" - True - , OutgoingNote - (fromIntegral k) - (case k of - 4 -> - getBytes $ getOrchSK $ zcashAccountOrchSpendKey $ entityVal acc - 3 -> - getBytes $ getSapSK $ zcashAccountSapSpendKey $ entityVal acc - _ -> "") - recvr - (fromIntegral zats) - (E.encodeUtf8 memo) - False - ] - getTotalAmount :: - ( [Entity WalletTrNote] - , [Entity WalletSapNote] - , [Entity WalletOrchNote]) - -> Integer - getTotalAmount (t, s, o) = - sum (map (fromIntegral . walletTrNoteValue . entityVal) t) + - sum (map (fromIntegral . walletSapNoteValue . entityVal) s) + - sum (map (fromIntegral . walletOrchNoteValue . entityVal) o) - prepTSpends :: - TransparentSpendingKey - -> [Entity WalletTrNote] - -> IO [TransparentTxSpend] - prepTSpends sk notes = do - forM notes $ \n -> do - tAddRead <- getAddressById pool $ walletTrNoteAddress $ entityVal n - case tAddRead of - Nothing -> throwIO $ userError "Couldn't read t-address" - Just tAdd -> do - (XPrvKey _ _ _ _ (SecKey xp_key)) <- - genTransparentSecretKey - (walletAddressIndex $ entityVal tAdd) - (getScope $ walletAddressScope $ entityVal tAdd) - sk - mReverseTxId <- getWalletTxId pool $ walletTrNoteTx $ entityVal n - case mReverseTxId of - Nothing -> throwIO $ userError "failed to get tx ID" - Just (ESQ.Value reverseTxId) -> do - let flipTxId = BS.reverse $ toBytes $ getHex reverseTxId - return $ - TransparentTxSpend - xp_key - (RawOutPoint - flipTxId - (fromIntegral $ walletTrNotePosition $ entityVal n)) - (RawTxOut - (walletTrNoteValue $ entityVal n) - (walletTrNoteScript $ entityVal n)) - prepSSpends :: - SaplingSpendingKey -> [Entity WalletSapNote] -> IO [SaplingTxSpend] - prepSSpends sk notes = do - forM notes $ \n -> do - return $ - SaplingTxSpend - (getBytes sk) - (DecodedNote - (fromIntegral $ walletSapNoteValue $ entityVal n) - (walletSapNoteRecipient $ entityVal n) - (E.encodeUtf8 $ walletSapNoteMemo $ entityVal n) - (getHex $ walletSapNoteNullifier $ entityVal n) - "" - (getRseed $ walletSapNoteRseed $ entityVal n)) - (toBytes $ getHex $ walletSapNoteWitness $ entityVal n) - prepOSpends :: - OrchardSpendingKey -> [Entity WalletOrchNote] -> IO [OrchardTxSpend] - prepOSpends sk notes = do - forM notes $ \n -> do - return $ - OrchardTxSpend - (getBytes sk) - (DecodedNote - (fromIntegral $ walletOrchNoteValue $ entityVal n) - (walletOrchNoteRecipient $ entityVal n) - (E.encodeUtf8 $ walletOrchNoteMemo $ entityVal n) - (getHex $ walletOrchNoteNullifier $ entityVal n) - (walletOrchNoteRho $ entityVal n) - (getRseed $ walletOrchNoteRseed $ entityVal n)) - (toBytes $ getHex $ walletOrchNoteWitness $ entityVal n) - sapAnchor :: [Entity WalletSapNote] -> Maybe SaplingWitness - sapAnchor notes = - if not (null notes) - then Just $ - SaplingWitness $ - getHex $ walletSapNoteWitness $ entityVal $ head notes - else Nothing - orchAnchor :: [Entity WalletOrchNote] -> Maybe OrchardWitness - orchAnchor notes = - if not (null notes) - then Just $ - OrchardWitness $ - getHex $ walletOrchNoteWitness $ entityVal $ head notes - else Nothing - --- | Sync the wallet with the data store -syncWallet :: - Config -- ^ configuration parameters - -> Entity ZcashWallet - -> IO () -syncWallet config w = do - startTime <- liftIO getCurrentTime - let walletDb = c_dbPath config - pool <- runNoLoggingT $ initPool walletDb - accs <- runNoLoggingT $ getAccounts pool $ entityKey w - addrs <- concat <$> mapM (runNoLoggingT . getAddresses pool . entityKey) accs - intAddrs <- - concat <$> mapM (runNoLoggingT . getInternalAddresses pool . entityKey) accs - chainTip <- runNoLoggingT $ getMaxBlock pool - let lastBlock = zcashWalletLastSync $ entityVal w - let startBlock = - if lastBlock > 0 - then lastBlock - else zcashWalletBirthdayHeight $ entityVal w - mapM_ (liftIO . findTransparentNotes pool startBlock) addrs - mapM_ (liftIO . findTransparentNotes pool startBlock) intAddrs - mapM_ (liftIO . findTransparentSpends pool . entityKey) accs - sapNotes <- - liftIO $ - mapM - (findSaplingOutputs config startBlock (zcashWalletNetwork $ entityVal w)) - accs - orchNotes <- - liftIO $ - mapM - (findOrchardActions config startBlock (zcashWalletNetwork $ entityVal w)) - accs - _ <- updateSaplingWitnesses pool - _ <- updateOrchardWitnesses pool - _ <- liftIO $ updateWalletSync pool chainTip (entityKey w) - mapM_ (runNoLoggingT . getWalletTransactions pool) addrs - -testSync :: Config -> IO () -testSync config = do - let dbPath = c_dbPath config - _ <- initDb dbPath - pool <- runNoLoggingT $ initPool dbPath - w <- getWallets pool TestNet - r <- mapM (syncWallet config) w - liftIO $ print r - {-let uaRead =-} - {-isValidUnifiedAddress-} - {-"utest1dl54utt6prjj5e0dnlknwumnxq9hycdjpkfr0sy6e6h522remqee8axe9zax0wsjrwpj76v555pdhvj9rnargpfyycs0vpkapq98xcdhem99gc4wchzn0ggepq3y6nz3a9sscwgqxgsh9vzhcad402y3x9szfregck5gslkya3c79d86xx0l33tpk8gnn7ew9vw37w43zh22u8dgdax"-} - {-case uaRead of-} - {-Nothing -> print "wrong address"-} - {-Just ua -> do-} - {-startTime <- getCurrentTime-} - {-print startTime-} - {-tx <--} - {-prepareTx-} - {-"zenith.db"-} - {-"127.0.0.1"-} - {-18232-} - {-TestNet-} - {-(toSqlKey 1)-} - {-2820897-} - {-0.04-} - {-ua-} - {-"sent with Zenith, test"-} - {-print tx-} - {-endTime <- getCurrentTime-} - {-print endTime-} - -{-testSend :: IO ()-} -{-testSend = do-} -clearSync :: Config -> IO () -clearSync config = do - let dbPath = c_dbPath config - pool <- runNoLoggingT $ initPool dbPath - _ <- initDb dbPath - _ <- clearWalletTransactions pool - w <- getWallets pool TestNet - liftIO $ mapM_ (updateWalletSync pool 0 . entityKey) w - w' <- liftIO $ getWallets pool TestNet - r <- mapM (syncWallet config) w' - liftIO $ print r diff --git a/src/Zenith/DB.hs b/src/Zenith/DB.hs index a48151d..8345aef 100644 --- a/src/Zenith/DB.hs +++ b/src/Zenith/DB.hs @@ -14,64 +14,19 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE TypeOperators #-} -{-# LANGUAGE TypeApplications #-} module Zenith.DB where -import Control.Exception (throwIO) -import Control.Monad (forM_, when) -import Control.Monad.IO.Class (MonadIO, liftIO) -import Control.Monad.Logger (NoLoggingT, runNoLoggingT) -import Data.Bifunctor (bimap) +import Control.Monad.IO.Class (liftIO) import qualified Data.ByteString as BS -import Data.HexString -import Data.List (group, sort) -import Data.Maybe (catMaybes, fromJust, isJust) -import Data.Pool (Pool) import qualified Data.Text as T -import qualified Data.Text.Encoding as TE -import Data.Word -import Database.Esqueleto.Experimental -import qualified Database.Persist as P -import qualified Database.Persist.Sqlite as PS +import Database.Persist +import Database.Persist.Sqlite import Database.Persist.TH -import Haskoin.Transaction.Common - ( OutPoint(..) - , TxIn(..) - , TxOut(..) - , txHashToHex - ) -import qualified Lens.Micro as ML ((&), (.~), (^.)) -import ZcashHaskell.Orchard (isValidUnifiedAddress) -import ZcashHaskell.Sapling (decodeSaplingOutputEsk) -import ZcashHaskell.Types - ( DecodedNote(..) - , OrchardAction(..) - , OrchardBundle(..) - , OrchardSpendingKey(..) - , OrchardWitness(..) - , SaplingBundle(..) - , SaplingCommitmentTree(..) - , SaplingSpendingKey(..) - , SaplingWitness(..) - , Scope(..) - , ShieldedOutput(..) - , ShieldedSpend(..) - , ToBytes(..) - , Transaction(..) - , TransparentAddress(..) - , TransparentBundle(..) - , TransparentReceiver(..) - , UnifiedAddress(..) - , ZcashNet - , decodeHexText - ) +import ZcashHaskell.Types (Scope(..), ZcashNet) import Zenith.Types - ( Config(..) - , HexStringDB(..) - , OrchardSpendingKeyDB(..) + ( OrchardSpendingKeyDB(..) , PhraseDB(..) - , RseedDB(..) , SaplingSpendingKeyDB(..) , ScopeDB(..) , TransparentSpendingKeyDB @@ -87,7 +42,6 @@ share network ZcashNetDB seedPhrase PhraseDB birthdayHeight Int - lastSync Int default=0 UniqueWallet name network deriving Show Eq ZcashAccount @@ -109,143 +63,6 @@ share UniqueAddress index scope accId UniqueAddName accId name deriving Show Eq - WalletTransaction - txId HexStringDB - accId ZcashAccountId - block Int - conf Int - time Int - UniqueWTx txId accId - deriving Show Eq - UserTx - hex HexStringDB - address WalletAddressId OnDeleteCascade OnUpdateCascade - time Int - amount Int - memo T.Text - UniqueUTx hex address - deriving Show Eq - WalletTrNote - tx WalletTransactionId OnDeleteCascade OnUpdateCascade - accId ZcashAccountId OnDeleteCascade OnUpdateCascade - address WalletAddressId OnDeleteCascade OnUpdateCascade - value Word64 - spent Bool - script BS.ByteString - change Bool - position Word64 - UniqueTNote tx script - deriving Show Eq - WalletTrSpend - tx WalletTransactionId OnDeleteCascade OnUpdateCascade - note WalletTrNoteId OnDeleteCascade OnUpdateCascade - accId ZcashAccountId OnDeleteCascade OnUpdateCascade - value Word64 - UniqueTrSpend tx accId - deriving Show Eq - WalletSapNote - tx WalletTransactionId OnDeleteCascade OnUpdateCascade - accId ZcashAccountId OnDeleteCascade OnUpdateCascade - value Word64 - recipient BS.ByteString - memo T.Text - spent Bool - nullifier HexStringDB - position Word64 - witness HexStringDB - change Bool - witPos ShieldOutputId OnDeleteIgnore OnUpdateIgnore - rseed RseedDB - UniqueSapNote tx nullifier - deriving Show Eq - WalletSapSpend - tx WalletTransactionId OnDeleteCascade OnUpdateCascade - note WalletSapNoteId OnDeleteCascade OnUpdateCascade - accId ZcashAccountId OnDeleteCascade OnUpdateCascade - value Word64 - UniqueSapSepnd tx accId - deriving Show Eq - WalletOrchNote - tx WalletTransactionId OnDeleteCascade OnUpdateCascade - accId ZcashAccountId OnDeleteCascade OnUpdateCascade - value Word64 - recipient BS.ByteString - memo T.Text - spent Bool - nullifier HexStringDB - position Word64 - witness HexStringDB - change Bool - witPos OrchActionId OnDeleteIgnore OnUpdateIgnore - rho BS.ByteString - rseed RseedDB - UniqueOrchNote tx nullifier - deriving Show Eq - WalletOrchSpend - tx WalletTransactionId OnDeleteCascade OnUpdateCascade - note WalletOrchNoteId OnDeleteCascade OnUpdateCascade - accId ZcashAccountId OnDeleteCascade OnUpdateCascade - value Word64 - UniqueOrchSpend tx accId - deriving Show Eq - ZcashTransaction - block Int - txId HexStringDB - conf Int - time Int - UniqueTx block txId - deriving Show Eq - TransparentNote - tx ZcashTransactionId - value Word64 - script BS.ByteString - position Int - UniqueTNPos tx position - deriving Show Eq - TransparentSpend - tx ZcashTransactionId - outPointHash HexStringDB - outPointIndex Word64 - script BS.ByteString - seq Word64 - position Int - UniqueTSPos tx position - deriving Show Eq - OrchAction - tx ZcashTransactionId - nf HexStringDB - rk HexStringDB - cmx HexStringDB - ephKey HexStringDB - encCipher HexStringDB - outCipher HexStringDB - cv HexStringDB - auth HexStringDB - position Int - UniqueOAPos tx position - deriving Show Eq - ShieldOutput - tx ZcashTransactionId - cv HexStringDB - cmu HexStringDB - ephKey HexStringDB - encCipher HexStringDB - outCipher HexStringDB - proof HexStringDB - position Int - UniqueSOPos tx position - deriving Show Eq - ShieldSpend - tx ZcashTransactionId - cv HexStringDB - anchor HexStringDB - nullifier HexStringDB - rk HexStringDB - proof HexStringDB - authSig HexStringDB - position Int - UniqueSSPos tx position - deriving Show Eq |] -- * Database functions @@ -254,1218 +71,77 @@ initDb :: T.Text -- ^ The database path to check -> IO () initDb dbName = do - PS.runSqlite dbName $ do runMigration migrateAll - -initPool :: T.Text -> NoLoggingT IO ConnectionPool -initPool dbPath = do - let dbInfo = PS.mkSqliteConnectionInfo dbPath - PS.createSqlitePoolFromInfo dbInfo 5 - --- | Upgrade the database -upgradeDb :: - T.Text -- ^ database path - -> IO () -upgradeDb dbName = do - PS.runSqlite dbName $ do runMigrationUnsafe migrateAll + runSqlite dbName $ do runMigration migrateAll -- | Get existing wallets from database -getWallets :: ConnectionPool -> ZcashNet -> IO [Entity ZcashWallet] -getWallets pool n = - runNoLoggingT $ - PS.retryOnBusy $ - flip PS.runSqlPool pool $ do - select $ do - wallets <- from $ table @ZcashWallet - where_ (wallets ^. ZcashWalletNetwork ==. val (ZcashNetDB n)) - pure wallets +getWallets :: T.Text -> ZcashNet -> IO [Entity ZcashWallet] +getWallets dbFp n = + runSqlite dbFp $ selectList [ZcashWalletNetwork ==. ZcashNetDB n] [] -- | Save a new wallet to the database saveWallet :: - ConnectionPool -- ^ The database path to use + T.Text -- ^ The database path to use -> ZcashWallet -- ^ The wallet to add to the database -> IO (Maybe (Entity ZcashWallet)) -saveWallet pool w = - runNoLoggingT $ - PS.retryOnBusy $ flip PS.runSqlPool pool $ insertUniqueEntity w - --- | Update the last sync block for the wallet -updateWalletSync :: ConnectionPool -> Int -> ZcashWalletId -> IO () -updateWalletSync pool b i = do - runNoLoggingT $ - PS.retryOnBusy $ - flip PS.runSqlPool pool $ do - update $ \w -> do - set w [ZcashWalletLastSync =. val b] - where_ $ w ^. ZcashWalletId ==. val i +saveWallet dbFp w = runSqlite dbFp $ insertUniqueEntity w -- | Returns a list of accounts associated with the given wallet getAccounts :: - ConnectionPool -- ^ The database path + T.Text -- ^ The database path -> ZcashWalletId -- ^ The wallet ID to check - -> NoLoggingT IO [Entity ZcashAccount] -getAccounts pool w = - PS.retryOnBusy $ - flip PS.runSqlPool pool $ do - select $ do - accs <- from $ table @ZcashAccount - where_ (accs ^. ZcashAccountWalletId ==. val w) - pure accs - -getAccountById :: - ConnectionPool -> ZcashAccountId -> IO (Maybe (Entity ZcashAccount)) -getAccountById pool za = do - runNoLoggingT $ - PS.retryOnBusy $ - flip PS.runSqlPool pool $ do - selectOne $ do - accs <- from $ table @ZcashAccount - where_ (accs ^. ZcashAccountId ==. val za) - pure accs + -> IO [Entity ZcashAccount] +getAccounts dbFp w = runSqlite dbFp $ selectList [ZcashAccountWalletId ==. w] [] -- | Returns the largest account index for the given wallet getMaxAccount :: - ConnectionPool -- ^ The database path + T.Text -- ^ The database path -> ZcashWalletId -- ^ The wallet ID to check -> IO Int -getMaxAccount pool w = do +getMaxAccount dbFp w = do a <- - runNoLoggingT $ - PS.retryOnBusy $ - flip PS.runSqlPool pool $ do - selectOne $ do - accs <- from $ table @ZcashAccount - where_ (accs ^. ZcashAccountWalletId ==. val w) - orderBy [desc $ accs ^. ZcashAccountIndex] - pure accs + runSqlite dbFp $ + selectFirst [ZcashAccountWalletId ==. w] [Desc ZcashAccountIndex] case a of Nothing -> return $ -1 Just x -> return $ zcashAccountIndex $ entityVal x -- | Save a new account to the database saveAccount :: - ConnectionPool -- ^ The database path + T.Text -- ^ The database path -> ZcashAccount -- ^ The account to add to the database -> IO (Maybe (Entity ZcashAccount)) -saveAccount pool a = - runNoLoggingT $ - PS.retryOnBusy $ flip PS.runSqlPool pool $ insertUniqueEntity a - --- | Returns the largest block in storage -getMaxBlock :: - Pool SqlBackend -- ^ The database pool - -> NoLoggingT IO Int -getMaxBlock pool = do - b <- - PS.retryOnBusy $ - flip PS.runSqlPool pool $ do - selectOne $ do - txs <- from $ table @ZcashTransaction - where_ (txs ^. ZcashTransactionBlock >. val 0) - orderBy [desc $ txs ^. ZcashTransactionBlock] - pure txs - case b of - Nothing -> return $ -1 - Just x -> return $ zcashTransactionBlock $ entityVal x +saveAccount dbFp a = runSqlite dbFp $ insertUniqueEntity a -- | Returns a list of addresses associated with the given account getAddresses :: - ConnectionPool -- ^ The database path + T.Text -- ^ The database path -> ZcashAccountId -- ^ The account ID to check - -> NoLoggingT IO [Entity WalletAddress] -getAddresses pool a = - PS.retryOnBusy $ - flip PS.runSqlPool pool $ do - select $ do - addrs <- from $ table @WalletAddress - where_ (addrs ^. WalletAddressAccId ==. val a) - where_ (addrs ^. WalletAddressScope ==. val (ScopeDB External)) - pure addrs - -getAddressById :: - ConnectionPool -> WalletAddressId -> IO (Maybe (Entity WalletAddress)) -getAddressById pool a = do - runNoLoggingT $ - PS.retryOnBusy $ - flip PS.runSqlPool pool $ do - selectOne $ do - addr <- from $ table @WalletAddress - where_ (addr ^. WalletAddressId ==. val a) - pure addr - --- | Returns a list of change addresses associated with the given account -getInternalAddresses :: - ConnectionPool -- ^ The database path - -> ZcashAccountId -- ^ The account ID to check - -> NoLoggingT IO [Entity WalletAddress] -getInternalAddresses pool a = - PS.retryOnBusy $ - flip PS.runSqlPool pool $ do - select $ do - addrs <- from $ table @WalletAddress - where_ (addrs ^. WalletAddressAccId ==. val a) - where_ (addrs ^. WalletAddressScope ==. val (ScopeDB Internal)) - pure addrs - --- | Returns a list of addressess associated with the given wallet -getWalletAddresses :: - ConnectionPool -- ^ The database path - -> ZcashWalletId -- ^ the wallet to search - -> NoLoggingT IO [Entity WalletAddress] -getWalletAddresses pool w = do - accs <- getAccounts pool w - addrs <- mapM (getAddresses pool . entityKey) accs - return $ concat addrs + -> IO [Entity WalletAddress] +getAddresses dbFp a = + runSqlite dbFp $ + selectList + [WalletAddressAccId ==. a, WalletAddressScope ==. ScopeDB External] + [] -- | Returns the largest address index for the given account getMaxAddress :: - ConnectionPool -- ^ The database path + T.Text -- ^ The database path -> ZcashAccountId -- ^ The account ID to check -> Scope -- ^ The scope of the address -> IO Int -getMaxAddress pool aw s = do +getMaxAddress dbFp aw s = do a <- - runNoLoggingT $ - PS.retryOnBusy $ - flip PS.runSqlPool pool $ do - selectOne $ do - addrs <- from $ table @WalletAddress - where_ $ addrs ^. WalletAddressAccId ==. val aw - where_ $ addrs ^. WalletAddressScope ==. val (ScopeDB s) - orderBy [desc $ addrs ^. WalletAddressIndex] - pure addrs + runSqlite dbFp $ + selectFirst + [WalletAddressAccId ==. aw, WalletAddressScope ==. ScopeDB s] + [Desc WalletAddressIndex] case a of Nothing -> return $ -1 Just x -> return $ walletAddressIndex $ entityVal x -- | Save a new address to the database saveAddress :: - ConnectionPool -- ^ the database path + T.Text -- ^ the database path -> WalletAddress -- ^ The wallet to add to the database -> IO (Maybe (Entity WalletAddress)) -saveAddress pool w = - runNoLoggingT $ - PS.retryOnBusy $ flip PS.runSqlPool pool $ insertUniqueEntity w - --- | Save a transaction to the data model -saveTransaction :: - ConnectionPool -- ^ the database path - -> Int -- ^ block time - -> Transaction -- ^ The transaction to save - -> NoLoggingT IO (Key ZcashTransaction) -saveTransaction pool t wt = - PS.retryOnBusy $ - flip PS.runSqlPool pool $ do - let ix = [0 ..] - w <- - insert $ - ZcashTransaction (tx_height wt) (HexStringDB $ tx_id wt) (tx_conf wt) t - when (isJust $ tx_transpBundle wt) $ do - _ <- - insertMany_ $ - zipWith (curry (storeTxOut w)) ix $ - (tb_vout . fromJust . tx_transpBundle) wt - _ <- - insertMany_ $ - zipWith (curry (storeTxIn w)) ix $ - (tb_vin . fromJust . tx_transpBundle) wt - return () - when (isJust $ tx_saplingBundle wt) $ do - _ <- - insertMany_ $ - zipWith (curry (storeSapSpend w)) ix $ - (sbSpends . fromJust . tx_saplingBundle) wt - _ <- - insertMany_ $ - zipWith (curry (storeSapOutput w)) ix $ - (sbOutputs . fromJust . tx_saplingBundle) wt - return () - when (isJust $ tx_orchardBundle wt) $ - insertMany_ $ - zipWith (curry (storeOrchAction w)) ix $ - (obActions . fromJust . tx_orchardBundle) wt - return w - where - storeTxOut :: ZcashTransactionId -> (Int, TxOut) -> TransparentNote - storeTxOut wid (i, TxOut v s) = TransparentNote wid (fromIntegral v) s i - storeTxIn :: ZcashTransactionId -> (Int, TxIn) -> TransparentSpend - storeTxIn wid (i, TxIn (OutPoint h k) s sq) = - TransparentSpend - wid - (HexStringDB . fromText $ txHashToHex h) - (fromIntegral k) - s - (fromIntegral sq) - i - storeSapSpend :: ZcashTransactionId -> (Int, ShieldedSpend) -> ShieldSpend - storeSapSpend wid (i, sp) = - ShieldSpend - wid - (HexStringDB $ sp_cv sp) - (HexStringDB $ sp_anchor sp) - (HexStringDB $ sp_nullifier sp) - (HexStringDB $ sp_rk sp) - (HexStringDB $ sp_proof sp) - (HexStringDB $ sp_auth sp) - i - storeSapOutput :: - ZcashTransactionId -> (Int, ShieldedOutput) -> ShieldOutput - storeSapOutput wid (i, so) = - ShieldOutput - wid - (HexStringDB $ s_cv so) - (HexStringDB $ s_cmu so) - (HexStringDB $ s_ephKey so) - (HexStringDB $ s_encCipherText so) - (HexStringDB $ s_outCipherText so) - (HexStringDB $ s_proof so) - i - storeOrchAction :: ZcashTransactionId -> (Int, OrchardAction) -> OrchAction - storeOrchAction wid (i, oa) = - OrchAction - wid - (HexStringDB $ nf oa) - (HexStringDB $ rk oa) - (HexStringDB $ cmx oa) - (HexStringDB $ eph_key oa) - (HexStringDB $ enc_ciphertext oa) - (HexStringDB $ out_ciphertext oa) - (HexStringDB $ cv oa) - (HexStringDB $ auth oa) - i - --- | Get the transactions from a particular block forward -getZcashTransactions :: - ConnectionPool -- ^ The database path - -> Int -- ^ Block - -> IO [Entity ZcashTransaction] -getZcashTransactions pool b = - runNoLoggingT $ - PS.retryOnBusy $ - flip PS.runSqlPool pool $ do - select $ do - txs <- from $ table @ZcashTransaction - where_ $ txs ^. ZcashTransactionBlock >. val b - orderBy [asc $ txs ^. ZcashTransactionBlock] - return txs - --- * Wallet --- | Get the block of the last transaction known to the wallet -getMaxWalletBlock :: - ConnectionPool -- ^ The database path - -> IO Int -getMaxWalletBlock pool = do - b <- - runNoLoggingT $ - PS.retryOnBusy $ - flip PS.runSqlPool pool $ do - selectOne $ do - txs <- from $ table @WalletTransaction - where_ $ txs ^. WalletTransactionBlock >. val 0 - orderBy [desc $ txs ^. WalletTransactionBlock] - return txs - case b of - Nothing -> return $ -1 - Just x -> return $ walletTransactionBlock $ entityVal x - -getMinBirthdayHeight :: ConnectionPool -> IO Int -getMinBirthdayHeight pool = do - b <- - runNoLoggingT $ - PS.retryOnBusy $ - flip PS.runSqlPool pool $ do - selectOne $ do - w <- from $ table @ZcashWallet - where_ (w ^. ZcashWalletBirthdayHeight >. val 0) - orderBy [asc $ w ^. ZcashWalletBirthdayHeight] - pure w - case b of - Nothing -> return 0 - Just x -> return $ zcashWalletBirthdayHeight $ entityVal x - -getLastSyncBlock :: ConnectionPool -> ZcashWalletId -> IO Int -getLastSyncBlock pool zw = do - b <- - runNoLoggingT $ - PS.retryOnBusy $ - flip PS.runSqlPool pool $ do - selectOne $ do - w <- from $ table @ZcashWallet - where_ (w ^. ZcashWalletId ==. val zw) - pure w - case b of - Nothing -> throwIO $ userError "Failed to retrieve wallet" - Just x -> return $ zcashWalletLastSync $ entityVal x - --- | Save a @WalletTransaction@ -saveWalletTransaction :: - ConnectionPool - -> ZcashAccountId - -> Entity ZcashTransaction - -> IO WalletTransactionId -saveWalletTransaction pool za zt = do - let zT' = entityVal zt - runNoLoggingT $ - PS.retryOnBusy $ - flip PS.runSqlPool pool $ do - t <- - upsert - (WalletTransaction - (zcashTransactionTxId zT') - za - (zcashTransactionBlock zT') - (zcashTransactionConf zT') - (zcashTransactionTime zT')) - [] - return $ entityKey t - --- | Save a @WalletSapNote@ -saveWalletSapNote :: - ConnectionPool -- ^ The database path - -> WalletTransactionId -- ^ The index for the transaction that contains the note - -> Integer -- ^ note position - -> SaplingWitness -- ^ the Sapling incremental witness - -> Bool -- ^ change flag - -> ZcashAccountId - -> ShieldOutputId - -> DecodedNote -- The decoded Sapling note - -> IO () -saveWalletSapNote pool wId pos wit ch za zt dn = do - runNoLoggingT $ - PS.retryOnBusy $ - flip PS.runSqlPool pool $ do - _ <- - upsert - (WalletSapNote - wId - za - (fromIntegral $ a_value dn) - (a_recipient dn) - (T.filter (/= '\NUL') $ TE.decodeUtf8Lenient $ a_memo dn) - False - (HexStringDB $ a_nullifier dn) - (fromIntegral pos) - (HexStringDB $ sapWit wit) - ch - zt - (RseedDB $ a_rseed dn)) - [] - return () - --- | Save a @WalletOrchNote@ -saveWalletOrchNote :: - ConnectionPool - -> WalletTransactionId - -> Integer - -> OrchardWitness - -> Bool - -> ZcashAccountId - -> OrchActionId - -> DecodedNote - -> IO () -saveWalletOrchNote pool wId pos wit ch za zt dn = do - runNoLoggingT $ - PS.retryOnBusy $ - flip PS.runSqlPool pool $ do - _ <- - upsert - (WalletOrchNote - wId - za - (fromIntegral $ a_value dn) - (a_recipient dn) - (T.filter (/= '\NUL') $ TE.decodeUtf8Lenient $ a_memo dn) - False - (HexStringDB $ a_nullifier dn) - (fromIntegral pos) - (HexStringDB $ orchWit wit) - ch - zt - (a_rho dn) - (RseedDB $ a_rseed dn)) - [] - return () - --- | Find the Transparent Notes that match the given transparent receiver -findTransparentNotes :: - ConnectionPool -- ^ The database path - -> Int -- ^ Starting block - -> Entity WalletAddress - -> IO () -findTransparentNotes pool b t = do - let tReceiver = t_rec =<< readUnifiedAddressDB (entityVal t) - case tReceiver of - Just tR -> do - let s = - BS.concat - [ BS.pack [0x76, 0xA9, 0x14] - , (toBytes . tr_bytes) tR - , BS.pack [0x88, 0xAC] - ] - tN <- - runNoLoggingT $ - PS.retryOnBusy $ - flip PS.runSqlPool pool $ do - select $ do - (txs :& tNotes) <- - from $ table @ZcashTransaction `innerJoin` table @TransparentNote `on` - (\(txs :& tNotes) -> - txs ^. ZcashTransactionId ==. tNotes ^. TransparentNoteTx) - where_ (txs ^. ZcashTransactionBlock >. val b) - where_ (tNotes ^. TransparentNoteScript ==. val s) - pure (txs, tNotes) - mapM_ - (saveWalletTrNote - pool - (getScope $ walletAddressScope $ entityVal t) - (walletAddressAccId $ entityVal t) - (entityKey t)) - tN - Nothing -> return () - --- | Add the transparent notes to the wallet -saveWalletTrNote :: - ConnectionPool -- ^ the database path - -> Scope - -> ZcashAccountId - -> WalletAddressId - -> (Entity ZcashTransaction, Entity TransparentNote) - -> IO () -saveWalletTrNote pool ch za wa (zt, tn) = do - let zT' = entityVal zt - runNoLoggingT $ - PS.retryOnBusy $ - flip PS.runSqlPool pool $ do - t <- - upsert - (WalletTransaction - (zcashTransactionTxId zT') - za - (zcashTransactionBlock zT') - (zcashTransactionConf zT') - (zcashTransactionTime zT')) - [] - insert_ $ - WalletTrNote - (entityKey t) - za - wa - (transparentNoteValue $ entityVal tn) - False - (transparentNoteScript $ entityVal tn) - (ch == Internal) - (fromIntegral $ transparentNotePosition $ entityVal tn) - --- | Save a Sapling note to the wallet database -saveSapNote :: ConnectionPool -> WalletSapNote -> IO () -saveSapNote pool wsn = - runNoLoggingT $ PS.retryOnBusy $ flip PS.runSqlPool pool $ insert_ wsn - --- | Get the shielded outputs from the given blockheight -getShieldedOutputs :: - ConnectionPool -- ^ database path - -> Int -- ^ block - -> IO [(Entity ZcashTransaction, Entity ShieldOutput)] -getShieldedOutputs pool b = - runNoLoggingT $ - PS.retryOnBusy $ - flip PS.runSqlPool pool $ do - select $ do - (txs :& sOutputs) <- - from $ table @ZcashTransaction `innerJoin` table @ShieldOutput `on` - (\(txs :& sOutputs) -> - txs ^. ZcashTransactionId ==. sOutputs ^. ShieldOutputTx) - where_ (txs ^. ZcashTransactionBlock >=. val b) - orderBy - [ asc $ txs ^. ZcashTransactionId - , asc $ sOutputs ^. ShieldOutputPosition - ] - pure (txs, sOutputs) - --- | Get the Orchard actions from the given blockheight forward -getOrchardActions :: - ConnectionPool -- ^ database path - -> Int -- ^ block - -> IO [(Entity ZcashTransaction, Entity OrchAction)] -getOrchardActions pool b = - runNoLoggingT $ - PS.retryOnBusy $ - flip PS.runSqlPool pool $ do - select $ do - (txs :& oActions) <- - from $ table @ZcashTransaction `innerJoin` table @OrchAction `on` - (\(txs :& oActions) -> - txs ^. ZcashTransactionId ==. oActions ^. OrchActionTx) - where_ (txs ^. ZcashTransactionBlock >=. val b) - orderBy - [asc $ txs ^. ZcashTransactionId, asc $ oActions ^. OrchActionPosition] - pure (txs, oActions) - --- | Get the transactions belonging to the given address -getWalletTransactions :: - ConnectionPool -- ^ database path - -> Entity WalletAddress - -> NoLoggingT IO () -getWalletTransactions pool w = do - let w' = entityVal w - chgAddr <- getInternalAddresses pool $ walletAddressAccId $ entityVal w - let ctReceiver = t_rec =<< readUnifiedAddressDB (entityVal $ head chgAddr) - let csReceiver = s_rec =<< readUnifiedAddressDB (entityVal $ head chgAddr) - let coReceiver = o_rec =<< readUnifiedAddressDB (entityVal $ head chgAddr) - let tReceiver = t_rec =<< readUnifiedAddressDB w' - let sReceiver = s_rec =<< readUnifiedAddressDB w' - let oReceiver = o_rec =<< readUnifiedAddressDB w' - trNotes <- - case tReceiver of - Nothing -> return [] - Just tR -> do - let s = - BS.concat - [ BS.pack [0x76, 0xA9, 0x14] - , (toBytes . tr_bytes) tR - , BS.pack [0x88, 0xAC] - ] - PS.retryOnBusy $ - flip PS.runSqlPool pool $ do - select $ do - tnotes <- from $ table @WalletTrNote - where_ (tnotes ^. WalletTrNoteScript ==. val s) - pure tnotes - trChgNotes <- - case ctReceiver of - Nothing -> return [] - Just tR -> do - let s1 = - BS.concat - [ BS.pack [0x76, 0xA9, 0x14] - , (toBytes . tr_bytes) tR - , BS.pack [0x88, 0xAC] - ] - PS.retryOnBusy $ - flip PS.runSqlPool pool $ do - select $ do - tnotes <- from $ table @WalletTrNote - where_ (tnotes ^. WalletTrNoteScript ==. val s1) - pure tnotes - trSpends <- - PS.retryOnBusy $ - flip PS.runSqlPool pool $ do - select $ do - trSpends <- from $ table @WalletTrSpend - where_ - (trSpends ^. WalletTrSpendNote `in_` - valList (map entityKey (trNotes <> trChgNotes))) - pure trSpends - sapNotes <- - case sReceiver of - Nothing -> return [] - Just sR -> do - PS.retryOnBusy $ - flip PS.runSqlPool pool $ do - select $ do - snotes <- from $ table @WalletSapNote - where_ (snotes ^. WalletSapNoteRecipient ==. val (getBytes sR)) - pure snotes - sapChgNotes <- - case csReceiver of - Nothing -> return [] - Just sR -> do - PS.retryOnBusy $ - flip PS.runSqlPool pool $ do - select $ do - snotes <- from $ table @WalletSapNote - where_ (snotes ^. WalletSapNoteRecipient ==. val (getBytes sR)) - pure snotes - sapSpends <- mapM (getSapSpends . entityKey) (sapNotes <> sapChgNotes) - orchNotes <- - case oReceiver of - Nothing -> return [] - Just oR -> do - PS.retryOnBusy $ - flip PS.runSqlPool pool $ do - select $ do - onotes <- from $ table @WalletOrchNote - where_ (onotes ^. WalletOrchNoteRecipient ==. val (getBytes oR)) - pure onotes - orchChgNotes <- - case coReceiver of - Nothing -> return [] - Just oR -> do - PS.retryOnBusy $ - flip PS.runSqlPool pool $ do - select $ do - onotes <- from $ table @WalletOrchNote - where_ (onotes ^. WalletOrchNoteRecipient ==. val (getBytes oR)) - pure onotes - orchSpends <- mapM (getOrchSpends . entityKey) (orchNotes <> orchChgNotes) - clearUserTx (entityKey w) - mapM_ addTr trNotes - mapM_ addTr trChgNotes - mapM_ addSap sapNotes - mapM_ addSap sapChgNotes - mapM_ addOrch orchNotes - mapM_ addOrch orchChgNotes - mapM_ subTSpend trSpends - mapM_ subSSpend $ catMaybes sapSpends - mapM_ subOSpend $ catMaybes orchSpends - where - clearUserTx :: WalletAddressId -> NoLoggingT IO () - clearUserTx waId = do - PS.retryOnBusy $ - flip PS.runSqlPool pool $ do - delete $ do - u <- from $ table @UserTx - where_ (u ^. UserTxAddress ==. val waId) - return () - getSapSpends :: - WalletSapNoteId -> NoLoggingT IO (Maybe (Entity WalletSapSpend)) - getSapSpends n = do - PS.retryOnBusy $ - flip PS.runSqlPool pool $ do - selectOne $ do - sapSpends <- from $ table @WalletSapSpend - where_ (sapSpends ^. WalletSapSpendNote ==. val n) - pure sapSpends - getOrchSpends :: - WalletOrchNoteId -> NoLoggingT IO (Maybe (Entity WalletOrchSpend)) - getOrchSpends n = do - PS.retryOnBusy $ - flip PS.runSqlPool pool $ do - selectOne $ do - orchSpends <- from $ table @WalletOrchSpend - where_ (orchSpends ^. WalletOrchSpendNote ==. val n) - pure orchSpends - addTr :: Entity WalletTrNote -> NoLoggingT IO () - addTr n = - upsertUserTx - (walletTrNoteTx $ entityVal n) - (entityKey w) - (fromIntegral $ walletTrNoteValue $ entityVal n) - "" - addSap :: Entity WalletSapNote -> NoLoggingT IO () - addSap n = - upsertUserTx - (walletSapNoteTx $ entityVal n) - (entityKey w) - (fromIntegral $ walletSapNoteValue $ entityVal n) - (walletSapNoteMemo $ entityVal n) - addOrch :: Entity WalletOrchNote -> NoLoggingT IO () - addOrch n = - upsertUserTx - (walletOrchNoteTx $ entityVal n) - (entityKey w) - (fromIntegral $ walletOrchNoteValue $ entityVal n) - (walletOrchNoteMemo $ entityVal n) - subTSpend :: Entity WalletTrSpend -> NoLoggingT IO () - subTSpend n = - upsertUserTx - (walletTrSpendTx $ entityVal n) - (entityKey w) - (-(fromIntegral $ walletTrSpendValue $ entityVal n)) - "" - subSSpend :: Entity WalletSapSpend -> NoLoggingT IO () - subSSpend n = - upsertUserTx - (walletSapSpendTx $ entityVal n) - (entityKey w) - (-(fromIntegral $ walletSapSpendValue $ entityVal n)) - "" - subOSpend :: Entity WalletOrchSpend -> NoLoggingT IO () - subOSpend n = - upsertUserTx - (walletOrchSpendTx $ entityVal n) - (entityKey w) - (-(fromIntegral $ walletOrchSpendValue $ entityVal n)) - "" - upsertUserTx :: - WalletTransactionId - -> WalletAddressId - -> Int - -> T.Text - -> NoLoggingT IO () - upsertUserTx tId wId amt memo = do - tr <- - PS.retryOnBusy $ - flip PS.runSqlPool pool $ do - select $ do - tx <- from $ table @WalletTransaction - where_ (tx ^. WalletTransactionId ==. val tId) - pure tx - existingUtx <- - PS.retryOnBusy $ - flip PS.runSqlPool pool $ do - selectOne $ do - ut <- from $ table @UserTx - where_ - (ut ^. UserTxHex ==. - val (walletTransactionTxId $ entityVal $ head tr)) - where_ (ut ^. UserTxAddress ==. val wId) - pure ut - case existingUtx of - Nothing -> do - _ <- - PS.retryOnBusy $ - flip PS.runSqlPool pool $ do - upsert - (UserTx - (walletTransactionTxId $ entityVal $ head tr) - wId - (walletTransactionTime $ entityVal $ head tr) - amt - memo) - [] - return () - Just uTx -> do - _ <- - PS.retryOnBusy $ - flip PS.runSqlPool pool $ do - update $ \t -> do - set - t - [ UserTxAmount +=. val amt - , UserTxMemo =. - val (memo <> " " <> userTxMemo (entityVal uTx)) - ] - where_ (t ^. UserTxId ==. val (entityKey uTx)) - return () - -getUserTx :: ConnectionPool -> WalletAddressId -> IO [Entity UserTx] -getUserTx pool aId = do - runNoLoggingT $ - PS.retryOnBusy $ - flip PS.runSqlPool pool $ do - select $ do - uTxs <- from $ table @UserTx - where_ (uTxs ^. UserTxAddress ==. val aId) - orderBy [asc $ uTxs ^. UserTxTime] - return uTxs - --- | Get wallet transparent notes by account -getWalletTrNotes :: ConnectionPool -> ZcashAccountId -> IO [Entity WalletTrNote] -getWalletTrNotes pool za = do - runNoLoggingT $ - PS.retryOnBusy $ - flip PS.runSqlPool pool $ do - select $ do - n <- from $ table @WalletTrNote - where_ (n ^. WalletTrNoteAccId ==. val za) - pure n - --- | find Transparent spends -findTransparentSpends :: ConnectionPool -> ZcashAccountId -> IO () -findTransparentSpends pool za = do - notes <- getWalletTrNotes pool za - mapM_ findOneTrSpend notes - where - findOneTrSpend :: Entity WalletTrNote -> IO () - findOneTrSpend n = do - mReverseTxId <- - runNoLoggingT $ - PS.retryOnBusy $ - flip PS.runSqlPool pool $ do - selectOne $ do - wtx <- from $ table @WalletTransaction - where_ - (wtx ^. WalletTransactionId ==. val (walletTrNoteTx $ entityVal n)) - pure $ wtx ^. WalletTransactionTxId - case mReverseTxId of - Nothing -> throwIO $ userError "failed to get tx ID" - Just (Value reverseTxId) -> do - let flipTxId = - HexStringDB $ - HexString $ BS.reverse $ toBytes $ getHex reverseTxId - s <- - runNoLoggingT $ - PS.retryOnBusy $ - flip PS.runSqlPool pool $ do - select $ do - (tx :& trSpends) <- - from $ - table @ZcashTransaction `innerJoin` table @TransparentSpend `on` - (\(tx :& trSpends) -> - tx ^. ZcashTransactionId ==. trSpends ^. TransparentSpendTx) - where_ - (trSpends ^. TransparentSpendOutPointHash ==. val flipTxId) - where_ - (trSpends ^. TransparentSpendOutPointIndex ==. - val (walletTrNotePosition $ entityVal n)) - pure (tx, trSpends) - if null s - then return () - else do - runNoLoggingT $ - PS.retryOnBusy $ - flip PS.runSqlPool pool $ do - _ <- - update $ \w -> do - set w [WalletTrNoteSpent =. val True] - where_ $ w ^. WalletTrNoteId ==. val (entityKey n) - t' <- upsertWalTx (entityVal $ fst $ head s) za - _ <- - upsert - (WalletTrSpend - (entityKey t') - (entityKey n) - za - (walletTrNoteValue $ entityVal n)) - [] - return () - -getWalletSapNotes :: - ConnectionPool -> ZcashAccountId -> IO [Entity WalletSapNote] -getWalletSapNotes pool za = do - runNoLoggingT $ - PS.retryOnBusy $ - flip PS.runSqlPool pool $ do - select $ do - n <- from $ table @WalletSapNote - where_ (n ^. WalletSapNoteAccId ==. val za) - pure n - --- | Sapling DAG-aware spend tracking -findSapSpends :: - ConnectionPool -> ZcashAccountId -> [Entity WalletSapNote] -> IO () -findSapSpends _ _ [] = return () -findSapSpends pool za (n:notes) = do - s <- - runNoLoggingT $ - PS.retryOnBusy $ - flip PS.runSqlPool pool $ do - select $ do - (tx :& sapSpends) <- - from $ table @ZcashTransaction `innerJoin` table @ShieldSpend `on` - (\(tx :& sapSpends) -> - tx ^. ZcashTransactionId ==. sapSpends ^. ShieldSpendTx) - where_ - (sapSpends ^. ShieldSpendNullifier ==. - val (walletSapNoteNullifier (entityVal n))) - pure (tx, sapSpends) - if null s - then findSapSpends pool za notes - else do - runNoLoggingT $ - PS.retryOnBusy $ - flip PS.runSqlPool pool $ do - _ <- - update $ \w -> do - set w [WalletSapNoteSpent =. val True] - where_ $ w ^. WalletSapNoteId ==. val (entityKey n) - t' <- upsertWalTx (entityVal $ fst $ head s) za - _ <- - upsert - (WalletSapSpend - (entityKey t') - (entityKey n) - za - (walletSapNoteValue $ entityVal n)) - [] - return () - findSapSpends pool za notes - -getWalletOrchNotes :: - ConnectionPool -> ZcashAccountId -> IO [Entity WalletOrchNote] -getWalletOrchNotes pool za = do - runNoLoggingT $ - PS.retryOnBusy $ - flip PS.runSqlPool pool $ do - select $ do - n <- from $ table @WalletOrchNote - where_ (n ^. WalletOrchNoteAccId ==. val za) - pure n - -getUnspentSapNotes :: ConnectionPool -> IO [Entity WalletSapNote] -getUnspentSapNotes pool = do - runNoLoggingT $ - PS.retryOnBusy $ - flip PS.runSqlPool pool $ do - select $ do - n <- from $ table @WalletSapNote - where_ (n ^. WalletSapNoteSpent ==. val False) - pure n - -getSaplingCmus :: Pool SqlBackend -> ShieldOutputId -> IO [Value HexStringDB] -getSaplingCmus pool zt = do - PS.runSqlPool - (select $ do - n <- from $ table @ShieldOutput - where_ (n ^. ShieldOutputId >. val zt) - orderBy [asc $ n ^. ShieldOutputId] - pure $ n ^. ShieldOutputCmu) - pool - -getMaxSaplingNote :: Pool SqlBackend -> IO ShieldOutputId -getMaxSaplingNote pool = do - flip PS.runSqlPool pool $ do - x <- - selectOne $ do - n <- from $ table @ShieldOutput - where_ (n ^. ShieldOutputId >. val (toSqlKey 0)) - orderBy [desc $ n ^. ShieldOutputId] - pure (n ^. ShieldOutputId) - case x of - Nothing -> return $ toSqlKey 0 - Just (Value y) -> return y - -updateSapNoteRecord :: - Pool SqlBackend - -> WalletSapNoteId - -> SaplingWitness - -> ShieldOutputId - -> IO () -updateSapNoteRecord pool n w o = do - flip PS.runSqlPool pool $ do - update $ \x -> do - set - x - [ WalletSapNoteWitness =. val (HexStringDB $ sapWit w) - , WalletSapNoteWitPos =. val o - ] - where_ (x ^. WalletSapNoteId ==. val n) - -getUnspentOrchNotes :: ConnectionPool -> IO [Entity WalletOrchNote] -getUnspentOrchNotes pool = do - runNoLoggingT $ - PS.retryOnBusy $ - flip PS.runSqlPool pool $ do - select $ do - n <- from $ table @WalletOrchNote - where_ (n ^. WalletOrchNoteSpent ==. val False) - pure n - -getOrchardCmxs :: Pool SqlBackend -> OrchActionId -> IO [Value HexStringDB] -getOrchardCmxs pool zt = do - PS.runSqlPool - (select $ do - n <- from $ table @OrchAction - where_ (n ^. OrchActionId >. val zt) - orderBy [asc $ n ^. OrchActionId] - pure $ n ^. OrchActionCmx) - pool - -getMaxOrchardNote :: Pool SqlBackend -> IO OrchActionId -getMaxOrchardNote pool = do - flip PS.runSqlPool pool $ do - x <- - selectOne $ do - n <- from $ table @OrchAction - where_ (n ^. OrchActionId >. val (toSqlKey 0)) - orderBy [desc $ n ^. OrchActionId] - pure (n ^. OrchActionId) - case x of - Nothing -> return $ toSqlKey 0 - Just (Value y) -> return y - -updateOrchNoteRecord :: - Pool SqlBackend - -> WalletOrchNoteId - -> OrchardWitness - -> OrchActionId - -> IO () -updateOrchNoteRecord pool n w o = do - flip PS.runSqlPool pool $ do - update $ \x -> do - set - x - [ WalletOrchNoteWitness =. val (HexStringDB $ orchWit w) - , WalletOrchNoteWitPos =. val o - ] - where_ (x ^. WalletOrchNoteId ==. val n) - -findOrchSpends :: - ConnectionPool -> ZcashAccountId -> [Entity WalletOrchNote] -> IO () -findOrchSpends _ _ [] = return () -findOrchSpends pool za (n:notes) = do - s <- - runNoLoggingT $ - PS.retryOnBusy $ - flip PS.runSqlPool pool $ do - select $ do - (tx :& orchSpends) <- - from $ table @ZcashTransaction `innerJoin` table @OrchAction `on` - (\(tx :& orchSpends) -> - tx ^. ZcashTransactionId ==. orchSpends ^. OrchActionTx) - where_ - (orchSpends ^. OrchActionNf ==. - val (walletOrchNoteNullifier (entityVal n))) - pure (tx, orchSpends) - if null s - then findOrchSpends pool za notes - else do - runNoLoggingT $ - PS.retryOnBusy $ - flip PS.runSqlPool pool $ do - _ <- - update $ \w -> do - set w [WalletOrchNoteSpent =. val True] - where_ $ w ^. WalletOrchNoteId ==. val (entityKey n) - t' <- upsertWalTx (entityVal $ fst $ head s) za - _ <- - upsert - (WalletOrchSpend - (entityKey t') - (entityKey n) - za - (walletOrchNoteValue $ entityVal n)) - [] - return () - findOrchSpends pool za notes - -upsertWalTx :: - MonadIO m - => ZcashTransaction - -> ZcashAccountId - -> SqlPersistT m (Entity WalletTransaction) -upsertWalTx zt za = - upsert - (WalletTransaction - (zcashTransactionTxId zt) - za - (zcashTransactionBlock zt) - (zcashTransactionConf zt) - (zcashTransactionTime zt)) - [] - -getBalance :: ConnectionPool -> ZcashAccountId -> IO Integer -getBalance pool za = do - trNotes <- getWalletUnspentTrNotes pool za - let tAmts = map (walletTrNoteValue . entityVal) trNotes - let tBal = sum tAmts - sapNotes <- getWalletUnspentSapNotes pool za - let sAmts = map (walletSapNoteValue . entityVal) sapNotes - let sBal = sum sAmts - orchNotes <- getWalletUnspentOrchNotes pool za - let oAmts = map (walletOrchNoteValue . entityVal) orchNotes - let oBal = sum oAmts - return . fromIntegral $ tBal + sBal + oBal - -clearWalletTransactions :: ConnectionPool -> IO () -clearWalletTransactions pool = do - runNoLoggingT $ - PS.retryOnBusy $ - flip PS.runSqlPool pool $ do - delete $ do - _ <- from $ table @UserTx - return () - delete $ do - _ <- from $ table @WalletOrchSpend - return () - delete $ do - _ <- from $ table @WalletOrchNote - return () - delete $ do - _ <- from $ table @WalletSapSpend - return () - delete $ do - _ <- from $ table @WalletSapNote - return () - delete $ do - _ <- from $ table @WalletTrNote - return () - delete $ do - _ <- from $ table @WalletTrSpend - return () - delete $ do - _ <- from $ table @WalletTransaction - return () - -getWalletUnspentTrNotes :: - ConnectionPool -> ZcashAccountId -> IO [Entity WalletTrNote] -getWalletUnspentTrNotes pool za = do - runNoLoggingT $ - PS.retryOnBusy $ - flip PS.runSqlPool pool $ do - select $ do - n <- from $ table @WalletTrNote - where_ (n ^. WalletTrNoteAccId ==. val za) - where_ (n ^. WalletTrNoteSpent ==. val False) - pure n - -getWalletUnspentSapNotes :: - ConnectionPool -> ZcashAccountId -> IO [Entity WalletSapNote] -getWalletUnspentSapNotes pool za = do - runNoLoggingT $ - PS.retryOnBusy $ - flip PS.runSqlPool pool $ do - select $ do - n1 <- from $ table @WalletSapNote - where_ (n1 ^. WalletSapNoteAccId ==. val za) - where_ (n1 ^. WalletSapNoteSpent ==. val False) - pure n1 - -getWalletUnspentOrchNotes :: - ConnectionPool -> ZcashAccountId -> IO [Entity WalletOrchNote] -getWalletUnspentOrchNotes pool za = do - runNoLoggingT $ - PS.retryOnBusy $ - flip PS.runSqlPool pool $ do - select $ do - n2 <- from $ table @WalletOrchNote - where_ (n2 ^. WalletOrchNoteAccId ==. val za) - where_ (n2 ^. WalletOrchNoteSpent ==. val False) - pure n2 - -selectUnspentNotes :: - ConnectionPool - -> ZcashAccountId - -> Integer - -> IO ([Entity WalletTrNote], [Entity WalletSapNote], [Entity WalletOrchNote]) -selectUnspentNotes pool za amt = do - trNotes <- getWalletUnspentTrNotes pool za - let (a1, tList) = checkTransparent (fromIntegral amt) trNotes - if a1 > 0 - then do - sapNotes <- getWalletUnspentSapNotes pool za - let (a2, sList) = checkSapling a1 sapNotes - if a2 > 0 - then do - orchNotes <- getWalletUnspentOrchNotes pool za - let (a3, oList) = checkOrchard a2 orchNotes - if a3 > 0 - then throwIO $ userError "Not enough funds" - else return (tList, sList, oList) - else return (tList, sList, []) - else return (tList, [], []) - where - checkTransparent :: - Word64 -> [Entity WalletTrNote] -> (Word64, [Entity WalletTrNote]) - checkTransparent x [] = (x, []) - checkTransparent x (n:ns) = - if walletTrNoteValue (entityVal n) < x - then ( fst (checkTransparent (x - walletTrNoteValue (entityVal n)) ns) - , n : - snd (checkTransparent (x - walletTrNoteValue (entityVal n)) ns)) - else (0, [n]) - checkSapling :: - Word64 -> [Entity WalletSapNote] -> (Word64, [Entity WalletSapNote]) - checkSapling x [] = (x, []) - checkSapling x (n:ns) = - if walletSapNoteValue (entityVal n) < x - then ( fst (checkSapling (x - walletSapNoteValue (entityVal n)) ns) - , n : snd (checkSapling (x - walletSapNoteValue (entityVal n)) ns)) - else (0, [n]) - checkOrchard :: - Word64 -> [Entity WalletOrchNote] -> (Word64, [Entity WalletOrchNote]) - checkOrchard x [] = (x, []) - checkOrchard x (n:ns) = - if walletOrchNoteValue (entityVal n) < x - then ( fst (checkOrchard (x - walletOrchNoteValue (entityVal n)) ns) - , n : snd (checkOrchard (x - walletOrchNoteValue (entityVal n)) ns)) - else (0, [n]) - -getWalletTxId :: - ConnectionPool -> WalletTransactionId -> IO (Maybe (Value HexStringDB)) -getWalletTxId pool wId = do - runNoLoggingT $ - PS.retryOnBusy $ - flip PS.runSqlPool pool $ do - selectOne $ do - wtx <- from $ table @WalletTransaction - where_ (wtx ^. WalletTransactionId ==. val wId) - pure $ wtx ^. WalletTransactionTxId - --- | Helper function to extract a Unified Address from the database -readUnifiedAddressDB :: WalletAddress -> Maybe UnifiedAddress -readUnifiedAddressDB = - isValidUnifiedAddress . TE.encodeUtf8 . getUA . walletAddressUAddress - -rmdups :: Ord a => [a] -> [a] -rmdups = map head . group . sort +saveAddress dbFp w = runSqlite dbFp $ insertUniqueEntity w diff --git a/src/Zenith/Scanner.hs b/src/Zenith/Scanner.hs deleted file mode 100644 index df47ed1..0000000 --- a/src/Zenith/Scanner.hs +++ /dev/null @@ -1,157 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} - -module Zenith.Scanner where - -import Control.Exception (throwIO, try) -import qualified Control.Monad.Catch as CM (try) -import Control.Monad.IO.Class (liftIO) -import Control.Monad.Logger - ( LoggingT - , NoLoggingT - , logErrorN - , logInfoN - , runNoLoggingT - ) -import Data.Aeson -import Data.HexString -import Data.Maybe -import qualified Data.Text as T -import Data.Time (getCurrentTime) -import Database.Persist.Sqlite -import GHC.Utils.Monad (concatMapM) -import Lens.Micro ((&), (.~), (^.), set) -import System.Console.AsciiProgress -import ZcashHaskell.Types - ( BlockResponse(..) - , RawZebraTx(..) - , Transaction(..) - , ZebraGetBlockChainInfo(..) - , ZebraTxResponse(..) - , fromRawOBundle - , fromRawSBundle - , fromRawTBundle - ) -import ZcashHaskell.Utils (getBlockTime, makeZebraCall, readZebraTransaction) -import Zenith.Core (checkBlockChain) -import Zenith.DB (getMaxBlock, initDb, saveTransaction) -import Zenith.Utils (jsonNumber) - --- | Function to scan the Zcash blockchain through the Zebra node and populate the Zenith database -scanZebra :: - Int -- ^ Starting block - -> T.Text -- ^ Host - -> Int -- ^ Port - -> T.Text -- ^ Path to database file - -> NoLoggingT IO () -scanZebra b host port dbFilePath = do - _ <- liftIO $ initDb dbFilePath - startTime <- liftIO getCurrentTime - logInfoN $ "Started sync: " <> T.pack (show startTime) - bc <- - liftIO $ try $ checkBlockChain host port :: NoLoggingT - IO - (Either IOError ZebraGetBlockChainInfo) - case bc of - Left e -> logErrorN $ T.pack (show e) - Right bStatus -> do - let dbInfo = - mkSqliteConnectionInfo dbFilePath & extraPragmas .~ - ["read_uncommited = true"] - pool <- createSqlitePoolFromInfo dbInfo 5 - dbBlock <- getMaxBlock pool - let sb = max dbBlock b - if sb > zgb_blocks bStatus || sb < 1 - then liftIO $ throwIO $ userError "Invalid starting block for scan" - else do - liftIO $ - print $ - "Scanning from " ++ - show (sb + 1) ++ " to " ++ show (zgb_blocks bStatus) - let bList = [(sb + 1) .. (zgb_blocks bStatus)] - displayConsoleRegions $ do - pg <- - liftIO $ - newProgressBar def {pgTotal = fromIntegral $ length bList} - txList <- - CM.try $ mapM_ (processBlock host port pool pg) bList :: NoLoggingT - IO - (Either IOError ()) - case txList of - Left e1 -> logErrorN $ T.pack (show e1) - Right txList' -> logInfoN "Finished scan" - --- | Function to process a raw block and extract the transaction information -processBlock :: - T.Text -- ^ Host name for `zebrad` - -> Int -- ^ Port for `zebrad` - -> ConnectionPool -- ^ DB file path - -> ProgressBar -- ^ Progress bar - -> Int -- ^ The block number to process - -> NoLoggingT IO () -processBlock host port pool pg b = do - r <- - liftIO $ - makeZebraCall - host - port - "getblock" - [Data.Aeson.String $ T.pack $ show b, jsonNumber 1] - case r of - Left e -> liftIO $ throwIO $ userError e - Right blk -> do - r2 <- - liftIO $ - makeZebraCall - host - port - "getblock" - [Data.Aeson.String $ T.pack $ show b, jsonNumber 0] - case r2 of - Left e2 -> liftIO $ throwIO $ userError e2 - Right hb -> do - let blockTime = getBlockTime hb - mapM_ (processTx host port blockTime pool) $ - bl_txs $ addTime blk blockTime - liftIO $ tick pg - where - addTime :: BlockResponse -> Int -> BlockResponse - addTime bl t = - BlockResponse - (bl_confirmations bl) - (bl_height bl) - (fromIntegral t) - (bl_txs bl) - --- | Function to process a raw transaction -processTx :: - T.Text -- ^ Host name for `zebrad` - -> Int -- ^ Port for `zebrad` - -> Int -- ^ Block time - -> ConnectionPool -- ^ DB file path - -> HexString -- ^ transaction id - -> NoLoggingT IO () -processTx host port bt pool t = do - r <- - liftIO $ - makeZebraCall - host - port - "getrawtransaction" - [Data.Aeson.String $ toText t, jsonNumber 1] - case r of - Left e -> liftIO $ throwIO $ userError e - Right rawTx -> do - case readZebraTransaction (ztr_hex rawTx) of - Nothing -> return () - Just rzt -> do - _ <- - saveTransaction pool bt $ - Transaction - t - (ztr_blockheight rawTx) - (ztr_conf rawTx) - (fromIntegral $ zt_expiry rzt) - (fromRawTBundle $ zt_tBundle rzt) - (fromRawSBundle $ zt_sBundle rzt) - (fromRawOBundle $ zt_oBundle rzt) - return () diff --git a/src/Zenith/Types.hs b/src/Zenith/Types.hs index 5526aa6..715e338 100644 --- a/src/Zenith/Types.hs +++ b/src/Zenith/Types.hs @@ -10,10 +10,10 @@ module Zenith.Types where import Data.Aeson +import Data.Aeson.Types (prependFailure, typeMismatch) import qualified Data.ByteString as BS import qualified Data.ByteString.Base64 as B64 import qualified Data.ByteString.Char8 as C -import Data.HexString import Data.Maybe (fromMaybe) import qualified Data.Text as T import qualified Data.Text.Encoding as E @@ -23,21 +23,12 @@ import GHC.Generics import ZcashHaskell.Types ( OrchardSpendingKey(..) , Phrase(..) - , Rseed(..) , SaplingSpendingKey(..) , Scope(..) , TransparentSpendingKey , ZcashNet(..) ) --- * UI --- * Database field type wrappers -newtype HexStringDB = HexStringDB - { getHex :: HexString - } deriving newtype (Eq, Show, Read) - -derivePersistField "HexStringDB" - newtype ZcashNetDB = ZcashNetDB { getNet :: ZcashNet } deriving newtype (Eq, Show, Read) @@ -80,44 +71,15 @@ newtype TransparentSpendingKeyDB = TransparentSpendingKeyDB derivePersistField "TransparentSpendingKeyDB" -newtype RseedDB = RseedDB - { getRseed :: Rseed - } deriving newtype (Eq, Show, Read) +-- | A type to model Zcash RPC calls +data RpcCall = RpcCall + { jsonrpc :: T.Text + , id :: T.Text + , method :: T.Text + , params :: [Value] + } deriving (Show, Generic, ToJSON, FromJSON) -derivePersistField "RseedDB" - --- * RPC --- | Type for Configuration parameters -data Config = Config - { c_dbPath :: !T.Text - , c_zebraHost :: !T.Text - , c_zebraPort :: !Int - } deriving (Eq, Prelude.Show) - --- ** `zebrad` --- | Type for modeling the tree state response -data ZebraTreeInfo = ZebraTreeInfo - { ztiHeight :: !Int - , ztiTime :: !Int - , ztiSapling :: !HexString - , ztiOrchard :: !HexString - } deriving (Eq, Show, Read) - -instance FromJSON ZebraTreeInfo where - parseJSON = - withObject "ZebraTreeInfo" $ \obj -> do - h <- obj .: "height" - t <- obj .: "time" - s <- obj .: "sapling" - o <- obj .: "orchard" - sc <- s .: "commitments" - oc <- o .: "commitments" - sf <- sc .: "finalState" - ocf <- oc .: "finalState" - pure $ ZebraTreeInfo h t sf ocf - --- ** `zcashd` --- | Type for modelling the different address sources for `zcashd` 5.0.0 +-- | Type for modelling the different address sources for Zcash 5.0.0 data AddressSource = LegacyRandom | Imported @@ -166,6 +128,24 @@ instance Show ZcashAddress where T.unpack (T.take 8 a) ++ "..." ++ T.unpack (T.takeEnd 8 a) ++ " Pools: " ++ show p +-- | A type to model the response of the Zcash RPC +data RpcResponse r = RpcResponse + { err :: Maybe T.Text + , respId :: T.Text + , result :: r + } deriving (Show, Generic, ToJSON) + +instance (FromJSON r) => FromJSON (RpcResponse r) where + parseJSON (Object obj) = do + e <- obj .: "error" + rId <- obj .: "id" + r <- obj .: "result" + pure $ RpcResponse e rId r + parseJSON invalid = + prependFailure + "parsing RpcResponse failed, " + (typeMismatch "Object" invalid) + newtype NodeVersion = NodeVersion Integer deriving (Eq, Show) diff --git a/src/Zenith/Utils.hs b/src/Zenith/Utils.hs index 96ca8dd..ed648a4 100644 --- a/src/Zenith/Utils.hs +++ b/src/Zenith/Utils.hs @@ -2,10 +2,11 @@ module Zenith.Utils where -import Data.Aeson +import qualified Data.ByteString as BS +import qualified Data.ByteString.Char8 as C +import Data.Char import Data.Functor (void) import Data.Maybe -import Data.Scientific (Scientific(..), scientific) import qualified Data.Text as T import qualified Data.Text.Encoding as E import System.Process (createProcess_, shell) @@ -19,26 +20,14 @@ import Zenith.Types , ZcashPool(..) ) --- | Helper function to convert numbers into JSON -jsonNumber :: Int -> Value -jsonNumber i = Number $ scientific (fromIntegral i) 0 - -- | Helper function to display small amounts of ZEC displayZec :: Integer -> String displayZec s - | abs s < 100 = show s ++ " zats " - | abs s < 100000 = show (fromIntegral s / 100) ++ " μZEC " - | abs s < 100000000 = show (fromIntegral s / 100000) ++ " mZEC " + | s < 100 = show s ++ " zats " + | s < 100000 = show (fromIntegral s / 100) ++ " μZEC " + | s < 100000000 = show (fromIntegral s / 100000) ++ " mZEC " | otherwise = show (fromIntegral s / 100000000) ++ " ZEC " --- | Helper function to display small amounts of ZEC -displayTaz :: Integer -> String -displayTaz s - | abs s < 100 = show s ++ " tazs " - | abs s < 100000 = show (fromIntegral s / 100) ++ " μTAZ " - | abs s < 100000000 = show (fromIntegral s / 100000) ++ " mTAZ " - | otherwise = show (fromIntegral s / 100000000) ++ " TAZ " - -- | Helper function to display abbreviated Unified Address showAddress :: UnifiedAddressDB -> T.Text showAddress u = T.take 20 t <> "..." diff --git a/src/Zenith/Zcashd.hs b/src/Zenith/Zcashd.hs index bc4c2d2..d82cd1e 100644 --- a/src/Zenith/Zcashd.hs +++ b/src/Zenith/Zcashd.hs @@ -24,12 +24,13 @@ import System.IO import Text.Read (readMaybe) import Text.Regex import Text.Regex.Base -import ZcashHaskell.Types (RpcCall(..), RpcResponse(..)) import Zenith.Types ( AddressGroup , AddressSource(..) , NodeVersion(..) , OpResult(..) + , RpcCall(..) + , RpcResponse(..) , UABalance(..) , ZcashAddress(..) , ZcashPool(..) @@ -48,11 +49,8 @@ listAddresses user pwd = do Nothing -> fail "Couldn't parse node response" Just res -> do let addys = result res - case addys of - Nothing -> fail "Empty response" - Just addys' -> do - let addList = concatMap getAddresses addys' - return addList + let addList = concatMap getAddresses addys + return addList -- | Get address balance getBalance :: BS.ByteString -> BS.ByteString -> ZcashAddress -> IO [Integer] @@ -73,9 +71,7 @@ getBalance user pwd zadd = do case rpcResp of Nothing -> fail "Couldn't parse node response" Just res -> do - case result res of - Nothing -> return [] - Just r -> return [r] + return [result res] Just acct -> do response <- makeZcashCall @@ -87,9 +83,7 @@ getBalance user pwd zadd = do case rpcResp of Nothing -> fail "Couldn't parse node response" Just res -> do - case result res of - Nothing -> return [0, 0, 0] - Just r -> return $ readUABalance r + return $ readUABalance (result res) where readUABalance ua = [uatransparent ua, uasapling ua, uaorchard ua] @@ -102,9 +96,7 @@ listTxs user pwd zaddy = do case rpcResp of Nothing -> fail "listTxs: Couldn't parse node response" Just res -> do - case result res of - Nothing -> fail "listTxs: Empty response" - Just res' -> return res' + return $ result res -- | Send Tx sendTx :: @@ -158,7 +150,7 @@ sendTx user pwd fromAddy toAddy amount memo = do Nothing -> fail "Couldn't parse node response" Just res -> do putStr " Sending." - checkOpResult user pwd (fromMaybe "" $ result res) + checkOpResult user pwd (result res) else putStrLn "Error: Source address is view-only." else putStrLn "Error: Insufficient balance in source address." @@ -171,14 +163,11 @@ checkServer user pwd = do Nothing -> fail "Couldn't parse node response" Just myResp -> do let r = result myResp - case r of - Nothing -> fail "Empty node response" - Just r' -> do - if isNodeValid r' - then putStrLn $ "Connected to Zcash Full Node (" <> show r <> ") :)" - else do - putStrLn "Deprecated Zcash Full Node version found. Exiting" - exitFailure + if isNodeValid r + then putStrLn $ "Connected to Zcash Full Node (" <> show r <> ") :)" + else do + putStrLn "Deprecated Zcash Full Node version found. Exiting" + exitFailure where isNodeValid (NodeVersion i) = i >= 5000000 -- | Check for accounts @@ -246,9 +235,7 @@ checkOpResult user pwd opid = do Nothing -> fail "Couldn't parse node response" Just res -> do let r = result res - case r of - Nothing -> fail "Empty node response" - Just r' -> mapM_ showResult r' + mapM_ showResult r where showResult t = case opsuccess t of @@ -282,7 +269,7 @@ makeZcashCall username password m p = do let rpcResp = decode body :: Maybe (RpcResponse String) case rpcResp of Nothing -> fail $ "Unknown server error " ++ show response - Just x -> fail (fromMaybe "" $ result x) + Just x -> fail (result x) 401 -> fail "Incorrect full node credentials" 200 -> return body _ -> fail "Unknown error" diff --git a/test/Spec.hs b/test/Spec.hs index 35fb3a1..bfc6f68 100644 --- a/test/Spec.hs +++ b/test/Spec.hs @@ -1,36 +1,16 @@ {-# LANGUAGE OverloadedStrings #-} import Control.Monad (when) -import Control.Monad.Logger (runNoLoggingT) -import Data.HexString -import qualified Data.Text.Encoding as E import Database.Persist import Database.Persist.Sqlite import System.Directory -import Test.HUnit import Test.Hspec import ZcashHaskell.Orchard (isValidUnifiedAddress) -import ZcashHaskell.Sapling - ( decodeSaplingOutputEsk - , encodeSaplingAddress - , getSaplingNotePosition - , getSaplingWitness - , isValidShieldedAddress - , updateSaplingCommitmentTree - ) -import ZcashHaskell.Transparent - ( decodeExchangeAddress - , decodeTransparentAddress - ) import ZcashHaskell.Types - ( DecodedNote(..) - , OrchardSpendingKey(..) + ( OrchardSpendingKey(..) , Phrase(..) - , SaplingCommitmentTree(..) - , SaplingReceiver(..) , SaplingSpendingKey(..) , Scope(..) - , ShieldedOutput(..) , ZcashNet(..) ) import Zenith.Core @@ -58,7 +38,6 @@ main = do Phrase "one two three four five six seven eight nine ten eleven twelve") 2000000 - 0 fromSqlKey s `shouldBe` 1 it "read wallet record" $ do s <- @@ -81,9 +60,8 @@ main = do "None" `shouldBe` maybe "None" zcashWalletName s describe "Wallet function tests:" $ do it "Save Wallet:" $ do - pool <- runNoLoggingT $ initPool "test.db" zw <- - saveWallet pool $ + saveWallet "test.db" $ ZcashWallet "Testing" (ZcashNetDB MainNet) @@ -91,22 +69,21 @@ main = do Phrase "cloth swing left trap random tornado have great onion element until make shy dad success art tuition canvas thunder apple decade elegant struggle invest") 2200000 - 0 zw `shouldNotBe` Nothing it "Save Account:" $ do - pool <- runNoLoggingT $ initPool "test.db" s <- runSqlite "test.db" $ do selectList [ZcashWalletName ==. "Testing"] [] - za <- saveAccount pool =<< createZcashAccount "TestAccount" 0 (head s) + za <- + saveAccount "test.db" =<< + createZcashAccount "TestAccount" 0 (head s) za `shouldNotBe` Nothing it "Save address:" $ do - pool <- runNoLoggingT $ initPool "test.db" acList <- runSqlite "test.db" $ selectList [ZcashAccountName ==. "TestAccount"] [] zAdd <- - saveAddress pool =<< + saveAddress "test.db" =<< createWalletAddress "Personal123" 0 MainNet External (head acList) addList <- runSqlite "test.db" $ @@ -121,133 +98,3 @@ main = do let ua = "utest1mvlny48qd4x94w8vz5u2lrxx0enuquajt72yekgq24p6pjaky3czk6m7x358h7g900ex6gzvdehaekl96qnakjzw8yaasp8y0u3j5jnlfd33trduznh6k3fcn5ek9qc857fgz8ehm37etx94sj58nrkc0k5hurxnuxpcpms3j8uy2t8kt2vy6vetvsfxxdhtjq0yqulqprvh7mf2u3x" isValidUnifiedAddress ua `shouldNotBe` Nothing - describe "Function tests" $ do - describe "Sapling Decoding" $ do - let sk = - SaplingSpendingKey - "\ETX}\195.\SUB\NUL\NUL\NUL\128\NUL\203\"\229IL\CANJ*\209\EM\145\228m\172\&4\SYNNl\DC3\161\147\SO\157\238H\192\147eQ\143L\201\216\163\180\147\145\156Zs+\146>8\176`ta\161\223\SO\140\177\b;\161\SO\236\151W\148<\STX\171|\DC2\172U\195(I\140\146\214\182\137\211\228\159\128~bV\STXy{m'\224\175\221\219\180!\ENQ_\161\132\240?\255\236\"6\133\181\170t\181\139\143\207\170\211\ENQ\167a\184\163\243\246\140\158t\155\133\138X\a\241\200\140\EMT\GS~\175\249&z\250\214\231\239mi\223\206\STX\t\EM<{V~J\253FB" - let tree = - SaplingCommitmentTree $ - hexString - "01818f2bd58b1e392334d0565181cc7843ae09e3533b2a50a8f1131af657340a5c001001161f962245812ba5e1804fd0a336bc78fa4ee4441a8e0f1525ca5da1b285d35101120f45afa700b8c1854aa8b9c8fe8ed92118ef790584bfcb926078812a10c83a00000000012f4f72c03f8c937a94919a01a07f21165cc8394295291cb888ca91ed003810390107114fe4bb4cd08b47f6ae47477c182d5da9fe5c189061808c1091e9bf3b4524000001447d6b9100cddd5f80c8cf4ddee2b87eba053bd987465aec2293bd0514e68b0d015f6c95e75f4601a0a31670a7deb970fc8988c611685161d2e1629d0a1a0ebd07015f8b9205e0514fa235d75c150b87e23866b882b39786852d1ab42aab11d31a4a0117ddeb3a5f8d2f6b2d0a07f28f01ab25e03a05a9319275bb86d72fcaef6fc01501f08f39275112dd8905b854170b7f247cf2df18454d4fa94e6e4f9320cca05f24011f8322ef806eb2430dc4a7a41c1b344bea5be946efc7b4349c1c9edb14ff9d39" - let nextTree = - SaplingCommitmentTree $ - hexString - "01bd8a3f3cfc964332a2ada8c09a0da9dfc24174befb938abb086b9be5ca049e4900100000019f0d7efb00169bb2202152d3266059d208ab17d14642c3339f9075e997160657000000012f4f72c03f8c937a94919a01a07f21165cc8394295291cb888ca91ed003810390107114fe4bb4cd08b47f6ae47477c182d5da9fe5c189061808c1091e9bf3b4524000001447d6b9100cddd5f80c8cf4ddee2b87eba053bd987465aec2293bd0514e68b0d015f6c95e75f4601a0a31670a7deb970fc8988c611685161d2e1629d0a1a0ebd07015f8b9205e0514fa235d75c150b87e23866b882b39786852d1ab42aab11d31a4a0117ddeb3a5f8d2f6b2d0a07f28f01ab25e03a05a9319275bb86d72fcaef6fc01501f08f39275112dd8905b854170b7f247cf2df18454d4fa94e6e4f9320cca05f24011f8322ef806eb2430dc4a7a41c1b344bea5be946efc7b4349c1c9edb14ff9d39" - it "Sapling is decoded correctly" $ do - so <- - runSqlite "zenith.db" $ - selectList [ShieldOutputTx ==. toSqlKey 38318] [] - let cmus = map (getHex . shieldOutputCmu . entityVal) so - let pos = - getSaplingNotePosition <$> - (getSaplingWitness =<< - updateSaplingCommitmentTree tree (head cmus)) - let pos1 = getSaplingNotePosition <$> getSaplingWitness tree - let pos2 = getSaplingNotePosition <$> getSaplingWitness nextTree - case pos of - Nothing -> assertFailure "couldn't get note position" - Just p -> do - print p - print pos1 - print pos2 - let dn = - decodeSaplingOutputEsk - sk - (ShieldedOutput - (getHex $ shieldOutputCv $ entityVal $ head so) - (getHex $ shieldOutputCmu $ entityVal $ head so) - (getHex $ shieldOutputEphKey $ entityVal $ head so) - (getHex $ shieldOutputEncCipher $ entityVal $ head so) - (getHex $ shieldOutputOutCipher $ entityVal $ head so) - (getHex $ shieldOutputProof $ entityVal $ head so)) - TestNet - External - p - case dn of - Nothing -> assertFailure "couldn't decode Sap output" - Just d -> - a_nullifier d `shouldBe` - hexString - "6c5d1413c63a9a88db71c3f41dc12cd60197ee742fc75b217215e7144db48bd3" - describe "Note selection for Tx" $ do - it "Value less than balance" $ do - pool <- runNoLoggingT $ initPool "zenith.db" - res <- selectUnspentNotes pool (toSqlKey 1) 14000000 - res `shouldNotBe` ([], [], []) - it "Value greater than balance" $ do - pool <- runNoLoggingT $ initPool "zenith.db" - let res = selectUnspentNotes pool (toSqlKey 1) 84000000 - res `shouldThrow` anyIOException - it "Fee calculation" $ do - pool <- runNoLoggingT $ initPool "zenith.db" - res <- selectUnspentNotes pool (toSqlKey 1) 14000000 - calculateTxFee res 3 `shouldBe` 20000 - describe "Testing validation" $ do - it "Unified" $ do - let a = - "utest1zfnw84xuxg0ytzqc008gz0qntr8cvwu4qjsccgtxwdrjywra7uj85x8ldymjc2jd3jvvvhyj3xwsunyvwkr5084t6p5gmvzwdgvwpflrpd6a3squ2dp8vt7cxngmwk30l44wkmvyfegypqmezxfnqj572lr779gkqj5xekp66uv4jga58alnc5j7tuank758zd96ap4f09udg6y6pxu" - True `shouldBe` - (case isValidUnifiedAddress (E.encodeUtf8 a) of - Just _a1 -> True - Nothing -> - isValidShieldedAddress (E.encodeUtf8 a) || - (case decodeTransparentAddress (E.encodeUtf8 a) of - Just _a3 -> True - Nothing -> - case decodeExchangeAddress a of - Just _a4 -> True - Nothing -> False)) - it "Sapling" $ do - let a = - "ztestsapling1tgjr4zppwk4ne8xy6gdq4z2gwq7dmf5jq8z2ctpn8nlmtse0a74fa5z0m8z383gmpgqz6q6duu4" - True `shouldBe` - (case isValidUnifiedAddress (E.encodeUtf8 a) of - Just _a1 -> True - Nothing -> - isValidShieldedAddress (E.encodeUtf8 a) || - (case decodeTransparentAddress (E.encodeUtf8 a) of - Just _a3 -> True - Nothing -> - case decodeExchangeAddress a of - Just _a4 -> True - Nothing -> False)) - it "Transparent" $ do - let a = "tmGfVZHuGVJ5vcLAgBdkUU4w7fLTRE5nXm3" - True `shouldBe` - (case isValidUnifiedAddress (E.encodeUtf8 a) of - Just _a1 -> True - Nothing -> - isValidShieldedAddress (E.encodeUtf8 a) || - (case decodeTransparentAddress (E.encodeUtf8 a) of - Just _a3 -> True - Nothing -> - case decodeExchangeAddress a of - Just _a4 -> True - Nothing -> False)) - it "Check Sapling Address" $ do - let a = - encodeSaplingAddress TestNet $ - SaplingReceiver - "Z$:\136!u\171<\156\196\210\SUB\n\137Hp<\221\166\146\SOH\196\172,3<\255\181\195/\239\170\158\208O\217\197\DC3\197\ESC\n\NUL-" - a `shouldBe` - Just - "ztestsapling1tgjr4zppwk4ne8xy6gdq4z2gwq7dmf5jq8z2ctpn8nlmtse0a74fa5z0m8z383gmpgqz6q6duu4" - {-describe "Creating Tx" $ do-} - {-xit "To Orchard" $ do-} - {-let uaRead =-} - {-isValidUnifiedAddress-} - {-"utest1dl54utt6prjj5e0dnlknwumnxq9hycdjpkfr0sy6e6h522remqee8axe9zax0wsjrwpj76v555pdhvj9rnargpfyycs0vpkapq98xcdhem99gc4wchzn0ggepq3y6nz3a9sscwgqxgsh9vzhcad402y3x9szfregck5gslkya3c79d86xx0l33tpk8gnn7ew9vw37w43zh22u8dgdax"-} - {-case uaRead of-} - {-Nothing -> assertFailure "wrong address"-} - {-Just ua -> do-} - {-tx <--} - {-prepareTx-} - {-"zenith.db"-} - {-TestNet-} - {-(toSqlKey 1)-} - {-2819811-} - {-0.04-} - {-ua-} - {-"sent with Zenith, test"-} - {-tx `shouldBe` Right (hexString "deadbeef")-} diff --git a/zcash-haskell b/zcash-haskell index 9dddb42..f228eff 160000 --- a/zcash-haskell +++ b/zcash-haskell @@ -1 +1 @@ -Subproject commit 9dddb42bb3ab78ed0c4d44efb00960ac112c2ce6 +Subproject commit f228eff367c776469455adc4d443102cc53e5538 diff --git a/zenith.cabal b/zenith.cabal index 3101182..081df74 100644 --- a/zenith.cabal +++ b/zenith.cabal @@ -1,6 +1,6 @@ cabal-version: 3.0 name: zenith -version: 0.5.1.0-beta +version: 0.4.4.1 license: MIT license-file: LICENSE author: Rene Vergara @@ -32,29 +32,16 @@ library Zenith.Types Zenith.Utils Zenith.Zcashd - Zenith.Scanner hs-source-dirs: src build-depends: Clipboard , aeson , array - , ascii-progress , base >=4.12 && <5 , base64-bytestring , brick , bytestring - , esqueleto - , resource-pool - , binary - , exceptions - , monad-logger - , vty-crossplatform - , secp256k1-haskell - , pureMD5 - , ghc - , haskoin-core - , hexstring , http-client , http-conduit , http-types @@ -63,16 +50,15 @@ library , microlens-th , mtl , persistent - , Hclip , persistent-sqlite , persistent-template , process + , hexstring , regex-base , regex-compat , regex-posix , scientific , text - , time , vector , vty , word-wrap @@ -100,19 +86,6 @@ executable zenith pkgconfig-depends: rustzcash_wrapper default-language: Haskell2010 -executable zenscan - ghc-options: -main-is ZenScan -threaded -rtsopts -with-rtsopts=-N - main-is: ZenScan.hs - hs-source-dirs: - app - build-depends: - base >=4.12 && <5 - , configurator - , monad-logger - , zenith - pkgconfig-depends: rustzcash_wrapper - default-language: Haskell2010 - test-suite zenith-tests type: exitcode-stdio-1.0 ghc-options: -threaded -rtsopts -with-rtsopts=-N @@ -123,7 +96,6 @@ test-suite zenith-tests base >=4.12 && <5 , bytestring , configurator - , monad-logger , data-default , sort , text @@ -131,8 +103,6 @@ test-suite zenith-tests , persistent , persistent-sqlite , hspec - , hexstring - , HUnit , directory , zcash-haskell , zenith