.gitignore

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

.gitmodules

@@ -1,3 +1,4 @@
 [submodule "zcash-haskell"]
 	path = zcash-haskell
-	url = https://code.vergara.tech/Vergara_Tech/zcash-haskell
+	url = https://git.vergara.tech/Vergara_Tech/zcash-haskell.git
+	branch = milestone2

CHANGELOG.md

@@ -5,105 +5,6 @@ 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.8.0.0-beta]
-
-### Added
-
-- TUI:
-	- Generate payment URI
-	- Read a payment URI
-	- Generate a Full Viewing Key
-	- Generate an Incoming Viewing Key
-
-- GUI:
-	- Generate payment URI and QR code
-	- Read a payment URI and QR code
-	- Generate a Full Viewing Key
-	- Generate an Incoming Viewing Key
-
-- RPC methods:
-	- `shieldnotes`
-	- `deshieldfunds`
-	- `getfullvk`
-	- `getincomingvk`
-
-## [0.7.2.0-beta]
-
-### Fixed
-
-- Creation of change addresses during account creation in GUI ([#111](https://code.vergara.tech/Vergara_Tech/zenith/issues/111))
-
-## [0.7.1.0-beta]
-
-### Changed
-
-- Removed workaround to obtain block time
-
-## [0.7.0.0-beta]
-
-### Added
-
-- RPC module
-	- OpenRPC specification
-	- `listwallets` RPC method
-	- `listaccounts` RPC method
-	- `listaddresses` RPC method
-	- `listreceived` RPC method
-	- `getbalance` RPC method
-	- `getnewwallet` RPC method
-	- `getnewaccount` RPC method
-	- `getnewaddress` RPC method
-	- `getoperationstatus` RPC method
-	- `sendmany` RPC method
-- Function `prepareTxV2` implementing `PrivacyPolicy`
-- Support for TEX addresses
-- Functionality to shield transparent balance
-- Functionality to de-shield shielded notes
-- Native commitment trees
-	- Batch append to trees in O(log n)
-
-### Changed
-
-- Detection of changes in database schema for automatic re-scan
-- Block tracking for chain re-org detection
-- Refactored `ZcashPool`
-- Preventing write operations to occur during wallet sync
-
-
-## [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

app/Main.hs

@@ -11,20 +11,18 @@ 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
 import Text.Read (readMaybe)
 import ZcashHaskell.Types
 import Zenith.CLI
-import Zenith.GUI (runZenithGUI)
+import Zenith.Core (clearSync, testSync)
-import Zenith.Scanner (clearSync, rescanZebra)
 import Zenith.Types (Config(..), ZcashAddress(..), ZcashPool(..), ZcashTx(..))
 import Zenith.Utils
 import Zenith.Zcashd
-  {-
+
 prompt :: String -> IO String
 prompt text = do
   putStr text
@@ -198,34 +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
-  dbFileName <- require config "dbFileName"
+  dbFilePath <- require config "dbFilePath"
   nodeUser <- require config "nodeUser"
   nodePwd <- require config "nodePwd"
   zebraPort <- require config "zebraPort"
   zebraHost <- require config "zebraHost"
-  nodePort <- require config "nodePort"
+  let myConfig = Config dbFilePath zebraHost zebraPort
-  currencyCode <- require config "currencyCode"
-  dbFP <- getZenithPath
-  let dbFilePath = T.pack $ dbFP ++ dbFileName
-  let myConfig =
-        Config
-          dbFilePath
-          zebraHost
-          zebraPort
-          nodeUser
-          nodePwd
-          nodePort
-          currencyCode
   if not (null args)
     then do
-      case head args
+      case head args of
-        {-"legacy" -> do
+        "legacy" -> do
           checkServer nodeUser nodePwd
           void $
             runCLI
@@ -234,12 +219,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" -> rescanZebra zebraHost zebraPort dbFilePath
+        "rescan" -> clearSync myConfig
-        "resync" -> clearSync myConfig
         _ -> printUsage
     else printUsage
 
@@ -247,7 +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 "gui\tGUI for zebrad"
   putStrLn "rescan\tRescan the existing wallet(s)"

app/Server.hs

@@ -1,100 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-
-module Server where
-
-import Control.Concurrent (forkIO, threadDelay)
-import Control.Exception (throwIO, throwTo, try)
-import Control.Monad (forever, when)
-import Control.Monad.Logger (runNoLoggingT)
-import Data.Configurator
-import qualified Data.Text as T
-import Network.Wai.Handler.Warp (run)
-import Servant
-import System.Exit
-import System.Posix.Signals
-import ZcashHaskell.Types (ZebraGetBlockChainInfo(..), ZebraGetInfo(..))
-import Zenith.Core (checkBlockChain, checkZebra)
-import Zenith.DB (getWallets, initDb, initPool)
-import Zenith.RPC
-  ( State(..)
-  , ZenithRPC(..)
-  , authenticate
-  , scanZebra
-  , zenithServer
-  )
-import Zenith.Scanner (rescanZebra)
-import Zenith.Types (Config(..))
-import Zenith.Utils (getZenithPath)
-
-main :: IO ()
-main = do
-  config <- load ["$(HOME)/Zenith/zenith.cfg"]
-  dbFileName <- require config "dbFileName"
-  nodeUser <- require config "nodeUser"
-  nodePwd <- require config "nodePwd"
-  zebraPort <- require config "zebraPort"
-  zebraHost <- require config "zebraHost"
-  nodePort <- require config "nodePort"
-  currencyCode <- require config "currencyCode"
-  dbFP <- getZenithPath
-  let dbFilePath = T.pack $ dbFP ++ dbFileName
-  let myConfig =
-        Config
-          dbFilePath
-          zebraHost
-          zebraPort
-          nodeUser
-          nodePwd
-          nodePort
-          currencyCode
-  let ctx = authenticate myConfig :. EmptyContext
-  w <- try $ checkZebra zebraHost zebraPort :: IO (Either IOError ZebraGetInfo)
-  case w of
-    Right zebra -> do
-      bc <-
-        try $ checkBlockChain zebraHost zebraPort :: IO
-          (Either IOError ZebraGetBlockChainInfo)
-      case bc of
-        Left e1 -> throwIO e1
-        Right chainInfo -> do
-          x <- initDb dbFilePath
-          case x of
-            Left e2 -> throwIO $ userError e2
-            Right x' -> do
-              when x' $ rescanZebra zebraHost zebraPort dbFilePath
-              pool <- runNoLoggingT $ initPool dbFilePath
-              walList <- getWallets pool $ zgb_net chainInfo
-              if not (null walList)
-                then do
-                  scanThread <-
-                    forkIO $
-                    forever $ do
-                      _ <-
-                        scanZebra
-                          dbFilePath
-                          zebraHost
-                          zebraPort
-                          (zgb_net chainInfo)
-                      threadDelay 90000000
-                  putStrLn "Zenith RPC Server 0.8.0.0-beta"
-                  putStrLn "------------------------------"
-                  putStrLn $
-                    "Connected to " ++
-                    show (zgb_net chainInfo) ++
-                    " Zebra " ++
-                    T.unpack (zgi_build zebra) ++ " on port " ++ show zebraPort
-                  let myState =
-                        State
-                          (zgb_net chainInfo)
-                          zebraHost
-                          zebraPort
-                          dbFilePath
-                          (zgi_build zebra)
-                          (zgb_blocks chainInfo)
-                  run nodePort $
-                    serveWithContext
-                      (Proxy :: Proxy ZenithRPC)
-                      ctx
-                      (zenithServer myState)
-                else putStrLn
-                       "No wallets available. Please start Zenith interactively to create a wallet"

app/ZenScan.hs

@@ -4,7 +4,7 @@ module ZenScan where
 
 import Control.Monad.Logger (runNoLoggingT)
 import Data.Configurator
-import Zenith.Scanner (rescanZebra)
+import Zenith.Scanner (scanZebra)
 
 main :: IO ()
 main = do

cabal.project

@@ -2,14 +2,14 @@ packages:
   ./*.cabal
   zcash-haskell/zcash-haskell.cabal
 
-with-compiler: ghc-9.6.5
+with-compiler: ghc-9.4.8
 
 source-repository-package
   type: git
-  location: https://code.vergara.tech/Vergara_Tech/haskell-hexstring.git
+  location: https://git.vergara.tech/Vergara_Tech/haskell-hexstring.git
   tag: 39d8da7b11a80269454c2f134a5c834e0f3cb9a7
 
 source-repository-package
   type: git
-  location: https://code.vergara.tech/Vergara_Tech/haskell-foreign-rust.git
+  location: https://git.vergara.tech/Vergara_Tech/haskell-foreign-rust.git
   tag: 335e804454cd30da2c526457be37e477f71e4665

cabal.project.freeze

@@ -1,48 +1,38 @@
 active-repositories: hackage.haskell.org:merge
-constraints: any.Cabal ==3.10.3.0,
+constraints: any.Cabal ==3.8.1.0,
-             any.Cabal-syntax ==3.10.3.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,
+             any.OneTuple ==0.4.1.1,
-             JuicyPixels -mmap,
+             any.QuickCheck ==2.14.3,
-             any.OneTuple ==0.4.2,
-             any.OpenGLRaw ==3.3.4.1,
-             OpenGLRaw -osandroid +usegles2 +useglxgetprocaddress +usenativewindowslibraries,
-             any.QuickCheck ==2.15.0.1,
              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.9.2,
+             any.X11 ==1.10.3,
-             any.adjunctions ==4.4.2,
+             X11 -pedantic,
-             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.2,
+             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,
+             any.assoc ==1.1,
-             assoc -tagged,
+             assoc +tagged,
              any.async ==2.2.5,
              async -bench,
              any.attoparsec ==0.14.4,
              attoparsec -developer,
-             any.attoparsec-aeson ==2.2.2.0,
+             any.attoparsec-aeson ==2.2.0.1,
-             any.authenticate-oauth ==1.7,
+             any.auto-update ==0.1.6,
-             any.auto-update ==0.2.4,
+             any.base ==4.17.2.1,
-             any.base ==4.18.2.1,
+             any.base-orphans ==0.9.1,
-             any.base-compat ==0.14.1,
-             any.base-compat-batteries ==0.14.1,
-             any.base-orphans ==0.9.3,
              any.base16 ==1.0,
              any.base16-bytestring ==1.0.2.0,
              any.base58-bytestring ==0.1.0,
@@ -52,208 +42,158 @@ 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.boring ==0.2.2,
-             boring +tagged,
              any.borsh ==0.3.0,
-             any.brick ==2.6,
+             any.brick ==2.3.1,
              brick -demos,
-             any.bsb-http-chunked ==0.0.0.4,
              any.byteorder ==1.0.4,
-             any.bytes ==0.17.4,
+             any.bytes ==0.17.3,
              any.bytestring ==0.11.5.3,
-             any.bytestring-to-vector ==0.3.0.1,
              any.c2hs ==0.28.8,
              c2hs +base3 -regression,
-             any.cabal-doctest ==1.0.11,
              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.9,
+             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.6,
+             any.conduit ==1.3.5,
              any.conduit-extra ==1.3.6,
              any.config-ini ==0.2.7.0,
              config-ini -enable-doctests,
              any.configurator ==0.3.0.0,
              configurator -developer,
-             any.constraints ==0.14.2,
              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 ==0.34,
-             any.cryptohash-md5 ==0.11.101.0,
-             any.cryptohash-sha1 ==0.11.101.0,
-             any.crypton ==1.0.1,
              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.3,
+             any.crypton-connection ==0.3.2,
-             any.crypton-x509 ==1.7.7,
+             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.13,
+             any.crypton-x509-validation ==1.6.12,
              any.cryptonite ==0.30,
              cryptonite -check_alignment +integer-gmp -old_toolchain_inliner +support_aesni +support_deepseq -support_pclmuldq +support_rdrand -support_sse +use_target_attributes,
              any.data-clist ==0.2,
-             any.data-default ==0.8.0.0,
+             any.data-default ==0.7.1.1,
-             any.data-default-class ==0.2.0.0,
+             any.data-default-class ==0.1.2.0,
-             any.data-fix ==0.3.4,
+             any.data-default-instances-containers ==0.0.1,
-             any.dec ==0.0.6,
+             any.data-default-instances-dlist ==0.0.1,
-             any.deepseq ==1.4.8.1,
+             any.data-default-instances-old-locale ==0.0.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.4.0,
+             any.envy ==2.1.3.0,
-             any.esqueleto ==3.5.13.1,
+             any.esqueleto ==3.5.11.2,
-             any.exceptions ==0.10.7,
+             any.exceptions ==0.10.5,
-             any.extra ==1.8,
+             any.fast-logger ==3.2.2,
-             any.fast-logger ==3.2.5,
+             any.filepath ==1.4.2.2,
-             any.file-embed ==0.0.16.0,
+             any.foldable1-classes-compat ==0.1,
-             any.filepath ==1.4.300.1,
+             foldable1-classes-compat +tagged,
-             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.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 ==9.4.8,
-             any.ghc-boot-th ==9.6.5,
+             any.ghc-boot-th ==9.4.8,
-             any.ghc-heap ==9.6.5,
+             any.ghc-heap ==9.4.8,
-             any.ghc-prim ==0.10.0,
+             any.ghc-prim ==0.9.1,
-             any.ghci ==9.6.5,
+             any.ghci ==9.4.8,
-             any.half ==0.3.2,
+             any.half ==0.3.1,
-             any.happy ==2.1.3,
+             any.happy ==1.20.1.1,
-             any.happy-lib ==2.1.3,
+             any.hashable ==1.4.4.0,
-             any.hashable ==1.4.7.0,
+             hashable +integer-gmp -random-initial-seed,
-             hashable -arch-native +integer-gmp -random-initial-seed,
+             any.haskeline ==0.8.2,
-             any.haskell-lexer ==1.1.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.10,
+             any.hspec ==2.11.7,
-             any.hspec-core ==2.11.10,
+             any.hspec-core ==2.11.7,
-             any.hspec-discover ==2.11.10,
+             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,
-             any.http-client-tls ==0.3.6.4,
+             any.http-client-tls ==0.3.6.3,
-             any.http-conduit ==2.3.9.1,
+             any.http-conduit ==2.3.8.3,
              http-conduit +aeson,
-             any.http-date ==0.0.11,
-             any.http-media ==0.8.1.1,
-             any.http-semantics ==0.3.0,
              any.http-types ==0.12.4,
-             any.http2 ==5.3.9,
+             any.indexed-traversable ==0.1.3,
-             http2 -devel -h2spec,
+             any.indexed-traversable-instances ==0.1.1.2,
-             any.indexed-traversable ==0.1.4,
+             any.integer-conversion ==0.1.0.1,
-             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.4,
+             any.iproute ==1.7.12,
-             any.iproute ==1.7.15,
+             any.language-c ==0.9.3,
-             any.kan-extensions ==5.2.6,
+             language-c -allwarnings +iecfpextension +usebytestrings,
-             any.language-c ==0.10.0,
+             any.lift-type ==0.1.1.1,
-             language-c +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.2.0,
              any.lifted-base ==0.2.3.12,
-             any.linear ==1.22,
+             any.megaparsec ==9.6.1,
-             linear -herbie +template-haskell,
-             any.megaparsec ==9.7.0,
              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.mmorph ==1.2.0,
              any.monad-control ==1.0.3.1,
              any.monad-logger ==0.3.40,
              monad-logger +template_haskell,
              any.monad-loops ==0.4.3,
              monad-loops +base4,
-             any.mono-traversable ==1.0.21.0,
+             any.mono-traversable ==1.0.17.0,
-             any.monomer ==1.6.0.1,
+             any.mtl ==2.2.2,
-             monomer -examples,
-             any.mtl ==2.3.1,
              any.murmur3 ==1.0.5,
-             any.nanovg ==0.8.1.0,
+             any.network ==3.1.4.0,
-             nanovg -examples -gl2 -gles3 -stb_truetype,
-             any.network ==3.2.7.0,
              network -devel,
-             any.network-byte-order ==0.1.7,
-             any.network-control ==0.1.3,
-             any.network-info ==0.2.1,
              any.network-uri ==2.6.4.2,
              any.old-locale ==1.0.0.7,
              any.old-time ==1.1.0.4,
-             any.optparse-applicative ==0.18.1.0,
+             any.os-string ==2.0.2,
-             optparse-applicative +process,
-             any.os-string ==2.0.7,
-             any.parallel ==3.2.2.0,
              any.parsec ==3.1.16.1,
              any.parser-combinators ==1.3.0,
              parser-combinators -dev,
              any.path-pieces ==0.2.1,
              any.pem ==0.2.4,
-             any.persistent ==2.14.6.3,
+             any.persistent ==2.14.6.1,
              any.persistent-sqlite ==2.13.3.0,
              persistent-sqlite -build-sanity-exe +full-text-search +have-usleep +json1 -systemlib +uri-filenames -use-pkgconfig -use-stat3 +use-stat4,
              any.persistent-template ==2.12.0.0,
              any.pretty ==1.1.3.6,
-             any.prettyprinter ==1.7.1,
-             prettyprinter -buildreadme +text,
-             any.prettyprinter-ansi-terminal ==1.1.3,
              any.primitive ==0.9.0.0,
-             any.process ==1.6.19.0,
+             any.process ==1.6.18.0,
-             any.profunctors ==5.6.2,
-             any.psqueues ==0.2.8.0,
              any.pureMD5 ==2.1.4,
              pureMD5 -test,
-             any.qrcode-core ==0.9.10,
-             any.qrcode-juicypixels ==0.8.6,
              any.quickcheck-io ==0.2.0,
              any.quickcheck-transformer ==0.3.1.2,
              any.random ==1.2.1.2,
-             any.recv ==0.1.0,
-             any.reflection ==2.1.9,
-             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,
@@ -263,28 +203,17 @@ 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,
+             any.scientific ==0.3.7.0,
-             scientific -integer-simple,
+             scientific -bytestring-builder -integer-simple,
-             any.sdl2 ==2.5.5.0,
+             any.secp256k1-haskell ==1.2.0,
-             sdl2 -examples -no-linear -opengl-example +pkgconfig +recent-ish,
+             any.semialign ==1.3,
-             any.secp256k1-haskell ==1.4.2,
-             any.semialign ==1.3.1,
              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.servant ==0.20.2,
+             any.silently ==1.2.5.3,
-             any.servant-server ==0.20.2,
-             any.silently ==1.2.5.4,
-             any.simple-sendfile ==0.2.32,
-             simple-sendfile +allow-bsd -fallback,
-             any.singleton-bool ==0.1.8,
              any.socks ==0.6.1,
-             any.some ==1.0.6,
-             some +newtype-unsafe,
              any.sop-core ==0.5.0.2,
              any.sort ==1.0.0.0,
              any.split ==0.2.5,
@@ -294,57 +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,
-             any.tagged ==0.8.9,
+             structured-cli -debug,
+             any.tagged ==0.8.8,
              tagged +deepseq +transformers,
-             any.tasty ==1.5.2,
+             any.template-haskell ==2.19.0.0,
-             tasty +unix,
-             any.template-haskell ==2.20.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-iso8601 ==0.1,
-             any.text-short ==0.1.6,
+             any.text-short ==0.1.5,
              text-short -asserts,
-             any.text-show ==3.11,
-             text-show +integer-gmp,
              any.text-zipper ==0.13,
              any.tf-random ==0.5,
-             any.th-abstraction ==0.7.1.0,
+             any.th-abstraction ==0.6.0.0,
-             any.th-compat ==0.1.6,
+             any.th-compat ==0.1.5,
-             any.th-lift ==0.8.6,
+             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-compat ==1.9.6.1,
-             any.time-locale-compat ==0.1.1.5,
+             time-compat -old-locale,
-             time-locale-compat -old-locale,
+             any.tls ==2.0.2,
-             any.time-manager ==0.2.1,
-             any.tls ==2.1.5,
              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.12.0,
+             any.typed-process ==0.2.11.1,
-             any.unix ==2.8.4.0,
+             any.unix ==2.7.3,
-             any.unix-compat ==0.7.3,
+             any.unix-compat ==0.7.1,
-             any.unix-time ==0.4.16,
+             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 ==1.3.16,
+             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.2.0,
+             any.vector ==0.13.1.0,
              vector +boundschecks -internalchecks -unsafechecks -wall,
-             any.vector-algorithms ==0.9.0.3,
+             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,
@@ -353,20 +277,9 @@ constraints: any.Cabal ==3.10.3.0,
              any.vty-crossplatform ==0.4.0.0,
              vty-crossplatform -demos,
              any.vty-unix ==0.2.0.0,
-             any.wai ==3.2.4,
-             any.wai-app-static ==3.1.9,
-             wai-app-static +crypton -print,
-             any.wai-extra ==3.1.17,
-             wai-extra -build-example,
-             any.wai-logger ==2.5.0,
-             any.warp ==3.4.7,
-             warp +allow-sendfilefd -network-bytestring -warp-debug +x509,
              any.wide-word ==0.1.6.0,
-             any.witherable ==0.5,
+             any.witherable ==0.4.2,
              any.word-wrap ==0.5,
-             any.word8 ==0.1.3,
+             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-12-14T09:52:48Z
+index-state: hackage.haskell.org 2024-04-07T10:14:52Z

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"
 source ~/.bashrc
-echo "... building zcash-haskell"
 cd zcash-haskell && cabal build
-echo
-echo "Done"
-echo

install

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

src/Zenith/GUI/Theme.hs

@@ -1,343 +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.disabled .
-  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"

src/Zenith/Scanner.hs

@@ -2,28 +2,29 @@
 
 module Zenith.Scanner where
 
-import Control.Concurrent.Async (concurrently_, withAsync)
 import Control.Exception (throwIO, try)
-import Control.Monad (when)
+import qualified Control.Monad.Catch as CM (try)
 import Control.Monad.IO.Class (liftIO)
 import Control.Monad.Logger
-  ( NoLoggingT
+  ( LoggingT
+  , NoLoggingT
   , logErrorN
   , logInfoN
   , runNoLoggingT
-  , runStderrLoggingT
   )
 import Data.Aeson
 import Data.HexString
+import Data.Maybe
 import qualified Data.Text as T
 import Data.Time (getCurrentTime)
 import Database.Persist.Sqlite
+import GHC.Utils.Monad (concatMapM)
+import Lens.Micro ((&), (.~), (^.), set)
 import System.Console.AsciiProgress
 import ZcashHaskell.Types
   ( BlockResponse(..)
   , RawZebraTx(..)
   , Transaction(..)
-  , ZcashNet(..)
   , ZebraGetBlockChainInfo(..)
   , ZebraTxResponse(..)
   , fromRawOBundle
@@ -31,85 +32,53 @@ import ZcashHaskell.Types
   , fromRawTBundle
   )
 import ZcashHaskell.Utils (getBlockTime, makeZebraCall, readZebraTransaction)
-import Zenith.Core (checkBlockChain, syncWallet, updateCommitmentTrees)
+import Zenith.Core (checkBlockChain)
-import Zenith.DB
+import Zenith.DB (getMaxBlock, initDb, saveTransaction)
-  ( ZcashBlock(..)
-  , ZcashBlockId
-  , clearWalletData
-  , clearWalletTransactions
-  , completeSync
-  , getBlock
-  , getMaxBlock
-  , getMinBirthdayHeight
-  , getUnconfirmedBlocks
-  , getWallets
-  , initDb
-  , initPool
-  , saveBlock
-  , saveConfs
-  , saveTransaction
-  , startSync
-  , updateWalletSync
-  , upgradeQrTable
-  )
-import Zenith.Types
-  ( Config(..)
-  , HexStringDB(..)
-  , ZcashNetDB(..)
-  , ZenithStatus(..)
-  )
 import Zenith.Utils (jsonNumber)
 
 -- | Function to scan the Zcash blockchain through the Zebra node and populate the Zenith database
-rescanZebra ::
+scanZebra ::
-     T.Text -- ^ Host
+     Int -- ^ Starting block
+  -> T.Text -- ^ Host
   -> Int -- ^ Port
   -> T.Text -- ^ Path to database file
-  -> IO ()
+  -> NoLoggingT IO ()
-rescanZebra host port dbFilePath = do
+scanZebra b host port dbFilePath = do
+  _ <- liftIO $ initDb dbFilePath
+  startTime <- liftIO getCurrentTime
+  logInfoN $ "Started sync: " <> T.pack (show startTime)
   bc <-
-    try $ checkBlockChain host port :: IO
+    liftIO $ try $ checkBlockChain host port :: NoLoggingT
+      IO
       (Either IOError ZebraGetBlockChainInfo)
   case bc of
-    Left e -> print e
+    Left e -> logErrorN $ T.pack (show e)
     Right bStatus -> do
-      let znet = ZcashNetDB $ zgb_net bStatus
+      let dbInfo =
-      pool1 <- runNoLoggingT $ initPool dbFilePath
+            mkSqliteConnectionInfo dbFilePath & extraPragmas .~
-      {-pool2 <- runNoLoggingT $ initPool dbFilePath-}
+            ["read_uncommited = true"]
-      {-pool3 <- runNoLoggingT $ initPool dbFilePath-}
+      pool <- createSqlitePoolFromInfo dbInfo 5
-      _ <- initDb dbFilePath
+      dbBlock <- getMaxBlock pool
-      upgradeQrTable pool1
-      clearWalletTransactions pool1
-      clearWalletData pool1
-      _ <- startSync pool1
-      dbBlock <- getMaxBlock pool1 znet
-      b <- liftIO $ getMinBirthdayHeight pool1 znet
       let sb = max dbBlock b
       if sb > zgb_blocks bStatus || sb < 1
         then liftIO $ throwIO $ userError "Invalid starting block for scan"
         else do
+          liftIO $
             print $
-            "Scanning from " ++ show sb ++ " to " ++ show (zgb_blocks bStatus)
+            "Scanning from " ++
-          let bList = [sb .. (zgb_blocks bStatus)]
+            show (sb + 1) ++ " to " ++ show (zgb_blocks bStatus)
-          {-
+          let bList = [(sb + 1) .. (zgb_blocks bStatus)]
-          let batch = length bList `div` 3
-          let bl1 = take batch bList
-          let bl2 = take batch $ drop batch bList
-          let bl3 = drop (2 * batch) bList
-          -}
-          _ <-
           displayConsoleRegions $ do
-              pg1 <- newProgressBar def {pgTotal = fromIntegral $ length bList}
+            pg <-
-              {-pg2 <- newProgressBar def {pgTotal = fromIntegral $ length bl2}-}
+              liftIO $
-              {-pg3 <- newProgressBar def {pgTotal = fromIntegral $ length bl3}-}
+              newProgressBar def {pgTotal = fromIntegral $ length bList}
-              mapM_ (processBlock host port pool1 pg1 znet) bList
+            txList <-
-              {-`concurrently_`-}
+              CM.try $ mapM_ (processBlock host port pool pg) bList :: NoLoggingT
-                {-mapM_ (processBlock host port pool2 pg2 znet) bl2 `concurrently_`-}
+                IO
-                {-mapM_ (processBlock host port pool3 pg3 znet) bl3-}
+                (Either IOError ())
-              print "Please wait..."
+            case txList of
-          _ <- completeSync pool1 Successful
+              Left e1 -> logErrorN $ T.pack (show e1)
-          _ <- runNoLoggingT $ updateCommitmentTrees pool1 host port znet
+              Right txList' -> logInfoN "Finished scan"
-          print "Rescan complete"
 
 -- | Function to process a raw block and extract the transaction information
 processBlock ::
@@ -117,10 +86,9 @@ processBlock ::
   -> Int -- ^ Port for `zebrad`
   -> ConnectionPool -- ^ DB file path
   -> ProgressBar -- ^ Progress bar
-  -> ZcashNetDB -- ^ the network
   -> Int -- ^ The block number to process
-  -> IO ()
+  -> NoLoggingT IO ()
-processBlock host port pool pg net b = do
+processBlock host port pool pg b = do
   r <-
     liftIO $
     makeZebraCall
@@ -129,29 +97,39 @@ processBlock host port pool pg net b = do
       "getblock"
       [Data.Aeson.String $ T.pack $ show b, jsonNumber 1]
   case r of
-    Left e -> do
+    Left e -> liftIO $ throwIO $ userError e
-      _ <- completeSync pool Failed
-      liftIO $ throwIO $ userError e
     Right blk -> do
-      bi <-
+      r2 <-
-        saveBlock pool $
+        liftIO $
-        ZcashBlock
+        makeZebraCall
-          (fromIntegral $ bl_height blk)
+          host
-          (HexStringDB $ bl_hash blk)
+          port
-          (fromIntegral $ bl_confirmations blk)
+          "getblock"
-          (fromIntegral $ bl_time blk)
+          [Data.Aeson.String $ T.pack $ show b, jsonNumber 0]
-          net
+      case r2 of
-      mapM_ (processTx host port bi pool) $ bl_txs blk
+        Left e2 -> liftIO $ throwIO $ userError e2
+        Right hb -> do
+          let blockTime = getBlockTime hb
+          mapM_ (processTx host port blockTime pool) $
+            bl_txs $ addTime blk blockTime
           liftIO $ tick pg
+  where
+    addTime :: BlockResponse -> Int -> BlockResponse
+    addTime bl t =
+      BlockResponse
+        (bl_confirmations bl)
+        (bl_height bl)
+        (fromIntegral t)
+        (bl_txs bl)
 
 -- | Function to process a raw transaction
 processTx ::
      T.Text -- ^ Host name for `zebrad`
   -> Int -- ^ Port for `zebrad`
-  -> ZcashBlockId -- ^ Block ID
+  -> Int -- ^ Block time
   -> ConnectionPool -- ^ DB file path
   -> HexString -- ^ transaction id
-  -> IO ()
+  -> NoLoggingT IO ()
 processTx host port bt pool t = do
   r <-
     liftIO $
@@ -161,15 +139,12 @@ processTx host port bt pool t = do
       "getrawtransaction"
       [Data.Aeson.String $ toText t, jsonNumber 1]
   case r of
-    Left e -> do
+    Left e -> liftIO $ throwIO $ userError e
-      _ <- completeSync pool Failed
-      liftIO $ throwIO $ userError e
     Right rawTx -> do
       case readZebraTransaction (ztr_hex rawTx) of
         Nothing -> return ()
         Just rzt -> do
           _ <-
-            runNoLoggingT $
             saveTransaction pool bt $
             Transaction
               t
@@ -180,82 +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
-
-clearSync :: Config -> IO ()
-clearSync config = do
-  let zHost = c_zebraHost config
-  let zPort = c_zebraPort config
-  let dbPath = c_dbPath config
-  pool <- runNoLoggingT $ initPool dbPath
-  bc <-
-    try $ checkBlockChain zHost zPort :: IO
-      (Either IOError ZebraGetBlockChainInfo)
-  case bc of
-    Left e1 -> throwIO e1
-    Right chainInfo -> do
-      x <- initDb dbPath
-      _ <- upgradeQrTable pool
-      case x of
-        Left e2 -> throwIO $ userError e2
-        Right x' -> do
-          when x' $ rescanZebra zHost zPort dbPath
-          _ <- clearWalletTransactions pool
-          w <- getWallets pool $ zgb_net chainInfo
-          liftIO $ mapM_ (updateWalletSync pool 0 . entityKey) w
-          w' <- liftIO $ getWallets pool $ zgb_net chainInfo
-          r <- runNoLoggingT $ mapM (syncWallet config) w'
-          liftIO $ print r
-
--- | Detect chain re-orgs
-checkIntegrity ::
-     T.Text -- ^ Database path
-  -> T.Text -- ^ Zebra host
-  -> Int -- ^ Zebra port
-  -> ZcashNet -- ^ the network to scan
-  -> Int -- ^ The block to start the check
-  -> Int -- ^ depth
-  -> IO Int
-checkIntegrity dbP zHost zPort znet b d =
-  if b < 1
-    then return 1
-    else do
-      r <-
-        makeZebraCall
-          zHost
-          zPort
-          "getblock"
-          [Data.Aeson.String $ T.pack $ show b, jsonNumber 1]
-      case r of
-        Left e -> throwIO $ userError e
-        Right blk -> do
-          pool <- runNoLoggingT $ initPool dbP
-          dbBlk <- getBlock pool b $ ZcashNetDB znet
-          case dbBlk of
-            Nothing -> return 1
-            Just dbBlk' ->
-              if bl_hash blk == getHex (zcashBlockHash $ entityVal dbBlk')
-                then return b
-                else checkIntegrity dbP zHost zPort znet (b - 5 * d) (d + 1)

src/Zenith/Tree.hs

@@ -1,400 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE DeriveAnyClass #-}
-{-# LANGUAGE DerivingVia #-}
-{-# LANGUAGE UndecidableInstances #-}
-
-module Zenith.Tree where
-
-import Codec.Borsh
-import Control.Monad.Logger (NoLoggingT, logDebugN)
-import Data.HexString
-import Data.Int (Int32, Int64, Int8)
-import Data.Maybe (fromJust, isNothing)
-import qualified Data.Text as T
-import qualified GHC.Generics as GHC
-import qualified Generics.SOP as SOP
-import ZcashHaskell.Orchard (combineOrchardNodes, getOrchardNodeValue)
-import ZcashHaskell.Sapling (combineSaplingNodes, getSaplingNodeValue)
-import ZcashHaskell.Types (MerklePath(..), OrchardTree(..), SaplingTree(..))
-
-type Level = Int8
-
-maxLevel :: Level
-maxLevel = 32
-
-type Position = Int32
-
-class Monoid v =>
-      Measured a v
-  where
-  measure :: a -> Position -> Int64 -> v
-
-class Node v where
-  getLevel :: v -> Level
-  getHash :: v -> HexString
-  getPosition :: v -> Position
-  getIndex :: v -> Int64
-  isFull :: v -> Bool
-  isMarked :: v -> Bool
-  mkNode :: Level -> Position -> HexString -> v
-
-type OrchardCommitment = HexString
-
-instance Measured OrchardCommitment OrchardNode where
-  measure oc p i =
-    case getOrchardNodeValue (hexBytes oc) of
-      Nothing -> OrchardNode 0 (hexString "00") 0 True 0 False
-      Just val -> OrchardNode p val 0 True i False
-
-type SaplingCommitment = HexString
-
-instance Measured SaplingCommitment SaplingNode where
-  measure sc p i =
-    case getSaplingNodeValue (hexBytes sc) of
-      Nothing -> SaplingNode 0 (hexString "00") 0 True 0 False
-      Just val -> SaplingNode p val 0 True i False
-
-data Tree v
-  = EmptyLeaf
-  | Leaf !v
-  | PrunedBranch !v
-  | Branch !v !(Tree v) !(Tree v)
-  | InvalidTree
-  deriving stock (Eq, GHC.Generic)
-  deriving anyclass (SOP.Generic, SOP.HasDatatypeInfo)
-  deriving (BorshSize, ToBorsh, FromBorsh) via AsEnum (Tree v)
-
-instance (Node v, Show v) => Show (Tree v) where
-  show EmptyLeaf = "()"
-  show (Leaf v) = "(" ++ show v ++ ")"
-  show (PrunedBranch v) = "{" ++ show v ++ "}"
-  show (Branch s x y) =
-    "<" ++ show (getHash s) ++ ">\n" ++ show x ++ "\n" ++ show y
-  show InvalidTree = "InvalidTree"
-
-instance (Monoid v, Node v) => Semigroup (Tree v) where
-  (<>) InvalidTree _ = InvalidTree
-  (<>) _ InvalidTree = InvalidTree
-  (<>) EmptyLeaf EmptyLeaf = PrunedBranch $ value $ branch EmptyLeaf EmptyLeaf
-  (<>) EmptyLeaf x = x
-  (<>) (Leaf x) EmptyLeaf = branch (Leaf x) EmptyLeaf
-  (<>) (Leaf x) (Leaf y) = branch (Leaf x) (Leaf y)
-  (<>) (Leaf _) Branch {} = InvalidTree
-  (<>) (Leaf _) (PrunedBranch _) = InvalidTree
-  (<>) (PrunedBranch x) EmptyLeaf = PrunedBranch $ x <> x
-  (<>) (PrunedBranch x) (Leaf y) =
-    if isFull x
-      then InvalidTree
-      else mkSubTree (getLevel x) (Leaf y)
-  (<>) (PrunedBranch x) (Branch s t u) =
-    if getLevel x == getLevel s
-      then branch (PrunedBranch x) (Branch s t u)
-      else InvalidTree
-  (<>) (PrunedBranch x) (PrunedBranch y) = PrunedBranch $ x <> y
-  (<>) (Branch s x y) EmptyLeaf =
-    branch (Branch s x y) $ getEmptyRoot (getLevel s)
-  (<>) (Branch s x y) (PrunedBranch w)
-    | getLevel s == getLevel w = branch (Branch s x y) (PrunedBranch w)
-    | otherwise = InvalidTree
-  (<>) (Branch s x y) (Leaf w)
-    | isFull s = InvalidTree
-    | isFull (value x) = branch x (y <> Leaf w)
-    | otherwise = branch (x <> Leaf w) y
-  (<>) (Branch s x y) (Branch s1 x1 y1)
-    | getLevel s == getLevel s1 = branch (Branch s x y) (Branch s1 x1 y1)
-    | otherwise = InvalidTree
-
-value :: Monoid v => Tree v -> v
-value EmptyLeaf = mempty
-value (Leaf v) = v
-value (PrunedBranch v) = v
-value (Branch v _ _) = v
-value InvalidTree = mempty
-
-branch :: Monoid v => Tree v -> Tree v -> Tree v
-branch x y = Branch (value x <> value y) x y
-
-leaf :: Measured a v => a -> Int32 -> Int64 -> Tree v
-leaf a p i = Leaf (measure a p i)
-
-prunedBranch :: Monoid v => Node v => Level -> Position -> HexString -> Tree v
-prunedBranch level pos val = PrunedBranch $ mkNode level pos val
-
-root :: Monoid v => Node v => Tree v -> Tree v
-root tree =
-  if getLevel (value tree) == maxLevel
-    then tree
-    else mkSubTree maxLevel tree
-
-getEmptyRoot :: Monoid v => Node v => Level -> Tree v
-getEmptyRoot level = iterate (\x -> x <> x) EmptyLeaf !! fromIntegral level
-
-append :: Monoid v => Measured a v => Node v => Tree v -> (a, Int64) -> Tree v
-append tree (n, i) = tree <> leaf n p i
-  where
-    p = 1 + getPosition (value tree)
-
-mkSubTree :: Node v => Monoid v => Level -> Tree v -> Tree v
-mkSubTree level t =
-  if getLevel (value subtree) == level
-    then subtree
-    else mkSubTree level subtree
-  where
-    subtree = t <> EmptyLeaf
-
-path :: Monoid v => Node v => Position -> Tree v -> Maybe MerklePath
-path pos (Branch s x y) =
-  if length (collectPath (Branch s x y)) /= 32
-    then Nothing
-    else Just $ MerklePath pos $ collectPath (Branch s x y)
-  where
-    collectPath :: Monoid v => Node v => Tree v -> [HexString]
-    collectPath EmptyLeaf = []
-    collectPath Leaf {} = []
-    collectPath PrunedBranch {} = []
-    collectPath InvalidTree = []
-    collectPath (Branch _ j k)
-      | getPosition (value k) /= 0 && getPosition (value k) < pos = []
-      | getPosition (value j) < pos = collectPath k <> [getHash (value j)]
-      | getPosition (value j) >= pos = collectPath j <> [getHash (value k)]
-      | otherwise = []
-path _ _ = Nothing
-
-nullPath :: MerklePath
-nullPath = MerklePath 0 []
-
-getNotePosition :: Monoid v => Node v => Tree v -> Int64 -> Maybe Position
-getNotePosition (Leaf x) i
-  | getIndex x == i = Just $ getPosition x
-  | otherwise = Nothing
-getNotePosition (Branch _ x y) i
-  | getIndex (value x) >= i = getNotePosition x i
-  | getIndex (value y) >= i = getNotePosition y i
-  | otherwise = Nothing
-getNotePosition _ _ = Nothing
-
-truncateTree :: Monoid v => Node v => Tree v -> Int64 -> NoLoggingT IO (Tree v)
-truncateTree (Branch s x y) i
-  | getLevel s == 1 && getIndex (value x) == i = do
-    logDebugN $ T.pack $ show (getLevel s) ++ " Trunc to left leaf"
-    return $ branch x EmptyLeaf
-  | getLevel s == 1 && getIndex (value y) == i = do
-    logDebugN $ T.pack $ show (getLevel s) ++ " Trunc to right leaf"
-    return $ branch x y
-  | getIndex (value x) >= i = do
-    logDebugN $
-      T.pack $
-      show (getLevel s) ++
-      ": " ++ show i ++ " left i: " ++ show (getIndex (value x))
-    l <- truncateTree x i
-    return $ branch (l) (getEmptyRoot (getLevel (value x)))
-  | getIndex (value y) /= 0 && getIndex (value y) >= i = do
-    logDebugN $
-      T.pack $
-      show (getLevel s) ++
-      ": " ++ show i ++ " right i: " ++ show (getIndex (value y))
-    r <- truncateTree y i
-    return $ branch x (r)
-  | otherwise = do
-    logDebugN $
-      T.pack $
-      show (getLevel s) ++
-      ": " ++
-      show (getIndex (value x)) ++ " catchall " ++ show (getIndex (value y))
-    return InvalidTree
-truncateTree x _ = return x
-
-countLeaves :: Node v => Tree v -> Int64
-countLeaves (Branch s x y) =
-  if isFull s
-    then 2 ^ getLevel s
-    else countLeaves x + countLeaves y
-countLeaves (PrunedBranch x) =
-  if isFull x
-    then 2 ^ getLevel x
-    else 0
-countLeaves (Leaf _) = 1
-countLeaves EmptyLeaf = 0
-countLeaves InvalidTree = 0
-
-batchAppend ::
-     Measured a v
-  => Node v => Monoid v => Tree v -> [(Int32, (a, Int64))] -> Tree v
-batchAppend x [] = x
-batchAppend (Branch s x y) notes
-  | isFull s = InvalidTree
-  | isFull (value x) = branch x (batchAppend y notes)
-  | otherwise =
-    branch
-      (batchAppend x (take leftSide notes))
-      (batchAppend y (drop leftSide notes))
-  where
-    leftSide = fromIntegral $ 2 ^ getLevel (value x) - countLeaves x
-batchAppend (PrunedBranch k) notes
-  | isFull k = InvalidTree
-  | otherwise =
-    branch
-      (batchAppend (getEmptyRoot (getLevel k - 1)) (take leftSide notes))
-      (batchAppend (getEmptyRoot (getLevel k - 1)) (drop leftSide notes))
-  where
-    leftSide = fromIntegral $ 2 ^ (getLevel k - 1)
-batchAppend EmptyLeaf notes
-  | length notes == 1 =
-    leaf (fst $ snd $ head notes) (fst $ head notes) (snd $ snd $ head notes)
-  | otherwise = InvalidTree
-batchAppend _ notes = InvalidTree
-
-data SaplingNode = SaplingNode
-  { sn_position :: !Position
-  , sn_value :: !HexString
-  , sn_level :: !Level
-  , sn_full :: !Bool
-  , sn_index :: !Int64
-  , sn_mark :: !Bool
-  } deriving stock (Eq, GHC.Generic)
-    deriving anyclass (SOP.Generic, SOP.HasDatatypeInfo)
-    deriving (BorshSize, ToBorsh, FromBorsh) via AsStruct SaplingNode
-
-instance Semigroup SaplingNode where
-  (<>) x y =
-    case combineSaplingNodes (sn_level x) (sn_value x) (sn_value y) of
-      Nothing -> x
-      Just newHash ->
-        SaplingNode
-          (max (sn_position x) (sn_position y))
-          newHash
-          (1 + sn_level x)
-          (sn_full x && sn_full y)
-          (max (sn_index x) (sn_index y))
-          (sn_mark x || sn_mark y)
-
-instance Monoid SaplingNode where
-  mempty = SaplingNode 0 (hexString "00") 0 False 0 False
-  mappend = (<>)
-
-instance Node SaplingNode where
-  getLevel = sn_level
-  getHash = sn_value
-  getPosition = sn_position
-  getIndex = sn_index
-  isFull = sn_full
-  isMarked = sn_mark
-  mkNode l p v = SaplingNode p v l True 0 False
-
-instance Show SaplingNode where
-  show = show . sn_value
-
-saplingSize :: SaplingTree -> Int64
-saplingSize tree =
-  (if isNothing (st_left tree)
-     then 0
-     else 1) +
-  (if isNothing (st_right tree)
-     then 0
-     else 1) +
-  foldl
-    (\x (i, p) ->
-       case p of
-         Nothing -> x + 0
-         Just _ -> x + 2 ^ i)
-    0
-    (zip [1 ..] $ st_parents tree)
-
-mkSaplingTree :: SaplingTree -> Tree SaplingNode
-mkSaplingTree tree =
-  foldl
-    (\t (i, n) ->
-       case n of
-         Just n' -> prunedBranch i 0 n' <> t
-         Nothing -> t <> getEmptyRoot i)
-    leafRoot
-    (zip [1 ..] $ st_parents tree)
-  where
-    leafRoot =
-      case st_right tree of
-        Just r' -> leaf (fromJust $ st_left tree) (pos - 1) 0 <> leaf r' pos 0
-        Nothing -> leaf (fromJust $ st_left tree) pos 0 <> EmptyLeaf
-    pos = fromIntegral $ saplingSize tree - 1
-
--- | Orchard 
-data OrchardNode = OrchardNode
-  { on_position :: !Position
-  , on_value :: !HexString
-  , on_level :: !Level
-  , on_full :: !Bool
-  , on_index :: !Int64
-  , on_mark :: !Bool
-  } deriving stock (Eq, GHC.Generic)
-    deriving anyclass (SOP.Generic, SOP.HasDatatypeInfo)
-    deriving (BorshSize, ToBorsh, FromBorsh) via AsStruct OrchardNode
-
-instance Semigroup OrchardNode where
-  (<>) x y =
-    case combineOrchardNodes
-           (fromIntegral $ on_level x)
-           (on_value x)
-           (on_value y) of
-      Nothing -> x
-      Just newHash ->
-        OrchardNode
-          (max (on_position x) (on_position y))
-          newHash
-          (1 + on_level x)
-          (on_full x && on_full y)
-          (max (on_index x) (on_index y))
-          (on_mark x || on_mark y)
-
-instance Monoid OrchardNode where
-  mempty = OrchardNode 0 (hexString "00") 0 False 0 False
-  mappend = (<>)
-
-instance Node OrchardNode where
-  getLevel = on_level
-  getHash = on_value
-  getPosition = on_position
-  getIndex = on_index
-  isFull = on_full
-  isMarked = on_mark
-  mkNode l p v = OrchardNode p v l True 0 False
-
-instance Show OrchardNode where
-  show = show . on_value
-
-instance Measured OrchardNode OrchardNode where
-  measure o p i =
-    OrchardNode p (on_value o) (on_level o) (on_full o) i (on_mark o)
-
-orchardSize :: OrchardTree -> Int64
-orchardSize tree =
-  (if isNothing (ot_left tree)
-     then 0
-     else 1) +
-  (if isNothing (ot_right tree)
-     then 0
-     else 1) +
-  foldl
-    (\x (i, p) ->
-       case p of
-         Nothing -> x + 0
-         Just _ -> x + 2 ^ i)
-    0
-    (zip [1 ..] $ ot_parents tree)
-
-mkOrchardTree :: OrchardTree -> Tree OrchardNode
-mkOrchardTree tree =
-  foldl
-    (\t (i, n) ->
-       case n of
-         Just n' -> prunedBranch i 0 n' <> t
-         Nothing -> t <> getEmptyRoot i)
-    leafRoot
-    (zip [1 ..] $ ot_parents tree)
-  where
-    leafRoot =
-      case ot_right tree of
-        Just r' -> leaf (fromJust $ ot_left tree) (pos - 1) 0 <> leaf r' pos 0
-        Nothing -> leaf (fromJust $ ot_left tree) pos 0 <> EmptyLeaf
-    pos = fromIntegral $ orchardSize tree - 1

src/Zenith/Types.hs

@@ -10,37 +10,23 @@
 module Zenith.Types where
 
 import Data.Aeson
-import Data.Aeson.TH (deriveJSON)
 import qualified Data.ByteString as BS
 import qualified Data.ByteString.Base64 as B64
 import qualified Data.ByteString.Char8 as C
 import Data.HexString
-import Data.Int (Int64)
 import Data.Maybe (fromMaybe)
-import Data.Scientific (Scientific)
 import qualified Data.Text as T
 import qualified Data.Text.Encoding as E
 import Data.Text.Encoding.Error (lenientDecode)
-import qualified Data.UUID as U
 import Database.Persist.TH
 import GHC.Generics
-import ZcashHaskell.Orchard (encodeUnifiedAddress, parseAddress)
-import ZcashHaskell.Sapling (encodeSaplingAddress)
-import ZcashHaskell.Transparent
-  ( encodeExchangeAddress
-  , encodeTransparentReceiver
-  )
 import ZcashHaskell.Types
-  ( ExchangeAddress(..)
+  ( OrchardSpendingKey(..)
-  , OrchardSpendingKey(..)
   , Phrase(..)
   , Rseed(..)
-  , SaplingAddress(..)
   , SaplingSpendingKey(..)
   , Scope(..)
-  , TransparentAddress(..)
   , TransparentSpendingKey
-  , ValidAddress(..)
   , ZcashNet(..)
   )
 
@@ -56,9 +42,6 @@ newtype ZcashNetDB = ZcashNetDB
   { getNet :: ZcashNet
   } deriving newtype (Eq, Show, Read)
 
-instance ToJSON ZcashNetDB where
-  toJSON (ZcashNetDB z) = toJSON z
-
 derivePersistField "ZcashNetDB"
 
 newtype UnifiedAddressDB = UnifiedAddressDB
@@ -109,166 +92,8 @@ data Config = Config
   { c_dbPath :: !T.Text
   , c_zebraHost :: !T.Text
   , c_zebraPort :: !Int
-  , c_zenithUser :: !BS.ByteString
-  , c_zenithPwd :: !BS.ByteString
-  , c_zenithPort :: !Int
-  , c_currencyCode :: !T.Text
   } deriving (Eq, Prelude.Show)
 
-data ZcashPool
-  = TransparentPool
-  | SproutPool
-  | SaplingPool
-  | OrchardPool
-  deriving (Show, Read, Eq)
-
-derivePersistField "ZcashPool"
-
-instance ToJSON ZcashPool where
-  toJSON zp =
-    case zp of
-      TransparentPool -> Data.Aeson.String "p2pkh"
-      SproutPool -> Data.Aeson.String "sprout"
-      SaplingPool -> Data.Aeson.String "sapling"
-      OrchardPool -> Data.Aeson.String "orchard"
-
-instance FromJSON ZcashPool where
-  parseJSON =
-    withText "ZcashPool" $ \case
-      "p2pkh" -> return TransparentPool
-      "sprout" -> return SproutPool
-      "sapling" -> return SaplingPool
-      "orchard" -> return OrchardPool
-      _ -> fail "Not a known Zcash pool"
-
-newtype ZenithUuid = ZenithUuid
-  { getUuid :: U.UUID
-  } deriving newtype (Show, Eq, Read, ToJSON, FromJSON)
-
-derivePersistField "ZenithUuid"
-
--- ** API types
-data ZcashWalletAPI = ZcashWalletAPI
-  { zw_index :: !Int
-  , zw_name :: !T.Text
-  , zw_network :: !ZcashNet
-  , zw_birthday :: !Int
-  , zw_lastSync :: !Int
-  } deriving (Eq, Prelude.Show)
-
-$(deriveJSON defaultOptions {fieldLabelModifier = drop 3} ''ZcashWalletAPI)
-
-data ZcashAccountAPI = ZcashAccountAPI
-  { za_index :: !Int
-  , za_wallet :: !Int
-  , za_name :: !T.Text
-  } deriving (Eq, Prelude.Show)
-
-$(deriveJSON defaultOptions {fieldLabelModifier = drop 3} ''ZcashAccountAPI)
-
-data ZcashAddressAPI = ZcashAddressAPI
-  { zd_index :: !Int
-  , zd_account :: !Int
-  , zd_name :: !T.Text
-  , zd_ua :: !T.Text
-  , zd_legacy :: !(Maybe T.Text)
-  , zd_transparent :: !(Maybe T.Text)
-  } deriving (Eq, Prelude.Show)
-
-$(deriveJSON defaultOptions {fieldLabelModifier = drop 3} ''ZcashAddressAPI)
-
-data ZcashNoteAPI = ZcashNoteAPI
-  { zn_txid :: !HexString
-  , zn_pool :: !ZcashPool
-  , zn_amount :: !Float
-  , zn_amountZats :: !Int64
-  , zn_memo :: !T.Text
-  , zn_confirmed :: !Bool
-  , zn_blockheight :: !Int
-  , zn_blocktime :: !Int
-  , zn_outindex :: !Int
-  , zn_change :: !Bool
-  } deriving (Eq, Prelude.Show)
-
-$(deriveJSON defaultOptions {fieldLabelModifier = drop 3} ''ZcashNoteAPI)
-
-data AccountBalance = AccountBalance
-  { acb_transparent :: !Int64
-  , acb_sapling :: !Int64
-  , acb_orchard :: !Int64
-  } deriving (Eq, Prelude.Show)
-
-$(deriveJSON defaultOptions {fieldLabelModifier = drop 4} ''AccountBalance)
-
-data ZenithStatus
-  = Processing
-  | Failed
-  | Successful
-  deriving (Eq, Prelude.Show, Read)
-
-$(deriveJSON defaultOptions ''ZenithStatus)
-
-derivePersistField "ZenithStatus"
-
-data PrivacyPolicy
-  = None
-  | Low
-  | Medium
-  | Full
-  deriving (Eq, Show, Read, Ord)
-
-$(deriveJSON defaultOptions ''PrivacyPolicy)
-
-newtype ValidAddressAPI = ValidAddressAPI
-  { getVA :: ValidAddress
-  } deriving newtype (Eq, Show)
-
-instance ToJSON ValidAddressAPI where
-  toJSON (ValidAddressAPI va) =
-    case va of
-      Unified ua -> Data.Aeson.String $ encodeUnifiedAddress ua
-      Sapling sa ->
-        maybe
-          Data.Aeson.Null
-          Data.Aeson.String
-          (encodeSaplingAddress (net_type sa) (sa_receiver sa))
-      Transparent ta ->
-        Data.Aeson.String $
-        encodeTransparentReceiver (ta_network ta) (ta_receiver ta)
-      Exchange ea ->
-        maybe
-          Data.Aeson.Null
-          Data.Aeson.String
-          (encodeExchangeAddress (ex_network ea) (ex_address ea))
-
-data ProposedNote = ProposedNote
-  { pn_addr :: !ValidAddressAPI
-  , pn_amt :: !Scientific
-  , pn_memo :: !(Maybe T.Text)
-  } deriving (Eq, Prelude.Show)
-
-instance FromJSON ProposedNote where
-  parseJSON =
-    withObject "ProposedNote" $ \obj -> do
-      a <- obj .: "address"
-      n <- obj .: "amount"
-      m <- obj .:? "memo"
-      case parseAddress (E.encodeUtf8 a) of
-        Nothing -> fail "Invalid address"
-        Just a' ->
-          if n > 0 && n < 21000000
-            then pure $ ProposedNote (ValidAddressAPI a') n m
-            else fail "Invalid amount"
-
-instance ToJSON ProposedNote where
-  toJSON (ProposedNote a n m) =
-    object ["address" .= a, "amount" .= n, "memo" .= m]
-
-data ShieldDeshieldOp
-  = Shield
-  | Deshield
-  deriving (Eq, Show, Read, Ord)
-
 -- ** `zebrad`
 -- | Type for modeling the tree state response
 data ZebraTreeInfo = ZebraTreeInfo
@@ -313,6 +138,22 @@ instance FromJSON AddressSource where
       "mnemonic_seed" -> return MnemonicSeed
       _ -> fail "Not a known address source"
 
+data ZcashPool
+  = Transparent
+  | Sprout
+  | Sapling
+  | Orchard
+  deriving (Show, Eq, Generic, ToJSON)
+
+instance FromJSON ZcashPool where
+  parseJSON =
+    withText "ZcashPool" $ \case
+      "p2pkh" -> return Transparent
+      "sprout" -> return Sprout
+      "sapling" -> return Sapling
+      "orchard" -> return Orchard
+      _ -> fail "Not a known Zcash pool"
+
 data ZcashAddress = ZcashAddress
   { source :: AddressSource
   , pool :: [ZcashPool]
@@ -360,8 +201,7 @@ instance FromJSON AddressGroup where
           Nothing -> return []
           Just x -> do
             x' <- x .:? "addresses"
-            return $
+            return $ maybe [] (map (ZcashAddress s1 [Transparent] Nothing)) x'
-              maybe [] (map (ZcashAddress s1 [TransparentPool] Nothing)) x'
       processSapling k s2 =
         case k of
           Nothing -> return []
@@ -369,7 +209,7 @@ instance FromJSON AddressGroup where
             where processOneSapling sx =
                     withObject "Sapling" $ \oS -> do
                       oS' <- oS .: "addresses"
-                      return $ map (ZcashAddress sx [SaplingPool] Nothing) oS'
+                      return $ map (ZcashAddress sx [Sapling] Nothing) oS'
       processUnified u =
         case u of
           Nothing -> return []
@@ -508,20 +348,3 @@ encodeHexText' t =
   if T.length t > 0
     then C.unpack . B64.encode $ E.encodeUtf8 t
     else C.unpack . B64.encode $ E.encodeUtf8 "Sent from Zenith"
-
--- | Define a data structure for the parsed components
-data ZcashPaymentURI = ZcashPaymentURI
-  { uriAddress :: String
-  , uriAmount :: Maybe Double
-  , uriMemo :: T.Text
-  , uriLabel :: Maybe String
-  , uriMessage :: Maybe String
-  } deriving (Show, Eq)
-
--- | Define a data structure for the URI QR image
-data URIQrCode = URIQrCode 
-  {
-    uriBytes  :: BS.ByteString -- Image as ByteString
-  , uriWidth  :: Double           -- Number of columns in QR Image
-  , uriHeight :: Double           -- Number of rows in a QR Image
-  }  deriving (Show, Eq)

src/Zenith/Utils.hs

@@ -2,60 +2,20 @@
 
 module Zenith.Utils where
 
-import Control.Exception (SomeException, try)
-import Control.Monad (when)
 import Data.Aeson
-import qualified Data.Aeson.Key as K
-import qualified Data.Aeson.KeyMap as KM
-import Data.Aeson.Types (parseMaybe)
-import qualified Data.ByteString as BS
-import qualified Data.ByteString.Base64 as B64
-import qualified Data.ByteString.Char8 as BC
-import qualified Data.ByteString.Lazy as B
-import qualified Data.ByteString.Lazy.Char8 as BL
-import Data.Char (isAlphaNum, isSpace)
 import Data.Functor (void)
 import Data.Maybe
-import Data.Ord (clamp)
+import Data.Scientific (Scientific(..), scientific)
-import Data.Scientific (Scientific(..), Scientific, scientific, toRealFloat)
 import qualified Data.Text as T
 import qualified Data.Text.Encoding as E
-
---import qualified Data.Text.Encoding as TE
-import Network.HTTP.Simple
-import Network.URI (escapeURIString, isUnreserved)
-import System.Directory
 import System.Process (createProcess_, shell)
-import Text.Printf (printf)
-import Text.Read (readMaybe)
 import Text.Regex.Posix
-import ZcashHaskell.Orchard
+import ZcashHaskell.Orchard (encodeUnifiedAddress, isValidUnifiedAddress)
-  ( encodeUnifiedAddress
+import ZcashHaskell.Sapling (isValidShieldedAddress)
-  , isValidUnifiedAddress
-  , parseAddress
-  )
-import ZcashHaskell.Sapling (decodeSaplingAddress, isValidShieldedAddress)
-import ZcashHaskell.Transparent
-  ( decodeExchangeAddress
-  , decodeTransparentAddress
-  )
-import ZcashHaskell.Types
-  ( ExchangeAddress(..)
-  , ExchangeAddress(..)
-  , SaplingAddress(..)
-  , TransparentAddress(..)
-  , UnifiedAddress(..)
-  , ValidAddress(..)
-  , ValidAddress(..)
-  , ZcashNet(..)
-  )
-import ZcashHaskell.Utils (makeZebraCall)
 import Zenith.Types
   ( AddressGroup(..)
-  , PrivacyPolicy(..)
   , UnifiedAddressDB(..)
   , ZcashAddress(..)
-  , ZcashPaymentURI(..)
   , ZcashPool(..)
   )
 
@@ -71,7 +31,7 @@ displayZec s
   | abs s < 100000000 = show (fromIntegral s / 100000) ++ " mZEC"
   | otherwise = show (fromIntegral s / 100000000) ++ " ZEC "
 
--- | Helper function to display small amounts of TAZ
+-- | Helper function to display small amounts of ZEC
 displayTaz :: Integer -> String
 displayTaz s
   | abs s < 100 = show s ++ " tazs"
@@ -79,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 <> "..."
@@ -98,9 +52,9 @@ getAddresses ag = agtransparent ag <> agsapling ag <> agunified ag
 -- | Helper function to validate potential Zcash addresses
 validateAddress :: T.Text -> Maybe ZcashPool
 validateAddress txt --(tReg || sReg && isJust chk) || (uReg && isJust chk)
-  | tReg = Just TransparentPool
+  | tReg = Just Transparent
-  | sReg && chkS = Just SaplingPool
+  | sReg && chkS = Just Sapling
-  | uReg && chk = Just OrchardPool
+  | uReg && chk = Just Orchard
   | otherwise = Nothing
   where
     transparentRegex = "^t1[a-zA-Z0-9]{33}$" :: String
@@ -112,262 +66,9 @@ validateAddress txt --(tReg || sReg && isJust chk) || (uReg && isJust chk)
     chk = isJust $ isValidUnifiedAddress $ E.encodeUtf8 txt
     chkS = isValidShieldedAddress $ E.encodeUtf8 txt
 
--- | Return True if Address is valid
-validateAddressBool :: T.Text -> Bool
-validateAddressBool a = do
-  case (validateAddress a) of
-    Nothing -> False
-    _ -> True
-
 -- | Copy an address to the clipboard
 copyAddress :: ZcashAddress -> IO ()
 copyAddress a =
   void $
   createProcess_ "toClipboard" $
   shell $ "echo " ++ T.unpack (addy a) ++ " | xclip -r -selection clipboard"
-
--- | Get current user and build zenith path
-getZenithPath :: IO String
-getZenithPath = do
-  homeDirectory <- getHomeDirectory
-  return (homeDirectory ++ "/Zenith/")
-
--- | Bound a value to the 0..1 range, used for progress reporting on UIs
-validBarValue :: Float -> Float
-validBarValue = clamp (0, 1)
-
-isRecipientValid :: T.Text -> Bool
-isRecipientValid a = do
-  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 (E.encodeUtf8 a) of
-             Just _a4 -> True
-             Nothing -> False)
-
-isUnifiedAddressValid :: T.Text -> Bool
-isUnifiedAddressValid ua =
-  case isValidUnifiedAddress (E.encodeUtf8 ua) of
-    Just _a1 -> True
-    Nothing -> False
-
-isSaplingAddressValid :: T.Text -> Bool
-isSaplingAddressValid sa = isValidShieldedAddress (E.encodeUtf8 sa)
-
-isTransparentAddressValid :: T.Text -> Bool
-isTransparentAddressValid ta =
-  case decodeTransparentAddress (E.encodeUtf8 ta) of
-    Just _a3 -> True
-    Nothing -> False
-
-isExchangeAddressValid :: T.Text -> Bool
-isExchangeAddressValid xa =
-  case decodeExchangeAddress (E.encodeUtf8 xa) of
-    Just _a4 -> True
-    Nothing -> False
-
-isRecipientValidGUI :: PrivacyPolicy -> T.Text -> Bool
-isRecipientValidGUI p a = do
-  let adr = parseAddress (E.encodeUtf8 a)
-  case p of
-    Full ->
-      case adr of
-        Just a ->
-          case a of
-            Unified ua -> True
-            Sapling sa -> True
-            _ -> False
-        Nothing -> False
-    Medium ->
-      case adr of
-        Just a ->
-          case a of
-            Unified ua -> True
-            Sapling sa -> True
-            _ -> False
-        Nothing -> False
-    Low ->
-      case adr of
-        Just a ->
-          case a of
-            Unified ua -> True
-            Sapling sa -> True
-            Transparent ta -> True
-            _ -> False
-        Nothing -> False
-    None ->
-      case adr of
-        Just a ->
-          case a of
-            Transparent ta -> True
-            Exchange ea -> True
-            _ -> False
-        Nothing -> False
-
-isZecAddressValid :: T.Text -> Bool
-isZecAddressValid a = do
-  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 (E.encodeUtf8 a) of
-             Just _a4 -> True
-             Nothing -> False)
-
-parseAddressUA :: T.Text -> ZcashNet -> Maybe UnifiedAddress
-parseAddressUA 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
-
-isValidContent :: String -> Bool
-isValidContent [] = False --  an empty string is invalid   
-isValidContent (x:xs)
-  | not (isAlphaNum x) = False --  string must start with an alphanumeric character
-  | otherwise = allValidChars xs --  process the rest of the string 
-  where
-    allValidChars :: String -> Bool
-    allValidChars [] = True -- if we got here, string is valid
-    allValidChars (y:ys)
-      | isAlphaNum y || isSpace y = allValidChars ys -- char is valid, continue
-      | otherwise = False -- found an invalid character, return false  
-
-isValidString :: T.Text -> Bool
-isValidString c = do
-  let a = T.unpack c
-  isValidContent a
-
-padWithZero :: Int -> String -> String
-padWithZero n s
-  | length s >= n = s
-  | otherwise = padWithZero n ("0" ++ s)
-
-isEmpty :: [a] -> Bool
-isEmpty [] = True
-isEmpty _ = False
-
-getChainTip :: T.Text -> Int -> IO Int
-getChainTip zHost zPort = do
-  r <- makeZebraCall zHost zPort "getblockcount" []
-  case r of
-    Left e1 -> pure 0
-    Right i -> pure i
-
--- Function to fetch Zcash price from CoinGecko
-getZcashPrice :: T.Text -> IO (Maybe Double)
-getZcashPrice currency = do
-  let url =
-        "https://api.coingecko.com/api/v3/simple/price?ids=zcash&vs_currencies=" <>
-        T.unpack currency
-  response <- httpJSONEither (parseRequest_ url)
-  case getResponseBody response of
-    Right (Object obj)
-        -- Extract "zcash" object
-     -> do
-      case KM.lookup "zcash" obj of
-        Just (Object zcashObj)
-            -- Extract the currency price
-         ->
-          case KM.lookup (K.fromText (T.toLower currency)) zcashObj of
-            Just (Number price) -> return (Just (toRealFloat price))
-            _ -> return Nothing
-        _ -> return Nothing
-    _ -> return Nothing
-
--- Parse memo result to convert it to a ByteString
-processEither :: Either String BC.ByteString -> BC.ByteString
-processEither (Right bs) = bs
-processEither (Left e) = BC.pack e -- Returns the error message
-
--- Parse the query string into key-value pairs 
-parseQuery :: String -> [(String, String)]
-parseQuery query = map (breakOn '=') (splitOn '&' query)
-  where
-    splitOn :: Char -> String -> [String]
-    splitOn _ [] = [""]
-    splitOn delim (c:cs)
-      | c == delim = "" : rest
-      | otherwise = (c : head rest) : tail rest
-      where
-        rest = splitOn delim cs
-    breakOn :: Char -> String -> (String, String)
-    breakOn delim str = (key, drop 1 value)
-      where
-        (key, value) = span (/= delim) str
-
--- Parse a ZIP-321 encoded string into a ZcashPayment structure
-parseZcashPayment :: String -> Either String ZcashPaymentURI
-parseZcashPayment input
-  | not (T.isPrefixOf "zcash:" (T.pack input)) =
-    Left "Invalid scheme: must start with 'zcash:'"
-  | otherwise =
-    let (addrPart, queryPart) = break (== '?') (drop 6 input)
-        queryParams = parseQuery (drop 1 queryPart)
-     in Right
-          ZcashPaymentURI
-            { uriAddress = addrPart
-            , uriAmount = lookup "amount" queryParams >>= readMaybe
-            , uriMemo =
-                case lookup "memo" queryParams of
-                  Just m ->
-                    T.pack
-                      (BC.unpack
-                         (processEither $ decodeBase64Unpadded (BC.pack m)))
-                  _ -> ""
-            , uriLabel = lookup "label" queryParams
-            , uriMessage = lookup "message" queryParams
-            }
-
--- Function to pad a base64 string if it's not a multiple of 4
-padBase64 :: BC.ByteString -> BC.ByteString
-padBase64 bs = bs <> BC.replicate paddingLength '='
-  where
-    paddingLength = (4 - BC.length bs `mod` 4) `mod` 4
-
--- Function to decode a base64 un-padded string
-decodeBase64Unpadded :: BC.ByteString -> Either String BC.ByteString
-decodeBase64Unpadded = B64.decode . padBase64
-
--- Function to encode memo as un-padded Base64
-encodeBase64Memo :: String -> String
-encodeBase64Memo = BC.unpack . BC.takeWhile (/= '=') . B64.encode . BC.pack
-
--- Function to drop trailing zeros 
-dropTrailingZeros :: String -> String
-dropTrailingZeros str =
-  let withoutZeros = reverse (dropWhile (== '0') (reverse str))
-   in if last withoutZeros == '.'
-        then withoutZeros ++ "0" -- Ensure at least one decimal place
-        else withoutZeros
-
--- Function to create a ZIP-321 URI
-createZip321 :: String -> Maybe Double -> Maybe String -> String
-createZip321 address mAmount mMemo =
-  "zcash:" ++
-  address ++
-  maybe
-    ""
-    (\amount -> "?amount=" ++ dropTrailingZeros (printf "%.8f" amount))
-    mAmount ++
-  maybe
-    ""
-    (\memo -> "&memo=" ++ escapeURIString isUnreserved (encodeBase64Memo memo))
-    mMemo
-
-getTransparentFromUA :: UnifiedAddress -> Maybe TransparentAddress
-getTransparentFromUA ua = TransparentAddress (ua_net ua) <$> t_rec ua

src/Zenith/Zcashd.hs

@@ -123,10 +123,9 @@ sendTx user pwd fromAddy toAddy amount memo = do
       if source fromAddy /= ImportedWatchOnly
         then do
           let privacyPolicy
-                | valAdd == Just TransparentPool = "AllowRevealedRecipients"
+                | valAdd == Just Transparent = "AllowRevealedRecipients"
                 | isNothing (account fromAddy) &&
-                    elem TransparentPool (pool fromAddy) =
+                    elem Transparent (pool fromAddy) = "AllowRevealedSenders"
-                  "AllowRevealedSenders"
                 | otherwise = "AllowRevealedAmounts"
           let pd =
                 case memo of
@@ -302,7 +301,7 @@ sendWithUri user pwd fromAddy uri repTo = do
       let addType = validateAddress $ T.pack parsedAddress
       case addType of
         Nothing -> putStrLn "   Invalid address"
-        Just TransparentPool -> do
+        Just Transparent -> do
           putStrLn $ "   Address is valid: " ++ parsedAddress
           case (readMaybe parsedAmount :: Maybe Double) of
             Nothing -> putStrLn "   Invalid amount."

test/ServerSpec.hs

@@ -1,910 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-
-import Control.Concurrent (forkIO, threadDelay)
-import Control.Exception (SomeException, throwIO, try)
-import Control.Monad (when)
-import Control.Monad.Logger (runNoLoggingT)
-import Data.Aeson
-import qualified Data.ByteString as BS
-import Data.Configurator
-import Data.Maybe (fromJust, fromMaybe)
-import qualified Data.Text as T
-import qualified Data.Text.Encoding as E
-import Data.Time.Clock (getCurrentTime)
-import qualified Data.UUID as U
-import Network.HTTP.Simple
-import Network.Wai.Handler.Warp (run)
-import Servant
-import System.Directory
-import Test.HUnit hiding (State)
-import Test.Hspec
-import ZcashHaskell.Orchard (isValidUnifiedAddress, parseAddress)
-import ZcashHaskell.Types
-  ( ZcashNet(..)
-  , ZebraGetBlockChainInfo(..)
-  , ZebraGetInfo(..)
-  )
-import Zenith.Core (checkBlockChain, checkZebra)
-import Zenith.DB (Operation(..), initDb, initPool, saveOperation)
-import Zenith.RPC
-  ( RpcCall(..)
-  , State(..)
-  , ZenithInfo(..)
-  , ZenithMethod(..)
-  , ZenithParams(..)
-  , ZenithRPC(..)
-  , ZenithResponse(..)
-  , authenticate
-  , zenithServer
-  )
-import Zenith.Types
-  ( Config(..)
-  , PrivacyPolicy(..)
-  , ProposedNote(..)
-  , ValidAddressAPI(..)
-  , ZcashAccountAPI(..)
-  , ZcashAddressAPI(..)
-  , ZcashWalletAPI(..)
-  , ZenithStatus(..)
-  , ZenithUuid(..)
-  )
-
-main :: IO ()
-main = do
-  config <- load ["$(HOME)/Zenith/zenith.cfg"]
-  let dbFilePath = "test.db"
-  nodeUser <- require config "nodeUser"
-  nodePwd <- require config "nodePwd"
-  zebraPort <- require config "zebraPort"
-  zebraHost <- require config "zebraHost"
-  nodePort <- require config "nodePort"
-  currencyCode <- require config "currencyCode"
-  let myConfig =
-        Config
-          dbFilePath
-          zebraHost
-          zebraPort
-          nodeUser
-          nodePwd
-          nodePort
-          currencyCode
-  hspec $ do
-    describe "RPC methods" $ do
-      beforeAll_ (startAPI myConfig) $ do
-        describe "getinfo" $ do
-          it "bad credentials" $ do
-            res <-
-              makeZenithCall
-                "127.0.0.1"
-                nodePort
-                "baduser"
-                "idontknow"
-                GetInfo
-                BlankParams
-            res `shouldBe` Left "Invalid credentials"
-          it "correct credentials" $ do
-            res <-
-              makeZenithCall
-                "127.0.0.1"
-                nodePort
-                nodeUser
-                nodePwd
-                GetInfo
-                BlankParams
-            case res of
-              Left e -> assertFailure e
-              Right r ->
-                r `shouldBe`
-                InfoResponse "zh" (ZenithInfo "0.8.0.0-beta" TestNet "v2.1.0")
-        describe "Wallets" $ do
-          describe "listwallet" $ do
-            it "bad credentials" $ do
-              res <-
-                makeZenithCall
-                  "127.0.0.1"
-                  nodePort
-                  "baduser"
-                  "idontknow"
-                  ListWallets
-                  BlankParams
-              res `shouldBe` Left "Invalid credentials"
-            it "correct credentials, no wallet" $ do
-              res <-
-                makeZenithCall
-                  "127.0.0.1"
-                  nodePort
-                  nodeUser
-                  nodePwd
-                  ListWallets
-                  BlankParams
-              case res of
-                Left e -> assertFailure e
-                Right r ->
-                  r `shouldBe`
-                  ErrorResponse
-                    "zh"
-                    (-32001)
-                    "No wallets available. Please create one first"
-          describe "getnewwallet" $ do
-            it "bad credentials" $ do
-              res <-
-                makeZenithCall
-                  "127.0.0.1"
-                  nodePort
-                  "baduser"
-                  "idontknow"
-                  GetNewWallet
-                  BlankParams
-              res `shouldBe` Left "Invalid credentials"
-            describe "correct credentials" $ do
-              it "no params" $ do
-                res <-
-                  makeZenithCall
-                    "127.0.0.1"
-                    nodePort
-                    nodeUser
-                    nodePwd
-                    GetNewWallet
-                    BlankParams
-                case res of
-                  Left e -> assertFailure e
-                  Right r ->
-                    r `shouldBe` ErrorResponse "zh" (-32602) "Invalid params"
-              it "Valid params" $ do
-                res <-
-                  makeZenithCall
-                    "127.0.0.1"
-                    nodePort
-                    nodeUser
-                    nodePwd
-                    GetNewWallet
-                    (NameParams "Main")
-                case res of
-                  Left e -> assertFailure e
-                  Right r -> r `shouldBe` NewItemResponse "zh" 1
-              it "duplicate name" $ do
-                res <-
-                  makeZenithCall
-                    "127.0.0.1"
-                    nodePort
-                    nodeUser
-                    nodePwd
-                    GetNewWallet
-                    (NameParams "Main")
-                case res of
-                  Left e -> assertFailure e
-                  Right r ->
-                    r `shouldBe`
-                    ErrorResponse
-                      "zh"
-                      (-32007)
-                      "Entity with that name already exists."
-          describe "listwallet" $ do
-            it "wallet exists" $ do
-              res <-
-                makeZenithCall
-                  "127.0.0.1"
-                  nodePort
-                  nodeUser
-                  nodePwd
-                  ListWallets
-                  BlankParams
-              case res of
-                Left e -> assertFailure e
-                Right (WalletListResponse i k) ->
-                  zw_name (head k) `shouldBe` "Main"
-                Right _ -> assertFailure "Unexpected response"
-        describe "Accounts" $ do
-          describe "listaccounts" $ do
-            it "bad credentials" $ do
-              res <-
-                makeZenithCall
-                  "127.0.0.1"
-                  nodePort
-                  "baduser"
-                  "idontknow"
-                  ListAccounts
-                  BlankParams
-              res `shouldBe` Left "Invalid credentials"
-            describe "correct credentials" $ do
-              it "invalid wallet" $ do
-                res <-
-                  makeZenithCall
-                    "127.0.0.1"
-                    nodePort
-                    nodeUser
-                    nodePwd
-                    ListAccounts
-                    (AccountsParams 17)
-                case res of
-                  Left e -> assertFailure e
-                  Right r ->
-                    r `shouldBe`
-                    ErrorResponse "zh" (-32008) "Wallet does not exist."
-              it "valid wallet, no accounts" $ do
-                res <-
-                  makeZenithCall
-                    "127.0.0.1"
-                    nodePort
-                    nodeUser
-                    nodePwd
-                    ListAccounts
-                    (AccountsParams 1)
-                case res of
-                  Left e -> assertFailure e
-                  Right r ->
-                    r `shouldBe`
-                    ErrorResponse
-                      "zh"
-                      (-32002)
-                      "No accounts available for this wallet. Please create one first"
-          describe "getnewaccount" $ do
-            it "invalid credentials" $ do
-              res <-
-                makeZenithCall
-                  "127.0.0.1"
-                  nodePort
-                  "baduser"
-                  "idontknow"
-                  GetNewAccount
-                  BlankParams
-              res `shouldBe` Left "Invalid credentials"
-            describe "correct credentials" $ do
-              it "invalid wallet" $ do
-                res <-
-                  makeZenithCall
-                    "127.0.0.1"
-                    nodePort
-                    nodeUser
-                    nodePwd
-                    GetNewAccount
-                    (NameIdParams "Personal" 17)
-                case res of
-                  Left e -> assertFailure e
-                  Right r ->
-                    r `shouldBe`
-                    ErrorResponse "zh" (-32008) "Wallet does not exist."
-              it "valid wallet" $ do
-                res <-
-                  makeZenithCall
-                    "127.0.0.1"
-                    nodePort
-                    nodeUser
-                    nodePwd
-                    GetNewAccount
-                    (NameIdParams "Personal" 1)
-                case res of
-                  Left e -> assertFailure e
-                  Right r -> r `shouldBe` NewItemResponse "zh" 1
-              it "valid wallet, duplicate name" $ do
-                res <-
-                  makeZenithCall
-                    "127.0.0.1"
-                    nodePort
-                    nodeUser
-                    nodePwd
-                    GetNewAccount
-                    (NameIdParams "Personal" 1)
-                case res of
-                  Left e -> assertFailure e
-                  Right r ->
-                    r `shouldBe`
-                    ErrorResponse
-                      "zh"
-                      (-32007)
-                      "Entity with that name already exists."
-          describe "listaccounts" $ do
-            it "valid wallet" $ do
-              res <-
-                makeZenithCall
-                  "127.0.0.1"
-                  nodePort
-                  nodeUser
-                  nodePwd
-                  ListAccounts
-                  (AccountsParams 1)
-              case res of
-                Left e -> assertFailure e
-                Right r ->
-                  r `shouldBe`
-                  AccountListResponse "zh" [ZcashAccountAPI 1 1 "Personal"]
-        describe "Addresses" $ do
-          describe "listaddresses" $ do
-            it "bad credentials" $ do
-              res <-
-                makeZenithCall
-                  "127.0.0.1"
-                  nodePort
-                  "baduser"
-                  "idontknow"
-                  ListAddresses
-                  BlankParams
-              res `shouldBe` Left "Invalid credentials"
-            it "correct credentials, no addresses" $ do
-              res <-
-                makeZenithCall
-                  "127.0.0.1"
-                  nodePort
-                  nodeUser
-                  nodePwd
-                  ListAddresses
-                  (AddressesParams 1)
-              case res of
-                Left e -> assertFailure e
-                Right r ->
-                  r `shouldBe`
-                  ErrorResponse
-                    "zh"
-                    (-32003)
-                    "No addresses available for this account. Please create one first"
-          describe "getnewaddress" $ do
-            it "bad credentials" $ do
-              res <-
-                makeZenithCall
-                  "127.0.0.1"
-                  nodePort
-                  "baduser"
-                  "idontknow"
-                  GetNewAddress
-                  BlankParams
-              res `shouldBe` Left "Invalid credentials"
-            describe "correct credentials" $ do
-              it "invalid account" $ do
-                res <-
-                  makeZenithCall
-                    "127.0.0.1"
-                    nodePort
-                    nodeUser
-                    nodePwd
-                    GetNewAddress
-                    (NewAddrParams 17 "Business" False False)
-                case res of
-                  Left e -> assertFailure e
-                  Right r ->
-                    r `shouldBe`
-                    ErrorResponse "zh" (-32006) "Account does not exist."
-              it "valid account" $ do
-                res <-
-                  makeZenithCall
-                    "127.0.0.1"
-                    nodePort
-                    nodeUser
-                    nodePwd
-                    GetNewAddress
-                    (NewAddrParams 1 "Business" False False)
-                case res of
-                  Left e -> assertFailure e
-                  Right (NewAddrResponse i a) -> zd_name a `shouldBe` "Business"
-                  Right _ -> assertFailure "unexpected response"
-              it "valid account, duplicate name" $ do
-                res <-
-                  makeZenithCall
-                    "127.0.0.1"
-                    nodePort
-                    nodeUser
-                    nodePwd
-                    GetNewAddress
-                    (NewAddrParams 1 "Business" False False)
-                case res of
-                  Left e -> assertFailure e
-                  Right r ->
-                    r `shouldBe`
-                    ErrorResponse
-                      "zh"
-                      (-32007)
-                      "Entity with that name already exists."
-              it "valid account, no sapling" $ do
-                res <-
-                  makeZenithCall
-                    "127.0.0.1"
-                    nodePort
-                    nodeUser
-                    nodePwd
-                    GetNewAddress
-                    (NewAddrParams 1 "NoSapling" True False)
-                case res of
-                  Left e -> assertFailure e
-                  Right (NewAddrResponse i a) -> zd_legacy a `shouldBe` Nothing
-                  Right _ -> assertFailure "unexpected response"
-              it "valid account, no transparent" $ do
-                res <-
-                  makeZenithCall
-                    "127.0.0.1"
-                    nodePort
-                    nodeUser
-                    nodePwd
-                    GetNewAddress
-                    (NewAddrParams 1 "NoTransparent" False True)
-                case res of
-                  Left e -> assertFailure e
-                  Right (NewAddrResponse i a) ->
-                    zd_transparent a `shouldBe` Nothing
-                  Right _ -> assertFailure "unexpected response"
-              it "valid account, orchard only" $ do
-                res <-
-                  makeZenithCall
-                    "127.0.0.1"
-                    nodePort
-                    nodeUser
-                    nodePwd
-                    GetNewAddress
-                    (NewAddrParams 1 "OrchOnly" True True)
-                case res of
-                  Left e -> assertFailure e
-                  Right (NewAddrResponse i a) ->
-                    a `shouldSatisfy`
-                    (\b ->
-                       (zd_transparent b == Nothing) && (zd_legacy b == Nothing))
-                  Right _ -> assertFailure "unexpected response"
-          describe "listaddresses" $ do
-            it "correct credentials, addresses exist" $ do
-              res <-
-                makeZenithCall
-                  "127.0.0.1"
-                  nodePort
-                  nodeUser
-                  nodePwd
-                  ListAddresses
-                  (AddressesParams 1)
-              case res of
-                Left e -> assertFailure e
-                Right (AddressListResponse i a) -> length a `shouldBe` 4
-        describe "Notes" $ do
-          describe "listreceived" $ do
-            it "bad credentials" $ do
-              res <-
-                makeZenithCall
-                  "127.0.0.1"
-                  nodePort
-                  "baduser"
-                  "idontknow"
-                  ListReceived
-                  BlankParams
-              res `shouldBe` Left "Invalid credentials"
-            describe "correct credentials" $ do
-              it "no parameters" $ do
-                res <-
-                  makeZenithCall
-                    "127.0.0.1"
-                    nodePort
-                    nodeUser
-                    nodePwd
-                    ListReceived
-                    BlankParams
-                case res of
-                  Left e -> assertFailure e
-                  Right (ErrorResponse i c m) -> c `shouldBe` (-32602)
-              it "unknown index" $ do
-                res <-
-                  makeZenithCall
-                    "127.0.0.1"
-                    nodePort
-                    nodeUser
-                    nodePwd
-                    ListReceived
-                    (NotesParams "17")
-                case res of
-                  Left e -> assertFailure e
-                  Right (ErrorResponse i c m) -> c `shouldBe` (-32004)
-        describe "Balance" $ do
-          describe "getbalance" $ do
-            it "bad credentials" $ do
-              res <-
-                makeZenithCall
-                  "127.0.0.1"
-                  nodePort
-                  "baduser"
-                  "idontknow"
-                  GetBalance
-                  BlankParams
-              res `shouldBe` Left "Invalid credentials"
-            describe "correct credentials" $ do
-              it "no parameters" $ do
-                res <-
-                  makeZenithCall
-                    "127.0.0.1"
-                    nodePort
-                    nodeUser
-                    nodePwd
-                    GetBalance
-                    BlankParams
-                case res of
-                  Left e -> assertFailure e
-                  Right (ErrorResponse i c m) -> c `shouldBe` (-32602)
-              it "unknown index" $ do
-                res <-
-                  makeZenithCall
-                    "127.0.0.1"
-                    nodePort
-                    nodeUser
-                    nodePwd
-                    GetBalance
-                    (BalanceParams 17)
-                case res of
-                  Left e -> assertFailure e
-                  Right (ErrorResponse i c m) -> c `shouldBe` (-32006)
-        describe "Operations" $ do
-          describe "getoperationstatus" $ do
-            it "bad credentials" $ do
-              res <-
-                makeZenithCall
-                  "127.0.0.1"
-                  nodePort
-                  "baduser"
-                  "idontknow"
-                  GetOperationStatus
-                  BlankParams
-              res `shouldBe` Left "Invalid credentials"
-            describe "correct credentials" $ do
-              it "invalid ID" $ do
-                res <-
-                  makeZenithCall
-                    "127.0.0.1"
-                    nodePort
-                    nodeUser
-                    nodePwd
-                    GetOperationStatus
-                    (NameParams "badId")
-                case res of
-                  Left e -> assertFailure e
-                  Right (ErrorResponse i c m) -> c `shouldBe` (-32602)
-              it "valid ID" $ do
-                res <-
-                  makeZenithCall
-                    "127.0.0.1"
-                    nodePort
-                    nodeUser
-                    nodePwd
-                    GetOperationStatus
-                    (OpParams
-                       (ZenithUuid $
-                        fromMaybe U.nil $
-                        U.fromText "bd2aa95a-db51-4cc4-9fea-0f9cf79003a4"))
-                case res of
-                  Left e -> assertFailure e
-                  Right (OpResponse i o) ->
-                    operationUuid o `shouldBe`
-                    (ZenithUuid $
-                     fromMaybe U.nil $
-                     U.fromText "bd2aa95a-db51-4cc4-9fea-0f9cf79003a4")
-                  Right _ -> assertFailure "unexpected response"
-              it "valid ID not found" $ do
-                res <-
-                  makeZenithCall
-                    "127.0.0.1"
-                    nodePort
-                    nodeUser
-                    nodePwd
-                    GetOperationStatus
-                    (OpParams
-                       (ZenithUuid $
-                        fromMaybe U.nil $
-                        U.fromText "bd2aa95a-db51-4cc4-9fea-0f9cf79003a5"))
-                case res of
-                  Left e -> assertFailure e
-                  Right (ErrorResponse i c m) -> c `shouldBe` (-32009)
-                  Right _ -> assertFailure "unexpected response"
-        describe "Send tx" $ do
-          describe "sendmany" $ do
-            it "bad credentials" $ do
-              res <-
-                makeZenithCall
-                  "127.0.0.1"
-                  nodePort
-                  "baduser"
-                  "idontknow"
-                  SendMany
-                  BlankParams
-              res `shouldBe` Left "Invalid credentials"
-            describe "correct credentials" $ do
-              it "invalid account" $ do
-                let uaRead =
-                      parseAddress
-                        "utest1dl54utt6prjj5e0dnlknwumnxq9hycdjpkfr0sy6e6h522remqee8axe9zax0wsjrwpj76v555pdhvj9rnargpfyycs0vpkapq98xcdhem99gc4wchzn0ggepq3y6nz3a9sscwgqxgsh9vzhcad402y3x9szfregck5gslkya3c79d86xx0l33tpk8gnn7ew9vw37w43zh22u8dgdax"
-                res <-
-                  makeZenithCall
-                    "127.0.0.1"
-                    nodePort
-                    nodeUser
-                    nodePwd
-                    SendMany
-                    (SendParams
-                       17
-                       [ ProposedNote
-                           (ValidAddressAPI $ fromJust uaRead)
-                           0.005
-                           (Just "A cool memo")
-                       ]
-                       Full)
-                case res of
-                  Left e -> assertFailure e
-                  Right (ErrorResponse i c m) -> c `shouldBe` (-32006)
-              it "valid account, empty notes" $ do
-                let uaRead =
-                      parseAddress
-                        "utest1dl54utt6prjj5e0dnlknwumnxq9hycdjpkfr0sy6e6h522remqee8axe9zax0wsjrwpj76v555pdhvj9rnargpfyycs0vpkapq98xcdhem99gc4wchzn0ggepq3y6nz3a9sscwgqxgsh9vzhcad402y3x9szfregck5gslkya3c79d86xx0l33tpk8gnn7ew9vw37w43zh22u8dgdax"
-                res <-
-                  makeZenithCall
-                    "127.0.0.1"
-                    nodePort
-                    nodeUser
-                    nodePwd
-                    SendMany
-                    (SendParams 1 [] Full)
-                case res of
-                  Left e -> assertFailure e
-                  Right (ErrorResponse i c m) -> c `shouldBe` (-32602)
-              it "valid account, single output" $ do
-                let uaRead =
-                      parseAddress
-                        "utest1dl54utt6prjj5e0dnlknwumnxq9hycdjpkfr0sy6e6h522remqee8axe9zax0wsjrwpj76v555pdhvj9rnargpfyycs0vpkapq98xcdhem99gc4wchzn0ggepq3y6nz3a9sscwgqxgsh9vzhcad402y3x9szfregck5gslkya3c79d86xx0l33tpk8gnn7ew9vw37w43zh22u8dgdax"
-                res <-
-                  makeZenithCall
-                    "127.0.0.1"
-                    nodePort
-                    nodeUser
-                    nodePwd
-                    SendMany
-                    (SendParams
-                       1
-                       [ ProposedNote
-                           (ValidAddressAPI $ fromJust uaRead)
-                           5.0
-                           (Just "A cool memo")
-                       ]
-                       Full)
-                case res of
-                  Left e -> assertFailure e
-                  Right (SendResponse i o) -> o `shouldNotBe` U.nil
-              it "valid account, multiple outputs" $ do
-                let uaRead =
-                      parseAddress
-                        "utest1dl54utt6prjj5e0dnlknwumnxq9hycdjpkfr0sy6e6h522remqee8axe9zax0wsjrwpj76v555pdhvj9rnargpfyycs0vpkapq98xcdhem99gc4wchzn0ggepq3y6nz3a9sscwgqxgsh9vzhcad402y3x9szfregck5gslkya3c79d86xx0l33tpk8gnn7ew9vw37w43zh22u8dgdax"
-                let uaRead2 =
-                      parseAddress
-                        "ztestsapling136jp8z89v2jh6kqd5rs4dtvlxym90m43svzdwzxaplyvc5ttzppytpvx80ncllcsqzpmukxjl3y"
-                res <-
-                  makeZenithCall
-                    "127.0.0.1"
-                    nodePort
-                    nodeUser
-                    nodePwd
-                    SendMany
-                    (SendParams
-                       1
-                       [ ProposedNote
-                           (ValidAddressAPI $ fromJust uaRead)
-                           5.0
-                           (Just "A cool memo")
-                       , ProposedNote
-                           (ValidAddressAPI $ fromJust uaRead2)
-                           1.0
-                           (Just "Not so cool memo")
-                       ]
-                       Full)
-                case res of
-                  Left e -> assertFailure e
-                  Right (SendResponse i o) -> o `shouldNotBe` U.nil
-        describe "Shield notes" $ do
-          it "bad credentials" $ do
-            res <-
-              makeZenithCall
-                "127.0.0.1"
-                nodePort
-                "baduser"
-                "idontknow"
-                ShieldNotes
-                BlankParams
-            res `shouldBe` Left "Invalid credentials"
-          describe "correct credentials" $ do
-            it "no parameters" $ do
-              res <-
-                makeZenithCall
-                  "127.0.0.1"
-                  nodePort
-                  nodeUser
-                  nodePwd
-                  ShieldNotes
-                  BlankParams
-              case res of
-                Left e -> assertFailure e
-                Right (ErrorResponse i c m) -> c `shouldBe` (-32602)
-            it "invalid account" $ do
-              res <-
-                makeZenithCall
-                  "127.0.0.1"
-                  nodePort
-                  nodeUser
-                  nodePwd
-                  ShieldNotes
-                  (ShieldNotesParams 27)
-              case res of
-                Left e -> assertFailure e
-                Right (ErrorResponse i c m) -> c `shouldBe` (-32006)
-            it "valid account" $ do
-              res <-
-                makeZenithCall
-                  "127.0.0.1"
-                  nodePort
-                  nodeUser
-                  nodePwd
-                  ShieldNotes
-                  (ShieldNotesParams 1)
-              case res of
-                Left e -> assertFailure e
-                Right (MultiOpResponse i c) -> c `shouldNotBe` []
-        describe "Viewing Keys" $ do
-          describe "Full" $ do
-            it "bad credentials" $ do
-              res <-
-                makeZenithCall
-                  "127.0.0.1"
-                  nodePort
-                  "baduser"
-                  "idontknow"
-                  GetFVK
-                  BlankParams
-              res `shouldBe` Left "Invalid credentials"
-            describe "correct credentials" $ do
-              it "no parameters" $ do
-                res <-
-                  makeZenithCall
-                    "127.0.0.1"
-                    nodePort
-                    nodeUser
-                    nodePwd
-                    GetFVK
-                    BlankParams
-                case res of
-                  Left e -> assertFailure e
-                  Right (ErrorResponse i c m) -> c `shouldBe` (-32602)
-              it "invalid account" $ do
-                res <-
-                  makeZenithCall
-                    "127.0.0.1"
-                    nodePort
-                    nodeUser
-                    nodePwd
-                    GetFVK
-                    (ViewingKeyParams 27)
-                case res of
-                  Left e -> assertFailure e
-                  Right (ErrorResponse i c m) -> c `shouldBe` (-32006)
-              it "valid account" $ do
-                res <-
-                  makeZenithCall
-                    "127.0.0.1"
-                    nodePort
-                    nodeUser
-                    nodePwd
-                    GetFVK
-                    (ViewingKeyParams 1)
-                case res of
-                  Left e -> assertFailure e
-                  Right (ViewingKeyResponse i c) -> c `shouldNotBe` ""
-                  Right x -> assertFailure $ show x
-          describe "Incoming" $ do
-            it "bad credentials" $ do
-              res <-
-                makeZenithCall
-                  "127.0.0.1"
-                  nodePort
-                  "baduser"
-                  "idontknow"
-                  GetIVK
-                  BlankParams
-              res `shouldBe` Left "Invalid credentials"
-            describe "correct credentials" $ do
-              it "no parameters" $ do
-                res <-
-                  makeZenithCall
-                    "127.0.0.1"
-                    nodePort
-                    nodeUser
-                    nodePwd
-                    GetIVK
-                    BlankParams
-                case res of
-                  Left e -> assertFailure e
-                  Right (ErrorResponse i c m) -> c `shouldBe` (-32602)
-              it "invalid account" $ do
-                res <-
-                  makeZenithCall
-                    "127.0.0.1"
-                    nodePort
-                    nodeUser
-                    nodePwd
-                    GetIVK
-                    (ViewingKeyParams 27)
-                case res of
-                  Left e -> assertFailure e
-                  Right (ErrorResponse i c m) -> c `shouldBe` (-32006)
-              it "valid account" $ do
-                res <-
-                  makeZenithCall
-                    "127.0.0.1"
-                    nodePort
-                    nodeUser
-                    nodePwd
-                    GetIVK
-                    (ViewingKeyParams 1)
-                case res of
-                  Left e -> assertFailure e
-                  Right (ViewingKeyResponse i c) -> c `shouldNotBe` ""
-                  Right x -> assertFailure $ show x
-
-startAPI :: Config -> IO ()
-startAPI config = do
-  putStrLn "Starting test RPC server"
-  checkDbFile <- doesFileExist "test.db"
-  when checkDbFile $ removeFile "test.db"
-  let ctx = authenticate config :. EmptyContext
-  w <-
-    try $ checkZebra (c_zebraHost config) (c_zebraPort config) :: IO
-      (Either IOError ZebraGetInfo)
-  case w of
-    Right zebra -> do
-      bc <-
-        try $ checkBlockChain (c_zebraHost config) (c_zebraPort config) :: IO
-          (Either IOError ZebraGetBlockChainInfo)
-      case bc of
-        Left e1 -> throwIO e1
-        Right chainInfo -> do
-          x <- initDb "test.db"
-          case x of
-            Left e2 -> throwIO $ userError e2
-            Right x' -> do
-              pool <- runNoLoggingT $ initPool "test.db"
-              ts <- getCurrentTime
-              y <-
-                saveOperation
-                  pool
-                  (Operation
-                     (ZenithUuid $
-                      fromMaybe U.nil $
-                      U.fromText "bd2aa95a-db51-4cc4-9fea-0f9cf79003a4")
-                     ts
-                     Nothing
-                     Processing
-                     Nothing)
-              let myState =
-                    State
-                      (zgb_net chainInfo)
-                      (c_zebraHost config)
-                      (c_zebraPort config)
-                      "test.db"
-                      (zgi_build zebra)
-                      (zgb_blocks chainInfo)
-              forkIO $
-                run (c_zenithPort config) $
-                serveWithContext
-                  (Servant.Proxy :: Servant.Proxy ZenithRPC)
-                  ctx
-                  (zenithServer myState)
-              threadDelay 1000000
-              putStrLn "Test server is up!"
-
--- | Make a Zebra RPC call
-makeZenithCall ::
-     T.Text -- ^ Hostname for `zebrad`
-  -> Int -- ^ Port for `zebrad`
-  -> BS.ByteString
-  -> BS.ByteString
-  -> ZenithMethod -- ^ RPC method to call
-  -> ZenithParams -- ^ List of parameters
-  -> IO (Either String ZenithResponse)
-makeZenithCall host port usr pwd m params = do
-  let payload = RpcCall "2.0" "zh" m params
-  let myRequest =
-        setRequestBodyJSON payload $
-        setRequestPort port $
-        setRequestHost (E.encodeUtf8 host) $
-        setRequestBasicAuth usr pwd $ setRequestMethod "POST" defaultRequest
-  r <- httpJSONEither myRequest
-  case getResponseStatusCode r of
-    403 -> return $ Left "Invalid credentials"
-    200 ->
-      case getResponseBody r of
-        Left e -> return $ Left $ show e
-        Right r' -> return $ Right r'
-    e -> return $ Left $ show e ++ show (getResponseBody r)

zcash-haskell

@@ -1 +1 @@
-Subproject commit a28edcb5995667677e96a08c6952a568bfd6c51e
+Subproject commit 90c8a7c3028bd6836dea5655221277a25d457653

zenith.cabal

@@ -1,6 +1,6 @@
 cabal-version:    3.0
 name:             zenith
-version:          0.8.0.0-beta
+version:          0.5.3.1-beta
 license:          MIT
 license-file:     LICENSE
 author:           Rene Vergara
@@ -27,40 +27,32 @@ library
   ghc-options: -Wall -Wunused-imports
   exposed-modules:
     Zenith.CLI
-    Zenith.GUI
-    Zenith.GUI.Theme
     Zenith.Core
     Zenith.DB
     Zenith.Types
     Zenith.Utils
     Zenith.Zcashd
     Zenith.Scanner
-    Zenith.RPC
-    Zenith.Tree
   hs-source-dirs:
     src
   build-depends:
       Clipboard
-    , Hclip
-    , JuicyPixels
     , aeson
     , array
     , ascii-progress
-    , async
     , base >=4.12 && <5
     , base64-bytestring
-    , binary
-    , borsh
     , brick
     , bytestring
-    , configurator
-    , data-default
-    , directory
     , esqueleto
+    , resource-pool
+    , binary
     , exceptions
-    , filepath
+    , monad-logger
+    , vty-crossplatform
+    , secp256k1-haskell
+    , pureMD5
     , ghc
-    , generics-sop
     , haskoin-core
     , hexstring
     , http-client
@@ -69,35 +61,22 @@ library
     , microlens
     , microlens-mtl
     , microlens-th
-    , monad-logger
-    , transformers
-    , monomer
     , mtl
     , persistent
+    , Hclip
     , persistent-sqlite
     , persistent-template
     , process
-    , pureMD5
-    , qrcode-core
-    , qrcode-juicypixels
     , regex-base
     , regex-compat
     , regex-posix
-    , resource-pool
     , scientific
-    , secp256k1-haskell >= 1
-    , servant-server
     , text
-    , text-show
     , time
-    , uuid
     , vector
     , vty
-    , vty-crossplatform
     , word-wrap
     , zcash-haskell
-    , unordered-containers
-    , network-uri
   --pkgconfig-depends: rustzcash_wrapper
   default-language: Haskell2010
 
@@ -113,7 +92,7 @@ executable zenith
     , configurator
     , data-default
     , sort
-    --, structured-cli
+    , structured-cli
     , text
     , time
     , zenith
@@ -121,21 +100,15 @@ executable zenith
   pkgconfig-depends: rustzcash_wrapper
   default-language: Haskell2010
 
-executable zenithserver
+executable zenscan
-  ghc-options: -main-is Server -threaded -rtsopts -with-rtsopts=-N
+  ghc-options: -main-is ZenScan -threaded -rtsopts -with-rtsopts=-N
-  main-is: Server.hs
+  main-is: ZenScan.hs
   hs-source-dirs:
     app
   build-depends:
       base >=4.12 && <5
     , configurator
     , monad-logger
-    , wai-extra
-    , warp
-    , servant-server
-    , text
-    , unix
-    , zcash-haskell
     , zenith
   pkgconfig-depends: rustzcash_wrapper
   default-language: Haskell2010
@@ -149,11 +122,8 @@ test-suite zenith-tests
   build-depends:
       base >=4.12 && <5
     , bytestring
-    , aeson
     , configurator
     , monad-logger
-    , borsh
-    , aeson
     , data-default
     , sort
     , text
@@ -168,34 +138,3 @@ test-suite zenith-tests
     , zenith
   pkgconfig-depends: rustzcash_wrapper
   default-language: Haskell2010
-
-test-suite zenithserver-tests
-  type: exitcode-stdio-1.0
-  ghc-options: -threaded -rtsopts -with-rtsopts=-N
-  main-is: ServerSpec.hs
-  hs-source-dirs:
-    test
-  build-depends:
-      base >=4.12 && <5
-    , bytestring
-    , aeson
-    , configurator
-    , monad-logger
-    , data-default
-    , sort
-    , text
-    , time
-    , uuid
-    , http-conduit
-    , persistent
-    , persistent-sqlite
-    , hspec
-    , hexstring
-    , warp
-    , servant-server
-    , HUnit
-    , directory
-    , zcash-haskell
-    , zenith
-  pkgconfig-depends: rustzcash_wrapper
-  default-language: Haskell2010

zenith.cfg

@@ -1,38 +1,5 @@
-# 
-# Zenith Configuration File
-# 
-# -------------------------------------------------------------
-# nodeUser - 
-# -------------------------------------------------------------
 nodeUser = "user"
-# -------------------------------------------------------------
-# nodePwd -
 nodePwd = "superSecret"
-# -------------------------------------------------------------
+dbFilePath = "zenith.db"
-# dbFileName  - contains the SQLite database name used for
-#			    keeping all Zenith's data
-#               default = zenith.db 
-#
-dbFileName = "zenith.db"
-# -------------------------------------------------------------
-# zebraHost   - Zebra IP 
-#				Default - "127.0.0.1" 
 zebraHost = "127.0.0.1"
-# -------------------------------------------------------------
-# zebraPort   - Port used for access Zebra API endpoints
-#			    must be the same port configured for your 
-#				Zebra node
 zebraPort = 18232
-# -------------------------------------------------------------
-# currencyCode  - ISO 4217 currency code 
-#
-#  Example of currency codes are:
-#
-#      United States -> currencyCode = "usd"	
-#      Canada        -> currencyCode = "cnd"	
-#      Australia     -> currencyCode = "aud"
-#      Euro Region   -> currencyCode = "eur"	
-#      Great Britain -> currencyCode = "gbp"	
-#      Japan         -> currencyCode = "jpy"		
-#                 
-currencyCode = "usd"