diff --git a/README.md b/README.md index f898769..2c0cfe0 100644 --- a/README.md +++ b/README.md @@ -36,13 +36,13 @@ Zenith is a command-line interface for the Zcash Full Node (`zcashd`). It has th git clone https://git.vergara.tech/Vergara_Tech/zenith.git cd zenith git submodule init -git submodule update +git submodule update --remote ``` -- Install using `stack`: +- Install using `cabal`: ``` -stack install +cabal install ``` ## Configuration diff --git a/app/Main.hs b/app/Main.hs index 70f07d5..d3c271b 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -199,7 +199,7 @@ main :: IO () main = do config <- load ["zenith.cfg"] args <- getArgs - dbName <- require config "dbName" + dbFilePath <- require config "dbFilePath" nodeUser <- require config "nodeUser" nodePwd <- require config "nodePwd" zebraPort <- require config "zebraPort" @@ -217,7 +217,7 @@ main = do " ______ _ _ _ \n |___ / (_) | | | \n / / ___ _ __ _| |_| |__ \n / / / _ \\ '_ \\| | __| '_ \\ \n / /_| __/ | | | | |_| | | |\n /_____\\___|_| |_|_|\\__|_| |_|\n Zcash Full Node CLI v0.4.0" } (root nodeUser nodePwd) - "cli" -> runZenithCLI zebraHost zebraPort dbName + "cli" -> runZenithCLI zebraHost zebraPort dbFilePath _ -> printUsage else printUsage diff --git a/src/Zenith/CLI.hs b/src/Zenith/CLI.hs index 88a2df2..106b1ae 100644 --- a/src/Zenith/CLI.hs +++ b/src/Zenith/CLI.hs @@ -5,7 +5,6 @@ module Zenith.CLI where import Control.Monad (void) import Control.Monad.IO.Class (liftIO) -import Data.Maybe (fromMaybe) import qualified Data.Text as T import qualified Graphics.Vty as V import Lens.Micro ((&), (.~), (^.), set) @@ -22,6 +21,7 @@ import Brick.Forms , handleFormEvent , newForm , renderForm + , updateFormState ) import qualified Brick.Main as M import qualified Brick.Types as BT @@ -42,6 +42,7 @@ import Brick.Widgets.Core , padBottom , padRight , str + , txt , vBox , vLimit , withAttr @@ -51,7 +52,7 @@ import qualified Brick.Widgets.Dialog as D import qualified Brick.Widgets.List as L import qualified Data.Vector as Vec import Database.Persist -import Network.HTTP.Simple +import ZcashHaskell.Keys (generateWalletSeedPhrase) import ZcashHaskell.Types import Zenith.Core import Zenith.DB @@ -61,14 +62,19 @@ data Name | AList | TList | HelpDialog - | WalNameField + | DialogInputField deriving (Eq, Show, Ord) -data WalletName = WalletName - { _walName :: !T.Text +data DialogInput = DialogInput + { _dialogInput :: !T.Text } deriving (Show) -makeLenses ''WalletName +makeLenses ''DialogInput + +data DialogType + = WName + | AName + | Blank data State = State { _network :: !String @@ -77,25 +83,36 @@ data State = State , _transactions :: !(L.List Name String) , _msg :: !String , _helpBox :: !Bool - , _walletBox :: !Bool + , _dialogBox :: !DialogType , _splashBox :: !Bool - , _walletForm :: !(Form WalletName () Name) + , _inputForm :: !(Form DialogInput () Name) , _focusRing :: !(F.FocusRing Name) + , _startBlock :: !Int + , _dbPath :: !T.Text } makeLenses ''State drawUI :: State -> [Widget Name] -drawUI s = [splashDialog s, helpDialog s, walletDialog s, ui s] +drawUI s = [splashDialog s, helpDialog s, inputDialog s, ui s] where ui :: State -> Widget Name - ui s = + ui st = joinBorders $ withBorderStyle unicode $ - B.borderWithLabel (str $ "Zenith - " <> s ^. network) $ - (C.center (listBox "Addresses" (s ^. addresses)) <+> - B.vBorder <+> C.center (listBox "Transactions" (s ^. transactions))) <=> - msgBox (s ^. msg) + B.borderWithLabel + (str + ("Zenith - " <> + st ^. network <> + " - " <> + T.unpack + (maybe + "(None)" + (\(_, w) -> zcashWalletName $ entityVal w) + (L.listSelectedElement (st ^. wallets))))) $ + (C.center (listBox "Addresses" (st ^. addresses)) <+> + B.vBorder <+> C.center (listBox "Transactions" (st ^. transactions))) <=> + msgBox (st ^. msg) listBox :: String -> L.List Name String -> Widget Name listBox titleLabel l = C.vCenter $ @@ -111,8 +128,8 @@ drawUI s = [splashDialog s, helpDialog s, walletDialog s, ui s] vBox [B.hBorderWithLabel (str "Messages"), hLimit 70 $ padRight Max $ str m] helpDialog :: State -> Widget Name - helpDialog s = - if s ^. helpBox + helpDialog st = + if st ^. helpBox then D.renderDialog (D.dialog (Just (str "Commands")) Nothing 55) (vBox ([C.hCenter $ str "Key", B.hBorder] <> keyList) <+> @@ -124,16 +141,21 @@ drawUI s = [splashDialog s, helpDialog s, walletDialog s, ui s] map (hLimit 40 . str) ["Open help", "Close dialog", "Create Wallet", "Quit"] - walletDialog :: State -> Widget Name - walletDialog s = - if s ^. walletBox - then D.renderDialog - (D.dialog (Just (str "Create Wallet")) Nothing 50) - (renderForm $ s ^. walletForm) - else emptyWidget + inputDialog :: State -> Widget Name + inputDialog st = + case st ^. dialogBox of + WName -> + D.renderDialog + (D.dialog (Just (str "Create Wallet")) Nothing 50) + (renderForm $ st ^. inputForm) + AName -> + D.renderDialog + (D.dialog (Just (str "Create Account")) Nothing 50) + (renderForm $ st ^. inputForm) + Blank -> emptyWidget splashDialog :: State -> Widget Name - splashDialog s = - if s ^. splashBox + splashDialog st = + if st ^. splashBox then withBorderStyle unicodeBold $ D.renderDialog (D.dialog Nothing Nothing 30) @@ -141,13 +163,14 @@ drawUI s = [splashDialog s, helpDialog s, walletDialog s, ui s] titleAttr (str " _____ _ _ _ \n|__ /___ _ __ (_) |_| |__\n / // _ \\ '_ \\| | __| '_ \\\n / /| __/ | | | | |_| | | |\n/____\\___|_| |_|_|\\__|_| |_|") <=> - C.hCenter (withAttr titleAttr (str "Zcash Wallet v0.4.1")) <=> + C.hCenter (withAttr titleAttr (str "Zcash Wallet v0.4.3.0")) <=> C.hCenter (withAttr blinkAttr $ str "Press any key...")) else emptyWidget -mkWalletForm :: WalletName -> Form WalletName e Name -mkWalletForm = - newForm [label "Name: " @@= editTextField walName WalNameField (Just 1)] +mkInputForm :: DialogInput -> Form DialogInput e Name +mkInputForm = + newForm + [label "Name: " @@= editTextField dialogInput DialogInputField (Just 1)] where label s w = padBottom (Pad 1) $ vLimit 1 (hLimit 15 $ str s <+> fill ' ') <+> w @@ -180,35 +203,57 @@ appEvent (BT.VtyEvent e) = do case e of V.EvKey V.KEsc [] -> do BT.modify $ set helpBox False - ev -> return () + _ev -> return () else do - if s ^. walletBox - then do + case s ^. dialogBox of + WName -> do case e of - V.EvKey V.KEsc [] -> BT.modify $ set walletBox False + V.EvKey V.KEsc [] -> BT.modify $ set dialogBox Blank V.EvKey V.KEnter [] -> do - BT.modify $ set walletBox False - fs <- BT.zoom walletForm $ BT.gets formState + fs <- BT.zoom inputForm $ BT.gets formState + nw <- liftIO $ addNewWallet (fs ^. dialogInput) s + BT.modify $ set wallets nw printMsg $ - "Creating new wallet " <> (T.unpack $ fs ^. walName) - ev -> BT.zoom walletForm $ handleFormEvent (BT.VtyEvent ev) - else do + "Creating new wallet " <> T.unpack (fs ^. dialogInput) + BT.modify $ set dialogBox Blank + ev -> BT.zoom inputForm $ handleFormEvent (BT.VtyEvent ev) + AName -> do + case e of + V.EvKey V.KEsc [] -> BT.modify $ set dialogBox Blank + V.EvKey V.KEnter [] -> do + BT.modify $ set dialogBox Blank + fs <- BT.zoom inputForm $ BT.gets formState + printMsg $ + "Creating new address " <> T.unpack (fs ^. dialogInput) + ev -> BT.zoom inputForm $ handleFormEvent (BT.VtyEvent ev) + Blank -> do case e of V.EvKey (V.KChar '\t') [] -> focusRing %= F.focusNext V.EvKey (V.KChar 'q') [] -> M.halt V.EvKey (V.KChar '?') [] -> BT.modify $ set helpBox True - V.EvKey (V.KChar 'c') [] -> BT.modify $ set walletBox True - V.EvKey (V.KChar 's') [] -> printMsg "You pressed S!" + V.EvKey (V.KChar 'w') [] -> do + BT.modify $ + set inputForm $ + updateFormState (DialogInput "New Wallet") $ + s ^. inputForm + BT.modify $ set dialogBox WName + V.EvKey (V.KChar 'a') [] -> do + BT.modify $ + set inputForm $ + updateFormState (DialogInput "New Account") $ + s ^. inputForm + BT.modify $ set dialogBox AName ev -> case r of Just AList -> BT.zoom addresses $ L.handleListEvent ev Just TList -> BT.zoom transactions $ L.handleListEvent ev - Nothing -> return () + _anyName -> return () where printMsg :: String -> BT.EventM Name State () printMsg s = BT.modify $ updateMsg s updateMsg :: String -> State -> State updateMsg = set msg +appEvent _ = return () theMap :: A.AttrMap theMap = @@ -233,7 +278,7 @@ theApp = } runZenithCLI :: T.Text -> Int -> T.Text -> IO () -runZenithCLI host port dbName = do +runZenithCLI host port dbFilePath = do w <- checkZebra host port case (w :: Maybe ZebraGetInfo) of Just zebra -> do @@ -241,7 +286,8 @@ runZenithCLI host port dbName = do case (bc :: Maybe ZebraGetBlockChainInfo) of Nothing -> print "Unable to determine blockchain status" Just chainInfo -> do - walList <- getWallets $ zgb_net chainInfo + initDb dbFilePath + walList <- getWallets dbFilePath $ zgb_net chainInfo void $ M.defaultMain theApp $ State @@ -252,11 +298,25 @@ runZenithCLI host port dbName = do ("Start up Ok! Connected to Zebra " ++ (T.unpack . zgi_build) zebra ++ " on port " ++ show port ++ ".") False - (null walList) + (if null walList + then WName + else Blank) True - (mkWalletForm $ WalletName "Main") + (mkInputForm $ DialogInput "Main") (F.focusRing [AList, TList]) + (zgb_blocks chainInfo) + dbFilePath Nothing -> do print $ "No Zebra node available on port " <> show port <> ". Check your configuration" + +addNewWallet :: + T.Text -> State -> IO (L.GenericList Name Vec.Vector (Entity ZcashWallet)) +addNewWallet n s = do + sP <- generateWalletSeedPhrase + let bH = s ^. startBlock + let netName = read $ s ^. network + _ <- saveWallet (s ^. dbPath) $ ZcashWallet sP bH n netName + wL <- getWallets (s ^. dbPath) netName + return $ L.listReplace (Vec.fromList wL) (Just 0) $ s ^. wallets diff --git a/src/Zenith/Core.hs b/src/Zenith/Core.hs index 097f645..40836f5 100644 --- a/src/Zenith/Core.hs +++ b/src/Zenith/Core.hs @@ -13,14 +13,40 @@ import ZcashHaskell.Utils import Zenith.DB -- * Database functions --- | Returns the list of wallets available in the given database -checkWallets :: - T.Text -- ^ The database name to check - -> ZcashNet -- ^ The network the wallet is running - -> IO [Entity ZcashWallet] -checkWallets dbName znet = do +-- | Initializes the database +initDb :: + T.Text -- ^ The database path to check + -> IO () +initDb dbName = do runSqlite dbName $ do runMigration migrateAll - runSqlite dbName $ selectList [ZcashWalletNetwork ==. znet] [] + +-- | Save a new wallet to the database +saveWallet :: + T.Text -- ^ The database path to use + -> ZcashWallet -- ^ The wallet to add to the database + -> IO ZcashWalletId +saveWallet dbFp w = runSqlite dbFp $ insert w + +-- | Returns a list of accounts associated with the given wallet +getAccounts :: + T.Text -- ^ The database path + -> ZcashWalletId -- ^ The wallet ID to check + -> IO [Entity ZcashAccount] +getAccounts dbFp w = runSqlite dbFp $ selectList [ZcashAccountWalletId ==. w] [] + +-- | Save a new account to the database +saveAccount :: + T.Text -- ^ The database path + -> ZcashAccount -- ^ The account to add to the database + -> IO ZcashAccountId +saveAccount dbFp a = runSqlite dbFp $ insert a + +-- | Returns a list of addresses associated with the given account +getAddresses :: + T.Text -- ^ The database path + -> ZcashAccountId -- ^ The account ID to check + -> IO [Entity WalletAddress] +getAddresses dbFp a = runSqlite dbFp $ selectList [WalletAddressAccId ==. a] [] -- * Zebra Node interaction -- | Checks the status of the `zebrad` node @@ -28,8 +54,8 @@ checkZebra :: T.Text -- ^ Host where `zebrad` is available -> Int -- ^ Port where `zebrad` is available -> IO (Maybe ZebraGetInfo) -checkZebra host port = do - res <- makeZebraCall host port "getinfo" [] +checkZebra nodeHost nodePort = do + res <- makeZebraCall nodeHost nodePort "getinfo" [] let body = responseBody (res :: Response (RpcResponse ZebraGetInfo)) return $ result body @@ -38,14 +64,14 @@ checkBlockChain :: T.Text -- ^ Host where `zebrad` is available -> Int -- ^ Port where `zebrad` is available -> IO (Maybe ZebraGetBlockChainInfo) -checkBlockChain host port = do - let f = makeZebraCall host port +checkBlockChain nodeHost nodePort = do + let f = makeZebraCall nodeHost nodePort result <$> (responseBody <$> f "getblockchaininfo" []) -- | Generic RPC call function connectZebra :: FromJSON a => T.Text -> Int -> T.Text -> [Data.Aeson.Value] -> IO (Maybe a) -connectZebra host port m params = do - res <- makeZebraCall host port m params +connectZebra nodeHost nodePort m params = do + res <- makeZebraCall nodeHost nodePort m params let body = responseBody res return $ result body diff --git a/src/Zenith/DB.hs b/src/Zenith/DB.hs index c1d9310..8af8832 100644 --- a/src/Zenith/DB.hs +++ b/src/Zenith/DB.hs @@ -31,16 +31,29 @@ share [persistLowerCase| ZcashWallet seedPhrase Phrase - spendingKey BS.ByteString - tPrivateKey BS.ByteString birthdayHeight Int name T.Text network ZcashNet deriving Show + ZcashAccount + walletId ZcashWalletId + index Int + orchSpendKey BS.ByteString + sapSpendKey BS.ByteString + tPrivateKey BS.ByteString + deriving Show + WalletAddress + accId ZcashAccountId + index Int + orchRec BS.ByteString Maybe + sapRec BS.ByteString Maybe + tRec BS.ByteString Maybe + encoded T.Text + deriving Show |] -getWallets :: ZcashNet -> IO [Entity ZcashWallet] -getWallets n = - runSqlite "zenith.db" $ do +getWallets :: T.Text -> ZcashNet -> IO [Entity ZcashWallet] +getWallets dbFp n = + runSqlite dbFp $ do s <- selectList [ZcashWalletNetwork ==. n] [] liftIO $ return s diff --git a/test/Spec.hs b/test/Spec.hs index e3556ce..03a2d20 100644 --- a/test/Spec.hs +++ b/test/Spec.hs @@ -1,51 +1,68 @@ {-# LANGUAGE OverloadedStrings #-} -import Control.Monad.IO.Class (liftIO) +import Control.Monad (when) import Database.Persist import Database.Persist.Sqlite +import System.Directory import Test.Hspec import ZcashHaskell.Types (ZcashNet(..)) +import Zenith.Core (getAccounts) import Zenith.DB -import Zenith.DB - ( EntityField(ZcashWalletId, ZcashWalletName) - , ZcashWallet(zcashWalletName) - ) main :: IO () main = do + checkDbFile <- doesFileExist "test.db" + when checkDbFile $ removeFile "test.db" hspec $ do describe "Database tests" $ do it "Create table" $ do s <- runSqlite "test.db" $ do runMigration migrateAll s `shouldBe` () - it "insert wallet record" $ do - s <- - runSqlite "test.db" $ do - insert $ - ZcashWallet - "one two three four five six seven eight nine ten eleven twelve" - "123456789" - "987654321" - 2000000 - "Main Wallet" - MainNet - fromSqlKey s `shouldBe` 1 - it "read wallet record" $ do - s <- - runSqlite "test.db" $ do - selectList [ZcashWalletBirthdayHeight >. 0] [] - length s `shouldBe` 1 - it "modify wallet record" $ do - s <- - runSqlite "test.db" $ do - let recId = toSqlKey 1 :: ZcashWalletId - update recId [ZcashWalletName =. "New Wallet"] - get recId - "New Wallet" `shouldBe` maybe "None" zcashWalletName s - it "delete wallet record" $ do - s <- - runSqlite "test.db" $ do - let recId = toSqlKey 1 :: ZcashWalletId - delete recId - get recId - "None" `shouldBe` maybe "None" zcashWalletName s + describe "Wallet Table" $ do + it "insert wallet record" $ do + s <- + runSqlite "test.db" $ do + insert $ + ZcashWallet + "one two three four five six seven eight nine ten eleven twelve" + 2000000 + "Main Wallet" + MainNet + fromSqlKey s `shouldBe` 1 + it "read wallet record" $ do + s <- + runSqlite "test.db" $ do + selectList [ZcashWalletBirthdayHeight >. 0] [] + length s `shouldBe` 1 + it "modify wallet record" $ do + s <- + runSqlite "test.db" $ do + let recId = toSqlKey 1 :: ZcashWalletId + update recId [ZcashWalletName =. "New Wallet"] + get recId + "New Wallet" `shouldBe` maybe "None" zcashWalletName s + it "delete wallet record" $ do + s <- + runSqlite "test.db" $ do + let recId = toSqlKey 1 :: ZcashWalletId + delete recId + get recId + "None" `shouldBe` maybe "None" zcashWalletName s + describe "Account table" $ do + it "insert account" $ do + s <- + runSqlite "test.db" $ do + insert $ + ZcashWallet + "one two three four five six seven eight nine ten eleven twelve" + 2000000 + "Main Wallet" + MainNet + t <- + runSqlite "test.db" $ do + insert $ ZcashAccount s 0 "132465798" "987654321" "739182462" + fromSqlKey t `shouldBe` 1 + it "read accounts for wallet" $ do + wList <- getWallets "test.db" MainNet + acc <- getAccounts "test.db" $ entityKey (head wList) + length acc `shouldBe` 1 diff --git a/zcash-haskell b/zcash-haskell index 419f041..a52d223 160000 --- a/zcash-haskell +++ b/zcash-haskell @@ -1 +1 @@ -Subproject commit 419f041ca9d1dd921673721c56a673fe1dc058e8 +Subproject commit a52d2231f1a4f85a6504bfb9228a1475a0773088 diff --git a/zenith.cabal b/zenith.cabal index d3e5b78..b14f4ea 100644 --- a/zenith.cabal +++ b/zenith.cabal @@ -104,6 +104,7 @@ test-suite zenith-tests , persistent , persistent-sqlite , hspec + , directory , zcash-haskell , zenith pkgconfig-depends: rustzcash_wrapper diff --git a/zenith.cfg b/zenith.cfg index 3c9bd46..efedae5 100644 --- a/zenith.cfg +++ b/zenith.cfg @@ -1,5 +1,5 @@ nodeUser = "user" nodePwd = "superSecret" -dbName = "zenith.db" +dbFilePath = "zenith.db" zebraHost = "127.0.0.1" zebraPort = 18232