From 149d74d4e298196ed95228e5b28393c8e96165fa Mon Sep 17 00:00:00 2001 From: "Rene V. Vergara" Date: Sat, 11 Jan 2025 20:02:29 -0500 Subject: [PATCH] rvv001 -> Payment URI generation : Form to capture payment data ready. --- src/Zenith/GUI.hs | 241 +++++++++++++--------------------------------- 1 file changed, 65 insertions(+), 176 deletions(-) diff --git a/src/Zenith/GUI.hs b/src/Zenith/GUI.hs index fe4aca6..2dc6fba 100644 --- a/src/Zenith/GUI.hs +++ b/src/Zenith/GUI.hs @@ -33,7 +33,6 @@ import Database.Persist import Lens.Micro ((&), (+~), (.~), (?~), (^.), set) import Lens.Micro.TH import Monomer - import qualified Monomer.Lens as L import System.Directory (getHomeDirectory) import System.FilePath (()) @@ -69,15 +68,15 @@ import Zenith.Types hiding (ZcashAddress(..)) import Zenith.Utils ( displayAmount , getChainTip - , getZcashPrice , isRecipientValidGUI , isValidString , isZecAddressValid , jsonNumber , padWithZero - , parseZcashPayment , showAddress , validBarValue + , parseZcashPayment + , getZcashPrice ) data VkTypeDef @@ -96,7 +95,6 @@ data AppEvent | AccountClicked | MenuClicked | NewClicked - | ViewingKeysClicked | NewAddress !(Maybe (Entity ZcashAccount)) | NewInternalAddress !(Maybe (Entity ZcashAccount)) | NewAccount !(Maybe (Entity ZcashWallet)) @@ -162,14 +160,15 @@ data AppEvent | ShowFIATBalance | DisplayFIATBalance Double Double | CloseFIATBalance + | ViewingKeysClicked | PrepareViewingKey !VkTypeDef !(Maybe (Entity ZcashAccount)) | ShowViewingKey !VkTypeDef !T.Text | CopyViewingKey !T.Text !T.Text | CloseShowVK | DisplayPaymentURIForm | ClosePaymentURIForm - | GenURIString - | CheckAmountURI !Float + | PrepareURIString + | IsAmountValid !Float | CloseShowURIOverlay | CopyURIString !T.Text | DisplayPayUsingURI @@ -288,19 +287,19 @@ buildUI wenv model = widgetTree , modalOverlay `nodeVisible` isJust (model ^. modalMsg) , adrbookOverlay `nodeVisible` model ^. showAdrBook , newAdrBkOverlay `nodeVisible` model ^. newAdrBkEntry - , dfBalOverlay `nodeVisible` model ^. displayFIATBalance , showABAddressOverlay (model ^. abdescrip) (model ^. abaddress) `nodeVisible` model ^. showABAddress , updateABAddressOverlay (model ^. abdescrip) (model ^. abaddress) `nodeVisible` model ^. updateABAddress + , shieldOverlay `nodeVisible` model ^. shieldZec + , deShieldOverlay `nodeVisible` model ^. deShieldZec + , dfBalOverlay `nodeVisible` model ^. displayFIATBalance , showVKOverlay `nodeVisible` model ^. viewingKeyDisplay , paymentURIOverlay `nodeVisible` model ^. paymentURIDisplay , showURIOverlay `nodeVisible` model ^. showURIDisplay , pmtUsingURIOverlay `nodeVisible` model ^. usepmtURIOverlay - , shieldOverlay `nodeVisible` model ^. shieldZec - , deShieldOverlay `nodeVisible` model ^. deShieldZec , msgAdrBookOverlay `nodeVisible` isJust (model ^. msgAB) ] mainWindow = @@ -393,7 +392,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 DisplayPaymentURIForm ] (label "Create URI") `styleBasic` [bgColor white, borderB 1 gray, padding 3] , box_ [alignLeft, onClick DisplayPayUsingURI] @@ -1247,153 +1246,41 @@ buildUI wenv model = widgetTree , filler ]) `styleBasic` [bgColor (white & L.a .~ 0.5)] + -- paymentURIOverlay = - box - (vstack - [ filler - , hstack - [ filler - , box_ - [] - (vstack - [ box_ - [alignMiddle] - (label "Create URI" `styleBasic` - [textFont "Bold", textSize 12]) - , separatorLine `styleBasic` [fgColor btnColor] - , spacer - , hstack - [ label "Privacy Level:" `styleBasic` - [width 70, textFont "Bold"] - , spacer - , label "Full " `styleBasic` [width 40] - , radio Full privacyChoice - , spacer - , label "Medium " `styleBasic` [width 40] - , radio Medium privacyChoice - ] - , hstack - [ label " " `styleBasic` - [width 70, textFont "Bold"] - , spacer - , label "Low " `styleBasic` [width 40] - , radio Low privacyChoice - , spacer - , label "None " `styleBasic` [width 40] - , radio None privacyChoice - ] - , spacer - , hstack - [ label "To:" `styleBasic` [width 50, textFont "Bold"] - , spacer - , textField_ sendRecipient [onChange CheckRecipient] `styleBasic` - [ width 150 - , styleIf - (not $ model ^. recipientValid) - (textColor red) - ] - ] - , 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 - -- Radio button group for privacy level - , box_ - [alignMiddle] - (hstack - [ spacer - , button "Cancel" ClosePaymentURIForm - , spacer - , mainButton "Send" SendTx `nodeEnabled` False - , spacer - ]) - ]) `styleBasic` - [radius 4, border 2 btnColor, bgColor white, padding 4] - , filler - ] - , filler - ]) `styleBasic` - [bgColor (white & L.a .~ 0.5)] - -- 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 CheckAmountURI - -- ] `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" ClosePaymentURIForm - -- , spacer - -- ]) - -- ]) `styleBasic` - -- [radius 4, border 2 btnColor, bgColor white, padding 4] - -- , filler - -- ] - -- , filler - -- ]) `styleBasic` - -- [bgColor (white & L.a .~ 0.5)] + alert ClosePaymentURIForm $ + vstack + [ box_ + [] + (label "Create a Payment URI" `styleBasic` + [textFont "Bold", textColor white, textSize 10, padding 3]) `styleBasic` + [bgColor btnColor, radius 2, padding 3] + , spacer + , hstack + [ label "Amount : " `styleBasic` [textFont "Bold"] + , numericField_ sendAmount + [ decimals 8 ] + `nodeKey` "floatInput" + `styleBasic` + [ width 150 + , styleIf (model ^. sendAmount <= 0.0) (textColor red) + ] + ] + , spacer + , hstack + [ label "Memo: " `styleBasic` [textFont "Bold"] + , spacer + , textField_ sendMemo [] `styleBasic` [width 300] + ] + , spacer + , hstack + [ filler + , mainButton "Create URI" PrepareURIString `nodeEnabled` + (model ^. sendAmount > 0.0) + , filler + ] + ] `styleBasic` [bgColor (white & L.a .~ 0.5)] + -- showURIOverlay = alert CloseShowURIOverlay $ vstack @@ -1409,7 +1296,7 @@ buildUI wenv model = widgetTree , hstack [ filler , button "Copy to Clipboard" $ - CopyURIString (model ^. uriString) + CopyURIString (model ^. uriString) , filler ] ] @@ -1806,10 +1693,12 @@ handleEvent wenv node model evt = model & amountValid .~ (i < (fromIntegral (model ^. balance) / 100000000.0)) ] - CheckAmountURI i -> - [ Model $ - 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 @@ -1920,16 +1809,16 @@ handleEvent wenv node model evt = -- ShowViewingKey vkType vkText -> case vkType of - VkFull -> [ Model $ + VkFull -> [ Model $ model & vkTypeName .~ "Full" & vkData .~ vkText & viewingKeyDisplay .~ True & menuPopup .~ False ] VkIncoming -> [ Model $ - model & vkTypeName .~ "Incoming" + model & vkTypeName .~ "Incoming" & vkData .~ vkText - & viewingKeyDisplay .~ True + & viewingKeyDisplay .~ True & menuPopup .~ False ] -- @@ -1937,18 +1826,18 @@ handleEvent wenv node model evt = -- DisplayPaymentURIForm -> [ Model $ - model & paymentURIDisplay .~ True - & uriString .~ "" - & amountValid .~ False + model & uriString .~ "" + & amountValid .~ False & sendAmount .~ 0.0 & sendMemo .~ "" + & paymentURIDisplay .~ True & menuPopup .~ False ] ClosePaymentURIForm -> [Model $ model & paymentURIDisplay .~ False] -- -- Generate URI -- - GenURIString -> [ Task $ genURIString (model ^. sendAmount) (model ^. sendMemo) ] + PrepareURIString -> [ Task $ genURIString (model ^. sendAmount) (model ^. sendMemo) ] CloseShowURIOverlay -> [ Model $ model & showURIDisplay .~ False & uriString .~ "" ] -- -- Display Pay using URI Form @@ -2176,9 +2065,9 @@ handleEvent wenv node model evt = Just acc -> do let osk = getOrchSK $ zcashAccountOrchSpendKey $ entityVal acc let ssk = getSapSK $ zcashAccountSapSpendKey $ entityVal acc - let tsk = getTranSK $ zcashAccountTPrivateKey $ entityVal acc - fvk <- deriveUfvk n osk ssk tsk - return $ ShowViewingKey VkFull fvk + let tsk = getTranSK $ zcashAccountTPrivateKey $ entityVal acc + fvk <- deriveUfvk n osk ssk tsk + return $ ShowViewingKey VkFull fvk -- -- Get Incoming Viewing Key -- @@ -2189,14 +2078,14 @@ handleEvent wenv node model evt = Just acc -> do let osk = getOrchSK $ zcashAccountOrchSpendKey $ entityVal acc let ssk = getSapSK $ zcashAccountSapSpendKey $ entityVal acc - let tsk = getTranSK $ zcashAccountTPrivateKey $ entityVal acc - ivk <- deriveUivk n osk ssk tsk - return $ ShowViewingKey VkIncoming ivk + let tsk = getTranSK $ zcashAccountTPrivateKey $ entityVal acc + ivk <- deriveUivk n osk ssk tsk + return $ ShowViewingKey VkIncoming ivk -- -- Gen URI String -- - genURIString :: Float -> T.Text -> IO AppEvent - genURIString mAmt mMemo = do + genURIString :: Float -> T.Text -> IO AppEvent + genURIString mAmt mMemo = do return $ ShowMessage "Prueba de URI" scanZebra ::