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

Send TX windows working
         Closing the URI form is not working
This commit is contained in:
Rene V. Vergara 2025-01-02 13:28:08 -05:00
parent 02ec4716e9
commit 6b3ea31882
3 changed files with 112 additions and 28 deletions

View file

@ -77,10 +77,11 @@ import Zenith.Utils
, showAddress , showAddress
, validBarValue , validBarValue
, getZcashPrice , getZcashPrice
, parseZcashPayment
) )
data VkTypeDef data VkTypeDef
= VkNone = VkNone
| VkFull | VkFull
| VkIncoming | VkIncoming
deriving (Eq, Show) deriving (Eq, Show)
@ -156,14 +157,17 @@ data AppEvent
| SendShield | SendShield
| StartSync | StartSync
| TreeSync | TreeSync
| ShowFIATBalance | ShowFIATBalance
| DisplayFIATBalance Double Double | DisplayFIATBalance Double Double
| CloseFIATBalance | CloseFIATBalance
| ShowViewingKey !VkTypeDef !T.Text | ShowViewingKey !VkTypeDef !T.Text
| CopyViewingKey !T.Text !T.Text | CopyViewingKey !T.Text !T.Text
| CloseShowVK | CloseShowVK
| DisplayPaymentURI | DisplayPaymentURI
| ClosePaymentURI | ClosePaymentURI
| DisplayPayUsingURI
| ClosePayUsingURI
| ProcIfValidURI
deriving (Eq, Show) deriving (Eq, Show)
data AppModel = AppModel data AppModel = AppModel
@ -223,7 +227,7 @@ data AppModel = AppModel
, _tBalanceValid :: !Bool , _tBalanceValid :: !Bool
, _sBalance :: !Integer , _sBalance :: !Integer
, _sBalanceValid :: !Bool , _sBalanceValid :: !Bool
, _displayFIATBalance :: !Bool , _displayFIATBalance :: !Bool
, _zPrice :: !Double , _zPrice :: !Double
, _aBal :: !Double , _aBal :: !Double
, _viewingKeyPopup :: !Bool , _viewingKeyPopup :: !Bool
@ -231,6 +235,8 @@ data AppModel = AppModel
, _vkTypeName :: !T.Text , _vkTypeName :: !T.Text
, _vkData :: !T.Text , _vkData :: !T.Text
, _paymentURIDisplay :: !Bool , _paymentURIDisplay :: !Bool
, _usepmtURIOverlay :: !Bool
, _uriString :: !T.Text
} deriving (Eq, Show) } deriving (Eq, Show)
makeLenses ''AppModel makeLenses ''AppModel
@ -267,6 +273,7 @@ buildUI wenv model = widgetTree
[ mainWindow [ mainWindow
, confirmOverlay `nodeVisible` isJust (model ^. confirmTitle) , confirmOverlay `nodeVisible` isJust (model ^. confirmTitle)
, seedOverlay `nodeVisible` model ^. showSeed , seedOverlay `nodeVisible` model ^. showSeed
, paymentURIOverlay `nodeVisible` model ^. paymentURIDisplay
, txOverlay `nodeVisible` isJust (model ^. showTx) , txOverlay `nodeVisible` isJust (model ^. showTx)
, sendTxOverlay `nodeVisible` model ^. openSend , sendTxOverlay `nodeVisible` model ^. openSend
, txIdOverlay `nodeVisible` isJust (model ^. showId) , txIdOverlay `nodeVisible` isJust (model ^. showId)
@ -282,7 +289,7 @@ buildUI wenv model = widgetTree
model ^. model ^.
updateABAddress updateABAddress
, showVKOverlay `nodeVisible` model ^. viewingKeyDisplay , showVKOverlay `nodeVisible` model ^. viewingKeyDisplay
, paymentURIOverlay `nodeVisible` model ^. paymentURIDisplay , pmtUsingURIOverlay `nodeVisible` model ^. usepmtURIOverlay
, shieldOverlay `nodeVisible` model ^. shieldZec , shieldOverlay `nodeVisible` model ^. shieldZec
, deShieldOverlay `nodeVisible` model ^. deShieldZec , deShieldOverlay `nodeVisible` model ^. deShieldZec
, msgAdrBookOverlay `nodeVisible` isJust (model ^. msgAB) , msgAdrBookOverlay `nodeVisible` isJust (model ^. msgAB)
@ -354,7 +361,7 @@ buildUI wenv model = widgetTree
[bgColor white, borderB 1 gray, padding 3] [bgColor white, borderB 1 gray, padding 3]
, box_ [alignLeft, onClick ShowDeShield] (label "De-Shield ZEC") `styleBasic` , box_ [alignLeft, onClick ShowDeShield] (label "De-Shield ZEC") `styleBasic`
[bgColor white, borderB 1 gray, padding 3] [bgColor white, borderB 1 gray, padding 3]
, box_ , box_
[alignLeft] [alignLeft]
(vstack (vstack
[ box_ [ box_
@ -374,6 +381,8 @@ buildUI wenv model = widgetTree
[bgColor white, borderB 1 gray, padding 3] [bgColor white, borderB 1 gray, padding 3]
, box_ [alignLeft, onClick DisplayPaymentURI] (label "Create URI") `styleBasic` , box_ [alignLeft, onClick DisplayPaymentURI] (label "Create URI") `styleBasic`
[bgColor white, borderB 1 gray, padding 3] [bgColor white, borderB 1 gray, padding 3]
, box_ [alignLeft, onClick DisplayPayUsingURI] (label "Pay using URI") `styleBasic`
[bgColor white, borderB 1 gray, padding 3]
]) `styleBasic` ]) `styleBasic`
[bgColor btnColor, padding 3] [bgColor btnColor, padding 3]
newBox = newBox =
@ -1052,9 +1061,9 @@ buildUI wenv model = widgetTree
, label_ (txtWrapN (fromMaybe "" (model ^. msgAB)) 64) [multiline] , label_ (txtWrapN (fromMaybe "" (model ^. msgAB)) 64) [multiline]
, filler , filler
] ]
dfBalOverlay = dfBalOverlay =
alert CloseFIATBalance $ alert CloseFIATBalance $
vstack vstack
[ box_ [ box_
[] []
(label ("Account Balance in " <> (T.toUpper (c_currencyCode (model ^. configuration))) ) `styleBasic` (label ("Account Balance in " <> (T.toUpper (c_currencyCode (model ^. configuration))) ) `styleBasic`
@ -1062,10 +1071,10 @@ buildUI wenv model = widgetTree
[bgColor btnColor, radius 2, padding 3] [bgColor btnColor, radius 2, padding 3]
, filler , 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 , 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 = showVKOverlay =
alert CloseShowVK $ alert CloseShowVK $
vstack vstack
[ box_ [ box_
@ -1245,7 +1254,7 @@ buildUI wenv model = widgetTree
[ spacer [ spacer
, mainButton "Create URI" NotImplemented `nodeEnabled` True , mainButton "Create URI" NotImplemented `nodeEnabled` True
, spacer , spacer
, button "Cancel" ClosePaymentURI , button "Cancel" ClosePaymentURI
, spacer , spacer
]) ])
]) `styleBasic` ]) `styleBasic`
@ -1255,8 +1264,42 @@ buildUI wenv model = widgetTree
, filler , filler
]) `styleBasic` ]) `styleBasic`
[bgColor (white & L.a .~ 0.5)] [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 -> IO ()
generateQRCodes config = do generateQRCodes config = do
@ -1380,8 +1423,8 @@ handleEvent wenv node model evt =
] ]
ConfirmCancel -> [Model $ model & confirmTitle .~ Nothing & mainInput .~ ""] ConfirmCancel -> [Model $ model & confirmTitle .~ Nothing & mainInput .~ ""]
ViewingKeysClicked -> [Model $ model & viewingKeyPopup .~ not (model ^. viewingKeyPopup)] ViewingKeysClicked -> [Model $ model & viewingKeyPopup .~ not (model ^. viewingKeyPopup)]
NewAddress vk -> NewAddress vk ->
[ Model $ [ Model $
model & confirmTitle ?~ "New Address" & model & confirmTitle ?~ "New Address" &
confirmCancel .~ "Cancel" & menuPopup .~ False confirmCancel .~ "Cancel" & menuPopup .~ False
] ]
@ -1661,7 +1704,7 @@ handleEvent wenv node model evt =
] ]
ShowMessage a -> [Model $ model & msgAB ?~ a & menuPopup .~ False] ShowMessage a -> [Model $ model & msgAB ?~ a & menuPopup .~ False]
NotImplemented -> NotImplemented ->
[ Model $ [ Model $
model & msgAB ?~ "Function not implemented..." & menuPopup .~ False model & msgAB ?~ "Function not implemented..." & menuPopup .~ False
] ]
CloseMsgAB -> [Model $ model & msgAB .~ Nothing & inError .~ False] CloseMsgAB -> [Model $ model & msgAB .~ Nothing & inError .~ False]
@ -1672,26 +1715,58 @@ handleEvent wenv node model evt =
DisplayFIATBalance zpr abal -> DisplayFIATBalance zpr abal ->
[ Model $ model & zPrice .~ zpr & aBal .~ abal & displayFIATBalance .~ True & menuPopup .~ False [ Model $ model & zPrice .~ zpr & aBal .~ abal & displayFIATBalance .~ True & menuPopup .~ False
] ]
ShowFIATBalance -> ShowFIATBalance ->
if model ^. network == MainNet if model ^. network == MainNet
then [ Task $ sfBalance (model ^. configuration) then [ Task $ sfBalance (model ^. configuration)
] ]
else [ Model $ model & zPrice .~ 0.0 & aBal .~ 0.0 else [ Model $ model & zPrice .~ 0.0 & aBal .~ 0.0
, Event $ ShowError "Balance conversion not available for TestNet" , Event $ ShowError "Balance conversion not available for TestNet"
] ]
CloseFIATBalance -> [Model $ model & displayFIATBalance .~ False] CloseFIATBalance -> [Model $ model & displayFIATBalance .~ False]
-- --
-- Show Viewing Keys -- Show Viewing Keys
-- --
ShowViewingKey vkType vkText -> ShowViewingKey vkType vkText ->
case vkType of case vkType of
VkFull -> [ Model $ model & vkTypeName .~ "Full" & vkData .~ vkText & viewingKeyDisplay .~ True & menuPopup .~ False] VkFull -> [ Model $ model & vkTypeName .~ "Full" & vkData .~ vkText & viewingKeyDisplay .~ True & menuPopup .~ False]
VkIncoming -> [ Model $ model & vkTypeName .~ "Incoming" & vkData .~ vkText & viewingKeyDisplay .~ True & menuPopup .~ False] VkIncoming -> [ Model $ model & vkTypeName .~ "Incoming" & vkData .~ vkText & viewingKeyDisplay .~ True & menuPopup .~ False]
-- --
-- Display PaymentURI Form -- Display PaymentURI Form
-- --
DisplayPaymentURI -> [ Model $ model & paymentURIDisplay .~ True & menuPopup .~ False] DisplayPaymentURI -> [ Model $ model & paymentURIDisplay .~ True & uriString .~ "" & menuPopup .~ False]
ClosePaymentURI -> [Model $ model & paymentURIDisplay .~ 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 -> ShowShield ->
@ -1737,6 +1812,7 @@ handleEvent wenv node model evt =
(entityKey acc) (entityKey acc)
, Event CloseShield , Event CloseShield
] ]
where where
currentWallet = currentWallet =
if null (model ^. wallets) if null (model ^. wallets)
@ -1860,8 +1936,14 @@ handleEvent wenv node model evt =
case zpr of case zpr of
Just zp -> do Just zp -> do
let zbal = ( dbal (model ^. balance) ) / 100000000 let zbal = ( dbal (model ^. balance) ) / 100000000
return $ DisplayFIATBalance zp zbal 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 :: scanZebra ::
T.Text T.Text
@ -2227,6 +2309,8 @@ runZenithGUI config = do
"" ""
"" ""
False False
False
""
startApp model handleEvent buildUI (params hD) startApp model handleEvent buildUI (params hD)
Left _e -> print "Zebra not available" Left _e -> print "Zebra not available"
where where

View file

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

View file

@ -314,7 +314,7 @@ parseZcashPayment input
{ uriAddress = addrPart { uriAddress = addrPart
, uriAmount = lookup "amount" queryParams >>= readMaybe , uriAmount = lookup "amount" queryParams >>= readMaybe
, uriMemo = case lookup "memo" queryParams of , 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 , uriLabel = lookup "label" queryParams
, uriMessage = lookup "message" queryParams , uriMessage = lookup "message" queryParams