Add base addressbook to GUI #102

Merged
pitmutt merged 21 commits from rvv041 into milestone3 2024-09-13 11:39:59 +00:00
Showing only changes of commit 538216944d - Show all commits

View file

@ -50,25 +50,19 @@ import Zenith.Core
import Zenith.DB import Zenith.DB
import Zenith.GUI.Theme import Zenith.GUI.Theme
import Zenith.Scanner (processTx, updateConfs) import Zenith.Scanner (processTx, updateConfs)
import Zenith.Types import Zenith.Types hiding (ZcashAddress(..))
( ZcashNetDB
)
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 , validateAddressBool
, isValidString
, padWithZero
, getZenithPath
, isEmpty
) )
data AppEvent data AppEvent
@ -125,7 +119,6 @@ data AppEvent
| CheckValidDescrip !T.Text | CheckValidDescrip !T.Text
| SaveNewABEntry | SaveNewABEntry
| ShowMessage !T.Text | ShowMessage !T.Text
deriving (Eq, Show) deriving (Eq, Show)
data AppModel = AppModel data AppModel = AppModel
@ -795,37 +788,34 @@ buildUI wenv model = widgetTree
(label "Address Book" `styleBasic` (label "Address Book" `styleBasic`
[textFont "Bold", textSize 12, textColor white]) `styleBasic` [textFont "Bold", textSize 12, textColor white]) `styleBasic`
[bgColor btnColor, radius 2, padding 3] [bgColor btnColor, radius 2, padding 3]
, boxShadow $ , boxShadow $
box_ box_
[alignMiddle] [alignMiddle]
(vstack (vstack
[ vscroll (vstack (zipWith abookRow [0 ..] (model ^. abaddressList))) `nodeKey` "txScroll" [ vscroll
]) `styleBasic` (vstack (zipWith abookRow [0 ..] (model ^. abaddressList))) `nodeKey`
"txScroll"
]) `styleBasic`
[radius 2, padding 3, bgColor white] [radius 2, padding 3, bgColor white]
, spacer , spacer
, hstack [ , hstack
button "New" NewAdrBkEntry [ button "New" NewAdrBkEntry
, spacer , spacer
, button "Edit" notImplemented , button "Edit" notImplemented
, spacer , spacer
, button "Copy" notImplemented , button "Copy" notImplemented
] ]
] ]
abookRow :: Int -> Entity AddressBook -> WidgetNode AppModel AppEvent abookRow :: Int -> Entity AddressBook -> WidgetNode AppModel AppEvent
abookRow idx ab = abookRow idx ab =
box_ box_
[onClick $ ShowMessage (addressBookAbaddress $ entityVal ab), alignLeft] [onClick $ ShowMessage (addressBookAbaddress $ entityVal ab), alignLeft]
(hstack (hstack
[ [ label (T.pack $ padWithZero 3 $ show (fromSqlKey (entityKey ab))) `styleBasic`
label [textFont "Bold"]
(T.pack $ , spacer
padWithZero 3 $ , label (T.pack $ show (addressBookAbdescrip $ entityVal ab))
show (fromSqlKey (entityKey ab))) `styleBasic` [textFont "Bold"] ]) `styleBasic`
, spacer
, label
(T.pack $
show (addressBookAbdescrip $ entityVal ab))
]) `styleBasic`
[padding 2, borderB 1 gray] [padding 2, borderB 1 gray]
newAdrBkOverlay = newAdrBkOverlay =
alert CloseNewAdrBook $ alert CloseNewAdrBook $
@ -834,16 +824,14 @@ buildUI wenv model = widgetTree
[] []
(label "New Address Book Entry" `styleBasic` (label "New Address Book Entry" `styleBasic`
[textFont "Bold", textSize 10, textColor white]) `styleBasic` [textFont "Bold", textSize 10, textColor white]) `styleBasic`
[bgColor btnColor, radius 2, padding 3] [bgColor btnColor, radius 2, padding 3]
, spacer , spacer
, hstack , hstack
[ label "Description: " `styleBasic` [width 80] [ label "Description: " `styleBasic` [width 80]
, spacer , spacer
, textField_ abdescrip [onChange CheckValidDescrip] `styleBasic` , textField_ abdescrip [onChange CheckValidDescrip] `styleBasic`
[ width 320 [ width 320
, styleIf , styleIf (not $ model ^. abDescripValid) (textColor red)
(not $ model ^. abDescripValid)
(textColor red)
] ]
] ]
, spacer , spacer
@ -852,19 +840,17 @@ buildUI wenv model = widgetTree
, spacer , spacer
, textField_ abaddress [onChange CheckValidAddress] `styleBasic` , textField_ abaddress [onChange CheckValidAddress] `styleBasic`
[ width 350 [ width 350
, styleIf , styleIf (not $ model ^. abAddressValid) (textColor red)
(not $ model ^. abAddressValid)
(textColor red)
] ]
] ]
, spacer , spacer
, hstack , hstack
[ button "Save" SaveNewABEntry `nodeEnabled` [ button "Save" SaveNewABEntry `nodeEnabled`
((model ^. abAddressValid) && (model ^. abDescripValid)) ((model ^. abAddressValid) && (model ^. abDescripValid))
, spacer , spacer
, button "Cancel" CloseNewAdrBook `nodeEnabled` True , button "Cancel" CloseNewAdrBook `nodeEnabled` True
] ]
] ]
msgAdrBookOverlay = msgAdrBookOverlay =
alert CloseMsgAB $ alert CloseMsgAB $
hstack hstack
@ -873,7 +859,7 @@ buildUI wenv model = widgetTree
[textSize 32, textColor btnColor] `nodeVisible` [textSize 32, textColor btnColor] `nodeVisible`
(model ^. inError) (model ^. inError)
, spacer , spacer
, label_ (txtWrapN (fromMaybe "" (model ^. msgAB)) 64) [multiline] , label_ (txtWrapN (fromMaybe "" (model ^. msgAB)) 64) [multiline]
, filler , filler
] ]
@ -1191,20 +1177,36 @@ handleEvent wenv node model evt =
-- | -- |
-- | Address Book Events -- | Address Book Events
-- | -- |
CheckValidAddress a -> [Model $ model & abAddressValid .~ isRecipientValid a] CheckValidAddress a ->
CheckValidDescrip a -> [Model $ model & abDescripValid .~ isValidString a] [Model $ model & abAddressValid .~ isRecipientValid a]
CheckValidDescrip a -> [Model $ model & abDescripValid .~ isValidString a]
ShowAdrBook -> [Model $ model & showAdrBook .~ True & menuPopup .~ False] ShowAdrBook -> [Model $ model & showAdrBook .~ True & menuPopup .~ False]
CloseAdrBook -> [Model $ model & showAdrBook .~ False] CloseAdrBook -> [Model $ model & showAdrBook .~ False]
NewAdrBkEntry -> [Model $ model & newAdrBkEntry .~ True & menuPopup .~ False] NewAdrBkEntry ->
[Model $ model & newAdrBkEntry .~ True & menuPopup .~ False]
CloseNewAdrBook -> do CloseNewAdrBook -> do
[Model $ model & newAdrBkEntry .~ False] [Model $ model & newAdrBkEntry .~ False]
SaveNewABEntry -> SaveNewABEntry ->
[ Task $ saveAddrBook (model ^. configuration) (ZcashNetDB (model ^. network)) (model ^. abdescrip) (model ^. abaddress) [ Task $
, Model $ model & abdescrip .~ "" & abaddress .~ "" & newAdrBkEntry .~ False 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
]
NotImplemented ->
[ Model $
model & msgAB ?~ "Function not implemented..." & menuPopup .~ False
] ]
NotImplemented -> [Model $ model & msgAB ?~ "Function not implemented..." & menuPopup .~ False]
CloseMsgAB -> [Model $ model & msgAB .~ Nothing & inError .~ False] CloseMsgAB -> [Model $ model & msgAB .~ Nothing & inError .~ False]
ShowMessage a -> [Model $ model & msgAB ?~ a & menuPopup .~ False] ShowMessage a -> [Model $ model & msgAB ?~ a & menuPopup .~ False]
LoadAbList a -> [Model $ model & abaddressList .~ a]
where where
currentWallet = currentWallet =
if null (model ^. wallets) if null (model ^. wallets)
@ -1297,25 +1299,19 @@ handleEvent wenv node model evt =
-- | -- |
saveAddrBook :: Config -> ZcashNetDB -> T.Text -> T.Text -> IO AppEvent saveAddrBook :: Config -> ZcashNetDB -> T.Text -> T.Text -> IO AppEvent
saveAddrBook config n d a = do saveAddrBook config n d a = do
let dbPath = c_dbPath config let dbPath = c_dbPath config
pool <- runNoLoggingT $ initPool dbPath pool <- runNoLoggingT $ initPool dbPath
res <- res <- liftIO $ saveAdrsInAdrBook pool $ AddressBook n d a
liftIO $
saveAdrsInAdrBook pool $
AddressBook
n
d
a
case res of case res of
Nothing -> return $ ShowMessage "Error saving the AddressBook entry..." Nothing -> return $ ShowMessage "Error saving the AddressBook entry..."
Just _ -> return $ ShowMessage "New Address Book entry added!!" Just _ -> return $ ShowMessage "New Address Book entry added!!"
-- | -- |
-- | -- |
-- | -- |
-- loadABList :: Config -> ZcashNet -> IO AppEvent -- loadABList :: Config -> ZcashNet -> IO AppEvent
-- loadABList config n = do -- loadABList config n = do
-- pool <- runNoLoggingT $ initPool $ c_dbPath config -- pool <- runNoLoggingT $ initPool $ c_dbPath config
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
_ <- liftIO $ initDb dbPath _ <- liftIO $ initDb dbPath
@ -1414,8 +1410,8 @@ timeTicker sendMsg = do
threadDelay $ 1000 * 1000 threadDelay $ 1000 * 1000
timeTicker sendMsg timeTicker sendMsg
txtWrapN :: T.Text -> Int -> T.Text txtWrapN :: T.Text -> Int -> T.Text
txtWrapN t n = wrapText (WrapSettings False True NoFill FillAfterFirst) n t 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
@ -1484,7 +1480,9 @@ runZenithGUI config = do
Nothing Nothing
True True
bal bal
(if unconfBal == 0 then Nothing else Just unconfBal) (if unconfBal == 0
then Nothing
else Just unconfBal)
Orchard Orchard
qr qr
False False
@ -1495,7 +1493,10 @@ runZenithGUI config = do
Nothing Nothing
"" ""
"" ""
(SaveAddress (if not (null accList) then Just (head accList) else Nothing ) ) (SaveAddress
(if not (null accList)
then Just (head accList)
else Nothing))
False False
False False
Nothing Nothing
@ -1533,9 +1534,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)