Compare commits
115 commits
62b6ee3f32
...
ff6168b45e
Author | SHA1 | Date | |
---|---|---|---|
ff6168b45e | |||
cc4ce8a280 | |||
332b7f5520 | |||
6b3ea31882 | |||
02ec4716e9 | |||
d476183a1d | |||
56bf19a6f6 | |||
63aa5e5984 | |||
fe8fb1fa3c | |||
cb927a0ab3 | |||
53eac75aa5 | |||
324ed663c3 | |||
9acf18c503 | |||
54d9f20fdd | |||
e02551c9ff | |||
cf2f77e510 | |||
25b6a097c7 | |||
398f4f1dcf | |||
b6b586f9bf | |||
adfaed6753 | |||
28c05a66fe | |||
0d5161cdb2 | |||
165977eecf | |||
5c8a611dfc | |||
6255ea3142 | |||
01cdf9eb14 | |||
b95213ae5c | |||
302cfb0b76 | |||
6a4bbb587c | |||
95b89e28ed | |||
93240325df | |||
abe30db2fe | |||
d050c0c040 | |||
212c1f2867 | |||
0e14228a0e | |||
7189ddcb2a | |||
4a874897cf | |||
befc3e46cc | |||
eaa596fdac | |||
a2be940648 | |||
f4f149d6a2 | |||
4aad9cb57f | |||
c9a42572d3 | |||
932d79ad57 | |||
a2743842dd | |||
e46cd01f41 | |||
322f2b8959 | |||
bf4118b09d | |||
59d3ee4d37 | |||
a3a8bb1eaa | |||
06b2cd9222 | |||
185738eccc | |||
87feab284e | |||
5ce0b5fa0f | |||
538216944d | |||
dee0a7e8e8 | |||
b3df16f217 | |||
0142ea90ae | |||
1931098ee9 | |||
35dce186fd | |||
bd3d9e8067 | |||
f780e996e0 | |||
dcdf2e8304 | |||
f8fa5a005a | |||
70123a7261 | |||
1caa4efdb4 | |||
73ad2f0eb3 | |||
6503af6a98 | |||
67d334a60b | |||
fae0def6a8 | |||
35ab075703 | |||
0b7bf1db99 | |||
40fb9228a2 | |||
4ee09238d8 | |||
6875917ec7 | |||
cdd28d2184 | |||
934bff1454 | |||
9c7e808794 | |||
9917356b40 | |||
e1dfb66fae | |||
a3df217992 | |||
e94ca5e8c4 | |||
66767da36a | |||
b75ed16a3e | |||
14cf97d473 | |||
c68c504b53 | |||
46b4969da5 | |||
c9dea01644 | |||
d4fd7c5044 | |||
473192e34b | |||
d1789b634e | |||
2dfb11dc0f | |||
9cbeb5fbb0 | |||
2cfaf5959d | |||
b8980bd219 | |||
339c93905f | |||
675ca9d5e3 | |||
4553f964f3 | |||
dbe352acac | |||
606c25c2c3 | |||
a0b92ba468 | |||
f7efa85cdd | |||
0d5ff79b96 | |||
abf02cf90d | |||
e3de5c7624 | |||
8ba1dfa7c7 | |||
cbcf7c9c8c | |||
b66d0d9563 | |||
a60534a5c2 | |||
94bfca95ca | |||
662f9cd5ed | |||
d37269bf44 | |||
c89d5a46d4 | |||
01459544a5 | |||
3a5e593a65 |
11 changed files with 656 additions and 151 deletions
4
.gitignore
vendored
4
.gitignore
vendored
|
@ -5,3 +5,7 @@ zenith.db
|
|||
zenith.log
|
||||
zenith.db-shm
|
||||
zenith.db-wal
|
||||
test.db
|
||||
test.db-shm
|
||||
test.db-wal
|
||||
|
||||
|
|
16
app/Main.hs
16
app/Main.hs
|
@ -213,13 +213,15 @@ main = do
|
|||
currencyCode <- require config "currencyCode"
|
||||
dbFP <- getZenithPath
|
||||
let dbFilePath = T.pack $ dbFP ++ dbFileName
|
||||
let myConfig = Config dbFilePath
|
||||
zebraHost
|
||||
zebraPort
|
||||
nodeUser
|
||||
nodePwd
|
||||
nodePort
|
||||
currencyCode
|
||||
let myConfig =
|
||||
Config
|
||||
dbFilePath
|
||||
zebraHost
|
||||
zebraPort
|
||||
nodeUser
|
||||
nodePwd
|
||||
nodePort
|
||||
currencyCode
|
||||
if not (null args)
|
||||
then do
|
||||
case head args
|
||||
|
|
|
@ -38,7 +38,15 @@ main = do
|
|||
currencyCode <- require config "currencyCode"
|
||||
dbFP <- getZenithPath
|
||||
let dbFilePath = T.pack $ dbFP ++ dbFileName
|
||||
let myConfig = Config dbFilePath zebraHost zebraPort nodeUser nodePwd nodePort currencyCode
|
||||
let myConfig =
|
||||
Config
|
||||
dbFilePath
|
||||
zebraHost
|
||||
zebraPort
|
||||
nodeUser
|
||||
nodePwd
|
||||
nodePort
|
||||
currencyCode
|
||||
let ctx = authenticate myConfig :. EmptyContext
|
||||
w <- try $ checkZebra zebraHost zebraPort :: IO (Either IOError ZebraGetInfo)
|
||||
case w of
|
||||
|
|
|
@ -89,7 +89,13 @@ import Lens.Micro.Mtl
|
|||
import Lens.Micro.TH
|
||||
import System.Hclip
|
||||
import Text.Printf
|
||||
import Text.Wrap (FillScope(..), FillStrategy(..), WrapSettings(..))
|
||||
import Text.Wrap
|
||||
( FillScope(..)
|
||||
, FillStrategy(..)
|
||||
, WrapSettings(..)
|
||||
, defaultWrapSettings
|
||||
, wrapTextToLines
|
||||
)
|
||||
import ZcashHaskell.Keys (generateWalletSeedPhrase)
|
||||
import ZcashHaskell.Orchard
|
||||
( getSaplingFromUA
|
||||
|
@ -121,12 +127,12 @@ import Zenith.Utils
|
|||
( displayTaz
|
||||
, displayZec
|
||||
, getChainTip
|
||||
, getZcashPrice
|
||||
, isRecipientValid
|
||||
, isRecipientValidGUI
|
||||
, jsonNumber
|
||||
, showAddress
|
||||
, validBarValue
|
||||
, getZcashPrice
|
||||
)
|
||||
|
||||
data Name
|
||||
|
@ -182,6 +188,13 @@ newtype ShDshEntry = ShDshEntry
|
|||
|
||||
makeLenses ''ShDshEntry
|
||||
|
||||
data PaymentInput = PaymentInput
|
||||
{ _pmtAmt :: !Scientific
|
||||
, _pmtMemo :: !T.Text
|
||||
} deriving (Show)
|
||||
|
||||
makeLenses ''PaymentInput
|
||||
|
||||
data DialogType
|
||||
= WName
|
||||
| AName
|
||||
|
@ -197,6 +210,9 @@ data DialogType
|
|||
| DeshieldForm
|
||||
| ShieldForm
|
||||
| ShowFIATBalance
|
||||
| ViewingKeyMenu
|
||||
| ViewingKeyShow
|
||||
| PaymentURIShow
|
||||
|
||||
data DisplayType
|
||||
= AddrDisplay
|
||||
|
@ -250,12 +266,30 @@ data State = State
|
|||
, _sBalance :: !Integer
|
||||
, _currencyCode :: !T.Text
|
||||
, _zprice :: !Double
|
||||
}
|
||||
, _vkName :: !T.Text
|
||||
, _vkData :: !T.Text
|
||||
, _pmtURIForm :: !(Form PaymentInput () Name)
|
||||
}
|
||||
|
||||
makeLenses ''State
|
||||
|
||||
zBalance :: State -> Double
|
||||
zBalance st = (fromIntegral (st ^. balance) ) / 100000000
|
||||
zBalance st = (fromIntegral (st ^. balance)) / 100000000
|
||||
|
||||
-- Function to split text into fixed-size chunks
|
||||
splitText :: Int -> T.Text -> [T.Text]
|
||||
splitText chunkSize text =
|
||||
let strippedText = T.filter (/= '\n') text -- Remove newlines
|
||||
in if T.null strippedText
|
||||
then []
|
||||
else T.take chunkSize strippedText :
|
||||
splitText chunkSize (T.drop chunkSize strippedText)
|
||||
|
||||
-- Create a widget to display the long text
|
||||
renderLongText :: Int -> T.Text -> Widget Name
|
||||
renderLongText lineLength longText =
|
||||
let linesOfText = splitText lineLength longText
|
||||
in vBox $ map txt linesOfText
|
||||
|
||||
drawUI :: State -> [Widget Name]
|
||||
drawUI s = [splashDialog s, helpDialog s, displayDialog s, inputDialog s, ui s]
|
||||
|
@ -307,13 +341,18 @@ drawUI s = [splashDialog s, helpDialog s, displayDialog s, inputDialog s, ui s]
|
|||
, capCommand "A" "ccounts"
|
||||
, capCommand "V" "iew address"
|
||||
, capCommand "S" "end Tx"
|
||||
, capCommand3 "ba" "L" ("ance (" ++ ( T.unpack (st ^. currencyCode) )++ ")" )
|
||||
, capCommand2 "Gen " "U" "RI"
|
||||
, capCommand3
|
||||
"ba"
|
||||
"L"
|
||||
("ance (" ++ (T.unpack (st ^. currencyCode)) ++ ")")
|
||||
])
|
||||
, C.hCenter
|
||||
(hBox
|
||||
[ capCommand2 "Address " "B" "ook"
|
||||
, capCommand2 "s" "H" "ield"
|
||||
, capCommand "D" "e-shield"
|
||||
, capCommand2 "Viewing " "K" "eys"
|
||||
, capCommand "Q" "uit"
|
||||
, capCommand "?" " Help"
|
||||
, str $ show (st ^. timer)
|
||||
|
@ -384,7 +423,9 @@ drawUI s = [splashDialog s, helpDialog s, displayDialog s, inputDialog s, ui s]
|
|||
else emptyWidget
|
||||
where
|
||||
keyList =
|
||||
map (C.hCenter . str) ["?", "Esc", "w", "a", "v", "s", "b", "d", "l", "q"]
|
||||
map
|
||||
(C.hCenter . str)
|
||||
["?", "Esc", "w", "a", "v", "s", "u", "b", "d", "k", "l", "q"]
|
||||
actionList =
|
||||
map
|
||||
(hLimit 40 . str)
|
||||
|
@ -394,8 +435,10 @@ drawUI s = [splashDialog s, helpDialog s, displayDialog s, inputDialog s, ui s]
|
|||
, "Switch accounts"
|
||||
, "View address"
|
||||
, "Send Tx"
|
||||
, "Gen URI"
|
||||
, "Address Book"
|
||||
, "Shield/De-Shield"
|
||||
, "Viewing Keys"
|
||||
, "Balance in Fiat"
|
||||
, "Quit"
|
||||
]
|
||||
|
@ -443,6 +486,13 @@ drawUI s = [splashDialog s, helpDialog s, displayDialog s, inputDialog s, ui s]
|
|||
(renderForm (st ^. txForm) <=>
|
||||
C.hCenter
|
||||
(hBox [capCommand "↲ " "Send", capCommand "<esc> " "Cancel"]))
|
||||
PaymentURIShow ->
|
||||
D.renderDialog
|
||||
(D.dialog (Just (str " Create Payment URI ")) Nothing 50)
|
||||
(renderForm (st ^. pmtURIForm) <=>
|
||||
C.hCenter
|
||||
(hBox
|
||||
[capCommand "P" "rocess", capCommand3 " " "<esc> " "Cancel"]))
|
||||
DeshieldForm ->
|
||||
D.renderDialog
|
||||
(D.dialog (Just (str " De-Shield ZEC ")) Nothing 50)
|
||||
|
@ -462,7 +512,7 @@ drawUI s = [splashDialog s, helpDialog s, displayDialog s, inputDialog s, ui s]
|
|||
]) <=>
|
||||
renderForm (st ^. deshieldForm) <=>
|
||||
C.hCenter
|
||||
(hBox [capCommand "P" "roceed", capCommand "<esc> " "Cancel"]))
|
||||
(hBox [capCommand "P" "roceed", capCommand3 "" "<esc> " "Cancel"]))
|
||||
ShieldForm ->
|
||||
D.renderDialog
|
||||
(D.dialog (Just (str " Shield ZEC ")) Nothing 50)
|
||||
|
@ -473,7 +523,26 @@ drawUI s = [splashDialog s, helpDialog s, displayDialog s, inputDialog s, ui s]
|
|||
then displayZec (st ^. tBalance)
|
||||
else displayTaz (st ^. tBalance) ++ "?") <=>
|
||||
C.hCenter
|
||||
(hBox [capCommand "P" "roceed", capCommand "<esc> " "Cancel"]))
|
||||
(hBox [capCommand "P" "roceed", capCommand3 "" "<esc> " "Cancel"]))
|
||||
ViewingKeyShow ->
|
||||
D.renderDialog
|
||||
(D.dialog
|
||||
(Just (str (" " ++ (T.unpack (st ^. vkName)) ++ " Viewing Key ")))
|
||||
Nothing
|
||||
50)
|
||||
(padAll 1 (C.hCenter (renderLongText 45 (st ^. vkData))) <=>
|
||||
C.hCenter
|
||||
(hBox
|
||||
[capCommand "C" "opy to Clipoard", capCommand3 "" "E" "xit"]))
|
||||
ViewingKeyMenu ->
|
||||
D.renderDialog
|
||||
(D.dialog (Just (str " Viewing Keys ")) Nothing 50)
|
||||
(C.hCenter
|
||||
(hBox
|
||||
[ capCommand "F" "ull"
|
||||
, capCommand "I" "ncoming"
|
||||
, capCommand3 "" "E" "xit"
|
||||
]))
|
||||
Blank -> emptyWidget
|
||||
-- Address Book List
|
||||
AdrBook ->
|
||||
|
@ -527,35 +596,50 @@ drawUI s = [splashDialog s, helpDialog s, displayDialog s, inputDialog s, ui s]
|
|||
, capCommand3 "" "<Esc>" " Cancel"
|
||||
]))
|
||||
-- Show Balance in FIAT form
|
||||
ShowFIATBalance ->
|
||||
ShowFIATBalance ->
|
||||
D.renderDialog
|
||||
(D.dialog (Just $ str (" Account Balance (" ++ ( T.unpack (st ^. currencyCode)) ++ ") ") ) Nothing 60)
|
||||
(D.dialog
|
||||
(Just $
|
||||
str
|
||||
(" Account Balance (" ++
|
||||
(T.unpack (st ^. currencyCode)) ++ ") "))
|
||||
Nothing
|
||||
60)
|
||||
(withAttr abDefAttr $
|
||||
setAvailableSize (50, 8) $
|
||||
viewport SFBViewPort BT.Vertical $
|
||||
vLimit 8 $
|
||||
setAvailableSize (50, 8) $
|
||||
viewport SFBViewPort BT.Vertical $
|
||||
vLimit 8 $
|
||||
hLimit 50 $
|
||||
vBox $
|
||||
[ vLimit 4 $
|
||||
hLimit 50 $
|
||||
vBox $
|
||||
[
|
||||
vLimit 4 $
|
||||
hLimit 50 $
|
||||
vBox $
|
||||
[ C.hCenter (str $ " ")
|
||||
, C.hCenter (str $ "1 ZEC = " ++ ( printf "%.2f" ( s ^. zprice ) ) ++ " " ++ (T.unpack ( s ^. currencyCode) ))
|
||||
, C.hCenter (str $ " ")
|
||||
, C.hCenter ( str $ " Balance: " ++ ( printf "%.8f" $ zBalance s ) ++ " ZEC ==> " ++ ( printf "%.2f" (( s ^. zprice ) * (zBalance s) ) ++ " " ++ (T.unpack ( s ^. currencyCode) )) )
|
||||
]
|
||||
, padTop Max $
|
||||
vLimit 4 $
|
||||
hLimit 50 $
|
||||
withAttr abMBarAttr $
|
||||
vBox $
|
||||
[ C.hCenter (str " ")
|
||||
, C.hCenter $
|
||||
(capCommand "R" "efresh" <+> capCommand3 "E" "x" "it")
|
||||
]
|
||||
])
|
||||
--
|
||||
vBox $
|
||||
[ C.hCenter (str $ " ")
|
||||
, C.hCenter
|
||||
(str $
|
||||
"1 ZEC = " ++
|
||||
(printf "%.2f" (s ^. zprice)) ++
|
||||
" " ++ (T.unpack (s ^. currencyCode)))
|
||||
, C.hCenter (str $ " ")
|
||||
, C.hCenter
|
||||
(str $
|
||||
" Balance: " ++
|
||||
(printf "%.8f" $ zBalance s) ++
|
||||
" ZEC ==> " ++
|
||||
(printf "%.2f" ((s ^. zprice) * (zBalance s)) ++
|
||||
" " ++ (T.unpack (s ^. currencyCode))))
|
||||
]
|
||||
, padTop Max $
|
||||
vLimit 4 $
|
||||
hLimit 50 $
|
||||
withAttr abMBarAttr $
|
||||
vBox $
|
||||
[ C.hCenter (str " ")
|
||||
, C.hCenter $
|
||||
(capCommand "R" "efresh" <+> capCommand3 "E" "x" "it")
|
||||
]
|
||||
])
|
||||
--
|
||||
splashDialog :: State -> Widget Name
|
||||
splashDialog st =
|
||||
if st ^. splashBox
|
||||
|
@ -567,7 +651,7 @@ drawUI s = [splashDialog s, helpDialog s, displayDialog s, inputDialog s, ui s]
|
|||
(str
|
||||
" _____ _ _ _ \n|__ /___ _ __ (_) |_| |__\n / // _ \\ '_ \\| | __| '_ \\\n / /| __/ | | | | |_| | | |\n/____\\___|_| |_|_|\\__|_| |_|") <=>
|
||||
C.hCenter
|
||||
(withAttr titleAttr (str "Zcash Wallet v0.7.0.0-beta")) <=>
|
||||
(withAttr titleAttr (str "Zcash Wallet v0.7.1.0-beta")) <=>
|
||||
C.hCenter (withAttr blinkAttr $ str "Press any key..."))
|
||||
else emptyWidget
|
||||
capCommand3 :: String -> String -> String -> Widget Name
|
||||
|
@ -746,6 +830,19 @@ 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 =
|
||||
newForm
|
||||
[ label "Amount: " @@=
|
||||
editShowableFieldWithValidate pmtAmt AmtField (isAmountValid bal)
|
||||
, label "Memo: " @@= editTextField pmtMemo MemoField (Just 1)
|
||||
]
|
||||
where
|
||||
isAmountValid :: Integer -> Scientific -> Bool
|
||||
isAmountValid b i = fromIntegral b >= (i * scientific 1 8)
|
||||
label s w =
|
||||
padBottom (Pad 1) $ vLimit 1 (hLimit 15 $ str s <+> fill ' ') <+> w
|
||||
|
||||
mkDeshieldForm :: Integer -> ShDshEntry -> Form ShDshEntry e Name
|
||||
mkDeshieldForm tbal =
|
||||
newForm
|
||||
|
@ -757,7 +854,19 @@ mkDeshieldForm tbal =
|
|||
isAmountValid b i = fromIntegral b >= (i * scientific 1 8)
|
||||
label s w =
|
||||
padBottom (Pad 1) $ vLimit 1 (hLimit 15 $ str s <+> fill ' ') <+> w
|
||||
|
||||
{--
|
||||
mkShieldForm :: Integer -> ShDshEntry -> Form ShDshEntry e Name
|
||||
mkShieldForm bal =
|
||||
newForm
|
||||
[ label "Amount to Shield: " @@=
|
||||
editShowableFieldWithValidate shAmt AmtField (isAmountValid bal)
|
||||
]
|
||||
where
|
||||
isAmountValid :: Integer -> Scientific -> Bool
|
||||
isAmountValid b i = (fromIntegral b / 100000000.0) >= i
|
||||
label s w =
|
||||
padBottom (Pad 1) $ vLimit 1 (hLimit 15 $ str s <+> fill ' ') <+> w
|
||||
--}
|
||||
mkNewABForm :: AdrBookEntry -> Form AdrBookEntry e Name
|
||||
mkNewABForm =
|
||||
newForm
|
||||
|
@ -1035,7 +1144,10 @@ appEvent (BT.AppEvent t) = do
|
|||
AdrBookDelForm -> return ()
|
||||
DeshieldForm -> return ()
|
||||
ShieldForm -> return ()
|
||||
ShowFIATBalance -> return()
|
||||
ViewingKeyShow -> return ()
|
||||
ViewingKeyMenu -> return ()
|
||||
ShowFIATBalance -> return ()
|
||||
PaymentURIShow -> return ()
|
||||
Blank -> do
|
||||
if s ^. timer == 90
|
||||
then do
|
||||
|
@ -1619,19 +1731,65 @@ appEvent (BT.VtyEvent e) = do
|
|||
V.EvKey (V.KChar 'x') [] ->
|
||||
BT.modify $ set dialogBox Blank
|
||||
V.EvKey (V.KChar 'r') [] -> do
|
||||
BT.modify $ set dialogBox Blank
|
||||
zpr <- liftIO $ getZcashPrice $ s ^. currencyCode
|
||||
case zpr of
|
||||
Just p -> do
|
||||
BT.modify $ set zprice p
|
||||
BT.modify $ set dialogBox ShowFIATBalance
|
||||
Nothing -> do
|
||||
BT.modify $ set msg ("CoinGecko is not responding!!!")
|
||||
BT.modify $ set displayBox MsgDisplay
|
||||
BT.modify $ set dialogBox Blank
|
||||
zpr <- liftIO $ getZcashPrice $ s ^. currencyCode
|
||||
case zpr of
|
||||
Just p -> do
|
||||
BT.modify $ set zprice p
|
||||
BT.modify $ set dialogBox ShowFIATBalance
|
||||
Nothing -> do
|
||||
BT.modify $
|
||||
set msg ("CoinGecko is not responding!!!")
|
||||
BT.modify $ set displayBox MsgDisplay
|
||||
-- Process any other event
|
||||
ev -> BT.zoom abAddresses $ L.handleListEvent ev
|
||||
--
|
||||
-- Viewing Key Display Support
|
||||
--
|
||||
ViewingKeyShow -> do
|
||||
case e of
|
||||
V.EvKey (V.KChar 'c') [] -> do
|
||||
liftIO $ setClipboard $ T.unpack $ s ^. vkData
|
||||
BT.modify $
|
||||
set msg $
|
||||
(T.unpack (s ^. vkName)) ++
|
||||
" viewing key copied to Clipboard!!"
|
||||
BT.modify $ set displayBox MsgDisplay
|
||||
V.EvKey (V.KChar 'e') [] -> do
|
||||
BT.modify $ set vkName ""
|
||||
BT.modify $ set vkData ""
|
||||
BT.modify $ set dialogBox ViewingKeyMenu
|
||||
ev -> return ()
|
||||
--
|
||||
ViewingKeyMenu -> do
|
||||
case e of
|
||||
V.EvKey (V.KChar 'f') [] -> do
|
||||
BT.modify $ set vkName "Full"
|
||||
BT.modify $
|
||||
set
|
||||
vkData
|
||||
"VKFull->ztestsapling1tgjr4zppwk4ne8xy6gdq4z2gwq7dmf5jq8z2ctpn8nlmtse0a74fa5z0m8z383gmpgqz6q6duu4"
|
||||
BT.modify $ set dialogBox ViewingKeyShow
|
||||
V.EvKey (V.KChar 'i') [] -> do
|
||||
BT.modify $ set vkName "Incomming"
|
||||
BT.modify $
|
||||
set
|
||||
vkData
|
||||
"VKIncoming->ztestsapling1tgjr4zppwk4ne8xy6gdq4z2gwq7dmf5jq8z2ctpn8nlmtse0a74fa5z0m8z383gmpgqz6q6duu4"
|
||||
BT.modify $ set dialogBox ViewingKeyShow
|
||||
V.EvKey (V.KChar 'e') [] ->
|
||||
BT.modify $ set dialogBox Blank
|
||||
ev -> return ()
|
||||
--
|
||||
-- Payment URI Form Events
|
||||
--
|
||||
PaymentURIShow -> do
|
||||
case e of
|
||||
V.EvKey V.KEsc [] -> BT.modify $ set dialogBox Blank
|
||||
ev -> return ()
|
||||
--
|
||||
-- Process any other event
|
||||
--
|
||||
Blank -> do
|
||||
case e of
|
||||
V.EvKey (V.KChar '\t') [] -> focusRing %= F.focusNext
|
||||
|
@ -1655,24 +1813,34 @@ appEvent (BT.VtyEvent e) = do
|
|||
set txForm $
|
||||
mkSendForm (s ^. balance) (SendInput "" 0.0 "" Full)
|
||||
BT.modify $ set dialogBox SendTx
|
||||
V.EvKey (V.KChar 'u') [] -> do
|
||||
BT.modify $
|
||||
set pmtURIForm $
|
||||
mkPaymentURIForm (s ^. balance) (PaymentInput 0.0 "")
|
||||
BT.modify $ set dialogBox PaymentURIShow
|
||||
V.EvKey (V.KChar 'b') [] ->
|
||||
BT.modify $ set dialogBox AdrBook
|
||||
-- >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
|
||||
V.EvKey (V.KChar 'l') [] -> do
|
||||
V.EvKey (V.KChar 'l') [] -> do
|
||||
if s ^. network == MainNet
|
||||
then do
|
||||
zpr <- liftIO $ getZcashPrice $ s ^. currencyCode
|
||||
case zpr of
|
||||
Just p -> do
|
||||
BT.modify $ set zprice p
|
||||
BT.modify $ set dialogBox ShowFIATBalance
|
||||
Nothing -> do
|
||||
BT.modify $ set msg ("Currency not supported (" ++ T.unpack (s ^. currencyCode ) ++ ")!!!")
|
||||
BT.modify $ set displayBox MsgDisplay
|
||||
else do
|
||||
BT.modify $ set msg "Balance conversion not available for TestNet"
|
||||
BT.modify $ set displayBox MsgDisplay
|
||||
-- <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
|
||||
then do
|
||||
zpr <- liftIO $ getZcashPrice $ s ^. currencyCode
|
||||
case zpr of
|
||||
Just p -> do
|
||||
BT.modify $ set zprice p
|
||||
BT.modify $ set dialogBox ShowFIATBalance
|
||||
Nothing -> do
|
||||
BT.modify $
|
||||
set
|
||||
msg
|
||||
("Currency not supported (" ++
|
||||
T.unpack (s ^. currencyCode) ++ ")!!!")
|
||||
BT.modify $ set displayBox MsgDisplay
|
||||
else do
|
||||
BT.modify $
|
||||
set
|
||||
msg
|
||||
"Balance conversion not available for TestNet"
|
||||
BT.modify $ set displayBox MsgDisplay
|
||||
V.EvKey (V.KChar 'd') [] -> do
|
||||
pool <- liftIO $ runNoLoggingT $ initPool $ s ^. dbPath
|
||||
selAcc <-
|
||||
|
@ -1724,7 +1892,8 @@ appEvent (BT.VtyEvent e) = do
|
|||
msg
|
||||
"Not enough transparent funds in this account"
|
||||
BT.modify $ set displayBox MsgDisplay
|
||||
|
||||
V.EvKey (V.KChar 'k') [] -> do
|
||||
BT.modify $ set dialogBox ViewingKeyMenu
|
||||
ev ->
|
||||
case r of
|
||||
Just AList ->
|
||||
|
@ -1877,8 +2046,11 @@ runZenithTUI config = do
|
|||
(mkDeshieldForm 0 (ShDshEntry 0.0))
|
||||
tBal
|
||||
sBal
|
||||
currencyCode
|
||||
currencyCode
|
||||
0
|
||||
""
|
||||
""
|
||||
(mkPaymentURIForm 0 $ PaymentInput 0.0 "")
|
||||
Left _e -> do
|
||||
print $
|
||||
"No Zebra node available on port " <>
|
||||
|
|
|
@ -69,21 +69,21 @@ import Zenith.Types hiding (ZcashAddress(..))
|
|||
import Zenith.Utils
|
||||
( displayAmount
|
||||
, getChainTip
|
||||
, getZcashPrice
|
||||
, isRecipientValidGUI
|
||||
, isValidString
|
||||
, isZecAddressValid
|
||||
, jsonNumber
|
||||
, padWithZero
|
||||
, parseZcashPayment
|
||||
, showAddress
|
||||
, validBarValue
|
||||
, getZcashPrice
|
||||
)
|
||||
|
||||
data VkTypeDef
|
||||
= VkNone
|
||||
= VkNone
|
||||
| VkFull
|
||||
| VkIncoming
|
||||
| VkOutgoing
|
||||
deriving (Eq, Show)
|
||||
|
||||
data AppEvent
|
||||
|
@ -157,12 +157,17 @@ data AppEvent
|
|||
| SendShield
|
||||
| StartSync
|
||||
| TreeSync
|
||||
| ShowFIATBalance
|
||||
| ShowFIATBalance
|
||||
| DisplayFIATBalance Double Double
|
||||
| CloseFIATBalance
|
||||
| ShowViewingKey !VkTypeDef !T.Text
|
||||
| ShowViewingKey !VkTypeDef !T.Text
|
||||
| CopyViewingKey !T.Text !T.Text
|
||||
| CloseShowVK
|
||||
| DisplayPaymentURI
|
||||
| ClosePaymentURI
|
||||
| DisplayPayUsingURI
|
||||
| ClosePayUsingURI
|
||||
| ProcIfValidURI
|
||||
deriving (Eq, Show)
|
||||
|
||||
data AppModel = AppModel
|
||||
|
@ -222,13 +227,16 @@ data AppModel = AppModel
|
|||
, _tBalanceValid :: !Bool
|
||||
, _sBalance :: !Integer
|
||||
, _sBalanceValid :: !Bool
|
||||
, _displayFIATBalance :: !Bool
|
||||
, _displayFIATBalance :: !Bool
|
||||
, _zPrice :: !Double
|
||||
, _aBal :: !Double
|
||||
, _viewingKeyPopup :: !Bool
|
||||
, _viewingKeyDisplay :: !Bool
|
||||
, _vkTypeName :: !T.Text
|
||||
, _vkData :: !T.Text
|
||||
, _paymentURIDisplay :: !Bool
|
||||
, _usepmtURIOverlay :: !Bool
|
||||
, _uriString :: !T.Text
|
||||
} deriving (Eq, Show)
|
||||
|
||||
makeLenses ''AppModel
|
||||
|
@ -279,7 +287,9 @@ buildUI wenv model = widgetTree
|
|||
, updateABAddressOverlay (model ^. abdescrip) (model ^. abaddress) `nodeVisible`
|
||||
model ^.
|
||||
updateABAddress
|
||||
, showVKOverlay `nodeVisible` model ^. viewingKeyDisplay
|
||||
, showVKOverlay `nodeVisible` model ^. viewingKeyDisplay
|
||||
, paymentURIOverlay `nodeVisible` model ^. paymentURIDisplay
|
||||
, pmtUsingURIOverlay `nodeVisible` model ^. usepmtURIOverlay
|
||||
, shieldOverlay `nodeVisible` model ^. shieldZec
|
||||
, deShieldOverlay `nodeVisible` model ^. deShieldZec
|
||||
, msgAdrBookOverlay `nodeVisible` isJust (model ^. msgAB)
|
||||
|
@ -351,7 +361,7 @@ buildUI wenv model = widgetTree
|
|||
[bgColor white, borderB 1 gray, padding 3]
|
||||
, box_ [alignLeft, onClick ShowDeShield] (label "De-Shield ZEC") `styleBasic`
|
||||
[bgColor white, borderB 1 gray, padding 3]
|
||||
, box_
|
||||
, box_
|
||||
[alignLeft]
|
||||
(vstack
|
||||
[ box_
|
||||
|
@ -364,10 +374,21 @@ buildUI wenv model = widgetTree
|
|||
, widgetIf (model ^. viewingKeyPopup) $
|
||||
remixIcon remixMenuFoldFill
|
||||
])
|
||||
, widgetIf (model ^. viewingKeyPopup) $ animSlideIn viewingKeysBox
|
||||
, widgetIf (model ^. viewingKeyPopup) $
|
||||
animSlideIn viewingKeysBox
|
||||
]) `styleBasic`
|
||||
[bgColor white, borderB 1 gray, padding 3]
|
||||
, box_ [alignLeft, onClick ShowFIATBalance] ( label ("Balance in " <> T.toUpper (c_currencyCode (model ^. configuration) ) ) ) `styleBasic`
|
||||
, box_
|
||||
[alignLeft, onClick ShowFIATBalance]
|
||||
(label
|
||||
("Balance in " <>
|
||||
T.toUpper (c_currencyCode (model ^. configuration)))) `styleBasic`
|
||||
[bgColor white, borderB 1 gray, padding 3]
|
||||
, box_ [alignLeft, onClick DisplayPaymentURI] (label "Create URI") `styleBasic`
|
||||
[bgColor white, borderB 1 gray, padding 3]
|
||||
, box_
|
||||
[alignLeft, onClick DisplayPayUsingURI]
|
||||
(label "Pay using URI") `styleBasic`
|
||||
[bgColor white, borderB 1 gray, padding 3]
|
||||
]) `styleBasic`
|
||||
[bgColor btnColor, padding 3]
|
||||
|
@ -393,17 +414,23 @@ buildUI wenv model = widgetTree
|
|||
[alignMiddle]
|
||||
(vstack
|
||||
[ box_
|
||||
[alignLeft, onClick (ShowViewingKey VkFull "VKFull->ztestsapling1tgjr4zppwk4ne8xy6gdq4z2gwq7dmf5jq8z2ctpn8nlmtse0a74fa5z0m8z383gmpgqz6q6duu4")]
|
||||
[ alignLeft
|
||||
, onClick
|
||||
(ShowViewingKey
|
||||
VkFull
|
||||
"VKFull->ztestsapling1tgjr4zppwk4ne8xy6gdq4z2gwq7dmf5jq8z2ctpn8nlmtse0a74fa5z0m8z383gmpgqz6q6duu4")
|
||||
]
|
||||
(hstack [label "Full VK", filler]) `styleBasic`
|
||||
[bgColor white, borderB 1 gray, padding 3]
|
||||
, box_
|
||||
[alignLeft, onClick $ (ShowViewingKey VkIncoming "VKIncoming->ztestsapling1tgjr4zppwk4ne8xy6gdq4z2gwq7dmf5jq8z2ctpn8nlmtse0a74fa5z0m8z383gmpgqz6q6duu4")]
|
||||
[ alignLeft
|
||||
, onClick $
|
||||
(ShowViewingKey
|
||||
VkIncoming
|
||||
"VKIncoming->ztestsapling1tgjr4zppwk4ne8xy6gdq4z2gwq7dmf5jq8z2ctpn8nlmtse0a74fa5z0m8z383gmpgqz6q6duu4")
|
||||
]
|
||||
(hstack [label "Incoming VK", filler]) `styleBasic`
|
||||
[bgColor white, borderB 1 gray, padding 3]
|
||||
, box_
|
||||
[alignLeft, onClick $ (ShowViewingKey VkOutgoing "VKOutgoing->ztestsapling1tgjr4zppwk4ne8xy6gdq4z2gwq7dmf5jq8z2ctpn8nlmtse0a74fa5z0m8z383gmpgqz6q6duu4")]
|
||||
(hstack [label "Outgoing VK", filler]) `styleBasic`
|
||||
[bgColor white, borderB 1 gray, padding 3]
|
||||
])
|
||||
walletButton =
|
||||
hstack
|
||||
|
@ -1051,20 +1078,31 @@ buildUI wenv model = widgetTree
|
|||
, label_ (txtWrapN (fromMaybe "" (model ^. msgAB)) 64) [multiline]
|
||||
, filler
|
||||
]
|
||||
dfBalOverlay =
|
||||
dfBalOverlay =
|
||||
alert CloseFIATBalance $
|
||||
vstack
|
||||
vstack
|
||||
[ box_
|
||||
[]
|
||||
(label ("Account Balance in " <> (T.toUpper (c_currencyCode (model ^. configuration))) ) `styleBasic`
|
||||
(label
|
||||
("Account Balance in " <>
|
||||
(T.toUpper (c_currencyCode (model ^. configuration)))) `styleBasic`
|
||||
[textFont "Bold", textSize 12, textColor white]) `styleBasic`
|
||||
[bgColor btnColor, radius 2, padding 3]
|
||||
, filler
|
||||
, (label ("1 ZEC = " <> ( T.pack (printf "%.2f" ( model ^. zPrice ))) <> " " <> (T.toUpper (c_currencyCode (model ^. configuration))) ) ) `styleBasic` []
|
||||
, filler
|
||||
, (label ( ( T.pack (printf "%.8f" (model ^. aBal) ) <> " ZEC = " <> ( T.pack (printf "%.2f" (( model ^. zPrice )*( model ^. aBal ) ) ) ) <> " " <> (T.toUpper (c_currencyCode (model ^. configuration))) ) ) ) `styleBasic` []
|
||||
]
|
||||
showVKOverlay =
|
||||
, (label
|
||||
("1 ZEC = " <>
|
||||
(T.pack (printf "%.2f" (model ^. zPrice))) <>
|
||||
" " <> (T.toUpper (c_currencyCode (model ^. configuration))))) `styleBasic`
|
||||
[]
|
||||
, filler
|
||||
, (label
|
||||
((T.pack (printf "%.8f" (model ^. aBal)) <>
|
||||
" ZEC = " <>
|
||||
(T.pack (printf "%.2f" ((model ^. zPrice) * (model ^. aBal)))) <>
|
||||
" " <> (T.toUpper (c_currencyCode (model ^. configuration)))))) `styleBasic`
|
||||
[]
|
||||
]
|
||||
showVKOverlay =
|
||||
alert CloseShowVK $
|
||||
vstack
|
||||
[ box_
|
||||
|
@ -1073,11 +1111,13 @@ buildUI wenv model = widgetTree
|
|||
[textFont "Bold", textColor white, textSize 12, padding 3]) `styleBasic`
|
||||
[bgColor btnColor, radius 2, padding 3]
|
||||
, spacer
|
||||
, hstack [filler, label_ (txtWrapN (model ^. vkData) 64) [multiline], filler]
|
||||
, hstack
|
||||
[filler, label_ (txtWrapN (model ^. vkData) 64) [multiline], filler]
|
||||
, spacer
|
||||
, hstack
|
||||
[ filler
|
||||
, button "Copy to Clipboard" $ CopyViewingKey (model ^. vkTypeName) (model ^. vkData)
|
||||
, button "Copy to Clipboard" $
|
||||
CopyViewingKey (model ^. vkTypeName) (model ^. vkData)
|
||||
, filler
|
||||
]
|
||||
]
|
||||
|
@ -1196,8 +1236,106 @@ buildUI wenv model = widgetTree
|
|||
, filler
|
||||
]) `styleBasic`
|
||||
[bgColor (white & L.a .~ 0.5)]
|
||||
|
||||
notImplemented = NotImplemented
|
||||
paymentURIOverlay =
|
||||
box
|
||||
(vstack
|
||||
[ filler
|
||||
, hstack
|
||||
[ filler
|
||||
, box_
|
||||
[]
|
||||
(vstack
|
||||
[ box_
|
||||
[alignMiddle]
|
||||
(label "Create URI" `styleBasic`
|
||||
[textColor white, textFont "Bold", textSize 12]) `styleBasic`
|
||||
[bgColor btnColor]
|
||||
, separatorLine `styleBasic` [fgColor btnColor]
|
||||
, spacer
|
||||
, hstack
|
||||
[ label "Amount:" `styleBasic`
|
||||
[width 50, textFont "Bold"]
|
||||
, spacer
|
||||
, numericField_
|
||||
sendAmount
|
||||
[ decimals 8
|
||||
, minValue 0.0
|
||||
, maxValue
|
||||
(fromIntegral (model ^. balance) / 100000000.0)
|
||||
, validInput amountValid
|
||||
, onChange CheckAmount
|
||||
] `styleBasic`
|
||||
[ width 150
|
||||
, styleIf
|
||||
(not $ model ^. amountValid)
|
||||
(textColor red)
|
||||
]
|
||||
]
|
||||
, hstack
|
||||
[ label "Memo:" `styleBasic`
|
||||
[width 50, textFont "Bold"]
|
||||
, spacer
|
||||
, textArea sendMemo `styleBasic`
|
||||
[width 150, height 40]
|
||||
]
|
||||
, spacer
|
||||
, box_
|
||||
[alignMiddle]
|
||||
(hstack
|
||||
[ spacer
|
||||
, mainButton "Create URI" NotImplemented `nodeEnabled`
|
||||
True
|
||||
, spacer
|
||||
, button "Cancel" ClosePaymentURI
|
||||
, spacer
|
||||
])
|
||||
]) `styleBasic`
|
||||
[radius 4, border 2 btnColor, bgColor white, padding 4]
|
||||
, filler
|
||||
]
|
||||
, filler
|
||||
]) `styleBasic`
|
||||
[bgColor (white & L.a .~ 0.5)]
|
||||
pmtUsingURIOverlay =
|
||||
box
|
||||
(vstack
|
||||
[ filler
|
||||
, hstack
|
||||
[ filler
|
||||
, box_
|
||||
[]
|
||||
(vstack
|
||||
[ box_
|
||||
[alignMiddle]
|
||||
(label "Pay using URI" `styleBasic`
|
||||
[textColor white, textFont "Bold", textSize 12]) `styleBasic`
|
||||
[bgColor btnColor]
|
||||
, separatorLine `styleBasic` [fgColor btnColor]
|
||||
, spacer
|
||||
, hstack
|
||||
[ label "URI :" `styleBasic`
|
||||
[width 30, textFont "Bold"]
|
||||
, spacer
|
||||
, textArea uriString `styleBasic`
|
||||
[width 170, height 30]
|
||||
]
|
||||
, spacer
|
||||
, box_
|
||||
[alignMiddle]
|
||||
(hstack
|
||||
[ spacer
|
||||
, button "Cancel" ClosePayUsingURI
|
||||
, spacer
|
||||
, mainButton "Process" ProcIfValidURI
|
||||
, spacer
|
||||
])
|
||||
]) `styleBasic`
|
||||
[radius 4, border 2 btnColor, bgColor white, padding 4]
|
||||
, filler
|
||||
]
|
||||
, filler
|
||||
]) `styleBasic`
|
||||
[bgColor (white & L.a .~ 0.5)]
|
||||
|
||||
generateQRCodes :: Config -> IO ()
|
||||
generateQRCodes config = do
|
||||
|
@ -1320,11 +1458,13 @@ handleEvent wenv node model evt =
|
|||
False
|
||||
]
|
||||
ConfirmCancel -> [Model $ model & confirmTitle .~ Nothing & mainInput .~ ""]
|
||||
ViewingKeysClicked -> [Model $ model & viewingKeyPopup .~ not (model ^. viewingKeyPopup)]
|
||||
NewAddress vk ->
|
||||
[ Model $
|
||||
model & confirmTitle ?~ "New Address" &
|
||||
confirmCancel .~ "Cancel" & menuPopup .~ False
|
||||
ViewingKeysClicked ->
|
||||
[Model $ model & viewingKeyPopup .~ not (model ^. viewingKeyPopup)]
|
||||
NewAddress vk ->
|
||||
[ Model $
|
||||
model & confirmTitle ?~ "New Address" & confirmCancel .~ "Cancel" &
|
||||
menuPopup .~
|
||||
False
|
||||
]
|
||||
ShowSeed -> [Model $ model & showSeed .~ True & menuPopup .~ False]
|
||||
ShowSend ->
|
||||
|
@ -1589,7 +1729,7 @@ handleEvent wenv node model evt =
|
|||
CopyViewingKey t v ->
|
||||
[ setClipboardData ClipboardEmpty
|
||||
, setClipboardData $ ClipboardText v
|
||||
, Event $ ShowMessage ( t <> " viewing key copied!!")
|
||||
, Event $ ShowMessage (t <> " viewing key copied!!")
|
||||
]
|
||||
DeleteABEntry a ->
|
||||
[ Task $ deleteAdrBook (model ^. configuration) a
|
||||
|
@ -1602,33 +1742,97 @@ handleEvent wenv node model evt =
|
|||
]
|
||||
ShowMessage a -> [Model $ model & msgAB ?~ a & menuPopup .~ False]
|
||||
NotImplemented ->
|
||||
[ Model $
|
||||
[ Model $
|
||||
model & msgAB ?~ "Function not implemented..." & menuPopup .~ False
|
||||
]
|
||||
CloseMsgAB -> [Model $ model & msgAB .~ Nothing & inError .~ False]
|
||||
CloseShowVK -> [Model $ model & vkTypeName .~ "" & vkData .~ "" & viewingKeyDisplay .~ False]
|
||||
CloseShowVK ->
|
||||
[ Model $
|
||||
model & vkTypeName .~ "" & vkData .~ "" & viewingKeyDisplay .~ False
|
||||
]
|
||||
--
|
||||
-- Show Balance in FIAT
|
||||
--
|
||||
DisplayFIATBalance zpr abal ->
|
||||
[ Model $ model & zPrice .~ zpr & aBal .~ abal & displayFIATBalance .~ True & menuPopup .~ False
|
||||
[ Model $
|
||||
model & zPrice .~ zpr & aBal .~ abal & displayFIATBalance .~ True &
|
||||
menuPopup .~
|
||||
False
|
||||
]
|
||||
ShowFIATBalance ->
|
||||
if model ^. network == MainNet
|
||||
then [ Task $ sfBalance (model ^. configuration)
|
||||
]
|
||||
else [ Model $ model & zPrice .~ 0.0 & aBal .~ 0.0
|
||||
, Event $ ShowError "Balance conversion not available for TestNet"
|
||||
]
|
||||
ShowFIATBalance ->
|
||||
if model ^. network == MainNet
|
||||
then [Task $ sfBalance (model ^. configuration)]
|
||||
else [ Model $ model & zPrice .~ 0.0 & aBal .~ 0.0
|
||||
, Event $ ShowError "Balance conversion not available for TestNet"
|
||||
]
|
||||
CloseFIATBalance -> [Model $ model & displayFIATBalance .~ False]
|
||||
--
|
||||
-- Show Viewing Keys
|
||||
--
|
||||
ShowViewingKey vkType vkText ->
|
||||
case vkType of
|
||||
VkFull -> [ Model $ model & vkTypeName .~ "Full" & vkData .~ vkText & viewingKeyDisplay .~ True & menuPopup .~ False]
|
||||
VkIncoming -> [ Model $ model & vkTypeName .~ "Incoming" & vkData .~ vkText & viewingKeyDisplay .~ True & menuPopup .~ False]
|
||||
VkOutgoing -> [ Model $ model & vkTypeName .~ "Outgoing" & vkData .~ vkText & viewingKeyDisplay .~ True & menuPopup .~ False]
|
||||
ShowViewingKey vkType vkText ->
|
||||
case vkType of
|
||||
VkFull ->
|
||||
[ Model $
|
||||
model & vkTypeName .~ "Full" & vkData .~ vkText & viewingKeyDisplay .~
|
||||
True &
|
||||
menuPopup .~
|
||||
False
|
||||
]
|
||||
VkIncoming ->
|
||||
[ Model $
|
||||
model & vkTypeName .~ "Incoming" & vkData .~ vkText &
|
||||
viewingKeyDisplay .~
|
||||
True &
|
||||
menuPopup .~
|
||||
False
|
||||
]
|
||||
--
|
||||
-- Display PaymentURI Form
|
||||
--
|
||||
DisplayPaymentURI ->
|
||||
[ Model $
|
||||
model & paymentURIDisplay .~ True & uriString .~ "" & menuPopup .~ False
|
||||
]
|
||||
ClosePaymentURI -> [Model $ model & paymentURIDisplay .~ False]
|
||||
--
|
||||
-- Display Pay using URI Form
|
||||
--
|
||||
DisplayPayUsingURI ->
|
||||
[Model $ model & usepmtURIOverlay .~ True & menuPopup .~ False]
|
||||
ClosePayUsingURI -> [Model $ model & usepmtURIOverlay .~ False]
|
||||
ProcIfValidURI -> do
|
||||
let zp = parseZcashPayment $ T.unpack (model ^. uriString)
|
||||
case zp of
|
||||
Right p -> do
|
||||
case uriAmount p of
|
||||
Just a ->
|
||||
[ Model $
|
||||
model & usepmtURIOverlay .~ False & openSend .~ True &
|
||||
privacyChoice .~
|
||||
Full &
|
||||
recipientValid .~
|
||||
False &
|
||||
sendRecipient .~
|
||||
T.pack (uriAddress p) &
|
||||
sendAmount .~
|
||||
realToFrac a &
|
||||
sendMemo .~
|
||||
(uriMemo p)
|
||||
, Event $ ClosePaymentURI
|
||||
]
|
||||
Nothing ->
|
||||
[ Model $
|
||||
model & usepmtURIOverlay .~ False & openSend .~ False &
|
||||
uriString .~
|
||||
""
|
||||
, Event $ ShowError "Invalid URI"
|
||||
]
|
||||
Left e ->
|
||||
[ Model $
|
||||
model & usepmtURIOverlay .~ False & openSend .~ False & uriString .~
|
||||
""
|
||||
, Event $ ShowError "Invalid URI"
|
||||
]
|
||||
--
|
||||
--
|
||||
ShowShield ->
|
||||
|
@ -1643,7 +1847,8 @@ handleEvent wenv node model evt =
|
|||
[ Task $ updAddrBookDescrip (model ^. configuration) d a
|
||||
, Model $
|
||||
model & abdescrip .~ "" & abaddress .~ "" & updateABAddress .~ False &
|
||||
showABAddress .~ False
|
||||
showABAddress .~
|
||||
False
|
||||
, Task $ do
|
||||
dbPool <- runNoLoggingT $ initPool $ c_dbPath $ model ^. configuration
|
||||
abList <- getAdrBook dbPool $ model ^. network
|
||||
|
@ -1796,9 +2001,16 @@ handleEvent wenv node model evt =
|
|||
zpr <- liftIO $ getZcashPrice $ c_currencyCode config
|
||||
case zpr of
|
||||
Just zp -> do
|
||||
let zbal = ( dbal (model ^. balance) ) / 100000000
|
||||
return $ DisplayFIATBalance zp zbal
|
||||
Nothing -> return $ ShowMessage ( "Currency not supported [" <> c_currencyCode config <> "]")
|
||||
let zbal = (dbal (model ^. balance)) / 100000000
|
||||
return $ DisplayFIATBalance zp zbal
|
||||
Nothing ->
|
||||
return $
|
||||
ShowMessage
|
||||
("Currency not supported [" <> c_currencyCode config <> "]")
|
||||
--
|
||||
procIfValidURI :: T.Text -> IO AppEvent
|
||||
procIfValidURI ustr = do
|
||||
return $ ShowSend
|
||||
|
||||
scanZebra ::
|
||||
T.Text
|
||||
|
@ -2163,6 +2375,9 @@ runZenithGUI config = do
|
|||
False
|
||||
""
|
||||
""
|
||||
False
|
||||
False
|
||||
""
|
||||
startApp model handleEvent buildUI (params hD)
|
||||
Left _e -> print "Zebra not available"
|
||||
where
|
||||
|
|
|
@ -10,6 +10,7 @@ import Control.Monad.Logger
|
|||
( NoLoggingT
|
||||
, logErrorN
|
||||
, logInfoN
|
||||
, runFileLoggingT
|
||||
, runNoLoggingT
|
||||
, runStderrLoggingT
|
||||
)
|
||||
|
@ -58,6 +59,7 @@ import Zenith.Types
|
|||
, ZcashNetDB(..)
|
||||
, ZenithStatus(..)
|
||||
)
|
||||
import Zenith.Types (Config(..), HexStringDB(..), ZcashNetDB(..))
|
||||
import Zenith.Utils (jsonNumber)
|
||||
|
||||
-- | Function to scan the Zcash blockchain through the Zebra node and populate the Zenith database
|
||||
|
|
|
@ -112,7 +112,7 @@ data Config = Config
|
|||
, c_zenithUser :: !BS.ByteString
|
||||
, c_zenithPwd :: !BS.ByteString
|
||||
, c_zenithPort :: !Int
|
||||
, c_currencyCode :: !T.Text
|
||||
, c_currencyCode :: !T.Text
|
||||
} deriving (Eq, Prelude.Show)
|
||||
|
||||
data ZcashPool
|
||||
|
@ -508,3 +508,12 @@ encodeHexText' t =
|
|||
if T.length t > 0
|
||||
then C.unpack . B64.encode $ E.encodeUtf8 t
|
||||
else C.unpack . B64.encode $ E.encodeUtf8 "Sent from Zenith"
|
||||
|
||||
-- | Define a data structure for the parsed components
|
||||
data ZcashPaymentURI = ZcashPaymentURI
|
||||
{ uriAddress :: String
|
||||
, uriAmount :: Maybe Double
|
||||
, uriMemo :: T.Text
|
||||
, uriLabel :: Maybe String
|
||||
, uriMessage :: Maybe String
|
||||
} deriving (Show, Eq)
|
||||
|
|
|
@ -2,25 +2,31 @@
|
|||
|
||||
module Zenith.Utils where
|
||||
|
||||
import Control.Exception (SomeException, try)
|
||||
import Control.Monad (when)
|
||||
import Data.Aeson
|
||||
import Data.Aeson.Types (parseMaybe)
|
||||
import qualified Data.Aeson.Key as K
|
||||
import qualified Data.Aeson.KeyMap as KM
|
||||
import Data.Aeson.Types (parseMaybe)
|
||||
import qualified Data.ByteString.Base64 as B64
|
||||
import qualified Data.ByteString.Char8 as BC
|
||||
import qualified Data.ByteString.Lazy as B
|
||||
import qualified Data.ByteString.Lazy.Char8 as BL
|
||||
import Data.Char (isAlphaNum, isSpace)
|
||||
import Data.Functor (void)
|
||||
import Data.Maybe
|
||||
import Data.Ord (clamp)
|
||||
import Data.Scientific (Scientific(..), scientific)
|
||||
import Data.Scientific (Scientific, toRealFloat)
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.Text.Encoding as E
|
||||
import Control.Exception (try, SomeException)
|
||||
import Control.Monad (when)
|
||||
import qualified Data.ByteString.Lazy as B
|
||||
import qualified Data.ByteString.Lazy.Char8 as BL
|
||||
import qualified Data.Text.Encoding as TE
|
||||
import Network.HTTP.Simple
|
||||
import System.Directory
|
||||
import System.Process (createProcess_, shell)
|
||||
import Text.Regex.Posix
|
||||
import Text.Printf (printf)
|
||||
import Text.Read (readMaybe)
|
||||
import Text.Regex.Posix
|
||||
import ZcashHaskell.Orchard
|
||||
( encodeUnifiedAddress
|
||||
, isValidUnifiedAddress
|
||||
|
@ -33,10 +39,12 @@ import ZcashHaskell.Transparent
|
|||
)
|
||||
import ZcashHaskell.Types
|
||||
( ExchangeAddress(..)
|
||||
, ExchangeAddress(..)
|
||||
, SaplingAddress(..)
|
||||
, TransparentAddress(..)
|
||||
, UnifiedAddress(..)
|
||||
, ValidAddress(..)
|
||||
, ValidAddress(..)
|
||||
, ZcashNet(..)
|
||||
)
|
||||
import ZcashHaskell.Utils (makeZebraCall)
|
||||
|
@ -45,11 +53,9 @@ import Zenith.Types
|
|||
, PrivacyPolicy(..)
|
||||
, UnifiedAddressDB(..)
|
||||
, ZcashAddress(..)
|
||||
, ZcashPaymentURI(..)
|
||||
, ZcashPool(..)
|
||||
)
|
||||
import Network.HTTP.Simple
|
||||
import Data.Scientific (Scientific, toRealFloat)
|
||||
|
||||
|
||||
-- | Helper function to convert numbers into JSON
|
||||
jsonNumber :: Int -> Value
|
||||
|
@ -263,17 +269,68 @@ getChainTip zHost zPort = do
|
|||
-- Function to fetch Zcash price from CoinGecko
|
||||
getZcashPrice :: T.Text -> IO (Maybe Double)
|
||||
getZcashPrice currency = do
|
||||
let url = "https://api.coingecko.com/api/v3/simple/price?ids=zcash&vs_currencies=" <> T.unpack currency
|
||||
response <- httpJSONEither (parseRequest_ url)
|
||||
case getResponseBody response of
|
||||
Right (Object obj) -> do
|
||||
let url =
|
||||
"https://api.coingecko.com/api/v3/simple/price?ids=zcash&vs_currencies=" <>
|
||||
T.unpack currency
|
||||
response <- httpJSONEither (parseRequest_ url)
|
||||
case getResponseBody response of
|
||||
Right (Object obj)
|
||||
-- Extract "zcash" object
|
||||
case KM.lookup "zcash" obj of
|
||||
Just (Object zcashObj) ->
|
||||
-> do
|
||||
case KM.lookup "zcash" obj of
|
||||
Just (Object zcashObj)
|
||||
-- Extract the currency price
|
||||
case KM.lookup (K.fromText (T.toLower currency)) zcashObj of
|
||||
Just (Number price) -> return (Just (toRealFloat price))
|
||||
_ -> return Nothing
|
||||
_ -> return Nothing
|
||||
_ -> return Nothing
|
||||
|
||||
->
|
||||
case KM.lookup (K.fromText (T.toLower currency)) zcashObj of
|
||||
Just (Number price) -> return (Just (toRealFloat price))
|
||||
_ -> return Nothing
|
||||
_ -> return Nothing
|
||||
_ -> return Nothing
|
||||
|
||||
-- Parse memo result to convert it to a ByteString
|
||||
processEither :: Either String BC.ByteString -> BC.ByteString
|
||||
processEither (Right bs) = bs
|
||||
processEither (Left e) = BC.pack e -- Returns the error message
|
||||
|
||||
-- Parse the query string into key-value pairs
|
||||
parseQuery :: String -> [(String, String)]
|
||||
parseQuery query = map (breakOn '=') (splitOn '&' query)
|
||||
where
|
||||
splitOn :: Char -> String -> [String]
|
||||
splitOn _ [] = [""]
|
||||
splitOn delim (c:cs)
|
||||
| c == delim = "" : rest
|
||||
| otherwise = (c : head rest) : tail rest
|
||||
where
|
||||
rest = splitOn delim cs
|
||||
breakOn :: Char -> String -> (String, String)
|
||||
breakOn delim str = (key, drop 1 value)
|
||||
where
|
||||
(key, value) = span (/= delim) str
|
||||
|
||||
-- Parse a ZIP-321 encoded string into a ZcashPayment structure
|
||||
parseZcashPayment :: String -> Either String ZcashPaymentURI
|
||||
parseZcashPayment input
|
||||
| not (T.isPrefixOf "zcash:" (T.pack input)) = Left "Invalid scheme: must start with 'zcash:'"
|
||||
| otherwise =
|
||||
let (addrPart, queryPart) = break (== '?') (drop 6 input)
|
||||
queryParams = parseQuery (drop 1 queryPart)
|
||||
in Right ZcashPaymentURI
|
||||
{ uriAddress = addrPart
|
||||
, uriAmount = lookup "amount" queryParams >>= readMaybe
|
||||
, uriMemo = case lookup "memo" queryParams of
|
||||
Just m -> T.pack ( BC.unpack (processEither $ decodeBase64Unpadded (BC.pack m) ) )
|
||||
_ -> ""
|
||||
, uriLabel = lookup "label" queryParams
|
||||
, uriMessage = lookup "message" queryParams
|
||||
}
|
||||
|
||||
-- Function to pad a base64 string if it's not a multiple of 4
|
||||
padBase64 :: BC.ByteString -> BC.ByteString
|
||||
padBase64 bs = bs <> BC.replicate paddingLength '='
|
||||
where
|
||||
paddingLength = (4 - BC.length bs `mod` 4) `mod` 4
|
||||
|
||||
-- Function to decode a base64 un-padded string
|
||||
decodeBase64Unpadded :: BC.ByteString -> Either String BC.ByteString
|
||||
decodeBase64Unpadded = B64.decode . padBase64
|
||||
|
|
|
@ -58,7 +58,16 @@ main = do
|
|||
zebraPort <- require config "zebraPort"
|
||||
zebraHost <- require config "zebraHost"
|
||||
nodePort <- require config "nodePort"
|
||||
let myConfig = Config dbFilePath zebraHost zebraPort nodeUser nodePwd nodePort
|
||||
currencyCode <- require config "currencyCode"
|
||||
let myConfig =
|
||||
Config
|
||||
dbFilePath
|
||||
zebraHost
|
||||
zebraPort
|
||||
nodeUser
|
||||
nodePwd
|
||||
nodePort
|
||||
currencyCode
|
||||
hspec $ do
|
||||
describe "RPC methods" $ do
|
||||
beforeAll_ (startAPI myConfig) $ do
|
||||
|
|
33
test/Spec.hs
33
test/Spec.hs
|
@ -645,8 +645,7 @@ main = do
|
|||
case ix of
|
||||
Nothing -> assertFailure "couldn't find index at block"
|
||||
Just i -> do
|
||||
updatedTree <-
|
||||
runNoLoggingT $ truncateTree oTree i
|
||||
updatedTree <- runNoLoggingT $ truncateTree oTree i
|
||||
let finalAnchor =
|
||||
getOrchardTreeAnchor $
|
||||
OrchardCommitmentTree $ ztiOrchard zebraTreesIn
|
||||
|
@ -1109,5 +1108,33 @@ main = do
|
|||
it "Testing for USD " $ do
|
||||
price <- getZcashPrice $ T.pack "usd"
|
||||
case price of
|
||||
Just p -> p `shouldNotBe` 0.0
|
||||
Just p -> p `shouldNotBe` 0.0
|
||||
Nothing -> assertFailure "Failed to get ZEC price"
|
||||
describe "Parse an URI payment string (all fields filled) " $ do
|
||||
it ("Parsing URI -> " ++ "zcash:ztestsapling10yy2ex5....") $ do
|
||||
let zcashURI2 =
|
||||
"zcash:ztestsapling10yy2ex5dcqkclhc7z7yrnjq2z6feyjad56ptwlfgmy77dmaqqrl9gyhprdx59qgmsnyfska2kez?amount=100&memo=SGVsbG8sIFdvcmxkIQ==&message=Test"
|
||||
case parseZcashPayment zcashURI2 of
|
||||
Right p -> do
|
||||
print p
|
||||
(uriAmount p) `shouldBe` Just 100.0
|
||||
Left e -> assertFailure $ "Error: " ++ e
|
||||
describe
|
||||
"Parse an URI payment string (just address and amount fields provided) " $ do
|
||||
it ("Parsing URI -> " ++ "zcash:ztestsapling10yy2ex5....") $ do
|
||||
let zcashURI3 =
|
||||
"zcash:ztestsapling10yy2ex5dcqkclhc7z7yrnjq2z6feyjad56ptwlfgmy77dmaqqrl9gyhprdx59qgmsnyfska2kez?amount=100"
|
||||
case parseZcashPayment zcashURI3 of
|
||||
Right p -> do
|
||||
print p
|
||||
(uriAmount p) `shouldBe` Just 100.0
|
||||
Left e -> assertFailure $ "Error: " ++ e
|
||||
describe "Parse an URI payment string (invalid URI provided) " $ do
|
||||
it ("Parsing URI -> " ++ "zcash:ztestsapling10yy2ex5....") $ do
|
||||
let zcashURI3 =
|
||||
"z:ztestsapling10yy2ex5dcqkclhc7z7yrnjq2z6feyjad56ptwlfgmy77dmaqqrl9gyhprdx59qgmsnyfska2kez?amount=100"
|
||||
case parseZcashPayment zcashURI3 of
|
||||
Right p -> do
|
||||
print p
|
||||
(uriAmount p) `shouldBe` Just 100.0
|
||||
Left e -> assertFailure $ "Error: " ++ e
|
||||
|
|
|
@ -1 +1 @@
|
|||
Subproject commit 7d3ae36d2b48b8ed91a70e40a77fb7efe57765a0
|
||||
Subproject commit cfa862ec9495e810e7296fa6fe724b46dbe0ee52
|
Loading…
Reference in a new issue