zenith-install - Merge branch 'milestone2' into zenith-install

This commit is contained in:
Rene V. Vergara A. 2024-07-11 13:54:50 -04:00
commit d1fd231fe2
11 changed files with 1058 additions and 338 deletions

View file

@ -5,7 +5,7 @@ All notable changes to this project will be documented in this file.
The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.0.0/),
and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0.html).
## [Unreleased]
## [0.6.0.0-beta]
### Added
@ -20,10 +20,36 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0
- Dialog to add new account
- Dialog to add new wallet
- Dialog to display transaction details and copy TX ID
- Dialog to send a new transaction
- Dialog to display Tx ID after successful broadcast
- Unconfirmed balance display on TUI and GUI
- Tracking of unconfirmed notes
### Changed
- Upgraded to GHC 9.6.5
### Fixed
- Validation of input of amount for sending in TUI
### Removed
- Legacy interface to `zcashd`
## [0.5.3.1-beta]
### Added
- Docker image
## [0.5.3.0-beta]
### Added
- Address Book functionality. Allows users to store frequently used zcash addresses and
generate transactions using them.
### Changed
- Improved formatting of sync progress
@ -34,11 +60,6 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0
## [0.5.2.0-beta]
### Added
- Address Book functionality. Allows users to store frequently used zcash addresses and
generate transactions using them.
### Changed
- Update to `zcash-haskell-0.6.2.0` to increase performance of transaction creation

View file

@ -11,7 +11,8 @@ import Data.Sort
import qualified Data.Text as T
import qualified Data.Text.IO as TIO
import Data.Time.Clock.POSIX
import System.Console.StructuredCLI
{-import System.Console.StructuredCLI-}
import System.Environment (getArgs)
import System.Exit
import System.IO
@ -23,7 +24,7 @@ import Zenith.GUI (runZenithGUI)
import Zenith.Types (Config(..), ZcashAddress(..), ZcashPool(..), ZcashTx(..))
import Zenith.Utils
import Zenith.Zcashd
{-
prompt :: String -> IO String
prompt text = do
putStr text
@ -197,14 +198,15 @@ processUri user pwd =
_ -> False
_ <- liftIO $ sendWithUri user pwd (addList !! (idx - 1)) u repTo
return NoAction
-}
main :: IO ()
main = do
config <- load [ "$(HOME)/Zenith/zenith.cfg" ]
args <- getArgs
dbFileName <- require config "dbFileName"
nodeUser <- require config "nodeUser"
nodePwd <- require config "nodePwd"
{-nodeUser <- require config "nodeUser"-}
{-nodePwd <- require config "nodePwd"-}
zebraPort <- require config "zebraPort"
zebraHost <- require config "zebraHost"
dbFP <- getZenithPath
@ -213,7 +215,7 @@ main = do
if not (null args)
then do
case head args of
"legacy" -> do
{-"legacy" -> do
checkServer nodeUser nodePwd
void $
runCLI
@ -222,9 +224,10 @@ main = do
{ getBanner =
" ______ _ _ _ \n |___ / (_) | | | \n / / ___ _ __ _| |_| |__ \n / / / _ \\ '_ \\| | __| '_ \\ \n / /_| __/ | | | | |_| | | |\n /_____\\___|_| |_|_|\\__|_| |_|\n Zcash Full Node CLI v0.4.0"
}
(root nodeUser nodePwd)
"tui" -> runZenithTUI myConfig
(root nodeUser nodePwd) -}
"gui" -> runZenithGUI myConfig
"tui" -> runZenithTUI myConfig
"rescan" -> clearSync myConfig
_ -> printUsage
else printUsage
@ -233,6 +236,6 @@ printUsage :: IO ()
printUsage = do
putStrLn "zenith [command] [parameters]\n"
putStrLn "Available commands:"
putStrLn "legacy\tLegacy CLI for zcashd"
{-putStrLn "legacy\tLegacy CLI for zcashd"-}
putStrLn "tui\tTUI for zebrad"
putStrLn "rescan\tRescan the existing wallet(s)"

View file

@ -2,7 +2,7 @@ packages:
./*.cabal
zcash-haskell/zcash-haskell.cabal
with-compiler: ghc-9.4.8
with-compiler: ghc-9.6.5
source-repository-package
type: git

View file

@ -1,12 +1,12 @@
active-repositories: hackage.haskell.org:merge
constraints: any.Cabal ==3.8.1.0,
any.Cabal-syntax ==3.8.1.0,
constraints: any.Cabal ==3.10.3.0,
any.Cabal-syntax ==3.10.3.0,
any.Clipboard ==2.3.2.0,
any.HUnit ==1.6.2.0,
any.Hclip ==3.0.0.4,
any.JuicyPixels ==3.3.8,
any.JuicyPixels ==3.3.9,
JuicyPixels -mmap,
any.OneTuple ==0.4.1.1,
any.OneTuple ==0.4.2,
any.OpenGLRaw ==3.3.4.1,
OpenGLRaw -osandroid +usegles2 +useglxgetprocaddress +usenativewindowslibraries,
any.QuickCheck ==2.14.3,
@ -18,32 +18,32 @@ constraints: any.Cabal ==3.8.1.0,
any.X11 ==1.10.3,
X11 -pedantic,
any.adjunctions ==4.4.2,
any.aeson ==2.2.1.0,
any.aeson ==2.2.3.0,
aeson +ordered-keymap,
any.alex ==3.5.1.0,
any.ansi-terminal ==1.1,
any.ansi-terminal ==1.1.1,
ansi-terminal -example,
any.ansi-terminal-types ==1.1,
any.appar ==0.1.8,
any.array ==0.5.4.0,
any.array ==0.5.6.0,
any.ascii-progress ==0.3.3.0,
ascii-progress -examples,
any.asn1-encoding ==0.9.6,
any.asn1-parse ==0.9.5,
any.asn1-types ==0.3.4,
any.assoc ==1.1,
assoc +tagged,
any.assoc ==1.1.1,
assoc -tagged,
any.async ==2.2.5,
async -bench,
any.attoparsec ==0.14.4,
attoparsec -developer,
any.attoparsec-aeson ==2.2.0.1,
any.attoparsec-aeson ==2.2.2.0,
any.authenticate-oauth ==1.7,
any.auto-update ==0.1.6,
any.base ==4.17.2.1,
any.base-compat ==0.13.1,
any.base-compat-batteries ==0.13.1,
any.base-orphans ==0.9.1,
any.auto-update ==0.2.1,
any.base ==4.18.2.1,
any.base-compat ==0.14.0,
any.base-compat-batteries ==0.14.0,
any.base-orphans ==0.9.2,
any.base16 ==1.0,
any.base16-bytestring ==1.0.2.0,
any.base58-bytestring ==0.1.0,
@ -53,14 +53,14 @@ constraints: any.Cabal ==3.8.1.0,
bifunctors +tagged,
any.bimap ==0.5.0,
any.binary ==0.8.9.1,
any.binary-orphans ==1.0.4.1,
any.binary-orphans ==1.0.5,
any.bitvec ==1.1.5.0,
bitvec +simd,
any.blaze-builder ==0.4.2.3,
any.blaze-html ==0.9.2.0,
any.blaze-markup ==0.8.3.0,
any.borsh ==0.3.0,
any.brick ==2.3.1,
any.brick ==2.4,
brick -demos,
any.byteorder ==1.0.4,
any.bytes ==0.17.3,
@ -70,19 +70,20 @@ constraints: any.Cabal ==3.8.1.0,
any.bytestring-to-vector ==0.3.0.1,
any.c2hs ==0.28.8,
c2hs +base3 -regression,
any.cabal-doctest ==1.0.9,
any.cabal-doctest ==1.0.10,
any.call-stack ==0.4.0,
any.case-insensitive ==1.2.1.0,
any.cborg ==0.2.10.0,
cborg +optimize-gmp,
any.cereal ==0.5.8.3,
cereal -bytestring-builder,
any.character-ps ==0.1,
any.clock ==0.8.4,
clock -llvm,
any.colour ==2.3.6,
any.comonad ==5.0.8,
comonad +containers +distributive +indexed-traversable,
any.concurrent-output ==1.10.20,
any.concurrent-output ==1.10.21,
any.conduit ==1.3.5,
any.conduit-extra ==1.3.6,
any.config-ini ==0.2.7.0,
@ -92,14 +93,14 @@ constraints: any.Cabal ==3.8.1.0,
any.containers ==0.6.7,
any.contravariant ==1.5.5,
contravariant +semigroups +statevar +tagged,
any.cookie ==0.4.6,
any.cookie ==0.5.0,
any.crypto-api ==0.13.3,
crypto-api -all_cpolys,
any.crypto-pubkey-types ==0.4.3,
any.crypton ==0.34,
any.crypton ==1.0.0,
crypton -check_alignment +integer-gmp -old_toolchain_inliner +support_aesni +support_deepseq +support_pclmuldq +support_rdrand -support_sse +use_target_attributes,
any.crypton-connection ==0.3.2,
any.crypton-x509 ==1.7.6,
any.crypton-connection ==0.4.1,
any.crypton-x509 ==1.7.7,
any.crypton-x509-store ==1.6.9,
any.crypton-x509-system ==1.6.7,
any.crypton-x509-validation ==1.6.12,
@ -111,9 +112,9 @@ constraints: any.Cabal ==3.8.1.0,
any.data-default-instances-containers ==0.0.1,
any.data-default-instances-dlist ==0.0.1,
any.data-default-instances-old-locale ==0.0.1,
any.data-fix ==0.3.2,
any.deepseq ==1.4.8.0,
any.directory ==1.3.7.1,
any.data-fix ==0.3.4,
any.deepseq ==1.4.8.1,
any.directory ==1.3.8.4,
any.distributive ==0.6.2.1,
distributive +semigroups +tagged,
any.dlist ==1.0,
@ -125,13 +126,11 @@ constraints: any.Cabal ==3.8.1.0,
entropy -donotgetentropy,
any.envy ==2.1.3.0,
any.esqueleto ==3.5.11.2,
any.exceptions ==0.10.5,
any.extra ==1.7.14,
any.fast-logger ==3.2.2,
any.filepath ==1.4.2.2,
any.exceptions ==0.10.7,
any.extra ==1.7.16,
any.fast-logger ==3.2.3,
any.filepath ==1.4.300.1,
any.fixed ==0.3,
any.foldable1-classes-compat ==0.1,
foldable1-classes-compat +tagged,
any.foreign-rust ==0.1.0,
any.foreign-store ==0.2.1,
any.formatting ==7.2.0,
@ -141,30 +140,29 @@ constraints: any.Cabal ==3.8.1.0,
generic-deriving +base-4-9,
any.generically ==0.1.1,
any.generics-sop ==0.5.1.4,
any.ghc ==9.4.8,
any.ghc ==9.6.5,
any.ghc-bignum ==1.3,
any.ghc-boot ==9.4.8,
any.ghc-boot-th ==9.4.8,
any.ghc-heap ==9.4.8,
any.ghc-prim ==0.9.1,
any.ghci ==9.4.8,
any.ghc-boot ==9.6.5,
any.ghc-boot-th ==9.6.5,
any.ghc-heap ==9.6.5,
any.ghc-prim ==0.10.0,
any.ghci ==9.6.5,
any.half ==0.3.1,
any.happy ==1.20.1.1,
any.hashable ==1.4.4.0,
hashable +integer-gmp -random-initial-seed,
any.haskeline ==0.8.2,
any.hashable ==1.4.7.0,
hashable -arch-native +integer-gmp -random-initial-seed,
any.haskell-lexer ==1.1.1,
any.haskoin-core ==1.1.0,
any.hexstring ==0.12.1.0,
any.hourglass ==0.2.12,
any.hpc ==0.6.1.0,
any.hpc ==0.6.2.0,
any.hsc2hs ==0.68.10,
hsc2hs -in-ghc-tree,
any.hspec ==2.11.7,
any.hspec-core ==2.11.7,
any.hspec-discover ==2.11.7,
any.hspec ==2.11.9,
any.hspec-core ==2.11.9,
any.hspec-discover ==2.11.9,
any.hspec-expectations ==0.8.4,
any.http-api-data ==0.6,
any.http-api-data ==0.6.1,
http-api-data -use-text-show,
any.http-client ==0.7.17,
http-client +network-uri,
@ -172,18 +170,18 @@ constraints: any.Cabal ==3.8.1.0,
any.http-conduit ==2.3.8.3,
http-conduit +aeson,
any.http-types ==0.12.4,
any.indexed-traversable ==0.1.3,
any.indexed-traversable-instances ==0.1.1.2,
any.integer-conversion ==0.1.0.1,
any.indexed-traversable ==0.1.4,
any.indexed-traversable-instances ==0.1.2,
any.integer-conversion ==0.1.1,
any.integer-gmp ==1.1,
any.integer-logarithms ==1.0.3.1,
integer-logarithms -check-bounds +integer-gmp,
any.invariant ==0.6.3,
any.iproute ==1.7.12,
any.kan-extensions ==5.2.5,
any.kan-extensions ==5.2.6,
any.language-c ==0.9.3,
language-c -allwarnings +iecfpextension +usebytestrings,
any.lens ==5.2.3,
any.lens ==5.3.2,
lens -benchmark-uniplate -dump-splices +inlining -j +test-hunit +test-properties +test-templates +trustworthy,
any.lens-aeson ==1.2.3,
any.lift-type ==0.1.1.1,
@ -196,7 +194,7 @@ constraints: any.Cabal ==3.8.1.0,
memory +support_bytestring +support_deepseq,
any.microlens ==0.4.13.1,
any.microlens-mtl ==0.2.0.3,
any.microlens-th ==0.4.3.14,
any.microlens-th ==0.4.3.15,
any.mime-types ==0.1.2.0,
any.monad-control ==1.0.3.1,
any.monad-logger ==0.3.40,
@ -206,16 +204,16 @@ constraints: any.Cabal ==3.8.1.0,
any.mono-traversable ==1.0.17.0,
any.monomer ==1.6.0.1,
monomer -examples,
any.mtl ==2.2.2,
any.mtl ==2.3.1,
any.murmur3 ==1.0.5,
any.nanovg ==0.8.1.0,
nanovg -examples -gl2 -gles3 -stb_truetype,
any.network ==3.1.4.0,
any.network ==3.2.1.0,
network -devel,
any.network-uri ==2.6.4.2,
any.old-locale ==1.0.0.7,
any.old-time ==1.1.0.4,
any.os-string ==2.0.2,
any.os-string ==2.0.6,
any.parallel ==3.2.2.0,
any.parsec ==3.1.16.1,
any.parser-combinators ==1.3.0,
@ -228,7 +226,7 @@ constraints: any.Cabal ==3.8.1.0,
any.persistent-template ==2.12.0.0,
any.pretty ==1.1.3.6,
any.primitive ==0.9.0.0,
any.process ==1.6.18.0,
any.process ==1.6.19.0,
any.profunctors ==5.6.2,
any.psqueues ==0.2.8.0,
any.pureMD5 ==2.1.4,
@ -238,7 +236,7 @@ constraints: any.Cabal ==3.8.1.0,
any.quickcheck-io ==0.2.0,
any.quickcheck-transformer ==0.3.1.2,
any.random ==1.2.1.2,
any.reflection ==2.1.7,
any.reflection ==2.1.8,
reflection -slow +template-haskell,
any.regex-base ==0.94.0.2,
any.regex-compat ==0.95.2.1,
@ -249,14 +247,14 @@ constraints: any.Cabal ==3.8.1.0,
any.rts ==1.0.2,
any.safe ==0.3.21,
any.safe-exceptions ==0.1.7.4,
any.scientific ==0.3.7.0,
scientific -bytestring-builder -integer-simple,
any.scientific ==0.3.8.0,
scientific -integer-simple,
any.sdl2 ==2.5.5.0,
sdl2 -examples -no-linear -opengl-example +pkgconfig +recent-ish,
any.secp256k1-haskell ==1.2.0,
any.semialign ==1.3,
any.semialign ==1.3.1,
semialign +semigroupoids,
any.semigroupoids ==6.0.0.1,
any.semigroupoids ==6.0.1,
semigroupoids +comonad +containers +contravariant +distributive +tagged +unordered-containers,
any.semigroups ==0.20,
semigroups +binary +bytestring -bytestring-builder +containers +deepseq +hashable +tagged +template-haskell +text +transformers +unordered-containers,
@ -273,57 +271,53 @@ constraints: any.Cabal ==3.8.1.0,
any.stm-chans ==3.0.0.9,
any.streaming-commons ==0.2.2.6,
streaming-commons -use-bytestring-builder,
any.strict ==0.5,
any.strict ==0.5.1,
any.string-conversions ==0.4.0.1,
any.structured-cli ==2.7.0.1,
structured-cli -debug,
any.system-cxx-std-lib ==1.0,
any.tagged ==0.8.8,
tagged +deepseq +transformers,
any.template-haskell ==2.19.0.0,
any.template-haskell ==2.20.0.0,
any.terminal-size ==0.3.4,
any.terminfo ==0.4.1.5,
any.terminfo ==0.4.1.6,
any.text ==2.0.2,
any.text-iso8601 ==0.1,
any.text-short ==0.1.5,
any.text-iso8601 ==0.1.1,
any.text-short ==0.1.6,
text-short -asserts,
any.text-show ==3.10.4,
any.text-show ==3.10.5,
text-show +base-4-9 +integer-gmp +new-functor-classes +template-haskell-2-11,
any.text-zipper ==0.13,
any.tf-random ==0.5,
any.th-abstraction ==0.6.0.0,
any.th-abstraction ==0.7.0.0,
any.th-compat ==0.1.5,
any.th-lift ==0.8.4,
any.th-lift-instances ==0.1.20,
any.these ==1.2,
any.these ==1.2.1,
any.time ==1.12.2,
any.time-compat ==1.9.6.1,
time-compat -old-locale,
any.time-compat ==1.9.7,
any.time-locale-compat ==0.1.1.5,
time-locale-compat -old-locale,
any.tls ==2.0.2,
any.tls ==2.1.0,
tls -devel,
any.transformers ==0.5.6.2,
any.transformers ==0.6.1.0,
any.transformers-base ==0.4.6,
transformers-base +orphaninstances,
any.transformers-compat ==0.7.2,
transformers-compat -five +five-three -four +generic-deriving +mtl -three -two,
any.typed-process ==0.2.11.1,
any.unix ==2.7.3,
any.unix-compat ==0.7.1,
unix-compat -old-time,
any.unix-time ==0.4.12,
any.unix ==2.8.4.0,
any.unix-compat ==0.7.2,
any.unix-time ==0.4.15,
any.unliftio ==0.2.25.0,
any.unliftio-core ==0.2.1.0,
any.unordered-containers ==0.2.20,
unordered-containers -debug,
any.utf8-string ==1.0.2,
any.uuid-types ==1.0.5.1,
any.uuid-types ==1.0.6,
any.vault ==0.3.1.5,
vault +useghc,
any.vector ==0.13.1.0,
vector +boundschecks -internalchecks -unsafechecks -wall,
any.vector-algorithms ==0.9.0.1,
any.vector-algorithms ==0.9.0.2,
vector-algorithms +bench +boundschecks -internalchecks -llvm +properties -unsafechecks,
any.vector-stream ==0.1.0.1,
any.void ==0.7.3,
@ -333,10 +327,10 @@ constraints: any.Cabal ==3.8.1.0,
vty-crossplatform -demos,
any.vty-unix ==0.2.0.0,
any.wide-word ==0.1.6.0,
any.witherable ==0.4.2,
any.witherable ==0.5,
any.word-wrap ==0.5,
any.wreq ==0.5.4.3,
wreq -aws -developer +doctest -httpbin,
any.zlib ==0.6.3.0,
any.zlib ==0.7.1.0,
zlib -bundled-c-zlib +non-blocking-ffi +pkg-config
index-state: hackage.haskell.org 2024-04-07T10:14:52Z
index-state: hackage.haskell.org 2024-07-10T18:40:26Z

View file

@ -3,7 +3,6 @@
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Zenith.CLI where
import qualified Brick.AttrMap as A
@ -11,8 +10,10 @@ import qualified Brick.BChan as BC
import qualified Brick.Focus as F
import Brick.Forms
( Form(..)
, FormFieldState
, (@@=)
, allFieldsValid
, editShowableField
, editShowableFieldWithValidate
, editTextField
, focusedFormInputAttr
@ -22,13 +23,11 @@ import Brick.Forms
, renderForm
, setFieldValid
, updateFormState
, FormFieldState
, editShowableField
)
import qualified Brick.Main as M
import qualified Brick.Types as BT
import Brick.Types (Widget)
import Brick.Util (bg, clamp, fg, on, style)
import Brick.Util (bg, fg, on, style)
import qualified Brick.Widgets.Border as B
import Brick.Widgets.Border.Style (unicode, unicodeBold)
import qualified Brick.Widgets.Center as C
@ -43,8 +42,8 @@ import Brick.Widgets.Core
, joinBorders
, padAll
, padBottom
, padTop
, padLeft
, padTop
, setAvailableSize
, str
, strWrap
@ -54,8 +53,8 @@ import Brick.Widgets.Core
, txtWrapWith
, updateAttrMap
, vBox
, viewport
, vLimit
, viewport
, withAttr
, withBorderStyle
)
@ -89,22 +88,33 @@ import ZcashHaskell.Keys (generateWalletSeedPhrase, getWalletSeed)
import ZcashHaskell.Orchard (getSaplingFromUA, isValidUnifiedAddress)
import ZcashHaskell.Sapling (decodeSaplingAddress, isValidShieldedAddress)
import ZcashHaskell.Transparent
( decodeExchangeAddress
, decodeTransparentAddress
( decodeTransparentAddress
, encodeTransparentReceiver
)
import ZcashHaskell.Types
import ZcashHaskell.Utils (getBlockTime, makeZebraCall)
import Zenith.Core
import Zenith.DB
import Zenith.Scanner (processTx)
import Zenith.Scanner (processTx, updateConfs)
import Zenith.Types
( Config(..)
, PhraseDB(..)
, UnifiedAddressDB(..)
, ZcashNetDB(..)
)
<<<<<<< HEAD
import Zenith.Utils (displayTaz, displayZec, jsonNumber, showAddress, getZenithPath)
=======
import Zenith.Utils
( displayTaz
, displayZec
, isRecipientValid
, jsonNumber
, parseAddress
, showAddress
, validBarValue
)
>>>>>>> milestone2
data Name
= WList
@ -197,8 +207,9 @@ data State = State
, _txForm :: !(Form SendInput () Name)
, _abAddresses :: !(L.List Name (Entity AddressBook))
, _abForm :: !(Form AdrBookEntry () Name)
, _abCurAdrs :: !T.Text -- used for address book CRUD operations
, _abCurAdrs :: !T.Text -- used for address book CRUD operations
, _sentTx :: !(Maybe HexString)
, _unconfBalance :: !Integer
}
makeLenses ''State
@ -216,10 +227,11 @@ drawUI s = [splashDialog s, helpDialog s, displayDialog s, inputDialog s, ui s]
show (st ^. network) <>
" - " <>
(T.unpack
(maybe
"(None)"
(\(_, w) -> zcashWalletName $ entityVal w)
(L.listSelectedElement (st ^. wallets)))) ++ " "))
(maybe
"(None)"
(\(_, w) -> zcashWalletName $ entityVal w)
(L.listSelectedElement (st ^. wallets)))) ++
" "))
(C.hCenter
(str
("Account: " ++
@ -234,9 +246,16 @@ drawUI s = [splashDialog s, helpDialog s, displayDialog s, inputDialog s, ui s]
if st ^. network == MainNet
then displayZec (st ^. balance)
else displayTaz (st ^. balance))) <=>
listAddressBox " Addresses " (st ^. addresses) <+>
C.hCenter
(str
("Unconf: " ++
if st ^. network == MainNet
then displayZec (st ^. unconfBalance)
else displayTaz (st ^. unconfBalance))) <=>
listAddressBox "Addresses" (st ^. addresses) <+>
B.vBorder <+>
(C.hCenter (str ("Last block seen: " ++ show (st ^. syncBlock) ++ "\n")) <=>
(C.hCenter
(str ("Last block seen: " ++ show (st ^. syncBlock) ++ "\n")) <=>
listTxBox " Transactions " (st ^. network) (st ^. transactions))) <=>
C.hCenter
(hBox
@ -313,7 +332,8 @@ drawUI s = [splashDialog s, helpDialog s, displayDialog s, inputDialog s, ui s]
vBox ([str "Actions", B.hBorder] <> actionList))
else emptyWidget
where
keyList = map (C.hCenter . str) ["?", "Esc", "w", "a", "v", "s", "b", "q"]
keyList =
map (C.hCenter . str) ["?", "Esc", "w", "a", "v", "s", "b", "q"]
actionList =
map
(hLimit 40 . str)
@ -374,50 +394,55 @@ drawUI s = [splashDialog s, helpDialog s, displayDialog s, inputDialog s, ui s]
-- Address Book List
AdrBook ->
D.renderDialog
(D.dialog (Just $ str " Address Book ") Nothing 60)
(withAttr abDefAttr $
setAvailableSize (50,20) $
viewport ABViewport BT.Vertical $
vLimit 20 $
hLimit 50 $
vBox [vLimit 16 $
hLimit 50 $
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")]])
(D.dialog (Just $ str " Address Book ") Nothing 60)
(withAttr abDefAttr $
setAvailableSize (50, 20) $
viewport ABViewport BT.Vertical $
vLimit 20 $
hLimit 50 $
vBox
[ vLimit 16 $
hLimit 50 $
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")
]
])
-- Address Book new entry form
AdrBookForm ->
D.renderDialog
(D.dialog (Just $ str " New Address Book Entry ") Nothing 50)
(renderForm (st ^. abForm) <=>
C.hCenter
(hBox [capCommand "" " Save", capCommand3 "" "<Esc>" " Cancel"]))
(hBox [capCommand "" " Save", capCommand3 "" "<Esc>" " Cancel"]))
-- Address Book edit/update entry form
AdrBookUpdForm ->
D.renderDialog
(D.dialog (Just $ str " Edit Address Book Entry ") Nothing 50)
(renderForm (st ^. abForm) <=>
C.hCenter
(hBox [capCommand "" " Save", capCommand3 "" "<Esc>" " Cancel"]))
(hBox [capCommand "" " Save", capCommand3 "" "<Esc>" " Cancel"]))
-- Address Book edit/update entry form
AdrBookDelForm ->
D.renderDialog
(D.dialog (Just $ str " Delete Address Book Entry ") Nothing 50)
(renderForm (st ^. abForm) <=>
C.hCenter
(hBox [capCommand "C" "onfirm delete", capCommand3 "" "<Esc>" " Cancel"]))
(hBox
[ capCommand "C" "onfirm delete"
, capCommand3 "" "<Esc>" " Cancel"
]))
--
splashDialog :: State -> Widget Name
splashDialog st =
if st ^. splashBox
@ -429,16 +454,14 @@ 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.5.3.0-beta")) <=>
(withAttr titleAttr (str "Zcash Wallet v0.6.0.0-beta")) <=>
C.hCenter (withAttr blinkAttr $ str "Press any key..."))
else emptyWidget
capCommand3 :: String -> String -> String -> Widget Name
capCommand3 l h e = hBox [str l, withAttr titleAttr (str h), str e]
capCommand2 :: String -> String -> String -> Widget Name
capCommand2 l h e = hBox [str l, withAttr titleAttr (str h), str e, str " | "]
capCommand2 l h e =
hBox [str l, withAttr titleAttr (str h), str e, str " | "]
capCommand :: String -> String -> Widget Name
capCommand k comm = hBox [withAttr titleAttr (str k), str comm, str " | "]
xCommand :: Widget Name
@ -563,19 +586,20 @@ drawUI s = [splashDialog s, helpDialog s, displayDialog s, inputDialog s, ui s]
(WrapSettings False True NoFill FillAfterFirst)
(st ^. msg)))
AdrBookEntryDisplay -> do
case L.listSelectedElement $ st ^. abAddresses of
case L.listSelectedElement $ st ^. abAddresses of
Just (_, a) -> do
let abentry = T.pack $
" Descr: " ++
T.unpack (addressBookAbdescrip (entityVal a)) ++
"\n Address: " ++
T.unpack (addressBookAbaddress (entityVal a))
let abentry =
T.pack $
" Descr: " ++
T.unpack (addressBookAbdescrip (entityVal a)) ++
"\n Address: " ++
T.unpack (addressBookAbaddress (entityVal a))
withBorderStyle unicodeBold $
D.renderDialog
(D.dialog (Just $ txt " Address Book Entry ") Nothing 60)
(padAll 1 $
txtWrapWith (WrapSettings False True NoFill FillAfterFirst) $
abentry)
(D.dialog (Just $ txt " Address Book Entry ") Nothing 60)
(padAll 1 $
txtWrapWith (WrapSettings False True NoFill FillAfterFirst) $
abentry)
_ -> emptyWidget
BlankDisplay -> emptyWidget
@ -597,12 +621,12 @@ mkSendForm bal =
]
where
isAmountValid :: Integer -> Float -> Bool
isAmountValid b i = (fromIntegral b * 100000000.0) >= i && i > 0
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 =
mkNewABForm =
newForm
[ label "Descrip: " @@= editTextField descrip DescripField (Just 1)
, label "Address: " @@= editTextField address AddressField (Just 1)
@ -611,19 +635,6 @@ mkNewABForm =
label s w =
padBottom (Pad 1) $ vLimit 1 (hLimit 10 $ str s <+> fill ' ') <+> w
isRecipientValid :: T.Text -> Bool
isRecipientValid a =
case isValidUnifiedAddress (E.encodeUtf8 a) of
Just _a1 -> True
Nothing ->
isValidShieldedAddress (E.encodeUtf8 a) ||
(case decodeTransparentAddress (E.encodeUtf8 a) of
Just _a3 -> True
Nothing ->
case decodeExchangeAddress a of
Just _a4 -> True
Nothing -> False)
listDrawElement :: (Show a) => Bool -> a -> Widget Name
listDrawElement sel a =
let selStr s =
@ -684,9 +695,9 @@ listDrawAB :: Bool -> Entity AddressBook -> Widget Name
listDrawAB sel ab =
let selStr s =
if sel
then withAttr abSelAttr (txt $ " " <> s )
then withAttr abSelAttr (txt $ " " <> s)
else txt $ " " <> s
in selStr $ addressBookAbdescrip (entityVal ab)
in selStr $ addressBookAbdescrip (entityVal ab)
customAttr :: A.AttrName
customAttr = L.listSelectedAttr <> A.attrName "custom"
@ -715,26 +726,32 @@ abSelAttr = A.attrName "abselected"
abMBarAttr :: A.AttrName
abMBarAttr = A.attrName "menubar"
validBarValue :: Float -> Float
validBarValue = clamp 0 1
scanZebra :: T.Text -> T.Text -> Int -> Int -> BC.BChan Tick -> IO ()
scanZebra dbP zHost zPort b eChan = do
_ <- liftIO $ initDb dbP
bStatus <- liftIO $ checkBlockChain zHost zPort
pool <- runNoLoggingT $ initPool dbP
dbBlock <- runNoLoggingT $ getMaxBlock pool
let sb = max dbBlock b
if sb > zgb_blocks bStatus || sb < 1
then liftIO $ BC.writeBChan eChan $ TickMsg "Invalid starting block for scan"
else do
let bList = [(sb + 1) .. (zgb_blocks bStatus)]
if not (null bList)
confUp <- try $ updateConfs zHost zPort pool :: IO (Either IOError ())
case confUp of
Left _e0 ->
liftIO $
BC.writeBChan eChan $ TickMsg "Failed to update unconfirmed transactions"
Right _ -> do
let sb = max dbBlock b
if sb > zgb_blocks bStatus || sb < 1
then do
let step =
(1.0 :: Float) / fromIntegral (zgb_blocks bStatus - (sb + 1))
mapM_ (processBlock pool step) bList
else liftIO $ BC.writeBChan eChan $ TickVal 1.0
liftIO $
BC.writeBChan eChan $ TickMsg "Invalid starting block for scan"
else do
let bList = [(sb + 1) .. (zgb_blocks bStatus)]
if not (null bList)
then do
let step =
(1.0 :: Float) /
fromIntegral (zgb_blocks bStatus - (sb + 1))
mapM_ (processBlock pool step) bList
else liftIO $ BC.writeBChan eChan $ TickVal 1.0
where
processBlock :: ConnectionPool -> Float -> Int -> IO ()
processBlock pool step bl = do
@ -1072,19 +1089,21 @@ appEvent (BT.VtyEvent e) = do
BT.modify $ set msg "Invalid inputs"
BT.modify $ set displayBox MsgDisplay
BT.modify $ set dialogBox Blank
ev -> BT.zoom txForm $ do
handleFormEvent (BT.VtyEvent ev)
fs <- BT.gets formState
BT.modify $
setFieldValid
(isRecipientValid (fs ^. sendTo))
RecField
ev ->
BT.zoom txForm $ do
handleFormEvent (BT.VtyEvent ev)
fs <- BT.gets formState
BT.modify $
setFieldValid
(isRecipientValid (fs ^. sendTo))
RecField
AdrBook -> do
case e of
V.EvKey (V.KChar 'x') [] ->
BT.modify $ set dialogBox Blank
V.EvKey (V.KChar 'c') [] -> do
V.EvKey (V.KChar 'c') []
-- Copy Address to Clipboard
-> do
case L.listSelectedElement $ s ^. abAddresses of
Just (_, a) -> do
liftIO $
@ -1092,53 +1111,72 @@ appEvent (BT.VtyEvent e) = do
T.unpack $ addressBookAbaddress (entityVal a)
BT.modify $
set msg $
"Address copied to Clipboard from >>\n" ++
T.unpack (addressBookAbdescrip (entityVal a))
"Address copied to Clipboard from >>\n" ++
T.unpack (addressBookAbdescrip (entityVal a))
BT.modify $ set displayBox MsgDisplay
_ -> do
BT.modify $ set msg "Error while copying the address!!"
BT.modify $ set displayBox MsgDisplay
BT.modify $
set msg "Error while copying the address!!"
BT.modify $ set displayBox MsgDisplay
-- Send Zcash transaction
V.EvKey (V.KChar 's') [] -> do
case L.listSelectedElement $ s ^. abAddresses of
Just (_, a) -> do
BT.modify $
set txForm $
mkSendForm (s ^. balance) (SendInput (addressBookAbaddress (entityVal a)) 0.0 "")
BT.modify $ set dialogBox SendTx
BT.modify $
set txForm $
mkSendForm
(s ^. balance)
(SendInput
(addressBookAbaddress (entityVal a))
0.0
"")
BT.modify $ set dialogBox SendTx
_ -> do
BT.modify $ set msg "No receiver address available!!"
BT.modify $ set displayBox MsgDisplay
BT.modify $
set msg "No receiver address available!!"
BT.modify $ set displayBox MsgDisplay
-- Edit an entry in Address Book
V.EvKey (V.KChar 'e') [] -> do
case L.listSelectedElement $ s ^. abAddresses of
Just (_, a) -> do
BT.modify $ set abCurAdrs (addressBookAbaddress (entityVal a))
BT.modify $
set abForm $
mkNewABForm (AdrBookEntry (addressBookAbdescrip (entityVal a)) (addressBookAbaddress (entityVal a)))
BT.modify $ set dialogBox AdrBookUpdForm
BT.modify $
set
abCurAdrs
(addressBookAbaddress (entityVal a))
BT.modify $
set abForm $
mkNewABForm
(AdrBookEntry
(addressBookAbdescrip (entityVal a))
(addressBookAbaddress (entityVal a)))
BT.modify $ set dialogBox AdrBookUpdForm
_ -> do
BT.modify $ set dialogBox Blank
BT.modify $ set dialogBox Blank
-- Delete an entry from Address Book
V.EvKey (V.KChar 'd') [] -> do
case L.listSelectedElement $ s ^. abAddresses of
Just (_, a) -> do
BT.modify $ set abCurAdrs (addressBookAbaddress (entityVal a))
BT.modify $
set abForm $
mkNewABForm (AdrBookEntry (addressBookAbdescrip (entityVal a)) (addressBookAbaddress (entityVal a)))
BT.modify $ set dialogBox AdrBookDelForm
BT.modify $
set
abCurAdrs
(addressBookAbaddress (entityVal a))
BT.modify $
set abForm $
mkNewABForm
(AdrBookEntry
(addressBookAbdescrip (entityVal a))
(addressBookAbaddress (entityVal a)))
BT.modify $ set dialogBox AdrBookDelForm
_ -> do
BT.modify $ set dialogBox Blank
BT.modify $ set dialogBox Blank
-- Create a new entry in Address Book
V.EvKey (V.KChar 'n') [] -> do
BT.modify $ set abForm $ mkNewABForm (AdrBookEntry "" "")
BT.modify $ set dialogBox AdrBookForm
BT.modify $
set abForm $ mkNewABForm (AdrBookEntry "" "")
BT.modify $ set dialogBox AdrBookForm
-- Show AddressBook entry data
V.EvKey V.KEnter [] -> do
BT.modify $ set displayBox AdrBookEntryDisplay
BT.modify $ set displayBox AdrBookEntryDisplay
-- Process any other event
ev -> BT.zoom abAddresses $ L.handleListEvent ev
-- Process new address book entry
@ -1146,75 +1184,101 @@ appEvent (BT.VtyEvent e) = do
case e of
V.EvKey V.KEsc [] -> BT.modify $ set dialogBox AdrBook
V.EvKey V.KEnter [] -> do
pool <- liftIO $ runNoLoggingT $ initPool $ s ^. dbPath
fs <- BT.zoom abForm $ BT.gets formState
let idescr = T.unpack $ T.strip (fs ^. descrip)
let iabadr = fs ^. address
if not (null idescr) && isRecipientValid iabadr
then do
res <- liftIO $ saveAdrsInAdrBook pool $ AddressBook (ZcashNetDB (s ^. network)) (fs ^. descrip) (fs ^.address)
case res of
Nothing -> do
BT.modify $ set msg ("AddressBook Entry already exists: " ++ T.unpack (fs ^.address))
BT.modify $ set displayBox MsgDisplay
Just _ -> do
BT.modify $ set msg ("New AddressBook entry created!!\n" ++ T.unpack (fs ^.address))
BT.modify $ set displayBox MsgDisplay
pool <- liftIO $ runNoLoggingT $ initPool $ s ^. dbPath
fs <- BT.zoom abForm $ BT.gets formState
let idescr = T.unpack $ T.strip (fs ^. descrip)
let iabadr = fs ^. address
if not (null idescr) && isRecipientValid iabadr
then do
res <-
liftIO $
saveAdrsInAdrBook pool $
AddressBook
(ZcashNetDB (s ^. network))
(fs ^. descrip)
(fs ^. address)
case res of
Nothing -> do
BT.modify $
set
msg
("AddressBook Entry already exists: " ++
T.unpack (fs ^. address))
BT.modify $ set displayBox MsgDisplay
Just _ -> do
BT.modify $
set
msg
("New AddressBook entry created!!\n" ++
T.unpack (fs ^. address))
BT.modify $ set displayBox MsgDisplay
-- case end
s' <- liftIO $ refreshAddressBook s
BT.put s'
BT.modify $ set dialogBox AdrBook
else do
BT.modify $ set msg "Invalid or missing data!!: "
BT.modify $ set displayBox MsgDisplay
BT.modify $ set dialogBox AdrBookForm
ev -> BT.zoom abForm $ do
handleFormEvent (BT.VtyEvent ev)
fs <- BT.gets formState
BT.modify $
setFieldValid
(isRecipientValid (fs ^. address))
AddressField
s' <- liftIO $ refreshAddressBook s
BT.put s'
BT.modify $ set dialogBox AdrBook
else do
BT.modify $ set msg "Invalid or missing data!!: "
BT.modify $ set displayBox MsgDisplay
BT.modify $ set dialogBox AdrBookForm
ev ->
BT.zoom abForm $ do
handleFormEvent (BT.VtyEvent ev)
fs <- BT.gets formState
BT.modify $
setFieldValid
(isRecipientValid (fs ^. address))
AddressField
AdrBookUpdForm -> do
case e of
V.EvKey V.KEsc [] -> BT.modify $ set dialogBox AdrBook
V.EvKey V.KEnter [] -> do
pool <- liftIO $ runNoLoggingT $ initPool $ s ^. dbPath
fs <- BT.zoom abForm $ BT.gets formState
let idescr = T.unpack $ T.strip (fs ^. descrip)
let iabadr = fs ^. address
if not (null idescr) && isRecipientValid iabadr
then do
res <- liftIO $ updateAdrsInAdrBook pool (fs ^. descrip) (fs ^.address) (s ^. abCurAdrs)
BT.modify $ set msg ("AddressBook entry modified!!\n" ++ T.unpack (fs ^.address))
BT.modify $ set displayBox MsgDisplay
pool <- liftIO $ runNoLoggingT $ initPool $ s ^. dbPath
fs <- BT.zoom abForm $ BT.gets formState
let idescr = T.unpack $ T.strip (fs ^. descrip)
let iabadr = fs ^. address
if not (null idescr) && isRecipientValid iabadr
then do
res <-
liftIO $
updateAdrsInAdrBook
pool
(fs ^. descrip)
(fs ^. address)
(s ^. abCurAdrs)
BT.modify $
set
msg
("AddressBook entry modified!!\n" ++
T.unpack (fs ^. address))
BT.modify $ set displayBox MsgDisplay
-- case end
s' <- liftIO $ refreshAddressBook s
BT.put s'
BT.modify $ set dialogBox AdrBook
else do
BT.modify $ set msg "Invalid or missing data!!: "
BT.modify $ set displayBox MsgDisplay
BT.modify $ set dialogBox AdrBookForm
ev -> BT.zoom abForm $ do
handleFormEvent (BT.VtyEvent ev)
fs <- BT.gets formState
BT.modify $
setFieldValid
(isRecipientValid (fs ^. address))
AddressField
s' <- liftIO $ refreshAddressBook s
BT.put s'
BT.modify $ set dialogBox AdrBook
else do
BT.modify $ set msg "Invalid or missing data!!: "
BT.modify $ set displayBox MsgDisplay
BT.modify $ set dialogBox AdrBookForm
ev ->
BT.zoom abForm $ do
handleFormEvent (BT.VtyEvent ev)
fs <- BT.gets formState
BT.modify $
setFieldValid
(isRecipientValid (fs ^. address))
AddressField
-- Process delete AddresBook entry
AdrBookDelForm -> do
case e of
V.EvKey V.KEsc [] -> BT.modify $ set dialogBox AdrBook
V.EvKey (V.KChar 'c') [] -> do
pool <- liftIO $ runNoLoggingT $ initPool $ s ^. dbPath
fs <- BT.zoom abForm $ BT.gets formState
res <- liftIO $ deleteAdrsFromAB pool (fs ^.address)
s' <- liftIO $ refreshAddressBook s
BT.put s'
BT.modify $ set dialogBox AdrBook
ev -> BT.modify $ set dialogBox AdrBookDelForm
case e of
V.EvKey V.KEsc [] -> BT.modify $ set dialogBox AdrBook
V.EvKey (V.KChar 'c') [] -> do
pool <- liftIO $ runNoLoggingT $ initPool $ s ^. dbPath
fs <- BT.zoom abForm $ BT.gets formState
res <- liftIO $ deleteAdrsFromAB pool (fs ^. address)
s' <- liftIO $ refreshAddressBook s
BT.put s'
BT.modify $ set dialogBox AdrBook
ev -> BT.modify $ set dialogBox AdrBookDelForm
-- Process any other event
Blank -> do
case e of
@ -1321,13 +1385,15 @@ runZenithTUI config = do
if not (null walList)
then zcashWalletLastSync $ entityVal $ head walList
else 0
abookList <- getAdrBook pool $ zgb_net chainInfo
bal <-
if not (null accList)
then getBalance pool $ entityKey $ head accList
else return 0
uBal <-
if not (null accList)
then getUnconfirmedBalance pool $ entityKey $ head accList
else return 0
eventChan <- BC.newBChan 10
_ <-
forkIO $
@ -1368,6 +1434,7 @@ runZenithTUI config = do
(mkNewABForm (AdrBookEntry "" ""))
""
Nothing
uBal
Left e -> do
print $
"No Zebra node available on port " <>
@ -1396,6 +1463,10 @@ refreshWallet s = do
if not (null aL)
then getBalance pool $ entityKey $ head aL
else return 0
uBal <-
if not (null aL)
then getUnconfirmedBalance pool $ entityKey $ head aL
else return 0
txL <-
if not (null addrL)
then getUserTx pool $ entityKey $ head addrL
@ -1406,6 +1477,8 @@ refreshWallet s = do
let txL' = L.listReplace (Vec.fromList txL) (Just 0) (s ^. transactions)
return $
s & wallets .~ wL & accounts .~ aL' & syncBlock .~ bl & balance .~ bal &
unconfBalance .~
uBal &
addresses .~
addrL' &
transactions .~
@ -1451,8 +1524,7 @@ addNewAccount n s = do
Right zA' -> do
r <- saveAccount pool zA'
case r of
Nothing ->
return $ s & msg .~ "Account already exists: " ++ T.unpack n
Nothing -> return $ s & msg .~ "Account already exists: " ++ T.unpack n
Just x -> do
aL <- runNoLoggingT $ getAccounts pool (entityKey selWallet)
let nL =
@ -1475,6 +1547,7 @@ refreshAccount s = do
Just (_k, w) -> return w
aL <- runNoLoggingT $ getAddresses pool $ entityKey selAccount
bal <- getBalance pool $ entityKey selAccount
uBal <- getUnconfirmedBalance pool $ entityKey selAccount
let aL' = L.listReplace (Vec.fromList aL) (Just 0) (s ^. addresses)
selAddress <-
do case L.listSelectedElement aL' of
@ -1485,13 +1558,17 @@ refreshAccount s = do
case selAddress of
Nothing ->
return $
s & balance .~ bal & addresses .~ aL' & msg .~ "Switched to account: " ++
s & balance .~ bal & unconfBalance .~ uBal & addresses .~ aL' & msg .~
"Switched to account: " ++
T.unpack (zcashAccountName $ entityVal selAccount)
Just (_i, a) -> do
tList <- getUserTx pool $ entityKey a
let tL' = L.listReplace (Vec.fromList tList) (Just 0) (s ^. transactions)
return $
s & balance .~ bal & addresses .~ aL' & transactions .~ tL' & msg .~
s & balance .~ bal & unconfBalance .~ uBal & addresses .~ aL' &
transactions .~
tL' &
msg .~
"Switched to account: " ++
T.unpack (zcashAccountName $ entityVal selAccount)
@ -1519,10 +1596,11 @@ refreshAddressBook s = do
do case L.listSelectedElement $ s ^. abAddresses of
Nothing -> do
let fAdd =
L.listSelectedElement $ L.listMoveToBeginning $ s ^. abAddresses
L.listSelectedElement $
L.listMoveToBeginning $ s ^. abAddresses
return fAdd
Just a2 -> return $ Just a2
abookList <- getAdrBook pool (s ^. network)
abookList <- getAdrBook pool (s ^. network)
let tL' = L.listReplace (Vec.fromList abookList) (Just 0) (s ^. abAddresses)
return $ s & abAddresses .~ tL'
@ -1547,8 +1625,7 @@ addNewAddress n scope s = do
Right uA' -> do
nAddr <- saveAddress pool uA'
case nAddr of
Nothing ->
return $ s & msg .~ "Address already exists: " ++ T.unpack n
Nothing -> return $ s & msg .~ "Address already exists: " ++ T.unpack n
Just x -> do
addrL <- runNoLoggingT $ getAddresses pool (entityKey selAccount)
let nL =
@ -1574,6 +1651,7 @@ sendTransaction ::
-> IO ()
sendTransaction pool chan zHost zPort znet accId bl amt ua memo = do
BC.writeBChan chan $ TickMsg "Preparing transaction..."
<<<<<<< HEAD
zenithPath <- getZenithPath
let zenithLogPath = ( zenithPath ++ "zenith.log" )
outUA <- parseAddress ua
@ -1609,3 +1687,24 @@ sendTransaction pool chan zHost zPort znet accId bl amt ua memo = do
return $
UnifiedAddress znet Nothing Nothing (Just $ ta_receiver a3)
Nothing -> throwIO $ userError "Incorrect address"
=======
case parseAddress ua znet of
Nothing -> BC.writeBChan chan $ TickMsg "Incorrect address"
Just outUA -> do
res <-
runFileLoggingT "zenith.log" $
prepareTx pool zHost zPort znet accId bl amt outUA memo
BC.writeBChan chan $ TickMsg "Transaction ready, sending to Zebra..."
case res of
Left e -> BC.writeBChan chan $ TickMsg $ show e
Right rawTx -> do
resp <-
makeZebraCall
zHost
zPort
"sendrawtransaction"
[Data.Aeson.String $ toText rawTx]
case resp of
Left e1 -> BC.writeBChan chan $ TickMsg $ "Zebra error: " ++ show e1
Right txId -> BC.writeBChan chan $ TickTx txId
>>>>>>> milestone2

View file

@ -32,7 +32,6 @@ import qualified Data.Text as T
import qualified Data.Text.Encoding as TE
import Data.Word
import Database.Esqueleto.Experimental
import qualified Database.Persist as P
import qualified Database.Persist.Sqlite as PS
import Database.Persist.TH
import Haskoin.Transaction.Common
@ -43,7 +42,6 @@ import Haskoin.Transaction.Common
)
import qualified Lens.Micro as ML ((&), (.~), (^.))
import ZcashHaskell.Orchard (isValidUnifiedAddress)
import ZcashHaskell.Sapling (decodeSaplingOutputEsk)
import ZcashHaskell.Types
( DecodedNote(..)
, OrchardAction(..)
@ -247,12 +245,6 @@ share
position Int
UniqueSSPos tx position
deriving Show Eq
AddressBook
network ZcashNetDB
abdescrip T.Text
abaddress T.Text
UniqueABA abaddress
deriving Show Eq
QrCode
address WalletAddressId OnDeleteCascade OnUpdateCascade
version ZcashPool
@ -262,6 +254,12 @@ share
name T.Text
UniqueQr address version
deriving Show Eq
AddressBook
network ZcashNetDB
abdescrip T.Text
abaddress T.Text
UniqueABA abaddress
deriving Show Eq
|]
-- * Database functions
@ -1398,6 +1396,35 @@ getBalance pool za = do
let oBal = sum oAmts
return . fromIntegral $ tBal + sBal + oBal
getTransparentBalance :: ConnectionPool -> ZcashAccountId -> IO Integer
getTransparentBalance pool za = do
trNotes <- getWalletUnspentTrNotes pool za
let tAmts = map (walletTrNoteValue . entityVal) trNotes
return . fromIntegral $ sum tAmts
getShieldedBalance :: ConnectionPool -> ZcashAccountId -> IO Integer
getShieldedBalance pool za = do
sapNotes <- getWalletUnspentSapNotes pool za
let sAmts = map (walletSapNoteValue . entityVal) sapNotes
let sBal = sum sAmts
orchNotes <- getWalletUnspentOrchNotes pool za
let oAmts = map (walletOrchNoteValue . entityVal) orchNotes
let oBal = sum oAmts
return . fromIntegral $ sBal + oBal
getUnconfirmedBalance :: ConnectionPool -> ZcashAccountId -> IO Integer
getUnconfirmedBalance pool za = do
trNotes <- getWalletUnspentUnconfirmedTrNotes pool za
let tAmts = map (walletTrNoteValue . entityVal) trNotes
let tBal = sum tAmts
sapNotes <- getWalletUnspentUnconfirmedSapNotes pool za
let sAmts = map (walletSapNoteValue . entityVal) sapNotes
let sBal = sum sAmts
orchNotes <- getWalletUnspentUnconfirmedOrchNotes pool za
let oAmts = map (walletOrchNoteValue . entityVal) orchNotes
let oBal = sum oAmts
return . fromIntegral $ tBal + sBal + oBal
clearWalletTransactions :: ConnectionPool -> IO ()
clearWalletTransactions pool = do
runNoLoggingT $
@ -1435,10 +1462,42 @@ getWalletUnspentTrNotes pool za = do
PS.retryOnBusy $
flip PS.runSqlPool pool $ do
select $ do
n <- from $ table @WalletTrNote
where_ (n ^. WalletTrNoteAccId ==. val za)
where_ (n ^. WalletTrNoteSpent ==. val False)
pure n
(txs :& tNotes) <-
from $ table @WalletTransaction `innerJoin` table @WalletTrNote `on`
(\(txs :& tNotes) ->
txs ^. WalletTransactionId ==. tNotes ^. WalletTrNoteTx)
where_ (tNotes ^. WalletTrNoteAccId ==. val za)
where_ (tNotes ^. WalletTrNoteSpent ==. val False)
where_
((tNotes ^. WalletTrNoteChange ==. val True &&. txs ^.
WalletTransactionConf >=.
val 3) ||.
(tNotes ^. WalletTrNoteChange ==. val False &&. txs ^.
WalletTransactionConf >=.
val 10))
pure tNotes
getWalletUnspentUnconfirmedTrNotes ::
ConnectionPool -> ZcashAccountId -> IO [Entity WalletTrNote]
getWalletUnspentUnconfirmedTrNotes pool za = do
runNoLoggingT $
PS.retryOnBusy $
flip PS.runSqlPool pool $ do
select $ do
(txs :& tNotes) <-
from $ table @WalletTransaction `innerJoin` table @WalletTrNote `on`
(\(txs :& tNotes) ->
txs ^. WalletTransactionId ==. tNotes ^. WalletTrNoteTx)
where_ (tNotes ^. WalletTrNoteAccId ==. val za)
where_ (tNotes ^. WalletTrNoteSpent ==. val False)
where_
((tNotes ^. WalletTrNoteChange ==. val True &&. txs ^.
WalletTransactionConf <.
val 3) ||.
(tNotes ^. WalletTrNoteChange ==. val False &&. txs ^.
WalletTransactionConf <.
val 10))
pure tNotes
getWalletUnspentSapNotes ::
ConnectionPool -> ZcashAccountId -> IO [Entity WalletSapNote]
@ -1447,10 +1506,42 @@ getWalletUnspentSapNotes pool za = do
PS.retryOnBusy $
flip PS.runSqlPool pool $ do
select $ do
n1 <- from $ table @WalletSapNote
where_ (n1 ^. WalletSapNoteAccId ==. val za)
where_ (n1 ^. WalletSapNoteSpent ==. val False)
pure n1
(txs :& sNotes) <-
from $ table @WalletTransaction `innerJoin` table @WalletSapNote `on`
(\(txs :& sNotes) ->
txs ^. WalletTransactionId ==. sNotes ^. WalletSapNoteTx)
where_ (sNotes ^. WalletSapNoteAccId ==. val za)
where_ (sNotes ^. WalletSapNoteSpent ==. val False)
where_
((sNotes ^. WalletSapNoteChange ==. val True &&. txs ^.
WalletTransactionConf >=.
val 3) ||.
(sNotes ^. WalletSapNoteChange ==. val False &&. txs ^.
WalletTransactionConf >=.
val 10))
pure sNotes
getWalletUnspentUnconfirmedSapNotes ::
ConnectionPool -> ZcashAccountId -> IO [Entity WalletSapNote]
getWalletUnspentUnconfirmedSapNotes pool za = do
runNoLoggingT $
PS.retryOnBusy $
flip PS.runSqlPool pool $ do
select $ do
(txs :& sNotes) <-
from $ table @WalletTransaction `innerJoin` table @WalletSapNote `on`
(\(txs :& sNotes) ->
txs ^. WalletTransactionId ==. sNotes ^. WalletSapNoteTx)
where_ (sNotes ^. WalletSapNoteAccId ==. val za)
where_ (sNotes ^. WalletSapNoteSpent ==. val False)
where_
((sNotes ^. WalletSapNoteChange ==. val True &&. txs ^.
WalletTransactionConf <.
val 3) ||.
(sNotes ^. WalletSapNoteChange ==. val False &&. txs ^.
WalletTransactionConf <.
val 10))
pure sNotes
getWalletUnspentOrchNotes ::
ConnectionPool -> ZcashAccountId -> IO [Entity WalletOrchNote]
@ -1459,10 +1550,42 @@ getWalletUnspentOrchNotes pool za = do
PS.retryOnBusy $
flip PS.runSqlPool pool $ do
select $ do
n2 <- from $ table @WalletOrchNote
where_ (n2 ^. WalletOrchNoteAccId ==. val za)
where_ (n2 ^. WalletOrchNoteSpent ==. val False)
pure n2
(txs :& oNotes) <-
from $ table @WalletTransaction `innerJoin` table @WalletOrchNote `on`
(\(txs :& oNotes) ->
txs ^. WalletTransactionId ==. oNotes ^. WalletOrchNoteTx)
where_ (oNotes ^. WalletOrchNoteAccId ==. val za)
where_ (oNotes ^. WalletOrchNoteSpent ==. val False)
where_
((oNotes ^. WalletOrchNoteChange ==. val True &&. txs ^.
WalletTransactionConf >=.
val 3) ||.
(oNotes ^. WalletOrchNoteChange ==. val False &&. txs ^.
WalletTransactionConf >=.
val 10))
pure oNotes
getWalletUnspentUnconfirmedOrchNotes ::
ConnectionPool -> ZcashAccountId -> IO [Entity WalletOrchNote]
getWalletUnspentUnconfirmedOrchNotes pool za = do
runNoLoggingT $
PS.retryOnBusy $
flip PS.runSqlPool pool $ do
select $ do
(txs :& oNotes) <-
from $ table @WalletTransaction `innerJoin` table @WalletOrchNote `on`
(\(txs :& oNotes) ->
txs ^. WalletTransactionId ==. oNotes ^. WalletOrchNoteTx)
where_ (oNotes ^. WalletOrchNoteAccId ==. val za)
where_ (oNotes ^. WalletOrchNoteSpent ==. val False)
where_
((oNotes ^. WalletOrchNoteChange ==. val True &&. txs ^.
WalletTransactionConf <.
val 3) ||.
(oNotes ^. WalletOrchNoteChange ==. val False &&. txs ^.
WalletTransactionConf <.
val 10))
pure oNotes
selectUnspentNotes ::
ConnectionPool
@ -1523,6 +1646,27 @@ getWalletTxId pool wId = do
where_ (wtx ^. WalletTransactionId ==. val wId)
pure $ wtx ^. WalletTransactionTxId
getUnconfirmedBlocks :: ConnectionPool -> IO [Int]
getUnconfirmedBlocks pool = do
r <-
runNoLoggingT $
PS.retryOnBusy $
flip PS.runSqlPool pool $ do
select $ do
wtx <- from $ table @WalletTransaction
where_ (wtx ^. WalletTransactionConf <=. val 10)
pure $ wtx ^. WalletTransactionBlock
return $ map (\(Value i) -> i) r
saveConfs :: ConnectionPool -> Int -> Int -> IO ()
saveConfs pool b c = do
runNoLoggingT $
PS.retryOnBusy $
flip PS.runSqlPool pool $ do
update $ \t -> do
set t [WalletTransactionConf =. val c]
where_ $ t ^. WalletTransactionBlock ==. val b
-- | Helper function to extract a Unified Address from the database
readUnifiedAddressDB :: WalletAddress -> Maybe UnifiedAddress
readUnifiedAddressDB =
@ -1568,7 +1712,6 @@ updateAdrsInAdrBook pool d a ia = do
-- adrbook <- from $ table @AddressBook
-- where_ ((adrbook ^. AddressBookAbaddress) ==. val a)
-- return adrbook
-- | delete an existing address from AddressBook
deleteAdrsFromAB :: ConnectionPool -> T.Text -> IO ()
deleteAdrsFromAB pool ia = do
@ -1577,7 +1720,7 @@ deleteAdrsFromAB pool ia = do
flip PS.runSqlPool pool $ do
delete $ do
ab <- from $ table @AddressBook
where_ (ab ^. AddressBookAbaddress ==. val ia)
where_ (ab ^. AddressBookAbaddress ==. val ia)
rmdups :: Ord a => [a] -> [a]
rmdups = map head . group . sort

View file

@ -7,8 +7,11 @@ import Codec.Picture
import Codec.Picture.Types (pixelFold, promoteImage)
import Codec.QRCode
import Codec.QRCode.JuicyPixels
import Control.Concurrent (threadDelay)
import Control.Exception (throwIO, try)
import Control.Monad.Logger (runNoLoggingT)
import Control.Monad.IO.Class (liftIO)
import Control.Monad.Logger (runFileLoggingT, runNoLoggingT)
import Data.Aeson
import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as LBS
import Data.HexString (toText)
@ -23,13 +26,15 @@ import Lens.Micro.TH
import Monomer
import qualified Monomer.Lens as L
import System.Hclip
import Text.Printf
import Text.Wrap (FillScope(..), FillStrategy(..), WrapSettings(..), wrapText)
import TextShow hiding (toText)
import ZcashHaskell.Keys (generateWalletSeedPhrase)
import ZcashHaskell.Orchard (getSaplingFromUA, isValidUnifiedAddress)
import ZcashHaskell.Transparent (encodeTransparentReceiver)
import ZcashHaskell.Types
( Phrase(..)
( BlockResponse(..)
, Phrase(..)
, Scope(..)
, ToBytes(..)
, UnifiedAddress(..)
@ -37,11 +42,20 @@ import ZcashHaskell.Types
, ZebraGetBlockChainInfo(..)
, ZebraGetInfo(..)
)
import ZcashHaskell.Utils (getBlockTime, makeZebraCall)
import Zenith.Core
import Zenith.DB
import Zenith.GUI.Theme
import Zenith.Scanner (processTx, updateConfs)
import Zenith.Types hiding (ZcashAddress(..))
import Zenith.Utils (displayAmount, showAddress)
import Zenith.Utils
( displayAmount
, isRecipientValid
, jsonNumber
, parseAddress
, showAddress
, validBarValue
)
data AppEvent
= AppInit
@ -61,6 +75,7 @@ data AppEvent
| SwitchAddr !Int
| SwitchAcc !Int
| SwitchWal !Int
| UpdateBalance !(Integer, Integer)
| CopyAddr !(Maybe (Entity WalletAddress))
| LoadTxs ![Entity UserTx]
| LoadAddrs ![Entity WalletAddress]
@ -71,11 +86,20 @@ data AppEvent
| SaveAccount !(Maybe (Entity ZcashWallet))
| SaveWallet
| CloseSeed
| CloseTxId
| ShowSeed
| CopySeed !T.Text
| CopyTx !T.Text
| CloseTx
| ShowTx !Int
| TickUp
| SyncVal !Float
| SendTx
| ShowSend
| CancelSend
| CheckRecipient !T.Text
| CheckAmount !Float
| ShowTxId !T.Text
deriving (Eq, Show)
data AppModel = AppModel
@ -108,6 +132,15 @@ data AppModel = AppModel
, _showSeed :: !Bool
, _modalMsg :: !(Maybe T.Text)
, _showTx :: !(Maybe Int)
, _timer :: !Int
, _barValue :: !Float
, _openSend :: !Bool
, _sendRecipient :: !T.Text
, _sendAmount :: !Float
, _sendMemo :: !T.Text
, _recipientValid :: !Bool
, _amountValid :: !Bool
, _showId :: !(Maybe T.Text)
} deriving (Eq, Show)
makeLenses ''AppModel
@ -145,6 +178,8 @@ buildUI wenv model = widgetTree
, confirmOverlay `nodeVisible` isJust (model ^. confirmTitle)
, seedOverlay `nodeVisible` model ^. showSeed
, txOverlay `nodeVisible` isJust (model ^. showTx)
, sendTxOverlay `nodeVisible` model ^. openSend
, txIdOverlay `nodeVisible` isJust (model ^. showId)
, msgOverlay `nodeVisible` isJust (model ^. msg)
, modalOverlay `nodeVisible` isJust (model ^. modalMsg)
]
@ -275,7 +310,12 @@ buildUI wenv model = widgetTree
mainPane =
box_ [alignMiddle] $
hstack
[addressBox, txBox `nodeVisible` not (null $ model ^. transactions)]
[ addressBox
, vstack
[ mainButton "Send" ShowSend `styleBasic` [textFont "Bold"]
, txBox `nodeVisible` not (null $ model ^. transactions)
]
]
balanceBox =
hstack
[ filler
@ -283,19 +323,24 @@ buildUI wenv model = widgetTree
box_
[alignMiddle]
(vstack
[ animFadeIn
(label (displayAmount (model ^. network) $ model ^. balance) `styleBasic`
[textSize 20])
[ hstack
[ filler
, animFadeIn
(label
(displayAmount (model ^. network) $ model ^. balance) `styleBasic`
[textSize 20])
, filler
]
, hstack
[ filler
, remixIcon remixHourglassFill `styleBasic` [textSize 8]
, label
(maybe "0" (displayAmount (model ^. network)) $
model ^. unconfBalance) `styleBasic`
[textSize 8] `nodeVisible`
isJust (model ^. unconfBalance)
[textSize 8]
, filler
]
] `nodeVisible`
isJust (model ^. unconfBalance)
]) `styleBasic`
[bgColor white, radius 5, border 1 btnColor]
, filler
@ -456,6 +501,8 @@ buildUI wenv model = widgetTree
("Last block sync: " <>
maybe "N/A" (showt . zcashWalletLastSync . entityVal) currentWallet) `styleBasic`
[padding 3, textSize 8]
, spacer
, label (showt $ model ^. timer) `styleBasic` [padding 3, textSize 8]
, filler
, image_ "./assets/1F993.png" [fitHeight] `styleBasic`
[height 24, width 24] `nodeVisible`
@ -489,6 +536,73 @@ buildUI wenv model = widgetTree
, cancelCaption $ model ^. confirmCancel
]
(hstack [label "Name:", filler, textField_ mainInput [maxLength 25]])
sendTxOverlay =
box
(vstack
[ filler
, hstack
[ filler
, box_
[]
(vstack
[ box_
[alignMiddle]
(label "Send Zcash" `styleBasic`
[textFont "Bold", textSize 12])
, separatorLine `styleBasic` [fgColor btnColor]
, spacer
, hstack
[ label "To:" `styleBasic` [width 50]
, spacer
, textField_ sendRecipient [onChange CheckRecipient] `styleBasic`
[ width 150
, styleIf
(not $ model ^. recipientValid)
(textColor red)
]
]
, hstack
[ label "Amount:" `styleBasic` [width 50]
, spacer
, numericField_
sendAmount
[ decimals 8
, minValue 0.0
, maxValue
(fromIntegral (model ^. balance) / 100000000.0)
, validInput amountValid
, onChange CheckAmount
] `styleBasic`
[ width 150
, styleIf
(not $ model ^. amountValid)
(textColor red)
]
]
, hstack
[ label "Memo:" `styleBasic` [width 50]
, spacer
, textArea sendMemo `styleBasic`
[width 150, height 40]
]
, spacer
, box_
[alignMiddle]
(hstack
[ spacer
, button "Cancel" CancelSend
, spacer
, mainButton "Send" SendTx `nodeEnabled`
(model ^. amountValid && model ^. recipientValid)
, spacer
])
]) `styleBasic`
[radius 4, border 2 btnColor, bgColor white, padding 4]
, filler
]
, filler
]) `styleBasic`
[bgColor (white & L.a .~ 0.5)]
seedOverlay =
alert CloseSeed $
vstack
@ -602,6 +716,31 @@ buildUI wenv model = widgetTree
]) `styleBasic`
[padding 2, bgColor white, width 280, borderB 1 gray]
]
txIdOverlay =
case model ^. showId of
Nothing -> alert CloseTxId $ label "N/A"
Just t ->
alert CloseTxId $
box_
[alignLeft]
(vstack
[ box_ [alignMiddle] $
label "Transaction Sent!" `styleBasic` [textFont "Bold"]
, spacer
, hstack
[ label "Tx ID " `styleBasic` [width 60, textFont "Bold"]
, separatorLine `styleBasic` [fgColor btnColor]
, spacer
, label_ (txtWrap t) [multiline]
, spacer
, box_
[onClick $ CopyTx t]
(remixIcon remixFileCopyFill `styleBasic`
[textColor white]) `styleBasic`
[cursorHand, bgColor btnColor, radius 2, padding 2]
]
]) `styleBasic`
[padding 2, bgColor white, width 280, borderB 1 gray, borderT 1 gray]
generateQRCodes :: Config -> IO ()
generateQRCodes config = do
@ -679,10 +818,14 @@ handleEvent ::
-> [AppEventResponse AppModel AppEvent]
handleEvent wenv node model evt =
case evt of
AppInit -> [Event NewWallet | isNothing currentWallet]
AppInit ->
[Event NewWallet | isNothing currentWallet] <> [Producer timeTicker]
ShowMsg t -> [Model $ model & msg ?~ t & menuPopup .~ False]
ShowError t ->
[Model $ model & msg ?~ t & menuPopup .~ False & inError .~ True]
[ Model $
model & msg ?~ t & menuPopup .~ False & inError .~ True & modalMsg .~
Nothing
]
ShowModal t -> [Model $ model & modalMsg ?~ t]
WalletClicked -> [Model $ model & walPopup .~ True]
AccountClicked -> [Model $ model & accPopup .~ True]
@ -720,6 +863,32 @@ handleEvent wenv node model evt =
]
ConfirmCancel -> [Model $ model & confirmTitle .~ Nothing & mainInput .~ ""]
ShowSeed -> [Model $ model & showSeed .~ True & menuPopup .~ False]
ShowSend -> [Model $ model & openSend .~ True]
SendTx ->
case currentAccount of
Nothing -> [Event $ ShowError "No account available", Event CancelSend]
Just acc ->
case currentWallet of
Nothing ->
[Event $ ShowError "No wallet available", Event CancelSend]
Just wal ->
[ Producer $
sendTransaction
(model ^. configuration)
(model ^. network)
(entityKey acc)
(zcashWalletLastSync $ entityVal wal)
(model ^. sendAmount)
(model ^. sendRecipient)
(model ^. sendMemo)
, Event CancelSend
]
CancelSend ->
[ Model $
model & openSend .~ False & sendRecipient .~ "" & sendAmount .~ 0.0 &
sendMemo .~
""
]
SaveAddress acc ->
if T.length (model ^. mainInput) > 1
then [ Task $ addNewAddress (model ^. mainInput) External acc
@ -762,6 +931,15 @@ handleEvent wenv node model evt =
case selectAccount i of
Nothing -> return []
Just acc -> runNoLoggingT $ getAddresses dbPool $ entityKey acc
, Task $
UpdateBalance <$> do
dbPool <- runNoLoggingT $ initPool $ c_dbPath $ model ^. configuration
case selectAccount i of
Nothing -> return (0, 0)
Just acc -> do
b <- getBalance dbPool $ entityKey acc
u <- getUnconfirmedBalance dbPool $ entityKey acc
return (b, u)
, Event $ SetPool Orchard
]
SwitchWal i ->
@ -773,6 +951,13 @@ handleEvent wenv node model evt =
Nothing -> return []
Just wal -> runNoLoggingT $ getAccounts dbPool $ entityKey wal
]
UpdateBalance (b, u) ->
[ Model $
model & balance .~ b & unconfBalance .~
(if u == 0
then Nothing
else Just u)
]
CopyAddr a ->
[ setClipboardData ClipboardEmpty
, setClipboardData $
@ -817,12 +1002,55 @@ handleEvent wenv node model evt =
else [Event $ NewAccount currentWallet]
LoadWallets a ->
if not (null a)
then [Model $ model & wallets .~ a, Event $ SwitchWal 0]
then [ Model $ model & wallets .~ a
, Event $ SwitchWal $ model ^. selWallet
]
else [Event NewWallet]
CloseMsg -> [Model $ model & msg .~ Nothing & inError .~ False]
CloseSeed -> [Model $ model & showSeed .~ False]
CloseTx -> [Model $ model & showTx .~ Nothing]
CloseTxId -> [Model $ model & showId .~ Nothing]
ShowTx i -> [Model $ model & showTx ?~ i]
TickUp ->
if (model ^. timer) < 90
then [Model $ model & timer .~ (1 + model ^. timer)]
else if (model ^. barValue) == 1.0
then [ Model $ model & timer .~ 0 & barValue .~ 0.0
, Producer $
scanZebra
(c_dbPath $ model ^. configuration)
(c_zebraHost $ model ^. configuration)
(c_zebraPort $ model ^. configuration)
]
else [Model $ model & timer .~ 0]
SyncVal i ->
if (i + model ^. barValue) >= 0.999
then [ Model $ model & barValue .~ 1.0 & modalMsg .~ Nothing
, Task $ do
case currentWallet of
Nothing -> return $ ShowError "No wallet available"
Just cW -> do
syncWallet (model ^. configuration) cW
return $ SwitchAddr (model ^. selAddr)
, Task $ do
pool <-
runNoLoggingT $ initPool $ c_dbPath $ model ^. configuration
wL <- getWallets pool (model ^. network)
return $ LoadWallets wL
]
else [ Model $
model & barValue .~ validBarValue (i + model ^. barValue) &
modalMsg ?~
("Wallet Sync: " <>
T.pack (printf "%.2f%%" (model ^. barValue * 100)))
]
CheckRecipient a -> [Model $ model & recipientValid .~ isRecipientValid a]
CheckAmount i ->
[ Model $
model & amountValid .~
(i < (fromIntegral (model ^. balance) / 100000000.0))
]
ShowTxId tx -> [Model $ model & showId ?~ tx & modalMsg .~ Nothing]
where
currentWallet =
if null (model ^. wallets)
@ -911,6 +1139,104 @@ handleEvent wenv node model evt =
wL <- getWallets pool (model ^. network)
return $ LoadWallets wL
scanZebra :: T.Text -> T.Text -> Int -> (AppEvent -> IO ()) -> IO ()
scanZebra dbPath zHost zPort sendMsg = do
_ <- liftIO $ initDb dbPath
bStatus <- liftIO $ checkBlockChain zHost zPort
pool <- runNoLoggingT $ initPool dbPath
b <- liftIO $ getMinBirthdayHeight pool
dbBlock <- runNoLoggingT $ getMaxBlock pool
let sb = max dbBlock b
confUp <- try $ updateConfs zHost zPort pool :: IO (Either IOError ())
case confUp of
Left _e0 -> sendMsg (ShowError "Failed to update unconfirmed transactions")
Right _ -> do
if sb > zgb_blocks bStatus || sb < 1
then sendMsg (ShowError "Invalid starting block for scan")
else do
let bList = [(sb + 1) .. (zgb_blocks bStatus)]
if not (null bList)
then do
let step = (1.0 :: Float) / fromIntegral (length bList)
mapM_ (processBlock pool step) bList
else sendMsg (SyncVal 1.0)
where
processBlock :: ConnectionPool -> Float -> Int -> IO ()
processBlock pool step bl = do
r <-
liftIO $
makeZebraCall
zHost
zPort
"getblock"
[Data.Aeson.String $ showt bl, jsonNumber 1]
case r of
Left e1 -> sendMsg (ShowError $ showt e1)
Right blk -> do
r2 <-
liftIO $
makeZebraCall
zHost
zPort
"getblock"
[Data.Aeson.String $ showt bl, jsonNumber 0]
case r2 of
Left e2 -> sendMsg (ShowError $ showt e2)
Right hb -> do
let blockTime = getBlockTime hb
mapM_ (runNoLoggingT . processTx zHost zPort blockTime pool) $
bl_txs $ addTime blk blockTime
sendMsg (SyncVal step)
addTime :: BlockResponse -> Int -> BlockResponse
addTime bl t =
BlockResponse
(bl_confirmations bl)
(bl_height bl)
(fromIntegral t)
(bl_txs bl)
sendTransaction ::
Config
-> ZcashNet
-> ZcashAccountId
-> Int
-> Float
-> T.Text
-> T.Text
-> (AppEvent -> IO ())
-> IO ()
sendTransaction config znet accId bl amt ua memo sendMsg = do
sendMsg $ ShowModal "Preparing transaction..."
case parseAddress ua znet of
Nothing -> sendMsg $ ShowError "Incorrect address"
Just outUA -> do
let dbPath = c_dbPath config
let zHost = c_zebraHost config
let zPort = c_zebraPort config
pool <- runNoLoggingT $ initPool dbPath
res <-
runFileLoggingT "zenith.log" $
prepareTx pool zHost zPort znet accId bl amt outUA memo
case res of
Left e -> sendMsg $ ShowError $ T.pack $ show e
Right rawTx -> do
sendMsg $ ShowModal "Transaction ready, sending to Zebra..."
resp <-
makeZebraCall
zHost
zPort
"sendrawtransaction"
[Data.Aeson.String $ toText rawTx]
case resp of
Left e1 -> sendMsg $ ShowError $ "Zebra error: " <> showt e1
Right txId -> sendMsg $ ShowTxId txId
timeTicker :: (AppEvent -> IO ()) -> IO ()
timeTicker sendMsg = do
sendMsg TickUp
threadDelay $ 1000 * 1000
timeTicker sendMsg
txtWrap :: T.Text -> T.Text
txtWrap = wrapText (WrapSettings False True NoFill FillAfterFirst) 32
@ -948,6 +1274,14 @@ runZenithGUI config = do
if not (null addrList)
then getQrCode pool Orchard $ entityKey $ head addrList
else return Nothing
bal <-
if not (null accList)
then getBalance pool $ entityKey $ head accList
else return 0
unconfBal <-
if not (null accList)
then getUnconfirmedBalance pool $ entityKey $ head accList
else return 0
let model =
AppModel
config
@ -962,8 +1296,10 @@ runZenithGUI config = do
0
Nothing
True
314259000
(Just 300000)
bal
(if unconfBal == 0
then Nothing
else Just unconfBal)
Orchard
qr
False
@ -982,6 +1318,15 @@ runZenithGUI config = do
False
Nothing
Nothing
0
1.0
False
""
0.0
""
False
False
Nothing
startApp model handleEvent buildUI params
Left e -> do
initDb dbFilePath
@ -1018,6 +1363,15 @@ runZenithGUI config = do
False
Nothing
Nothing
0
1.0
False
""
0.0
""
False
False
Nothing
startApp model handleEvent buildUI params
where
params =

View file

@ -64,6 +64,12 @@ zenithTheme =
L.active .
L.btnMainStyle . L.text ?~
hiliteTextStyle &
L.disabled .
L.btnMainStyle . L.text ?~
hiliteTextStyle &
L.disabled .
L.btnMainStyle . L.bgColor ?~
gray07c &
L.basic .
L.textFieldStyle . L.text ?~
baseTextStyle &
@ -78,6 +84,36 @@ zenithTheme =
baseTextStyle &
L.focusHover .
L.textFieldStyle . L.text ?~
baseTextStyle &
L.basic .
L.numericFieldStyle . L.text ?~
baseTextStyle &
L.hover .
L.numericFieldStyle . L.text ?~
baseTextStyle &
L.focus .
L.numericFieldStyle . L.text ?~
baseTextStyle &
L.active .
L.numericFieldStyle . L.text ?~
baseTextStyle &
L.focusHover .
L.numericFieldStyle . L.text ?~
baseTextStyle &
L.basic .
L.textAreaStyle . L.text ?~
baseTextStyle &
L.hover .
L.textAreaStyle . L.text ?~
baseTextStyle &
L.focus .
L.textAreaStyle . L.text ?~
baseTextStyle &
L.active .
L.textAreaStyle . L.text ?~
baseTextStyle &
L.focusHover .
L.textAreaStyle . L.text ?~
baseTextStyle
zenithThemeColors :: BaseThemeColors

View file

@ -33,7 +33,13 @@ import ZcashHaskell.Types
)
import ZcashHaskell.Utils (getBlockTime, makeZebraCall, readZebraTransaction)
import Zenith.Core (checkBlockChain)
import Zenith.DB (getMaxBlock, initDb, saveTransaction)
import Zenith.DB
( getMaxBlock
, getUnconfirmedBlocks
, initDb
, saveConfs
, saveTransaction
)
import Zenith.Utils (jsonNumber)
-- | Function to scan the Zcash blockchain through the Zebra node and populate the Zenith database
@ -155,3 +161,26 @@ processTx host port bt pool t = do
(fromRawSBundle $ zt_sBundle rzt)
(fromRawOBundle $ zt_oBundle rzt)
return ()
-- | Function to update unconfirmed transactions
updateConfs ::
T.Text -- ^ Host name for `zebrad`
-> Int -- ^ Port for `zebrad`
-> ConnectionPool
-> IO ()
updateConfs host port pool = do
targetBlocks <- getUnconfirmedBlocks pool
mapM_ updateTx targetBlocks
where
updateTx :: Int -> IO ()
updateTx b = do
r <-
makeZebraCall
host
port
"getblock"
[Data.Aeson.String $ T.pack $ show b, jsonNumber 1]
case r of
Left e -> throwIO $ userError e
Right blk -> do
saveConfs pool b $ fromInteger $ bl_confirmations blk

View file

@ -5,6 +5,7 @@ module Zenith.Utils where
import Data.Aeson
import Data.Functor (void)
import Data.Maybe
import Data.Ord (clamp)
import Data.Scientific (Scientific(..), scientific)
import qualified Data.Text as T
import qualified Data.Text.Encoding as E
@ -12,8 +13,17 @@ import System.Process (createProcess_, shell)
import System.Directory
import Text.Regex.Posix
import ZcashHaskell.Orchard (encodeUnifiedAddress, isValidUnifiedAddress)
import ZcashHaskell.Sapling (isValidShieldedAddress)
import ZcashHaskell.Types (ZcashNet(..))
import ZcashHaskell.Sapling (decodeSaplingAddress, isValidShieldedAddress)
import ZcashHaskell.Transparent
( decodeExchangeAddress
, decodeTransparentAddress
)
import ZcashHaskell.Types
( SaplingAddress(..)
, TransparentAddress(..)
, UnifiedAddress(..)
, ZcashNet(..)
)
import Zenith.Types
( AddressGroup(..)
, UnifiedAddressDB(..)
@ -87,3 +97,34 @@ getZenithPath = do
d <- getHomeDirectory
let homeDirectory = d
return (homeDirectory ++ "/Zenith/")
-- | Bound a value to the 0..1 range, used for progress reporting on UIs
validBarValue :: Float -> Float
validBarValue = clamp (0, 1)
isRecipientValid :: T.Text -> Bool
isRecipientValid a =
case isValidUnifiedAddress (E.encodeUtf8 a) of
Just _a1 -> True
Nothing ->
isValidShieldedAddress (E.encodeUtf8 a) ||
(case decodeTransparentAddress (E.encodeUtf8 a) of
Just _a3 -> True
Nothing ->
case decodeExchangeAddress a of
Just _a4 -> True
Nothing -> False)
parseAddress :: T.Text -> ZcashNet -> Maybe UnifiedAddress
parseAddress a znet =
case isValidUnifiedAddress (E.encodeUtf8 a) of
Just a1 -> Just a1
Nothing ->
case decodeSaplingAddress (E.encodeUtf8 a) of
Just a2 ->
Just $ UnifiedAddress znet Nothing (Just $ sa_receiver a2) Nothing
Nothing ->
case decodeTransparentAddress (E.encodeUtf8 a) of
Just a3 ->
Just $ UnifiedAddress znet Nothing Nothing (Just $ ta_receiver a3)
Nothing -> Nothing

View file

@ -1,6 +1,6 @@
cabal-version: 3.0
name: zenith
version: 0.5.3.0-beta
version: 0.6.0.0-beta
license: MIT
license-file: LICENSE
author: Rene Vergara
@ -53,7 +53,7 @@ library
, exceptions
, monad-logger
, vty-crossplatform
, secp256k1-haskell
, secp256k1-haskell >= 1
, pureMD5
, ghc >=9.4.8
, haskoin-core
@ -101,7 +101,7 @@ executable zenith
, configurator
, data-default
, sort
, structured-cli
--, structured-cli
, text
, time
, zenith