Add address book
This commit is contained in:
parent
322f2b8959
commit
e46cd01f41
GPG key ID:
65122AD495A7F5B2
4 changed files with 355 additions and 2 deletions
|
|
@ -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)"
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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 &
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
||||
|
|
|
|||
Loading…
Reference in a new issue