Vergara_Tech/zenith
2
0
Fork 0
Code Issues 24 Pull requests Projects Releases 9 Packages Wiki Activity Actions

rvv001 - Issue 0085 - URI support implemented in TUI - "Processing URI ..." message added

Browse source 
- Payment URI Creation added to TUI
		      supports Unified, Sapling and Transparent address
This commit is contained in:
Rene V. Vergara 2025-01-17 18:35:11 -05:00
parent c1f0d86f14
commit df31e41684
2 changed files with 115 additions and 46 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

158
src/Zenith/CLI.hs
View file

@ -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 " " "<esc> " "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 $

3
src/Zenith/Utils.hs
View file

@ -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