From df31e41684bac4dd6db8a90127963a11fc8164d0 Mon Sep 17 00:00:00 2001 From: "Rene V. Vergara" Date: Fri, 17 Jan 2025 18:35:11 -0500 Subject: [PATCH] rvv001 - Issue 0085 - URI support implemented in TUI - "Processing URI ..." message added - Payment URI Creation added to TUI supports Unified, Sapling and Transparent address --- src/Zenith/CLI.hs | 158 +++++++++++++++++++++++++++++++------------- src/Zenith/Utils.hs | 3 +- 2 files changed, 115 insertions(+), 46 deletions(-) diff --git a/src/Zenith/CLI.hs b/src/Zenith/CLI.hs index 48e47bb..7fdafb3 100644 --- a/src/Zenith/CLI.hs +++ b/src/Zenith/CLI.hs @@ -75,7 +75,7 @@ import Control.Monad.Logger import Data.Aeson import Data.HexString (HexString(..), toText) import Data.Maybe -import Data.Scientific (Scientific, scientific, fromFloatDigits) +import Data.Scientific (Scientific, scientific, fromFloatDigits, toRealFloat) import qualified Data.Text as T import qualified Data.Text.Encoding as E import Data.Time.Clock.POSIX (posixSecondsToUTCTime) @@ -126,6 +126,7 @@ import Zenith.Types , SaplingSpendingKeyDB(..) , TransparentSpendingKeyDB(..) , ZcashPaymentURI(..) + , ZcashPool(..) ) import Zenith.Utils ( displayTaz @@ -138,6 +139,7 @@ import Zenith.Utils , showAddress , validBarValue , parseZcashPayment + , createZip321 ) data Name @@ -163,6 +165,9 @@ data Name | TotalTranspField | TotalShieldedField | SFBViewPort + | URITransparentAddress + | URISaplingAddress + | URIUnifiedAddress deriving (Eq, Show, Ord) data DialogInput = DialogInput @@ -194,13 +199,14 @@ newtype ShDshEntry = ShDshEntry makeLenses ''ShDshEntry data PaymentInput = PaymentInput - { _pmtAmt :: !Scientific + { _pmtAddressPool :: ZcashPool + , _pmtAmt :: !Scientific , _pmtMemo :: !T.Text } deriving (Show) makeLenses ''PaymentInput -data URIText = URIText +data URIText = URIText { _uriString :: !T.Text } deriving (Show) @@ -224,6 +230,7 @@ data DialogType | ShowFIATBalance | ViewingKeyMenu | ViewingKeyShow + | PaymentURICreate | PaymentURIShow | PayUsingURIShow | ProcessURIMenu @@ -288,6 +295,9 @@ data State = State makeLenses ''State +scientificToDouble :: Scientific -> Double +scientificToDouble = toRealFloat + zBalance :: State -> Double zBalance st = (fromIntegral (st ^. balance)) / 100000000 @@ -502,13 +512,25 @@ drawUI s = [splashDialog s, helpDialog s, displayDialog s, inputDialog s, ui s] -- URI Support -- -- | Create a New payment URI - PaymentURIShow -> + PaymentURICreate -> D.renderDialog (D.dialog (Just (str " Create Payment URI ")) Nothing 50) (renderForm (st ^. pmtURIForm) <=> C.hCenter (hBox [capCommand "↲ " "Process", capCommand3 " " " " "Cancel"])) + -- + -- | Show Paument URI + PaymentURIShow -> + D.renderDialog + (D.dialog + (Just (str (" Payment URI "))) + Nothing + 50) + (padAll 1 (C.hCenter (renderLongText 45 (st ^. vkData))) <=> + C.hCenter + (hBox + [capCommand "C" "opy to Clipoard", capCommand3 "" "E" "xit"])) -- -- | Pay using a URI PayUsingURIShow -> @@ -707,23 +729,23 @@ drawUI s = [splashDialog s, helpDialog s, displayDialog s, inputDialog s, ui s] withBorderStyle unicodeBold $ D.renderDialog (D.dialog - (Just $ txt ("Address: " <> walletAddressName (entityVal a))) + (Just $ txt (" Address: " <> walletAddressName (entityVal a) <> " ")) Nothing 60) (padAll 1 $ B.borderWithLabel - (str "Unified") + (str " Unified ") (txtWrapWith (WrapSettings False True NoFill FillAfterFirst) $ getUA $ walletAddressUAddress $ entityVal a) <=> B.borderWithLabel - (str "Legacy Shielded") + (str " Legacy Shielded ") (txtWrapWith (WrapSettings False True NoFill FillAfterFirst) $ fromMaybe "None" $ (getSaplingFromUA . E.encodeUtf8 . getUA . walletAddressUAddress) (entityVal a)) <=> B.borderWithLabel - (str "Transparent") + (str " Transparent ") (txtWrapWith (WrapSettings False True NoFill FillAfterFirst) $ maybe "None" (encodeTransparentReceiver (st ^. network)) $ t_rec =<< @@ -735,7 +757,7 @@ drawUI s = [splashDialog s, helpDialog s, displayDialog s, inputDialog s, ui s] [ str "Copy: " , capCommand "U" "nified" , capCommand "S" "apling" - , capCommand "T" "ransparent" + , capCommand3 " " "T" "ransparent" ]) <=> C.hCenter xCommand) Nothing -> emptyWidget @@ -865,20 +887,27 @@ mkSendForm bal = label s w = padBottom (Pad 1) $ vLimit 1 (hLimit 15 $ str s <+> fill ' ') <+> w -mkPaymentURIForm :: Integer -> PaymentInput -> Form PaymentInput e Name -mkPaymentURIForm bal = +mkPaymentURIForm :: PaymentInput -> Form PaymentInput e Name +mkPaymentURIForm = newForm - [ label "Amount: " @@= - editShowableFieldWithValidate pmtAmt AmtField (isAmountValid bal) + [ label "Pmt. Address:" @@= + radioField + pmtAddressPool + [ (OrchardPool, URIUnifiedAddress, "Unified") + , (SaplingPool, URISaplingAddress, "Sapling") + , (TransparentPool, URITransparentAddress, "Transparent") + ] + , label "Amount (Zec): " @@= + editShowableFieldWithValidate pmtAmt AmtField (isAmountValid ) , label "Memo: " @@= editTextField pmtMemo MemoField (Just 1) ] where - isAmountValid :: Integer -> Scientific -> Bool - isAmountValid b i = fromIntegral b >= (i * scientific 1 8) + isAmountValid :: Scientific -> Bool + isAmountValid i = i > 0.0 label s w = - padBottom (Pad 1) $ vLimit 1 (hLimit 15 $ str s <+> fill ' ') <+> w + padBottom (Pad 1) $ vLimit 1 (hLimit 20 $ str s <+> fill ' ') <+> w -mkPayUsingURIForm :: URIText -> Form URIText e Name +mkPayUsingURIForm :: URIText -> Form URIText e Name mkPayUsingURIForm = newForm [ label " URI: " @@= editTextField uriString MemoField (Just 1) @@ -1179,6 +1208,7 @@ appEvent (BT.AppEvent t) = do ViewingKeyMenu -> return () ProcessURIMenu -> return () ShowFIATBalance -> return () + PaymentURICreate -> return () PaymentURIShow -> return () PayUsingURIShow -> return () Blank -> do @@ -1815,8 +1845,8 @@ appEvent (BT.VtyEvent e) = do Just (_k, w) -> return w let osk = getOrchSK $ zcashAccountOrchSpendKey $ entityVal selAccount let ssk = getSapSK $ zcashAccountSapSpendKey $ entityVal selAccount - let tsk = getTranSK $ zcashAccountTPrivateKey $ entityVal selAccount - fvk <- liftIO $ deriveUfvk (s ^. network) osk ssk tsk + let tsk = getTranSK $ zcashAccountTPrivateKey $ entityVal selAccount + fvk <- liftIO $ deriveUfvk (s ^. network) osk ssk tsk BT.modify $ set vkName "Full" BT.modify $ set vkData fvk BT.modify $ set dialogBox ViewingKeyShow @@ -1835,8 +1865,8 @@ appEvent (BT.VtyEvent e) = do Just (_k, w) -> return w let osk = getOrchSK $ zcashAccountOrchSpendKey $ entityVal selAccount let ssk = getSapSK $ zcashAccountSapSpendKey $ entityVal selAccount - let tsk = getTranSK $ zcashAccountTPrivateKey $ entityVal selAccount - ivk <- liftIO $ deriveUivk (s ^. network) osk ssk tsk + let tsk = getTranSK $ zcashAccountTPrivateKey $ entityVal selAccount + ivk <- liftIO $ deriveUivk (s ^. network) osk ssk tsk BT.modify $ set vkName "Incomming" BT.modify $ set vkData ivk BT.modify $ set dialogBox ViewingKeyShow @@ -1844,27 +1874,68 @@ appEvent (BT.VtyEvent e) = do BT.modify $ set dialogBox Blank ev -> return () -- - -- Payment URI Form Events + -- Create Payment URI Form Events + -- + PaymentURICreate -> do + case e of + V.EvKey V.KEnter [] -> do + fs <- BT.zoom pmtURIForm $ BT.gets formState + case L.listSelectedElement $ s ^. addresses of + Just (_, a) -> do + let za = case (fs ^. pmtAddressPool) of + OrchardPool -> getUA $ walletAddressUAddress $ entityVal a + SaplingPool -> + case (getSaplingFromUA $ E.encodeUtf8 $ getUA $ walletAddressUAddress $ entityVal a) of + Just sa -> sa + _ -> "" + TransparentPool -> do + let trec = t_rec =<< (isValidUnifiedAddress . E.encodeUtf8 . getUA . walletAddressUAddress) (entityVal a) + case trec of + Just tr -> encodeTransparentReceiver (s ^. network) tr + _ -> "" + -- + _ -> "" + let amt = scientificToDouble (fs ^. pmtAmt) + if amt > 0.0 + then do + let mm = ( fs ^. pmtMemo ) + BT.modify $ set vkData (T.pack (createZip321 (T.unpack za) (Just amt) (Just (T.unpack mm)) )) + BT.modify $ set dialogBox PaymentURIShow + else do + BT.modify $ set msg " Must provide an amount!! " + BT.modify $ set displayBox MsgDisplay + Nothing -> do + BT.modify $ set msg " No Zcash address available!! " + BT.modify $ set displayBox MsgDisplay + V.EvKey V.KEsc [] -> BT.modify $ set dialogBox Blank + ev -> do + BT.zoom pmtURIForm $ do + handleFormEvent (BT.VtyEvent ev) + -- + -- Show Payment URI Form Events -- PaymentURIShow -> do case e of - V.EvKey V.KEnter [] -> BT.modify $ set dialogBox Blank - V.EvKey V.KEsc [] -> BT.modify $ set dialogBox Blank - ev -> do + V.EvKey (V.KChar 'c') [] -> do + liftIO $ setClipboard $ T.unpack $ s ^. vkData + BT.modify $ set msg " URI copied to Clipboard!!" + BT.modify $ set displayBox MsgDisplay + V.EvKey (V.KChar 'e') [] -> BT.modify $ set dialogBox Blank + ev -> do BT.zoom pmtURIForm $ do handleFormEvent (BT.VtyEvent ev) -- -- Pay using URI Form Events -- - PayUsingURIShow -> do - case e of - V.EvKey V.KEnter [] -> do + PayUsingURIShow -> do + case e of + V.EvKey V.KEnter [] -> do fs <- BT.zoom payUsingURIForm $ BT.gets formState - let zp = parseZcashPayment $ T.unpack (fs ^. uriString) + let zp = parseZcashPayment $ T.unpack (fs ^. uriString) case zp of Right p -> do case uriAmount p of - Just a -> do + Just a -> do BT.modify $ set txForm $ mkSendForm @@ -1875,17 +1946,17 @@ appEvent (BT.VtyEvent e) = do (uriMemo p) Full) BT.modify $ set dialogBox SendTx - Nothing -> do + Nothing -> do BT.modify $ set msg "URI error - Invalid value " BT.modify $ set displayBox MsgDisplay - Left e -> do + Left e -> do BT.modify $ - set msg e + set msg e BT.modify $ set displayBox MsgDisplay V.EvKey V.KEsc [] -> BT.modify $ set dialogBox Blank - ev -> do + ev -> do BT.zoom payUsingURIForm $ do handleFormEvent (BT.VtyEvent ev) -- @@ -1894,12 +1965,12 @@ appEvent (BT.VtyEvent e) = do ProcessURIMenu -> do case e of V.EvKey (V.KChar 'c') [] -> do - BT.modify $ + BT.modify $ set pmtURIForm $ - mkPaymentURIForm (s ^. balance) (PaymentInput 0.0 "") - BT.modify $ set dialogBox PaymentURIShow + mkPaymentURIForm (PaymentInput OrchardPool 0.0 "") + BT.modify $ set dialogBox PaymentURICreate V.EvKey (V.KChar 'p') [] -> do - BT.modify $ + BT.modify $ set payUsingURIForm $ mkPayUsingURIForm (URIText "") BT.modify $ set dialogBox PayUsingURIShow @@ -1932,7 +2003,7 @@ appEvent (BT.VtyEvent e) = do set txForm $ mkSendForm (s ^. balance) (SendInput "" 0.0 "" Full) BT.modify $ set dialogBox SendTx - V.EvKey (V.KChar 'u') [] -> + V.EvKey (V.KChar 'u') [] -> BT.modify $ set dialogBox ProcessURIMenu V.EvKey (V.KChar 'b') [] -> BT.modify $ set dialogBox AdrBook @@ -2012,9 +2083,6 @@ appEvent (BT.VtyEvent e) = do BT.modify $ set dialogBox ViewingKeyMenu V.EvKey (V.KChar 'u') [] -> do BT.modify $ set dialogBox ViewingKeyMenu - -- set pmtURIForm $ - -- mkPaymentURIForm (s ^. balance) (PaymentInput 0.0 "") - -- BT.modify $ set dialogBox PaymentURIShow ev -> case r of Just AList -> @@ -2029,8 +2097,8 @@ appEvent (BT.VtyEvent e) = do printMsg s = BT.modify $ updateMsg s updateMsg :: String -> State -> State updateMsg = set msg --- fs <- BT.gets formState --- ev -> BT.zoom shdshForm $ L.handleListEvent ev +-- +-- appEvent _ = return () theMap :: A.AttrMap @@ -2171,7 +2239,7 @@ runZenithTUI config = do 0 "" "" - (mkPaymentURIForm 0 $ PaymentInput 0.0 "") + (mkPaymentURIForm $ PaymentInput OrchardPool 0.0 "") (mkPayUsingURIForm $ URIText "") Left _e -> do print $ diff --git a/src/Zenith/Utils.hs b/src/Zenith/Utils.hs index c9781bd..8151949 100644 --- a/src/Zenith/Utils.hs +++ b/src/Zenith/Utils.hs @@ -8,6 +8,7 @@ import Data.Aeson import qualified Data.Aeson.Key as K import qualified Data.Aeson.KeyMap as KM import Data.Aeson.Types (parseMaybe) +import qualified Data.ByteString as BS import qualified Data.ByteString.Base64 as B64 import qualified Data.ByteString.Char8 as BC import qualified Data.ByteString.Lazy as B @@ -19,7 +20,7 @@ import Data.Ord (clamp) import Data.Scientific (Scientific(..), scientific, Scientific, toRealFloat) import qualified Data.Text as T import qualified Data.Text.Encoding as E -import qualified Data.Text.Encoding as TE +--import qualified Data.Text.Encoding as TE import Network.HTTP.Simple import Network.URI (escapeURIString, isUnreserved) import System.Directory