rvv001 - Synchronize branch with recent changes

Processing Payment URI is working
		     Display of error messages added to process

.gitignore

@@ -5,3 +5,7 @@ zenith.db
 zenith.log
 zenith.db-shm
 zenith.db-wal
+test.db
+test.db-shm
+test.db-wal
+

app/Main.hs

@@ -213,7 +213,9 @@ main = do
   currencyCode <- require config "currencyCode"
   dbFP <- getZenithPath
   let dbFilePath = T.pack $ dbFP ++ dbFileName
-  let myConfig = Config  dbFilePath 
+  let myConfig =
+        Config
+          dbFilePath
           zebraHost
           zebraPort
           nodeUser

app/Server.hs

@@ -38,7 +38,15 @@ main = do
   currencyCode <- require config "currencyCode"
   dbFP <- getZenithPath
   let dbFilePath = T.pack $ dbFP ++ dbFileName
-  let myConfig = Config dbFilePath zebraHost zebraPort nodeUser nodePwd nodePort currencyCode
+  let myConfig =
+        Config
+          dbFilePath
+          zebraHost
+          zebraPort
+          nodeUser
+          nodePwd
+          nodePort
+          currencyCode
   let ctx = authenticate myConfig :. EmptyContext
   w <- try $ checkZebra zebraHost zebraPort :: IO (Either IOError ZebraGetInfo)
   case w of

src/Zenith/CLI.hs

@@ -89,7 +89,13 @@ import Lens.Micro.Mtl
 import Lens.Micro.TH
 import System.Hclip
 import Text.Printf
-import Text.Wrap (FillScope(..), FillStrategy(..), WrapSettings(..))
+import Text.Wrap
+  ( FillScope(..)
+  , FillStrategy(..)
+  , WrapSettings(..)
+  , defaultWrapSettings
+  , wrapTextToLines
+  )
 import ZcashHaskell.Keys (generateWalletSeedPhrase)
 import ZcashHaskell.Orchard
   ( getSaplingFromUA
@@ -121,12 +127,12 @@ import Zenith.Utils
   ( displayTaz
   , displayZec
   , getChainTip
+  , getZcashPrice
   , isRecipientValid
   , isRecipientValidGUI
   , jsonNumber
   , showAddress
   , validBarValue
-  , getZcashPrice
   )
 
 data Name
@@ -182,6 +188,13 @@ newtype ShDshEntry = ShDshEntry
 
 makeLenses ''ShDshEntry
 
+data PaymentInput = PaymentInput
+  { _pmtAmt :: !Scientific
+  , _pmtMemo :: !T.Text
+  } deriving (Show)
+
+makeLenses ''PaymentInput
+
 data DialogType
   = WName
   | AName
@@ -197,6 +210,9 @@ data DialogType
   | DeshieldForm
   | ShieldForm
   | ShowFIATBalance
+  | ViewingKeyMenu
+  | ViewingKeyShow
+  | PaymentURIShow
 
 data DisplayType
   = AddrDisplay
@@ -250,6 +266,9 @@ data State = State
   , _sBalance :: !Integer
   , _currencyCode :: !T.Text
   , _zprice :: !Double
+  , _vkName :: !T.Text
+  , _vkData :: !T.Text
+  , _pmtURIForm :: !(Form PaymentInput () Name)
   }
 
 makeLenses ''State
@@ -257,6 +276,21 @@ makeLenses ''State
 zBalance :: State -> Double
 zBalance st = (fromIntegral (st ^. balance)) / 100000000
 
+-- Function to split text into fixed-size chunks
+splitText :: Int -> T.Text -> [T.Text]
+splitText chunkSize text =
+  let strippedText = T.filter (/= '\n') text -- Remove newlines
+   in if T.null strippedText
+        then []
+        else T.take chunkSize strippedText :
+             splitText chunkSize (T.drop chunkSize strippedText)
+
+-- Create a widget to display the long text
+renderLongText :: Int -> T.Text -> Widget Name
+renderLongText lineLength longText =
+  let linesOfText = splitText lineLength longText
+   in vBox $ map txt linesOfText
+
 drawUI :: State -> [Widget Name]
 drawUI s = [splashDialog s, helpDialog s, displayDialog s, inputDialog s, ui s]
   where
@@ -307,13 +341,18 @@ drawUI s = [splashDialog s, helpDialog s, displayDialog s, inputDialog s, ui s]
                 , capCommand "A" "ccounts"
                 , capCommand "V" "iew address"
                 , capCommand "S" "end Tx"
-                , capCommand3 "ba" "L" ("ance (" ++ ( T.unpack (st ^. currencyCode) )++ ")" )
+                , capCommand2 "Gen " "U" "RI"
+                , capCommand3
+                    "ba"
+                    "L"
+                    ("ance (" ++ (T.unpack (st ^. currencyCode)) ++ ")")
                 ])
          , C.hCenter
              (hBox
                 [ capCommand2 "Address " "B" "ook"
                 , capCommand2 "s" "H" "ield"
                 , capCommand "D" "e-shield"
+                , capCommand2 "Viewing " "K" "eys"
                 , capCommand "Q" "uit"
                 , capCommand "?" " Help"
                 , str $ show (st ^. timer)
@@ -384,7 +423,9 @@ drawUI s = [splashDialog s, helpDialog s, displayDialog s, inputDialog s, ui s]
         else emptyWidget
       where
         keyList =
-          map (C.hCenter . str) ["?", "Esc", "w", "a", "v", "s", "b", "d", "l", "q"]
+          map
+            (C.hCenter . str)
+            ["?", "Esc", "w", "a", "v", "s", "u", "b", "d", "k", "l", "q"]
         actionList =
           map
             (hLimit 40 . str)
@@ -394,8 +435,10 @@ drawUI s = [splashDialog s, helpDialog s, displayDialog s, inputDialog s, ui s]
             , "Switch accounts"
             , "View address"
             , "Send Tx"
+            , "Gen URI"
             , "Address Book"
             , "Shield/De-Shield"
+            , "Viewing Keys"
             , "Balance in Fiat"
             , "Quit"
             ]
@@ -443,6 +486,13 @@ drawUI s = [splashDialog s, helpDialog s, displayDialog s, inputDialog s, ui s]
             (renderForm (st ^. txForm) <=>
              C.hCenter
                (hBox [capCommand "↲ " "Send", capCommand "<esc> " "Cancel"]))
+        PaymentURIShow ->
+          D.renderDialog
+            (D.dialog (Just (str " Create Payment URI ")) Nothing 50)
+            (renderForm (st ^. pmtURIForm) <=>
+             C.hCenter
+               (hBox
+                  [capCommand "P" "rocess", capCommand3 " " "<esc> " "Cancel"]))
         DeshieldForm ->
           D.renderDialog
             (D.dialog (Just (str " De-Shield ZEC ")) Nothing 50)
@@ -462,7 +512,7 @@ drawUI s = [splashDialog s, helpDialog s, displayDialog s, inputDialog s, ui s]
                   ]) <=>
              renderForm (st ^. deshieldForm) <=>
              C.hCenter
-               (hBox [capCommand "P" "roceed", capCommand "<esc> " "Cancel"]))
+               (hBox [capCommand "P" "roceed", capCommand3 "" "<esc> " "Cancel"]))
         ShieldForm ->
           D.renderDialog
             (D.dialog (Just (str " Shield ZEC ")) Nothing 50)
@@ -473,7 +523,26 @@ drawUI s = [splashDialog s, helpDialog s, displayDialog s, inputDialog s, ui s]
                   then displayZec (st ^. tBalance)
                   else displayTaz (st ^. tBalance) ++ "?") <=>
              C.hCenter
-               (hBox [capCommand "P" "roceed", capCommand "<esc> " "Cancel"]))
+               (hBox [capCommand "P" "roceed", capCommand3 "" "<esc> " "Cancel"]))
+        ViewingKeyShow ->
+          D.renderDialog
+            (D.dialog
+               (Just (str (" " ++ (T.unpack (st ^. vkName)) ++ " Viewing Key ")))
+               Nothing
+               50)
+            (padAll 1 (C.hCenter (renderLongText 45 (st ^. vkData))) <=>
+             C.hCenter
+               (hBox
+                  [capCommand "C" "opy to Clipoard", capCommand3 "" "E" "xit"]))
+        ViewingKeyMenu ->
+          D.renderDialog
+            (D.dialog (Just (str " Viewing Keys ")) Nothing 50)
+            (C.hCenter
+               (hBox
+                  [ capCommand "F" "ull"
+                  , capCommand "I" "ncoming"
+                  , capCommand3 "" "E" "xit"
+                  ]))
         Blank -> emptyWidget
         -- Address Book List
         AdrBook ->
@@ -529,21 +598,36 @@ drawUI s = [splashDialog s, helpDialog s, displayDialog s, inputDialog s, ui s]
         -- Show Balance in FIAT form
         ShowFIATBalance ->
           D.renderDialog
-            (D.dialog (Just $ str (" Account Balance (" ++ ( T.unpack (st ^. currencyCode)) ++ ") ") ) Nothing 60)
+            (D.dialog
+               (Just $
+                str
+                  (" Account Balance (" ++
+                   (T.unpack (st ^. currencyCode)) ++ ") "))
+               Nothing
+               60)
             (withAttr abDefAttr $
              setAvailableSize (50, 8) $
              viewport SFBViewPort BT.Vertical $
              vLimit 8 $
              hLimit 50 $
              vBox $
-                [ 
+             [ vLimit 4 $
-                  vLimit 4 $
                hLimit 50 $
                vBox $
                [ C.hCenter (str $ " ")
-                   , C.hCenter (str  $ "1 ZEC = " ++ ( printf "%.2f" ( s ^. zprice ) ) ++ " " ++ (T.unpack ( s ^. currencyCode) ))
+               , C.hCenter
+                   (str $
+                    "1 ZEC = " ++
+                    (printf "%.2f" (s ^. zprice)) ++
+                    " " ++ (T.unpack (s ^. currencyCode)))
                , C.hCenter (str $ " ")
-                   , C.hCenter ( str $ " Balance: " ++ (  printf "%.8f" $ zBalance s ) ++ " ZEC ==> " ++ ( printf "%.2f" (( s ^. zprice ) * (zBalance s) ) ++ " " ++ (T.unpack ( s ^. currencyCode) ))   )
+               , C.hCenter
+                   (str $
+                    " Balance: " ++
+                    (printf "%.8f" $ zBalance s) ++
+                    " ZEC ==> " ++
+                    (printf "%.2f" ((s ^. zprice) * (zBalance s)) ++
+                     " " ++ (T.unpack (s ^. currencyCode))))
                ]
              , padTop Max $
                vLimit 4 $
@@ -567,7 +651,7 @@ drawUI s = [splashDialog s, helpDialog s, displayDialog s, inputDialog s, ui s]
                   (str
                      " _____          _ _   _     \n|__  /___ _ __ (_) |_| |__\n  / // _ \\ '_ \\| | __| '_ \\\n / /|  __/ | | | | |_| | | |\n/____\\___|_| |_|_|\\__|_| |_|") <=>
                 C.hCenter
-                  (withAttr titleAttr (str "Zcash Wallet v0.7.0.0-beta")) <=>
+                  (withAttr titleAttr (str "Zcash Wallet v0.7.1.0-beta")) <=>
                 C.hCenter (withAttr blinkAttr $ str "Press any key..."))
         else emptyWidget
     capCommand3 :: String -> String -> String -> Widget Name
@@ -746,6 +830,19 @@ mkSendForm bal =
     label s w =
       padBottom (Pad 1) $ vLimit 1 (hLimit 15 $ str s <+> fill ' ') <+> w
 
+mkPaymentURIForm :: Integer -> PaymentInput -> Form PaymentInput e Name
+mkPaymentURIForm bal =
+  newForm
+    [ label "Amount: " @@=
+      editShowableFieldWithValidate pmtAmt AmtField (isAmountValid bal)
+    , label "Memo:   " @@= editTextField pmtMemo MemoField (Just 1)
+    ]
+  where
+    isAmountValid :: Integer -> Scientific -> Bool
+    isAmountValid b i = fromIntegral b >= (i * scientific 1 8)
+    label s w =
+      padBottom (Pad 1) $ vLimit 1 (hLimit 15 $ str s <+> fill ' ') <+> w
+
 mkDeshieldForm :: Integer -> ShDshEntry -> Form ShDshEntry e Name
 mkDeshieldForm tbal =
   newForm
@@ -757,7 +854,19 @@ mkDeshieldForm tbal =
     isAmountValid b i = fromIntegral b >= (i * scientific 1 8)
     label s w =
       padBottom (Pad 1) $ vLimit 1 (hLimit 15 $ str s <+> fill ' ') <+> w
-
+{--
+mkShieldForm :: Integer -> ShDshEntry -> Form ShDshEntry e Name
+mkShieldForm bal =
+  newForm
+    [ label "Amount to Shield: " @@=
+      editShowableFieldWithValidate shAmt AmtField (isAmountValid bal)
+    ]
+  where
+    isAmountValid :: Integer -> Scientific -> Bool
+    isAmountValid b i = (fromIntegral b / 100000000.0) >= i
+    label s w =
+      padBottom (Pad 1) $ vLimit 1 (hLimit 15 $ str s <+> fill ' ') <+> w
+--}
 mkNewABForm :: AdrBookEntry -> Form AdrBookEntry e Name
 mkNewABForm =
   newForm
@@ -1035,7 +1144,10 @@ appEvent (BT.AppEvent t) = do
             AdrBookDelForm -> return ()
             DeshieldForm -> return ()
             ShieldForm -> return ()
+            ViewingKeyShow -> return ()
+            ViewingKeyMenu -> return ()
             ShowFIATBalance -> return ()
+            PaymentURIShow -> return ()
             Blank -> do
               if s ^. timer == 90
                 then do
@@ -1626,12 +1738,58 @@ appEvent (BT.VtyEvent e) = do
                              BT.modify $ set zprice p
                              BT.modify $ set dialogBox ShowFIATBalance
                            Nothing -> do
-                                  BT.modify $ set msg ("CoinGecko is not responding!!!")
+                             BT.modify $
+                               set msg ("CoinGecko is not responding!!!")
                              BT.modify $ set displayBox MsgDisplay
                       -- Process any other event       
                        ev -> BT.zoom abAddresses $ L.handleListEvent ev
                    --
+                   -- Viewing Key Display Support
+                   --
+                   ViewingKeyShow -> do
+                     case e of
+                       V.EvKey (V.KChar 'c') [] -> do
+                         liftIO $ setClipboard $ T.unpack $ s ^. vkData
+                         BT.modify $
+                           set msg $
+                           (T.unpack (s ^. vkName)) ++
+                           " viewing key copied to Clipboard!!"
+                         BT.modify $ set displayBox MsgDisplay
+                       V.EvKey (V.KChar 'e') [] -> do
+                         BT.modify $ set vkName ""
+                         BT.modify $ set vkData ""
+                         BT.modify $ set dialogBox ViewingKeyMenu
+                       ev -> return ()
+                   --
+                   ViewingKeyMenu -> do
+                     case e of
+                       V.EvKey (V.KChar 'f') [] -> do
+                         BT.modify $ set vkName "Full"
+                         BT.modify $
+                           set
+                             vkData
+                             "VKFull->ztestsapling1tgjr4zppwk4ne8xy6gdq4z2gwq7dmf5jq8z2ctpn8nlmtse0a74fa5z0m8z383gmpgqz6q6duu4"
+                         BT.modify $ set dialogBox ViewingKeyShow
+                       V.EvKey (V.KChar 'i') [] -> do
+                         BT.modify $ set vkName "Incomming"
+                         BT.modify $
+                           set
+                             vkData
+                             "VKIncoming->ztestsapling1tgjr4zppwk4ne8xy6gdq4z2gwq7dmf5jq8z2ctpn8nlmtse0a74fa5z0m8z383gmpgqz6q6duu4"
+                         BT.modify $ set dialogBox ViewingKeyShow
+                       V.EvKey (V.KChar 'e') [] ->
+                         BT.modify $ set dialogBox Blank
+                       ev -> return ()
+                   --
+                   -- Payment URI Form Events
+                   --
+                   PaymentURIShow -> do
+                     case e of
+                       V.EvKey V.KEsc [] -> BT.modify $ set dialogBox Blank
+                       ev -> return ()
+                   --
                    -- Process any other event    
+                   --
                    Blank -> do
                      case e of
                        V.EvKey (V.KChar '\t') [] -> focusRing %= F.focusNext
@@ -1655,9 +1813,13 @@ appEvent (BT.VtyEvent e) = do
                            set txForm $
                            mkSendForm (s ^. balance) (SendInput "" 0.0 "" Full)
                          BT.modify $ set dialogBox SendTx
+                       V.EvKey (V.KChar 'u') [] -> do
+                         BT.modify $
+                           set pmtURIForm $
+                           mkPaymentURIForm (s ^. balance) (PaymentInput 0.0 "")
+                         BT.modify $ set dialogBox PaymentURIShow
                        V.EvKey (V.KChar 'b') [] ->
                          BT.modify $ set dialogBox AdrBook
-                       -- >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
                        V.EvKey (V.KChar 'l') [] -> do
                          if s ^. network == MainNet
                            then do
@@ -1667,12 +1829,18 @@ appEvent (BT.VtyEvent e) = do
                                  BT.modify $ set zprice p
                                  BT.modify $ set dialogBox ShowFIATBalance
                                Nothing -> do
-                                      BT.modify $ set msg ("Currency not supported (" ++ T.unpack (s ^. currencyCode ) ++ ")!!!")
+                                 BT.modify $
+                                   set
+                                     msg
+                                     ("Currency not supported (" ++
+                                      T.unpack (s ^. currencyCode) ++ ")!!!")
                                  BT.modify $ set displayBox MsgDisplay
                            else do
-                                BT.modify $ set msg "Balance conversion not available for TestNet"
+                             BT.modify $
+                               set
+                                 msg
+                                 "Balance conversion not available for TestNet"
                              BT.modify $ set displayBox MsgDisplay
-                       -- <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
                        V.EvKey (V.KChar 'd') [] -> do
                          pool <- liftIO $ runNoLoggingT $ initPool $ s ^. dbPath
                          selAcc <-
@@ -1724,7 +1892,8 @@ appEvent (BT.VtyEvent e) = do
                                  msg
                                  "Not enough transparent funds in this account"
                              BT.modify $ set displayBox MsgDisplay
-
+                       V.EvKey (V.KChar 'k') [] -> do
+                         BT.modify $ set dialogBox ViewingKeyMenu
                        ev ->
                          case r of
                            Just AList ->
@@ -1879,6 +2048,9 @@ runZenithTUI config = do
                   sBal
                   currencyCode
                   0
+                  ""
+                  ""
+                  (mkPaymentURIForm 0 $ PaymentInput 0.0 "")
     Left _e -> do
       print $
         "No Zebra node available on port " <>

src/Zenith/GUI.hs

@@ -69,21 +69,21 @@ import Zenith.Types hiding (ZcashAddress(..))
 import Zenith.Utils
   ( displayAmount
   , getChainTip
+  , getZcashPrice
   , isRecipientValidGUI
   , isValidString
   , isZecAddressValid
   , jsonNumber
   , padWithZero
+  , parseZcashPayment
   , showAddress
   , validBarValue
-  , getZcashPrice
   )
 
 data VkTypeDef
   = VkNone
   | VkFull
   | VkIncoming
-  | VkOutgoing 
   deriving (Eq, Show)
 
 data AppEvent
@@ -163,6 +163,11 @@ data AppEvent
   | ShowViewingKey !VkTypeDef !T.Text
   | CopyViewingKey !T.Text !T.Text
   | CloseShowVK
+  | DisplayPaymentURI
+  | ClosePaymentURI
+  | DisplayPayUsingURI
+  | ClosePayUsingURI
+  | ProcIfValidURI
   deriving (Eq, Show)
 
 data AppModel = AppModel
@@ -229,6 +234,9 @@ data AppModel = AppModel
   , _viewingKeyDisplay :: !Bool
   , _vkTypeName :: !T.Text
   , _vkData :: !T.Text
+  , _paymentURIDisplay :: !Bool
+  , _usepmtURIOverlay :: !Bool
+  , _uriString :: !T.Text
   } deriving (Eq, Show)
 
 makeLenses ''AppModel
@@ -280,6 +288,8 @@ buildUI wenv model = widgetTree
           model ^.
           updateABAddress
         , showVKOverlay `nodeVisible` model ^. viewingKeyDisplay
+        , paymentURIOverlay `nodeVisible` model ^. paymentURIDisplay
+        , pmtUsingURIOverlay `nodeVisible` model ^. usepmtURIOverlay
         , shieldOverlay `nodeVisible` model ^. shieldZec
         , deShieldOverlay `nodeVisible` model ^. deShieldZec
         , msgAdrBookOverlay `nodeVisible` isJust (model ^. msgAB)
@@ -364,10 +374,21 @@ buildUI wenv model = widgetTree
                          , widgetIf (model ^. viewingKeyPopup) $
                            remixIcon remixMenuFoldFill
                          ])
-                  , widgetIf (model ^. viewingKeyPopup) $ animSlideIn viewingKeysBox
+                  , widgetIf (model ^. viewingKeyPopup) $
+                    animSlideIn viewingKeysBox
                   ]) `styleBasic`
              [bgColor white, borderB 1 gray, padding 3]
-           , box_ [alignLeft, onClick ShowFIATBalance] ( label ("Balance in " <> T.toUpper (c_currencyCode (model ^. configuration) ) ) )  `styleBasic`
+           , box_
+               [alignLeft, onClick ShowFIATBalance]
+               (label
+                  ("Balance in " <>
+                   T.toUpper (c_currencyCode (model ^. configuration)))) `styleBasic`
+             [bgColor white, borderB 1 gray, padding 3]
+           , box_ [alignLeft, onClick DisplayPaymentURI] (label "Create URI") `styleBasic`
+             [bgColor white, borderB 1 gray, padding 3]
+           , box_
+               [alignLeft, onClick DisplayPayUsingURI]
+               (label "Pay using URI") `styleBasic`
              [bgColor white, borderB 1 gray, padding 3]
            ]) `styleBasic`
       [bgColor btnColor, padding 3]
@@ -393,17 +414,23 @@ buildUI wenv model = widgetTree
         [alignMiddle]
         (vstack
            [ box_
-               [alignLeft, onClick (ShowViewingKey VkFull "VKFull->ztestsapling1tgjr4zppwk4ne8xy6gdq4z2gwq7dmf5jq8z2ctpn8nlmtse0a74fa5z0m8z383gmpgqz6q6duu4")]
+               [ alignLeft
+               , onClick
+                   (ShowViewingKey
+                      VkFull
+                      "VKFull->ztestsapling1tgjr4zppwk4ne8xy6gdq4z2gwq7dmf5jq8z2ctpn8nlmtse0a74fa5z0m8z383gmpgqz6q6duu4")
+               ]
                (hstack [label "Full VK", filler]) `styleBasic`
              [bgColor white, borderB 1 gray, padding 3]
            , box_
-               [alignLeft, onClick $ (ShowViewingKey VkIncoming "VKIncoming->ztestsapling1tgjr4zppwk4ne8xy6gdq4z2gwq7dmf5jq8z2ctpn8nlmtse0a74fa5z0m8z383gmpgqz6q6duu4")]
+               [ alignLeft
+               , onClick $
+                 (ShowViewingKey
+                    VkIncoming
+                    "VKIncoming->ztestsapling1tgjr4zppwk4ne8xy6gdq4z2gwq7dmf5jq8z2ctpn8nlmtse0a74fa5z0m8z383gmpgqz6q6duu4")
+               ]
                (hstack [label "Incoming VK", filler]) `styleBasic`
              [bgColor white, borderB 1 gray, padding 3]
-           , box_
-               [alignLeft, onClick $ (ShowViewingKey VkOutgoing "VKOutgoing->ztestsapling1tgjr4zppwk4ne8xy6gdq4z2gwq7dmf5jq8z2ctpn8nlmtse0a74fa5z0m8z383gmpgqz6q6duu4")]
-               (hstack [label "Outgoing VK", filler]) `styleBasic`
-             [bgColor white, borderB 1 gray, padding 3]
            ])
     walletButton =
       hstack
@@ -1056,13 +1083,24 @@ buildUI wenv model = widgetTree
       vstack
         [ box_
             []
-            (label ("Account Balance in " <> (T.toUpper (c_currencyCode (model ^. configuration))) ) `styleBasic`
+            (label
+               ("Account Balance in " <>
+                (T.toUpper (c_currencyCode (model ^. configuration)))) `styleBasic`
              [textFont "Bold", textSize 12, textColor white]) `styleBasic`
           [bgColor btnColor, radius 2, padding 3]
         , filler
-        , (label ("1 ZEC = " <> ( T.pack (printf "%.2f" ( model ^. zPrice ))) <> " " <> (T.toUpper (c_currencyCode (model ^. configuration))) ) ) `styleBasic`  []
+        , (label
+             ("1 ZEC = " <>
+              (T.pack (printf "%.2f" (model ^. zPrice))) <>
+              " " <> (T.toUpper (c_currencyCode (model ^. configuration))))) `styleBasic`
+          []
         , filler
-        , (label ( ( T.pack (printf "%.8f" (model ^. aBal) ) <> " ZEC = " <> ( T.pack (printf "%.2f" (( model ^. zPrice )*( model ^. aBal ) ) ) )  <> " " <> (T.toUpper (c_currencyCode (model ^. configuration))) ) ) )  `styleBasic`   []     
+        , (label
+             ((T.pack (printf "%.8f" (model ^. aBal)) <>
+               " ZEC = " <>
+               (T.pack (printf "%.2f" ((model ^. zPrice) * (model ^. aBal)))) <>
+               " " <> (T.toUpper (c_currencyCode (model ^. configuration)))))) `styleBasic`
+          []
         ]
     showVKOverlay =
       alert CloseShowVK $
@@ -1073,11 +1111,13 @@ buildUI wenv model = widgetTree
              [textFont "Bold", textColor white, textSize 12, padding 3]) `styleBasic`
           [bgColor btnColor, radius 2, padding 3]
         , spacer
-        , hstack [filler, label_ (txtWrapN (model ^. vkData) 64) [multiline], filler]
+        , hstack
+            [filler, label_ (txtWrapN (model ^. vkData) 64) [multiline], filler]
         , spacer
         , hstack
             [ filler
-            , button "Copy to Clipboard" $ CopyViewingKey (model ^. vkTypeName) (model ^. vkData)
+            , button "Copy to Clipboard" $
+              CopyViewingKey (model ^. vkTypeName) (model ^. vkData)
             , filler
             ]
         ]
@@ -1196,8 +1236,106 @@ buildUI wenv model = widgetTree
            , filler
            ]) `styleBasic`
       [bgColor (white & L.a .~ 0.5)]
-
+    paymentURIOverlay =
-notImplemented = NotImplemented
+      box
+        (vstack
+           [ filler
+           , hstack
+               [ filler
+               , box_
+                   []
+                   (vstack
+                      [ box_
+                          [alignMiddle]
+                          (label "Create URI" `styleBasic`
+                           [textColor white, textFont "Bold", textSize 12]) `styleBasic`
+                        [bgColor btnColor]
+                      , separatorLine `styleBasic` [fgColor btnColor]
+                      , spacer
+                      , hstack
+                          [ label "Amount:" `styleBasic`
+                            [width 50, textFont "Bold"]
+                          , spacer
+                          , numericField_
+                              sendAmount
+                              [ decimals 8
+                              , minValue 0.0
+                              , maxValue
+                                  (fromIntegral (model ^. balance) / 100000000.0)
+                              , validInput amountValid
+                              , onChange CheckAmount
+                              ] `styleBasic`
+                            [ width 150
+                            , styleIf
+                                (not $ model ^. amountValid)
+                                (textColor red)
+                            ]
+                          ]
+                      , hstack
+                          [ label "Memo:" `styleBasic`
+                            [width 50, textFont "Bold"]
+                          , spacer
+                          , textArea sendMemo `styleBasic`
+                            [width 150, height 40]
+                          ]
+                      , spacer
+                      , box_
+                          [alignMiddle]
+                          (hstack
+                             [ spacer
+                             , mainButton "Create URI" NotImplemented `nodeEnabled`
+                               True
+                             , spacer
+                             , button "Cancel" ClosePaymentURI
+                             , spacer
+                             ])
+                      ]) `styleBasic`
+                 [radius 4, border 2 btnColor, bgColor white, padding 4]
+               , filler
+               ]
+           , filler
+           ]) `styleBasic`
+      [bgColor (white & L.a .~ 0.5)]
+    pmtUsingURIOverlay =
+      box
+        (vstack
+           [ filler
+           , hstack
+               [ filler
+               , box_
+                   []
+                   (vstack
+                      [ box_
+                          [alignMiddle]
+                          (label "Pay using URI" `styleBasic`
+                           [textColor white, textFont "Bold", textSize 12]) `styleBasic`
+                        [bgColor btnColor]
+                      , separatorLine `styleBasic` [fgColor btnColor]
+                      , spacer
+                      , hstack
+                          [ label "URI :" `styleBasic`
+                            [width 30, textFont "Bold"]
+                          , spacer
+                          , textArea uriString `styleBasic`
+                            [width 170, height 30]
+                          ]
+                      , spacer
+                      , box_
+                          [alignMiddle]
+                          (hstack
+                             [ spacer
+                             , button "Cancel" ClosePayUsingURI
+                             , spacer
+                             , mainButton "Process" ProcIfValidURI
+                             , spacer
+                             ])
+                      ]) `styleBasic`
+                 [radius 4, border 2 btnColor, bgColor white, padding 4]
+               , filler
+               ]
+           , filler
+           ]) `styleBasic`
+      [bgColor (white & L.a .~ 0.5)]
 
 generateQRCodes :: Config -> IO ()
 generateQRCodes config = do
@@ -1320,11 +1458,13 @@ handleEvent wenv node model evt =
         False
       ]
     ConfirmCancel -> [Model $ model & confirmTitle .~ Nothing & mainInput .~ ""]
-    ViewingKeysClicked -> [Model $ model & viewingKeyPopup .~ not (model ^. viewingKeyPopup)]
+    ViewingKeysClicked ->
+      [Model $ model & viewingKeyPopup .~ not (model ^. viewingKeyPopup)]
     NewAddress vk ->
       [ Model $
-        model & confirmTitle ?~ "New Address" &
+        model & confirmTitle ?~ "New Address" & confirmCancel .~ "Cancel" &
-        confirmCancel .~ "Cancel" & menuPopup .~ False
+        menuPopup .~
+        False
       ]
     ShowSeed -> [Model $ model & showSeed .~ True & menuPopup .~ False]
     ShowSend ->
@@ -1606,17 +1746,22 @@ handleEvent wenv node model evt =
         model & msgAB ?~ "Function not implemented..." & menuPopup .~ False
       ]
     CloseMsgAB -> [Model $ model & msgAB .~ Nothing & inError .~ False]
-    CloseShowVK -> [Model $ model & vkTypeName .~ "" & vkData .~ ""  & viewingKeyDisplay .~ False]
+    CloseShowVK ->
+      [ Model $
+        model & vkTypeName .~ "" & vkData .~ "" & viewingKeyDisplay .~ False
+      ]
     --
     -- Show Balance in FIAT
     --
     DisplayFIATBalance zpr abal ->
-      [ Model $ model & zPrice .~ zpr & aBal .~ abal & displayFIATBalance .~ True & menuPopup .~ False
+      [ Model $
+        model & zPrice .~ zpr & aBal .~ abal & displayFIATBalance .~ True &
+        menuPopup .~
+        False
       ]
     ShowFIATBalance ->
       if model ^. network == MainNet
-          then [ Task $ sfBalance (model ^. configuration) 
+        then [Task $ sfBalance (model ^. configuration)]
-               ]
         else [ Model $ model & zPrice .~ 0.0 & aBal .~ 0.0
              , Event $ ShowError "Balance conversion not available for TestNet"
              ]
@@ -1626,9 +1771,68 @@ handleEvent wenv node model evt =
     --
     ShowViewingKey vkType vkText ->
       case vkType of
-          VkFull -> [ Model $ model & vkTypeName .~ "Full" & vkData .~ vkText & viewingKeyDisplay .~ True & menuPopup .~ False]
+        VkFull ->
-          VkIncoming -> [ Model $ model & vkTypeName .~ "Incoming" & vkData .~ vkText & viewingKeyDisplay .~ True & menuPopup .~ False]
+          [ Model $
-          VkOutgoing -> [ Model $ model & vkTypeName .~ "Outgoing" & vkData .~ vkText & viewingKeyDisplay .~ True & menuPopup .~ False]
+            model & vkTypeName .~ "Full" & vkData .~ vkText & viewingKeyDisplay .~
+            True &
+            menuPopup .~
+            False
+          ]
+        VkIncoming ->
+          [ Model $
+            model & vkTypeName .~ "Incoming" & vkData .~ vkText &
+            viewingKeyDisplay .~
+            True &
+            menuPopup .~
+            False
+          ]
+    --
+    -- Display PaymentURI Form
+    --
+    DisplayPaymentURI ->
+      [ Model $
+        model & paymentURIDisplay .~ True & uriString .~ "" & menuPopup .~ False
+      ]
+    ClosePaymentURI -> [Model $ model & paymentURIDisplay .~ False]
+    --
+    -- Display Pay using URI Form
+    --
+    DisplayPayUsingURI ->
+      [Model $ model & usepmtURIOverlay .~ True & menuPopup .~ False]
+    ClosePayUsingURI -> [Model $ model & usepmtURIOverlay .~ False]
+    ProcIfValidURI -> do
+      let zp = parseZcashPayment $ T.unpack (model ^. uriString)
+      case zp of
+        Right p -> do
+          case uriAmount p of
+            Just a ->
+              [ Model $
+                model & usepmtURIOverlay .~ False & openSend .~ True &
+                privacyChoice .~
+                Full &
+                recipientValid .~
+                False &
+                sendRecipient .~
+                T.pack (uriAddress p) &
+                sendAmount .~
+                realToFrac a &
+                sendMemo .~
+                (uriMemo p)
+              , Event $ ClosePaymentURI
+              ]
+            Nothing ->
+              [ Model $
+                model & usepmtURIOverlay .~ False & openSend .~ False &
+                uriString .~
+                ""
+              , Event $ ShowError "Invalid URI"
+              ]
+        Left e ->
+          [ Model $
+            model & usepmtURIOverlay .~ False & openSend .~ False & uriString .~
+            ""
+          , Event $ ShowError "Invalid URI"
+          ]
     --
     --
     ShowShield ->
@@ -1643,7 +1847,8 @@ handleEvent wenv node model evt =
       [ Task $ updAddrBookDescrip (model ^. configuration) d a
       , Model $
         model & abdescrip .~ "" & abaddress .~ "" & updateABAddress .~ False &
-        showABAddress .~ False
+        showABAddress .~
+        False
       , Task $ do
           dbPool <- runNoLoggingT $ initPool $ c_dbPath $ model ^. configuration
           abList <- getAdrBook dbPool $ model ^. network
@@ -1798,7 +2003,14 @@ handleEvent wenv node model evt =
         Just zp -> do
           let zbal = (dbal (model ^. balance)) / 100000000
           return $ DisplayFIATBalance zp zbal
-        Nothing -> return $ ShowMessage ( "Currency not supported [" <> c_currencyCode config <> "]")
+        Nothing ->
+          return $
+          ShowMessage
+            ("Currency not supported [" <> c_currencyCode config <> "]")
+    --
+    procIfValidURI :: T.Text -> IO AppEvent
+    procIfValidURI ustr = do
+      return $ ShowSend
 
 scanZebra ::
      T.Text
@@ -2163,6 +2375,9 @@ runZenithGUI config = do
                           False
                           ""
                           ""
+                          False
+                          False
+                          ""
                   startApp model handleEvent buildUI (params hD)
         Left _e -> print "Zebra not available"
   where

src/Zenith/Scanner.hs

@@ -10,6 +10,7 @@ import Control.Monad.Logger
   ( NoLoggingT
   , logErrorN
   , logInfoN
+  , runFileLoggingT
   , runNoLoggingT
   , runStderrLoggingT
   )
@@ -58,6 +59,7 @@ import Zenith.Types
   , ZcashNetDB(..)
   , ZenithStatus(..)
   )
+import Zenith.Types (Config(..), HexStringDB(..), ZcashNetDB(..))
 import Zenith.Utils (jsonNumber)
 
 -- | Function to scan the Zcash blockchain through the Zebra node and populate the Zenith database

src/Zenith/Types.hs

@@ -508,3 +508,12 @@ encodeHexText' t =
   if T.length t > 0
     then C.unpack . B64.encode $ E.encodeUtf8 t
     else C.unpack . B64.encode $ E.encodeUtf8 "Sent from Zenith"
+
+-- | Define a data structure for the parsed components
+data ZcashPaymentURI = ZcashPaymentURI
+  { uriAddress :: String
+  , uriAmount :: Maybe Double
+  , uriMemo :: T.Text
+  , uriLabel :: Maybe String
+  , uriMessage :: Maybe String
+  } deriving (Show, Eq)

src/Zenith/Utils.hs

@@ -2,25 +2,31 @@
 
 module Zenith.Utils where
 
+import Control.Exception (SomeException, try)
+import Control.Monad (when)
 import Data.Aeson
-import Data.Aeson.Types (parseMaybe)
 import qualified Data.Aeson.Key as K
 import qualified Data.Aeson.KeyMap as KM
+import Data.Aeson.Types (parseMaybe)
+import qualified Data.ByteString.Base64 as B64
+import qualified Data.ByteString.Char8 as BC
+import qualified Data.ByteString.Lazy as B
+import qualified Data.ByteString.Lazy.Char8 as BL
 import Data.Char (isAlphaNum, isSpace)
 import Data.Functor (void)
 import Data.Maybe
 import Data.Ord (clamp)
 import Data.Scientific (Scientific(..), scientific)
+import Data.Scientific (Scientific, toRealFloat)
 import qualified Data.Text as T
 import qualified Data.Text.Encoding as E
-import Control.Exception (try, SomeException)
+import qualified Data.Text.Encoding as TE
-import Control.Monad (when)
+import Network.HTTP.Simple
-import qualified Data.ByteString.Lazy as B
-import qualified Data.ByteString.Lazy.Char8 as BL
 import System.Directory
 import System.Process (createProcess_, shell)
-import Text.Regex.Posix
 import Text.Printf (printf)
+import Text.Read (readMaybe)
+import Text.Regex.Posix
 import ZcashHaskell.Orchard
   ( encodeUnifiedAddress
   , isValidUnifiedAddress
@@ -33,10 +39,12 @@ import ZcashHaskell.Transparent
   )
 import ZcashHaskell.Types
   ( ExchangeAddress(..)
+  , ExchangeAddress(..)
   , SaplingAddress(..)
   , TransparentAddress(..)
   , UnifiedAddress(..)
   , ValidAddress(..)
+  , ValidAddress(..)
   , ZcashNet(..)
   )
 import ZcashHaskell.Utils (makeZebraCall)
@@ -45,11 +53,9 @@ import Zenith.Types
   , PrivacyPolicy(..)
   , UnifiedAddressDB(..)
   , ZcashAddress(..)
+  , ZcashPaymentURI(..)
   , ZcashPool(..)
   )
-import Network.HTTP.Simple
-import Data.Scientific (Scientific, toRealFloat)
-
 
 -- | Helper function to convert numbers into JSON
 jsonNumber :: Int -> Value
@@ -263,17 +269,68 @@ getChainTip zHost zPort = do
 -- Function to fetch Zcash price from CoinGecko
 getZcashPrice :: T.Text -> IO (Maybe Double)
 getZcashPrice currency = do
-    let url = "https://api.coingecko.com/api/v3/simple/price?ids=zcash&vs_currencies=" <> T.unpack currency
+  let url =
+        "https://api.coingecko.com/api/v3/simple/price?ids=zcash&vs_currencies=" <>
+        T.unpack currency
   response <- httpJSONEither (parseRequest_ url)
   case getResponseBody response of
-      Right (Object obj) -> do
+    Right (Object obj)
         -- Extract "zcash" object
+     -> do
       case KM.lookup "zcash" obj of
-          Just (Object zcashObj) -> 
+        Just (Object zcashObj)
             -- Extract the currency price
+         ->
           case KM.lookup (K.fromText (T.toLower currency)) zcashObj of
             Just (Number price) -> return (Just (toRealFloat price))
             _ -> return Nothing
         _ -> return Nothing
     _ -> return Nothing
 
+-- Parse memo result to convert it to a ByteString
+processEither :: Either String BC.ByteString -> BC.ByteString
+processEither (Right bs) = bs
+processEither (Left e) = BC.pack e -- Returns the error message
+
+-- Parse the query string into key-value pairs 
+parseQuery :: String -> [(String, String)]
+parseQuery query = map (breakOn '=') (splitOn '&' query)
+  where
+    splitOn :: Char -> String -> [String]
+    splitOn _ [] = [""]
+    splitOn delim (c:cs)
+      | c == delim = "" : rest
+      | otherwise = (c : head rest) : tail rest
+      where
+        rest = splitOn delim cs
+    breakOn :: Char -> String -> (String, String)
+    breakOn delim str = (key, drop 1 value)
+      where
+        (key, value) = span (/= delim) str
+
+-- Parse a ZIP-321 encoded string into a ZcashPayment structure
+parseZcashPayment :: String -> Either String ZcashPaymentURI
+parseZcashPayment input
+  | not (T.isPrefixOf "zcash:"  (T.pack input)) = Left "Invalid scheme: must start with 'zcash:'"
+  | otherwise =
+      let (addrPart, queryPart) = break (== '?') (drop 6 input)
+          queryParams = parseQuery (drop 1 queryPart)
+       in Right ZcashPaymentURI
+            { uriAddress = addrPart
+            , uriAmount  = lookup "amount" queryParams >>= readMaybe
+            , uriMemo    = case lookup "memo" queryParams of
+                            Just m -> T.pack ( BC.unpack (processEither $ decodeBase64Unpadded (BC.pack m)  ) )
+                            _ -> ""
+            , uriLabel   = lookup "label" queryParams
+            , uriMessage = lookup "message" queryParams
+            }
+
+-- Function to pad a base64 string if it's not a multiple of 4
+padBase64 :: BC.ByteString -> BC.ByteString
+padBase64 bs = bs <> BC.replicate paddingLength '='
+  where
+    paddingLength = (4 - BC.length bs `mod` 4) `mod` 4
+
+-- Function to decode a base64 un-padded string
+decodeBase64Unpadded :: BC.ByteString -> Either String BC.ByteString
+decodeBase64Unpadded = B64.decode . padBase64

test/ServerSpec.hs

@@ -58,7 +58,16 @@ main = do
   zebraPort <- require config "zebraPort"
   zebraHost <- require config "zebraHost"
   nodePort <- require config "nodePort"
-  let myConfig = Config dbFilePath zebraHost zebraPort nodeUser nodePwd nodePort
+  currencyCode <- require config "currencyCode"
+  let myConfig =
+        Config
+          dbFilePath
+          zebraHost
+          zebraPort
+          nodeUser
+          nodePwd
+          nodePort
+          currencyCode
   hspec $ do
     describe "RPC methods" $ do
       beforeAll_ (startAPI myConfig) $ do

test/Spec.hs

@@ -645,8 +645,7 @@ main = do
               case ix of
                 Nothing -> assertFailure "couldn't find index at block"
                 Just i -> do
-                  updatedTree <-
+                  updatedTree <- runNoLoggingT $ truncateTree oTree i
-                    runNoLoggingT $ truncateTree oTree i
                   let finalAnchor =
                         getOrchardTreeAnchor $
                         OrchardCommitmentTree $ ztiOrchard zebraTreesIn
@@ -1111,3 +1110,31 @@ main = do
         case price of
           Just p -> p `shouldNotBe` 0.0
           Nothing -> assertFailure "Failed to get ZEC price"
+    describe "Parse an URI payment string (all fields filled) " $ do
+      it ("Parsing URI -> " ++ "zcash:ztestsapling10yy2ex5....") $ do
+        let zcashURI2 =
+              "zcash:ztestsapling10yy2ex5dcqkclhc7z7yrnjq2z6feyjad56ptwlfgmy77dmaqqrl9gyhprdx59qgmsnyfska2kez?amount=100&memo=SGVsbG8sIFdvcmxkIQ==&message=Test"
+        case parseZcashPayment zcashURI2 of
+          Right p -> do
+            print p
+            (uriAmount p) `shouldBe` Just 100.0
+          Left e -> assertFailure $ "Error: " ++ e
+    describe
+      "Parse an URI payment string (just address and amount fields provided) " $ do
+      it ("Parsing URI -> " ++ "zcash:ztestsapling10yy2ex5....") $ do
+        let zcashURI3 =
+              "zcash:ztestsapling10yy2ex5dcqkclhc7z7yrnjq2z6feyjad56ptwlfgmy77dmaqqrl9gyhprdx59qgmsnyfska2kez?amount=100"
+        case parseZcashPayment zcashURI3 of
+          Right p -> do
+            print p
+            (uriAmount p) `shouldBe` Just 100.0
+          Left e -> assertFailure $ "Error: " ++ e
+    describe "Parse an URI payment string (invalid URI provided) " $ do
+      it ("Parsing URI -> " ++ "zcash:ztestsapling10yy2ex5....") $ do
+        let zcashURI3 =
+              "z:ztestsapling10yy2ex5dcqkclhc7z7yrnjq2z6feyjad56ptwlfgmy77dmaqqrl9gyhprdx59qgmsnyfska2kez?amount=100"
+        case parseZcashPayment zcashURI3 of
+          Right p -> do
+            print p
+            (uriAmount p) `shouldBe` Just 100.0
+          Left e -> assertFailure $ "Error: " ++ e

zcash-haskell

@@ -1 +1 @@
-Subproject commit 7d3ae36d2b48b8ed91a70e40a77fb7efe57765a0
+Subproject commit cfa862ec9495e810e7296fa6fe724b46dbe0ee52