Add address book

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"
   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)"

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 (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

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)
@@ -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
+