rvv001 - Issue 085 - [Zenith GUI] Read a payment URI

Send TX windows working
         Closing the URI form is not working

src/Zenith/GUI.hs

@@ -77,6 +77,7 @@ import Zenith.Utils
   , showAddress
   , validBarValue
   , getZcashPrice
+  , parseZcashPayment
   )
 
 data VkTypeDef
@@ -164,6 +165,9 @@ data AppEvent
   | CloseShowVK
   | DisplayPaymentURI
   | ClosePaymentURI
+  | DisplayPayUsingURI
+  | ClosePayUsingURI
+  | ProcIfValidURI
   deriving (Eq, Show)
 
 data AppModel = AppModel
@@ -231,6 +235,8 @@ data AppModel = AppModel
   , _vkTypeName :: !T.Text
   , _vkData :: !T.Text
   , _paymentURIDisplay :: !Bool
+  , _usepmtURIOverlay :: !Bool
+  , _uriString :: !T.Text
   } deriving (Eq, Show)
 
 makeLenses ''AppModel
@@ -267,6 +273,7 @@ buildUI wenv model = widgetTree
         [ mainWindow
         , confirmOverlay `nodeVisible` isJust (model ^. confirmTitle)
         , seedOverlay `nodeVisible` model ^. showSeed
+        , paymentURIOverlay `nodeVisible` model ^. paymentURIDisplay
         , txOverlay `nodeVisible` isJust (model ^. showTx)
         , sendTxOverlay `nodeVisible` model ^. openSend
         , txIdOverlay `nodeVisible` isJust (model ^. showId)
@@ -282,7 +289,7 @@ 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)
@@ -374,6 +381,8 @@ buildUI wenv model = widgetTree
              [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]
     newBox =
@@ -1255,8 +1264,42 @@ buildUI wenv model = widgetTree
            , filler
            ]) `styleBasic`
       [bgColor (white & L.a .~ 0.5)]
-
+    pmtUsingURIOverlay =
-notImplemented = NotImplemented
+      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
@@ -1687,11 +1730,43 @@ handleEvent wenv node model evt =
         case vkType of
           VkFull -> [ Model $ 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 & menuPopup .~ False]
+    DisplayPaymentURI -> [ Model $ model & paymentURIDisplay .~ True & uriString .~ "" & menuPopup .~ False]
     ClosePaymentURI -> [Model $ model & paymentURIDisplay .~ False]
+    ProcIfValidURI -> do 
+      [Model $ model & paymentURIDisplay .~ False ]
+      let zp = parseZcashPayment  $ T.unpack (model ^. uriString)
+      case zp of
+         Right p -> do 
+            case uriAmount p of 
+              Just a ->
+                [ Model $ model & paymentURIDisplay .~ False
+                                & openSend .~ True 
+                                & privacyChoice .~ Full 
+                                & recipientValid .~ False 
+                                & sendRecipient .~ T.pack ( uriAddress p ) 
+                                & sendAmount .~ realToFrac a
+                                & sendMemo .~ (uriMemo p)
+                , Event $ ClosePaymentURI 
+                ]
+              Nothing -> 
+                [ Model $ model & paymentURIDisplay .~ False 
+                                & openSend .~ False 
+                                & uriString .~ ""
+                , Event $ ShowError "Invalid URI"
+                ]
+         Left e -> [ Model $ model & paymentURIDisplay .~ False 
+                                   & openSend .~ False 
+                                   & uriString .~ ""
+                   , Event $ ShowError "Invalid URI"
+                   ]
+    --
+    -- Display Pay using URI Form
+    --
+    DisplayPayUsingURI -> [ Model $ model & usepmtURIOverlay.~ True & menuPopup .~ False]
+    ClosePayUsingURI -> [Model $ model & usepmtURIOverlay .~ False]
     --
     --
     ShowShield ->
@@ -1737,6 +1812,7 @@ handleEvent wenv node model evt =
               (entityKey acc)
           , Event CloseShield
           ]
+            
   where
     currentWallet =
       if null (model ^. wallets)
@@ -1862,6 +1938,12 @@ handleEvent wenv node model evt =
           let zbal = ( dbal (model ^. balance) ) / 100000000
           return $ DisplayFIATBalance zp zbal
         Nothing -> return $ ShowMessage ( "Currency not supported [" <> c_currencyCode config <> "]")
+    --
+    procIfValidURI :: T.Text -> IO AppEvent
+    procIfValidURI ustr = do 
+      return $ ShowSend
+
+
 
 scanZebra ::
      T.Text
@@ -2227,6 +2309,8 @@ runZenithGUI config = do
                           ""
                           ""
                           False
+                          False
+                          ""
                   startApp model handleEvent buildUI (params hD)
         Left _e -> print "Zebra not available"
   where

src/Zenith/Types.hs

@@ -513,7 +513,7 @@ encodeHexText' t =
 data ZcashPaymentURI = ZcashPaymentURI
   { uriAddress :: String
   , uriAmount  :: Maybe Double
-  , uriMemo    :: C.ByteString
+  , uriMemo    :: T.Text
   , uriLabel   :: Maybe String
   , uriMessage :: Maybe String
   } deriving (Show, Eq)

src/Zenith/Utils.hs

@@ -314,7 +314,7 @@ parseZcashPayment input
             { uriAddress = addrPart
             , uriAmount  = lookup "amount" queryParams >>= readMaybe
             , uriMemo    = case lookup "memo" queryParams of
-                            Just m -> processEither $ B64.decode $ BC.pack m 
+                            Just m -> T.pack ( BC.unpack (processEither $ B64.decode $ BC.pack m ) )
                             _ -> ""
             , uriLabel   = lookup "label" queryParams
             , uriMessage = lookup "message" queryParams