rvv001 - Issue 0085 - URI support implemented in TUI - "Processing URI ..." message added
- Payment URI Creation added to TUI supports Unified, Sapling and Transparent address
This commit is contained in:
parent
c1f0d86f14
commit
df31e41684
2 changed files with 115 additions and 46 deletions
|
|
@ -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,7 +199,8 @@ newtype ShDshEntry = ShDshEntry
|
|||
makeLenses ''ShDshEntry
|
||||
|
||||
data PaymentInput = PaymentInput
|
||||
{ _pmtAmt :: !Scientific
|
||||
{ _pmtAddressPool :: ZcashPool
|
||||
, _pmtAmt :: !Scientific
|
||||
, _pmtMemo :: !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,7 +512,7 @@ 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) <=>
|
||||
|
|
@ -510,6 +520,18 @@ drawUI s = [splashDialog s, helpDialog s, displayDialog s, inputDialog s, ui s]
|
|||
(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 ->
|
||||
D.renderDialog
|
||||
|
|
@ -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,18 +887,25 @@ 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 =
|
||||
|
|
@ -1179,6 +1208,7 @@ appEvent (BT.AppEvent t) = do
|
|||
ViewingKeyMenu -> return ()
|
||||
ProcessURIMenu -> return ()
|
||||
ShowFIATBalance -> return ()
|
||||
PaymentURICreate -> return ()
|
||||
PaymentURIShow -> return ()
|
||||
PayUsingURIShow -> return ()
|
||||
Blank -> do
|
||||
|
|
@ -1844,12 +1874,53 @@ 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
|
||||
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)
|
||||
|
|
@ -1896,8 +1967,8 @@ appEvent (BT.VtyEvent e) = do
|
|||
V.EvKey (V.KChar 'c') [] -> do
|
||||
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 $
|
||||
set payUsingURIForm $
|
||||
|
|
@ -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 $
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
Loading…
Reference in a new issue