diff --git a/src/Zenith/CLI.hs b/src/Zenith/CLI.hs index 0615372..f7ec123 100644 --- a/src/Zenith/CLI.hs +++ b/src/Zenith/CLI.hs @@ -2,6 +2,7 @@ {-# LANGUAGE TypeApplications #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE BlockArguments #-} module Zenith.CLI where @@ -151,6 +152,7 @@ data DialogType | Blank | AdrBook | AdrBookForm + | AdrBookUpdForm data DisplayType = AddrDisplay @@ -190,6 +192,7 @@ data State = State , _txForm :: !(Form SendInput () Name) , _abaddresses :: !(L.List Name (Entity AddressBook)) , _abForm :: !(Form AdrBookEntry () Name) + , _abCurAdrs :: !T.Text } makeLenses ''State @@ -362,6 +365,7 @@ drawUI s = [splashDialog s, helpDialog s, displayDialog s, inputDialog s, ui s] C.hCenter (hBox [capCommand "↲ " "Send", capCommand " " "Cancel"])) Blank -> emptyWidget + -- Address Book List AdrBook -> D.renderDialog (D.dialog (Just $ str " Address Book ") Nothing 60) @@ -384,15 +388,21 @@ drawUI s = [splashDialog s, helpDialog s, displayDialog s, inputDialog s, ui s] C.hCenter $ (capCommand "D" "elete Address" <+> capCommand "S" "end Zcash" <+> - capCommand3 "E" "x" "it")]]) - + capCommand3 "E" "x" "it")]]) + -- Address Book new entry form AdrBookForm -> D.renderDialog - (D.dialog (Just (str " Address Book Entry ")) Nothing 50) + (D.dialog (Just $ str " New Address Book Entry ") Nothing 50) + (renderForm (st ^. abForm) <=> + C.hCenter + (hBox [capCommand "↲" " Save", capCommand3 "" "" " Cancel"])) + -- Address Book edit/update entry form + AdrBookUpdForm -> + D.renderDialog + (D.dialog (Just $ str " Edit Address Book Entry ") Nothing 50) (renderForm (st ^. abForm) <=> C.hCenter (hBox [capCommand "↲" " Save", capCommand3 "" "" " Cancel"])) - splashDialog :: State -> Widget Name splashDialog st = @@ -772,6 +782,7 @@ appEvent (BT.AppEvent t) = do SendTx -> return () AdrBook -> return () AdrBookForm -> return () + AdrBookUpdForm -> return () Blank -> do if s ^. timer == 90 then do @@ -1041,10 +1052,15 @@ appEvent (BT.VtyEvent e) = do 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 + BT.modify $ set abCurAdrs (addressBookAddress (entityVal a)) + BT.modify $ + set abForm $ + mkNewABForm (AdrBookEntry (addressBookDescrip (entityVal a)) (addressBookAddress (entityVal a))) + BT.modify $ set dialogBox AdrBookUpdForm + + _ -> do + BT.modify $ set dialogBox Blank + -- Create a new entry in Address Book V.EvKey (V.KChar 'n') [] -> do BT.modify $ set abForm $ mkNewABForm (AdrBookEntry "" "") @@ -1061,7 +1077,7 @@ appEvent (BT.VtyEvent e) = do let idescr = T.unpack $ T.strip (fs ^. descrip) let iabadr = fs ^. address if not (null idescr) && isRecipientValid iabadr - then do + then do res <- liftIO $ saveAdrsInAdrBook pool $ AddressBook (ZcashNetDB (s ^. network)) (fs ^. descrip) (fs ^.address) case res of Nothing -> do @@ -1070,15 +1086,42 @@ appEvent (BT.VtyEvent e) = do 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) + -- case end + ab <- liftIO $ refreshAddressBook s + BT.put ab + 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 + AdrBookUpdForm -> 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 $ updateAdrsInAdrBook pool (fs ^. descrip) (fs ^.address) (s ^. abCurAdrs) + BT.modify $ set msg ("AddressBook entry modified!!\n" ++ T.unpack (fs ^.address)) + BT.modify $ set displayBox MsgDisplay + -- case end + 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 @@ -1086,7 +1129,6 @@ appEvent (BT.VtyEvent e) = do setFieldValid (isRecipientValid (fs ^. address)) AddressField - Blank -> do case e of V.EvKey (V.KChar '\t') [] -> focusRing %= F.focusNext @@ -1237,6 +1279,7 @@ runZenithCLI config = do (mkSendForm 0 $ SendInput "" 0.0 "") (L.list ABList (Vec.fromList abookList) 1) (mkNewABForm (AdrBookEntry "" "")) + " " Left e -> print $ "No Zebra node available on port " <> show port <> ". Check your configuration." @@ -1380,6 +1423,23 @@ refreshTxs s = do let tL' = L.listReplace (Vec.fromList tList) (Just 0) (s ^. transactions) return $ s & transactions .~ tL' +refreshAddressBook :: State -> IO State +refreshAddressBook s = do + pool <- runNoLoggingT $ initPool $ s ^. dbPath + selAddress <- + do case L.listSelectedElement $ s ^. abaddresses of + Nothing -> do + let fAdd = + L.listSelectedElement $ L.listMoveToBeginning $ s ^. abaddresses + return fAdd + Just a2 -> return $ Just a2 + case selAddress of + Nothing -> return s + Just (_i, a) -> do + abookList <- getAdrBook pool (s ^. network) + let tL' = L.listReplace (Vec.fromList abookList) (Just 0) (s ^. abaddresses) + return $ s & abaddresses .~ tL' + addNewAddress :: T.Text -> Scope -> State -> IO State addNewAddress n scope s = do pool <- runNoLoggingT $ initPool $ s ^. dbPath diff --git a/src/Zenith/DB.hs b/src/Zenith/DB.hs index b3c25ce..fe643e9 100644 --- a/src/Zenith/DB.hs +++ b/src/Zenith/DB.hs @@ -15,6 +15,7 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE TypeApplications #-} +{-# LANGUAGE BlockArguments #-} module Zenith.DB where @@ -1494,14 +1495,24 @@ saveAdrsInAdrBook pool a = PS.retryOnBusy $ flip PS.runSqlPool pool $ insertUniqueEntity a -- | Update an existing address into AddressBook -updateAdrsInAdrBook :: ConnectionPool -> T.Text -> AddressBookId -> IO () -updateAdrsInAdrBook pool a i = do +updateAdrsInAdrBook :: ConnectionPool -> T.Text -> T.Text -> T.Text -> IO () +updateAdrsInAdrBook pool d a ia = do runNoLoggingT $ PS.retryOnBusy $ flip PS.runSqlPool pool $ do update $ \ab -> do - set ab [AddressBookAddress =. val a] - where_ $ ab ^. AddressBookId ==. val i + set ab [AddressBookDescrip =. val d, AddressBookAddress =. val a] + where_ $ ab ^. AddressBookAddress ==. val ia + +getABookRec :: ConnectionPool -> T.Text -> IO [Entity AddressBook] +getABookRec pool a = do + runNoLoggingT $ + PS.retryOnBusy $ + flip PS.runSqlPool pool $ + select $ do + adrbook <- from $ table @AddressBook + where_ ((adrbook ^. AddressBookAddress) ==. val a) + return adrbook -- | delete an existing address from AddressBook deleteAdrsFromAB :: ConnectionPool -> AddressBookId -> IO () @@ -1509,7 +1520,7 @@ deleteAdrsFromAB pool i = do runNoLoggingT $ PS.retryOnBusy $ flip PS.runSqlPool pool $ do - delete $ do + delete $ do ab <- from $ table @AddressBook where_ (ab ^. AddressBookId ==. val i)