Compare commits
134 commits
Author | SHA1 | Date | |
---|---|---|---|
df31e41684 | |||
c1f0d86f14 | |||
ee71b7acbb | |||
3da6a57d50 | |||
149d74d4e2 | |||
de3bc48c38 | |||
9ab31a6d9b | |||
9d4e8a255b | |||
9aaf712bad | |||
e4b6b36a7d | |||
d8457eceb6 | |||
ff6168b45e | |||
cc4ce8a280 | |||
332b7f5520 | |||
6b3ea31882 | |||
02ec4716e9 | |||
d476183a1d | |||
56bf19a6f6 | |||
63aa5e5984 | |||
fe8fb1fa3c | |||
cb927a0ab3 | |||
62b6ee3f32 | |||
9d1293ea03 | |||
1ed96dcbf8 | |||
d3d5d88bbc | |||
843821232d | |||
a290f9c912 | |||
c0520bcbc7 | |||
9e211762e0 | |||
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 |
15 changed files with 1292 additions and 47 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
|
||||
|
||||
|
|
11
app/Main.hs
11
app/Main.hs
|
@ -210,9 +210,18 @@ main = do
|
|||
zebraPort <- require config "zebraPort"
|
||||
zebraHost <- require config "zebraHost"
|
||||
nodePort <- require config "nodePort"
|
||||
currencyCode <- require config "currencyCode"
|
||||
dbFP <- getZenithPath
|
||||
let dbFilePath = T.pack $ dbFP ++ dbFileName
|
||||
let myConfig = Config dbFilePath zebraHost zebraPort nodeUser nodePwd nodePort
|
||||
let myConfig =
|
||||
Config
|
||||
dbFilePath
|
||||
zebraHost
|
||||
zebraPort
|
||||
nodeUser
|
||||
nodePwd
|
||||
nodePort
|
||||
currencyCode
|
||||
if not (null args)
|
||||
then do
|
||||
case head args
|
||||
|
|
|
@ -35,9 +35,18 @@ main = do
|
|||
zebraPort <- require config "zebraPort"
|
||||
zebraHost <- require config "zebraHost"
|
||||
nodePort <- require config "nodePort"
|
||||
currencyCode <- require config "currencyCode"
|
||||
dbFP <- getZenithPath
|
||||
let dbFilePath = T.pack $ dbFP ++ dbFileName
|
||||
let myConfig = Config dbFilePath zebraHost zebraPort nodeUser nodePwd nodePort
|
||||
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
|
||||
|
|
Binary file not shown.
Binary file not shown.
|
@ -75,7 +75,7 @@ import Control.Monad.Logger
|
|||
import Data.Aeson
|
||||
import Data.HexString (HexString(..), toText)
|
||||
import Data.Maybe
|
||||
import Data.Scientific (Scientific, scientific)
|
||||
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)
|
||||
|
@ -89,8 +89,14 @@ import Lens.Micro.Mtl
|
|||
import Lens.Micro.TH
|
||||
import System.Hclip
|
||||
import Text.Printf
|
||||
import Text.Wrap (FillScope(..), FillStrategy(..), WrapSettings(..))
|
||||
import ZcashHaskell.Keys (generateWalletSeedPhrase)
|
||||
import Text.Wrap
|
||||
( FillScope(..)
|
||||
, FillStrategy(..)
|
||||
, WrapSettings(..)
|
||||
, defaultWrapSettings
|
||||
, wrapTextToLines
|
||||
)
|
||||
import ZcashHaskell.Keys (generateWalletSeedPhrase, deriveUfvk, deriveUivk)
|
||||
import ZcashHaskell.Orchard
|
||||
( getSaplingFromUA
|
||||
, isValidUnifiedAddress
|
||||
|
@ -116,16 +122,24 @@ import Zenith.Types
|
|||
, ValidAddressAPI(..)
|
||||
, ZcashNetDB(..)
|
||||
, ZenithStatus(..)
|
||||
, OrchardSpendingKeyDB(..)
|
||||
, SaplingSpendingKeyDB(..)
|
||||
, TransparentSpendingKeyDB(..)
|
||||
, ZcashPaymentURI(..)
|
||||
, ZcashPool(..)
|
||||
)
|
||||
import Zenith.Utils
|
||||
( displayTaz
|
||||
, displayZec
|
||||
, getChainTip
|
||||
, getZcashPrice
|
||||
, isRecipientValid
|
||||
, isRecipientValidGUI
|
||||
, jsonNumber
|
||||
, showAddress
|
||||
, validBarValue
|
||||
, parseZcashPayment
|
||||
, createZip321
|
||||
)
|
||||
|
||||
data Name
|
||||
|
@ -150,6 +164,10 @@ data Name
|
|||
| DeshieldField
|
||||
| TotalTranspField
|
||||
| TotalShieldedField
|
||||
| SFBViewPort
|
||||
| URITransparentAddress
|
||||
| URISaplingAddress
|
||||
| URIUnifiedAddress
|
||||
deriving (Eq, Show, Ord)
|
||||
|
||||
data DialogInput = DialogInput
|
||||
|
@ -180,6 +198,21 @@ newtype ShDshEntry = ShDshEntry
|
|||
|
||||
makeLenses ''ShDshEntry
|
||||
|
||||
data PaymentInput = PaymentInput
|
||||
{ _pmtAddressPool :: ZcashPool
|
||||
, _pmtAmt :: !Scientific
|
||||
, _pmtMemo :: !T.Text
|
||||
} deriving (Show)
|
||||
|
||||
makeLenses ''PaymentInput
|
||||
|
||||
data URIText = URIText
|
||||
{
|
||||
_uriString :: !T.Text
|
||||
} deriving (Show)
|
||||
|
||||
makeLenses ''URIText
|
||||
|
||||
data DialogType
|
||||
= WName
|
||||
| AName
|
||||
|
@ -194,6 +227,13 @@ data DialogType
|
|||
| AdrBookDelForm
|
||||
| DeshieldForm
|
||||
| ShieldForm
|
||||
| ShowFIATBalance
|
||||
| ViewingKeyMenu
|
||||
| ViewingKeyShow
|
||||
| PaymentURICreate
|
||||
| PaymentURIShow
|
||||
| PayUsingURIShow
|
||||
| ProcessURIMenu
|
||||
|
||||
data DisplayType
|
||||
= AddrDisplay
|
||||
|
@ -211,7 +251,7 @@ data Tick
|
|||
| TickMsg !String
|
||||
| TickTx !HexString
|
||||
|
||||
data DropDownItem =
|
||||
newtype DropDownItem =
|
||||
DropdownItem String
|
||||
|
||||
data State = State
|
||||
|
@ -245,10 +285,37 @@ data State = State
|
|||
, _deshieldForm :: !(Form ShDshEntry () Name)
|
||||
, _tBalance :: !Integer
|
||||
, _sBalance :: !Integer
|
||||
, _currencyCode :: !T.Text
|
||||
, _zprice :: !Double
|
||||
, _vkName :: !T.Text
|
||||
, _vkData :: !T.Text
|
||||
, _pmtURIForm :: !(Form PaymentInput () Name)
|
||||
, _payUsingURIForm :: !(Form URIText () Name)
|
||||
}
|
||||
|
||||
makeLenses ''State
|
||||
|
||||
scientificToDouble :: Scientific -> Double
|
||||
scientificToDouble = toRealFloat
|
||||
|
||||
zBalance :: State -> Double
|
||||
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]
|
||||
where
|
||||
|
@ -298,13 +365,16 @@ drawUI s = [splashDialog s, helpDialog s, displayDialog s, inputDialog s, ui s]
|
|||
[ capCommand "W" "allets"
|
||||
, capCommand "A" "ccounts"
|
||||
, capCommand "V" "iew address"
|
||||
, capCommand3 "" "S" "end Tx"
|
||||
, capCommand "S" "end Tx"
|
||||
, capCommand "U" "RI Support"
|
||||
, 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)
|
||||
|
@ -375,7 +445,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", "q"]
|
||||
map
|
||||
(C.hCenter . str)
|
||||
["?", "Esc", "w", "a", "v", "s", "u", "b", "d", "k", "l", "q"]
|
||||
actionList =
|
||||
map
|
||||
(hLimit 40 . str)
|
||||
|
@ -385,8 +457,11 @@ drawUI s = [splashDialog s, helpDialog s, displayDialog s, inputDialog s, ui s]
|
|||
, "Switch accounts"
|
||||
, "View address"
|
||||
, "Send Tx"
|
||||
, "URI Menu"
|
||||
, "Address Book"
|
||||
, "Shield/De-Shield"
|
||||
, "Viewing Keys"
|
||||
, "Balance in Fiat"
|
||||
, "Quit"
|
||||
]
|
||||
inputDialog :: State -> Widget Name
|
||||
|
@ -432,7 +507,40 @@ drawUI s = [splashDialog s, helpDialog s, displayDialog s, inputDialog s, ui s]
|
|||
(D.dialog (Just (str " Send Transaction ")) Nothing 50)
|
||||
(renderForm (st ^. txForm) <=>
|
||||
C.hCenter
|
||||
(hBox [capCommand "↲ " "Send", capCommand "<esc> " "Cancel"]))
|
||||
(hBox [capCommand "↲ " "Send", capCommand3 " " "<esc> " "Cancel"]))
|
||||
--
|
||||
-- URI Support
|
||||
--
|
||||
-- | Create a New payment URI
|
||||
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 ->
|
||||
D.renderDialog
|
||||
(D.dialog (Just (str " Pay Using URI ")) Nothing 50)
|
||||
(renderForm (st ^. payUsingURIForm) <=>
|
||||
C.hCenter
|
||||
(hBox
|
||||
[capCommand "↲ " "Process", capCommand3 " " "<esc> " "Cancel"]))
|
||||
--
|
||||
DeshieldForm ->
|
||||
D.renderDialog
|
||||
(D.dialog (Just (str " De-Shield ZEC ")) Nothing 50)
|
||||
|
@ -452,7 +560,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)
|
||||
|
@ -463,7 +571,35 @@ 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"
|
||||
]))
|
||||
ProcessURIMenu ->
|
||||
D.renderDialog
|
||||
(D.dialog (Just (str " URI Support ")) Nothing 50)
|
||||
(C.hCenter
|
||||
(hBox
|
||||
[ capCommand "C" "reate Payment URI"
|
||||
, capCommand "P" "ay using an URI"
|
||||
, capCommand3 "" "E" "xit"
|
||||
]))
|
||||
Blank -> emptyWidget
|
||||
-- Address Book List
|
||||
AdrBook ->
|
||||
|
@ -516,7 +652,51 @@ drawUI s = [splashDialog s, helpDialog s, displayDialog s, inputDialog s, ui s]
|
|||
[ capCommand "C" "onfirm delete"
|
||||
, capCommand3 "" "<Esc>" " Cancel"
|
||||
]))
|
||||
--
|
||||
-- Show Balance in FIAT form
|
||||
ShowFIATBalance ->
|
||||
D.renderDialog
|
||||
(D.dialog
|
||||
(Just $
|
||||
str
|
||||
(" Account Balance (" ++
|
||||
(T.unpack (st ^. currencyCode)) ++ ") "))
|
||||
Nothing
|
||||
60)
|
||||
(withAttr abDefAttr $
|
||||
setAvailableSize (50, 8) $
|
||||
viewport SFBViewPort BT.Vertical $
|
||||
vLimit 8 $
|
||||
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")
|
||||
]
|
||||
])
|
||||
--
|
||||
splashDialog :: State -> Widget Name
|
||||
splashDialog st =
|
||||
if st ^. splashBox
|
||||
|
@ -549,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 =<<
|
||||
|
@ -577,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
|
||||
|
@ -707,6 +887,35 @@ mkSendForm bal =
|
|||
label s w =
|
||||
padBottom (Pad 1) $ vLimit 1 (hLimit 15 $ str s <+> fill ' ') <+> w
|
||||
|
||||
mkPaymentURIForm :: PaymentInput -> Form PaymentInput e Name
|
||||
mkPaymentURIForm =
|
||||
newForm
|
||||
[ 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 :: Scientific -> Bool
|
||||
isAmountValid i = i > 0.0
|
||||
label s w =
|
||||
padBottom (Pad 1) $ vLimit 1 (hLimit 20 $ str s <+> fill ' ') <+> w
|
||||
|
||||
mkPayUsingURIForm :: URIText -> Form URIText e Name
|
||||
mkPayUsingURIForm =
|
||||
newForm
|
||||
[ label " URI: " @@= editTextField uriString MemoField (Just 1)
|
||||
]
|
||||
where
|
||||
label s w =
|
||||
padBottom (Pad 1) $ vLimit 1 (hLimit 15 $ str s <+> fill ' ') <+> w
|
||||
|
||||
mkDeshieldForm :: Integer -> ShDshEntry -> Form ShDshEntry e Name
|
||||
mkDeshieldForm tbal =
|
||||
newForm
|
||||
|
@ -716,9 +925,21 @@ mkDeshieldForm tbal =
|
|||
where
|
||||
isAmountValid :: Integer -> Scientific -> Bool
|
||||
isAmountValid b i = fromIntegral b >= (i * scientific 1 8)
|
||||
label s w =
|
||||
padBottom (Pad 1) $ vLimit 1 (hLimit 25 $ 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
|
||||
|
@ -935,7 +1156,8 @@ appEvent (BT.AppEvent t) = do
|
|||
(s ^. zebraPort)
|
||||
"user"
|
||||
"pwd"
|
||||
8080)
|
||||
8080
|
||||
(s ^. currencyCode))
|
||||
selWallet
|
||||
updatedState <- BT.get
|
||||
ns <- liftIO $ refreshWallet updatedState
|
||||
|
@ -982,6 +1204,13 @@ appEvent (BT.AppEvent t) = do
|
|||
AdrBookDelForm -> return ()
|
||||
DeshieldForm -> return ()
|
||||
ShieldForm -> return ()
|
||||
ViewingKeyShow -> return ()
|
||||
ViewingKeyMenu -> return ()
|
||||
ProcessURIMenu -> return ()
|
||||
ShowFIATBalance -> return ()
|
||||
PaymentURICreate -> return ()
|
||||
PaymentURIShow -> return ()
|
||||
PayUsingURIShow -> return ()
|
||||
Blank -> do
|
||||
if s ^. timer == 90
|
||||
then do
|
||||
|
@ -1559,7 +1788,198 @@ appEvent (BT.VtyEvent e) = do
|
|||
ev ->
|
||||
BT.zoom deshieldForm $ do
|
||||
handleFormEvent (BT.VtyEvent ev)
|
||||
--
|
||||
-- Process ShowFIATBalance events
|
||||
--
|
||||
ShowFIATBalance -> do
|
||||
case e of
|
||||
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
|
||||
-- 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 ()
|
||||
--
|
||||
-- Open viewing key display form
|
||||
--
|
||||
ViewingKeyMenu -> do
|
||||
case e of
|
||||
--
|
||||
-- Full viewing key display
|
||||
--
|
||||
V.EvKey (V.KChar 'f') [] -> do
|
||||
selAccount <-
|
||||
do case L.listSelectedElement $ s ^. accounts of
|
||||
Nothing -> do
|
||||
let fAcc =
|
||||
L.listSelectedElement $ L.listMoveToBeginning $ s ^. accounts
|
||||
case fAcc of
|
||||
Nothing -> throw $ userError "Failed to select account"
|
||||
Just (_j, w1) -> return w1
|
||||
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
|
||||
BT.modify $ set vkName "Full"
|
||||
BT.modify $ set vkData fvk
|
||||
BT.modify $ set dialogBox ViewingKeyShow
|
||||
--
|
||||
-- Incoming viewing key display
|
||||
--
|
||||
V.EvKey (V.KChar 'i') [] -> do
|
||||
selAccount <-
|
||||
do case L.listSelectedElement $ s ^. accounts of
|
||||
Nothing -> do
|
||||
let fAcc =
|
||||
L.listSelectedElement $ L.listMoveToBeginning $ s ^. accounts
|
||||
case fAcc of
|
||||
Nothing -> throw $ userError "Failed to select account"
|
||||
Just (_j, w1) -> return w1
|
||||
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
|
||||
BT.modify $ set vkName "Incomming"
|
||||
BT.modify $ set vkData ivk
|
||||
BT.modify $ set dialogBox ViewingKeyShow
|
||||
V.EvKey (V.KChar 'e') [] ->
|
||||
BT.modify $ set dialogBox Blank
|
||||
ev -> return ()
|
||||
--
|
||||
-- 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.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
|
||||
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
|
||||
--
|
||||
ProcessURIMenu -> do
|
||||
case e of
|
||||
V.EvKey (V.KChar 'c') [] -> do
|
||||
BT.modify $
|
||||
set pmtURIForm $
|
||||
mkPaymentURIForm (PaymentInput OrchardPool 0.0 "")
|
||||
BT.modify $ set dialogBox PaymentURICreate
|
||||
V.EvKey (V.KChar 'p') [] -> do
|
||||
BT.modify $
|
||||
set payUsingURIForm $
|
||||
mkPayUsingURIForm (URIText "")
|
||||
BT.modify $ set dialogBox PayUsingURIShow
|
||||
V.EvKey (V.KChar 'e') [] ->
|
||||
BT.modify $ set dialogBox Blank
|
||||
ev -> return ()
|
||||
--
|
||||
-- Process any other event
|
||||
--
|
||||
Blank -> do
|
||||
case e of
|
||||
V.EvKey (V.KChar '\t') [] -> focusRing %= F.focusNext
|
||||
|
@ -1583,8 +2003,31 @@ appEvent (BT.VtyEvent e) = do
|
|||
set txForm $
|
||||
mkSendForm (s ^. balance) (SendInput "" 0.0 "" Full)
|
||||
BT.modify $ set dialogBox SendTx
|
||||
V.EvKey (V.KChar 'u') [] ->
|
||||
BT.modify $ set dialogBox ProcessURIMenu
|
||||
V.EvKey (V.KChar 'b') [] ->
|
||||
BT.modify $ set dialogBox AdrBook
|
||||
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
|
||||
V.EvKey (V.KChar 'd') [] -> do
|
||||
pool <- liftIO $ runNoLoggingT $ initPool $ s ^. dbPath
|
||||
selAcc <-
|
||||
|
@ -1636,6 +2079,10 @@ 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
|
||||
V.EvKey (V.KChar 'u') [] -> do
|
||||
BT.modify $ set dialogBox ViewingKeyMenu
|
||||
ev ->
|
||||
case r of
|
||||
Just AList ->
|
||||
|
@ -1650,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
|
||||
|
@ -1690,6 +2137,7 @@ runZenithTUI config = do
|
|||
let host = c_zebraHost config
|
||||
let port = c_zebraPort config
|
||||
let dbFilePath = c_dbPath config
|
||||
let currencyCode = c_currencyCode config
|
||||
pool <- runNoLoggingT $ initPool dbFilePath
|
||||
w <- try $ checkZebra host port :: IO (Either IOError ZebraGetInfo)
|
||||
case w of
|
||||
|
@ -1787,6 +2235,12 @@ runZenithTUI config = do
|
|||
(mkDeshieldForm 0 (ShDshEntry 0.0))
|
||||
tBal
|
||||
sBal
|
||||
currencyCode
|
||||
0
|
||||
""
|
||||
""
|
||||
(mkPaymentURIForm $ PaymentInput OrchardPool 0.0 "")
|
||||
(mkPayUsingURIForm $ URIText "")
|
||||
Left _e -> do
|
||||
print $
|
||||
"No Zebra node available on port " <>
|
||||
|
|
|
@ -22,11 +22,15 @@ import Control.Monad.Logger
|
|||
)
|
||||
import Data.Aeson
|
||||
import qualified Data.ByteString as BS
|
||||
import qualified Data.ByteString.Lazy as BL
|
||||
import Data.HexString (toText)
|
||||
import Data.Maybe (fromMaybe, isJust, isNothing)
|
||||
import Data.Scientific (Scientific, fromFloatDigits)
|
||||
import Data.Text (Text)
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.Text.Encoding as E
|
||||
import qualified Data.Text.Lazy as TL
|
||||
import qualified Data.Text.Lazy.Encoding as TLE
|
||||
import Data.Time.Clock.POSIX (posixSecondsToUTCTime)
|
||||
import Database.Esqueleto.Experimental (ConnectionPool, fromSqlKey)
|
||||
import Database.Persist
|
||||
|
@ -36,10 +40,10 @@ import Monomer
|
|||
import qualified Monomer.Lens as L
|
||||
import System.Directory (getHomeDirectory)
|
||||
import System.FilePath ((</>))
|
||||
import Text.Printf
|
||||
import Text.Printf (printf)
|
||||
import Text.Wrap (FillScope(..), FillStrategy(..), WrapSettings(..), wrapText)
|
||||
import TextShow hiding (toText)
|
||||
import ZcashHaskell.Keys (generateWalletSeedPhrase)
|
||||
import ZcashHaskell.Keys (generateWalletSeedPhrase, deriveUfvk, deriveUivk)
|
||||
import ZcashHaskell.Orchard
|
||||
( getSaplingFromUA
|
||||
, isValidUnifiedAddress
|
||||
|
@ -75,8 +79,17 @@ import Zenith.Utils
|
|||
, padWithZero
|
||||
, showAddress
|
||||
, validBarValue
|
||||
, parseZcashPayment
|
||||
, getZcashPrice
|
||||
, createZip321
|
||||
)
|
||||
|
||||
data VkTypeDef
|
||||
= VkNone
|
||||
| VkFull
|
||||
| VkIncoming
|
||||
deriving (Eq, Show)
|
||||
|
||||
data AppEvent
|
||||
= AppInit
|
||||
| ShowMsg !T.Text
|
||||
|
@ -149,6 +162,25 @@ data AppEvent
|
|||
| SendShield
|
||||
| StartSync
|
||||
| TreeSync
|
||||
| ShowFIATBalance
|
||||
| DisplayFIATBalance Double Double
|
||||
| CloseFIATBalance
|
||||
| ViewingKeysClicked
|
||||
| PrepareViewingKey !VkTypeDef !(Maybe (Entity ZcashAccount))
|
||||
| ShowViewingKey !VkTypeDef !T.Text
|
||||
| CopyViewingKey !T.Text !T.Text
|
||||
| CloseShowVK
|
||||
| DisplayPaymentURIForm !T.Text
|
||||
| ClosePaymentURIForm
|
||||
| PrepareURIString
|
||||
| CloseShowURIOverlay
|
||||
| ShowURIOverlay !(Maybe URIQrCode) !T.Text
|
||||
| QRImageLoaded
|
||||
| CopyURIString !T.Text
|
||||
| DisplayPayUsingURI
|
||||
| ClosePayUsingURI
|
||||
| ProcIfValidURI
|
||||
| PreparePaymentURIForm
|
||||
deriving (Eq, Show)
|
||||
|
||||
data AppModel = AppModel
|
||||
|
@ -208,6 +240,20 @@ data AppModel = AppModel
|
|||
, _tBalanceValid :: !Bool
|
||||
, _sBalance :: !Integer
|
||||
, _sBalanceValid :: !Bool
|
||||
, _displayFIATBalance :: !Bool
|
||||
, _zPrice :: !Double
|
||||
, _aBal :: !Double
|
||||
, _viewingKeyPopup :: !Bool
|
||||
, _viewingKeyDisplay :: !Bool
|
||||
, _vkTypeName :: !T.Text
|
||||
, _vkData :: !T.Text
|
||||
, _paymentURIDisplay :: !Bool
|
||||
, _showURIDisplay :: !Bool
|
||||
, _usepmtURIOverlay :: !Bool
|
||||
, _uriString :: !T.Text
|
||||
, _uriAddr :: !T.Text
|
||||
, _uriQRImage :: !(Maybe URIQrCode)
|
||||
, _uriQRInProgress :: !Bool
|
||||
} deriving (Eq, Show)
|
||||
|
||||
makeLenses ''AppModel
|
||||
|
@ -221,6 +267,18 @@ remixHourglassFill = toGlyph 0xF338
|
|||
remixIcon :: T.Text -> WidgetNode s e
|
||||
remixIcon i = label i `styleBasic` [textFont "Remix", textMiddle]
|
||||
|
||||
getURIQRWidth :: Maybe URIQrCode -> Int
|
||||
getURIQRWidth qr =
|
||||
case qr of
|
||||
Nothing -> 0
|
||||
Just qr -> round (uriWidth qr)
|
||||
|
||||
getURIQRHeight :: Maybe URIQrCode -> Int
|
||||
getURIQRHeight qr =
|
||||
case qr of
|
||||
Nothing -> 0
|
||||
Just qr -> round (uriHeight qr)
|
||||
|
||||
buildUI ::
|
||||
WidgetEnv AppModel AppEvent -> AppModel -> WidgetNode AppModel AppEvent
|
||||
buildUI wenv model = widgetTree
|
||||
|
@ -259,6 +317,12 @@ buildUI wenv model = widgetTree
|
|||
updateABAddress
|
||||
, shieldOverlay `nodeVisible` model ^. shieldZec
|
||||
, deShieldOverlay `nodeVisible` model ^. deShieldZec
|
||||
, dfBalOverlay `nodeVisible` model ^. displayFIATBalance
|
||||
, showVKOverlay `nodeVisible` model ^. viewingKeyDisplay
|
||||
, paymentURIOverlay `nodeVisible` model ^. paymentURIDisplay
|
||||
, showURIInProgress `nodeVisible` model ^. uriQRInProgress
|
||||
, showURIOverlay `nodeVisible` model ^. showURIDisplay
|
||||
, pmtUsingURIOverlay `nodeVisible` model ^. usepmtURIOverlay
|
||||
, msgAdrBookOverlay `nodeVisible` isJust (model ^. msgAB)
|
||||
]
|
||||
mainWindow =
|
||||
|
@ -328,6 +392,35 @@ 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_
|
||||
[alignLeft]
|
||||
(vstack
|
||||
[ box_
|
||||
[alignLeft, onClick ViewingKeysClicked]
|
||||
(hstack
|
||||
[ label "Viewing Keys"
|
||||
, filler
|
||||
, widgetIf (not $ model ^. viewingKeyPopup) $
|
||||
remixIcon remixMenuUnfoldFill
|
||||
, widgetIf (model ^. viewingKeyPopup) $
|
||||
remixIcon remixMenuFoldFill
|
||||
])
|
||||
, 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`
|
||||
[bgColor white, borderB 1 gray, padding 3]
|
||||
, box_ [alignLeft, onClick PreparePaymentURIForm] (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]
|
||||
newBox =
|
||||
|
@ -347,6 +440,31 @@ buildUI wenv model = widgetTree
|
|||
(hstack [label "Wallet", filler]) `styleBasic`
|
||||
[bgColor white, borderB 1 gray, padding 3]
|
||||
])
|
||||
viewingKeysBox =
|
||||
box_
|
||||
[alignMiddle]
|
||||
(vstack
|
||||
[ box_
|
||||
[ alignLeft
|
||||
, onClick
|
||||
(PrepareViewingKey
|
||||
VkFull
|
||||
currentAccount
|
||||
)
|
||||
]
|
||||
(hstack [label "Full VK", filler]) `styleBasic`
|
||||
[bgColor white, borderB 1 gray, padding 3]
|
||||
, box_
|
||||
[ alignLeft
|
||||
, onClick
|
||||
(PrepareViewingKey
|
||||
VkIncoming
|
||||
currentAccount
|
||||
)
|
||||
]
|
||||
(hstack [label "Incoming VK", filler]) `styleBasic`
|
||||
[bgColor white, borderB 1 gray, padding 3]
|
||||
])
|
||||
walletButton =
|
||||
hstack
|
||||
[ label "Wallet: " `styleBasic` [textFont "Bold", textColor white]
|
||||
|
@ -993,6 +1111,49 @@ buildUI wenv model = widgetTree
|
|||
, label_ (txtWrapN (fromMaybe "" (model ^. msgAB)) 64) [multiline]
|
||||
, filler
|
||||
]
|
||||
dfBalOverlay =
|
||||
alert CloseFIATBalance $
|
||||
vstack
|
||||
[ box_
|
||||
[]
|
||||
(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 =
|
||||
alert CloseShowVK $
|
||||
vstack
|
||||
[ box_
|
||||
[]
|
||||
(label ((model ^. vkTypeName) <> " Viewing Key") `styleBasic`
|
||||
[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]
|
||||
, spacer
|
||||
, hstack
|
||||
[ filler
|
||||
, button "Copy to Clipboard" $
|
||||
CopyViewingKey (model ^. vkTypeName) (model ^. vkData)
|
||||
, filler
|
||||
]
|
||||
]
|
||||
shieldOverlay =
|
||||
box
|
||||
(vstack
|
||||
|
@ -1108,8 +1269,168 @@ buildUI wenv model = widgetTree
|
|||
, filler
|
||||
]) `styleBasic`
|
||||
[bgColor (white & L.a .~ 0.5)]
|
||||
|
||||
notImplemented = NotImplemented
|
||||
--
|
||||
paymentURIOverlay =
|
||||
box
|
||||
(vstack
|
||||
[ filler
|
||||
, hstack
|
||||
[ filler
|
||||
, box_
|
||||
[]
|
||||
(vstack
|
||||
[ box_
|
||||
[]
|
||||
(label "Create a Payment URI" `styleBasic`
|
||||
[textFont "Bold", textColor white, textSize 10, padding 3]) `styleBasic`
|
||||
[bgColor btnColor, radius 2, padding 3]
|
||||
, spacer
|
||||
, hstack
|
||||
[ filler
|
||||
, label "Current Address:" `styleBasic` [textFont "Bold"]
|
||||
, spacer
|
||||
, label_ (txtWrapN (model ^. uriAddr) 64) [multiline]
|
||||
, filler
|
||||
]
|
||||
, spacer
|
||||
, hstack
|
||||
[ label "Amount : " `styleBasic` [textFont "Bold"]
|
||||
, numericField_ sendAmount
|
||||
[ decimals 8 ]
|
||||
`nodeKey` "floatInput"
|
||||
`styleBasic`
|
||||
[ width 150
|
||||
, styleIf (model ^. sendAmount <= 0.0) (textColor red)
|
||||
]
|
||||
]
|
||||
, spacer
|
||||
, hstack
|
||||
[ label "Memo: " `styleBasic` [textFont "Bold"]
|
||||
, spacer
|
||||
, textField_ sendMemo [] `styleBasic` [width 300]
|
||||
]
|
||||
, spacer
|
||||
, hstack
|
||||
[ filler
|
||||
, mainButton "Create URI" PrepareURIString `nodeEnabled`
|
||||
(model ^. sendAmount > 0.0)
|
||||
, spacer
|
||||
, button "Cancel" ClosePaymentURIForm
|
||||
, filler
|
||||
]
|
||||
]) `styleBasic`
|
||||
[radius 4, border 2 btnColor, bgColor white, padding 4]
|
||||
, filler
|
||||
]
|
||||
, filler
|
||||
]) `styleBasic`
|
||||
[bgColor (white & L.a .~ 0.5)]
|
||||
--
|
||||
showURIInProgress =
|
||||
box
|
||||
(vstack
|
||||
[ filler
|
||||
, hstack
|
||||
[ filler
|
||||
, label "Processing Payment URI, it will take a moment ....."
|
||||
`styleBasic` [textFont "Bold", textSize 14]
|
||||
, filler
|
||||
]
|
||||
, filler
|
||||
]) `styleBasic`
|
||||
[bgColor (white & L.a .~ 0.5)]
|
||||
--
|
||||
showURIOverlay =
|
||||
box
|
||||
(vstack
|
||||
[ filler
|
||||
, hstack
|
||||
[ filler
|
||||
, box_
|
||||
[]
|
||||
(vstack
|
||||
[ box_
|
||||
[alignMiddle]
|
||||
(label "Payment URI" `styleBasic`
|
||||
[textFont "Bold", textColor white, textSize 11, padding 3]) `styleBasic`
|
||||
[bgColor btnColor, radius 2, padding 3]
|
||||
, spacer
|
||||
, hstack
|
||||
[filler, label_ (txtWrapN (model ^. uriString ) 64) [multiline], filler]
|
||||
, spacer
|
||||
, hstack
|
||||
[ filler
|
||||
, box_
|
||||
[alignMiddle]
|
||||
(case model ^. uriQRImage of
|
||||
Just img -> imageMem_ "URIQRCode" (uriBytes img) (Size (uriWidth img) (uriHeight img) )
|
||||
[fitWidth]
|
||||
Nothing -> image_
|
||||
(T.pack $ (model ^. home) </> "Zenith/assets/cracked_qr.png")
|
||||
[fitHeight] )
|
||||
`styleBasic` [ bgColor white
|
||||
, height 120
|
||||
, width 120
|
||||
]
|
||||
, filler
|
||||
]
|
||||
, spacer
|
||||
, hstack
|
||||
[ filler
|
||||
, button "Copy to Clipboard" $
|
||||
CopyURIString (model ^. uriString)
|
||||
, spacer
|
||||
, button "Cancel" CloseShowURIOverlay
|
||||
, filler
|
||||
]
|
||||
]) `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
|
||||
|
@ -1233,6 +1554,14 @@ 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
|
||||
]
|
||||
ShowSeed -> [Model $ model & showSeed .~ True & menuPopup .~ False]
|
||||
ShowSend ->
|
||||
[ Model $
|
||||
|
@ -1455,6 +1784,7 @@ handleEvent wenv node model evt =
|
|||
model & amountValid .~
|
||||
(i < (fromIntegral (model ^. balance) / 100000000.0))
|
||||
]
|
||||
--
|
||||
ShowTxId tx -> [Model $ model & showId ?~ tx & modalMsg .~ Nothing]
|
||||
-- |
|
||||
-- | Address Book Events
|
||||
|
@ -1508,6 +1838,16 @@ handleEvent wenv node model evt =
|
|||
, setClipboardData $ ClipboardText a
|
||||
, Event $ ShowMessage "Address copied!!"
|
||||
]
|
||||
CopyViewingKey t v ->
|
||||
[ setClipboardData ClipboardEmpty
|
||||
, setClipboardData $ ClipboardText v
|
||||
, Event $ ShowMessage (t <> " viewing key copied!!")
|
||||
]
|
||||
CopyURIString u ->
|
||||
[ setClipboardData ClipboardEmpty
|
||||
, setClipboardData $ ClipboardText u
|
||||
, Event $ ShowMessage "URI string copied to clipboard!!"
|
||||
]
|
||||
DeleteABEntry a ->
|
||||
[ Task $ deleteAdrBook (model ^. configuration) a
|
||||
, Model $
|
||||
|
@ -1523,6 +1863,124 @@ handleEvent wenv node model evt =
|
|||
model & msgAB ?~ "Function not implemented..." & menuPopup .~ False
|
||||
]
|
||||
CloseMsgAB -> [Model $ model & msgAB .~ Nothing & inError .~ 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
|
||||
]
|
||||
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]
|
||||
--
|
||||
-- Prepare Viewing Keys
|
||||
--
|
||||
PrepareViewingKey vkType cAcc ->
|
||||
case vkType of
|
||||
VkFull -> [ Task $ getFullVk (model ^. network) cAcc ]
|
||||
VkIncoming -> [ Task $ getIncomingVk (model ^. network) cAcc ]
|
||||
--
|
||||
-- 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
|
||||
]
|
||||
--
|
||||
-- Display PaymentURI Form
|
||||
--
|
||||
PreparePaymentURIForm ->
|
||||
[ Task $ getCurrentAddress currentAddress ]
|
||||
--
|
||||
DisplayPaymentURIForm ua->
|
||||
[ Model $
|
||||
model & uriString .~ ""
|
||||
& uriAddr .~ ua
|
||||
& amountValid .~ False
|
||||
& sendAmount .~ 0.0
|
||||
& sendMemo .~ ""
|
||||
& paymentURIDisplay .~ True
|
||||
& menuPopup .~ False
|
||||
]
|
||||
ClosePaymentURIForm -> [Model $ model & paymentURIDisplay .~ False]
|
||||
--
|
||||
-- Generate URI
|
||||
--
|
||||
PrepareURIString -> [ Task $ genURIString (model ^. uriAddr) (model ^. sendAmount) (model ^. sendMemo)
|
||||
, Model $ model & uriQRInProgress .~ True
|
||||
]
|
||||
ShowURIOverlay qr uStr ->
|
||||
[ Model $
|
||||
model & uriString .~ uStr
|
||||
& uriQRImage .~ qr
|
||||
& uriQRInProgress .~ True
|
||||
& paymentURIDisplay .~ False
|
||||
& showURIDisplay .~ True
|
||||
& uriQRInProgress .~ False
|
||||
]
|
||||
CloseShowURIOverlay -> [ Model $ model & showURIDisplay .~ False & uriString .~ "" & uriQRInProgress .~ False & uriQRImage .~ Nothing]
|
||||
QRImageLoaded -> [ Model $ model & uriQRInProgress .~ 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 $ ClosePaymentURIForm
|
||||
]
|
||||
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 ->
|
||||
if model ^. tBalance > 0
|
||||
then [Model $ model & shieldZec .~ True & menuPopup .~ False]
|
||||
|
@ -1680,6 +2138,90 @@ handleEvent wenv node model evt =
|
|||
pool <- runNoLoggingT $ initPool $ c_dbPath config
|
||||
res <- liftIO $ updateAdrsInAdrBook pool d a a
|
||||
return $ ShowMessage "Address Book entry updated!!"
|
||||
--
|
||||
dbal :: Integer -> Double
|
||||
dbal a = fromIntegral a
|
||||
--
|
||||
sfBalance :: Config -> IO AppEvent
|
||||
sfBalance config = do
|
||||
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 <> "]")
|
||||
--
|
||||
procIfValidURI :: T.Text -> IO AppEvent
|
||||
procIfValidURI ustr = do
|
||||
return $ ShowSend
|
||||
--
|
||||
-- Get Full Viewing Key
|
||||
--
|
||||
getFullVk :: ZcashNet -> Maybe (Entity ZcashAccount) -> IO AppEvent
|
||||
getFullVk n cAcc = do
|
||||
case cAcc of
|
||||
Nothing -> return $ ShowMessage "Viewing Key Error: No account selected!"
|
||||
Just acc -> do
|
||||
let osk = getOrchSK $ zcashAccountOrchSpendKey $ entityVal acc
|
||||
let ssk = getSapSK $ zcashAccountSapSpendKey $ entityVal acc
|
||||
let tsk = getTranSK $ zcashAccountTPrivateKey $ entityVal acc
|
||||
fvk <- deriveUfvk n osk ssk tsk
|
||||
return $ ShowViewingKey VkFull fvk
|
||||
--
|
||||
-- Get Incoming Viewing Key
|
||||
--
|
||||
getIncomingVk :: ZcashNet -> Maybe (Entity ZcashAccount) -> IO AppEvent
|
||||
getIncomingVk n cAcc = do
|
||||
case cAcc of
|
||||
Nothing -> return $ ShowMessage "Viewing Key Error: No account selected!"
|
||||
Just acc -> do
|
||||
let osk = getOrchSK $ zcashAccountOrchSpendKey $ entityVal acc
|
||||
let ssk = getSapSK $ zcashAccountSapSpendKey $ entityVal acc
|
||||
let tsk = getTranSK $ zcashAccountTPrivateKey $ entityVal acc
|
||||
ivk <- deriveUivk n osk ssk tsk
|
||||
return $ ShowViewingKey VkIncoming ivk
|
||||
--
|
||||
-- Get curret zcash address
|
||||
--
|
||||
getCurrentAddress :: Maybe (Entity WalletAddress) -> IO AppEvent
|
||||
getCurrentAddress a = do
|
||||
let ua = case model ^. selPool of
|
||||
OrchardPool -> maybe "None" (getUA . walletAddressUAddress . entityVal) a
|
||||
SaplingPool -> fromMaybe "None" $ (getSaplingFromUA . E.encodeUtf8 . getUA . walletAddressUAddress . entityVal) =<< a
|
||||
SproutPool -> "None"
|
||||
TransparentPool -> maybe "None" (encodeTransparentReceiver (model ^. network)) $
|
||||
t_rec =<< (isValidUnifiedAddress . E.encodeUtf8 . getUA . walletAddressUAddress . entityVal) =<< a
|
||||
return $ DisplayPaymentURIForm ua
|
||||
--
|
||||
-- Generate a QR code for a String and save it as an PNG image
|
||||
--
|
||||
genURIStringQR :: Int -> T.Text -> Maybe URIQrCode
|
||||
genURIStringQR scaleFactor uriStr = do
|
||||
let qrOptions = defaultQRCodeOptions L
|
||||
case encodeText qrOptions Utf8WithoutECI uriStr of
|
||||
Nothing -> Nothing
|
||||
Just qrCode -> do
|
||||
let qri = promoteImage (toImage 4 scaleFactor qrCode)
|
||||
let qrw = fromIntegral $ imageWidth qri
|
||||
let qrh = fromIntegral $ imageHeight qri
|
||||
let qrb = BS.pack $
|
||||
pixelFold (\bs _ _ (PixelRGBA8 i j k l) -> bs <> [i, j, k, l])
|
||||
[]
|
||||
qri
|
||||
Just URIQrCode { uriBytes=qrb, uriWidth=qrw, uriHeight=qrh }
|
||||
--
|
||||
-- Gen URI String
|
||||
--
|
||||
genURIString :: T.Text -> Float -> T.Text -> IO AppEvent
|
||||
genURIString addr mAmt mMemo = do
|
||||
let mM = case mMemo of
|
||||
"" -> Nothing
|
||||
_ -> Just (T.unpack mMemo)
|
||||
let uriSt = createZip321 (T.unpack addr) (Just (realToFrac mAmt)) mM
|
||||
return $ ShowURIOverlay (genURIStringQR 3 (T.pack uriSt)) (T.pack uriSt)
|
||||
|
||||
scanZebra ::
|
||||
T.Text
|
||||
|
@ -2024,6 +2566,20 @@ runZenithGUI config = do
|
|||
False
|
||||
shieldBal
|
||||
False
|
||||
False
|
||||
0.0
|
||||
0.0
|
||||
False
|
||||
False
|
||||
""
|
||||
""
|
||||
False
|
||||
False
|
||||
False
|
||||
""
|
||||
""
|
||||
Nothing
|
||||
False
|
||||
startApp model handleEvent buildUI (params hD)
|
||||
Left _e -> print "Zebra not available"
|
||||
where
|
||||
|
|
|
@ -916,7 +916,7 @@ scanZebra dbPath zHost zPort net = do
|
|||
updateCommitmentTrees pool zHost zPort $ ZcashNetDB net
|
||||
runNoLoggingT $
|
||||
mapM_
|
||||
(syncWallet (Config dbPath zHost zPort "user" "pwd" 8080))
|
||||
(syncWallet (Config dbPath zHost zPort "user" "pwd" 8080 "usd"))
|
||||
wals
|
||||
_ <- completeSync pool Successful
|
||||
return ()
|
||||
|
|
|
@ -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,6 +112,7 @@ data Config = Config
|
|||
, c_zenithUser :: !BS.ByteString
|
||||
, c_zenithPwd :: !BS.ByteString
|
||||
, c_zenithPort :: !Int
|
||||
, c_currencyCode :: !T.Text
|
||||
} deriving (Eq, Prelude.Show)
|
||||
|
||||
data ZcashPool
|
||||
|
@ -507,3 +508,20 @@ 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)
|
||||
|
||||
-- | Define a data structure for the URI QR image
|
||||
data URIQrCode = URIQrCode
|
||||
{
|
||||
uriBytes :: BS.ByteString -- Image as ByteString
|
||||
, uriWidth :: Double -- Number of columns in QR Image
|
||||
, uriHeight :: Double -- Number of rows in a QR Image
|
||||
} deriving (Show, Eq)
|
||||
|
|
|
@ -2,16 +2,31 @@
|
|||
|
||||
module Zenith.Utils where
|
||||
|
||||
import Control.Exception (SomeException, try)
|
||||
import Control.Monad (when)
|
||||
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
|
||||
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(..), scientific, Scientific, toRealFloat)
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.Text.Encoding as E
|
||||
--import qualified Data.Text.Encoding as TE
|
||||
import Network.HTTP.Simple
|
||||
import Network.URI (escapeURIString, isUnreserved)
|
||||
import System.Directory
|
||||
import System.Process (createProcess_, shell)
|
||||
import Text.Printf (printf)
|
||||
import Text.Read (readMaybe)
|
||||
import Text.Regex.Posix
|
||||
import ZcashHaskell.Orchard
|
||||
( encodeUnifiedAddress
|
||||
|
@ -25,10 +40,12 @@ import ZcashHaskell.Transparent
|
|||
)
|
||||
import ZcashHaskell.Types
|
||||
( ExchangeAddress(..)
|
||||
, ExchangeAddress(..)
|
||||
, SaplingAddress(..)
|
||||
, TransparentAddress(..)
|
||||
, UnifiedAddress(..)
|
||||
, ValidAddress(..)
|
||||
, ValidAddress(..)
|
||||
, ZcashNet(..)
|
||||
)
|
||||
import ZcashHaskell.Utils (makeZebraCall)
|
||||
|
@ -37,6 +54,7 @@ import Zenith.Types
|
|||
, PrivacyPolicy(..)
|
||||
, UnifiedAddressDB(..)
|
||||
, ZcashAddress(..)
|
||||
, ZcashPaymentURI(..)
|
||||
, ZcashPool(..)
|
||||
)
|
||||
|
||||
|
@ -52,7 +70,7 @@ displayZec s
|
|||
| abs s < 100000000 = show (fromIntegral s / 100000) ++ " mZEC"
|
||||
| otherwise = show (fromIntegral s / 100000000) ++ " ZEC "
|
||||
|
||||
-- | Helper function to display small amounts of ZEC
|
||||
-- | Helper function to display small amounts of TAZ
|
||||
displayTaz :: Integer -> String
|
||||
displayTaz s
|
||||
| abs s < 100 = show s ++ " tazs"
|
||||
|
@ -248,3 +266,91 @@ getChainTip zHost zPort = do
|
|||
case r of
|
||||
Left e1 -> pure 0
|
||||
Right i -> pure i
|
||||
|
||||
-- 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)
|
||||
-- Extract "zcash" object
|
||||
-> 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
|
||||
|
||||
-- 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
|
||||
|
||||
-- Function to encode memo as un-padded Base64
|
||||
encodeBase64Memo :: String -> String
|
||||
encodeBase64Memo = BC.unpack . BC.takeWhile (/= '=') . B64.encode . BC.pack
|
||||
|
||||
-- Function to drop trailing zeros
|
||||
dropTrailingZeros :: String -> String
|
||||
dropTrailingZeros str =
|
||||
let withoutZeros = reverse (dropWhile (== '0') (reverse str))
|
||||
in if last withoutZeros == '.'
|
||||
then withoutZeros ++ "0" -- Ensure at least one decimal place
|
||||
else withoutZeros
|
||||
|
||||
-- Function to create a ZIP-321 URI
|
||||
createZip321 :: String -> Maybe Double -> Maybe String -> String
|
||||
createZip321 address mAmount mMemo =
|
||||
"zcash:" ++ address
|
||||
++ maybe "" (\amount -> "?amount=" ++ dropTrailingZeros (printf "%.8f" amount) ) mAmount
|
||||
++ maybe "" (\memo -> "&memo=" ++ escapeURIString isUnreserved (encodeBase64Memo memo)) mMemo
|
||||
|
|
|
@ -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
|
||||
|
|
77
test/Spec.hs
77
test/Spec.hs
|
@ -2,13 +2,14 @@
|
|||
|
||||
import Codec.Borsh
|
||||
import Control.Monad (when)
|
||||
import Control.Monad.Logger (runFileLoggingT, runNoLoggingT)
|
||||
import Control.Monad.Logger (runNoLoggingT, runNoLoggingT)
|
||||
import Data.Aeson
|
||||
import qualified Data.ByteString as BS
|
||||
import qualified Data.ByteString.Lazy as LBS
|
||||
import Data.HexString
|
||||
import Data.List (foldl')
|
||||
import Data.Maybe (fromJust)
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.Text.Encoding as E
|
||||
import Database.Persist
|
||||
import Database.Persist.Sqlite
|
||||
|
@ -69,6 +70,7 @@ import Zenith.Core
|
|||
import Zenith.DB
|
||||
import Zenith.Tree
|
||||
import Zenith.Types
|
||||
import Zenith.Utils
|
||||
|
||||
main :: IO ()
|
||||
main = do
|
||||
|
@ -643,8 +645,7 @@ main = do
|
|||
case ix of
|
||||
Nothing -> assertFailure "couldn't find index at block"
|
||||
Just i -> do
|
||||
updatedTree <-
|
||||
runFileLoggingT "test.log" $ truncateTree oTree i
|
||||
updatedTree <- runNoLoggingT $ truncateTree oTree i
|
||||
let finalAnchor =
|
||||
getOrchardTreeAnchor $
|
||||
OrchardCommitmentTree $ ztiOrchard zebraTreesIn
|
||||
|
@ -737,7 +738,7 @@ main = do
|
|||
Just ua -> do
|
||||
pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
|
||||
tx <-
|
||||
runFileLoggingT "zenith.log" $
|
||||
runNoLoggingT $
|
||||
prepareTxV2
|
||||
pool
|
||||
"localhost"
|
||||
|
@ -763,7 +764,7 @@ main = do
|
|||
Just ua -> do
|
||||
pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
|
||||
tx <-
|
||||
runFileLoggingT "zenith.log" $
|
||||
runNoLoggingT $
|
||||
prepareTxV2
|
||||
pool
|
||||
"localhost"
|
||||
|
@ -787,7 +788,7 @@ main = do
|
|||
Just ua -> do
|
||||
pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
|
||||
tx <-
|
||||
runFileLoggingT "zenith.log" $
|
||||
runNoLoggingT $
|
||||
prepareTxV2
|
||||
pool
|
||||
"localhost"
|
||||
|
@ -815,7 +816,7 @@ main = do
|
|||
Just ua -> do
|
||||
pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
|
||||
tx <-
|
||||
runFileLoggingT "zenith.log" $
|
||||
runNoLoggingT $
|
||||
prepareTxV2
|
||||
pool
|
||||
"localhost"
|
||||
|
@ -847,7 +848,7 @@ main = do
|
|||
Just ua -> do
|
||||
pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
|
||||
tx <-
|
||||
runFileLoggingT "zenith.log" $
|
||||
runNoLoggingT $
|
||||
prepareTxV2
|
||||
pool
|
||||
"localhost"
|
||||
|
@ -873,7 +874,7 @@ main = do
|
|||
Just ua -> do
|
||||
pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
|
||||
tx <-
|
||||
runFileLoggingT "zenith.log" $
|
||||
runNoLoggingT $
|
||||
prepareTxV2
|
||||
pool
|
||||
"localhost"
|
||||
|
@ -897,7 +898,7 @@ main = do
|
|||
Just ua -> do
|
||||
pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
|
||||
tx <-
|
||||
runFileLoggingT "zenith.log" $
|
||||
runNoLoggingT $
|
||||
prepareTxV2
|
||||
pool
|
||||
"localhost"
|
||||
|
@ -926,7 +927,7 @@ main = do
|
|||
Just ua -> do
|
||||
pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
|
||||
tx <-
|
||||
runFileLoggingT "zenith.log" $
|
||||
runNoLoggingT $
|
||||
prepareTxV2
|
||||
pool
|
||||
"localhost"
|
||||
|
@ -957,7 +958,7 @@ main = do
|
|||
Just ua -> do
|
||||
pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
|
||||
tx <-
|
||||
runFileLoggingT "zenith.log" $
|
||||
runNoLoggingT $
|
||||
prepareTxV2
|
||||
pool
|
||||
"localhost"
|
||||
|
@ -983,7 +984,7 @@ main = do
|
|||
Just ua -> do
|
||||
pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
|
||||
tx <-
|
||||
runFileLoggingT "zenith.log" $
|
||||
runNoLoggingT $
|
||||
prepareTxV2
|
||||
pool
|
||||
"localhost"
|
||||
|
@ -1007,7 +1008,7 @@ main = do
|
|||
Just ua -> do
|
||||
pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
|
||||
tx <-
|
||||
runFileLoggingT "zenith.log" $
|
||||
runNoLoggingT $
|
||||
prepareTxV2
|
||||
pool
|
||||
"localhost"
|
||||
|
@ -1034,7 +1035,7 @@ main = do
|
|||
Just ua -> do
|
||||
pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
|
||||
tx <-
|
||||
runFileLoggingT "zenith.log" $
|
||||
runNoLoggingT $
|
||||
prepareTxV2
|
||||
pool
|
||||
"localhost"
|
||||
|
@ -1061,7 +1062,7 @@ main = do
|
|||
Just ua -> do
|
||||
pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
|
||||
tx <-
|
||||
runFileLoggingT "zenith.log" $
|
||||
runNoLoggingT $
|
||||
prepareTxV2
|
||||
pool
|
||||
"localhost"
|
||||
|
@ -1086,7 +1087,7 @@ main = do
|
|||
Just ua -> do
|
||||
pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
|
||||
tx <-
|
||||
runFileLoggingT "zenith.log" $
|
||||
runNoLoggingT $
|
||||
prepareTxV2
|
||||
pool
|
||||
"localhost"
|
||||
|
@ -1103,3 +1104,45 @@ main = do
|
|||
case tx of
|
||||
Left e -> assertFailure $ show e
|
||||
Right h -> h `shouldNotBe` hexString "deadbeef"
|
||||
describe "Call CoinGecko to get ZEC price" $ do
|
||||
it "Testing for USD " $ do
|
||||
price <- getZcashPrice $ T.pack "usd"
|
||||
case price of
|
||||
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
|
||||
describe "Create a ZIP-321 URI payment string " $ do
|
||||
it "Creating an URI using a valid Zcash address, an amount, and a memo " $ do
|
||||
let address = "ztestsapling10yy2ex5dcqkclhc7z7yrnjq2z6feyjad56ptwlfgmy77dmaqqrl9gyhprdx59qgmsnyfska2kez"
|
||||
let amount = Just 1.2345
|
||||
let memo = Just "This is a simple memo."
|
||||
let uriString = createZip321 address amount memo
|
||||
print uriString
|
||||
uriString `shouldBe` "zcash:ztestsapling10yy2ex5dcqkclhc7z7yrnjq2z6feyjad56ptwlfgmy77dmaqqrl9gyhprdx59qgmsnyfska2kez?amount=1.2345&memo=VGhpcyBpcyBhIHNpbXBsZSBtZW1vLg"
|
||||
|
|
|
@ -96,6 +96,8 @@ library
|
|||
, vty-crossplatform
|
||||
, word-wrap
|
||||
, zcash-haskell
|
||||
, unordered-containers
|
||||
, network-uri
|
||||
--pkgconfig-depends: rustzcash_wrapper
|
||||
default-language: Haskell2010
|
||||
|
||||
|
|
35
zenith.cfg
35
zenith.cfg
|
@ -1,5 +1,38 @@
|
|||
#
|
||||
# Zenith Configuration File
|
||||
#
|
||||
# -------------------------------------------------------------
|
||||
# nodeUser -
|
||||
# -------------------------------------------------------------
|
||||
nodeUser = "user"
|
||||
# -------------------------------------------------------------
|
||||
# nodePwd -
|
||||
nodePwd = "superSecret"
|
||||
dbFilePath = "zenith.db"
|
||||
# -------------------------------------------------------------
|
||||
# dbFileName - contains the SQLite database name used for
|
||||
# keeping all Zenith's data
|
||||
# default = zenith.db
|
||||
#
|
||||
dbFileName = "zenith.db"
|
||||
# -------------------------------------------------------------
|
||||
# zebraHost - Zebra IP
|
||||
# Default - "127.0.0.1"
|
||||
zebraHost = "127.0.0.1"
|
||||
# -------------------------------------------------------------
|
||||
# zebraPort - Port used for access Zebra API endpoints
|
||||
# must be the same port configured for your
|
||||
# Zebra node
|
||||
zebraPort = 18232
|
||||
# -------------------------------------------------------------
|
||||
# currencyCode - ISO 4217 currency code
|
||||
#
|
||||
# Example of currency codes are:
|
||||
#
|
||||
# United States -> currencyCode = "usd"
|
||||
# Canada -> currencyCode = "cnd"
|
||||
# Australia -> currencyCode = "aud"
|
||||
# Euro Region -> currencyCode = "eur"
|
||||
# Great Britain -> currencyCode = "gbp"
|
||||
# Japan -> currencyCode = "jpy"
|
||||
#
|
||||
currencyCode = "usd"
|
||||
|
|
Loading…
Reference in a new issue