diff --git a/CHANGELOG.md b/CHANGELOG.md index a4a73d3..20fa1a2 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -5,6 +5,40 @@ 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 diff --git a/app/Main.hs b/app/Main.hs index 269ec1b..0b6a6f0 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -11,7 +11,8 @@ import Data.Sort import qualified Data.Text as T import qualified Data.Text.IO as TIO import Data.Time.Clock.POSIX -import System.Console.StructuredCLI + +{-import System.Console.StructuredCLI-} import System.Environment (getArgs) import System.Exit import System.IO @@ -19,10 +20,11 @@ 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 @@ -196,21 +198,22 @@ processUri user pwd = _ -> False _ <- liftIO $ sendWithUri user pwd (addList !! (idx - 1)) u repTo return NoAction +-} main :: IO () main = do - config <- load ["zenith.cfg"] + config <- load ["$(HOME)/Zenith/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 of - "legacy" -> do + case head args + {-"legacy" -> do checkServer nodeUser nodePwd void $ runCLI @@ -219,7 +222,9 @@ main = do { getBanner = " ______ _ _ _ \n |___ / (_) | | | \n / / ___ _ __ _| |_| |__ \n / / / _ \\ '_ \\| | __| '_ \\ \n / /_| __/ | | | | |_| | | |\n /_____\\___|_| |_|_|\\__|_| |_|\n Zcash Full Node CLI v0.4.0" } - (root nodeUser nodePwd) + (root nodeUser nodePwd) -} + of + "gui" -> runZenithGUI myConfig "tui" -> runZenithTUI myConfig "rescan" -> clearSync myConfig _ -> printUsage @@ -229,6 +234,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 new file mode 100644 index 0000000..ac48165 Binary files /dev/null and b/assets/1F616_color.png differ diff --git a/assets/1F928_color.png b/assets/1F928_color.png new file mode 100644 index 0000000..10095c0 Binary files /dev/null and b/assets/1F928_color.png differ diff --git a/assets/1F993.png b/assets/1F993.png new file mode 100644 index 0000000..290f365 Binary files /dev/null and b/assets/1F993.png differ diff --git a/assets/2620_color.png b/assets/2620_color.png new file mode 100644 index 0000000..ecfdc10 Binary files /dev/null and b/assets/2620_color.png differ diff --git a/assets/Atkinson-Hyperlegible-Bold-102.ttf b/assets/Atkinson-Hyperlegible-Bold-102.ttf new file mode 100644 index 0000000..14b7196 Binary files /dev/null and b/assets/Atkinson-Hyperlegible-Bold-102.ttf differ diff --git a/assets/Atkinson-Hyperlegible-BoldItalic-102.ttf b/assets/Atkinson-Hyperlegible-BoldItalic-102.ttf new file mode 100644 index 0000000..4532705 Binary files /dev/null and b/assets/Atkinson-Hyperlegible-BoldItalic-102.ttf differ diff --git a/assets/Atkinson-Hyperlegible-Font-License-2020-1104.pdf b/assets/Atkinson-Hyperlegible-Font-License-2020-1104.pdf new file mode 100644 index 0000000..afe27dc Binary files /dev/null and b/assets/Atkinson-Hyperlegible-Font-License-2020-1104.pdf differ diff --git a/assets/Atkinson-Hyperlegible-Italic-102.ttf b/assets/Atkinson-Hyperlegible-Italic-102.ttf new file mode 100644 index 0000000..89e5ce4 Binary files /dev/null and b/assets/Atkinson-Hyperlegible-Italic-102.ttf differ diff --git a/assets/Atkinson-Hyperlegible-Regular-102.ttf b/assets/Atkinson-Hyperlegible-Regular-102.ttf new file mode 100644 index 0000000..c4fa6fb Binary files /dev/null and b/assets/Atkinson-Hyperlegible-Regular-102.ttf differ diff --git a/assets/DejaVuSansMono-Bold.ttf b/assets/DejaVuSansMono-Bold.ttf new file mode 100644 index 0000000..b210eb5 Binary files /dev/null and b/assets/DejaVuSansMono-Bold.ttf differ diff --git a/assets/DejaVuSansMono-BoldOblique.ttf b/assets/DejaVuSansMono-BoldOblique.ttf new file mode 100644 index 0000000..3211064 Binary files /dev/null and b/assets/DejaVuSansMono-BoldOblique.ttf differ diff --git a/assets/DejaVuSansMono-Oblique.ttf b/assets/DejaVuSansMono-Oblique.ttf new file mode 100644 index 0000000..ff83b15 Binary files /dev/null and b/assets/DejaVuSansMono-Oblique.ttf differ diff --git a/assets/DejaVuSansMono.ttf b/assets/DejaVuSansMono.ttf new file mode 100644 index 0000000..041cffc Binary files /dev/null and b/assets/DejaVuSansMono.ttf differ diff --git a/assets/OpenMoji-color-glyf_colr_1.ttf b/assets/OpenMoji-color-glyf_colr_1.ttf new file mode 100644 index 0000000..86cf85b Binary files /dev/null and b/assets/OpenMoji-color-glyf_colr_1.ttf differ diff --git a/assets/Roboto-Regular.ttf b/assets/Roboto-Regular.ttf new file mode 100644 index 0000000..8c082c8 Binary files /dev/null and b/assets/Roboto-Regular.ttf differ diff --git a/assets/remixicon.ttf b/assets/remixicon.ttf new file mode 100644 index 0000000..22ce6de Binary files /dev/null and b/assets/remixicon.ttf differ diff --git a/cabal.project b/cabal.project index 217198a..d245ac1 100644 --- a/cabal.project +++ b/cabal.project @@ -2,7 +2,7 @@ packages: ./*.cabal zcash-haskell/zcash-haskell.cabal -with-compiler: ghc-9.4.8 +with-compiler: ghc-9.6.5 source-repository-package type: git diff --git a/cabal.project.freeze b/cabal.project.freeze index 3b9c8d2..175cc2c 100644 --- a/cabal.project.freeze +++ b/cabal.project.freeze @@ -1,38 +1,49 @@ active-repositories: hackage.haskell.org:merge -constraints: any.Cabal ==3.8.1.0, - any.Cabal-syntax ==3.8.1.0, +constraints: any.Cabal ==3.10.3.0, + any.Cabal-syntax ==3.10.3.0, any.Clipboard ==2.3.2.0, any.HUnit ==1.6.2.0, any.Hclip ==3.0.0.4, - any.OneTuple ==0.4.1.1, + any.JuicyPixels ==3.3.9, + JuicyPixels -mmap, + any.OneTuple ==0.4.2, + any.OpenGLRaw ==3.3.4.1, + OpenGLRaw -osandroid +usegles2 +useglxgetprocaddress +usenativewindowslibraries, 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.aeson ==2.2.1.0, + any.adjunctions ==4.4.2, + any.aeson ==2.2.3.0, aeson +ordered-keymap, any.alex ==3.5.1.0, - any.ansi-terminal ==1.1, + any.ansi-terminal ==1.1.1, ansi-terminal -example, any.ansi-terminal-types ==1.1, any.appar ==0.1.8, - any.array ==0.5.4.0, + any.array ==0.5.6.0, any.ascii-progress ==0.3.3.0, ascii-progress -examples, any.asn1-encoding ==0.9.6, any.asn1-parse ==0.9.5, any.asn1-types ==0.3.4, - any.assoc ==1.1, - assoc +tagged, + any.assoc ==1.1.1, + assoc -tagged, any.async ==2.2.5, async -bench, any.attoparsec ==0.14.4, attoparsec -developer, - any.attoparsec-aeson ==2.2.0.1, - any.auto-update ==0.1.6, - any.base ==4.17.2.1, - any.base-orphans ==0.9.1, + 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.base16 ==1.0, any.base16-bytestring ==1.0.2.0, any.base58-bytestring ==0.1.0, @@ -42,30 +53,37 @@ constraints: any.Cabal ==3.8.1.0, bifunctors +tagged, any.bimap ==0.5.0, any.binary ==0.8.9.1, - any.binary-orphans ==1.0.4.1, + any.binary-orphans ==1.0.5, any.bitvec ==1.1.5.0, bitvec +simd, any.blaze-builder ==0.4.2.3, any.blaze-html ==0.9.2.0, any.blaze-markup ==0.8.3.0, any.borsh ==0.3.0, - any.brick ==2.3.1, + any.brick ==2.4, brick -demos, any.byteorder ==1.0.4, any.bytes ==0.17.3, 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.20, + any.concurrent-output ==1.10.21, any.conduit ==1.3.5, any.conduit-extra ==1.3.6, any.config-ini ==0.2.7.0, @@ -75,13 +93,14 @@ constraints: any.Cabal ==3.8.1.0, any.containers ==0.6.7, any.contravariant ==1.5.5, contravariant +semigroups +statevar +tagged, - any.cookie ==0.4.6, + any.cookie ==0.5.0, any.crypto-api ==0.13.3, crypto-api -all_cpolys, - any.crypton ==0.34, + any.crypto-pubkey-types ==0.4.3, + any.crypton ==1.0.0, crypton -check_alignment +integer-gmp -old_toolchain_inliner +support_aesni +support_deepseq +support_pclmuldq +support_rdrand -support_sse +use_target_attributes, - any.crypton-connection ==0.3.2, - any.crypton-x509 ==1.7.6, + any.crypton-connection ==0.4.1, + any.crypton-x509 ==1.7.7, any.crypton-x509-store ==1.6.9, any.crypton-x509-system ==1.6.7, any.crypton-x509-validation ==1.6.12, @@ -93,50 +112,57 @@ constraints: any.Cabal ==3.8.1.0, any.data-default-instances-containers ==0.0.1, any.data-default-instances-dlist ==0.0.1, any.data-default-instances-old-locale ==0.0.1, - any.data-fix ==0.3.2, - any.deepseq ==1.4.8.0, - any.directory ==1.3.7.1, + any.data-fix ==0.3.4, + any.deepseq ==1.4.8.1, + any.directory ==1.3.8.4, any.distributive ==0.6.2.1, distributive +semigroups +tagged, any.dlist ==1.0, 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.5, - any.fast-logger ==3.2.2, - any.filepath ==1.4.2.2, - any.foldable1-classes-compat ==0.1, - foldable1-classes-compat +tagged, + 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.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.4.8, + any.ghc ==9.6.5, any.ghc-bignum ==1.3, - any.ghc-boot ==9.4.8, - any.ghc-boot-th ==9.4.8, - any.ghc-heap ==9.4.8, - any.ghc-prim ==0.9.1, - any.ghci ==9.4.8, + any.ghc-boot ==9.6.5, + any.ghc-boot-th ==9.6.5, + any.ghc-heap ==9.6.5, + any.ghc-prim ==0.10.0, + any.ghci ==9.6.5, any.half ==0.3.1, any.happy ==1.20.1.1, - any.hashable ==1.4.4.0, - hashable +integer-gmp -random-initial-seed, - any.haskeline ==0.8.2, + any.hashable ==1.4.7.0, + hashable -arch-native +integer-gmp -random-initial-seed, any.haskell-lexer ==1.1.1, any.haskoin-core ==1.1.0, any.hexstring ==0.12.1.0, any.hourglass ==0.2.12, - any.hpc ==0.6.1.0, + any.hpc ==0.6.2.0, any.hsc2hs ==0.68.10, hsc2hs -in-ghc-tree, - any.hspec ==2.11.7, - any.hspec-core ==2.11.7, - any.hspec-discover ==2.11.7, + any.hspec ==2.11.9, + any.hspec-core ==2.11.9, + any.hspec-discover ==2.11.9, any.hspec-expectations ==0.8.4, - any.http-api-data ==0.6, + any.http-api-data ==0.6.1, http-api-data -use-text-show, any.http-client ==0.7.17, http-client +network-uri, @@ -144,24 +170,31 @@ constraints: any.Cabal ==3.8.1.0, any.http-conduit ==2.3.8.3, http-conduit +aeson, any.http-types ==0.12.4, - any.indexed-traversable ==0.1.3, - any.indexed-traversable-instances ==0.1.1.2, - any.integer-conversion ==0.1.0.1, + any.indexed-traversable ==0.1.4, + any.indexed-traversable-instances ==0.1.2, + any.integer-conversion ==0.1.1, any.integer-gmp ==1.1, any.integer-logarithms ==1.0.3.1, integer-logarithms -check-bounds +integer-gmp, + any.invariant ==0.6.3, any.iproute ==1.7.12, + any.kan-extensions ==5.2.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.14, + any.microlens-th ==0.4.3.15, any.mime-types ==0.1.2.0, any.monad-control ==1.0.3.1, any.monad-logger ==0.3.40, @@ -169,14 +202,19 @@ constraints: any.Cabal ==3.8.1.0, any.monad-loops ==0.4.3, monad-loops +base4, any.mono-traversable ==1.0.17.0, - any.mtl ==2.2.2, + any.monomer ==1.6.0.1, + monomer -examples, + any.mtl ==2.3.1, any.murmur3 ==1.0.5, - any.network ==3.1.4.0, + any.nanovg ==0.8.1.0, + nanovg -examples -gl2 -gles3 -stb_truetype, + any.network ==3.2.1.0, network -devel, any.network-uri ==2.6.4.2, any.old-locale ==1.0.0.7, any.old-time ==1.1.0.4, - any.os-string ==2.0.2, + any.os-string ==2.0.6, + any.parallel ==3.2.2.0, any.parsec ==3.1.16.1, any.parser-combinators ==1.3.0, parser-combinators -dev, @@ -188,12 +226,18 @@ constraints: any.Cabal ==3.8.1.0, any.persistent-template ==2.12.0.0, any.pretty ==1.1.3.6, any.primitive ==0.9.0.0, - any.process ==1.6.18.0, + any.process ==1.6.19.0, + any.profunctors ==5.6.2, + any.psqueues ==0.2.8.0, any.pureMD5 ==2.1.4, 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, @@ -203,13 +247,17 @@ constraints: any.Cabal ==3.8.1.0, any.rts ==1.0.2, any.safe ==0.3.21, any.safe-exceptions ==0.1.7.4, - any.scientific ==0.3.7.0, - scientific -bytestring-builder -integer-simple, + any.scientific ==0.3.8.0, + scientific -integer-simple, + any.sdl2 ==2.5.5.0, + sdl2 -examples -no-linear -opengl-example +pkgconfig +recent-ish, any.secp256k1-haskell ==1.2.0, - any.semialign ==1.3, + any.semialign ==1.3.1, semialign +semigroupoids, - any.semigroupoids ==6.0.0.1, + any.semigroupoids ==6.0.1, semigroupoids +comonad +containers +contravariant +distributive +tagged +unordered-containers, + any.semigroups ==0.20, + semigroups +binary +bytestring -bytestring-builder +containers +deepseq +hashable +tagged +template-haskell +text +transformers +unordered-containers, any.serialise ==0.2.6.1, serialise +newtime15, any.silently ==1.2.5.3, @@ -223,52 +271,53 @@ constraints: any.Cabal ==3.8.1.0, any.stm-chans ==3.0.0.9, any.streaming-commons ==0.2.2.6, streaming-commons -use-bytestring-builder, - any.strict ==0.5, + any.strict ==0.5.1, any.string-conversions ==0.4.0.1, - any.structured-cli ==2.7.0.1, - structured-cli -debug, + any.system-cxx-std-lib ==1.0, any.tagged ==0.8.8, tagged +deepseq +transformers, - any.template-haskell ==2.19.0.0, + any.template-haskell ==2.20.0.0, any.terminal-size ==0.3.4, - any.terminfo ==0.4.1.5, + any.terminfo ==0.4.1.6, any.text ==2.0.2, - any.text-iso8601 ==0.1, - any.text-short ==0.1.5, + any.text-iso8601 ==0.1.1, + any.text-short ==0.1.6, text-short -asserts, + any.text-show ==3.10.5, + text-show +base-4-9 +integer-gmp +new-functor-classes +template-haskell-2-11, any.text-zipper ==0.13, any.tf-random ==0.5, - any.th-abstraction ==0.6.0.0, + any.th-abstraction ==0.7.0.0, any.th-compat ==0.1.5, any.th-lift ==0.8.4, any.th-lift-instances ==0.1.20, - any.these ==1.2, + any.these ==1.2.1, any.time ==1.12.2, - any.time-compat ==1.9.6.1, - time-compat -old-locale, - any.tls ==2.0.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, tls -devel, - any.transformers ==0.5.6.2, + any.transformers ==0.6.1.0, any.transformers-base ==0.4.6, transformers-base +orphaninstances, any.transformers-compat ==0.7.2, transformers-compat -five +five-three -four +generic-deriving +mtl -three -two, any.typed-process ==0.2.11.1, - any.unix ==2.7.3, - any.unix-compat ==0.7.1, - unix-compat -old-time, - any.unix-time ==0.4.12, + any.unix ==2.8.4.0, + any.unix-compat ==0.7.2, + any.unix-time ==0.4.15, any.unliftio ==0.2.25.0, any.unliftio-core ==0.2.1.0, any.unordered-containers ==0.2.20, unordered-containers -debug, any.utf8-string ==1.0.2, - any.uuid-types ==1.0.5.1, + any.uuid-types ==1.0.6, any.vault ==0.3.1.5, vault +useghc, any.vector ==0.13.1.0, vector +boundschecks -internalchecks -unsafechecks -wall, - any.vector-algorithms ==0.9.0.1, + any.vector-algorithms ==0.9.0.2, vector-algorithms +bench +boundschecks -internalchecks -llvm +properties -unsafechecks, any.vector-stream ==0.1.0.1, any.void ==0.7.3, @@ -278,8 +327,10 @@ constraints: any.Cabal ==3.8.1.0, vty-crossplatform -demos, any.vty-unix ==0.2.0.0, any.wide-word ==0.1.6.0, - any.witherable ==0.4.2, + any.witherable ==0.5, any.word-wrap ==0.5, - any.zlib ==0.7.0.0, + any.wreq ==0.5.4.3, + wreq -aws -developer +doctest -httpbin, + any.zlib ==0.7.1.0, zlib -bundled-c-zlib +non-blocking-ffi +pkg-config -index-state: hackage.haskell.org 2024-04-07T10:14:52Z +index-state: hackage.haskell.org 2024-07-10T18:40:26Z diff --git a/configure b/configure index df9fc8d..25686c1 100755 --- a/configure +++ b/configure @@ -1,6 +1,17 @@ #!/bin/bash - -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 +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" source ~/.bashrc +echo "... building zcash-haskell" cd zcash-haskell && cabal build +echo +echo "Done" +echo diff --git a/install b/install new file mode 100755 index 0000000..2dc2023 --- /dev/null +++ b/install @@ -0,0 +1,5 @@ +#!/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 830a1d7..b10b7e0 100644 --- a/src/Zenith/CLI.hs +++ b/src/Zenith/CLI.hs @@ -27,7 +27,7 @@ import Brick.Forms import qualified Brick.Main as M import qualified Brick.Types as BT import Brick.Types (Widget) -import Brick.Util (bg, clamp, fg, on, style) +import Brick.Util (bg, fg, on, style) import qualified Brick.Widgets.Border as B import Brick.Widgets.Border.Style (unicode, unicodeBold) import qualified Brick.Widgets.Center as C @@ -88,22 +88,29 @@ import ZcashHaskell.Keys (generateWalletSeedPhrase, getWalletSeed) import ZcashHaskell.Orchard (getSaplingFromUA, isValidUnifiedAddress) import ZcashHaskell.Sapling (decodeSaplingAddress, isValidShieldedAddress) import ZcashHaskell.Transparent - ( decodeExchangeAddress - , decodeTransparentAddress + ( decodeTransparentAddress , encodeTransparentReceiver ) import ZcashHaskell.Types import ZcashHaskell.Utils (getBlockTime, makeZebraCall) import Zenith.Core import Zenith.DB -import Zenith.Scanner (processTx) +import Zenith.Scanner (processTx, updateConfs) import Zenith.Types ( Config(..) , PhraseDB(..) , UnifiedAddressDB(..) , ZcashNetDB(..) ) -import Zenith.Utils (displayTaz, displayZec, jsonNumber, showAddress) +import Zenith.Utils + ( displayTaz + , displayZec + , isRecipientValid + , jsonNumber + , parseAddress + , showAddress + , validBarValue + ) data Name = WList @@ -198,6 +205,7 @@ data State = State , _abForm :: !(Form AdrBookEntry () Name) , _abCurAdrs :: !T.Text -- used for address book CRUD operations , _sentTx :: !(Maybe HexString) + , _unconfBalance :: !Integer } makeLenses ''State @@ -234,7 +242,13 @@ drawUI s = [splashDialog s, helpDialog s, displayDialog s, inputDialog s, ui s] if st ^. network == MainNet then displayZec (st ^. balance) else displayTaz (st ^. balance))) <=> - listAddressBox " Addresses " (st ^. addresses) <+> + C.hCenter + (str + ("Unconf: " ++ + if st ^. network == MainNet + then displayZec (st ^. unconfBalance) + else displayTaz (st ^. unconfBalance))) <=> + listAddressBox "Addresses" (st ^. addresses) <+> B.vBorder <+> (C.hCenter (str ("Last block seen: " ++ show (st ^. syncBlock) ++ "\n")) <=> @@ -436,7 +450,7 @@ drawUI s = [splashDialog s, helpDialog s, displayDialog s, inputDialog s, ui s] (str " _____ _ _ _ \n|__ /___ _ __ (_) |_| |__\n / // _ \\ '_ \\| | __| '_ \\\n / /| __/ | | | | |_| | | |\n/____\\___|_| |_|_|\\__|_| |_|") <=> C.hCenter - (withAttr titleAttr (str "Zcash Wallet v0.5.3.1-beta")) <=> + (withAttr titleAttr (str "Zcash Wallet v0.6.0.0-beta")) <=> C.hCenter (withAttr blinkAttr $ str "Press any key...")) else emptyWidget capCommand3 :: String -> String -> String -> Widget Name @@ -603,7 +617,7 @@ mkSendForm bal = ] where isAmountValid :: Integer -> Float -> Bool - isAmountValid b i = (fromIntegral b * 100000000.0) >= i && i > 0 + isAmountValid b i = (fromIntegral b / 100000000.0) >= i label s w = padBottom (Pad 1) $ vLimit 1 (hLimit 15 $ str s <+> fill ' ') <+> w @@ -617,19 +631,6 @@ mkNewABForm = label s w = padBottom (Pad 1) $ vLimit 1 (hLimit 10 $ str s <+> fill ' ') <+> w -isRecipientValid :: T.Text -> Bool -isRecipientValid a = - case isValidUnifiedAddress (E.encodeUtf8 a) of - Just _a1 -> True - Nothing -> - isValidShieldedAddress (E.encodeUtf8 a) || - (case decodeTransparentAddress (E.encodeUtf8 a) of - Just _a3 -> True - Nothing -> - case decodeExchangeAddress a of - Just _a4 -> True - Nothing -> False) - listDrawElement :: (Show a) => Bool -> a -> Widget Name listDrawElement sel a = let selStr s = @@ -721,27 +722,32 @@ abSelAttr = A.attrName "abselected" abMBarAttr :: A.AttrName abMBarAttr = A.attrName "menubar" -validBarValue :: Float -> Float -validBarValue = clamp 0 1 - scanZebra :: T.Text -> T.Text -> Int -> Int -> BC.BChan Tick -> IO () scanZebra dbP zHost zPort b eChan = do _ <- liftIO $ initDb dbP bStatus <- liftIO $ checkBlockChain zHost zPort pool <- runNoLoggingT $ initPool dbP dbBlock <- runNoLoggingT $ getMaxBlock pool - let sb = max dbBlock b - if sb > zgb_blocks bStatus || sb < 1 - then liftIO $ - BC.writeBChan eChan $ TickMsg "Invalid starting block for scan" - else do - let bList = [(sb + 1) .. (zgb_blocks bStatus)] - if not (null bList) + confUp <- try $ updateConfs zHost zPort pool :: IO (Either IOError ()) + case confUp of + Left _e0 -> + liftIO $ + BC.writeBChan eChan $ TickMsg "Failed to update unconfirmed transactions" + Right _ -> do + let sb = max dbBlock b + if sb > zgb_blocks bStatus || sb < 1 then do - let step = - (1.0 :: Float) / fromIntegral (zgb_blocks bStatus - (sb + 1)) - mapM_ (processBlock pool step) bList - else liftIO $ BC.writeBChan eChan $ TickVal 1.0 + liftIO $ + BC.writeBChan eChan $ TickMsg "Invalid starting block for scan" + else do + let bList = [(sb + 1) .. (zgb_blocks bStatus)] + if not (null bList) + then do + let step = + (1.0 :: Float) / + fromIntegral (zgb_blocks bStatus - (sb + 1)) + mapM_ (processBlock pool step) bList + else liftIO $ BC.writeBChan eChan $ TickVal 1.0 where processBlock :: ConnectionPool -> Float -> Int -> IO () processBlock pool step bl = do @@ -1380,6 +1386,10 @@ runZenithTUI config = do 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 $ @@ -1420,6 +1430,7 @@ runZenithTUI config = do (mkNewABForm (AdrBookEntry "" "")) "" Nothing + uBal Left e -> do print $ "No Zebra node available on port " <> @@ -1448,6 +1459,10 @@ refreshWallet s = do if not (null aL) then getBalance pool $ entityKey $ head aL else return 0 + uBal <- + if not (null aL) + then getUnconfirmedBalance pool $ entityKey $ head aL + else return 0 txL <- if not (null addrL) then getUserTx pool $ entityKey $ head addrL @@ -1458,6 +1473,8 @@ refreshWallet s = do let txL' = L.listReplace (Vec.fromList txL) (Just 0) (s ^. transactions) return $ s & wallets .~ wL & accounts .~ aL' & syncBlock .~ bl & balance .~ bal & + unconfBalance .~ + uBal & addresses .~ addrL' & transactions .~ @@ -1526,6 +1543,7 @@ refreshAccount s = do Just (_k, w) -> return w aL <- runNoLoggingT $ getAddresses pool $ entityKey selAccount bal <- getBalance pool $ entityKey selAccount + uBal <- getUnconfirmedBalance pool $ entityKey selAccount let aL' = L.listReplace (Vec.fromList aL) (Just 0) (s ^. addresses) selAddress <- do case L.listSelectedElement aL' of @@ -1536,13 +1554,17 @@ refreshAccount s = do case selAddress of Nothing -> return $ - s & balance .~ bal & addresses .~ aL' & msg .~ "Switched to account: " ++ + s & balance .~ bal & unconfBalance .~ uBal & addresses .~ aL' & msg .~ + "Switched to account: " ++ T.unpack (zcashAccountName $ entityVal selAccount) Just (_i, a) -> do tList <- getUserTx pool $ entityKey a let tL' = L.listReplace (Vec.fromList tList) (Just 0) (s ^. transactions) return $ - s & balance .~ bal & addresses .~ aL' & transactions .~ tL' & msg .~ + s & balance .~ bal & unconfBalance .~ uBal & addresses .~ aL' & + transactions .~ + tL' & + msg .~ "Switched to account: " ++ T.unpack (zcashAccountName $ entityVal selAccount) @@ -1625,36 +1647,22 @@ sendTransaction :: -> IO () sendTransaction pool chan zHost zPort znet accId bl amt ua memo = do BC.writeBChan chan $ TickMsg "Preparing transaction..." - 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" + 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 diff --git a/src/Zenith/DB.hs b/src/Zenith/DB.hs index 8f9eef1..aea3c5a 100644 --- a/src/Zenith/DB.hs +++ b/src/Zenith/DB.hs @@ -32,7 +32,6 @@ import qualified Data.Text as T import qualified Data.Text.Encoding as TE import Data.Word import Database.Esqueleto.Experimental -import qualified Database.Persist as P import qualified Database.Persist.Sqlite as PS import Database.Persist.TH import Haskoin.Transaction.Common @@ -43,7 +42,6 @@ import Haskoin.Transaction.Common ) import qualified Lens.Micro as ML ((&), (.~), (^.)) import ZcashHaskell.Orchard (isValidUnifiedAddress) -import ZcashHaskell.Sapling (decodeSaplingOutputEsk) import ZcashHaskell.Types ( DecodedNote(..) , OrchardAction(..) @@ -77,6 +75,7 @@ import Zenith.Types , TransparentSpendingKeyDB , UnifiedAddressDB(..) , ZcashNetDB(..) + , ZcashPool(..) ) share @@ -246,6 +245,15 @@ 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 @@ -422,6 +430,16 @@ 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 @@ -554,6 +572,41 @@ 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 :: @@ -1343,6 +1396,35 @@ getBalance pool za = do let oBal = sum oAmts return . fromIntegral $ tBal + sBal + oBal +getTransparentBalance :: ConnectionPool -> ZcashAccountId -> IO Integer +getTransparentBalance pool za = do + trNotes <- getWalletUnspentTrNotes pool za + let tAmts = map (walletTrNoteValue . entityVal) trNotes + return . fromIntegral $ sum tAmts + +getShieldedBalance :: ConnectionPool -> ZcashAccountId -> IO Integer +getShieldedBalance pool za = do + sapNotes <- getWalletUnspentSapNotes pool za + let sAmts = map (walletSapNoteValue . entityVal) sapNotes + let sBal = sum sAmts + orchNotes <- getWalletUnspentOrchNotes pool za + let oAmts = map (walletOrchNoteValue . entityVal) orchNotes + let oBal = sum oAmts + return . fromIntegral $ sBal + oBal + +getUnconfirmedBalance :: ConnectionPool -> ZcashAccountId -> IO Integer +getUnconfirmedBalance pool za = do + trNotes <- getWalletUnspentUnconfirmedTrNotes pool za + let tAmts = map (walletTrNoteValue . entityVal) trNotes + let tBal = sum tAmts + sapNotes <- getWalletUnspentUnconfirmedSapNotes pool za + let sAmts = map (walletSapNoteValue . entityVal) sapNotes + let sBal = sum sAmts + orchNotes <- getWalletUnspentUnconfirmedOrchNotes pool za + let oAmts = map (walletOrchNoteValue . entityVal) orchNotes + let oBal = sum oAmts + return . fromIntegral $ tBal + sBal + oBal + clearWalletTransactions :: ConnectionPool -> IO () clearWalletTransactions pool = do runNoLoggingT $ @@ -1380,10 +1462,42 @@ getWalletUnspentTrNotes pool za = do PS.retryOnBusy $ flip PS.runSqlPool pool $ do select $ do - n <- from $ table @WalletTrNote - where_ (n ^. WalletTrNoteAccId ==. val za) - where_ (n ^. WalletTrNoteSpent ==. val False) - pure n + (txs :& tNotes) <- + from $ table @WalletTransaction `innerJoin` table @WalletTrNote `on` + (\(txs :& tNotes) -> + txs ^. WalletTransactionId ==. tNotes ^. WalletTrNoteTx) + where_ (tNotes ^. WalletTrNoteAccId ==. val za) + where_ (tNotes ^. WalletTrNoteSpent ==. val False) + where_ + ((tNotes ^. WalletTrNoteChange ==. val True &&. txs ^. + WalletTransactionConf >=. + val 3) ||. + (tNotes ^. WalletTrNoteChange ==. val False &&. txs ^. + WalletTransactionConf >=. + val 10)) + pure tNotes + +getWalletUnspentUnconfirmedTrNotes :: + ConnectionPool -> ZcashAccountId -> IO [Entity WalletTrNote] +getWalletUnspentUnconfirmedTrNotes pool za = do + runNoLoggingT $ + PS.retryOnBusy $ + flip PS.runSqlPool pool $ do + select $ do + (txs :& tNotes) <- + from $ table @WalletTransaction `innerJoin` table @WalletTrNote `on` + (\(txs :& tNotes) -> + txs ^. WalletTransactionId ==. tNotes ^. WalletTrNoteTx) + where_ (tNotes ^. WalletTrNoteAccId ==. val za) + where_ (tNotes ^. WalletTrNoteSpent ==. val False) + where_ + ((tNotes ^. WalletTrNoteChange ==. val True &&. txs ^. + WalletTransactionConf <. + val 3) ||. + (tNotes ^. WalletTrNoteChange ==. val False &&. txs ^. + WalletTransactionConf <. + val 10)) + pure tNotes getWalletUnspentSapNotes :: ConnectionPool -> ZcashAccountId -> IO [Entity WalletSapNote] @@ -1392,10 +1506,42 @@ getWalletUnspentSapNotes pool za = do PS.retryOnBusy $ flip PS.runSqlPool pool $ do select $ do - n1 <- from $ table @WalletSapNote - where_ (n1 ^. WalletSapNoteAccId ==. val za) - where_ (n1 ^. WalletSapNoteSpent ==. val False) - pure n1 + (txs :& sNotes) <- + from $ table @WalletTransaction `innerJoin` table @WalletSapNote `on` + (\(txs :& sNotes) -> + txs ^. WalletTransactionId ==. sNotes ^. WalletSapNoteTx) + where_ (sNotes ^. WalletSapNoteAccId ==. val za) + where_ (sNotes ^. WalletSapNoteSpent ==. val False) + where_ + ((sNotes ^. WalletSapNoteChange ==. val True &&. txs ^. + WalletTransactionConf >=. + val 3) ||. + (sNotes ^. WalletSapNoteChange ==. val False &&. txs ^. + WalletTransactionConf >=. + val 10)) + pure sNotes + +getWalletUnspentUnconfirmedSapNotes :: + ConnectionPool -> ZcashAccountId -> IO [Entity WalletSapNote] +getWalletUnspentUnconfirmedSapNotes pool za = do + runNoLoggingT $ + PS.retryOnBusy $ + flip PS.runSqlPool pool $ do + select $ do + (txs :& sNotes) <- + from $ table @WalletTransaction `innerJoin` table @WalletSapNote `on` + (\(txs :& sNotes) -> + txs ^. WalletTransactionId ==. sNotes ^. WalletSapNoteTx) + where_ (sNotes ^. WalletSapNoteAccId ==. val za) + where_ (sNotes ^. WalletSapNoteSpent ==. val False) + where_ + ((sNotes ^. WalletSapNoteChange ==. val True &&. txs ^. + WalletTransactionConf <. + val 3) ||. + (sNotes ^. WalletSapNoteChange ==. val False &&. txs ^. + WalletTransactionConf <. + val 10)) + pure sNotes getWalletUnspentOrchNotes :: ConnectionPool -> ZcashAccountId -> IO [Entity WalletOrchNote] @@ -1404,10 +1550,42 @@ getWalletUnspentOrchNotes pool za = do PS.retryOnBusy $ flip PS.runSqlPool pool $ do select $ do - n2 <- from $ table @WalletOrchNote - where_ (n2 ^. WalletOrchNoteAccId ==. val za) - where_ (n2 ^. WalletOrchNoteSpent ==. val False) - pure n2 + (txs :& oNotes) <- + from $ table @WalletTransaction `innerJoin` table @WalletOrchNote `on` + (\(txs :& oNotes) -> + txs ^. WalletTransactionId ==. oNotes ^. WalletOrchNoteTx) + where_ (oNotes ^. WalletOrchNoteAccId ==. val za) + where_ (oNotes ^. WalletOrchNoteSpent ==. val False) + where_ + ((oNotes ^. WalletOrchNoteChange ==. val True &&. txs ^. + WalletTransactionConf >=. + val 3) ||. + (oNotes ^. WalletOrchNoteChange ==. val False &&. txs ^. + WalletTransactionConf >=. + val 10)) + pure oNotes + +getWalletUnspentUnconfirmedOrchNotes :: + ConnectionPool -> ZcashAccountId -> IO [Entity WalletOrchNote] +getWalletUnspentUnconfirmedOrchNotes pool za = do + runNoLoggingT $ + PS.retryOnBusy $ + flip PS.runSqlPool pool $ do + select $ do + (txs :& oNotes) <- + from $ table @WalletTransaction `innerJoin` table @WalletOrchNote `on` + (\(txs :& oNotes) -> + txs ^. WalletTransactionId ==. oNotes ^. WalletOrchNoteTx) + where_ (oNotes ^. WalletOrchNoteAccId ==. val za) + where_ (oNotes ^. WalletOrchNoteSpent ==. val False) + where_ + ((oNotes ^. WalletOrchNoteChange ==. val True &&. txs ^. + WalletTransactionConf <. + val 3) ||. + (oNotes ^. WalletOrchNoteChange ==. val False &&. txs ^. + WalletTransactionConf <. + val 10)) + pure oNotes selectUnspentNotes :: ConnectionPool @@ -1468,6 +1646,27 @@ getWalletTxId pool wId = do where_ (wtx ^. WalletTransactionId ==. val wId) pure $ wtx ^. WalletTransactionTxId +getUnconfirmedBlocks :: ConnectionPool -> IO [Int] +getUnconfirmedBlocks pool = do + r <- + runNoLoggingT $ + PS.retryOnBusy $ + flip PS.runSqlPool pool $ do + select $ do + wtx <- from $ table @WalletTransaction + where_ (wtx ^. WalletTransactionConf <=. val 10) + pure $ wtx ^. WalletTransactionBlock + return $ map (\(Value i) -> i) r + +saveConfs :: ConnectionPool -> Int -> Int -> IO () +saveConfs pool b c = do + runNoLoggingT $ + PS.retryOnBusy $ + flip PS.runSqlPool pool $ do + update $ \t -> do + set t [WalletTransactionConf =. val c] + where_ $ t ^. WalletTransactionBlock ==. val b + -- | Helper function to extract a Unified Address from the database readUnifiedAddressDB :: WalletAddress -> Maybe UnifiedAddress readUnifiedAddressDB = @@ -1513,7 +1712,6 @@ updateAdrsInAdrBook pool d a ia = do -- adrbook <- from $ table @AddressBook -- where_ ((adrbook ^. AddressBookAbaddress) ==. val a) -- return adrbook - -- | delete an existing address from AddressBook deleteAdrsFromAB :: ConnectionPool -> T.Text -> IO () deleteAdrsFromAB pool ia = do @@ -1522,7 +1720,7 @@ deleteAdrsFromAB pool ia = do flip PS.runSqlPool pool $ do delete $ do ab <- from $ table @AddressBook - where_ (ab ^. AddressBookAbaddress ==. val ia) + where_ (ab ^. AddressBookAbaddress ==. val ia) rmdups :: Ord a => [a] -> [a] rmdups = map head . group . sort diff --git a/src/Zenith/GUI.hs b/src/Zenith/GUI.hs new file mode 100644 index 0000000..c0b4623 --- /dev/null +++ b/src/Zenith/GUI.hs @@ -0,0 +1,1414 @@ +{-# 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 new file mode 100644 index 0000000..6b59ef3 --- /dev/null +++ b/src/Zenith/GUI/Theme.hs @@ -0,0 +1,340 @@ +{-# 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 df47ed1..09f7ccc 100644 --- a/src/Zenith/Scanner.hs +++ b/src/Zenith/Scanner.hs @@ -33,7 +33,13 @@ import ZcashHaskell.Types ) import ZcashHaskell.Utils (getBlockTime, makeZebraCall, readZebraTransaction) import Zenith.Core (checkBlockChain) -import Zenith.DB (getMaxBlock, initDb, saveTransaction) +import Zenith.DB + ( getMaxBlock + , getUnconfirmedBlocks + , initDb + , saveConfs + , saveTransaction + ) import Zenith.Utils (jsonNumber) -- | Function to scan the Zcash blockchain through the Zebra node and populate the Zenith database @@ -155,3 +161,26 @@ processTx host port bt pool t = do (fromRawSBundle $ zt_sBundle rzt) (fromRawOBundle $ zt_oBundle rzt) return () + +-- | Function to update unconfirmed transactions +updateConfs :: + T.Text -- ^ Host name for `zebrad` + -> Int -- ^ Port for `zebrad` + -> ConnectionPool + -> IO () +updateConfs host port pool = do + targetBlocks <- getUnconfirmedBlocks pool + mapM_ updateTx targetBlocks + where + updateTx :: Int -> IO () + updateTx b = do + r <- + makeZebraCall + host + port + "getblock" + [Data.Aeson.String $ T.pack $ show b, jsonNumber 1] + case r of + Left e -> throwIO $ userError e + Right blk -> do + saveConfs pool b $ fromInteger $ bl_confirmations blk diff --git a/src/Zenith/Types.hs b/src/Zenith/Types.hs index 5526aa6..6176c17 100644 --- a/src/Zenith/Types.hs +++ b/src/Zenith/Types.hs @@ -143,7 +143,9 @@ data ZcashPool | Sprout | Sapling | Orchard - deriving (Show, Eq, Generic, ToJSON) + deriving (Show, Read, Eq, Generic, ToJSON) + +derivePersistField "ZcashPool" instance FromJSON ZcashPool where parseJSON = diff --git a/src/Zenith/Utils.hs b/src/Zenith/Utils.hs index 0f73fc9..eedf02d 100644 --- a/src/Zenith/Utils.hs +++ b/src/Zenith/Utils.hs @@ -5,13 +5,24 @@ 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 (isValidShieldedAddress) +import ZcashHaskell.Sapling (decodeSaplingAddress, isValidShieldedAddress) +import ZcashHaskell.Transparent + ( decodeExchangeAddress + , decodeTransparentAddress + ) +import ZcashHaskell.Types + ( SaplingAddress(..) + , TransparentAddress(..) + , UnifiedAddress(..) + , ZcashNet(..) + ) import Zenith.Types ( AddressGroup(..) , UnifiedAddressDB(..) @@ -39,6 +50,12 @@ 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 <> "..." @@ -72,3 +89,34 @@ 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 90c8a7c..e807441 160000 --- a/zcash-haskell +++ b/zcash-haskell @@ -1 +1 @@ -Subproject commit 90c8a7c3028bd6836dea5655221277a25d457653 +Subproject commit e8074419cfb54559a4c09731ad2448d5930869a2 diff --git a/zenith.cabal b/zenith.cabal index c54b192..2aacd50 100644 --- a/zenith.cabal +++ b/zenith.cabal @@ -1,6 +1,6 @@ cabal-version: 3.0 name: zenith -version: 0.5.3.1-beta +version: 0.6.0.0-beta license: MIT license-file: LICENSE author: Rene Vergara @@ -27,6 +27,8 @@ library ghc-options: -Wall -Wunused-imports exposed-modules: Zenith.CLI + Zenith.GUI + Zenith.GUI.Theme Zenith.Core Zenith.DB Zenith.Types @@ -44,13 +46,16 @@ library , base64-bytestring , brick , bytestring + , data-default + , directory + , filepath , esqueleto , resource-pool , binary , exceptions , monad-logger , vty-crossplatform - , secp256k1-haskell + , secp256k1-haskell >= 1 , pureMD5 , ghc , haskoin-core @@ -58,9 +63,13 @@ library , http-client , http-conduit , http-types + , JuicyPixels + , qrcode-core + , qrcode-juicypixels , microlens , microlens-mtl , microlens-th + , monomer , mtl , persistent , Hclip @@ -72,6 +81,7 @@ library , regex-posix , scientific , text + , text-show , time , vector , vty @@ -92,7 +102,7 @@ executable zenith , configurator , data-default , sort - , structured-cli + --, structured-cli , text , time , zenith