diff --git a/CHANGELOG.md b/CHANGELOG.md index 20fa1a2..aa0b028 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -5,53 +5,8 @@ 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). -## [0.6.0.0-beta] - -### Added - -- GUI module -- Address list -- Transaction list -- Balance display -- Account selector -- Menu for new addresses, accounts, wallets -- Dialog to display and copy seed phrase -- Dialog to add new address -- 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 -- Implemented config and data folder -- Improved the `configure` script for installation - -### 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 @@ -62,6 +17,11 @@ 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 diff --git a/app/Main.hs b/app/Main.hs index 0b6a6f0..269ec1b 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -11,8 +11,7 @@ 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 @@ -20,11 +19,10 @@ import Text.Read (readMaybe) import ZcashHaskell.Types import Zenith.CLI import Zenith.Core (clearSync, testSync) -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 @@ -198,22 +196,21 @@ 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"] + config <- load ["zenith.cfg"] args <- getArgs dbFilePath <- require config "dbFilePath" - {-nodeUser <- require config "nodeUser"-} - {-nodePwd <- require config "nodePwd"-} + nodeUser <- require config "nodeUser" + nodePwd <- require config "nodePwd" zebraPort <- require config "zebraPort" zebraHost <- require config "zebraHost" let myConfig = Config dbFilePath zebraHost zebraPort if not (null args) then do - case head args - {-"legacy" -> do + case head args of + "legacy" -> do checkServer nodeUser nodePwd void $ runCLI @@ -222,9 +219,7 @@ main = do { getBanner = " ______ _ _ _ \n |___ / (_) | | | \n / / ___ _ __ _| |_| |__ \n / / / _ \\ '_ \\| | __| '_ \\ \n / /_| __/ | | | | |_| | | |\n /_____\\___|_| |_|_|\\__|_| |_|\n Zcash Full Node CLI v0.4.0" } - (root nodeUser nodePwd) -} - of - "gui" -> runZenithGUI myConfig + (root nodeUser nodePwd) "tui" -> runZenithTUI myConfig "rescan" -> clearSync myConfig _ -> printUsage @@ -234,6 +229,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)" diff --git a/assets/1F616_color.png b/assets/1F616_color.png deleted file mode 100644 index ac48165..0000000 Binary files a/assets/1F616_color.png and /dev/null differ diff --git a/assets/1F928_color.png b/assets/1F928_color.png deleted file mode 100644 index 10095c0..0000000 Binary files a/assets/1F928_color.png and /dev/null differ diff --git a/assets/1F993.png b/assets/1F993.png deleted file mode 100644 index 290f365..0000000 Binary files a/assets/1F993.png and /dev/null differ diff --git a/assets/2620_color.png b/assets/2620_color.png deleted file mode 100644 index ecfdc10..0000000 Binary files a/assets/2620_color.png and /dev/null differ diff --git a/assets/Atkinson-Hyperlegible-Bold-102.ttf b/assets/Atkinson-Hyperlegible-Bold-102.ttf deleted file mode 100644 index 14b7196..0000000 Binary files a/assets/Atkinson-Hyperlegible-Bold-102.ttf and /dev/null differ diff --git a/assets/Atkinson-Hyperlegible-BoldItalic-102.ttf b/assets/Atkinson-Hyperlegible-BoldItalic-102.ttf deleted file mode 100644 index 4532705..0000000 Binary files a/assets/Atkinson-Hyperlegible-BoldItalic-102.ttf and /dev/null differ diff --git a/assets/Atkinson-Hyperlegible-Font-License-2020-1104.pdf b/assets/Atkinson-Hyperlegible-Font-License-2020-1104.pdf deleted file mode 100644 index afe27dc..0000000 Binary files a/assets/Atkinson-Hyperlegible-Font-License-2020-1104.pdf and /dev/null differ diff --git a/assets/Atkinson-Hyperlegible-Italic-102.ttf b/assets/Atkinson-Hyperlegible-Italic-102.ttf deleted file mode 100644 index 89e5ce4..0000000 Binary files a/assets/Atkinson-Hyperlegible-Italic-102.ttf and /dev/null differ diff --git a/assets/Atkinson-Hyperlegible-Regular-102.ttf b/assets/Atkinson-Hyperlegible-Regular-102.ttf deleted file mode 100644 index c4fa6fb..0000000 Binary files a/assets/Atkinson-Hyperlegible-Regular-102.ttf and /dev/null differ diff --git a/assets/DejaVuSansMono-Bold.ttf b/assets/DejaVuSansMono-Bold.ttf deleted file mode 100644 index b210eb5..0000000 Binary files a/assets/DejaVuSansMono-Bold.ttf and /dev/null differ diff --git a/assets/DejaVuSansMono-BoldOblique.ttf b/assets/DejaVuSansMono-BoldOblique.ttf deleted file mode 100644 index 3211064..0000000 Binary files a/assets/DejaVuSansMono-BoldOblique.ttf and /dev/null differ diff --git a/assets/DejaVuSansMono-Oblique.ttf b/assets/DejaVuSansMono-Oblique.ttf deleted file mode 100644 index ff83b15..0000000 Binary files a/assets/DejaVuSansMono-Oblique.ttf and /dev/null differ diff --git a/assets/DejaVuSansMono.ttf b/assets/DejaVuSansMono.ttf deleted file mode 100644 index 041cffc..0000000 Binary files a/assets/DejaVuSansMono.ttf and /dev/null differ diff --git a/assets/OpenMoji-color-glyf_colr_1.ttf b/assets/OpenMoji-color-glyf_colr_1.ttf deleted file mode 100644 index 86cf85b..0000000 Binary files a/assets/OpenMoji-color-glyf_colr_1.ttf and /dev/null differ diff --git a/assets/Roboto-Regular.ttf b/assets/Roboto-Regular.ttf deleted file mode 100644 index 8c082c8..0000000 Binary files a/assets/Roboto-Regular.ttf and /dev/null differ diff --git a/assets/remixicon.ttf b/assets/remixicon.ttf deleted file mode 100644 index 22ce6de..0000000 Binary files a/assets/remixicon.ttf and /dev/null differ diff --git a/cabal.project b/cabal.project index d245ac1..217198a 100644 --- a/cabal.project +++ b/cabal.project @@ -2,7 +2,7 @@ packages: ./*.cabal zcash-haskell/zcash-haskell.cabal -with-compiler: ghc-9.6.5 +with-compiler: ghc-9.4.8 source-repository-package type: git diff --git a/cabal.project.freeze b/cabal.project.freeze index 175cc2c..3b9c8d2 100644 --- a/cabal.project.freeze +++ b/cabal.project.freeze @@ -1,49 +1,38 @@ active-repositories: hackage.haskell.org:merge -constraints: any.Cabal ==3.10.3.0, - any.Cabal-syntax ==3.10.3.0, +constraints: any.Cabal ==3.8.1.0, + any.Cabal-syntax ==3.8.1.0, any.Clipboard ==2.3.2.0, any.HUnit ==1.6.2.0, any.Hclip ==3.0.0.4, - any.JuicyPixels ==3.3.9, - JuicyPixels -mmap, - any.OneTuple ==0.4.2, - any.OpenGLRaw ==3.3.4.1, - OpenGLRaw -osandroid +usegles2 +useglxgetprocaddress +usenativewindowslibraries, + any.OneTuple ==0.4.1.1, any.QuickCheck ==2.14.3, QuickCheck -old-random +templatehaskell, - any.RSA ==2.4.1, - any.SHA ==1.6.4.4, - SHA -exe, any.StateVar ==1.2.2, any.X11 ==1.10.3, X11 -pedantic, - any.adjunctions ==4.4.2, - any.aeson ==2.2.3.0, + any.aeson ==2.2.1.0, aeson +ordered-keymap, any.alex ==3.5.1.0, - any.ansi-terminal ==1.1.1, + any.ansi-terminal ==1.1, ansi-terminal -example, any.ansi-terminal-types ==1.1, any.appar ==0.1.8, - any.array ==0.5.6.0, + any.array ==0.5.4.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.1, - assoc -tagged, + any.assoc ==1.1, + assoc +tagged, any.async ==2.2.5, async -bench, any.attoparsec ==0.14.4, attoparsec -developer, - any.attoparsec-aeson ==2.2.2.0, - any.authenticate-oauth ==1.7, - 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.attoparsec-aeson ==2.2.0.1, + any.auto-update ==0.1.6, + any.base ==4.17.2.1, + any.base-orphans ==0.9.1, any.base16 ==1.0, any.base16-bytestring ==1.0.2.0, any.base58-bytestring ==0.1.0, @@ -53,37 +42,30 @@ constraints: any.Cabal ==3.10.3.0, bifunctors +tagged, any.bimap ==0.5.0, any.binary ==0.8.9.1, - any.binary-orphans ==1.0.5, + any.binary-orphans ==1.0.4.1, 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.4, + any.brick ==2.3.1, brick -demos, any.byteorder ==1.0.4, any.bytes ==0.17.3, any.bytestring ==0.11.5.3, - any.bytestring-builder ==0.10.8.2.0, - bytestring-builder +bytestring_has_builder, - any.bytestring-to-vector ==0.3.0.1, any.c2hs ==0.28.8, c2hs +base3 -regression, - 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.21, + any.concurrent-output ==1.10.20, any.conduit ==1.3.5, any.conduit-extra ==1.3.6, any.config-ini ==0.2.7.0, @@ -93,14 +75,13 @@ constraints: any.Cabal ==3.10.3.0, any.containers ==0.6.7, any.contravariant ==1.5.5, contravariant +semigroups +statevar +tagged, - any.cookie ==0.5.0, + any.cookie ==0.4.6, any.crypto-api ==0.13.3, crypto-api -all_cpolys, - any.crypto-pubkey-types ==0.4.3, - any.crypton ==1.0.0, + any.crypton ==0.34, 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.4.1, - any.crypton-x509 ==1.7.7, + any.crypton-connection ==0.3.2, + any.crypton-x509 ==1.7.6, any.crypton-x509-store ==1.6.9, any.crypton-x509-system ==1.6.7, any.crypton-x509-validation ==1.6.12, @@ -112,57 +93,50 @@ constraints: any.Cabal ==3.10.3.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.4, - any.deepseq ==1.4.8.1, - any.directory ==1.3.8.4, + any.data-fix ==0.3.2, + any.deepseq ==1.4.8.0, + any.directory ==1.3.7.1, any.distributive ==0.6.2.1, distributive +semigroups +tagged, any.dlist ==1.0, dlist -werror, - any.double-conversion ==2.0.5.0, - double-conversion -developer +embedded_double_conversion, any.easy-file ==0.2.5, any.entropy ==0.4.1.10, entropy -donotgetentropy, any.envy ==2.1.3.0, any.esqueleto ==3.5.11.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.exceptions ==0.10.5, + any.fast-logger ==3.2.2, + any.filepath ==1.4.2.2, + 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, - formatting -no-double-conversion, - any.free ==5.2, - any.generic-deriving ==1.14.5, - generic-deriving +base-4-9, any.generically ==0.1.1, any.generics-sop ==0.5.1.4, - any.ghc ==9.6.5, + any.ghc ==9.4.8, any.ghc-bignum ==1.3, - 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.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.half ==0.3.1, any.happy ==1.20.1.1, - any.hashable ==1.4.7.0, - hashable -arch-native +integer-gmp -random-initial-seed, + any.hashable ==1.4.4.0, + hashable +integer-gmp -random-initial-seed, + any.haskeline ==0.8.2, 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.2.0, + any.hpc ==0.6.1.0, any.hsc2hs ==0.68.10, hsc2hs -in-ghc-tree, - any.hspec ==2.11.9, - any.hspec-core ==2.11.9, - any.hspec-discover ==2.11.9, + any.hspec ==2.11.7, + any.hspec-core ==2.11.7, + any.hspec-discover ==2.11.7, any.hspec-expectations ==0.8.4, - any.http-api-data ==0.6.1, + any.http-api-data ==0.6, http-api-data -use-text-show, any.http-client ==0.7.17, http-client +network-uri, @@ -170,31 +144,24 @@ constraints: any.Cabal ==3.10.3.0, any.http-conduit ==2.3.8.3, http-conduit +aeson, any.http-types ==0.12.4, - any.indexed-traversable ==0.1.4, - any.indexed-traversable-instances ==0.1.2, - any.integer-conversion ==0.1.1, + any.indexed-traversable ==0.1.3, + any.indexed-traversable-instances ==0.1.1.2, + any.integer-conversion ==0.1.0.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.6, any.language-c ==0.9.3, language-c -allwarnings +iecfpextension +usebytestrings, - 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, any.lifted-base ==0.2.3.12, - any.linear ==1.22, - linear -herbie +template-haskell, any.megaparsec ==9.6.1, megaparsec -dev, any.memory ==0.18.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.15, + any.microlens-th ==0.4.3.14, any.mime-types ==0.1.2.0, any.monad-control ==1.0.3.1, any.monad-logger ==0.3.40, @@ -202,19 +169,14 @@ constraints: any.Cabal ==3.10.3.0, any.monad-loops ==0.4.3, monad-loops +base4, any.mono-traversable ==1.0.17.0, - any.monomer ==1.6.0.1, - monomer -examples, - any.mtl ==2.3.1, + any.mtl ==2.2.2, any.murmur3 ==1.0.5, - any.nanovg ==0.8.1.0, - nanovg -examples -gl2 -gles3 -stb_truetype, - any.network ==3.2.1.0, + any.network ==3.1.4.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.6, - any.parallel ==3.2.2.0, + any.os-string ==2.0.2, any.parsec ==3.1.16.1, any.parser-combinators ==1.3.0, parser-combinators -dev, @@ -226,18 +188,12 @@ constraints: any.Cabal ==3.10.3.0, any.persistent-template ==2.12.0.0, any.pretty ==1.1.3.6, any.primitive ==0.9.0.0, - any.process ==1.6.19.0, - any.profunctors ==5.6.2, - any.psqueues ==0.2.8.0, + any.process ==1.6.18.0, any.pureMD5 ==2.1.4, pureMD5 -test, - any.qrcode-core ==0.9.9, - any.qrcode-juicypixels ==0.8.5, any.quickcheck-io ==0.2.0, any.quickcheck-transformer ==0.3.1.2, any.random ==1.2.1.2, - any.reflection ==2.1.8, - reflection -slow +template-haskell, any.regex-base ==0.94.0.2, any.regex-compat ==0.95.2.1, any.regex-posix ==0.96.0.1, @@ -247,17 +203,13 @@ constraints: any.Cabal ==3.10.3.0, any.rts ==1.0.2, any.safe ==0.3.21, any.safe-exceptions ==0.1.7.4, - 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.scientific ==0.3.7.0, + scientific -bytestring-builder -integer-simple, any.secp256k1-haskell ==1.2.0, - any.semialign ==1.3.1, + any.semialign ==1.3, semialign +semigroupoids, - any.semigroupoids ==6.0.1, + any.semigroupoids ==6.0.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, any.serialise ==0.2.6.1, serialise +newtime15, any.silently ==1.2.5.3, @@ -271,53 +223,52 @@ constraints: any.Cabal ==3.10.3.0, any.stm-chans ==3.0.0.9, any.streaming-commons ==0.2.2.6, streaming-commons -use-bytestring-builder, - any.strict ==0.5.1, + any.strict ==0.5, any.string-conversions ==0.4.0.1, - any.system-cxx-std-lib ==1.0, + any.structured-cli ==2.7.0.1, + structured-cli -debug, any.tagged ==0.8.8, tagged +deepseq +transformers, - any.template-haskell ==2.20.0.0, + any.template-haskell ==2.19.0.0, any.terminal-size ==0.3.4, - any.terminfo ==0.4.1.6, + any.terminfo ==0.4.1.5, any.text ==2.0.2, - any.text-iso8601 ==0.1.1, - any.text-short ==0.1.6, + any.text-iso8601 ==0.1, + any.text-short ==0.1.5, text-short -asserts, - 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.7.0.0, + any.th-abstraction ==0.6.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.1, + any.these ==1.2, any.time ==1.12.2, - any.time-compat ==1.9.7, - any.time-locale-compat ==0.1.1.5, - time-locale-compat -old-locale, - any.tls ==2.1.0, + any.time-compat ==1.9.6.1, + time-compat -old-locale, + any.tls ==2.0.2, tls -devel, - any.transformers ==0.6.1.0, + any.transformers ==0.5.6.2, 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.8.4.0, - any.unix-compat ==0.7.2, - any.unix-time ==0.4.15, + any.unix ==2.7.3, + any.unix-compat ==0.7.1, + unix-compat -old-time, + any.unix-time ==0.4.12, 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.6, + any.uuid-types ==1.0.5.1, 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.2, + any.vector-algorithms ==0.9.0.1, vector-algorithms +bench +boundschecks -internalchecks -llvm +properties -unsafechecks, any.vector-stream ==0.1.0.1, any.void ==0.7.3, @@ -327,10 +278,8 @@ constraints: any.Cabal ==3.10.3.0, vty-crossplatform -demos, any.vty-unix ==0.2.0.0, any.wide-word ==0.1.6.0, - any.witherable ==0.5, + any.witherable ==0.4.2, any.word-wrap ==0.5, - any.wreq ==0.5.4.3, - wreq -aws -developer +doctest -httpbin, - any.zlib ==0.7.1.0, + any.zlib ==0.7.0.0, zlib -bundled-c-zlib +non-blocking-ffi +pkg-config -index-state: hackage.haskell.org 2024-07-10T18:40:26Z +index-state: hackage.haskell.org 2024-04-07T10:14:52Z diff --git a/configure b/configure index 25686c1..df9fc8d 100755 --- a/configure +++ b/configure @@ -1,17 +1,6 @@ #!/bin/bash -echo "Configuring Zenith...." -if grep -q "local/share/zcash-haskell" "$HOME/.bashrc"; then - echo "... Paths already exist" -else - # Set Paths - echo "... Adding new zenith paths to local configuration" - echo "export PKG_CONFIG_PATH=$HOME/.local/share/zcash-haskell:\$PKG_CONFIG_PATH" | tee -a ~/.bashrc - echo "export LD_LIBRARY_PATH=$HOME/.local/share/zcash-haskell:\$LD_LIBRARY_PATH" | tee -a ~/.bashrc -fi -echo "... Reloading paths" + +echo "export PKG_CONFIG_PATH=$HOME/.local/share/zcash-haskell:\$PKG_CONFIG_PATH" | tee -a ~/.bashrc +echo "export LD_LIBRARY_PATH=$HOME/.local/share/zcash-haskell:\$LD_LIBRARY_PATH" | tee -a ~/.bashrc source ~/.bashrc -echo "... building zcash-haskell" cd zcash-haskell && cabal build -echo -echo "Done" -echo diff --git a/install b/install deleted file mode 100755 index 2dc2023..0000000 --- a/install +++ /dev/null @@ -1,5 +0,0 @@ -#!/bin/bash - -echo "Deploying Zenith executable..." -ln -s ${PWD}/dist-newstyle/build/x86_64-linux/ghc-9.6.5/zenith-0.6.0.0/build/zenith/zenith ~/.local/bin/zenith -echo "Done." diff --git a/src/Zenith/CLI.hs b/src/Zenith/CLI.hs index b10b7e0..f107dfd 100644 --- a/src/Zenith/CLI.hs +++ b/src/Zenith/CLI.hs @@ -3,6 +3,7 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} + module Zenith.CLI where import qualified Brick.AttrMap as A @@ -10,10 +11,8 @@ import qualified Brick.BChan as BC import qualified Brick.Focus as F import Brick.Forms ( Form(..) - , FormFieldState , (@@=) , allFieldsValid - , editShowableField , editShowableFieldWithValidate , editTextField , focusedFormInputAttr @@ -23,11 +22,13 @@ 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, fg, on, style) +import Brick.Util (bg, clamp, fg, on, style) import qualified Brick.Widgets.Border as B import Brick.Widgets.Border.Style (unicode, unicodeBold) import qualified Brick.Widgets.Center as C @@ -42,8 +43,8 @@ import Brick.Widgets.Core , joinBorders , padAll , padBottom - , padLeft , padTop + , padLeft , setAvailableSize , str , strWrap @@ -53,8 +54,8 @@ import Brick.Widgets.Core , txtWrapWith , updateAttrMap , vBox - , vLimit , viewport + , vLimit , withAttr , withBorderStyle ) @@ -88,29 +89,22 @@ import ZcashHaskell.Keys (generateWalletSeedPhrase, getWalletSeed) import ZcashHaskell.Orchard (getSaplingFromUA, isValidUnifiedAddress) import ZcashHaskell.Sapling (decodeSaplingAddress, isValidShieldedAddress) import ZcashHaskell.Transparent - ( decodeTransparentAddress + ( decodeExchangeAddress + , decodeTransparentAddress , encodeTransparentReceiver ) import ZcashHaskell.Types import ZcashHaskell.Utils (getBlockTime, makeZebraCall) import Zenith.Core import Zenith.DB -import Zenith.Scanner (processTx, updateConfs) +import Zenith.Scanner (processTx) import Zenith.Types ( Config(..) , PhraseDB(..) , UnifiedAddressDB(..) , ZcashNetDB(..) ) -import Zenith.Utils - ( displayTaz - , displayZec - , isRecipientValid - , jsonNumber - , parseAddress - , showAddress - , validBarValue - ) +import Zenith.Utils (displayTaz, displayZec, jsonNumber, showAddress) data Name = WList @@ -203,9 +197,8 @@ 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 @@ -223,11 +216,10 @@ 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: " ++ @@ -242,16 +234,9 @@ drawUI s = [splashDialog s, helpDialog s, displayDialog s, inputDialog s, ui s] if st ^. network == MainNet then displayZec (st ^. balance) else displayTaz (st ^. balance))) <=> - C.hCenter - (str - ("Unconf: " ++ - if st ^. network == MainNet - then displayZec (st ^. unconfBalance) - else displayTaz (st ^. unconfBalance))) <=> - listAddressBox "Addresses" (st ^. addresses) <+> + 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 @@ -328,8 +313,7 @@ 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) @@ -390,55 +374,50 @@ 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 "" "" " Cancel"])) + (hBox [capCommand "↲" " Save", capCommand3 "" "" " 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 "" "" " Cancel"])) + (hBox [capCommand "↲" " Save", capCommand3 "" "" " 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 "" "" " Cancel" - ])) + (hBox [capCommand "C" "onfirm delete", capCommand3 "" "" " Cancel"])) -- + splashDialog :: State -> Widget Name splashDialog st = if st ^. splashBox @@ -450,14 +429,16 @@ 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.6.0.0-beta")) <=> + (withAttr titleAttr (str "Zcash Wallet v0.5.3.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 @@ -581,21 +562,20 @@ drawUI s = [splashDialog s, helpDialog s, displayDialog s, inputDialog s, ui s] (strWrapWith (WrapSettings False True NoFill FillAfterFirst) (st ^. msg))) - AdrBookEntryDisplay -> do - case L.listSelectedElement $ st ^. abAddresses of + AdrBookEntryDisplay -> do + 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 @@ -617,12 +597,12 @@ mkSendForm bal = ] where isAmountValid :: Integer -> Float -> Bool - isAmountValid b i = (fromIntegral b / 100000000.0) >= i + isAmountValid b i = (fromIntegral b * 100000000.0) >= i && i > 0 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) @@ -631,6 +611,19 @@ 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 = @@ -691,9 +684,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" @@ -722,32 +715,26 @@ 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 - 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 + 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) then do - 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 + 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 @@ -944,7 +931,7 @@ appEvent (BT.VtyEvent e) = do _ev -> return () SendDisplay -> BT.modify $ set displayBox BlankDisplay SyncDisplay -> BT.modify $ set displayBox BlankDisplay - AdrBookEntryDisplay -> BT.modify $ set displayBox BlankDisplay + AdrBookEntryDisplay -> BT.modify $ set displayBox BlankDisplay BlankDisplay -> do case s ^. dialogBox of WName -> do @@ -1085,21 +1072,19 @@ 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') [] + V.EvKey (V.KChar 'c') [] -> do -- Copy Address to Clipboard - -> do case L.listSelectedElement $ s ^. abAddresses of Just (_, a) -> do liftIO $ @@ -1107,72 +1092,53 @@ 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 + V.EvKey V.KEnter [] -> do + BT.modify $ set displayBox AdrBookEntryDisplay + -- Process any other event ev -> BT.zoom abAddresses $ L.handleListEvent ev -- Process new address book entry @@ -1180,101 +1146,75 @@ 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 - AdrBookUpdForm -> do + 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 @@ -1381,15 +1321,13 @@ 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 $ @@ -1430,7 +1368,6 @@ runZenithTUI config = do (mkNewABForm (AdrBookEntry "" "")) "" Nothing - uBal Left e -> do print $ "No Zebra node available on port " <> @@ -1459,10 +1396,6 @@ 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 @@ -1473,8 +1406,6 @@ 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 .~ @@ -1520,7 +1451,8 @@ 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 = @@ -1543,7 +1475,6 @@ 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 @@ -1554,17 +1485,13 @@ refreshAccount s = do case selAddress of Nothing -> return $ - s & balance .~ bal & unconfBalance .~ uBal & addresses .~ aL' & msg .~ - "Switched to account: " ++ + s & balance .~ bal & 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 & unconfBalance .~ uBal & addresses .~ aL' & - transactions .~ - tL' & - msg .~ + s & balance .~ bal & addresses .~ aL' & transactions .~ tL' & msg .~ "Switched to account: " ++ T.unpack (zcashAccountName $ entityVal selAccount) @@ -1592,11 +1519,10 @@ 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' @@ -1621,7 +1547,8 @@ 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 = @@ -1647,22 +1574,36 @@ sendTransaction :: -> IO () sendTransaction pool chan zHost zPort znet accId bl amt ua memo = do BC.writeBChan chan $ TickMsg "Preparing transaction..." - 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 + outUA <- parseAddress ua + 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 + where + parseAddress :: T.Text -> IO UnifiedAddress + parseAddress a = + case isValidUnifiedAddress (E.encodeUtf8 a) of + Just a1 -> return a1 + Nothing -> + case decodeSaplingAddress (E.encodeUtf8 a) of + Just a2 -> + return $ + UnifiedAddress znet Nothing (Just $ sa_receiver a2) Nothing + Nothing -> + case decodeTransparentAddress (E.encodeUtf8 a) of + Just a3 -> + return $ + UnifiedAddress znet Nothing Nothing (Just $ ta_receiver a3) + Nothing -> throwIO $ userError "Incorrect address" diff --git a/src/Zenith/DB.hs b/src/Zenith/DB.hs index aea3c5a..8f9eef1 100644 --- a/src/Zenith/DB.hs +++ b/src/Zenith/DB.hs @@ -32,6 +32,7 @@ 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 @@ -42,6 +43,7 @@ import Haskoin.Transaction.Common ) import qualified Lens.Micro as ML ((&), (.~), (^.)) import ZcashHaskell.Orchard (isValidUnifiedAddress) +import ZcashHaskell.Sapling (decodeSaplingOutputEsk) import ZcashHaskell.Types ( DecodedNote(..) , OrchardAction(..) @@ -75,7 +77,6 @@ import Zenith.Types , TransparentSpendingKeyDB , UnifiedAddressDB(..) , ZcashNetDB(..) - , ZcashPool(..) ) share @@ -245,15 +246,6 @@ share position Int UniqueSSPos tx position deriving Show Eq - QrCode - address WalletAddressId OnDeleteCascade OnUpdateCascade - version ZcashPool - bytes BS.ByteString - height Int - width Int - name T.Text - UniqueQr address version - deriving Show Eq AddressBook network ZcashNetDB abdescrip T.Text @@ -430,16 +422,6 @@ getWalletAddresses pool w = do addrs <- mapM (getAddresses pool . entityKey) accs return $ concat addrs -getExternalAddresses :: ConnectionPool -> IO [Entity WalletAddress] -getExternalAddresses pool = do - runNoLoggingT $ - PS.retryOnBusy $ - flip PS.runSqlPool pool $ do - select $ do - addrs <- from $ table @WalletAddress - where_ $ addrs ^. WalletAddressScope ==. val (ScopeDB External) - return addrs - -- | Returns the largest address index for the given account getMaxAddress :: ConnectionPool -- ^ The database path @@ -572,41 +554,6 @@ getZcashTransactions pool b = orderBy [asc $ txs ^. ZcashTransactionBlock] return txs --- ** QR codes --- | Functions to manage the QR codes stored in the database -saveQrCode :: - ConnectionPool -- ^ the connection pool - -> QrCode - -> NoLoggingT IO (Maybe (Entity QrCode)) -saveQrCode pool qr = - PS.retryOnBusy $ flip PS.runSqlPool pool $ insertUniqueEntity qr - -getQrCodes :: - ConnectionPool -- ^ the connection pool - -> WalletAddressId - -> IO [Entity QrCode] -getQrCodes pool wId = - runNoLoggingT $ - PS.retryOnBusy $ - flip PS.runSqlPool pool $ do - select $ do - qrs <- from $ table @QrCode - where_ $ qrs ^. QrCodeAddress ==. val wId - return qrs - -getQrCode :: ConnectionPool -> ZcashPool -> WalletAddressId -> IO (Maybe QrCode) -getQrCode pool zp wId = do - r <- - runNoLoggingT $ - PS.retryOnBusy $ - flip PS.runSqlPool pool $ do - selectOne $ do - qrs <- from $ table @QrCode - where_ $ qrs ^. QrCodeAddress ==. val wId - where_ $ qrs ^. QrCodeVersion ==. val zp - return qrs - return $ entityVal <$> r - -- * Wallet -- | Get the block of the last transaction known to the wallet getMaxWalletBlock :: @@ -1396,35 +1343,6 @@ 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 $ @@ -1462,42 +1380,10 @@ getWalletUnspentTrNotes pool za = do 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 - -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 + n <- from $ table @WalletTrNote + where_ (n ^. WalletTrNoteAccId ==. val za) + where_ (n ^. WalletTrNoteSpent ==. val False) + pure n getWalletUnspentSapNotes :: ConnectionPool -> ZcashAccountId -> IO [Entity WalletSapNote] @@ -1506,42 +1392,10 @@ getWalletUnspentSapNotes pool za = do 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 - -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 + n1 <- from $ table @WalletSapNote + where_ (n1 ^. WalletSapNoteAccId ==. val za) + where_ (n1 ^. WalletSapNoteSpent ==. val False) + pure n1 getWalletUnspentOrchNotes :: ConnectionPool -> ZcashAccountId -> IO [Entity WalletOrchNote] @@ -1550,42 +1404,10 @@ getWalletUnspentOrchNotes pool za = do 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 - -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 + n2 <- from $ table @WalletOrchNote + where_ (n2 ^. WalletOrchNoteAccId ==. val za) + where_ (n2 ^. WalletOrchNoteSpent ==. val False) + pure n2 selectUnspentNotes :: ConnectionPool @@ -1646,27 +1468,6 @@ 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 = @@ -1712,6 +1513,7 @@ 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 @@ -1720,7 +1522,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 diff --git a/src/Zenith/GUI.hs b/src/Zenith/GUI.hs deleted file mode 100644 index c0b4623..0000000 --- a/src/Zenith/GUI.hs +++ /dev/null @@ -1,1414 +0,0 @@ -{-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE OverloadedStrings #-} - -module Zenith.GUI where - -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.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) -import Data.Maybe (fromJust, fromMaybe, isJust, isNothing) -import qualified Data.Text as T -import qualified Data.Text.Encoding as E -import Data.Time.Clock.POSIX (posixSecondsToUTCTime) -import Database.Esqueleto.Experimental (ConnectionPool) -import Database.Persist -import Lens.Micro ((&), (+~), (.~), (?~), (^.), set) -import Lens.Micro.TH -import Monomer -import qualified Monomer.Lens as L -import System.Directory (getHomeDirectory) -import System.FilePath (()) -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 - ( BlockResponse(..) - , Phrase(..) - , Scope(..) - , ToBytes(..) - , UnifiedAddress(..) - , ZcashNet(..) - , 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 - , isRecipientValid - , jsonNumber - , parseAddress - , showAddress - , validBarValue - ) - -data AppEvent - = AppInit - | ShowMsg !T.Text - | ShowError !T.Text - | ShowModal !T.Text - | CloseMsg - | WalletClicked - | AccountClicked - | MenuClicked - | NewClicked - | NewAddress !(Maybe (Entity ZcashAccount)) - | NewAccount !(Maybe (Entity ZcashWallet)) - | NewWallet - | SetPool !ZcashPool - | SwitchQr !(Maybe QrCode) - | SwitchAddr !Int - | SwitchAcc !Int - | SwitchWal !Int - | UpdateBalance !(Integer, Integer) - | CopyAddr !(Maybe (Entity WalletAddress)) - | LoadTxs ![Entity UserTx] - | LoadAddrs ![Entity WalletAddress] - | LoadAccs ![Entity ZcashAccount] - | LoadWallets ![Entity ZcashWallet] - | ConfirmCancel - | SaveAddress !(Maybe (Entity ZcashAccount)) - | 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 - { _configuration :: !Config - , _network :: !ZcashNet - , _wallets :: ![Entity ZcashWallet] - , _selWallet :: !Int - , _accounts :: ![Entity ZcashAccount] - , _selAcc :: !Int - , _addresses :: ![Entity WalletAddress] - , _selAddr :: !Int - , _transactions :: ![Entity UserTx] - , _setTx :: !Int - , _msg :: !(Maybe T.Text) - , _zebraOn :: !Bool - , _balance :: !Integer - , _unconfBalance :: !(Maybe Integer) - , _selPool :: !ZcashPool - , _qrCodeWidget :: !(Maybe QrCode) - , _accPopup :: !Bool - , _walPopup :: !Bool - , _menuPopup :: !Bool - , _newPopup :: !Bool - , _mainInput :: !T.Text - , _confirmTitle :: !(Maybe T.Text) - , _confirmAccept :: !T.Text - , _confirmCancel :: !T.Text - , _confirmEvent :: !AppEvent - , _inError :: !Bool - , _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) - , _home :: !FilePath - } deriving (Eq, Show) - -makeLenses ''AppModel - -remixArrowRightWideLine :: T.Text -remixArrowRightWideLine = toGlyph 0xF496 - -remixHourglassFill :: T.Text -remixHourglassFill = toGlyph 0xF338 - -remixIcon :: T.Text -> WidgetNode s e -remixIcon i = label i `styleBasic` [textFont "Remix", textMiddle] - -buildUI :: - WidgetEnv AppModel AppEvent -> AppModel -> WidgetNode AppModel AppEvent -buildUI wenv model = widgetTree - where - btnColor = rgbHex "#ff5722" --rgbHex "#1818B2" - btnHiLite = rgbHex "#207DE8" - currentWallet = - if null (model ^. wallets) - then Nothing - else Just ((model ^. wallets) !! (model ^. selWallet)) - currentAccount = - if null (model ^. accounts) - then Nothing - else Just ((model ^. accounts) !! (model ^. selAcc)) - currentAddress = - if null (model ^. addresses) - then Nothing - else Just ((model ^. addresses) !! (model ^. selAddr)) - widgetTree = - zstack - [ mainWindow - , 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) - ] - mainWindow = - vstack - [ windowHeader - , spacer - , balanceBox - , filler - , mainPane - , filler - , windowFooter - ] - windowHeader = - hstack - [ vstack - [ box_ - [onClick MenuClicked, alignMiddle] - (remixIcon remixMenuFill `styleBasic` - [textSize 16, textColor white]) `styleBasic` - [cursorHand, height 25, padding 3] `styleHover` - [bgColor btnHiLite] - , popup menuPopup menuBox - ] - , vstack - [ box_ [onClick WalletClicked, alignMiddle] walletButton `styleBasic` - [cursorHand, height 25, padding 3] `styleHover` - [bgColor btnHiLite] - , popup walPopup walListPopup - ] - , vstack - [ box_ [onClick AccountClicked, alignMiddle] accountButton `styleBasic` - [cursorHand, height 25, padding 3] `styleHover` - [bgColor btnHiLite] - , popup accPopup accListPopup - ] - , filler - , remixIcon remixErrorWarningFill `styleBasic` [textColor white] - , label "Testnet" `styleBasic` [textColor white] `nodeVisible` - (model ^. network == TestNet) - ] `styleBasic` - [bgColor btnColor] - menuBox = - box_ - [alignMiddle] - (vstack - [ box_ - [alignLeft] - (vstack - [ box_ - [alignLeft, onClick NewClicked] - (hstack - [ label "New" - , filler - , widgetIf (not $ model ^. newPopup) $ - remixIcon remixMenuUnfoldFill - , widgetIf (model ^. newPopup) $ - remixIcon remixMenuFoldFill - ]) - , widgetIf (model ^. newPopup) $ animSlideIn newBox - ]) `styleBasic` - [bgColor white, borderB 1 gray, padding 3] - , box_ [alignLeft, onClick ShowSeed] (label "Backup Wallet") `styleBasic` - [bgColor white, borderB 1 gray, padding 3] - ]) `styleBasic` - [bgColor btnColor, padding 3] - newBox = - box_ - [alignMiddle] - (vstack - [ box_ - [alignLeft, onClick $ NewAddress currentAccount] - (hstack [label "Address", filler]) `styleBasic` - [bgColor white, borderB 1 gray, padding 3] - , box_ - [alignLeft, onClick $ NewAccount currentWallet] - (hstack [label "Account", filler]) `styleBasic` - [bgColor white, borderB 1 gray, padding 3] - , box_ - [alignLeft, onClick NewWallet] - (hstack [label "Wallet", filler]) `styleBasic` - [bgColor white, borderB 1 gray, padding 3] - ]) - walletButton = - hstack - [ label "Wallet: " `styleBasic` [textFont "Bold", textColor white] - , label (maybe "None" (zcashWalletName . entityVal) currentWallet) `styleBasic` - [textFont "Regular", textColor white] - , remixIcon remixArrowRightWideLine `styleBasic` [textColor white] - ] - walListPopup = - box_ [alignMiddle] dispWalList `styleBasic` [bgColor btnColor, padding 3] - dispWalList = vstack (zipWith walRow [0 ..] (model ^. wallets)) - walRow :: Int -> Entity ZcashWallet -> WidgetNode AppModel AppEvent - walRow idx wal = - box_ - [onClick $ SwitchWal idx, alignCenter] - (label (zcashWalletName (entityVal wal))) `styleBasic` - [ padding 1 - , borderB 1 gray - , bgColor white - , width 80 - , styleIf (model ^. selWallet == idx) (borderL 2 btnHiLite) - , styleIf (model ^. selWallet == idx) (borderR 2 btnHiLite) - ] - accountButton = - hstack - [ label "Account: " `styleBasic` [textFont "Bold", textColor white] - , label (maybe "None" (zcashAccountName . entityVal) currentAccount) `styleBasic` - [textFont "Regular", textColor white] - , remixIcon remixArrowRightWideLine `styleBasic` [textColor white] - ] - accListPopup = - box_ [alignMiddle] dispAccList `styleBasic` [bgColor btnColor, padding 3] - dispAccList = vstack (zipWith accRow [0 ..] (model ^. accounts)) - accRow :: Int -> Entity ZcashAccount -> WidgetNode AppModel AppEvent - accRow idx wAcc = - box_ - [onClick $ SwitchAcc idx, alignLeft] - (label (zcashAccountName (entityVal wAcc))) `styleBasic` - [ padding 1 - , borderB 1 gray - , bgColor white - , width 80 - , styleIf (model ^. selAcc == idx) (borderL 2 btnHiLite) - , styleIf (model ^. selAcc == idx) (borderR 2 btnHiLite) - ] - mainPane = - box_ [alignMiddle] $ - hstack - [ addressBox - , vstack - [ mainButton "Send" ShowSend `styleBasic` [textFont "Bold"] - , txBox `nodeVisible` not (null $ model ^. transactions) - ] - ] - balanceBox = - hstack - [ filler - , boxShadow $ - box_ - [alignMiddle] - (vstack - [ 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] - , filler - ] `nodeVisible` - isJust (model ^. unconfBalance) - ]) `styleBasic` - [bgColor white, radius 5, border 1 btnColor] - , filler - ] - addressBox = - vstack - [ boxShadow $ - box_ - [alignMiddle] - (vstack - [ label "Addresses" `styleBasic` - [textFont "Bold", textColor white, bgColor btnColor] - , vscroll (vstack (zipWith addrRow [0 ..] (model ^. addresses))) `nodeKey` - "addrScroll" - ]) `styleBasic` - [padding 3, radius 2, bgColor white] - , addrQRCode - ] - addrQRCode :: WidgetNode AppModel AppEvent - addrQRCode = - box_ - [alignMiddle] - (hstack - [ filler - , boxShadow $ - hstack - [ vstack - [ tooltip "Unified" $ - box_ - [onClick (SetPool Orchard)] - (remixIcon remixShieldCheckFill `styleBasic` - [ textSize 14 - , padding 4 - , styleIf - (model ^. selPool == Orchard) - (bgColor btnColor) - , styleIf - (model ^. selPool == Orchard) - (textColor white) - ]) - , filler - , tooltip "Legacy Shielded" $ - box_ - [onClick (SetPool Sapling)] - (remixIcon remixShieldLine `styleBasic` - [ textSize 14 - , padding 4 - , styleIf - (model ^. selPool == Sapling) - (bgColor btnColor) - , styleIf - (model ^. selPool == Sapling) - (textColor white) - ]) - , filler - , tooltip "Transparent" $ - box_ - [onClick (SetPool Transparent)] - (remixIcon remixEyeLine `styleBasic` - [ textSize 14 - , padding 4 - , styleIf - (model ^. selPool == Transparent) - (bgColor btnColor) - , styleIf - (model ^. selPool == Transparent) - (textColor white) - ]) - ] `styleBasic` - [bgColor white] - , vstack - [ filler - , tooltip "Copy" $ - box_ - [onClick $ CopyAddr currentAddress] - (hstack - [ label - (case model ^. selPool of - Orchard -> "Unified" - Sapling -> "Legacy Shielded" - Transparent -> "Transparent" - Sprout -> "Unknown") `styleBasic` - [textColor white] - , remixIcon remixFileCopyFill `styleBasic` - [textSize 14, padding 4, textColor white] - ]) `styleBasic` - [cursorHand] - , box_ - [alignMiddle] - (case model ^. qrCodeWidget of - Just qr -> - imageMem_ - (qrCodeName qr) - (qrCodeBytes qr) - (Size - (fromIntegral $ qrCodeHeight qr) - (fromIntegral $ qrCodeWidth qr)) - [fitWidth] - Nothing -> - image_ - (T.pack $ - (model ^. home) - "Zenith/assets/1F928_color.png") - [fitEither]) `styleBasic` - [bgColor white, height 100, width 100] - , filler - ] `styleBasic` - [bgColor btnColor, border 2 btnColor] - ] `styleBasic` - [radius 3, border 1 btnColor] - , filler - ]) - addrRow :: Int -> Entity WalletAddress -> WidgetNode AppModel AppEvent - addrRow idx wAddr = - box_ - [onClick $ SwitchAddr idx, alignLeft] - (label - (walletAddressName (entityVal wAddr) <> - ": " <> showAddress (walletAddressUAddress $ entityVal wAddr))) `styleBasic` - [ padding 1 - , borderB 1 gray - , styleIf (model ^. selAddr == idx) (borderL 2 btnHiLite) - , styleIf (model ^. selAddr == idx) (borderR 2 btnHiLite) - ] - txBox = - boxShadow $ - box_ - [alignMiddle] - (vstack - [ label "Transactions" `styleBasic` - [textFont "Bold", bgColor btnColor, textColor white] - , vscroll (vstack (zipWith txRow [0 ..] (model ^. transactions))) `nodeKey` - "txScroll" - ]) `styleBasic` - [radius 2, padding 3, bgColor white] - txRow :: Int -> Entity UserTx -> WidgetNode AppModel AppEvent - txRow idx tx = - box_ - [onClick $ ShowTx idx] - (hstack - [ label - (T.pack $ - show - (posixSecondsToUTCTime - (fromIntegral (userTxTime $ entityVal tx)))) - , filler - , widgetIf - (T.length (userTxMemo $ entityVal tx) > 1) - (remixIcon remixDiscussFill) - , if 0 >= userTxAmount (entityVal tx) - then remixIcon remixArrowRightUpFill `styleBasic` [textColor red] - else remixIcon remixArrowRightDownFill `styleBasic` - [textColor green] - , label $ - displayAmount (model ^. network) $ - fromIntegral $ userTxAmount (entityVal tx) - ]) `styleBasic` - [padding 2, borderB 1 gray] - windowFooter = - hstack - [ label - ("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_ - (T.pack $ (model ^. home) "Zenith/assets/1F993.png") - [fitHeight] `styleBasic` - [height 24, width 24] `nodeVisible` - (model ^. zebraOn) - , label - ("Connected on " <> - c_zebraHost (model ^. configuration) <> - ":" <> showt (c_zebraPort $ model ^. configuration)) `styleBasic` - [padding 3, textSize 8] `nodeVisible` - (model ^. zebraOn) - , label "Disconnected" `styleBasic` [padding 3, textSize 8] `nodeVisible` - not (model ^. zebraOn) - ] - msgOverlay = - alert CloseMsg $ - hstack - [ filler - , remixIcon remixErrorWarningFill `styleBasic` - [textSize 32, textColor btnColor] `nodeVisible` - (model ^. inError) - , spacer - , label $ fromMaybe "" (model ^. msg) - , filler - ] - confirmOverlay = - confirm_ - (model ^. confirmEvent) - ConfirmCancel - [ titleCaption $ fromMaybe "" $ model ^. confirmTitle - , acceptCaption $ model ^. confirmAccept - , 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 - [ box_ - [] - (label "Seed Phrase" `styleBasic` - [textFont "Bold", textSize 12, textColor white]) `styleBasic` - [bgColor btnColor, radius 2, padding 3] - , spacer - , textAreaV_ - (maybe - "None" - (E.decodeUtf8Lenient . - getBytes . getPhrase . zcashWalletSeedPhrase . entityVal) - currentWallet) - (const CloseSeed) - [readOnly, maxLines 2] `styleBasic` - [textSize 8] - , spacer - , hstack - [ filler - , box_ - [ onClick $ - CopySeed $ - maybe - "None" - (E.decodeUtf8Lenient . - getBytes . getPhrase . zcashWalletSeedPhrase . entityVal) - currentWallet - ] - (hstack - [ label "Copy" `styleBasic` [textColor white] - , remixIcon remixFileCopyLine `styleBasic` [textColor white] - ]) `styleBasic` - [cursorHand, bgColor btnColor, radius 2, padding 3] - , filler - ] - ] - modalOverlay = - box - (label (fromMaybe "?" $ model ^. modalMsg) `styleBasic` - [textSize 12, textFont "Bold"]) `styleBasic` - [bgColor (white & L.a .~ 0.5)] - txOverlay = - case model ^. showTx of - Nothing -> alert CloseTx $ label "N/A" - Just i -> - alert CloseTx $ - vstack - [ box_ - [alignLeft] - (hstack - [ label "Date " `styleBasic` [width 60, textFont "Bold"] - , separatorLine `styleBasic` [fgColor btnColor] - , spacer - , label - (T.pack $ - show $ - posixSecondsToUTCTime $ - fromIntegral $ - userTxTime $ entityVal $ (model ^. transactions) !! i) - ]) `styleBasic` - [padding 2, bgColor white, width 280, borderB 1 gray] - , box_ - [alignLeft] - (hstack - [ label "Tx ID " `styleBasic` [width 60, textFont "Bold"] - , separatorLine `styleBasic` [fgColor btnColor] - , spacer - , label_ - (txtWrap $ - toText $ - getHex $ - userTxHex $ entityVal $ (model ^. transactions) !! i) - [multiline] - , spacer - , box_ - [ onClick $ - CopyTx $ - toText $ - getHex $ - userTxHex $ entityVal $ (model ^. transactions) !! i - ] - (remixIcon remixFileCopyFill `styleBasic` - [textColor white]) `styleBasic` - [cursorHand, bgColor btnColor, radius 2, padding 2] - ]) `styleBasic` - [padding 2, bgColor white, width 280, borderB 1 gray] - , box_ - [alignLeft] - (hstack - [ label "Amount" `styleBasic` [width 60, textFont "Bold"] - , separatorLine `styleBasic` [fgColor btnColor] - , spacer - , label $ - displayAmount (model ^. network) $ - fromIntegral $ - userTxAmount $ entityVal $ (model ^. transactions) !! i - ]) `styleBasic` - [padding 2, bgColor white, width 280, borderB 1 gray] - , box_ - [alignLeft] - (hstack - [ label "Memo " `styleBasic` [width 60, textFont "Bold"] - , separatorLine `styleBasic` [fgColor btnColor] - , spacer - , label_ - (txtWrap $ - userTxMemo $ entityVal $ (model ^. transactions) !! i) - [multiline] - ]) `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 - let dbFilePath = c_dbPath config - pool <- runNoLoggingT $ initPool dbFilePath - addrs <- getExternalAddresses pool - mapM_ (checkExistingQrs pool) addrs - where - checkExistingQrs :: ConnectionPool -> Entity WalletAddress -> IO () - checkExistingQrs pool wAddr = do - s <- getQrCodes pool (entityKey wAddr) - if not (null s) - then return () - else do - generateOneQr pool Orchard wAddr - generateOneQr pool Sapling wAddr - generateOneQr pool Transparent wAddr - generateOneQr :: - ConnectionPool -> ZcashPool -> Entity WalletAddress -> IO () - generateOneQr p zp wAddr = - case encodeText (defaultQRCodeOptions L) Utf8WithoutECI =<< - dispAddr zp (entityVal wAddr) of - Just qr -> do - _ <- - runNoLoggingT $ - saveQrCode p $ - QrCode - (entityKey wAddr) - zp - (qrCodeData qr) - (qrCodeH qr) - (qrCodeW qr) - (walletAddressName (entityVal wAddr) <> T.pack (show zp)) - return () - Nothing -> return () - qrCodeImg :: QRImage -> Image PixelRGBA8 - qrCodeImg qr = promoteImage (toImage 4 2 qr) - qrCodeH :: QRImage -> Int - qrCodeH qr = fromIntegral $ imageHeight $ qrCodeImg qr - qrCodeW :: QRImage -> Int - qrCodeW qr = fromIntegral $ imageWidth $ qrCodeImg qr - qrCodeData :: QRImage -> BS.ByteString - qrCodeData qr = - BS.pack $ - pixelFold - (\bs _ _ (PixelRGBA8 i j k l) -> bs <> [i, j, k, l]) - [] - (qrCodeImg qr) - dispAddr :: ZcashPool -> WalletAddress -> Maybe T.Text - dispAddr zp w = - case zp of - Transparent -> - T.append "zcash:" . - encodeTransparentReceiver - (maybe - TestNet - ua_net - ((isValidUnifiedAddress . - E.encodeUtf8 . getUA . walletAddressUAddress) - w)) <$> - (t_rec =<< - (isValidUnifiedAddress . E.encodeUtf8 . getUA . walletAddressUAddress) - w) - Sapling -> - T.append "zcash:" <$> - (getSaplingFromUA . E.encodeUtf8 . getUA . walletAddressUAddress) w - Orchard -> Just $ (T.append "zcash:" . getUA . walletAddressUAddress) w - Sprout -> Nothing - -handleEvent :: - WidgetEnv AppModel AppEvent - -> WidgetNode AppModel AppEvent - -> AppModel - -> AppEvent - -> [AppEventResponse AppModel AppEvent] -handleEvent wenv node model evt = - case evt of - 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 & modalMsg .~ - Nothing - ] - ShowModal t -> [Model $ model & modalMsg ?~ t] - WalletClicked -> [Model $ model & walPopup .~ True] - AccountClicked -> [Model $ model & accPopup .~ True] - MenuClicked -> [Model $ model & menuPopup .~ True] - NewClicked -> [Model $ model & newPopup .~ not (model ^. newPopup)] - NewAddress acc -> - [ Model $ - model & confirmTitle ?~ "New Address" & confirmAccept .~ "Create" & - confirmCancel .~ - "Cancel" & - confirmEvent .~ - SaveAddress acc & - menuPopup .~ - False - ] - NewAccount wal -> - [ Model $ - model & confirmTitle ?~ "New Account" & confirmAccept .~ "Create" & - confirmCancel .~ - "Cancel" & - confirmEvent .~ - SaveAccount wal & - menuPopup .~ - False - ] - NewWallet -> - [ Model $ - model & confirmTitle ?~ "New Wallet" & confirmAccept .~ "Create" & - confirmCancel .~ - "Cancel" & - confirmEvent .~ - SaveWallet & - menuPopup .~ - False - ] - 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 - , Event $ ShowModal "Generating QR codes..." - , Event ConfirmCancel - ] - else [Event $ ShowError "Invalid input", Event ConfirmCancel] - SaveAccount wal -> - if T.length (model ^. mainInput) > 1 - then [ Task $ addNewAccount (model ^. mainInput) wal - , Event ConfirmCancel - ] - else [Event $ ShowError "Invalid input", Event ConfirmCancel] - SaveWallet -> - if T.length (model ^. mainInput) > 1 - then [Task addNewWallet, Event ConfirmCancel] - else [Event $ ShowError "Invalid input"] - SetPool p -> - [ Model $ model & selPool .~ p & modalMsg .~ Nothing - , Task $ - SwitchQr <$> do - dbPool <- runNoLoggingT $ initPool $ c_dbPath $ model ^. configuration - case currentAddress of - Nothing -> return Nothing - Just wAddr -> getQrCode dbPool p $ entityKey wAddr - , Task $ - LoadTxs <$> do - dbPool <- runNoLoggingT $ initPool $ c_dbPath $ model ^. configuration - case currentAddress of - Nothing -> return [] - Just wAddr -> getUserTx dbPool $ entityKey wAddr - ] - SwitchQr q -> [Model $ model & qrCodeWidget .~ q] - SwitchAddr i -> [Model $ model & selAddr .~ i, Event $ SetPool Orchard] - SwitchAcc i -> - [ Model $ model & selAcc .~ i - , Task $ - LoadAddrs <$> do - dbPool <- runNoLoggingT $ initPool $ c_dbPath $ model ^. configuration - 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 -> - [ Model $ model & selWallet .~ i & selAcc .~ 0 & selAddr .~ 0 - , Task $ - LoadAccs <$> do - dbPool <- runNoLoggingT $ initPool $ c_dbPath $ model ^. configuration - case selectWallet i of - 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 $ - ClipboardText $ - case model ^. selPool of - Orchard -> maybe "None" (getUA . walletAddressUAddress . entityVal) a - Sapling -> - fromMaybe "None" $ - (getSaplingFromUA . - E.encodeUtf8 . getUA . walletAddressUAddress . entityVal) =<< - a - Sprout -> "None" - Transparent -> - maybe "None" (encodeTransparentReceiver (model ^. network)) $ - t_rec =<< - (isValidUnifiedAddress . - E.encodeUtf8 . getUA . walletAddressUAddress . entityVal) =<< - a - , Event $ ShowMsg "Copied address!" - ] - CopySeed s -> - [ setClipboardData ClipboardEmpty - , setClipboardData $ ClipboardText s - , Event $ ShowMsg "Copied seed phrase!" - ] - CopyTx t -> - [ setClipboardData ClipboardEmpty - , setClipboardData $ ClipboardText t - , Event $ ShowMsg "Copied transaction ID!" - ] - LoadTxs t -> [Model $ model & transactions .~ t] - LoadAddrs a -> - if not (null a) - then [ Model $ model & addresses .~ a - , Event $ SwitchAddr $ model ^. selAddr - , Event $ SetPool Orchard - ] - else [Event $ NewAddress currentAccount] - LoadAccs a -> - if not (null a) - then [Model $ model & accounts .~ a, Event $ SwitchAcc 0] - else [Event $ NewAccount currentWallet] - LoadWallets a -> - if not (null a) - 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) - then Nothing - else Just ((model ^. wallets) !! (model ^. selWallet)) - selectWallet i = - if null (model ^. wallets) - then Nothing - else Just ((model ^. wallets) !! i) - currentAccount = - if null (model ^. accounts) - then Nothing - else Just ((model ^. accounts) !! (model ^. selAcc)) - selectAccount i = - if null (model ^. accounts) - then Nothing - else Just ((model ^. accounts) !! i) - currentAddress = - if null (model ^. addresses) - then Nothing - else Just ((model ^. addresses) !! (model ^. selAddr)) - addNewAddress :: - T.Text -> Scope -> Maybe (Entity ZcashAccount) -> IO AppEvent - addNewAddress n scope acc = do - case acc of - Nothing -> return $ ShowError "No account available" - Just a -> do - pool <- runNoLoggingT $ initPool $ c_dbPath $ model ^. configuration - maxAddr <- getMaxAddress pool (entityKey a) scope - uA <- - try $ createWalletAddress n (maxAddr + 1) (model ^. network) scope a :: IO - (Either IOError WalletAddress) - case uA of - Left e -> return $ ShowError $ "Error: " <> T.pack (show e) - Right uA' -> do - nAddr <- saveAddress pool uA' - case nAddr of - Nothing -> return $ ShowError $ "Address already exists: " <> n - Just _x -> do - generateQRCodes $ model ^. configuration - addrL <- runNoLoggingT $ getAddresses pool $ entityKey a - return $ LoadAddrs addrL - addNewAccount :: T.Text -> Maybe (Entity ZcashWallet) -> IO AppEvent - addNewAccount n w = do - case w of - Nothing -> return $ ShowError "No wallet available" - Just w' -> do - pool <- runNoLoggingT $ initPool $ c_dbPath $ model ^. configuration - accIx <- getMaxAccount pool $ entityKey w' - newAcc <- - try $ createZcashAccount n (accIx + 1) w' :: IO - (Either IOError ZcashAccount) - case newAcc of - Left e -> return $ ShowError "Failed to create account" - Right newAcc' -> do - r <- saveAccount pool newAcc' - case r of - Nothing -> return $ ShowError "Account already exists" - Just _x -> do - aList <- runNoLoggingT $ getAccounts pool (entityKey w') - return $ LoadAccs aList - addNewWallet :: IO AppEvent - addNewWallet = do - sP <- generateWalletSeedPhrase - pool <- runNoLoggingT $ initPool $ c_dbPath $ model ^. configuration - bc <- - try $ - checkBlockChain - (c_zebraHost $ model ^. configuration) - (c_zebraPort $ model ^. configuration) :: IO - (Either IOError ZebraGetBlockChainInfo) - case bc of - Left e1 -> return $ ShowError $ T.pack $ show e1 - Right chainInfo -> do - r <- - saveWallet pool $ - ZcashWallet - (model ^. mainInput) - (ZcashNetDB (model ^. network)) - (PhraseDB sP) - (zgb_blocks chainInfo) - 0 - case r of - Nothing -> return $ ShowError "Wallet already exists" - Just _ -> do - 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 - -runZenithGUI :: Config -> IO () -runZenithGUI config = do - homeDir <- try getHomeDirectory :: IO (Either IOError FilePath) - case homeDir of - Left e -> print e - Right hD -> do - let host = c_zebraHost config - let port = c_zebraPort config - let dbFilePath = c_dbPath config - pool <- runNoLoggingT $ initPool dbFilePath - w <- try $ checkZebra host port :: IO (Either IOError ZebraGetInfo) - case w of - Right zebra -> do - bc <- - try $ checkBlockChain host port :: IO - (Either IOError ZebraGetBlockChainInfo) - case bc of - Left e1 -> throwIO e1 - Right chainInfo -> do - initDb dbFilePath - generateQRCodes config - walList <- getWallets pool $ zgb_net chainInfo - accList <- - if not (null walList) - then runNoLoggingT $ - getAccounts pool $ entityKey $ head walList - else return [] - addrList <- - if not (null accList) - then runNoLoggingT $ - getAddresses pool $ entityKey $ head accList - else return [] - txList <- - if not (null addrList) - then getUserTx pool $ entityKey $ head addrList - else return [] - qr <- - 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 - (zgb_net chainInfo) - walList - 0 - accList - 0 - addrList - 0 - txList - 0 - Nothing - True - bal - (if unconfBal == 0 - then Nothing - else Just unconfBal) - Orchard - qr - False - False - False - False - "" - Nothing - "" - "" - (SaveAddress $ - if not (null accList) - then Just (head accList) - else Nothing) - False - False - Nothing - Nothing - 0 - 1.0 - False - "" - 0.0 - "" - False - False - Nothing - hD - startApp model handleEvent buildUI (params hD) - Left e -> do - initDb dbFilePath - let model = - AppModel - config - TestNet - [] - 0 - [] - 0 - [] - 0 - [] - 0 - (Just $ - "Couldn't connect to Zebra on " <> - host <> ":" <> showt port <> ". Check your configuration.") - False - 314259000 - (Just 30000) - Orchard - Nothing - False - False - False - False - "" - Nothing - "" - "" - (SaveAddress Nothing) - False - False - Nothing - Nothing - 0 - 1.0 - False - "" - 0.0 - "" - False - False - Nothing - hD - startApp model handleEvent buildUI (params hD) - where - params hd = - [ appWindowTitle "Zenith - Zcash Full Node Wallet" - , appWindowState $ MainWindowNormal (1000, 700) - , appTheme zenithTheme - , appFontDef - "Regular" - (T.pack $ - hd - "Zenith/assets/Atkinson-Hyperlegible-Regular-102.ttf" --"./assets/DejaVuSansMono.ttf" - ) - , appFontDef - "Bold" - (T.pack $ hd "Zenith/assets/Atkinson-Hyperlegible-Bold-102.ttf") - , appFontDef - "Italic" - (T.pack $ hd "Zenith/assets/Atkinson-Hyperlegible-Italic-102.ttf") - , appFontDef "Remix" (T.pack $ hd "Zenith/assets/remixicon.ttf") - , appDisableAutoScale True - , appScaleFactor 2.0 - , appInitEvent AppInit - ] diff --git a/src/Zenith/GUI/Theme.hs b/src/Zenith/GUI/Theme.hs deleted file mode 100644 index 6b59ef3..0000000 --- a/src/Zenith/GUI/Theme.hs +++ /dev/null @@ -1,340 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} - -module Zenith.GUI.Theme - ( zenithTheme - ) where - -import Data.Default -import Lens.Micro ((&), (+~), (.~), (?~), (^.), at, set) -import Monomer -import Monomer.Core.Themes.BaseTheme -import Monomer.Core.Themes.SampleThemes -import Monomer.Graphics (rgbHex, transparent) -import Monomer.Graphics.ColorTable -import qualified Monomer.Lens as L - -baseTextStyle :: TextStyle -baseTextStyle = def & L.fontSize ?~ FontSize 10 & L.fontColor ?~ black - -hiliteTextStyle :: TextStyle -hiliteTextStyle = def & L.fontSize ?~ FontSize 10 & L.fontColor ?~ white - -zenithTheme :: Theme -zenithTheme = - baseTheme zgoThemeColors & L.basic . L.labelStyle . L.text ?~ baseTextStyle & - L.hover . - L.tooltipStyle . L.text ?~ - baseTextStyle & - L.hover . - L.labelStyle . L.text ?~ - baseTextStyle & - L.basic . - L.dialogTitleStyle . L.text ?~ - (baseTextStyle & L.fontSize ?~ FontSize 12 & L.font ?~ "Bold") & - L.hover . - L.dialogTitleStyle . L.text ?~ - (baseTextStyle & L.fontSize ?~ FontSize 12 & L.font ?~ "Bold") & - L.basic . - L.btnStyle . L.text ?~ - baseTextStyle & - L.hover . - L.btnStyle . L.text ?~ - baseTextStyle & - L.focus . - L.btnStyle . L.text ?~ - baseTextStyle & - L.focusHover . - L.btnStyle . L.text ?~ - baseTextStyle & - L.active . - L.btnStyle . L.text ?~ - baseTextStyle & - L.basic . - L.btnMainStyle . L.text ?~ - hiliteTextStyle & - L.hover . - L.btnMainStyle . L.text ?~ - hiliteTextStyle & - L.focus . - L.btnMainStyle . L.text ?~ - hiliteTextStyle & - L.focusHover . - L.btnMainStyle . L.text ?~ - hiliteTextStyle & - 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 & - L.hover . - L.textFieldStyle . L.text ?~ - baseTextStyle & - L.focus . - L.textFieldStyle . L.text ?~ - baseTextStyle & - L.active . - L.textFieldStyle . L.text ?~ - 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 -zenithThemeColors = - BaseThemeColors - { clearColor = gray01 - , sectionColor = gray01 - , btnFocusBorder = blue09 - , btnBgBasic = gray07b - , btnBgHover = gray08 - , btnBgFocus = gray07c - , btnBgActive = gray06 - , btnBgDisabled = gray05 - , btnText = gray02 - , btnTextDisabled = gray01 - , btnMainFocusBorder = blue08 - , btnMainBgBasic = btnColor - , btnMainBgHover = btnHiLite - , btnMainBgFocus = btnColor - , btnMainBgActive = btnHiLite - , btnMainBgDisabled = blue04 - , btnMainText = white - , btnMainTextDisabled = gray08 - , dialogBg = gray01 - , dialogBorder = gray01 - , dialogText = white - , dialogTitleText = white - , emptyOverlay = gray05 & L.a .~ 0.8 - , shadow = gray00 & L.a .~ 0.33 - , externalLinkBasic = blue07 - , externalLinkHover = blue08 - , externalLinkFocus = blue07 - , externalLinkActive = blue06 - , externalLinkDisabled = gray06 - , iconBg = gray08 - , iconFg = gray01 - , inputIconFg = black - , inputBorder = gray02 - , inputFocusBorder = blue08 - , inputBgBasic = gray04 - , inputBgHover = gray06 - , inputBgFocus = gray05 - , inputBgActive = gray03 - , inputBgDisabled = gray07 - , inputFgBasic = gray06 - , inputFgHover = blue08 - , inputFgFocus = blue08 - , inputFgActive = blue07 - , inputFgDisabled = gray07 - , inputSndBasic = gray05 - , inputSndHover = gray06 - , inputSndFocus = gray05 - , inputSndActive = gray05 - , inputSndDisabled = gray03 - , inputHlBasic = gray07 - , inputHlHover = blue08 - , inputHlFocus = blue08 - , inputHlActive = blue08 - , inputHlDisabled = gray08 - , inputSelBasic = gray06 - , inputSelFocus = blue06 - , inputText = white - , inputTextDisabled = gray02 - , labelText = white - , scrollBarBasic = gray01 & L.a .~ 0.2 - , scrollThumbBasic = gray07 & L.a .~ 0.6 - , scrollBarHover = gray01 & L.a .~ 0.4 - , scrollThumbHover = gray07 & L.a .~ 0.8 - , slMainBg = gray00 - , slNormalBgBasic = transparent - , slNormalBgHover = gray05 - , slNormalText = white - , slNormalFocusBorder = blue08 - , slSelectedBgBasic = gray04 - , slSelectedBgHover = gray05 - , slSelectedText = white - , slSelectedFocusBorder = blue08 - , tooltipBorder = gray05 - , tooltipBg = rgbHex "#1D212B" - , tooltipText = white - } - -zgoThemeColors = - BaseThemeColors - { clearColor = gray10 -- gray12, - , sectionColor = gray09 -- gray11, - , btnFocusBorder = blue08 - , btnBgBasic = gray07 - , btnBgHover = gray07c - , btnBgFocus = gray07b - , btnBgActive = gray06 - , btnBgDisabled = gray05 - , btnText = gray02 - , btnTextDisabled = gray02 - , btnMainFocusBorder = blue09 - , btnMainBgBasic = btnColor - , btnMainBgHover = btnHiLite - , btnMainBgFocus = btnColor - , btnMainBgActive = btnHiLite - , btnMainBgDisabled = blue04 - , btnMainText = white - , btnMainTextDisabled = white - , dialogBg = white - , dialogBorder = white - , dialogText = black - , dialogTitleText = black - , emptyOverlay = gray07 & L.a .~ 0.8 - , shadow = gray00 & L.a .~ 0.2 - , externalLinkBasic = blue07 - , externalLinkHover = blue08 - , externalLinkFocus = blue07 - , externalLinkActive = blue06 - , externalLinkDisabled = gray06 - , iconBg = gray07 - , iconFg = gray01 - , inputIconFg = black - , inputBorder = gray06 - , inputFocusBorder = blue07 - , inputBgBasic = gray10 - , inputBgHover = white - , inputBgFocus = white - , inputBgActive = gray09 - , inputBgDisabled = gray05 - , inputFgBasic = gray05 - , inputFgHover = blue07 - , inputFgFocus = blue07 - , inputFgActive = blue06 - , inputFgDisabled = gray04 - , inputSndBasic = gray04 - , inputSndHover = gray05 - , inputSndFocus = gray05 - , inputSndActive = gray04 - , inputSndDisabled = gray03 - , inputHlBasic = gray06 - , inputHlHover = blue07 - , inputHlFocus = blue07 - , inputHlActive = blue06 - , inputHlDisabled = gray05 - , inputSelBasic = gray07 - , inputSelFocus = blue08 - , inputText = black - , inputTextDisabled = gray02 - , labelText = black - , scrollBarBasic = gray03 & L.a .~ 0.2 - , scrollThumbBasic = gray01 & L.a .~ 0.2 - , scrollBarHover = gray07 & L.a .~ 0.8 - , scrollThumbHover = gray05 & L.a .~ 0.8 - , slMainBg = white - , slNormalBgBasic = transparent - , slNormalBgHover = gray09 - , slNormalText = black - , slNormalFocusBorder = blue07 - , slSelectedBgBasic = gray08 - , slSelectedBgHover = gray09 - , slSelectedText = black - , slSelectedFocusBorder = blue07 - , tooltipBorder = gray08 - , tooltipBg = gray07 - , tooltipText = black - } - ---black = rgbHex "#000000" -{-white = rgbHex "#FFFFFF"-} -btnColor = rgbHex "#ff5722" --rgbHex "#1818B2" - -btnHiLite = rgbHex "#207DE8" - -blue01 = rgbHex "#002159" - -blue02 = rgbHex "#01337D" - -blue03 = rgbHex "#03449E" - -blue04 = rgbHex "#0552B5" - -blue05 = rgbHex "#0967D2" - -blue05b = rgbHex "#0F6BD7" - -blue05c = rgbHex "#1673DE" - -blue06 = rgbHex "#2186EB" - -blue06b = rgbHex "#2489EE" - -blue06c = rgbHex "#2B8FF6" - -blue07 = rgbHex "#47A3F3" - -blue07b = rgbHex "#50A6F6" - -blue07c = rgbHex "#57ACFC" - -blue08 = rgbHex "#7CC4FA" - -blue09 = rgbHex "#BAE3FF" - -blue10 = rgbHex "#E6F6FF" - -gray00 = rgbHex "#111111" - -gray01 = rgbHex "#2E2E2E" - -gray02 = rgbHex "#393939" - -gray03 = rgbHex "#515151" - -gray04 = rgbHex "#626262" - -gray05 = rgbHex "#7E7E7E" - -gray06 = rgbHex "#9E9E9E" - -gray07 = rgbHex "#B1B1B1" - -gray07b = rgbHex "#B4B4B4" - -gray07c = rgbHex "#BBBBBB" - -gray08 = rgbHex "#CFCFCF" - -gray09 = rgbHex "#E1E1E1" - -gray10 = rgbHex "#F7F7F7" diff --git a/src/Zenith/Scanner.hs b/src/Zenith/Scanner.hs index 09f7ccc..df47ed1 100644 --- a/src/Zenith/Scanner.hs +++ b/src/Zenith/Scanner.hs @@ -33,13 +33,7 @@ import ZcashHaskell.Types ) import ZcashHaskell.Utils (getBlockTime, makeZebraCall, readZebraTransaction) import Zenith.Core (checkBlockChain) -import Zenith.DB - ( getMaxBlock - , getUnconfirmedBlocks - , initDb - , saveConfs - , saveTransaction - ) +import Zenith.DB (getMaxBlock, initDb, saveTransaction) import Zenith.Utils (jsonNumber) -- | Function to scan the Zcash blockchain through the Zebra node and populate the Zenith database @@ -161,26 +155,3 @@ 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 diff --git a/src/Zenith/Types.hs b/src/Zenith/Types.hs index 6176c17..5526aa6 100644 --- a/src/Zenith/Types.hs +++ b/src/Zenith/Types.hs @@ -143,9 +143,7 @@ data ZcashPool | Sprout | Sapling | Orchard - deriving (Show, Read, Eq, Generic, ToJSON) - -derivePersistField "ZcashPool" + deriving (Show, Eq, Generic, ToJSON) instance FromJSON ZcashPool where parseJSON = diff --git a/src/Zenith/Utils.hs b/src/Zenith/Utils.hs index eedf02d..0f73fc9 100644 --- a/src/Zenith/Utils.hs +++ b/src/Zenith/Utils.hs @@ -5,24 +5,13 @@ 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 import System.Process (createProcess_, shell) import Text.Regex.Posix import ZcashHaskell.Orchard (encodeUnifiedAddress, isValidUnifiedAddress) -import ZcashHaskell.Sapling (decodeSaplingAddress, isValidShieldedAddress) -import ZcashHaskell.Transparent - ( decodeExchangeAddress - , decodeTransparentAddress - ) -import ZcashHaskell.Types - ( SaplingAddress(..) - , TransparentAddress(..) - , UnifiedAddress(..) - , ZcashNet(..) - ) +import ZcashHaskell.Sapling (isValidShieldedAddress) import Zenith.Types ( AddressGroup(..) , UnifiedAddressDB(..) @@ -50,12 +39,6 @@ displayTaz s | abs s < 100000000 = show (fromIntegral s / 100000) ++ " mTAZ" | otherwise = show (fromIntegral s / 100000000) ++ " TAZ" -displayAmount :: ZcashNet -> Integer -> T.Text -displayAmount n a = - if n == MainNet - then T.pack $ displayZec a - else T.pack $ displayTaz a - -- | Helper function to display abbreviated Unified Address showAddress :: UnifiedAddressDB -> T.Text showAddress u = T.take 20 t <> "..." @@ -89,34 +72,3 @@ copyAddress a = void $ createProcess_ "toClipboard" $ shell $ "echo " ++ T.unpack (addy a) ++ " | xclip -r -selection clipboard" - --- | 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 diff --git a/zcash-haskell b/zcash-haskell index e807441..90c8a7c 160000 --- a/zcash-haskell +++ b/zcash-haskell @@ -1 +1 @@ -Subproject commit e8074419cfb54559a4c09731ad2448d5930869a2 +Subproject commit 90c8a7c3028bd6836dea5655221277a25d457653 diff --git a/zenith.cabal b/zenith.cabal index 2aacd50..c7dedb1 100644 --- a/zenith.cabal +++ b/zenith.cabal @@ -1,6 +1,6 @@ cabal-version: 3.0 name: zenith -version: 0.6.0.0-beta +version: 0.5.3.0-beta license: MIT license-file: LICENSE author: Rene Vergara @@ -27,8 +27,6 @@ library ghc-options: -Wall -Wunused-imports exposed-modules: Zenith.CLI - Zenith.GUI - Zenith.GUI.Theme Zenith.Core Zenith.DB Zenith.Types @@ -46,16 +44,13 @@ library , base64-bytestring , brick , bytestring - , data-default - , directory - , filepath , esqueleto , resource-pool , binary , exceptions , monad-logger , vty-crossplatform - , secp256k1-haskell >= 1 + , secp256k1-haskell , pureMD5 , ghc , haskoin-core @@ -63,13 +58,9 @@ library , http-client , http-conduit , http-types - , JuicyPixels - , qrcode-core - , qrcode-juicypixels , microlens , microlens-mtl , microlens-th - , monomer , mtl , persistent , Hclip @@ -81,7 +72,6 @@ library , regex-posix , scientific , text - , text-show , time , vector , vty @@ -102,7 +92,7 @@ executable zenith , configurator , data-default , sort - --, structured-cli + , structured-cli , text , time , zenith