diff --git a/src/Zenith/GUI.hs b/src/Zenith/GUI.hs index 2dc6fba..9723f46 100644 --- a/src/Zenith/GUI.hs +++ b/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 mAmt mMemo = do - return $ ShowMessage "Prueba de URI" + -- + genURIString :: T.Text -> Float -> T.Text -> IO AppEvent + genURIString addr mAmt mMemo = do + 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 diff --git a/src/Zenith/Utils.hs b/src/Zenith/Utils.hs index 29b9aaa..1a43456 100644 --- a/src/Zenith/Utils.hs +++ b/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 -encodeMemo = BC.unpack . BC.takeWhile (/= '=') . B64.encode . BC.pack +encodeBase64Memo :: String -> String +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 "" (\memo -> "&memo=" ++ escapeURIString isUnreserved (encodeMemo memo)) mMemo + ++ maybe "" (\amount -> "?amount=" ++ dropTrailingZeros (printf "%.8f" amount) ) mAmount + ++ maybe "" (\memo -> "&memo=" ++ escapeURIString isUnreserved (encodeBase64Memo memo)) mMemo