Merge pull request 'Add base addressbook to GUI' (#102) from rvv041 into milestone3

Reviewed-on: https://git.vergara.tech///Vergara_Tech/zenith/pulls/102

app/Main.hs

@@ -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"
-  let myConfig = Config dbFilePath zebraHost zebraPort
+  dbFP <- getZenithPath
+  let dbFilePath = dbFP ++ dbFileName
+  let myConfig = Config (T.pack dbFilePath) zebraHost zebraPort
   if not (null args)
     then do
       case head args
@@ -236,4 +238,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)"

src/Zenith/GUI.hs

@@ -1,5 +1,6 @@
 {-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE BlockArguments #-}
 
 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.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
@@ -52,11 +53,16 @@ import Zenith.Scanner (processTx, updateConfs)
 import Zenith.Types hiding (ZcashAddress(..))
 import Zenith.Utils
   ( displayAmount
+  , getZenithPath
+  , isEmpty
   , isRecipientValid
+  , isValidString
   , jsonNumber
+  , padWithZero
   , parseAddress
   , showAddress
   , validBarValue
+  , validateAddressBool
   )
 
 data AppEvent
@@ -102,6 +108,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
@@ -144,6 +169,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
@@ -185,6 +220,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
@@ -247,6 +291,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 =
@@ -750,6 +796,150 @@ 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
@@ -1060,6 +1250,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)
@@ -1147,6 +1416,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 -> (AppEvent -> IO ()) -> IO ()
 scanZebra dbPath zHost zPort sendMsg = do
@@ -1246,6 +1541,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
 
@@ -1297,6 +1595,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
@@ -1325,10 +1624,10 @@ runZenithGUI config = do
                       Nothing
                       ""
                       ""
-                      (SaveAddress $
-                       if not (null accList)
+                      (SaveAddress
+                         (if not (null accList)
                             then Just (head accList)
-                         else Nothing)
+                            else Nothing))
                       False
                       False
                       Nothing
@@ -1343,6 +1642,16 @@ runZenithGUI config = do
                       False
                       Nothing
                       hD
+                      False
+                      False
+                      ""
+                      ""
+                      False
+                      False
+                      abList
+                      Nothing
+                      False
+                      False
               startApp model handleEvent buildUI (params hD)
         Left e -> do
           initDb dbFilePath
@@ -1358,9 +1667,9 @@ runZenithGUI config = do
                   0
                   []
                   0
-                  (Just $
-                   "Couldn't connect to Zebra on " <>
-                   host <> ":" <> showt port <> ". Check your configuration.")
+                  (Just
+                     ("Couldn't connect to Zebra on " <>
+                      host <> ":" <> showt port <> ". Check your configuration."))
                   False
                   314259000
                   (Just 30000)
@@ -1389,6 +1698,16 @@ runZenithGUI config = do
                   False
                   Nothing
                   hD
+                  False
+                  False
+                  ""
+                  ""
+                  False
+                  False
+                  []
+                  Nothing
+                  False
+                  False
           startApp model handleEvent buildUI (params hD)
   where
     params hd =

src/Zenith/GUI/Theme.hs

@@ -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 &

src/Zenith/Utils.hs

@@ -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)
@@ -103,7 +118,7 @@ isRecipientValid a =
       (case decodeTransparentAddress (E.encodeUtf8 a) of
          Just _a3 -> True
          Nothing ->
-           case decodeExchangeAddress a of
+           case decodeExchangeAddress (E.encodeUtf8 a) of
              Just _a4 -> True
              Nothing -> False)
 
@@ -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
+  

zcash-haskell

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