Add base addressbook to GUI #102

Merged
pitmutt merged 21 commits from rvv041 into milestone3 2024-09-13 11:39:59 +00:00
6 changed files with 379 additions and 12 deletions

View file

@ -204,12 +204,14 @@ main :: IO ()
main = do main = do
config <- load ["$(HOME)/Zenith/zenith.cfg"] config <- load ["$(HOME)/Zenith/zenith.cfg"]
args <- getArgs args <- getArgs
dbFilePath <- require config "dbFilePath" dbFileName <- require config "dbFileName"
{-nodeUser <- require config "nodeUser"-} {-nodeUser <- require config "nodeUser"-}
{-nodePwd <- require config "nodePwd"-} {-nodePwd <- require config "nodePwd"-}
zebraPort <- require config "zebraPort" zebraPort <- require config "zebraPort"
zebraHost <- require config "zebraHost" zebraHost <- require config "zebraHost"
let myConfig = Config dbFilePath zebraHost zebraPort dbFP <- getZenithPath
let dbFilePath = dbFP ++ dbFileName
let myConfig = Config (T.pack dbFilePath) zebraHost zebraPort
if not (null args) if not (null args)
then do then do
case head args case head args
@ -236,4 +238,5 @@ printUsage = do
putStrLn "Available commands:" putStrLn "Available commands:"
{-putStrLn "legacy\tLegacy CLI for zcashd"-} {-putStrLn "legacy\tLegacy CLI for zcashd"-}
putStrLn "tui\tTUI for zebrad" putStrLn "tui\tTUI for zebrad"
putStrLn "gui\tGUI for zebrad"
putStrLn "rescan\tRescan the existing wallet(s)" putStrLn "rescan\tRescan the existing wallet(s)"

Binary file not shown.

View file

@ -1,5 +1,6 @@
{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE BlockArguments #-}
module Zenith.GUI where module Zenith.GUI where
@ -19,7 +20,7 @@ import Data.Maybe (fromJust, fromMaybe, isJust, isNothing)
import qualified Data.Text as T import qualified Data.Text as T
import qualified Data.Text.Encoding as E import qualified Data.Text.Encoding as E
import Data.Time.Clock.POSIX (posixSecondsToUTCTime) import Data.Time.Clock.POSIX (posixSecondsToUTCTime)
import Database.Esqueleto.Experimental (ConnectionPool) import Database.Esqueleto.Experimental (ConnectionPool, fromSqlKey)
import Database.Persist import Database.Persist
import Lens.Micro ((&), (+~), (.~), (?~), (^.), set) import Lens.Micro ((&), (+~), (.~), (?~), (^.), set)
import Lens.Micro.TH import Lens.Micro.TH
@ -52,11 +53,16 @@ import Zenith.Scanner (processTx, updateConfs)
import Zenith.Types hiding (ZcashAddress(..)) import Zenith.Types hiding (ZcashAddress(..))
import Zenith.Utils import Zenith.Utils
( displayAmount ( displayAmount
, getZenithPath
, isEmpty
, isRecipientValid , isRecipientValid
, isValidString
, jsonNumber , jsonNumber
, padWithZero
, parseAddress , parseAddress
, showAddress , showAddress
, validBarValue , validBarValue
, validateAddressBool
) )
data AppEvent data AppEvent
@ -102,6 +108,25 @@ data AppEvent
| CheckRecipient !T.Text | CheckRecipient !T.Text
| CheckAmount !Float | CheckAmount !Float
| ShowTxId !T.Text | 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) deriving (Eq, Show)
data AppModel = AppModel data AppModel = AppModel
@ -144,6 +169,16 @@ data AppModel = AppModel
, _amountValid :: !Bool , _amountValid :: !Bool
, _showId :: !(Maybe T.Text) , _showId :: !(Maybe T.Text)
, _home :: !FilePath , _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) } deriving (Eq, Show)
makeLenses ''AppModel makeLenses ''AppModel
@ -185,6 +220,15 @@ buildUI wenv model = widgetTree
, txIdOverlay `nodeVisible` isJust (model ^. showId) , txIdOverlay `nodeVisible` isJust (model ^. showId)
, msgOverlay `nodeVisible` isJust (model ^. msg) , msgOverlay `nodeVisible` isJust (model ^. msg)
, modalOverlay `nodeVisible` isJust (model ^. modalMsg) , 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 = mainWindow =
vstack vstack
@ -247,6 +291,8 @@ buildUI wenv model = widgetTree
[bgColor white, borderB 1 gray, padding 3] [bgColor white, borderB 1 gray, padding 3]
, box_ [alignLeft, onClick ShowSeed] (label "Backup Wallet") `styleBasic` , box_ [alignLeft, onClick ShowSeed] (label "Backup Wallet") `styleBasic`
[bgColor white, borderB 1 gray, padding 3] [bgColor white, borderB 1 gray, padding 3]
, box_ [alignLeft, onClick ShowAdrBook] (label "Address Book") `styleBasic`
[bgColor white, borderB 1 gray, padding 3]
]) `styleBasic` ]) `styleBasic`
[bgColor btnColor, padding 3] [bgColor btnColor, padding 3]
newBox = newBox =
@ -750,6 +796,150 @@ buildUI wenv model = widgetTree
] ]
]) `styleBasic` ]) `styleBasic`
[padding 2, bgColor white, width 280, borderB 1 gray, borderT 1 gray] [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 -> IO ()
generateQRCodes config = do generateQRCodes config = do
@ -1060,6 +1250,85 @@ handleEvent wenv node model evt =
(i < (fromIntegral (model ^. balance) / 100000000.0)) (i < (fromIntegral (model ^. balance) / 100000000.0))
] ]
ShowTxId tx -> [Model $ model & showId ?~ tx & modalMsg .~ Nothing] 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 where
currentWallet = currentWallet =
if null (model ^. wallets) if null (model ^. wallets)
@ -1147,6 +1416,32 @@ handleEvent wenv node model evt =
Just _ -> do Just _ -> do
wL <- getWallets pool (model ^. network) wL <- getWallets pool (model ^. network)
return $ LoadWallets wL 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
pitmutt marked this conversation as resolved Outdated

@reneve Your new fields in the state should be after the hD variable, not before

@reneve Your new fields in the state should be after the `hD` variable, not before
-- |
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 -> (AppEvent -> IO ()) -> IO () scanZebra :: T.Text -> T.Text -> Int -> (AppEvent -> IO ()) -> IO ()
scanZebra dbPath zHost zPort sendMsg = do scanZebra dbPath zHost zPort sendMsg = do
@ -1246,6 +1541,9 @@ timeTicker sendMsg = do
threadDelay $ 1000 * 1000 threadDelay $ 1000 * 1000
timeTicker sendMsg 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 :: T.Text -> T.Text
txtWrap = wrapText (WrapSettings False True NoFill FillAfterFirst) 32 txtWrap = wrapText (WrapSettings False True NoFill FillAfterFirst) 32
@ -1297,6 +1595,7 @@ runZenithGUI config = do
if not (null accList) if not (null accList)
then getUnconfirmedBalance pool $ entityKey $ head accList then getUnconfirmedBalance pool $ entityKey $ head accList
else return 0 else return 0
abList <- getAdrBook pool (zgb_net chainInfo)
let model = let model =
AppModel AppModel
config config
@ -1325,10 +1624,10 @@ runZenithGUI config = do
Nothing Nothing
"" ""
"" ""
(SaveAddress $ (SaveAddress
if not (null accList) (if not (null accList)
then Just (head accList) then Just (head accList)
else Nothing) else Nothing))
False False
False False
Nothing Nothing
@ -1343,6 +1642,16 @@ runZenithGUI config = do
False False
Nothing Nothing
hD hD
False
False
""
""
False
False
abList
Nothing
False
False
startApp model handleEvent buildUI (params hD) startApp model handleEvent buildUI (params hD)
Left e -> do Left e -> do
initDb dbFilePath initDb dbFilePath
@ -1358,9 +1667,9 @@ runZenithGUI config = do
0 0
[] []
0 0
(Just $ (Just
"Couldn't connect to Zebra on " <> ("Couldn't connect to Zebra on " <>
host <> ":" <> showt port <> ". Check your configuration.") host <> ":" <> showt port <> ". Check your configuration."))
False False
314259000 314259000
(Just 30000) (Just 30000)
@ -1389,6 +1698,16 @@ runZenithGUI config = do
False False
Nothing Nothing
hD hD
False
False
""
""
False
False
[]
Nothing
False
False
startApp model handleEvent buildUI (params hD) startApp model handleEvent buildUI (params hD)
where where
params hd = params hd =

View file

@ -49,6 +49,9 @@ zenithTheme =
L.active . L.active .
L.btnStyle . L.text ?~ L.btnStyle . L.text ?~
baseTextStyle & baseTextStyle &
L.disabled .
L.btnStyle . L.text ?~
baseTextStyle &
L.basic . L.basic .
L.btnMainStyle . L.text ?~ L.btnMainStyle . L.text ?~
hiliteTextStyle & hiliteTextStyle &

View file

@ -9,6 +9,8 @@ import Data.Ord (clamp)
import Data.Scientific (Scientific(..), scientific) import Data.Scientific (Scientific(..), scientific)
import qualified Data.Text as T import qualified Data.Text as T
import qualified Data.Text.Encoding as E import qualified Data.Text.Encoding as E
import Data.Char (isAlphaNum, isSpace)
import System.Directory
import System.Process (createProcess_, shell) import System.Process (createProcess_, shell)
import Text.Regex.Posix import Text.Regex.Posix
import ZcashHaskell.Orchard (encodeUnifiedAddress, isValidUnifiedAddress) import ZcashHaskell.Orchard (encodeUnifiedAddress, isValidUnifiedAddress)
@ -83,6 +85,13 @@ validateAddress txt --(tReg || sReg && isJust chk) || (uReg && isJust chk)
chk = isJust $ isValidUnifiedAddress $ E.encodeUtf8 txt chk = isJust $ isValidUnifiedAddress $ E.encodeUtf8 txt
chkS = isValidShieldedAddress $ 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 -- | Copy an address to the clipboard
copyAddress :: ZcashAddress -> IO () copyAddress :: ZcashAddress -> IO ()
copyAddress a = copyAddress a =
@ -90,6 +99,12 @@ copyAddress a =
createProcess_ "toClipboard" $ createProcess_ "toClipboard" $
shell $ "echo " ++ T.unpack (addy a) ++ " | xclip -r -selection clipboard" 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 -- | Bound a value to the 0..1 range, used for progress reporting on UIs
validBarValue :: Float -> Float validBarValue :: Float -> Float
validBarValue = clamp (0, 1) validBarValue = clamp (0, 1)
@ -103,7 +118,7 @@ isRecipientValid a =
(case decodeTransparentAddress (E.encodeUtf8 a) of (case decodeTransparentAddress (E.encodeUtf8 a) of
Just _a3 -> True Just _a3 -> True
Nothing -> Nothing ->
case decodeExchangeAddress a of case decodeExchangeAddress (E.encodeUtf8 a) of
Just _a4 -> True Just _a4 -> True
Nothing -> False) Nothing -> False)
@ -120,3 +135,30 @@ parseAddress a znet =
Just a3 -> Just a3 ->
Just $ UnifiedAddress znet Nothing Nothing (Just $ ta_receiver a3) Just $ UnifiedAddress znet Nothing Nothing (Just $ ta_receiver a3)
Nothing -> Nothing 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

@ -1 +1 @@
Subproject commit e8074419cfb54559a4c09731ad2448d5930869a2 Subproject commit ce19e174cc636f1e9fce9114875ab0cb1df10213