diff --git a/app/Main.hs b/app/Main.hs index 03b3089..2547ab8 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -204,12 +204,14 @@ main :: IO () main = do config <- load ["$(HOME)/Zenith/zenith.cfg"] args <- getArgs - dbFilePath <- require config "dbFilePath" + dbFileName <- require config "dbFileName" nodeUser <- require config "nodeUser" nodePwd <- require config "nodePwd" zebraPort <- require config "zebraPort" zebraHost <- require config "zebraHost" nodePort <- require config "nodePort" + dbFP <- getZenithPath + let dbFilePath = T.pack $ dbFP ++ dbFileName let myConfig = Config dbFilePath zebraHost zebraPort nodeUser nodePwd nodePort if not (null args) then do @@ -237,4 +239,5 @@ printUsage = do putStrLn "Available commands:" {-putStrLn "legacy\tLegacy CLI for zcashd"-} putStrLn "tui\tTUI for zebrad" + putStrLn "gui\tGUI for zebrad" putStrLn "rescan\tRescan the existing wallet(s)" diff --git a/src/Zenith/GUI.hs b/src/Zenith/GUI.hs index 0c386e8..12d67c5 100644 --- a/src/Zenith/GUI.hs +++ b/src/Zenith/GUI.hs @@ -1,5 +1,6 @@ {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE BlockArguments #-} module Zenith.GUI where @@ -19,7 +20,7 @@ import Data.Maybe (fromMaybe, isJust, isNothing) import qualified Data.Text as T import qualified Data.Text.Encoding as E import Data.Time.Clock.POSIX (posixSecondsToUTCTime) -import Database.Esqueleto.Experimental (ConnectionPool) +import Database.Esqueleto.Experimental (ConnectionPool, fromSqlKey) import Database.Persist import Lens.Micro ((&), (+~), (.~), (?~), (^.), set) import Lens.Micro.TH @@ -50,11 +51,16 @@ import Zenith.Scanner (processTx, rescanZebra, updateConfs) import Zenith.Types hiding (ZcashAddress(..)) import Zenith.Utils ( displayAmount + , getZenithPath + , isEmpty , isRecipientValid + , isValidString , jsonNumber + , padWithZero , parseAddress , showAddress , validBarValue + , validateAddressBool ) data AppEvent @@ -100,6 +106,25 @@ data AppEvent | CheckRecipient !T.Text | CheckAmount !Float | ShowTxId !T.Text + | LoadAbList ![Entity AddressBook] + | ShowAdrBook + | CloseAdrBook + | NewAdrBkEntry + | CloseNewAdrBook + | NotImplemented + | CloseMsgAB + | CheckValidAddress !T.Text + | CheckValidDescrip !T.Text + | SaveNewABEntry + | SaveABDescription !T.Text + | UpdateABEntry !T.Text !T.Text + | CloseUpdABEntry + | ShowMessage !T.Text + | ShowABAddress !T.Text !T.Text + | CloseShowABAddress + | CopyABAdress !T.Text + | DeleteABEntry !T.Text + | UpdateABDescrip !T.Text !T.Text deriving (Eq, Show) data AppModel = AppModel @@ -142,6 +167,16 @@ data AppModel = AppModel , _amountValid :: !Bool , _showId :: !(Maybe T.Text) , _home :: !FilePath + , _showAdrBook :: !Bool + , _newAdrBkEntry :: !Bool + , _abdescrip :: !T.Text + , _abaddress :: !T.Text + , _abAddressValid :: !Bool + , _abDescripValid :: !Bool + , _abaddressList :: ![Entity AddressBook] + , _msgAB :: !(Maybe T.Text) + , _showABAddress :: !Bool + , _updateABAddress :: !Bool } deriving (Eq, Show) makeLenses ''AppModel @@ -183,6 +218,15 @@ buildUI wenv model = widgetTree , txIdOverlay `nodeVisible` isJust (model ^. showId) , msgOverlay `nodeVisible` isJust (model ^. msg) , modalOverlay `nodeVisible` isJust (model ^. modalMsg) + , adrbookOverlay `nodeVisible` model ^. showAdrBook + , newAdrBkOverlay `nodeVisible` model ^. newAdrBkEntry + , showABAddressOverlay (model ^. abdescrip) (model ^. abaddress) `nodeVisible` + model ^. + showABAddress + , updateABAddressOverlay (model ^. abdescrip) (model ^. abaddress) `nodeVisible` + model ^. + updateABAddress + , msgAdrBookOverlay `nodeVisible` isJust (model ^. msgAB) ] mainWindow = vstack @@ -245,6 +289,8 @@ buildUI wenv model = widgetTree [bgColor white, borderB 1 gray, padding 3] , box_ [alignLeft, onClick ShowSeed] (label "Backup Wallet") `styleBasic` [bgColor white, borderB 1 gray, padding 3] + , box_ [alignLeft, onClick ShowAdrBook] (label "Address Book") `styleBasic` + [bgColor white, borderB 1 gray, padding 3] ]) `styleBasic` [bgColor btnColor, padding 3] newBox = @@ -748,6 +794,146 @@ buildUI wenv model = widgetTree ] ]) `styleBasic` [padding 2, bgColor white, width 280, borderB 1 gray, borderT 1 gray] + -- | + -- | Address Book overlays + -- | + adrbookOverlay = + alert CloseAdrBook $ + vstack + [ box_ + [] + (label "Address Book" `styleBasic` + [textFont "Bold", textSize 12, textColor white]) `styleBasic` + [bgColor btnColor, radius 2, padding 3] + , boxShadow $ + box_ + [alignMiddle] + (vstack + [ vscroll + (vstack (zipWith abookRow [0 ..] (model ^. abaddressList))) `nodeKey` + "txScroll" + ]) `styleBasic` + [radius 2, padding 3, bgColor white] + , spacer + , hstack [button "New" NewAdrBkEntry] + ] + abookRow :: Int -> Entity AddressBook -> WidgetNode AppModel AppEvent + abookRow idx ab = + box_ + [ onClick $ + ShowABAddress + (addressBookAbdescrip $ entityVal ab) + (addressBookAbaddress $ entityVal ab) + , alignLeft + ] + (hstack + [ label (T.pack $ padWithZero 3 $ show (fromSqlKey (entityKey ab))) `styleBasic` + [textFont "Bold"] + , spacer + , label (addressBookAbdescrip $ entityVal ab) + ]) `styleBasic` + [padding 2, borderB 1 gray] + newAdrBkOverlay = + alert CloseNewAdrBook $ + vstack + [ box_ + [] + (label "New Address Book Entry" `styleBasic` + [textFont "Bold", textSize 10, textColor white]) `styleBasic` + [bgColor btnColor, radius 2, padding 3] + , spacer + , hstack + [ label "Description: " `styleBasic` [width 80] + , spacer + , textField_ abdescrip [onChange CheckValidDescrip] `styleBasic` + [ width 320 + , styleIf (not $ model ^. abDescripValid) (textColor red) + ] + ] + , spacer + , hstack + [ label "Address:" `styleBasic` [width 50] + , spacer + , textField_ abaddress [onChange CheckValidAddress] `styleBasic` + [ width 350 + , styleIf (not $ model ^. abAddressValid) (textColor red) + ] + ] + , spacer + , hstack + [ button "Save" SaveNewABEntry `nodeEnabled` + ((model ^. abAddressValid) && (model ^. abDescripValid)) + , spacer + , button "Cancel" CloseNewAdrBook `nodeEnabled` True + ] + ] + updateABAddressOverlay abd aba = + alert CloseUpdABEntry $ + vstack + [ box_ + [] + (label "Edit Address Description" `styleBasic` + [textFont "Bold", textSize 10, textColor white]) `styleBasic` + [bgColor btnColor, radius 2, padding 3] + , spacer + , hstack + [ label "Description:" `styleBasic` [width 80] + , spacer + , textField_ abdescrip [onChange CheckValidDescrip] `styleBasic` + [ width 320 + , styleIf (not $ model ^. abDescripValid) (textColor red) + ] + ] + , spacer + , hstack + [ filler + , button "Save" (UpdateABDescrip abd aba) `nodeEnabled` + (model ^. abDescripValid) + , spacer + , button "Cancel" CloseUpdABEntry `nodeEnabled` True + , filler + ] + ] + showABAddressOverlay abd aba = + alert CloseShowABAddress $ + vstack + [ box_ + [] + (label "Address Book Entry" `styleBasic` + [textFont "Bold", textColor white, textSize 12, padding 3]) `styleBasic` + [bgColor btnColor, radius 2, padding 3] + , spacer + , hstack + [ filler + , label (txtWrapN abd 64) `styleBasic` [textFont "Bold"] + , filler + ] + , spacer + , hstack [filler, label_ (txtWrapN aba 64) [multiline], filler] + , spacer + , hstack + [ filler + , button "Edit Description" $ UpdateABEntry abd aba + , spacer + , button "Copy Address" $ CopyABAdress aba + , spacer + , button "Delete Entry" $ DeleteABEntry aba + , filler + ] + ] + msgAdrBookOverlay = + alert CloseMsgAB $ + hstack + [ filler + , remixIcon remixErrorWarningFill `styleBasic` + [textSize 32, textColor btnColor] `nodeVisible` + (model ^. inError) + , spacer + , label_ (txtWrapN (fromMaybe "" (model ^. msgAB)) 64) [multiline] + , filler + ] + +notImplemented = NotImplemented generateQRCodes :: Config -> IO () generateQRCodes config = do @@ -1058,6 +1244,85 @@ handleEvent wenv node model evt = (i < (fromIntegral (model ^. balance) / 100000000.0)) ] ShowTxId tx -> [Model $ model & showId ?~ tx & modalMsg .~ Nothing] + -- | + -- | Address Book Events + -- | + CheckValidAddress a -> + [Model $ model & abAddressValid .~ isRecipientValid a] + CheckValidDescrip a -> [Model $ model & abDescripValid .~ isValidString a] + ShowAdrBook -> + if null (model ^. abaddressList) + then [Model $ model & newAdrBkEntry .~ True & menuPopup .~ False] + else [Model $ model & showAdrBook .~ True & menuPopup .~ False] + CloseAdrBook -> [Model $ model & showAdrBook .~ False] + NewAdrBkEntry -> + [Model $ model & newAdrBkEntry .~ True & menuPopup .~ False] + CloseNewAdrBook -> do + [Model $ model & newAdrBkEntry .~ False] + UpdateABEntry d a -> + [ Model $ + model & abdescrip .~ d & abaddress .~ a & updateABAddress .~ True & + abDescripValid .~ + True & + menuPopup .~ + False + ] + CloseUpdABEntry -> do + [Model $ model & updateABAddress .~ False] + SaveNewABEntry -> + [ Task $ + saveAddrBook + (model ^. configuration) + (ZcashNetDB (model ^. network)) + (model ^. abdescrip) + (model ^. abaddress) + , Model $ + model & abdescrip .~ "" & abaddress .~ "" & newAdrBkEntry .~ False + , Task $ do + dbPool <- runNoLoggingT $ initPool $ c_dbPath $ model ^. configuration + abList <- getAdrBook dbPool $ model ^. network + return $ LoadAbList abList + ] + ShowABAddress d a -> + [ Model $ + model & abdescrip .~ d & abaddress .~ a & showABAddress .~ True & + menuPopup .~ + False + ] + CloseShowABAddress -> + [Model $ model & showABAddress .~ False & inError .~ False] + CopyABAdress a -> + [ setClipboardData ClipboardEmpty + , setClipboardData $ ClipboardText a + , Event $ ShowMessage "Address copied!!" + ] + DeleteABEntry a -> + [ Task $ deleteAdrBook (model ^. configuration) a + , Model $ + model & abdescrip .~ "" & abaddress .~ "" & showABAddress .~ False + , Task $ do + dbPool <- runNoLoggingT $ initPool $ c_dbPath $ model ^. configuration + abList <- getAdrBook dbPool $ model ^. network + return $ LoadAbList abList + ] + ShowMessage a -> [Model $ model & msgAB ?~ a & menuPopup .~ False] + NotImplemented -> + [ Model $ + model & msgAB ?~ "Function not implemented..." & menuPopup .~ False + ] + CloseMsgAB -> [Model $ model & msgAB .~ Nothing & inError .~ False] + LoadAbList a -> [Model $ model & abaddressList .~ a] + UpdateABDescrip d a -> + [ Task $ updAddrBookDescrip (model ^. configuration) d a + , Model $ + model & abdescrip .~ "" & abaddress .~ "" & updateABAddress .~ False & + showABAddress .~ + False + , Task $ do + dbPool <- runNoLoggingT $ initPool $ c_dbPath $ model ^. configuration + abList <- getAdrBook dbPool $ model ^. network + return $ LoadAbList abList + ] where currentWallet = if null (model ^. wallets) @@ -1145,6 +1410,32 @@ handleEvent wenv node model evt = Just _ -> do wL <- getWallets pool (model ^. network) return $ LoadWallets wL + -- | + -- | Address Book -> save new entry into database + -- | + saveAddrBook :: Config -> ZcashNetDB -> T.Text -> T.Text -> IO AppEvent + saveAddrBook config n d a = do + pool <- runNoLoggingT $ initPool $ c_dbPath config + res <- liftIO $ saveAdrsInAdrBook pool $ AddressBook n d a + case res of + Nothing -> return $ ShowMessage "Error saving AddressBook entry..." + Just _ -> return $ ShowMessage "New Address Book entry added!!" + -- | + -- | Address Book -> save new entry into database + -- | + deleteAdrBook :: Config -> T.Text -> IO AppEvent + deleteAdrBook config a = do + pool <- runNoLoggingT $ initPool $ c_dbPath config + res <- liftIO $ deleteAdrsFromAB pool a + return $ ShowMessage "Address Book entry deleted!!" + -- | + -- | Address Book -> save new entry into database + -- | + updAddrBookDescrip :: Config -> T.Text -> T.Text -> IO AppEvent + updAddrBookDescrip config d a = do + pool <- runNoLoggingT $ initPool $ c_dbPath config + res <- liftIO $ updateAdrsInAdrBook pool d a a + return $ ShowMessage "Address Book entry updated!!" scanZebra :: T.Text -> T.Text -> Int -> ZcashNet -> (AppEvent -> IO ()) -> IO () scanZebra dbPath zHost zPort net sendMsg = do @@ -1243,6 +1534,9 @@ timeTicker sendMsg = do threadDelay $ 1000 * 1000 timeTicker sendMsg +txtWrapN :: T.Text -> Int -> T.Text +txtWrapN t n = wrapText (WrapSettings False True NoFill FillAfterFirst) n t + txtWrap :: T.Text -> T.Text txtWrap = wrapText (WrapSettings False True NoFill FillAfterFirst) 32 @@ -1298,6 +1592,7 @@ runZenithGUI config = do if not (null accList) then getUnconfirmedBalance pool $ entityKey $ head accList else return 0 + abList <- getAdrBook pool (zgb_net chainInfo) let model = AppModel config @@ -1344,6 +1639,16 @@ runZenithGUI config = do False Nothing hD + False + False + "" + "" + False + False + abList + Nothing + False + False startApp model handleEvent buildUI (params hD) Left _e -> print "Zebra not available" where diff --git a/src/Zenith/GUI/Theme.hs b/src/Zenith/GUI/Theme.hs index 6b59ef3..2e2cd4b 100644 --- a/src/Zenith/GUI/Theme.hs +++ b/src/Zenith/GUI/Theme.hs @@ -49,6 +49,9 @@ zenithTheme = L.active . L.btnStyle . L.text ?~ baseTextStyle & + L.disabled . + L.btnStyle . L.text ?~ + baseTextStyle & L.basic . L.btnMainStyle . L.text ?~ hiliteTextStyle & diff --git a/src/Zenith/Utils.hs b/src/Zenith/Utils.hs index 335ed9b..ff06973 100644 --- a/src/Zenith/Utils.hs +++ b/src/Zenith/Utils.hs @@ -9,6 +9,8 @@ import Data.Ord (clamp) import Data.Scientific (Scientific(..), scientific) import qualified Data.Text as T import qualified Data.Text.Encoding as E +import Data.Char (isAlphaNum, isSpace) +import System.Directory import System.Process (createProcess_, shell) import Text.Regex.Posix import ZcashHaskell.Orchard (encodeUnifiedAddress, isValidUnifiedAddress) @@ -83,6 +85,13 @@ validateAddress txt --(tReg || sReg && isJust chk) || (uReg && isJust chk) chk = isJust $ isValidUnifiedAddress $ E.encodeUtf8 txt chkS = isValidShieldedAddress $ E.encodeUtf8 txt +-- | Return True if Address is valid +validateAddressBool :: T.Text -> Bool +validateAddressBool a = do + case (validateAddress a) of + Nothing -> False + _ -> True + -- | Copy an address to the clipboard copyAddress :: ZcashAddress -> IO () copyAddress a = @@ -90,6 +99,12 @@ copyAddress a = createProcess_ "toClipboard" $ shell $ "echo " ++ T.unpack (addy a) ++ " | xclip -r -selection clipboard" +-- | Get current user and build zenith path +getZenithPath :: IO String +getZenithPath = do + homeDirectory <- getHomeDirectory + return (homeDirectory ++ "/Zenith/") + -- | Bound a value to the 0..1 range, used for progress reporting on UIs validBarValue :: Float -> Float validBarValue = clamp (0, 1) @@ -120,3 +135,30 @@ parseAddress a znet = Just a3 -> Just $ UnifiedAddress znet Nothing Nothing (Just $ ta_receiver a3) Nothing -> Nothing + +isValidContent :: String -> Bool +isValidContent [] = False -- an empty string is invalid +isValidContent (x:xs) + | not (isAlphaNum x ) = False -- string must start with an alphanumeric character + | otherwise = allValidChars xs -- process the rest of the string + where + allValidChars :: String -> Bool + allValidChars [] = True -- if we got here, string is valid + allValidChars (y:ys) + | isAlphaNum y || isSpace y = allValidChars ys -- char is valid, continue + | otherwise = False -- found an invalid character, return false + +isValidString :: T.Text -> Bool +isValidString c = do + let a = T.unpack c + isValidContent a + +padWithZero :: Int -> String -> String +padWithZero n s + | (length s) >= n = s + | otherwise = padWithZero n ("0" ++ s) + +isEmpty :: [a] -> Bool +isEmpty [] = True +isEmpty _ = False +