rvv001 - Issue 0085 - URI support implemented (GUI & TUI)

This commit is contained in:
Rene V. Vergara 2025-01-10 09:49:34 -05:00
parent 9aaf712bad
commit 9d4e8a255b
2 changed files with 65 additions and 15 deletions

View file

@ -75,7 +75,7 @@ import Control.Monad.Logger
import Data.Aeson import Data.Aeson
import Data.HexString (HexString(..), toText) import Data.HexString (HexString(..), toText)
import Data.Maybe import Data.Maybe
import Data.Scientific (Scientific, scientific) import Data.Scientific (Scientific, scientific, fromFloatDigits)
import qualified Data.Text as T import qualified Data.Text as T
import qualified Data.Text.Encoding as E import qualified Data.Text.Encoding as E
import Data.Time.Clock.POSIX (posixSecondsToUTCTime) import Data.Time.Clock.POSIX (posixSecondsToUTCTime)
@ -125,6 +125,7 @@ import Zenith.Types
, OrchardSpendingKeyDB(..) , OrchardSpendingKeyDB(..)
, SaplingSpendingKeyDB(..) , SaplingSpendingKeyDB(..)
, TransparentSpendingKeyDB(..) , TransparentSpendingKeyDB(..)
, ZcashPaymentURI(..)
) )
import Zenith.Utils import Zenith.Utils
( displayTaz ( displayTaz
@ -136,6 +137,7 @@ import Zenith.Utils
, jsonNumber , jsonNumber
, showAddress , showAddress
, validBarValue , validBarValue
, parseZcashPayment
) )
data Name data Name
@ -196,12 +198,14 @@ data PaymentInput = PaymentInput
, _pmtMemo :: !T.Text , _pmtMemo :: !T.Text
} deriving (Show) } deriving (Show)
newtype URIText = URIText makeLenses ''PaymentInput
data URIText = URIText
{ {
_uriString :: !Text _uriString :: !T.Text
} deriving (Show) } deriving (Show)
makeLenses ''PaymentInput makeLenses ''URIText
data DialogType data DialogType
= WName = WName
@ -221,6 +225,7 @@ data DialogType
| ViewingKeyMenu | ViewingKeyMenu
| ViewingKeyShow | ViewingKeyShow
| PaymentURIShow | PaymentURIShow
| PayUsingURIShow
| ProcessURIMenu | ProcessURIMenu
data DisplayType data DisplayType
@ -278,7 +283,7 @@ data State = State
, _vkName :: !T.Text , _vkName :: !T.Text
, _vkData :: !T.Text , _vkData :: !T.Text
, _pmtURIForm :: !(Form PaymentInput () Name) , _pmtURIForm :: !(Form PaymentInput () Name)
, _payUsingURIForm :: !(Form PaymentInput () Name) , _payUsingURIForm :: !(Form URIText () Name)
} }
makeLenses ''State makeLenses ''State
@ -492,7 +497,7 @@ drawUI s = [splashDialog s, helpDialog s, displayDialog s, inputDialog s, ui s]
(D.dialog (Just (str " Send Transaction ")) Nothing 50) (D.dialog (Just (str " Send Transaction ")) Nothing 50)
(renderForm (st ^. txForm) <=> (renderForm (st ^. txForm) <=>
C.hCenter C.hCenter
(hBox [capCommand "" "Send", capCommand "<esc> " "Cancel"])) (hBox [capCommand "" "Send", capCommand3 " " "<esc> " "Cancel"]))
-- --
-- URI Support -- URI Support
-- --
@ -503,16 +508,16 @@ drawUI s = [splashDialog s, helpDialog s, displayDialog s, inputDialog s, ui s]
(renderForm (st ^. pmtURIForm) <=> (renderForm (st ^. pmtURIForm) <=>
C.hCenter C.hCenter
(hBox (hBox
[capCommand "P" "rocess", capCommand3 " " "<esc> " "Cancel"])) [capCommand "" "Process", capCommand3 " " "<esc> " "Cancel"]))
-- --
-- | Pay usin a URI -- | Pay using a URI
PayUsingURIShow -> PayUsingURIShow ->
D.renderDialog D.renderDialog
(D.dialog (Just (str " Pay Using URI ")) Nothing 50) (D.dialog (Just (str " Pay Using URI ")) Nothing 50)
(renderForm (st ^. payUsingURIForm) <=> (renderForm (st ^. payUsingURIForm) <=>
C.hCenter C.hCenter
(hBox (hBox
[capCommand "P" "rocess", capCommand3 " " "<esc> " "Cancel"])) [capCommand "" "Process", capCommand3 " " "<esc> " "Cancel"]))
-- --
DeshieldForm -> DeshieldForm ->
D.renderDialog D.renderDialog
@ -873,8 +878,8 @@ mkPaymentURIForm bal =
label s w = label s w =
padBottom (Pad 1) $ vLimit 1 (hLimit 15 $ str s <+> fill ' ') <+> w padBottom (Pad 1) $ vLimit 1 (hLimit 15 $ str s <+> fill ' ') <+> w
payUsingURIForm :: URIText -> Form URIText e Name mkPayUsingURIForm :: URIText -> Form URIText e Name
payUsingURIForm = mkPayUsingURIForm =
newForm newForm
[ label " URI: " @@= editTextField uriString MemoField (Just 1) [ label " URI: " @@= editTextField uriString MemoField (Just 1)
] ]
@ -892,7 +897,7 @@ mkDeshieldForm tbal =
isAmountValid :: Integer -> Scientific -> Bool isAmountValid :: Integer -> Scientific -> Bool
isAmountValid b i = fromIntegral b >= (i * scientific 1 8) isAmountValid b i = fromIntegral b >= (i * scientific 1 8)
label s w = label s w =
padBottom (Pad 1) $ vLimit 1 (hLimit 15 $ str s <+> fill ' ') <+> w padBottom (Pad 1) $ vLimit 1 (hLimit 25 $ str s <+> fill ' ') <+> w
{-- {--
mkShieldForm :: Integer -> ShDshEntry -> Form ShDshEntry e Name mkShieldForm :: Integer -> ShDshEntry -> Form ShDshEntry e Name
mkShieldForm bal = mkShieldForm bal =
@ -1188,6 +1193,7 @@ appEvent (BT.AppEvent t) = do
ProcessURIMenu -> return () ProcessURIMenu -> return ()
ShowFIATBalance -> return () ShowFIATBalance -> return ()
PaymentURIShow -> return () PaymentURIShow -> return ()
PayUsingURIShow -> return ()
Blank -> do Blank -> do
if s ^. timer == 90 if s ^. timer == 90
then do then do
@ -1855,8 +1861,46 @@ appEvent (BT.VtyEvent e) = do
-- --
PaymentURIShow -> do PaymentURIShow -> do
case e of case e of
V.EvKey V.KEnter [] -> BT.modify $ set dialogBox Blank
V.EvKey V.KEsc [] -> BT.modify $ set dialogBox Blank V.EvKey V.KEsc [] -> BT.modify $ set dialogBox Blank
ev -> return () 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
fs <- BT.zoom payUsingURIForm $ BT.gets formState
let zp = parseZcashPayment $ T.unpack (fs ^. uriString)
case zp of
Right p -> do
case uriAmount p of
Just a -> do
BT.modify $
set txForm $
mkSendForm
(s ^. balance)
(SendInput
(T.pack (uriAddress p))
(fromFloatDigits a)
(uriMemo p)
Full)
BT.modify $ set dialogBox SendTx
Nothing -> do
BT.modify $
set
msg "URI error - Invalid value "
BT.modify $ set displayBox MsgDisplay
Left e -> do
BT.modify $
set msg e
BT.modify $ set displayBox MsgDisplay
V.EvKey V.KEsc [] -> BT.modify $ set dialogBox Blank
ev -> do
BT.zoom payUsingURIForm $ do
handleFormEvent (BT.VtyEvent ev)
-- --
-- Open URI process form -- Open URI process form
-- --
@ -1867,6 +1911,11 @@ appEvent (BT.VtyEvent e) = do
set pmtURIForm $ set pmtURIForm $
mkPaymentURIForm (s ^. balance) (PaymentInput 0.0 "") mkPaymentURIForm (s ^. balance) (PaymentInput 0.0 "")
BT.modify $ set dialogBox PaymentURIShow BT.modify $ set dialogBox PaymentURIShow
V.EvKey (V.KChar 'p') [] -> do
BT.modify $
set payUsingURIForm $
mkPayUsingURIForm (URIText "")
BT.modify $ set dialogBox PayUsingURIShow
V.EvKey (V.KChar 'e') [] -> V.EvKey (V.KChar 'e') [] ->
BT.modify $ set dialogBox Blank BT.modify $ set dialogBox Blank
ev -> return () ev -> return ()
@ -2136,6 +2185,7 @@ runZenithTUI config = do
"" ""
"" ""
(mkPaymentURIForm 0 $ PaymentInput 0.0 "") (mkPaymentURIForm 0 $ PaymentInput 0.0 "")
(mkPayUsingURIForm $ URIText "")
Left _e -> do Left _e -> do
print $ print $
"No Zebra node available on port " <> "No Zebra node available on port " <>

@ -1 +1 @@
Subproject commit cfa862ec9495e810e7296fa6fe724b46dbe0ee52 Subproject commit a28edcb5995667677e96a08c6952a568bfd6c51e