rvv001 - Issue 0085 - URI support implemented in GUI

- Support to generate a ZIP-321 formatted string
		      using a Transparent, Sapling or Unified address
 		      is available.

src/Zenith/GUI.hs

@@ -77,6 +77,7 @@ import Zenith.Utils
   , validBarValue
   , parseZcashPayment
   , getZcashPrice
+  , createZip321
   )
 
 data VkTypeDef
@@ -165,15 +166,16 @@ data AppEvent
   | ShowViewingKey !VkTypeDef !T.Text
   | CopyViewingKey !T.Text !T.Text
   | CloseShowVK
-  | DisplayPaymentURIForm
+  | DisplayPaymentURIForm !T.Text
   | ClosePaymentURIForm
   | PrepareURIString
-  | IsAmountValid !Float
   | CloseShowURIOverlay
+  | ShowURIOverlay !T.Text
   | CopyURIString !T.Text
   | DisplayPayUsingURI
   | ClosePayUsingURI
   | ProcIfValidURI
+  | PreparePaymentURIForm
   deriving (Eq, Show)
 
 data AppModel = AppModel
@@ -244,6 +246,7 @@ data AppModel = AppModel
   , _showURIDisplay :: !Bool
   , _usepmtURIOverlay :: !Bool
   , _uriString :: !T.Text
+  , _uriAddr :: !T.Text
   } deriving (Eq, Show)
 
 makeLenses ''AppModel
@@ -392,7 +395,7 @@ buildUI wenv model = widgetTree
                   ("Balance in " <>
                    T.toUpper (c_currencyCode (model ^. configuration)))) `styleBasic`
              [bgColor white, borderB 1 gray, padding 3]
-           , box_ [alignLeft, onClick DisplayPaymentURIForm ] (label "Create URI") `styleBasic`
+           , box_ [alignLeft, onClick PreparePaymentURIForm] (label "Create URI") `styleBasic`
              [bgColor white, borderB 1 gray, padding 3]
            , box_
                [alignLeft, onClick DisplayPayUsingURI]
@@ -1256,10 +1259,18 @@ buildUI wenv model = widgetTree
              [textFont "Bold", textColor white, textSize 10, padding 3]) `styleBasic`
           [bgColor btnColor, radius 2, padding 3]
         , spacer
+        , hstack
+            [ filler
+            , label "Current Address:" `styleBasic` [textFont "Bold"]
+            , spacer
+            , label_ (txtWrapN (model ^. uriAddr) 64) [multiline]
+            , filler
+            ]
+        , spacer
         , hstack
             [ label "Amount : " `styleBasic` [textFont "Bold"]
             , numericField_ sendAmount
-              [ decimals 8 ] 
+              [ decimals 8 ]
                 `nodeKey` "floatInput"
                 `styleBasic`
                    [ width 150
@@ -1693,12 +1704,7 @@ handleEvent wenv node model evt =
         model & amountValid .~
         (i < (fromIntegral (model ^. balance) / 100000000.0))
       ]
-    --  
+    -- 
-    IsAmountValid k ->
-      if (k > 0.0) && (k < (fromIntegral (model ^. balance) / 100000000.0))
-        then [ Model $ model & amountValid .~ True ]
-        else [ Model $ model & amountValid .~ False ]
-    --
     ShowTxId tx -> [Model $ model & showId ?~ tx & modalMsg .~ Nothing]
     -- |
     -- | Address Book Events
@@ -1824,9 +1830,13 @@ handleEvent wenv node model evt =
     --
     -- Display PaymentURI Form
     --
-    DisplayPaymentURIForm ->
+    PreparePaymentURIForm ->
+      [ Task $ getCurrentAddress currentAddress ]
+    -- 
+    DisplayPaymentURIForm ua->
       [ Model $
         model & uriString .~ ""
+              & uriAddr .~ ua
               & amountValid .~ False
               & sendAmount .~ 0.0
               & sendMemo .~ ""
@@ -1837,7 +1847,13 @@ handleEvent wenv node model evt =
     --
     -- Generate URI 
     --
-    PrepareURIString -> [ Task $ genURIString (model ^. sendAmount) (model ^. sendMemo) ]
+    PrepareURIString -> [ Task $ genURIString (model ^. uriAddr) (model ^. sendAmount) (model ^. sendMemo) ]
+    ShowURIOverlay uStr ->
+      [ Model $
+        model & uriString .~ uStr 
+              & paymentURIDisplay .~ False
+              & showURIDisplay .~ True
+      ]
     CloseShowURIOverlay -> [ Model $ model & showURIDisplay .~ False & uriString .~ "" ]
     --
     -- Display Pay using URI Form
@@ -2082,11 +2098,27 @@ handleEvent wenv node model evt =
             ivk <- deriveUivk n osk ssk tsk
             return $ ShowViewingKey VkIncoming ivk
     --
+    -- Get curret zcash address 
+    --   
+    getCurrentAddress :: Maybe (Entity WalletAddress) -> IO AppEvent
+    getCurrentAddress  a = do
+      let ua = case model ^. selPool of
+                OrchardPool -> maybe "None" (getUA . walletAddressUAddress . entityVal) a
+                SaplingPool -> fromMaybe "None" $ (getSaplingFromUA . E.encodeUtf8 . getUA . walletAddressUAddress . entityVal) =<< a
+                SproutPool -> "None"
+                TransparentPool -> maybe "None" (encodeTransparentReceiver (model ^. network)) $
+                  t_rec =<< (isValidUnifiedAddress . E.encodeUtf8 . getUA . walletAddressUAddress . entityVal) =<< a
+      return $ DisplayPaymentURIForm ua  
+    --
     -- Gen URI String
-    --         
+    --   
-    genURIString :: Float -> T.Text -> IO AppEvent
+    genURIString :: T.Text ->  Float -> T.Text -> IO AppEvent
-    genURIString mAmt mMemo = do
+    genURIString addr mAmt mMemo = do
-        return $ ShowMessage "Prueba de URI"
+      let mM = case mMemo of
+                  "" -> Nothing
+                  _  -> Just (T.unpack mMemo) 
+      let uriSt = createZip321 (T.unpack addr) (Just (realToFrac mAmt)) mM 
+      return $ ShowURIOverlay (T.pack uriSt)
 
 scanZebra ::
      T.Text
@@ -2442,6 +2474,7 @@ runZenithGUI config = do
                           False
                           False
                           ""
+                          ""
                   startApp model handleEvent buildUI (params hD)
         Left _e -> print "Zebra not available"
   where

src/Zenith/Utils.hs

@@ -337,12 +337,20 @@ decodeBase64Unpadded :: BC.ByteString -> Either String BC.ByteString
 decodeBase64Unpadded = B64.decode . padBase64
 
 -- Function to encode memo as un-padded Base64
-encodeMemo :: String -> String
+encodeBase64Memo :: String -> String
-encodeMemo = BC.unpack . BC.takeWhile (/= '=') . B64.encode . BC.pack
+encodeBase64Memo = BC.unpack . BC.takeWhile (/= '=') . B64.encode . BC.pack
+
+-- Function to drop trailing zeros 
+dropTrailingZeros :: String -> String
+dropTrailingZeros str =
+    let withoutZeros = reverse (dropWhile (== '0') (reverse str))
+    in if last withoutZeros == '.' 
+           then withoutZeros ++ "0"  -- Ensure at least one decimal place
+           else withoutZeros
 
 -- Function to create a ZIP-321 URI
 createZip321 :: String -> Maybe Double -> Maybe String -> String
 createZip321 address mAmount mMemo =
   "zcash:" ++ address
-    ++ maybe "" (\amount -> "?amount=" ++ show amount) mAmount
+    ++ maybe "" (\amount -> "?amount=" ++ dropTrailingZeros (printf "%.8f" amount) ) mAmount
-    ++ maybe "" (\memo -> "&memo=" ++ escapeURIString isUnreserved (encodeMemo memo)) mMemo
+    ++ maybe "" (\memo -> "&memo=" ++ escapeURIString isUnreserved (encodeBase64Memo memo)) mMemo