From 28bbcb48f01837d220c68979c8a8af17fdcc7783 Mon Sep 17 00:00:00 2001 From: "Rene Vergara A." Date: Thu, 30 May 2024 17:27:59 -0400 Subject: [PATCH] rvv041 - Address Book Form to create a new Address Book entry Error control added to the form. --- src/Zenith/CLI.hs | 177 ++++++++++++++++++++++++++++++++-------------- 1 file changed, 123 insertions(+), 54 deletions(-) diff --git a/src/Zenith/CLI.hs b/src/Zenith/CLI.hs index b750780..0615372 100644 --- a/src/Zenith/CLI.hs +++ b/src/Zenith/CLI.hs @@ -21,6 +21,8 @@ import Brick.Forms , renderForm , setFieldValid , updateFormState + , FormFieldState + , editShowableField ) import qualified Brick.Main as M import qualified Brick.Types as BT @@ -41,6 +43,7 @@ import Brick.Widgets.Core , padAll , padBottom , padTop + , padLeft , setAvailableSize , str , strWrap @@ -113,6 +116,8 @@ data Name | MemoField | ABViewport | ABList + | DescripField + | AddressField deriving (Eq, Show, Ord) data DialogInput = DialogInput @@ -129,6 +134,13 @@ data SendInput = SendInput makeLenses ''SendInput +data AdrBookEntry = AdrBookEntry + { _descrip :: !T.Text + , _address :: !T.Text + } deriving (Show) + +makeLenses ''AdrBookEntry + data DialogType = WName | AName @@ -138,6 +150,7 @@ data DialogType | SendTx | Blank | AdrBook + | AdrBookForm data DisplayType = AddrDisplay @@ -176,6 +189,7 @@ data State = State , _timer :: !Int , _txForm :: !(Form SendInput () Name) , _abaddresses :: !(L.List Name (Entity AddressBook)) + , _abForm :: !(Form AdrBookEntry () Name) } makeLenses ''State @@ -348,7 +362,7 @@ drawUI s = [splashDialog s, helpDialog s, displayDialog s, inputDialog s, ui s] C.hCenter (hBox [capCommand "↲ " "Send", capCommand " " "Cancel"])) Blank -> emptyWidget - AdrBook -> + AdrBook -> D.renderDialog (D.dialog (Just $ str " Address Book ") Nothing 60) (withAttr abDefAttr $ @@ -356,13 +370,9 @@ drawUI s = [splashDialog s, helpDialog s, displayDialog s, inputDialog s, ui s] viewport ABViewport BT.Vertical $ vLimit 20 $ hLimit 50 $ - vBox $ [vLimit 16 $ + vBox [vLimit 16 $ hLimit 50 $ vBox $ [ L.renderList listDrawAB True (s ^. abaddresses) ], --- [str "Addresses 1.................", --- str "Addresses 2.....", --- str "Addresses 3", --- str "Addresses 4"], padTop Max $ vLimit 4 $ hLimit 50 $ @@ -376,6 +386,14 @@ drawUI s = [splashDialog s, helpDialog s, displayDialog s, inputDialog s, ui s] capCommand "S" "end Zcash" <+> capCommand3 "E" "x" "it")]]) + AdrBookForm -> + D.renderDialog + (D.dialog (Just (str " Address Book Entry ")) Nothing 50) + (renderForm (st ^. abForm) <=> + C.hCenter + (hBox [capCommand "↲" " Save", capCommand3 "" "" " Cancel"])) + + splashDialog :: State -> Widget Name splashDialog st = if st ^. splashBox @@ -530,10 +548,20 @@ mkSendForm bal = ] where isAmountValid :: Integer -> Float -> Bool - isAmountValid b i = ((fromIntegral b * 100000000.0) >= i) && (i > 0) + isAmountValid b i = (fromIntegral b * 100000000.0) >= i && i > 0 label s w = padBottom (Pad 1) $ vLimit 1 (hLimit 15 $ str s <+> fill ' ') <+> w +mkNewABForm :: AdrBookEntry -> Form AdrBookEntry e Name +mkNewABForm = + newForm + [ label "Descrip: " @@= editTextField descrip DescripField (Just 1) + , label "Address: " @@= editTextField address AddressField (Just 1) + ] + where + label s w = + padBottom (Pad 1) $ vLimit 1 (hLimit 10 $ str s <+> fill ' ') <+> w + isRecipientValid :: T.Text -> Bool isRecipientValid a = case isValidUnifiedAddress (E.encodeUtf8 a) of @@ -607,9 +635,9 @@ listDrawAB :: Bool -> Entity AddressBook -> Widget Name listDrawAB sel ab = let selStr s = if sel - then withAttr abSelAttr (txt $ "" <> s <> ">") - else txt s - in selStr $ addressBookDescrip (entityVal ab) + then withAttr abSelAttr (txt $ " " <> s ) + else txt $ " " <> s + in selStr $ addressBookDescrip (entityVal ab) customAttr :: A.AttrName customAttr = L.listSelectedAttr <> A.attrName "custom" @@ -632,10 +660,10 @@ barToDoAttr = A.attrName "remaining" abDefAttr :: A.AttrName abDefAttr = A.attrName "abdefault" -abSelAttr :: A.AttrName +abSelAttr :: A.AttrName abSelAttr = A.attrName "abselected" -abMBarAttr :: A.AttrName +abMBarAttr :: A.AttrName abMBarAttr = A.attrName "menubar" validBarValue :: Float -> Float @@ -649,8 +677,7 @@ scanZebra dbP zHost zPort b eChan = do dbBlock <- runNoLoggingT $ getMaxBlock pool let sb = max dbBlock b if sb > zgb_blocks bStatus || sb < 1 - then do - liftIO $ BC.writeBChan eChan $ TickMsg "Invalid starting block for scan" + then liftIO $ BC.writeBChan eChan $ TickMsg "Invalid starting block for scan" else do let bList = [(sb + 1) .. (zgb_blocks bStatus)] let step = (1.0 :: Float) / fromIntegral (zgb_blocks bStatus - (sb + 1)) @@ -666,8 +693,7 @@ scanZebra dbP zHost zPort b eChan = do "getblock" [Data.Aeson.String $ T.pack $ show bl, jsonNumber 1] case r of - Left e1 -> do - liftIO $ BC.writeBChan eChan $ TickMsg e1 + Left e1 -> liftIO $ BC.writeBChan eChan $ TickMsg e1 Right blk -> do r2 <- liftIO $ @@ -677,8 +703,7 @@ scanZebra dbP zHost zPort b eChan = do "getblock" [Data.Aeson.String $ T.pack $ show bl, jsonNumber 0] case r2 of - Left e2 -> do - liftIO $ BC.writeBChan eChan $ TickMsg e2 + Left e2 -> liftIO $ BC.writeBChan eChan $ TickMsg e2 Right hb -> do let blockTime = getBlockTime hb mapM_ (runNoLoggingT . processTx zHost zPort blockTime pool) $ @@ -704,8 +729,7 @@ appEvent (BT.AppEvent t) = do PhraseDisplay -> return () TxDisplay -> return () SyncDisplay -> return () - SendDisplay -> do - BT.modify $ set msg m + SendDisplay -> BT.modify $ set msg m BlankDisplay -> return () TickVal v -> do case s ^. displayBox of @@ -747,6 +771,7 @@ appEvent (BT.AppEvent t) = do ASelect -> return () SendTx -> return () AdrBook -> return () + AdrBookForm -> return () Blank -> do if s ^. timer == 90 then do @@ -764,8 +789,7 @@ appEvent (BT.AppEvent t) = do (s ^. eventDispatch) BT.modify $ set timer 0 return () - else do - BT.modify $ set timer $ 1 + s ^. timer + else BT.modify $ set timer $ 1 + s ^. timer appEvent (BT.VtyEvent e) = do r <- F.focusGetCurrent <$> use focusRing s <- BT.get @@ -774,8 +798,7 @@ appEvent (BT.VtyEvent e) = do else if s ^. helpBox then do case e of - V.EvKey V.KEsc [] -> do - BT.modify $ set helpBox False + V.EvKey V.KEsc [] -> BT.modify $ set helpBox False _ev -> return () else do case s ^. displayBox of @@ -976,14 +999,13 @@ appEvent (BT.VtyEvent e) = do BT.modify $ set msg "Invalid inputs" BT.modify $ set displayBox MsgDisplay BT.modify $ set dialogBox Blank - ev -> do - BT.zoom txForm $ do - handleFormEvent (BT.VtyEvent ev) - fs <- BT.gets formState - BT.modify $ - setFieldValid - (isRecipientValid (fs ^. sendTo)) - RecField + ev -> BT.zoom txForm $ do + handleFormEvent (BT.VtyEvent ev) + fs <- BT.gets formState + BT.modify $ + setFieldValid + (isRecipientValid (fs ^. sendTo)) + RecField AdrBook -> do case e of V.EvKey (V.KChar 'x') [] -> @@ -997,12 +1019,12 @@ appEvent (BT.VtyEvent e) = do T.unpack $ addressBookAddress (entityVal a) BT.modify $ set msg $ - "Address copied to Clipboard from >>\n" ++ + "Address copied to Clipboard from >>\n" ++ T.unpack (addressBookDescrip (entityVal a)) ++ "->\n" ++ T.unpack (addressBookAddress (entityVal a)) ++ "!" BT.modify $ set displayBox MsgDisplay - _ -> do - BT.modify $ set msg $ "Error while copying the address!!" + _ -> do + BT.modify $ set msg "Error while copying the address!!" BT.modify $ set displayBox MsgDisplay -- Send Zcash transaction V.EvKey (V.KChar 's') [] -> do @@ -1012,11 +1034,59 @@ appEvent (BT.VtyEvent e) = do set txForm $ mkSendForm (s ^. balance) (SendInput (addressBookAddress (entityVal a)) 0.0 "") BT.modify $ set dialogBox SendTx - _ -> do - BT.modify $ set msg $ "No receiver address available!!" + _ -> do + BT.modify $ set msg "No receiver address available!!" BT.modify $ set displayBox MsgDisplay + -- Edit an entry in Address Book + V.EvKey (V.KChar 'e') [] -> do + case L.listSelectedElement $ s ^. abaddresses of + Just (_, a) -> do + BT.modify $ + set abForm $ + mkNewABForm (AdrBookEntry (addressBookDescrip (entityVal a)) (addressBookAddress (entityVal a))) + BT.modify $ set dialogBox AdrBookForm + -- Create a new entry in Address Book + V.EvKey (V.KChar 'n') [] -> do + BT.modify $ set abForm $ mkNewABForm (AdrBookEntry "" "") + BT.modify $ set dialogBox AdrBookForm -- Process any other event ev -> BT.zoom abaddresses $ L.handleListEvent ev + -- Process new address book entry + AdrBookForm -> do + case e of + V.EvKey V.KEsc [] -> BT.modify $ set dialogBox AdrBook + V.EvKey V.KEnter [] -> do + pool <- liftIO $ runNoLoggingT $ initPool $ s ^. dbPath + fs <- BT.zoom abForm $ BT.gets formState + let idescr = T.unpack $ T.strip (fs ^. descrip) + let iabadr = fs ^. address + if not (null idescr) && isRecipientValid iabadr + then do + res <- liftIO $ saveAdrsInAdrBook pool $ AddressBook (ZcashNetDB (s ^. network)) (fs ^. descrip) (fs ^.address) + case res of + Nothing -> do + BT.modify $ set msg ("AddressBook Entry already exists: " ++ T.unpack (fs ^.address)) + BT.modify $ set displayBox MsgDisplay + Just _ -> do + BT.modify $ set msg ("New AddressBook entry created!!\n" ++ T.unpack (fs ^.address)) + BT.modify $ set displayBox MsgDisplay + -- ns <- liftIO $ refreshWallet nw + abookList <- liftIO $ getAdrBook pool (s ^. network) + let abL = L.listReplace (Vec.fromList abookList) (Just 0) (s ^. abaddresses) + BT.modify $ set dialogBox AdrBook + else do + BT.modify $ set msg "Invalid or missing data!!: " + BT.modify $ set displayBox MsgDisplay + BT.modify $ set dialogBox AdrBookForm + + ev -> BT.zoom abForm $ do + handleFormEvent (BT.VtyEvent ev) + fs <- BT.gets formState + BT.modify $ + setFieldValid + (isRecipientValid (fs ^. address)) + AddressField + Blank -> do case e of V.EvKey (V.KChar '\t') [] -> focusRing %= F.focusNext @@ -1040,7 +1110,7 @@ appEvent (BT.VtyEvent e) = do set txForm $ mkSendForm (s ^. balance) (SendInput "" 0.0 "") BT.modify $ set dialogBox SendTx - V.EvKey (V.KChar 'b') [] -> + V.EvKey (V.KChar 'b') [] -> BT.modify $ set dialogBox AdrBook ev -> case r of @@ -1049,7 +1119,7 @@ appEvent (BT.VtyEvent e) = do Just TList -> BT.zoom transactions $ L.handleListEvent ev Just ABList -> - BT.zoom transactions $ L.handleListEvent ev + BT.zoom abaddresses $ L.handleListEvent ev _anyName -> return () where printMsg :: String -> BT.EventM Name State () @@ -1069,8 +1139,8 @@ theMap = , (blinkAttr, style V.blink) , (focusedFormInputAttr, V.white `on` V.blue) , (invalidFormInputAttr, V.red `on` V.black) - , (E.editAttr, V.white `on` V.blue) - , (E.editFocusedAttr, V.blue `on` V.white) + , (E.editAttr, V.white `on` V.black) + , (E.editFocusedAttr, V.black `on` V.white) , (baseAttr, bg V.brightBlack) , (barDoneAttr, V.white `on` V.blue) , (barToDoAttr, V.white `on` V.black) @@ -1166,10 +1236,10 @@ runZenithCLI config = do 0 (mkSendForm 0 $ SendInput "" 0.0 "") (L.list ABList (Vec.fromList abookList) 1) - Left e -> do - print $ - "No Zebra node available on port " <> - show port <> ". Check your configuration." + (mkNewABForm (AdrBookEntry "" "")) + Left e -> print $ + "No Zebra node available on port " <> + show port <> ". Check your configuration." refreshWallet :: State -> IO State refreshWallet s = do @@ -1220,14 +1290,13 @@ addNewWallet n s = do let netName = s ^. network r <- saveWallet pool $ ZcashWallet n (ZcashNetDB netName) (PhraseDB sP) bH 0 case r of - Nothing -> do - return $ s & msg .~ ("Wallet already exists: " ++ T.unpack n) + Nothing -> return $ s & msg .~ ("Wallet already exists: " ++ T.unpack n) Just _ -> do wL <- getWallets pool netName let aL = L.listFindBy (\x -> zcashWalletName (entityVal x) == n) $ L.listReplace (Vec.fromList wL) (Just 0) (s ^. wallets) - return $ (s & wallets .~ aL) & msg .~ "Created new wallet: " ++ T.unpack n + return $ s & wallets .~ aL & msg .~ "Created new wallet: " ++ T.unpack n addNewAccount :: T.Text -> State -> IO State addNewAccount n s = do @@ -1246,19 +1315,19 @@ addNewAccount n s = do try $ createZcashAccount n (aL' + 1) selWallet :: IO (Either IOError ZcashAccount) case zA of - Left e -> return $ s & msg .~ ("Error: " ++ show e) + Left e -> return $ s & msg .~ "Error: " ++ show e Right zA' -> do r <- saveAccount pool zA' case r of Nothing -> - return $ s & msg .~ ("Account already exists: " ++ T.unpack n) + return $ s & msg .~ "Account already exists: " ++ T.unpack n Just x -> do aL <- runNoLoggingT $ getAccounts pool (entityKey selWallet) let nL = L.listMoveToElement x $ L.listReplace (Vec.fromList aL) (Just 0) (s ^. accounts) return $ - (s & accounts .~ nL) & msg .~ "Created new account: " ++ T.unpack n + s & accounts .~ nL & msg .~ "Created new account: " ++ T.unpack n refreshAccount :: State -> IO State refreshAccount s = do @@ -1328,19 +1397,19 @@ addNewAddress n scope s = do try $ createWalletAddress n (maxAddr + 1) (s ^. network) scope selAccount :: IO (Either IOError WalletAddress) case uA of - Left e -> return $ s & msg .~ ("Error: " ++ show e) + Left e -> return $ s & msg .~ "Error: " ++ show e Right uA' -> do nAddr <- saveAddress pool uA' case nAddr of Nothing -> - return $ s & msg .~ ("Address already exists: " ++ T.unpack n) + return $ s & msg .~ "Address already exists: " ++ T.unpack n Just x -> do addrL <- runNoLoggingT $ getAddresses pool (entityKey selAccount) let nL = L.listMoveToElement x $ L.listReplace (Vec.fromList addrL) (Just 0) (s ^. addresses) return $ - (s & addresses .~ nL) & msg .~ "Created new address: " ++ + s & addresses .~ nL & msg .~ "Created new address: " ++ T.unpack n ++ "(" ++ T.unpack (showAddress $ walletAddressUAddress $ entityVal x) ++ ")"