zenith-install - Merge branch 'milestone2' into zenith-install
This commit is contained in:
commit
d1fd231fe2
11 changed files with 1058 additions and 338 deletions
33
CHANGELOG.md
33
CHANGELOG.md
|
|
@ -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
|
||||
|
|
|
|||
19
app/Main.hs
19
app/Main.hs
|
|
@ -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)"
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
187
src/Zenith/DB.hs
187
src/Zenith/DB.hs
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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 =
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
Loading…
Reference in a new issue