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

Squashed commit of the following:

Browse source 
commit afa658f238
Author: Rene Vergara <rene@vergara.network>
Date:   Wed Jan 29 13:53:06 2025 -0600

    docs: update change log

commit b41ff43b21
Merge: eb4834b 5c8fda2
Author: Rene Vergara <rene@vergara.network>
Date:   Wed Jan 29 13:29:20 2025 -0600

    Merge branch 'rvv001' of code.vergara.tech:Vergara_Tech/zenith into rvv001

commit eb4834b0ec
Author: Rene Vergara <rene@vergara.network>
Date:   Wed Jan 29 13:28:51 2025 -0600

    chore(gui): remove logging

commit 5c8fda2424
Author: Rene V. Vergara <rvergara59@protonmail.com>
Date:   Tue Jan 28 13:44:11 2025 -0500

    rvv001 - GUI - Viewing Keys Form enchanced

commit 088289ec08
Author: Rene V. Vergara <rvergara59@protonmail.com>
Date:   Tue Jan 28 10:59:59 2025 -0500

    rvv001 - GUI Payment with URI updated to validate address inside URI

commit aa4feb1da2
Author: Rene V. Vergara <rvergara59@protonmail.com>
Date:   Mon Jan 27 20:42:57 2025 -0500

    rvv001 - GUI - Fix of Pay with URI Form
    	       Uri String was not correctly cleared after closing the
    	       form

commit f800fb1c8a
Author: Rene Vergara <rene@vergara.network>
Date:   Fri Jan 24 13:53:50 2025 -0600

    chore(gui): add more debugging

commit 23d24f7cc1
Author: Rene Vergara <rene@vergara.network>
Date:   Fri Jan 24 10:10:56 2025 -0600

    chore(gui): enable debugging

commit 90bc009326
Merge: a7a398c 82e4c57
Author: Rene Vergara <rene@vergara.network>
Date:   Thu Jan 23 13:47:31 2025 -0600

    Merge branch 'milestone4' into rvv001

commit a7a398cb86
Author: Rene V. Vergara <rvergara59@protonmail.com>
Date:   Mon Jan 20 20:29:11 2025 -0500

    rvv001 - added a new image to assets folder (cracked_qr.png)

commit 9633fa05a9
Author: Rene V. Vergara <rvergara59@protonmail.com>
Date:   Mon Jan 20 19:21:33 2025 -0500

    rvv001 - Payment URI creation
    	 "Processing URI..." message display enhanced.

commit df31e41684
Author: Rene V. Vergara <rvergara59@protonmail.com>
Date:   Fri Jan 17 18:35:11 2025 -0500

    rvv001 - Issue 0085 - URI support implemented in TUI                        - "Processing URI ..." message added
                        - Payment URI Creation added to TUI
    		      supports Unified, Sapling and Transparent address

commit c1f0d86f14
Author: Rene V. Vergara <rvergara59@protonmail.com>
Date:   Thu Jan 16 16:09:45 2025 -0500

    rvv001 - Issue 0085 - URI support implemented in GUI
                        - "Processing URI ..." message added
                        - QR image Display for Transparent, Sapling and Unified
    		       address added.

commit ee71b7acbb
Author: Rene V. Vergara <rvergara59@protonmail.com>
Date:   Wed Jan 15 22:05:36 2025 -0500

     rvv001 - Issue 0085 - URI support implemented in GUI
                         - Support to generate and display a QR Code containing
    		       a  ZIP-321 formatted string

commit 3da6a57d50
Author: Rene V. Vergara <rvergara59@protonmail.com>
Date:   Sun Jan 12 15:51:43 2025 -0500

    rvv001 - Issue 0085 - URI support implemented in GUI
    		    - Support to generate a ZIP-321 formatted string
    		      using a Transparent, Sapling or Unified address
     		      is available.

commit 149d74d4e2
Author: Rene V. Vergara <rvergara59@protonmail.com>
Date:   Sat Jan 11 20:02:29 2025 -0500

    rvv001 -> Payment URI generation : Form to capture payment data ready.

commit de3bc48c38
Author: Rene V. Vergara <rvergara59@protonmail.com>
Date:   Sat Jan 11 13:22:30 2025 -0500

    rvv001 - URI string generation in progress

commit 9ab31a6d9b
Merge: 9d4e8a2 16cf30a
Author: Rene V. Vergara <rvergara59@protonmail.com>
Date:   Fri Jan 10 09:58:46 2025 -0500

    Merge branch 'master' of git.vergara.tech:Vergara_Tech/zenith into branch 'rvv001'

commit 9d4e8a255b
Author: Rene V. Vergara <rvergara59@protonmail.com>
Date:   Fri Jan 10 09:49:34 2025 -0500

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

commit 9aaf712bad
Author: Rene V. Vergara <rvergara59@protonmail.com>
Date:   Wed Jan 8 14:27:09 2025 -0500

    rvv001 - Start URI payment form

commit e4b6b36a7d
Author: Rene V. Vergara <rvergara59@protonmail.com>
Date:   Tue Jan 7 16:25:45 2025 -0500

    rvv001 - Issue 0122 - Generate Viewing Keys
                              The Viewing Keys deriving functions are now
                              integrated to the CLI.hs module (TUI).

commit d8457eceb6
Author: Rene V. Vergara <rvergara59@protonmail.com>
Date:   Tue Jan 7 12:02:21 2025 -0500

    rvv001 - Issue 0122 - Generate Viewing Keys
                          The Viewing Keys deriving functions are now
                          integrated to the GUI module.

commit ff6168b45e
Author: Rene V. Vergara A. <rvergara59@protonmail.com>
Date:   Sat Jan 4 13:53:14 2025 -0500

    rvv001 - Synchronize branch with recent changes

commit cc4ce8a280
Merge: 53eac75 332b7f5
Author: Rene Vergara <rene@vergara.network>
Date:   Fri Jan 3 14:33:19 2025 -0600

    Merge branch 'rvv001' of git.vergara.tech:Vergara_Tech/zenith into rvv001

commit 332b7f5520
Author: Rene V. Vergara <rvergara59@protonmail.com>
Date:   Thu Jan 2 13:41:12 2025 -0500

    rvv001 - Issue 085 - [Zenith GUI] Read a payment URI
                         Processing Payment URI is working
    		     Display of error messages added to process

commit 6b3ea31882
Author: Rene V. Vergara <rvergara59@protonmail.com>
Date:   Thu Jan 2 13:28:08 2025 -0500

    rvv001 - Issue 085 - [Zenith GUI] Read a payment URI
             Send TX windows working
             Closing the URI form is not working

commit 02ec4716e9
Author: Rene V. Vergara <rvergara59@protonmail.com>
Date:   Tue Dec 31 09:18:39 2024 -0500

    rvv001 - Issue 085 - [Zenith GUI] Read a payment URI
             Additional cases added to Test Suite

commit d476183a1d
Author: Rene V. Vergara <rvergara59@protonmail.com>
Date:   Mon Dec 30 21:00:57 2024 -0500

    rvv001 - Issue 085 - [Zenith GUI] Read a payment URI
    	 New type to support URI data structure created (Types.hs)
    	 Function to parse an URI string created (in Utils.hs)
    	 Test case added to Benchmark Suite

commit 56bf19a6f6
Author: Rene V. Vergara <rvergara59@protonmail.com>
Date:   Thu Dec 26 18:19:43 2024 -0500

    rvv001 - Issue 084
             - Form to capture input from the user implemented for TUI & GUI
               Outgoing Viewing Key display support removed from TUI & GUI

commit 63aa5e5984
Author: Rene V. Vergara <rvergara59@protonmail.com>
Date:   Thu Dec 26 13:53:26 2024 -0500

    rvv001 - Issue 084
             Form to capture input from the user implemented
             The inputs are :
                One numeric field for amount of ZEC
                One text field for memo (optional)

commit fe8fb1fa3c
Author: Rene V. Vergara <rvergara59@protonmail.com>
Date:   Mon Dec 23 17:34:31 2024 -0500

    rvv001 - Viewing Key Display support added
    	 Copy to Clipboard support added

commit cb927a0ab3
Author: Rene V. Vergara <rvergara59@protonmail.com>
Date:   Sun Dec 22 21:33:25 2024 -0500

    rvv001 - TUI - Viewing Keys Display
    	       Submenu created

commit 62b6ee3f32
Author: Rene V. Vergara <rvergara59@protonmail.com>
Date:   Sun Dec 22 13:57:13 2024 -0500

    rvv001 - Viewing Key Display feature added to GUI module.

commit 9d1293ea03
Author: Rene V. Vergara <rvergara59@protonmail.com>
Date:   Fri Dec 20 12:31:01 2024 -0500

    rvv001 - zenith.cfg updated and commented for package distribution.

commit 1ed96dcbf8
Author: Rene Vergara A. <rvergara59@protonmail.com>
Date:   Thu Dec 19 14:34:27 2024 -0500

    rvv001 - Show Balance in FIAT
    	 GUI version ready

commit d3d5d88bbc
Author: Rene Vergara A. <rvergara59@protonmail.com>
Date:   Mon Dec 16 16:43:20 2024 -0500

    rvv001 - Commit before first compilation under Kubuntu 24

commit 843821232d
Author: Rene Vergara A <rvergara59@protonmail.com>
Date:   Sun Dec 15 19:41:06 2024 -0500

    rvv001 - Show Balance in FIAT - GUI version
    	 First commit

commit a290f9c912
Author: Rene Vergara A <rvergara59@protonmail.com>
Date:   Sat Dec 14 19:56:10 2024 -0500

    rvv001 - Display total Balance in FIAT
    	 ShowFIATBalance New form added to CLI.hs

commit c0520bcbc7
Author: Rene Vergara A <rvergara59@protonmail.com>
Date:   Mon Dec 9 21:58:34 2024 -0500

    rvv001 - Added currency code to config File
    	 Currency Code is required to get ZEC price from CoinGecho
    	 Codes are in IS 4217 alphabetic 3 character format

commit 9e211762e0
Author: Rene Vergara A <rvergara59@protonmail.com>
Date:   Sun Dec 8 19:53:10 2024 -0500

    rvv001 - Obtain ZEC prices from CoinGecko
    	 * Function addedd to obtain ZEC prices from CoinGecko
               using ISO 4217 country currency codes.
This commit is contained in:
Rene Vergara 2025-01-29 14:02:48 -06:00
parent 82e4c576c2
commit cdf7a9f3e0
Signed by: pitmutt
SSH key fingerprint: SHA256:vNa8FIqbBZjV9hOCkXyOzd7gqWCMCfkcfiPH2zaGfQ0
14 changed files with 1435 additions and 67 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

4
.gitignore vendored
View file

@ -5,3 +5,7 @@ zenith.db
zenith.log
zenith.db-shm
zenith.db-wal
test.db
test.db-shm
test.db-wal

12
CHANGELOG.md
View file

@ -9,6 +9,18 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0
### Added
- TUI:
- Generate payment URI
- Read a payment URI
- Generate a Full Viewing Key
- Generate an Incoming Viewing Key
- GUI:
- Generate payment URI and QR code
- Read a payment URI and QR code
- Generate a Full Viewing Key
- Generate an Incoming Viewing Key
- RPC methods:
- `shieldnotes`
- `deshieldfunds`

11
app/Main.hs
View file

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

11
app/Server.hs
View file

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

BIN
assets/cracked_qr.png Normal file
View file

Binary file not shown.
Side by side

After

Width:  |  Height:  |  Size: 33 KiB

580
src/Zenith/CLI.hs
View file

@ -75,7 +75,7 @@ import Control.Monad.Logger
import Data.Aeson
import Data.HexString (HexString(..), toText)
import Data.Maybe
import Data.Scientific (Scientific, scientific)
import Data.Scientific (Scientific, fromFloatDigits, scientific, toRealFloat)
import qualified Data.Text as T
import qualified Data.Text.Encoding as E
import Data.Time.Clock.POSIX (posixSecondsToUTCTime)
@ -90,8 +90,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 (deriveUfvk, deriveUivk, generateWalletSeedPhrase)
import ZcashHaskell.Orchard
( getSaplingFromUA
, isValidUnifiedAddress
@ -109,23 +115,31 @@ import Zenith.Scanner (checkIntegrity, processTx, rescanZebra, updateConfs)
import Zenith.Types
( Config(..)
, HexStringDB(..)
, OrchardSpendingKeyDB(..)
, PhraseDB(..)
, PrivacyPolicy(..)
, ProposedNote(..)
, SaplingSpendingKeyDB(..)
, ShieldDeshieldOp(..)
, TransparentSpendingKeyDB(..)
, UnifiedAddressDB(..)
, ValidAddressAPI(..)
, ZcashNetDB(..)
, ZcashPaymentURI(..)
, ZcashPool(..)
, ZenithStatus(..)
, ZenithUuid(..)
)
import Zenith.Utils
( displayTaz
( createZip321
, displayTaz
, displayZec
, getChainTip
, getZcashPrice
, isRecipientValid
, isRecipientValidGUI
, jsonNumber
, parseZcashPayment
, showAddress
, validBarValue
)
@ -152,6 +166,10 @@ data Name
| DeshieldField
| TotalTranspField
| TotalShieldedField
| SFBViewPort
| URITransparentAddress
| URISaplingAddress
| URIUnifiedAddress
deriving (Eq, Show, Ord)
data DialogInput = DialogInput
@ -182,6 +200,20 @@ 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
@ -196,6 +228,13 @@ data DialogType
| AdrBookDelForm
| DeshieldForm
| ShieldForm
| ShowFIATBalance
| ViewingKeyMenu
| ViewingKeyShow
| PaymentURICreate
| PaymentURIShow
| PayUsingURIShow
| ProcessURIMenu
data DisplayType
= AddrDisplay
@ -213,7 +252,7 @@ data Tick
| TickMsg !String
| TickTx !HexString
data DropDownItem =
newtype DropDownItem =
DropdownItem String
data State = State
@ -247,10 +286,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
@ -294,24 +360,30 @@ drawUI s = [splashDialog s, helpDialog s, displayDialog s, inputDialog s, ui s]
(C.hCenter
(str ("Last block seen: " ++ show (st ^. syncBlock) ++ "\n")) <=>
listTxBox " Transactions " (st ^. network) (st ^. transactions))) <=>
(vBox
[ C.hCenter
(hBox
[ capCommand "W" "allets"
, capCommand "A" "ccounts"
, capCommand "V" "iew address"
, capCommand3 "" "S" "end Tx"
])
, C.hCenter
(hBox
[ capCommand2 "Address " "B" "ook"
, capCommand2 "s" "H" "ield"
, capCommand "D" "e-shield"
, capCommand "Q" "uit"
, capCommand "?" " Help"
, str $ show (st ^. timer)
])
])
vBox
[ C.hCenter
(hBox
[ capCommand "W" "allets"
, capCommand "A" "ccounts"
, capCommand "V" "iew address"
, 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)
])
]
listBox :: Show e => String -> L.List Name e -> Widget Name
listBox titleLabel l =
C.vCenter $
@ -377,7 +449,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)
@ -387,8 +461,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
@ -434,7 +511,37 @@ 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)
@ -454,7 +561,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)
@ -465,7 +572,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 ->
@ -479,20 +614,20 @@ drawUI s = [splashDialog s, helpDialog s, displayDialog s, inputDialog s, ui s]
vBox
[ vLimit 16 $
hLimit 50 $
vBox $ [L.renderList listDrawAB True (s ^. abAddresses)]
vBox [L.renderList listDrawAB True (s ^. abAddresses)]
, padTop Max $
vLimit 4 $
hLimit 50 $
withAttr abMBarAttr $
vBox $
[ C.hCenter $
(capCommand "N" "ew Address" <+>
capCommand "E" "dit Address" <+>
capCommand3 "" "C" "opy Address")
, C.hCenter $
(capCommand "D" "elete Address" <+>
capCommand "S" "end Zcash" <+> capCommand3 "E" "x" "it")
]
vBox
[ C.hCenter
(capCommand "N" "ew Address" <+>
capCommand "E" "dit Address" <+>
capCommand3 "" "C" "opy Address")
, C.hCenter
(capCommand "D" "elete Address" <+>
capCommand "S" "end Zcash" <+> capCommand3 "E" "x" "it")
]
])
-- Address Book new entry form
AdrBookForm ->
@ -518,7 +653,50 @@ 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
@ -530,7 +708,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.2.0-beta")) <=>
(withAttr titleAttr (str "Zcash Wallet v0.8.0.0-beta")) <=>
C.hCenter (withAttr blinkAttr $ str "Press any key..."))
else emptyWidget
capCommand3 :: String -> String -> String -> Widget Name
@ -551,23 +729,24 @@ 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 =<<
@ -579,7 +758,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
@ -674,8 +853,9 @@ drawUI s = [splashDialog s, helpDialog s, displayDialog s, inputDialog s, ui s]
D.renderDialog
(D.dialog (Just $ txt " Address Book Entry ") Nothing 60)
(padAll 1 $
txtWrapWith (WrapSettings False True NoFill FillAfterFirst) $
abentry)
txtWrapWith
(WrapSettings False True NoFill FillAfterFirst)
abentry)
_ -> emptyWidget
BlankDisplay -> emptyWidget
@ -709,6 +889,33 @@ 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
@ -719,7 +926,7 @@ mkDeshieldForm tbal =
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
padBottom (Pad 1) $ vLimit 1 (hLimit 25 $ str s <+> fill ' ') <+> w
mkNewABForm :: AdrBookEntry -> Form AdrBookEntry e Name
mkNewABForm =
@ -937,7 +1144,8 @@ appEvent (BT.AppEvent t) = do
(s ^. zebraPort)
"user"
"pwd"
8080)
8080
(s ^. currencyCode))
selWallet
updatedState <- BT.get
ns <- liftIO $ refreshWallet updatedState
@ -984,6 +1192,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
@ -1539,7 +1754,238 @@ 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
--
-- Full viewing key display
--
of
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
@ -1563,8 +2009,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 <-
@ -1616,6 +2085,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 ->
@ -1630,8 +2103,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
@ -1670,6 +2143,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
@ -1767,6 +2241,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 " <>

646
src/Zenith/GUI.hs
View file

@ -22,11 +22,14 @@ 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 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 qualified Data.UUID as U
import Database.Esqueleto.Experimental (ConnectionPool, fromSqlKey)
@ -37,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 (deriveUfvk, deriveUivk, generateWalletSeedPhrase)
import ZcashHaskell.Orchard
( getSaplingFromUA
, isValidUnifiedAddress
@ -67,17 +70,26 @@ import Zenith.GUI.Theme
import Zenith.Scanner (checkIntegrity, processTx, rescanZebra, updateConfs)
import Zenith.Types hiding (ZcashAddress(..))
import Zenith.Utils
( displayAmount
( createZip321
, displayAmount
, getChainTip
, getZcashPrice
, isRecipientValidGUI
, isValidString
, isZecAddressValid
, jsonNumber
, padWithZero
, parseZcashPayment
, showAddress
, validBarValue
)
data VkTypeDef
= VkNone
| VkFull
| VkIncoming
deriving (Eq, Show)
data AppEvent
= AppInit
| ShowMsg !T.Text
@ -150,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
@ -209,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
@ -222,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
@ -260,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 =
@ -329,6 +392,37 @@ 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 =
@ -348,6 +442,21 @@ 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]
@ -994,6 +1103,64 @@ 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 $
box
(vstack
[ filler
, hstack
[ filler
, box_
[]
(vstack
[ box_
[alignMiddle]
(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)
, spacer
, button "Close" $ CloseShowVK
, filler
]
]) `styleBasic`
[radius 4, border 2 btnColor, bgColor white, padding 4]
, filler
]
, filler
] ) `styleBasic`
[bgColor (white & L.a .~ 0.5)]
shieldOverlay =
box
(vstack
@ -1109,8 +1276,197 @@ 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
, box_
[]
(vstack
[ spacer
, hstack
[ filler
, label
"Processing Payment URI, it will take a moment ....." `styleBasic`
[textFont "Bold", textSize 14]
, filler
]
, spacer
]) `styleBasic`
[radius 4, border 2 btnColor, bgColor white, padding 4]
, 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
@ -1234,6 +1590,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 $
@ -1263,8 +1627,8 @@ handleEvent wenv node model evt =
CancelSend ->
[ Model $
model & openSend .~ False & sendRecipient .~ "" & sendAmount .~ 0.0 &
sendMemo .~
""
sendMemo .~ "" &
uriString .~ ""
]
SaveAddress acc ->
if T.length (model ^. mainInput) > 1
@ -1456,6 +1820,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
@ -1509,6 +1874,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 $
@ -1524,6 +1899,139 @@ 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 & uriString .~ ""]
--
-- 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 & uriString .~ ""]
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 .~
True &
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]
@ -1681,6 +2189,105 @@ 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
@ -1691,7 +2298,9 @@ scanZebra ::
-> NoLoggingT IO ()
scanZebra dbPath zHost zPort net sendMsg = do
bStatus <- liftIO $ checkBlockChain zHost zPort
logDebugN "starting DB pool"
pool <- liftIO $ runNoLoggingT $ initPool dbPath
logDebugN "started DB pool!"
b <- liftIO $ getMinBirthdayHeight pool $ ZcashNetDB net
dbBlock <- liftIO $ getMaxBlock pool $ ZcashNetDB net
chkBlock <- liftIO $ checkIntegrity dbPath zHost zPort net dbBlock 1
@ -1706,7 +2315,7 @@ scanZebra dbPath zHost zPort net sendMsg = do
then max dbBlock b
else max chkBlock b
unless (chkBlock == dbBlock || chkBlock == 1) $
rewindWalletData pool sb $ ZcashNetDB net
liftIO $ runNoLoggingT $ rewindWalletData pool sb $ ZcashNetDB net
if sb > zgb_blocks bStatus || sb < 1
then liftIO $ sendMsg (ShowError "Invalid starting block for scan")
else do
@ -1728,7 +2337,10 @@ scanZebra dbPath zHost zPort net sendMsg = do
(ShowError "Failed to update unconfirmed transactions")
Right _ -> do
liftIO $ sendMsg TreeSync
_ <- updateCommitmentTrees pool zHost zPort $ ZcashNetDB net
_ <-
liftIO $
runNoLoggingT $
updateCommitmentTrees pool zHost zPort $ ZcashNetDB net
_ <- liftIO $ completeSync pool Successful
logDebugN "Starting wallet sync"
liftIO $ sendMsg StartSync
@ -2006,11 +2618,25 @@ 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
params hd =
[ appWindowTitle "Zenith - Zcash Full Node Wallet - 0.7.2.0-beta"
[ appWindowTitle "Zenith - Zcash Full Node Wallet - 0.8.0.0-beta"
, appWindowState $ MainWindowNormal (1000, 700)
, appTheme zenithTheme
, appFontDef

2
src/Zenith/RPC.hs
View file

@ -1175,7 +1175,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 ()

18
src/Zenith/Types.hs
View file

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

124
src/Zenith/Utils.hs
View file

@ -2,16 +2,32 @@
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 +41,12 @@ import ZcashHaskell.Transparent
)
import ZcashHaskell.Types
( ExchangeAddress(..)
, ExchangeAddress(..)
, SaplingAddress(..)
, TransparentAddress(..)
, UnifiedAddress(..)
, ValidAddress(..)
, ValidAddress(..)
, ZcashNet(..)
)
import ZcashHaskell.Utils (makeZebraCall)
@ -37,6 +55,7 @@ import Zenith.Types
, PrivacyPolicy(..)
, UnifiedAddressDB(..)
, ZcashAddress(..)
, ZcashPaymentURI(..)
, ZcashPool(..)
)
@ -52,7 +71,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"
@ -249,5 +268,106 @@ getChainTip zHost zPort = do
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
getTransparentFromUA :: UnifiedAddress -> Maybe TransparentAddress
getTransparentFromUA ua = TransparentAddress (ua_net ua) <$> t_rec ua

11
test/ServerSpec.hs
View file

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

46
test/Spec.hs
View file

@ -9,6 +9,7 @@ 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
@ -1102,3 +1104,47 @@ 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"

2
zenith.cabal
View file

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

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