.gitignore

@@ -1,2 +1,3 @@
 .stack-work/
 *~
+dist-newstyle/

.gitmodules

@@ -1,6 +1,4 @@
-[submodule "haskoin-core"]
-	path = haskoin-core
-	url = https://github.com/khazaddum/haskoin-core.git
 [submodule "zcash-haskell"]
 	path = zcash-haskell
-	url = git@git.vergara.tech:Vergara_Tech/zcash-haskell.git
+	url = https://git.vergara.tech/Vergara_Tech/zcash-haskell.git
+	branch = dev040

CHANGELOG.md

@@ -5,6 +5,55 @@ 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.5.0.0]
+
+### Added
+
+- Core functions for sending transactions
+
+## [0.4.6.0]
+
+### Added
+
+- Display of account balance
+- Functions to identify spends
+- Functions to display transactions per address
+
+### Changed
+
+- Update `zcash-haskell`
+
+## [0.4.5.0]
+
+### Added
+
+- Functions to scan relevant transparent notes
+- Functions to scan relevant Sapling notes
+- Functions to scan relevant Orchard notes
+- Function to query `zebrad` for commitment trees
+
+### Changed
+
+- Update `zcash-haskell`
+
+## [0.4.4.3]
+
+### Added
+
+- `Core` module
+- `CLI` module
+- `DB` module
+- Command line arguments to switch to legacy version
+- New configuration parameter for Zebra port
+- New functions to call `getinfo` and `getblockchaininfo` RPC methods
+- `Scanner` module
+
+## [0.4.1]
+
+### Fixed
+
+- Handling of transactions to transparent receivers
+
 ## [0.4.0]
 
 ### Added

LICENSE

@@ -1,178 +1,22 @@
-Copyright (c) 2022 Vergara Technologies
+MIT License
 
-=======================================================
+Copyright (c) 2022-2024 Vergara Technologies LLC
-Bootstrap Open Source Licence ("BOSL") v. 1.0
-=======================================================
-This Bootstrap Open Source Licence (the "License") applies to any original work
-of authorship (the "Original Work") whose owner (the "Licensor") has placed the
-following licensing notice adjacent to the copyright notice for the Original
-Work:
 
-*Licensed under the Bootstrap Open Source Licence version 1.0*
+Permission is hereby granted, free of charge, to any person obtaining a copy
+of this software and associated documentation files (the "Software"), to deal
+in the Software without restriction, including without limitation the rights
+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
+copies of the Software, and to permit persons to whom the Software is
+furnished to do so, subject to the following conditions:
 
-1.  **Grant of Copyright License.** Licensor grants You a worldwide,
+The above copyright notice and this permission notice shall be included in all
-    royalty-free, non-exclusive, sublicensable license, for the duration of the
+copies or substantial portions of the Software.
-    copyright in the Original Work, to do the following:
 
-        a. to reproduce the Original Work in copies, either alone or as part of
+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
-        a collective work;
+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+SOFTWARE.
 
-        b. to translate, adapt, alter, transform, modify, or arrange the
-        Original Work, thereby creating derivative works ("Derivative Works")
-        based upon the Original Work;
-
-        c. to distribute or communicate copies of the Original Work and
-        Derivative Works to the public, provided that prior to any such
-        distribution or communication You first place a machine-readable copy
-        of the Source Code of the Original Work and such Derivative Works that
-        You intend to distribute or communicate in an information repository
-        reasonably calculated to permit inexpensive and convenient access
-        thereto by the public (“Information Repository”) for as long as You
-        continue to distribute or communicate said copies, accompanied by an
-        irrevocable offer to license said copies to the public free of charge
-        under this License, said offer valid starting no later than 12 months
-        after You first distribute or communicate said copies;
-
-    d. to perform the Original Work publicly; and
-
-    e. to display the Original Work publicly.
-
-2.  **Grant of Patent License.** Licensor grants You a worldwide, royalty-free,
-non-exclusive, sublicensable license, under patent claims owned or controlled
-by the Licensor that are embodied in the Original Work as furnished by the
-Licensor, for the duration of the patents, to make, use, sell, offer for sale,
-have made, and import the Original Work and Derivative Works.
-
-3.  **Grant of Source Code License.** The "Source Code" for a work means the
-preferred form of the work for making modifications to it and all available
-documentation describing how to modify the work. Licensor agrees to provide a
-machine-readable copy of the Source Code of the Original Work along with each
-copy of the Original Work that Licensor distributes. Licensor reserves the
-right to satisfy this obligation by placing a machine-readable copy of said
-Source Code in an Information Repository for as long as Licensor continues to
-distribute the Original Work.
-
-4.  **Exclusions From License Grant.** Neither the names of Licensor, nor the
-names of any contributors to the Original Work, nor any of their trademarks or
-service marks, may be used to endorse or promote products derived from this
-Original Work without express prior permission of the Licensor. Except as
-expressly stated herein, nothing in this License grants any license to
-Licensor's trademarks, copyrights, patents, trade secrets or any other
-intellectual property. No patent license is granted to make, use, sell, offer
-for sale, have made, or import embodiments of any patent claims other than the
-licensed claims defined in Section 2. No license is granted to the trademarks
-of Licensor even if such marks are included in the Original Work. Nothing in
-this License shall be interpreted to prohibit Licensor from licensing under
-terms different from this License any Original Work that Licensor otherwise
-would have a right to license.
-
-5.  **External Deployment.** The term "External Deployment" means the use,
-distribution, or communication of the Original Work or Derivative Works in any
-way such that the Original Work or Derivative Works may be used by anyone other
-than You, whether those works are distributed or communicated to those persons
-or made available as an application intended for use over a network. As an
-express condition for the grants of license hereunder, You must treat any
-External Deployment by You of the Original Work or a Derivative Work as a
-distribution under section 1(c).
-
-6.  **Attribution Rights.** You must retain, in the Source Code of any
-Derivative Works that You create, all copyright, patent, or trademark notices
-from the Source Code of the Original Work, as well as any notices of licensing
-and any descriptive text identified therein as an "Attribution Notice." You
-must cause the Source Code for any Derivative Works that You create to carry a
-prominent Attribution Notice reasonably calculated to inform recipients that
-You have modified the Original Work.
-
-7.  **Warranty of Provenance and Disclaimer of Warranty.** Licensor warrants
-that the copyright in and to the Original Work and the patent rights granted
-herein by Licensor are owned by the Licensor or are sublicensed to You under
-the terms of this License with the permission of the contributor(s) of those
-copyrights and patent rights. Except as expressly stated in the immediately
-preceding sentence, the Original Work is provided under this License on an "AS
-IS" BASIS and WITHOUT WARRANTY, either express or implied, including, without
-limitation, the warranties of non-infringement, merchantability or fitness for
-a particular purpose. THE ENTIRE RISK AS TO THE QUALITY OF THE ORIGINAL WORK IS
-WITH YOU. This DISCLAIMER OF WARRANTY constitutes an essential part of this
-License. No license to the Original Work is granted by this License except
-under this disclaimer.
-
-8.  **Limitation of Liability.** Under no circumstances and under no legal
-theory, whether in tort (including negligence), contract, or otherwise, shall
-the Licensor be liable to anyone for any indirect, special, incidental, or
-consequential damages of any character arising as a result of this License or
-the use of the Original Work including, without limitation, damages for loss of
-goodwill, work stoppage, computer failure or malfunction, or any and all other
-commercial damages or losses. This limitation of liability shall not apply to
-the extent applicable law prohibits such limitation.
-
-9.  **Acceptance and Termination.** If, at any time, You expressly assented to
-this License, that assent indicates your clear and irrevocable acceptance of
-this License and all of its terms and conditions. If You distribute or
-communicate copies of the Original Work or a Derivative Work, You must make a
-reasonable effort under the circumstances to obtain the express assent of
-recipients to the terms of this License. This License conditions your rights to
-undertake the activities listed in Section 1, including your right to create
-Derivative Works based upon the Original Work, and doing so without honoring
-these terms and conditions is prohibited by copyright law and international
-treaty. Nothing in this License is intended to affect copyright exceptions and
-limitations (including 'fair use' or 'fair dealing'). This License shall
-terminate immediately and You may no longer exercise any of the rights granted
-to You by this License upon your failure to honor the conditions in Section
-1(c).
-
-10.  **Termination for Patent Action.** This License shall terminate
-automatically and You may no longer exercise any of the rights granted to You
-by this License as of the date You commence an action, including a cross-claim
-or counterclaim, against Licensor or any licensee alleging that the Original
-Work infringes a patent. This termination provision shall not apply for an
-action alleging patent infringement by combinations of the Original Work with
-other software or hardware.
-
-11.  **Jurisdiction, Venue and Governing Law.** Any action or suit relating to
-this License may be brought only in the courts of a jurisdiction wherein the
-Licensor resides or in which Licensor conducts its primary business, and under
-the laws of that jurisdiction excluding its conflict-of-law provisions. The
-application of the United Nations Convention on Contracts for the International
-Sale of Goods is expressly excluded. Any use of the Original Work outside the
-scope of this License or after its termination shall be subject to the
-requirements and penalties of copyright or patent law in the appropriate
-jurisdiction. This section shall survive the termination of this License.
-
-12.  **Attorneys' Fees.** In any action to enforce the terms of this License or
-seeking damages relating thereto, the prevailing party shall be entitled to
-recover its costs and expenses, including, without limitation, reasonable
-attorneys' fees and costs incurred in connection with such action, including
-any appeal of such action. This section shall survive the termination of this
-License.
-
-13.  **Miscellaneous.** If any provision of this License is held to be
-unenforceable, such provision shall be reformed only to the extent necessary to
-make it enforceable.
-
-14.  **Definition of "You" in This License.** "You" throughout this License,
-whether in upper or lower case, means an individual or a legal entity
-exercising rights under, and complying with all of the terms of, this License.
-For legal entities, "You" includes any entity that controls, is controlled by,
-or is under common control with you. For purposes of this definition, "control"
-means (i) the power, direct or indirect, to cause the direction or management
-of such entity, whether by contract or otherwise, or (ii) ownership of fifty
-percent (50%) or more of the outstanding shares, or (iii) beneficial ownership
-of such entity.
-
-15.  **Right to Use.** You may use the Original Work in all ways not otherwise
-restricted or conditioned by this License or by law, and Licensor promises not
-to interfere with or be responsible for such uses by You.
-
-16.  **Modification of This License.** This License is Copyright © 2007 Zooko
-Wilcox-O'Hearn. Permission is granted to copy, distribute, or communicate this
-License without modification. Nothing in this License permits You to modify
-this License as applied to the Original Work or to Derivative Works. However,
-You may modify the text of this License and copy, distribute or communicate
-your modified version (the "Modified License") and apply it to other original
-works of authorship subject to the following conditions: (i) You may not
-indicate in any way that your Modified License is the "Bootstrap Open Source
-Licence" or "BOSL" and you may not use those names in the name of your Modified
-License; and (ii) You must replace the notice specified in the first paragraph
-above with the notice "Licensed under <insert your license name here>" or with
-a notice of your own that is not confusingly similar to the notice in this
-License.

README.md

@@ -10,7 +10,8 @@
                              Zcash Full Node CLI
 ```
 
-[![Please don't upload to GitHub](https://nogithub.codeberg.page/badge.svg)](https://nogithub.codeberg.page)
+[![Please don't upload to GitHub](https://nogithub.codeberg.page/badge.svg)](https://nogithub.codeberg.page) ![](https://img.shields.io/badge/License-MIT-green
+)
 
 Zenith is a command-line interface for the Zcash Full Node (`zcashd`). It has the following features:
 
@@ -20,8 +21,6 @@ Zenith is a command-line interface for the Zcash Full Node (`zcashd`). It has th
 - Creating new Unified Addresses.
 - Sending transactions with shielded memo support.
 
-Note: Zenith depends on a patched version of the `haskoin-core` Haskell package included in this repo. A pull request to the maintainers of `haskoin-core` has been submitted, if/when it is merged, Zenith will be updated to use the standard package.
-
 ## Installation
 
 - Install dependencies:
@@ -37,13 +36,13 @@ Note: Zenith depends on a patched version of the `haskoin-core` Haskell package
 git clone https://git.vergara.tech/Vergara_Tech/zenith.git
 cd zenith
 git submodule init
-git submodule update
+git submodule update --remote
 ```
 
-- Install using `stack`:
+- Install using `cabal`:
 
 ```
-stack install
+cabal install
 ```
 
 ## Configuration

Setup.hs

@@ -0,0 +1,131 @@
+import Control.Exception (throw)
+import Control.Monad (forM_, when)
+import Data.Maybe (isNothing)
+import Distribution.PackageDescription
+import Distribution.Simple
+import Distribution.Simple.LocalBuildInfo (LocalBuildInfo(..), localPkgDescr)
+import Distribution.Simple.PreProcess
+import Distribution.Simple.Program.Find
+  ( defaultProgramSearchPath
+  , findProgramOnSearchPath
+  )
+import Distribution.Simple.Setup
+import Distribution.Simple.Utils
+  ( IODataMode(IODataModeBinary)
+  , maybeExit
+  , rawSystemStdInOut
+  )
+import Distribution.Verbosity (Verbosity)
+import qualified Distribution.Verbosity as Verbosity
+import System.Directory
+  ( XdgDirectory(..)
+  , copyFile
+  , createDirectory
+  , createDirectoryIfMissing
+  , doesDirectoryExist
+  , doesFileExist
+  , getCurrentDirectory
+  , getDirectoryContents
+  , getHomeDirectory
+  , getXdgDirectory
+  )
+import System.Environment
+import System.FilePath ((</>))
+import Text.Regex
+import Text.Regex.Base
+
+main :: IO ()
+main = defaultMainWithHooks hooks
+  where
+    hooks =
+      simpleUserHooks
+        { preConf =
+            \_ flags -> do
+              prepDeps (fromFlag $ configVerbosity flags)
+              pure emptyHookedBuildInfo
+        --, confHook = \a flags -> confHook simpleUserHooks a flags >>= rsAddDirs
+        }
+
+execCargo :: Verbosity -> String -> [String] -> IO ()
+execCargo verbosity command args = do
+  cargoPath <-
+    findProgramOnSearchPath Verbosity.silent defaultProgramSearchPath "cargo"
+  dir <- getCurrentDirectory
+  let cargoExec =
+        case cargoPath of
+          Just (p, _) -> p
+          Nothing -> "cargo"
+      cargoArgs = command : args
+      workingDir = Just (dir </> rsFolder)
+      thirdComponent (_, _, c) = c
+  maybeExit . fmap thirdComponent $
+    rawSystemStdInOut
+      verbosity
+      cargoExec
+      cargoArgs
+      workingDir
+      Nothing
+      Nothing
+      IODataModeBinary
+
+rsMake :: Verbosity -> IO ()
+rsMake verbosity = do
+  execCargo verbosity "cbuild" []
+
+prepDeps :: Verbosity -> IO ()
+prepDeps verbosity = do
+  ldPath <- lookupEnv "LD_LIBRARY_PATH"
+  pkgPath <- lookupEnv "PKG_CONFIG_PATH"
+  if maybe False (matchTest (mkRegex ".*zcash-haskell.*")) ldPath &&
+     maybe False (matchTest (mkRegex ".*zcash-haskell.*")) pkgPath
+    then do
+      execCargo verbosity "cbuild" []
+      localData <- getXdgDirectory XdgData "zcash-haskell"
+      createDirectoryIfMissing True localData
+      dir <- getCurrentDirectory
+      let rustLibDir =
+            dir </> rsFolder </> "target/x86_64-unknown-linux-gnu/debug"
+      copyDir rustLibDir localData
+    else throw $
+         userError "Paths not set correctly, please run the 'configure' script."
+
+rsFolder :: FilePath
+rsFolder = "zcash-haskell/librustzcash-wrapper"
+
+rsAddDirs :: LocalBuildInfo -> IO LocalBuildInfo
+rsAddDirs lbi' = do
+  dir <- getCurrentDirectory
+  let rustIncludeDir =
+        dir </> rsFolder </> "target/x86_64-unknown-linux-gnu/debug"
+      rustLibDir = dir </> rsFolder </> "target/x86_64-unknown-linux-gnu/debug"
+      updateLbi lbi = lbi {localPkgDescr = updatePkgDescr (localPkgDescr lbi)}
+      updatePkgDescr pkgDescr =
+        pkgDescr {library = updateLib <$> library pkgDescr}
+      updateLib lib = lib {libBuildInfo = updateLibBi (libBuildInfo lib)}
+      updateLibBi libBuild =
+        libBuild
+          { includeDirs = rustIncludeDir : includeDirs libBuild
+          , extraLibDirs = rustLibDir : extraLibDirs libBuild
+          }
+  pure $ updateLbi lbi'
+
+copyDir :: FilePath -> FilePath -> IO ()
+copyDir src dst = do
+  whenM (not <$> doesDirectoryExist src) $
+    throw (userError "source does not exist")
+  --whenM (doesFileOrDirectoryExist dst) $
+    --throw (userError "destination already exists")
+  createDirectoryIfMissing True dst
+  content <- getDirectoryContents src
+  let xs = filter (`notElem` [".", ".."]) content
+  forM_ xs $ \name -> do
+    let srcPath = src </> name
+    let dstPath = dst </> name
+    isDirectory <- doesDirectoryExist srcPath
+    if isDirectory
+      then copyDir srcPath dstPath
+      else copyFile srcPath dstPath
+  where
+    doesFileOrDirectoryExist x = orM [doesDirectoryExist x, doesFileExist x]
+    orM xs = or <$> sequence xs
+    whenM s r = s >>= flip when r

app/Main.hs

@@ -12,10 +12,16 @@ import qualified Data.Text as T
 import qualified Data.Text.IO as TIO
 import Data.Time.Clock.POSIX
 import System.Console.StructuredCLI
+import System.Environment (getArgs)
 import System.Exit
 import System.IO
 import Text.Read (readMaybe)
-import Zenith
+import ZcashHaskell.Types
+import Zenith.CLI
+import Zenith.Core (clearSync, testSync)
+import Zenith.Types (Config(..), ZcashAddress(..), ZcashPool(..), ZcashTx(..))
+import Zenith.Utils
+import Zenith.Zcashd
 
 prompt :: String -> IO String
 prompt text = do
@@ -194,14 +200,35 @@ processUri user pwd =
 main :: IO ()
 main = do
   config <- load ["zenith.cfg"]
+  args <- getArgs
+  dbFilePath <- require config "dbFilePath"
   nodeUser <- require config "nodeUser"
   nodePwd <- require config "nodePwd"
-  checkServer nodeUser nodePwd
+  zebraPort <- require config "zebraPort"
-  void $
+  zebraHost <- require config "zebraHost"
-    runCLI
+  let myConfig = Config dbFilePath zebraHost zebraPort
-      "Zenith"
+  if not (null args)
-      def
+    then do
-        { getBanner =
+      case head args of
-            "                         ______          _ _   _    \n                        |___  /         (_) | | |    \n                           / / ___ _ __  _| |_| |__  \n                          / / / _ \\ '_ \\| | __| '_ \\ \n                         / /_|  __/ | | | | |_| | | |\n                        /_____\\___|_| |_|_|\\__|_| |_|\n                         Zcash Full Node CLI v0.4.0"
+        "legacy" -> do
-        }
+          checkServer nodeUser nodePwd
-      (root nodeUser nodePwd)
+          void $
+            runCLI
+              "Zenith"
+              def
+                { getBanner =
+                    "                         ______          _ _   _    \n                        |___  /         (_) | | |    \n                           / / ___ _ __  _| |_| |__  \n                          / / / _ \\ '_ \\| | __| '_ \\ \n                         / /_|  __/ | | | | |_| | | |\n                        /_____\\___|_| |_|_|\\__|_| |_|\n                         Zcash Full Node CLI v0.4.0"
+                }
+              (root nodeUser nodePwd)
+        "cli" -> runZenithCLI myConfig
+        "sync" -> testSync myConfig
+        "rescan" -> clearSync myConfig
+        _ -> printUsage
+    else printUsage
+
+printUsage :: IO ()
+printUsage = do
+  putStrLn "zenith [command] [parameters]\n"
+  putStrLn "Available commands:"
+  putStrLn "legacy\tLegacy CLI for zcashd"
+  putStrLn "cli\tCLI for zebrad"

app/ZenScan.hs

@@ -0,0 +1,15 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module ZenScan where
+
+import Control.Monad.Logger (runNoLoggingT)
+import Data.Configurator
+import Zenith.Scanner (scanZebra)
+
+main :: IO ()
+main = do
+  config <- load ["zenith.cfg"]
+  dbFilePath <- require config "dbFilePath"
+  zebraPort <- require config "zebraPort"
+  zebraHost <- require config "zebraHost"
+  runNoLoggingT $ scanZebra 2762066 zebraHost zebraPort dbFilePath

cabal.project

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

configure

@@ -0,0 +1,6 @@
+#!/bin/bash
+
+echo "export PKG_CONFIG_PATH=$HOME/.local/share/zcash-haskell:\$PKG_CONFIG_PATH" | tee -a ~/.bashrc
+echo "export LD_LIBRARY_PATH=$HOME/.local/share/zcash-haskell:\$LD_LIBRARY_PATH" | tee -a ~/.bashrc
+source ~/.bashrc
+cd zcash-haskell && cabal build

package.yaml

@@ -1,76 +0,0 @@
-name:                zenith
-version:             0.4.0
-git:                 "https://git.vergara.tech/Vergara_Tech/zenith"
-license:             BOSL
-author:              "Rene Vergara"
-maintainer:          "rene@vergara.network"
-copyright:           "Copyright (c) 2022 Vergara Technologies LLC"
-
-extra-source-files:
-- README.md
-- CHANGELOG.md
-- zenith.cfg
-
-# Metadata used when publishing your package
-synopsis:            Haskell CLI for Zcash Full Node
-# category:            Web
-
-# To avoid duplicated efforts in documentation and dealing with the
-# complications of embedding Haddock markup inside cabal files, it is
-# common to point users to the README.md file.
-description:         Please see the README on repo at <https://git.vergara.tech/Vergara_Tech/zenith#readme>
-
-dependencies:
-- base >= 4.7 && < 5
-
-library:
-  source-dirs: src
-  dependencies:
-  - aeson
-  - text
-  - bytestring
-  - http-conduit
-  - scientific
-  - vector
-  - regex-base
-  - regex-posix
-  - regex-compat
-  - Clipboard
-  - process
-  - http-types
-  - array
-  - base64-bytestring
-  - hexstring
-  - blake2
-  - zcash-haskell
-
-executables:
-  zenith:
-    main:                Main.hs
-    source-dirs:         app
-    ghc-options:
-    - -threaded
-    - -rtsopts
-    - -with-rtsopts=-N
-    - -Wall
-    - -Wunused-imports
-    dependencies:
-    - zenith
-    - configurator
-    - structured-cli
-    - data-default
-    - bytestring
-    - text
-    - time
-    - sort
-
-tests:
-  zenith-test:
-    main:                Spec.hs
-    source-dirs:         test
-    ghc-options:
-    - -threaded
-    - -rtsopts
-    - -with-rtsopts=-N
-    dependencies:
-    - zenith

src/Zenith.hs

@@ -1,635 +0,0 @@
-{-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE DeriveAnyClass #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE LambdaCase #-}
-
-module Zenith where
-
-import Control.Concurrent (threadDelay)
-import Control.Monad
-import Crypto.Hash.BLAKE2.BLAKE2b
-import Data.Aeson
-import Data.Aeson.Types
-import qualified Data.Array as A
-import Data.Bits
-import qualified Data.ByteString as B
-import qualified Data.ByteString.Base64 as B64
-import qualified Data.ByteString.Char8 as C
-import qualified Data.ByteString.Lazy as LB
-import Data.Char
-import Data.Functor (void)
-import Data.HexString
-import Data.Maybe
-import qualified Data.Scientific as Scientific
-import qualified Data.Text as T
-import qualified Data.Text.Encoding as E
-import Data.Text.Encoding.Error (lenientDecode)
-import qualified Data.Text.IO as TIO
-import qualified Data.Vector as V
-import Data.Word
-import GHC.Generics
-import ZcashHaskell.Orchard (isValidUnifiedAddress)
-import ZcashHaskell.Sapling (isValidShieldedAddress)
-
-{-import Haskoin.Address.Bech32-}
-import Network.HTTP.Simple
-import Network.HTTP.Types
-import Numeric
-import System.Clipboard
-import System.Exit
-import System.IO
-import System.Process (createProcess_, shell)
-import Text.Read (readMaybe)
-import Text.Regex
-import Text.Regex.Base
-import Text.Regex.Posix
-
--- | A type to model Zcash RPC calls
-data RpcCall = RpcCall
-  { jsonrpc :: T.Text
-  , id :: T.Text
-  , method :: T.Text
-  , params :: [Value]
-  } deriving (Show, Generic, ToJSON, FromJSON)
-
--- | Type for modelling the different address sources for Zcash 5.0.0
-data AddressSource
-  = LegacyRandom
-  | Imported
-  | ImportedWatchOnly
-  | KeyPool
-  | LegacySeed
-  | MnemonicSeed
-  deriving (Read, Show, Eq, Generic, ToJSON)
-
-instance FromJSON AddressSource where
-  parseJSON =
-    withText "AddressSource" $ \case
-      "legacy_random" -> return LegacyRandom
-      "imported" -> return Imported
-      "imported_watchonly" -> return ImportedWatchOnly
-      "keypool" -> return KeyPool
-      "legacy_hdseed" -> return LegacySeed
-      "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]
-  , account :: Maybe Integer
-  , addy :: T.Text
-  } deriving (Eq)
-
-instance Show ZcashAddress where
-  show (ZcashAddress s p i a) =
-    T.unpack (T.take 8 a) ++
-    "..." ++ T.unpack (T.takeEnd 8 a) ++ " Pools: " ++ show p
-
--- | A type to model the response of the Zcash RPC
-data RpcResponse r = RpcResponse
-  { err :: Maybe T.Text
-  , respId :: T.Text
-  , result :: r
-  } deriving (Show, Generic, ToJSON)
-
-instance (FromJSON r) => FromJSON (RpcResponse r) where
-  parseJSON (Object obj) = do
-    e <- obj .: "error"
-    rId <- obj .: "id"
-    r <- obj .: "result"
-    pure $ RpcResponse e rId r
-  parseJSON invalid =
-    prependFailure
-      "parsing RpcResponse failed, "
-      (typeMismatch "Object" invalid)
-
-newtype NodeVersion =
-  NodeVersion Integer
-  deriving (Eq, Show)
-
-instance FromJSON NodeVersion where
-  parseJSON =
-    withObject "NodeVersion" $ \obj -> do
-      v <- obj .: "version"
-      pure $ NodeVersion v
-
--- | A type to model an address group
-data AddressGroup = AddressGroup
-  { agsource :: AddressSource
-  , agtransparent :: [ZcashAddress]
-  , agsapling :: [ZcashAddress]
-  , agunified :: [ZcashAddress]
-  } deriving (Show, Generic)
-
-instance FromJSON AddressGroup where
-  parseJSON =
-    withObject "AddressGroup" $ \obj -> do
-      s <- obj .: "source"
-      t <- obj .:? "transparent"
-      sap <- obj .:? "sapling"
-      uni <- obj .:? "unified"
-      sL <- processSapling sap s
-      tL <- processTransparent t s
-      uL <- processUnified uni
-      return $ AddressGroup s tL (concat sL) (concat uL)
-    where
-      processTransparent c s1 =
-        case c of
-          Nothing -> return []
-          Just x -> do
-            x' <- x .: "addresses"
-            return $ map (ZcashAddress s1 [Transparent] Nothing) x'
-      processSapling k s2 =
-        case k of
-          Nothing -> return []
-          Just y -> mapM (processOneSapling s2) y
-            where processOneSapling sx =
-                    withObject "Sapling" $ \oS -> do
-                      oS' <- oS .: "addresses"
-                      return $ map (ZcashAddress sx [Sapling] Nothing) oS'
-      processUnified u =
-        case u of
-          Nothing -> return []
-          Just z -> mapM processOneAccount z
-            where processOneAccount =
-                    withObject "UAs" $ \uS -> do
-                      acct <- uS .: "account"
-                      uS' <- uS .: "addresses"
-                      mapM (processUAs acct) uS'
-                    where
-                      processUAs a =
-                        withObject "UAs" $ \v -> do
-                          addr <- v .: "address"
-                          p <- v .: "receiver_types"
-                          return $ ZcashAddress MnemonicSeed p a addr
-
-displayZec :: Integer -> String
-displayZec s
-  | s < 100 = show s ++ " zats "
-  | s < 100000 = show (fromIntegral s / 100) ++ " μZEC "
-  | s < 100000000 = show (fromIntegral s / 100000) ++ " mZEC "
-  | otherwise = show (fromIntegral s / 100000000) ++ " ZEC "
-
--- | A type to model a Zcash transaction
-data ZcashTx = ZcashTx
-  { ztxid :: T.Text
-  , zamount :: Double
-  , zamountZat :: Integer
-  , zblockheight :: Integer
-  , zblocktime :: Integer
-  , zchange :: Bool
-  , zconfirmations :: Integer
-  , zmemo :: T.Text
-  } deriving (Show, Generic)
-
-instance FromJSON ZcashTx where
-  parseJSON =
-    withObject "ZcashTx" $ \obj -> do
-      t <- obj .: "txid"
-      a <- obj .: "amount"
-      aZ <- obj .: "amountZat"
-      bh <- obj .: "blockheight"
-      bt <- obj .: "blocktime"
-      c <- obj .:? "change"
-      conf <- obj .: "confirmations"
-      m <- obj .:? "memo"
-      pure $
-        ZcashTx
-          t
-          a
-          aZ
-          bh
-          bt
-          (fromMaybe False c)
-          conf
-          (case m of
-             Nothing -> ""
-             Just m' -> T.filter (/= '\NUL') $ decodeHexText m')
-
-instance ToJSON ZcashTx where
-  toJSON (ZcashTx t a aZ bh bt c conf m) =
-    object
-      [ "amount" .= a
-      , "amountZat" .= aZ
-      , "txid" .= t
-      , "blockheight" .= bh
-      , "blocktime" .= bt
-      , "change" .= c
-      , "confirmations" .= conf
-      , "memo" .= m
-      ]
-
--- | Type for the UA balance
-data UABalance = UABalance
-  { uatransparent :: Integer
-  , uasapling :: Integer
-  , uaorchard :: Integer
-  } deriving (Eq)
-
-instance Show UABalance where
-  show (UABalance t s o) =
-    " T: " ++ show t ++ " S: " ++ show s ++ " O: " ++ show o
-
-instance FromJSON UABalance where
-  parseJSON =
-    withObject "UABalance" $ \obj -> do
-      p <- obj .: "pools"
-      t <- p .:? "transparent"
-      s <- p .:? "sapling"
-      o <- p .:? "orchard"
-      vT <-
-        case t of
-          Nothing -> return 0
-          Just t' -> t' .: "valueZat"
-      vS <-
-        case s of
-          Nothing -> return 0
-          Just s' -> s' .: "valueZat"
-      vO <-
-        case o of
-          Nothing -> return 0
-          Just o' -> o' .: "valueZat"
-      pure $ UABalance vT vS vO
-
--- | Type for Operation Result
-data OpResult = OpResult
-  { opsuccess :: T.Text
-  , opmessage :: Maybe T.Text
-  , optxid :: Maybe T.Text
-  } deriving (Show, Eq)
-
-instance FromJSON OpResult where
-  parseJSON =
-    withObject "OpResult" $ \obj -> do
-      s <- obj .: "status"
-      r <- obj .:? "result"
-      e <- obj .:? "error"
-      t <-
-        case r of
-          Nothing -> return Nothing
-          Just r' -> r' .: "txid"
-      m <-
-        case e of
-          Nothing -> return Nothing
-          Just m' -> m' .: "message"
-      pure $ OpResult s m t
-
--- | Helper function to turn a hex-encoded memo strings to readable text
-decodeHexText :: String -> T.Text
-decodeHexText h = E.decodeUtf8With lenientDecode $ B.pack $ hexRead h
-  where
-    hexRead hexText
-      | null chunk = []
-      | otherwise =
-        fromIntegral (read ("0x" <> chunk)) : hexRead (drop 2 hexText)
-      where
-        chunk = take 2 hexText
-
--- | Helper function to turn a string into a hex-encoded string
-encodeHexText :: String -> String
-encodeHexText t = mconcat (map padHex t)
-  where
-    padHex x =
-      if ord x < 16
-        then "0" ++ (showHex . ord) x ""
-        else showHex (ord x) ""
-
-encodeHexText' :: T.Text -> String
-encodeHexText' t =
-  if T.length t > 0
-    then T.unpack . toText . fromBytes $ E.encodeUtf8 t
-    else T.unpack . toText . fromBytes $ E.encodeUtf8 "Sent from Zenith"
-
--- | Helper function to extract addresses from AddressGroups
-getAddresses :: AddressGroup -> [ZcashAddress]
-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 Transparent
-  | sReg && chkS = Just Sapling
-  | uReg && chk = Just Orchard
-  | otherwise = Nothing
-  where
-    transparentRegex = "^t1[a-zA-Z0-9]{33}$" :: String
-    shieldedRegex = "^zs[a-zA-Z0-9]{76}$" :: String
-    unifiedRegex = "^u[a-zA-Z0-9]" :: String
-    tReg = T.unpack txt =~ transparentRegex :: Bool
-    sReg = T.unpack txt =~ shieldedRegex :: Bool
-    uReg = T.unpack txt =~ unifiedRegex :: Bool
-    chk = isValidUnifiedAddress $ E.encodeUtf8 txt
-    chkS = isValidShieldedAddress $ E.encodeUtf8 txt
-
--- | RPC methods
--- | List addresses
-listAddresses :: B.ByteString -> B.ByteString -> IO [ZcashAddress]
-listAddresses user pwd = do
-  response <- makeZcashCall user pwd "listaddresses" []
-  let rpcResp = decode response :: Maybe (RpcResponse [AddressGroup])
-  case rpcResp of
-    Nothing -> fail "Couldn't parse node response"
-    Just res -> do
-      let addys = result res
-      let addList = concatMap getAddresses addys
-      return addList
-
--- | Get address balance
-getBalance :: B.ByteString -> B.ByteString -> ZcashAddress -> IO [Integer]
-getBalance user pwd zadd = do
-  let a = account zadd
-  case a of
-    Nothing -> do
-      response <-
-        makeZcashCall
-          user
-          pwd
-          "z_getbalance"
-          [ String (addy zadd)
-          , Number (Scientific.scientific 1 0)
-          , Data.Aeson.Bool True
-          ]
-      let rpcResp = decode response :: Maybe (RpcResponse Integer)
-      case rpcResp of
-        Nothing -> fail "Couldn't parse node response"
-        Just res -> do
-          return [result res]
-    Just acct -> do
-      response <-
-        makeZcashCall
-          user
-          pwd
-          "z_getbalanceforaccount"
-          [Number (Scientific.scientific acct 0)]
-      let rpcResp = decode response :: Maybe (RpcResponse UABalance)
-      case rpcResp of
-        Nothing -> fail "Couldn't parse node response"
-        Just res -> do
-          return $ readUABalance (result res)
-          where readUABalance ua =
-                  [uatransparent ua, uasapling ua, uaorchard ua]
-
--- | List transactions
-listTxs :: B.ByteString -> B.ByteString -> ZcashAddress -> IO [ZcashTx]
-listTxs user pwd zaddy = do
-  response <-
-    makeZcashCall user pwd "z_listreceivedbyaddress" [String $ addy zaddy]
-  let rpcResp = decode response :: Maybe (RpcResponse [ZcashTx])
-  case rpcResp of
-    Nothing -> fail "listTxs: Couldn't parse node response"
-    Just res -> do
-      return $ result res
-
--- | Send Tx
-sendTx ::
-     B.ByteString
-  -> B.ByteString
-  -> ZcashAddress
-  -> T.Text
-  -> Double
-  -> Maybe T.Text
-  -> IO ()
-sendTx user pwd fromAddy toAddy amount memo = do
-  bal <- getBalance user pwd fromAddy
-  let valAdd = validateAddress toAddy
-  if sum bal - floor (amount * 100000000) >= 1000
-    then do
-      if source fromAddy /= ImportedWatchOnly
-        then do
-          let privacyPolicy
-                | valAdd == Just Transparent = "AllowRevealedRecipients"
-                | isNothing (account fromAddy) &&
-                    elem Transparent (pool fromAddy) = "AllowRevealedSenders"
-                | otherwise = "AllowRevealedAmounts"
-          let pd =
-                case memo of
-                  Nothing ->
-                    [ Data.Aeson.String (addy fromAddy)
-                    , Data.Aeson.Array
-                        (V.fromList
-                           [object ["address" .= toAddy, "amount" .= amount]])
-                    , Data.Aeson.Number $ Scientific.scientific 1 1
-                    , Data.Aeson.Null
-                    , Data.Aeson.String privacyPolicy
-                    ]
-                  Just memo' ->
-                    [ Data.Aeson.String (addy fromAddy)
-                    , Data.Aeson.Array
-                        (V.fromList
-                           [ object
-                               [ "address" .= toAddy
-                               , "amount" .= amount
-                               , "memo" .= encodeHexText' memo'
-                               ]
-                           ])
-                    , Data.Aeson.Number $ Scientific.scientific 1 1
-                    , Data.Aeson.Null
-                    , Data.Aeson.String privacyPolicy
-                    ]
-          response <- makeZcashCall user pwd "z_sendmany" pd
-          let rpcResp = decode response :: Maybe (RpcResponse T.Text)
-          case rpcResp of
-            Nothing -> fail "Couldn't parse node response"
-            Just res -> do
-              putStr "  Sending."
-              checkOpResult user pwd (result res)
-        else putStrLn "Error: Source address is view-only."
-    else putStrLn "Error: Insufficient balance in source address."
-
--- | Make a Zcash RPC call
-makeZcashCall ::
-     B.ByteString
-  -> B.ByteString
-  -> T.Text
-  -> [Data.Aeson.Value]
-  -> IO LB.ByteString
-makeZcashCall username password m p = do
-  let payload = RpcCall "1.0" "test" m p
-  let myRequest =
-        setRequestBodyJSON payload $
-        setRequestPort 8232 $
-        setRequestBasicAuth username password $
-        setRequestMethod "POST" defaultRequest
-  response <- httpLBS myRequest
-  let respStatus = getResponseStatusCode response
-  let body = getResponseBody response
-  case respStatus of
-    500 -> do
-      let rpcResp = decode body :: Maybe (RpcResponse String)
-      case rpcResp of
-        Nothing -> fail $ "Unknown server error " ++ show response
-        Just x -> fail (result x)
-    401 -> fail "Incorrect full node credentials"
-    200 -> return body
-    _ -> fail "Unknown error"
-
--- | Display an address
-displayZcashAddress ::
-     B.ByteString -> B.ByteString -> (Int, ZcashAddress) -> IO ()
-displayZcashAddress user pwd (idx, zaddy) = do
-  zats <- getBalance user pwd zaddy
-  putStr $ show idx ++ ": "
-  putStr $ show zaddy
-  when (source zaddy == ImportedWatchOnly) (putStr "[VK]")
-  putStr " Balance: "
-  mapM_ (putStr . displayZec) zats
-  putStrLn ""
-
--- | Copy an address to the clipboard
-copyAddress :: ZcashAddress -> IO ()
-copyAddress a =
-  void $
-  createProcess_ "toClipboard" $
-  shell $ "echo " ++ T.unpack (addy a) ++ " | xclip -r -selection clipboard"
-
--- | Verify operation result
-checkOpResult :: B.ByteString -> B.ByteString -> T.Text -> IO ()
-checkOpResult user pwd opid = do
-  response <-
-    makeZcashCall
-      user
-      pwd
-      "z_getoperationstatus"
-      [Data.Aeson.Array (V.fromList [Data.Aeson.String opid])]
-  let rpcResp = decode response :: Maybe (RpcResponse [OpResult])
-  case rpcResp of
-    Nothing -> fail "Couldn't parse node response"
-    Just res -> do
-      let r = result res
-      mapM_ showResult r
-  where
-    showResult t =
-      case opsuccess t of
-        "success" ->
-          putStrLn $ "  Success! Tx ID: " ++ maybe "" T.unpack (optxid t)
-        "executing" -> do
-          putStr "."
-          hFlush stdout
-          threadDelay 1000000 >> checkOpResult user pwd opid
-        _ -> putStrLn $ "  Failed :( " ++ maybe "" T.unpack (opmessage t)
-
--- | Check for accounts
-checkAccounts :: B.ByteString -> B.ByteString -> IO Bool
-checkAccounts user pwd = do
-  response <- makeZcashCall user pwd "z_listaccounts" []
-  let rpcResp = decode response :: Maybe (RpcResponse [Object])
-  case rpcResp of
-    Nothing -> fail "Couldn't parse node response"
-    Just res -> do
-      let r = result res
-      return $ not (null r)
-
--- | Add account to node
-createAccount :: B.ByteString -> B.ByteString -> IO ()
-createAccount user pwd = do
-  response <- makeZcashCall user pwd "z_getnewaccount" []
-  let rpcResp = decode response :: Maybe (RpcResponse Object)
-  case rpcResp of
-    Nothing -> fail "Couldn't parse node response"
-    Just res -> do
-      let r = result res
-      putStrLn "  Account created!"
-
--- | Create new Unified Address
-createUnifiedAddress :: B.ByteString -> B.ByteString -> Bool -> Bool -> IO ()
-createUnifiedAddress user pwd tRec sRec = do
-  let recs = getReceivers tRec sRec
-  let pd = [Data.Aeson.Number $ Scientific.scientific 0 1, recs]
-  newResp <- makeZcashCall user pwd "z_getaddressforaccount" pd
-  let rpcResp = decode newResp :: Maybe (RpcResponse Object)
-  case rpcResp of
-    Nothing -> fail "Couldn't parse node response"
-    Just res -> do
-      let r = result res
-      putStrLn "  New UA created!"
-  where
-    getReceivers t s
-      | t && s =
-        Data.Aeson.Array
-          (V.fromList
-             [ Data.Aeson.String "p2pkh"
-             , Data.Aeson.String "sapling"
-             , Data.Aeson.String "orchard"
-             ])
-      | t =
-        Data.Aeson.Array
-          (V.fromList [Data.Aeson.String "p2pkh", Data.Aeson.String "orchard"])
-      | s =
-        Data.Aeson.Array
-          (V.fromList [Data.Aeson.String "sapling", Data.Aeson.String "orchard"])
-      | otherwise = Data.Aeson.Array (V.fromList [Data.Aeson.String "orchard"])
-
--- | Check Zcash full node server
-checkServer :: B.ByteString -> B.ByteString -> IO ()
-checkServer user pwd = do
-  resp <- makeZcashCall user pwd "getinfo" []
-  let rpcResp = decode resp :: Maybe (RpcResponse NodeVersion)
-  case rpcResp of
-    Nothing -> fail "Couldn't parse node response"
-    Just myResp -> do
-      let r = result myResp
-      if isNodeValid r
-        then putStrLn $ "Connected to Zcash Full Node (" <> show r <> ") :)"
-        else do
-          putStrLn "Deprecated Zcash Full Node version found. Exiting"
-          exitFailure
-      where isNodeValid (NodeVersion i) = i >= 5000000
-
--- | Read ZIP-321 URI
-sendWithUri ::
-     B.ByteString -> B.ByteString -> ZcashAddress -> String -> Bool -> IO ()
-sendWithUri user pwd fromAddy uri repTo = do
-  let uriRegex = mkRegex "^zcash:(\\w+)\\?amount=(.*)\\&memo=(.*)$"
-  if matchTest uriRegex uri
-    then do
-      let reg = matchAllText uriRegex uri
-      let parsedAddress = fst $ head reg A.! 1
-      let parsedAmount = fst $ head reg A.! 2
-      let parsedEncodedMemo = fst $ head reg A.! 3
-      let addType = validateAddress $ T.pack parsedAddress
-      case addType of
-        Nothing -> putStrLn "   Invalid address"
-        Just Transparent -> do
-          putStrLn $ "   Address is valid: " ++ parsedAddress
-          case (readMaybe parsedAmount :: Maybe Double) of
-            Nothing -> putStrLn "   Invalid amount."
-            Just amt -> do
-              putStrLn $ "   Valid ZEC amount: " ++ show amt
-              sendTx user pwd fromAddy (T.pack parsedAddress) amt Nothing
-        Just _ -> do
-          putStrLn $ "   Address is valid: " ++ parsedAddress
-          case (readMaybe parsedAmount :: Maybe Double) of
-            Nothing -> putStrLn "   Invalid amount."
-            Just amt -> do
-              putStrLn $ "   Valid ZEC amount: " ++ show amt
-              let decodedMemo =
-                    E.decodeUtf8With lenientDecode $
-                    B64.decodeLenient $ C.pack parsedEncodedMemo
-              TIO.putStrLn $ "   Memo: " <> decodedMemo
-              sendTx
-                user
-                pwd
-                fromAddy
-                (T.pack parsedAddress)
-                amt
-                (if repTo
-                   then Just $
-                        T.concat [decodedMemo, "\nReply-To:\n", addy fromAddy]
-                   else Just decodedMemo)
-    else putStrLn "URI is not compliant with ZIP-321"

src/Zenith/Core.hs

@@ -0,0 +1,774 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+-- | Core wallet functionality for Zenith
+module Zenith.Core where
+
+import Control.Exception (throwIO, try)
+import Control.Monad (forM, when)
+import Control.Monad.IO.Class (liftIO)
+import Control.Monad.Logger
+  ( LoggingT
+  , MonadLoggerIO
+  , NoLoggingT
+  , logDebugN
+  , logErrorN
+  , logInfoN
+  , logWarnN
+  , runFileLoggingT
+  , runNoLoggingT
+  , runStdoutLoggingT
+  )
+import Crypto.Secp256k1 (SecKey(..))
+import Data.Aeson
+import Data.Binary.Get hiding (getBytes)
+import qualified Data.ByteString as BS
+import qualified Data.ByteString.Lazy as LBS
+import Data.Digest.Pure.MD5
+import Data.HexString (HexString, hexString, toBytes)
+import Data.List
+import Data.Maybe (fromJust)
+import Data.Pool (Pool)
+import qualified Data.Text as T
+import qualified Data.Text.Encoding as E
+import Data.Time
+import qualified Database.Esqueleto.Experimental as ESQ
+import Database.Persist
+import Database.Persist.Sqlite
+import GHC.Float.RealFracMethods (floorFloatInteger)
+import Haskoin.Crypto.Keys (XPrvKey(..))
+import Lens.Micro ((&), (.~), (^.), set)
+import Network.HTTP.Client
+import ZcashHaskell.Keys
+import ZcashHaskell.Orchard
+  ( decryptOrchardActionSK
+  , encodeUnifiedAddress
+  , genOrchardReceiver
+  , genOrchardSpendingKey
+  , getOrchardNotePosition
+  , getOrchardWitness
+  , isValidUnifiedAddress
+  , updateOrchardCommitmentTree
+  , updateOrchardWitness
+  )
+import ZcashHaskell.Sapling
+  ( decodeSaplingOutputEsk
+  , genSaplingInternalAddress
+  , genSaplingPaymentAddress
+  , genSaplingSpendingKey
+  , getSaplingNotePosition
+  , getSaplingWitness
+  , updateSaplingCommitmentTree
+  , updateSaplingWitness
+  )
+import ZcashHaskell.Transparent
+  ( genTransparentPrvKey
+  , genTransparentReceiver
+  , genTransparentSecretKey
+  )
+import ZcashHaskell.Types
+import ZcashHaskell.Utils
+import Zenith.DB
+import Zenith.Types
+  ( Config(..)
+  , HexStringDB(..)
+  , OrchardSpendingKeyDB(..)
+  , PhraseDB(..)
+  , RseedDB(..)
+  , SaplingSpendingKeyDB(..)
+  , ScopeDB(..)
+  , TransparentSpendingKeyDB(..)
+  , UnifiedAddressDB(..)
+  , ZcashNetDB(..)
+  , ZebraTreeInfo(..)
+  )
+
+-- * Zebra Node interaction
+-- | Checks the status of the `zebrad` node
+checkZebra ::
+     T.Text -- ^ Host where `zebrad` is available
+  -> Int -- ^ Port where `zebrad` is available 
+  -> IO ZebraGetInfo
+checkZebra nodeHost nodePort = do
+  res <- makeZebraCall nodeHost nodePort "getinfo" []
+  case res of
+    Left e -> throwIO $ userError e
+    Right bi -> return bi
+
+-- | Checks the status of the Zcash blockchain
+checkBlockChain ::
+     T.Text -- ^ Host where `zebrad` is available
+  -> Int -- ^ Port where `zebrad` is available
+  -> IO ZebraGetBlockChainInfo
+checkBlockChain nodeHost nodePort = do
+  r <- makeZebraCall nodeHost nodePort "getblockchaininfo" []
+  case r of
+    Left e -> throwIO $ userError e
+    Right bci -> return bci
+
+-- | Get commitment trees from Zebra
+getCommitmentTrees ::
+     T.Text -- ^ Host where `zebrad` is avaiable
+  -> Int -- ^ Port where `zebrad` is available
+  -> Int -- ^ Block height
+  -> IO ZebraTreeInfo
+getCommitmentTrees nodeHost nodePort block = do
+  r <-
+    makeZebraCall
+      nodeHost
+      nodePort
+      "z_gettreestate"
+      [Data.Aeson.String $ T.pack $ show block]
+  case r of
+    Left e -> throwIO $ userError e
+    Right zti -> return zti
+
+-- * Spending Keys
+-- | Create an Orchard Spending Key for the given wallet and account index
+createOrchardSpendingKey :: ZcashWallet -> Int -> IO OrchardSpendingKey
+createOrchardSpendingKey zw i = do
+  let s = getWalletSeed $ getPhrase $ zcashWalletSeedPhrase zw
+  case s of
+    Nothing -> throwIO $ userError "Unable to generate seed"
+    Just s' -> do
+      let coinType =
+            case getNet $ zcashWalletNetwork zw of
+              MainNet -> MainNetCoin
+              TestNet -> TestNetCoin
+              RegTestNet -> RegTestNetCoin
+      let r = genOrchardSpendingKey s' coinType i
+      case r of
+        Nothing -> throwIO $ userError "Unable to generate Orchard spending key"
+        Just sk -> return sk
+
+-- | Create a Sapling spending key for the given wallet and account index
+createSaplingSpendingKey :: ZcashWallet -> Int -> IO SaplingSpendingKey
+createSaplingSpendingKey zw i = do
+  let s = getWalletSeed $ getPhrase $ zcashWalletSeedPhrase zw
+  case s of
+    Nothing -> throwIO $ userError "Unable to generate seed"
+    Just s' -> do
+      let coinType =
+            case getNet $ zcashWalletNetwork zw of
+              MainNet -> MainNetCoin
+              TestNet -> TestNetCoin
+              RegTestNet -> RegTestNetCoin
+      let r = genSaplingSpendingKey s' coinType i
+      case r of
+        Nothing -> throwIO $ userError "Unable to generate Sapling spending key"
+        Just sk -> return sk
+
+createTransparentSpendingKey :: ZcashWallet -> Int -> IO TransparentSpendingKey
+createTransparentSpendingKey zw i = do
+  let s = getWalletSeed $ getPhrase $ zcashWalletSeedPhrase zw
+  case s of
+    Nothing -> throwIO $ userError "Unable to generate seed"
+    Just s' -> do
+      let coinType =
+            case getNet $ zcashWalletNetwork zw of
+              MainNet -> MainNetCoin
+              TestNet -> TestNetCoin
+              RegTestNet -> RegTestNetCoin
+      genTransparentPrvKey s' coinType i
+
+-- * Accounts
+-- | Create an account for the given wallet and account index
+createZcashAccount ::
+     T.Text -- ^ The account's name
+  -> Int -- ^ The account's index
+  -> Entity ZcashWallet -- ^ The Zcash wallet that this account will be attached to
+  -> IO ZcashAccount
+createZcashAccount n i zw = do
+  orSk <- createOrchardSpendingKey (entityVal zw) i
+  sapSk <- createSaplingSpendingKey (entityVal zw) i
+  tSk <- createTransparentSpendingKey (entityVal zw) i
+  return $
+    ZcashAccount
+      i
+      (entityKey zw)
+      n
+      (OrchardSpendingKeyDB orSk)
+      (SaplingSpendingKeyDB sapSk)
+      (TransparentSpendingKeyDB tSk)
+
+-- * Addresses
+-- | Create an external unified address for the given account and index
+createWalletAddress ::
+     T.Text -- ^ The address nickname
+  -> Int -- ^ The address' index
+  -> ZcashNet -- ^ The network for this address
+  -> Scope -- ^ External or Internal
+  -> Entity ZcashAccount -- ^ The Zcash account that the address will be attached to
+  -> IO WalletAddress
+createWalletAddress n i zNet scope za = do
+  let oRec =
+        genOrchardReceiver i scope $
+        getOrchSK $ zcashAccountOrchSpendKey $ entityVal za
+  let sRec =
+        case scope of
+          External ->
+            genSaplingPaymentAddress i $
+            getSapSK $ zcashAccountSapSpendKey $ entityVal za
+          Internal ->
+            genSaplingInternalAddress $
+            getSapSK $ zcashAccountSapSpendKey $ entityVal za
+  tRec <-
+    genTransparentReceiver i scope $
+    getTranSK $ zcashAccountTPrivateKey $ entityVal za
+  return $
+    WalletAddress
+      i
+      (entityKey za)
+      n
+      (UnifiedAddressDB $
+       encodeUnifiedAddress $ UnifiedAddress zNet oRec sRec (Just tRec))
+      (ScopeDB scope)
+
+-- * Wallet
+-- | Find the Sapling notes that match the given spending key
+findSaplingOutputs ::
+     Config -- ^ the configuration parameters
+  -> Int -- ^ the starting block
+  -> ZcashNetDB -- ^ The network
+  -> Entity ZcashAccount -- ^ The account to use
+  -> IO ()
+findSaplingOutputs config b znet za = do
+  let dbPath = c_dbPath config
+  let zebraHost = c_zebraHost config
+  let zebraPort = c_zebraPort config
+  let zn = getNet znet
+  pool <- runNoLoggingT $ initPool dbPath
+  tList <- getShieldedOutputs pool b
+  trees <- getCommitmentTrees zebraHost zebraPort (b - 1)
+  let sT = SaplingCommitmentTree $ ztiSapling trees
+  decryptNotes sT zn pool tList
+  sapNotes <- getWalletSapNotes pool (entityKey za)
+  findSapSpends pool (entityKey za) sapNotes
+  where
+    sk :: SaplingSpendingKeyDB
+    sk = zcashAccountSapSpendKey $ entityVal za
+    decryptNotes ::
+         SaplingCommitmentTree
+      -> ZcashNet
+      -> ConnectionPool
+      -> [(Entity ZcashTransaction, Entity ShieldOutput)]
+      -> IO ()
+    decryptNotes _ _ _ [] = return ()
+    decryptNotes st n pool ((zt, o):txs) = do
+      let updatedTree =
+            updateSaplingCommitmentTree
+              st
+              (getHex $ shieldOutputCmu $ entityVal o)
+      case updatedTree of
+        Nothing -> throwIO $ userError "Failed to update commitment tree"
+        Just uT -> do
+          let noteWitness = getSaplingWitness uT
+          let notePos = getSaplingNotePosition <$> noteWitness
+          case notePos of
+            Nothing -> throwIO $ userError "Failed to obtain note position"
+            Just nP -> do
+              case decodeShOut External n nP o of
+                Nothing -> do
+                  case decodeShOut Internal n nP o of
+                    Nothing -> do
+                      decryptNotes uT n pool txs
+                    Just dn1 -> do
+                      wId <- saveWalletTransaction pool (entityKey za) zt
+                      saveWalletSapNote
+                        pool
+                        wId
+                        nP
+                        (fromJust noteWitness)
+                        True
+                        (entityKey za)
+                        (entityKey o)
+                        dn1
+                      decryptNotes uT n pool txs
+                Just dn0 -> do
+                  wId <- saveWalletTransaction pool (entityKey za) zt
+                  saveWalletSapNote
+                    pool
+                    wId
+                    nP
+                    (fromJust noteWitness)
+                    False
+                    (entityKey za)
+                    (entityKey o)
+                    dn0
+                  decryptNotes uT n pool txs
+    decodeShOut ::
+         Scope
+      -> ZcashNet
+      -> Integer
+      -> Entity ShieldOutput
+      -> Maybe DecodedNote
+    decodeShOut scope n pos s = do
+      decodeSaplingOutputEsk
+        (getSapSK sk)
+        (ShieldedOutput
+           (getHex $ shieldOutputCv $ entityVal s)
+           (getHex $ shieldOutputCmu $ entityVal s)
+           (getHex $ shieldOutputEphKey $ entityVal s)
+           (getHex $ shieldOutputEncCipher $ entityVal s)
+           (getHex $ shieldOutputOutCipher $ entityVal s)
+           (getHex $ shieldOutputProof $ entityVal s))
+        n
+        scope
+        pos
+
+-- | Get Orchard actions 
+findOrchardActions ::
+     Config -- ^ the configuration parameters
+  -> Int -- ^ the starting block
+  -> ZcashNetDB -- ^ The network
+  -> Entity ZcashAccount -- ^ The account to use
+  -> IO ()
+findOrchardActions config b znet za = do
+  let dbPath = c_dbPath config
+  let zebraHost = c_zebraHost config
+  let zebraPort = c_zebraPort config
+  let zn = getNet znet
+  pool <- runNoLoggingT $ initPool dbPath
+  tList <- getOrchardActions pool b
+  trees <- getCommitmentTrees zebraHost zebraPort (b - 1)
+  let sT = OrchardCommitmentTree $ ztiOrchard trees
+  decryptNotes sT zn pool tList
+  orchNotes <- getWalletOrchNotes pool (entityKey za)
+  findOrchSpends pool (entityKey za) orchNotes
+  where
+    decryptNotes ::
+         OrchardCommitmentTree
+      -> ZcashNet
+      -> ConnectionPool
+      -> [(Entity ZcashTransaction, Entity OrchAction)]
+      -> IO ()
+    decryptNotes _ _ _ [] = return ()
+    decryptNotes ot n pool ((zt, o):txs) = do
+      let updatedTree =
+            updateOrchardCommitmentTree
+              ot
+              (getHex $ orchActionCmx $ entityVal o)
+      case updatedTree of
+        Nothing -> throwIO $ userError "Failed to update commitment tree"
+        Just uT -> do
+          let noteWitness = getOrchardWitness uT
+          let notePos = getOrchardNotePosition <$> noteWitness
+          case notePos of
+            Nothing -> throwIO $ userError "Failed to obtain note position"
+            Just nP ->
+              case decodeOrchAction External nP o of
+                Nothing ->
+                  case decodeOrchAction Internal nP o of
+                    Nothing -> decryptNotes uT n pool txs
+                    Just dn1 -> do
+                      wId <- saveWalletTransaction pool (entityKey za) zt
+                      saveWalletOrchNote
+                        pool
+                        wId
+                        nP
+                        (fromJust noteWitness)
+                        True
+                        (entityKey za)
+                        (entityKey o)
+                        dn1
+                      decryptNotes uT n pool txs
+                Just dn -> do
+                  wId <- saveWalletTransaction pool (entityKey za) zt
+                  saveWalletOrchNote
+                    pool
+                    wId
+                    nP
+                    (fromJust noteWitness)
+                    False
+                    (entityKey za)
+                    (entityKey o)
+                    dn
+                  decryptNotes uT n pool txs
+    sk :: OrchardSpendingKeyDB
+    sk = zcashAccountOrchSpendKey $ entityVal za
+    decodeOrchAction ::
+         Scope -> Integer -> Entity OrchAction -> Maybe DecodedNote
+    decodeOrchAction scope pos o =
+      decryptOrchardActionSK (getOrchSK sk) scope $
+      OrchardAction
+        (getHex $ orchActionNf $ entityVal o)
+        (getHex $ orchActionRk $ entityVal o)
+        (getHex $ orchActionCmx $ entityVal o)
+        (getHex $ orchActionEphKey $ entityVal o)
+        (getHex $ orchActionEncCipher $ entityVal o)
+        (getHex $ orchActionOutCipher $ entityVal o)
+        (getHex $ orchActionCv $ entityVal o)
+        (getHex $ orchActionAuth $ entityVal o)
+
+updateSaplingWitnesses :: ConnectionPool -> IO ()
+updateSaplingWitnesses pool = do
+  sapNotes <- getUnspentSapNotes pool
+  maxId <- liftIO $ getMaxSaplingNote pool
+  mapM_ (updateOneNote maxId) sapNotes
+  where
+    updateOneNote :: ShieldOutputId -> Entity WalletSapNote -> IO ()
+    updateOneNote maxId n = do
+      let noteSync = walletSapNoteWitPos $ entityVal n
+      when (noteSync < maxId) $ do
+        cmus <- liftIO $ getSaplingCmus pool $ walletSapNoteWitPos $ entityVal n
+        let cmuList = map (\(ESQ.Value x) -> getHex x) cmus
+        let newWitness =
+              updateSaplingWitness
+                (SaplingWitness $ getHex $ walletSapNoteWitness $ entityVal n)
+                cmuList
+        liftIO $ updateSapNoteRecord pool (entityKey n) newWitness maxId
+
+updateOrchardWitnesses :: ConnectionPool -> IO ()
+updateOrchardWitnesses pool = do
+  orchNotes <- getUnspentOrchNotes pool
+  maxId <- getMaxOrchardNote pool
+  mapM_ (updateOneNote maxId) orchNotes
+  where
+    updateOneNote :: OrchActionId -> Entity WalletOrchNote -> IO ()
+    updateOneNote maxId n = do
+      let noteSync = walletOrchNoteWitPos $ entityVal n
+      when (noteSync < maxId) $ do
+        cmxs <- liftIO $ getOrchardCmxs pool noteSync
+        let cmxList = map (\(ESQ.Value x) -> getHex x) cmxs
+        let newWitness =
+              updateOrchardWitness
+                (OrchardWitness $ getHex $ walletOrchNoteWitness $ entityVal n)
+                cmxList
+        liftIO $ updateOrchNoteRecord pool (entityKey n) newWitness maxId
+
+-- | Calculate fee per ZIP-317
+calculateTxFee ::
+     ([Entity WalletTrNote], [Entity WalletSapNote], [Entity WalletOrchNote])
+  -> Int
+  -> Integer
+calculateTxFee (t, s, o) i =
+  fromIntegral
+    (5000 * (max (length t) tout + max (length s) sout + length o + oout))
+  where
+    tout =
+      if i == 1 || i == 2
+        then 1
+        else 0
+    sout =
+      if i == 3
+        then 1
+        else 0
+    oout =
+      if i == 4
+        then 1
+        else 0
+
+-- | Prepare a transaction for sending
+prepareTx ::
+     ConnectionPool
+  -> T.Text
+  -> Int
+  -> ZcashNet
+  -> ZcashAccountId
+  -> Int
+  -> Float
+  -> UnifiedAddress
+  -> T.Text
+  -> LoggingT IO (Either TxError HexString)
+prepareTx pool zebraHost zebraPort zn za bh amt ua memo = do
+  accRead <- liftIO $ getAccountById pool za
+  let recipient =
+        case o_rec ua of
+          Nothing ->
+            case s_rec ua of
+              Nothing ->
+                case t_rec ua of
+                  Nothing -> (0, "")
+                  Just r3 ->
+                    case tr_type r3 of
+                      P2PKH -> (1, toBytes $ tr_bytes r3)
+                      P2SH -> (2, toBytes $ tr_bytes r3)
+              Just r2 -> (3, getBytes r2)
+          Just r1 -> (4, getBytes r1)
+  logDebugN $ T.pack $ show recipient
+  logDebugN $ T.pack $ "Target block: " ++ show bh
+  trees <- liftIO $ getCommitmentTrees zebraHost zebraPort bh
+  let sT = SaplingCommitmentTree $ ztiSapling trees
+  let oT = OrchardCommitmentTree $ ztiOrchard trees
+  case accRead of
+    Nothing -> do
+      logErrorN "Can't find Account"
+      return $ Left ZHError
+    Just acc -> do
+      logDebugN $ T.pack $ show acc
+      spParams <- liftIO $ BS.readFile "sapling-spend.params"
+      outParams <- liftIO $ BS.readFile "sapling-output.params"
+      if show (md5 $ LBS.fromStrict spParams) /=
+         "0f44c12ef115ae019decf18ade583b20"
+        then logErrorN "Can't validate sapling parameters"
+        else logInfoN "Valid Sapling spend params"
+      if show (md5 $ LBS.fromStrict outParams) /=
+         "924daf81b87a81bbbb9c7d18562046c8"
+        then logErrorN "Can't validate sapling parameters"
+        else logInfoN "Valid Sapling output params"
+      --print $ BS.length spParams
+      --print $ BS.length outParams
+      logDebugN "Read Sapling params"
+      let zats = fromIntegral $ floorFloatInteger $ amt * (10 ^ 8)
+      logDebugN $ T.pack $ show zats
+      {-firstPass <- liftIO $ selectUnspentNotes pool za zats-}
+      --let fee = calculateTxFee firstPass $ fst recipient
+      --logDebugN $ T.pack $ "calculated fee " ++ show fee
+      (tList, sList, oList) <- liftIO $ selectUnspentNotes pool za (zats + 5000)
+      logDebugN "selected notes"
+      logDebugN $ T.pack $ show tList
+      logDebugN $ T.pack $ show sList
+      logDebugN $ T.pack $ show oList
+      let noteTotal = getTotalAmount (tList, sList, oList)
+      tSpends <-
+        liftIO $
+        prepTSpends (getTranSK $ zcashAccountTPrivateKey $ entityVal acc) tList
+      --print tSpends
+      sSpends <-
+        liftIO $
+        prepSSpends (getSapSK $ zcashAccountSapSpendKey $ entityVal acc) sList
+      --print sSpends
+      oSpends <-
+        liftIO $
+        prepOSpends (getOrchSK $ zcashAccountOrchSpendKey $ entityVal acc) oList
+      --print oSpends
+      dummy <-
+        liftIO $ makeOutgoing acc recipient zats (noteTotal - 5000 - zats)
+      logDebugN "Calculating fee"
+      let feeResponse =
+            createTransaction
+              (Just sT)
+              (Just oT)
+              tSpends
+              sSpends
+              oSpends
+              dummy
+              (SaplingSpendParams spParams)
+              (SaplingOutputParams outParams)
+              zn
+              (bh + 3)
+              False
+      case feeResponse of
+        Left e1 -> return $ Left Fee
+        Right fee -> do
+          let feeAmt =
+                fromIntegral (runGet getInt64le $ LBS.fromStrict $ toBytes fee)
+          (tList1, sList1, oList1) <-
+            liftIO $ selectUnspentNotes pool za (zats + feeAmt)
+          logDebugN $ T.pack $ "selected notes with fee" ++ show feeAmt
+          logDebugN $ T.pack $ show tList
+          logDebugN $ T.pack $ show sList
+          logDebugN $ T.pack $ show oList
+          outgoing <-
+            liftIO $ makeOutgoing acc recipient zats (noteTotal - feeAmt - zats)
+          logDebugN $ T.pack $ show outgoing
+          let tx =
+                createTransaction
+                  (Just sT)
+                  (Just oT)
+                  tSpends
+                  sSpends
+                  oSpends
+                  outgoing
+                  (SaplingSpendParams spParams)
+                  (SaplingOutputParams outParams)
+                  zn
+                  (bh + 3)
+                  True
+          return tx
+  where
+    makeOutgoing ::
+         Entity ZcashAccount
+      -> (Int, BS.ByteString)
+      -> Integer
+      -> Integer
+      -> IO [OutgoingNote]
+    makeOutgoing acc (k, recvr) zats chg = do
+      chgAddr <- runNoLoggingT $ getInternalAddresses pool $ entityKey acc
+      let internalUA = getUA $ walletAddressUAddress $ entityVal $ head chgAddr
+      let chgRcvr =
+            fromJust $ o_rec =<< isValidUnifiedAddress (E.encodeUtf8 internalUA)
+      return
+        [ OutgoingNote
+            4
+            (getBytes $ getOrchSK $ zcashAccountOrchSpendKey $ entityVal acc)
+            (getBytes chgRcvr)
+            (fromIntegral chg)
+            ""
+            True
+        , OutgoingNote
+            (fromIntegral k)
+            (case k of
+               4 ->
+                 getBytes $ getOrchSK $ zcashAccountOrchSpendKey $ entityVal acc
+               3 ->
+                 getBytes $ getSapSK $ zcashAccountSapSpendKey $ entityVal acc
+               _ -> "")
+            recvr
+            (fromIntegral zats)
+            (E.encodeUtf8 memo)
+            False
+        ]
+    getTotalAmount ::
+         ( [Entity WalletTrNote]
+         , [Entity WalletSapNote]
+         , [Entity WalletOrchNote])
+      -> Integer
+    getTotalAmount (t, s, o) =
+      sum (map (fromIntegral . walletTrNoteValue . entityVal) t) +
+      sum (map (fromIntegral . walletSapNoteValue . entityVal) s) +
+      sum (map (fromIntegral . walletOrchNoteValue . entityVal) o)
+    prepTSpends ::
+         TransparentSpendingKey
+      -> [Entity WalletTrNote]
+      -> IO [TransparentTxSpend]
+    prepTSpends sk notes = do
+      forM notes $ \n -> do
+        tAddRead <- getAddressById pool $ walletTrNoteAddress $ entityVal n
+        case tAddRead of
+          Nothing -> throwIO $ userError "Couldn't read t-address"
+          Just tAdd -> do
+            (XPrvKey _ _ _ _ (SecKey xp_key)) <-
+              genTransparentSecretKey
+                (walletAddressIndex $ entityVal tAdd)
+                (getScope $ walletAddressScope $ entityVal tAdd)
+                sk
+            mReverseTxId <- getWalletTxId pool $ walletTrNoteTx $ entityVal n
+            case mReverseTxId of
+              Nothing -> throwIO $ userError "failed to get tx ID"
+              Just (ESQ.Value reverseTxId) -> do
+                let flipTxId = BS.reverse $ toBytes $ getHex reverseTxId
+                return $
+                  TransparentTxSpend
+                    xp_key
+                    (RawOutPoint
+                       flipTxId
+                       (fromIntegral $ walletTrNotePosition $ entityVal n))
+                    (RawTxOut
+                       (walletTrNoteValue $ entityVal n)
+                       (walletTrNoteScript $ entityVal n))
+    prepSSpends ::
+         SaplingSpendingKey -> [Entity WalletSapNote] -> IO [SaplingTxSpend]
+    prepSSpends sk notes = do
+      forM notes $ \n -> do
+        return $
+          SaplingTxSpend
+            (getBytes sk)
+            (DecodedNote
+               (fromIntegral $ walletSapNoteValue $ entityVal n)
+               (walletSapNoteRecipient $ entityVal n)
+               (E.encodeUtf8 $ walletSapNoteMemo $ entityVal n)
+               (getHex $ walletSapNoteNullifier $ entityVal n)
+               ""
+               (getRseed $ walletSapNoteRseed $ entityVal n))
+            (toBytes $ getHex $ walletSapNoteWitness $ entityVal n)
+    prepOSpends ::
+         OrchardSpendingKey -> [Entity WalletOrchNote] -> IO [OrchardTxSpend]
+    prepOSpends sk notes = do
+      forM notes $ \n -> do
+        return $
+          OrchardTxSpend
+            (getBytes sk)
+            (DecodedNote
+               (fromIntegral $ walletOrchNoteValue $ entityVal n)
+               (walletOrchNoteRecipient $ entityVal n)
+               (E.encodeUtf8 $ walletOrchNoteMemo $ entityVal n)
+               (getHex $ walletOrchNoteNullifier $ entityVal n)
+               (walletOrchNoteRho $ entityVal n)
+               (getRseed $ walletOrchNoteRseed $ entityVal n))
+            (toBytes $ getHex $ walletOrchNoteWitness $ entityVal n)
+    sapAnchor :: [Entity WalletSapNote] -> Maybe SaplingWitness
+    sapAnchor notes =
+      if not (null notes)
+        then Just $
+             SaplingWitness $
+             getHex $ walletSapNoteWitness $ entityVal $ head notes
+        else Nothing
+    orchAnchor :: [Entity WalletOrchNote] -> Maybe OrchardWitness
+    orchAnchor notes =
+      if not (null notes)
+        then Just $
+             OrchardWitness $
+             getHex $ walletOrchNoteWitness $ entityVal $ head notes
+        else Nothing
+
+-- | Sync the wallet with the data store
+syncWallet ::
+     Config -- ^ configuration parameters
+  -> Entity ZcashWallet
+  -> IO ()
+syncWallet config w = do
+  startTime <- liftIO getCurrentTime
+  let walletDb = c_dbPath config
+  pool <- runNoLoggingT $ initPool walletDb
+  accs <- runNoLoggingT $ getAccounts pool $ entityKey w
+  addrs <- concat <$> mapM (runNoLoggingT . getAddresses pool . entityKey) accs
+  intAddrs <-
+    concat <$> mapM (runNoLoggingT . getInternalAddresses pool . entityKey) accs
+  chainTip <- runNoLoggingT $ getMaxBlock pool
+  let lastBlock = zcashWalletLastSync $ entityVal w
+  let startBlock =
+        if lastBlock > 0
+          then lastBlock
+          else zcashWalletBirthdayHeight $ entityVal w
+  mapM_ (liftIO . findTransparentNotes pool startBlock) addrs
+  mapM_ (liftIO . findTransparentNotes pool startBlock) intAddrs
+  mapM_ (liftIO . findTransparentSpends pool . entityKey) accs
+  sapNotes <-
+    liftIO $
+    mapM
+      (findSaplingOutputs config startBlock (zcashWalletNetwork $ entityVal w))
+      accs
+  orchNotes <-
+    liftIO $
+    mapM
+      (findOrchardActions config startBlock (zcashWalletNetwork $ entityVal w))
+      accs
+  _ <- updateSaplingWitnesses pool
+  _ <- updateOrchardWitnesses pool
+  _ <- liftIO $ updateWalletSync pool chainTip (entityKey w)
+  mapM_ (runNoLoggingT . getWalletTransactions pool) addrs
+
+testSync :: Config -> IO ()
+testSync config = do
+  let dbPath = c_dbPath config
+  _ <- initDb dbPath
+  pool <- runNoLoggingT $ initPool dbPath
+  w <- getWallets pool TestNet
+  r <- mapM (syncWallet config) w
+  liftIO $ print r
+  {-let uaRead =-}
+        {-isValidUnifiedAddress-}
+          {-"utest1dl54utt6prjj5e0dnlknwumnxq9hycdjpkfr0sy6e6h522remqee8axe9zax0wsjrwpj76v555pdhvj9rnargpfyycs0vpkapq98xcdhem99gc4wchzn0ggepq3y6nz3a9sscwgqxgsh9vzhcad402y3x9szfregck5gslkya3c79d86xx0l33tpk8gnn7ew9vw37w43zh22u8dgdax"-}
+  {-case uaRead of-}
+    {-Nothing -> print "wrong address"-}
+    {-Just ua -> do-}
+      {-startTime <- getCurrentTime-}
+      {-print startTime-}
+      {-tx <--}
+        {-prepareTx-}
+          {-"zenith.db"-}
+          {-"127.0.0.1"-}
+          {-18232-}
+          {-TestNet-}
+          {-(toSqlKey 1)-}
+          {-2820897-}
+          {-0.04-}
+          {-ua-}
+          {-"sent with Zenith, test"-}
+      {-print tx-}
+      {-endTime <- getCurrentTime-}
+      {-print endTime-}
+
+{-testSend :: IO ()-}
+{-testSend = do-}
+clearSync :: Config -> IO ()
+clearSync config = do
+  let dbPath = c_dbPath config
+  pool <- runNoLoggingT $ initPool dbPath
+  _ <- initDb dbPath
+  _ <- clearWalletTransactions pool
+  w <- getWallets pool TestNet
+  liftIO $ mapM_ (updateWalletSync pool 0 . entityKey) w
+  w' <- liftIO $ getWallets pool TestNet
+  r <- mapM (syncWallet config) w'
+  liftIO $ print r

src/Zenith/Scanner.hs

@@ -0,0 +1,157 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module Zenith.Scanner where
+
+import Control.Exception (throwIO, try)
+import qualified Control.Monad.Catch as CM (try)
+import Control.Monad.IO.Class (liftIO)
+import Control.Monad.Logger
+  ( LoggingT
+  , NoLoggingT
+  , logErrorN
+  , logInfoN
+  , runNoLoggingT
+  )
+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(..)
+  , ZebraGetBlockChainInfo(..)
+  , ZebraTxResponse(..)
+  , fromRawOBundle
+  , fromRawSBundle
+  , fromRawTBundle
+  )
+import ZcashHaskell.Utils (getBlockTime, makeZebraCall, readZebraTransaction)
+import Zenith.Core (checkBlockChain)
+import Zenith.DB (getMaxBlock, initDb, saveTransaction)
+import Zenith.Utils (jsonNumber)
+
+-- | Function to scan the Zcash blockchain through the Zebra node and populate the Zenith database
+scanZebra ::
+     Int -- ^ Starting block
+  -> T.Text -- ^ Host
+  -> Int -- ^ Port
+  -> T.Text -- ^ Path to database file
+  -> NoLoggingT IO ()
+scanZebra b host port dbFilePath = do
+  _ <- liftIO $ initDb dbFilePath
+  startTime <- liftIO getCurrentTime
+  logInfoN $ "Started sync: " <> T.pack (show startTime)
+  bc <-
+    liftIO $ try $ checkBlockChain host port :: NoLoggingT
+      IO
+      (Either IOError ZebraGetBlockChainInfo)
+  case bc of
+    Left e -> logErrorN $ T.pack (show e)
+    Right bStatus -> do
+      let dbInfo =
+            mkSqliteConnectionInfo dbFilePath & extraPragmas .~
+            ["read_uncommited = true"]
+      pool <- createSqlitePoolFromInfo dbInfo 5
+      dbBlock <- getMaxBlock pool
+      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 + 1) ++ " to " ++ show (zgb_blocks bStatus)
+          let bList = [(sb + 1) .. (zgb_blocks bStatus)]
+          displayConsoleRegions $ do
+            pg <-
+              liftIO $
+              newProgressBar def {pgTotal = fromIntegral $ length bList}
+            txList <-
+              CM.try $ mapM_ (processBlock host port pool pg) bList :: NoLoggingT
+                IO
+                (Either IOError ())
+            case txList of
+              Left e1 -> logErrorN $ T.pack (show e1)
+              Right txList' -> logInfoN "Finished scan"
+
+-- | Function to process a raw block and extract the transaction information
+processBlock ::
+     T.Text -- ^ Host name for `zebrad`
+  -> Int -- ^ Port for `zebrad`
+  -> ConnectionPool -- ^ DB file path
+  -> ProgressBar -- ^ Progress bar
+  -> Int -- ^ The block number to process
+  -> NoLoggingT IO ()
+processBlock host port pool pg b = do
+  r <-
+    liftIO $
+    makeZebraCall
+      host
+      port
+      "getblock"
+      [Data.Aeson.String $ T.pack $ show b, jsonNumber 1]
+  case r of
+    Left e -> liftIO $ throwIO $ userError e
+    Right blk -> do
+      r2 <-
+        liftIO $
+        makeZebraCall
+          host
+          port
+          "getblock"
+          [Data.Aeson.String $ T.pack $ show b, jsonNumber 0]
+      case r2 of
+        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`
+  -> Int -- ^ Block time
+  -> ConnectionPool -- ^ DB file path
+  -> HexString -- ^ transaction id
+  -> NoLoggingT IO ()
+processTx host port bt pool t = do
+  r <-
+    liftIO $
+    makeZebraCall
+      host
+      port
+      "getrawtransaction"
+      [Data.Aeson.String $ toText t, jsonNumber 1]
+  case r of
+    Left e -> liftIO $ throwIO $ userError e
+    Right rawTx -> do
+      case readZebraTransaction (ztr_hex rawTx) of
+        Nothing -> return ()
+        Just rzt -> do
+          _ <-
+            saveTransaction pool bt $
+            Transaction
+              t
+              (ztr_blockheight rawTx)
+              (ztr_conf rawTx)
+              (fromIntegral $ zt_expiry rzt)
+              (fromRawTBundle $ zt_tBundle rzt)
+              (fromRawSBundle $ zt_sBundle rzt)
+              (fromRawOBundle $ zt_oBundle rzt)
+          return ()

src/Zenith/Types.hs

@@ -0,0 +1,350 @@
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE DerivingStrategies #-}
+{-# LANGUAGE GeneralisedNewtypeDeriving #-}
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE StandaloneDeriving #-}
+
+module Zenith.Types where
+
+import Data.Aeson
+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.Maybe (fromMaybe)
+import qualified Data.Text as T
+import qualified Data.Text.Encoding as E
+import Data.Text.Encoding.Error (lenientDecode)
+import Database.Persist.TH
+import GHC.Generics
+import ZcashHaskell.Types
+  ( OrchardSpendingKey(..)
+  , Phrase(..)
+  , Rseed(..)
+  , SaplingSpendingKey(..)
+  , Scope(..)
+  , TransparentSpendingKey
+  , ZcashNet(..)
+  )
+
+-- * UI
+-- * Database field type wrappers
+newtype HexStringDB = HexStringDB
+  { getHex :: HexString
+  } deriving newtype (Eq, Show, Read)
+
+derivePersistField "HexStringDB"
+
+newtype ZcashNetDB = ZcashNetDB
+  { getNet :: ZcashNet
+  } deriving newtype (Eq, Show, Read)
+
+derivePersistField "ZcashNetDB"
+
+newtype UnifiedAddressDB = UnifiedAddressDB
+  { getUA :: T.Text
+  } deriving newtype (Eq, Show, Read)
+
+derivePersistField "UnifiedAddressDB"
+
+newtype PhraseDB = PhraseDB
+  { getPhrase :: Phrase
+  } deriving newtype (Eq, Show, Read)
+
+derivePersistField "PhraseDB"
+
+newtype ScopeDB = ScopeDB
+  { getScope :: Scope
+  } deriving newtype (Eq, Show, Read)
+
+derivePersistField "ScopeDB"
+
+newtype OrchardSpendingKeyDB = OrchardSpendingKeyDB
+  { getOrchSK :: OrchardSpendingKey
+  } deriving newtype (Eq, Show, Read)
+
+derivePersistField "OrchardSpendingKeyDB"
+
+newtype SaplingSpendingKeyDB = SaplingSpendingKeyDB
+  { getSapSK :: SaplingSpendingKey
+  } deriving newtype (Eq, Show, Read)
+
+derivePersistField "SaplingSpendingKeyDB"
+
+newtype TransparentSpendingKeyDB = TransparentSpendingKeyDB
+  { getTranSK :: TransparentSpendingKey
+  } deriving newtype (Eq, Show, Read)
+
+derivePersistField "TransparentSpendingKeyDB"
+
+newtype RseedDB = RseedDB
+  { getRseed :: Rseed
+  } deriving newtype (Eq, Show, Read)
+
+derivePersistField "RseedDB"
+
+-- * RPC
+-- | Type for Configuration parameters
+data Config = Config
+  { c_dbPath :: !T.Text
+  , c_zebraHost :: !T.Text
+  , c_zebraPort :: !Int
+  } deriving (Eq, Prelude.Show)
+
+-- ** `zebrad`
+-- | Type for modeling the tree state response
+data ZebraTreeInfo = ZebraTreeInfo
+  { ztiHeight :: !Int
+  , ztiTime :: !Int
+  , ztiSapling :: !HexString
+  , ztiOrchard :: !HexString
+  } deriving (Eq, Show, Read)
+
+instance FromJSON ZebraTreeInfo where
+  parseJSON =
+    withObject "ZebraTreeInfo" $ \obj -> do
+      h <- obj .: "height"
+      t <- obj .: "time"
+      s <- obj .: "sapling"
+      o <- obj .: "orchard"
+      sc <- s .: "commitments"
+      oc <- o .: "commitments"
+      sf <- sc .: "finalState"
+      ocf <- oc .: "finalState"
+      pure $ ZebraTreeInfo h t sf ocf
+
+-- ** `zcashd`
+-- | Type for modelling the different address sources for `zcashd` 5.0.0
+data AddressSource
+  = LegacyRandom
+  | Imported
+  | ImportedWatchOnly
+  | KeyPool
+  | LegacySeed
+  | MnemonicSeed
+  deriving (Read, Show, Eq, Generic, ToJSON)
+
+instance FromJSON AddressSource where
+  parseJSON =
+    withText "AddressSource" $ \case
+      "legacy_random" -> return LegacyRandom
+      "imported" -> return Imported
+      "imported_watchonly" -> return ImportedWatchOnly
+      "keypool" -> return KeyPool
+      "legacy_hdseed" -> return LegacySeed
+      "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]
+  , account :: Maybe Integer
+  , addy :: T.Text
+  } deriving (Eq)
+
+instance Show ZcashAddress where
+  show (ZcashAddress s p i a) =
+    T.unpack (T.take 8 a) ++
+    "..." ++ T.unpack (T.takeEnd 8 a) ++ " Pools: " ++ show p
+
+newtype NodeVersion =
+  NodeVersion Integer
+  deriving (Eq, Show)
+
+instance FromJSON NodeVersion where
+  parseJSON =
+    withObject "NodeVersion" $ \obj -> do
+      v <- obj .: "version"
+      pure $ NodeVersion v
+
+-- | A type to model an address group
+data AddressGroup = AddressGroup
+  { agsource :: !AddressSource
+  , agtransparent :: ![ZcashAddress]
+  , agsapling :: ![ZcashAddress]
+  , agunified :: ![ZcashAddress]
+  } deriving (Show, Generic)
+
+instance FromJSON AddressGroup where
+  parseJSON =
+    withObject "AddressGroup" $ \obj -> do
+      s <- obj .: "source"
+      t <- obj .:? "transparent"
+      sap <- obj .:? "sapling"
+      uni <- obj .:? "unified"
+      sL <- processSapling sap s
+      tL <- processTransparent t s
+      uL <- processUnified uni
+      return $ AddressGroup s tL (concat sL) (concat uL)
+    where
+      processTransparent c s1 =
+        case c of
+          Nothing -> return []
+          Just x -> do
+            x' <- x .:? "addresses"
+            return $ maybe [] (map (ZcashAddress s1 [Transparent] Nothing)) x'
+      processSapling k s2 =
+        case k of
+          Nothing -> return []
+          Just y -> mapM (processOneSapling s2) y
+            where processOneSapling sx =
+                    withObject "Sapling" $ \oS -> do
+                      oS' <- oS .: "addresses"
+                      return $ map (ZcashAddress sx [Sapling] Nothing) oS'
+      processUnified u =
+        case u of
+          Nothing -> return []
+          Just z -> mapM processOneAccount z
+            where processOneAccount =
+                    withObject "UAs" $ \uS -> do
+                      acct <- uS .: "account"
+                      uS' <- uS .: "addresses"
+                      mapM (processUAs acct) uS'
+                    where
+                      processUAs a =
+                        withObject "UAs" $ \v -> do
+                          addr <- v .: "address"
+                          p <- v .: "receiver_types"
+                          return $ ZcashAddress MnemonicSeed p a addr
+
+-- | A type to model a Zcash transaction
+data ZcashTx = ZcashTx
+  { ztxid :: !T.Text
+  , zamount :: !Double
+  , zamountZat :: !Integer
+  , zblockheight :: !Integer
+  , zblocktime :: !Integer
+  , zchange :: !Bool
+  , zconfirmations :: !Integer
+  , zmemo :: !T.Text
+  } deriving (Show, Generic)
+
+instance FromJSON ZcashTx where
+  parseJSON =
+    withObject "ZcashTx" $ \obj -> do
+      t <- obj .: "txid"
+      a <- obj .: "amount"
+      aZ <- obj .: "amountZat"
+      bh <- obj .: "blockheight"
+      bt <- obj .: "blocktime"
+      c <- obj .:? "change"
+      conf <- obj .: "confirmations"
+      m <- obj .:? "memo"
+      pure $
+        ZcashTx
+          t
+          a
+          aZ
+          bh
+          bt
+          (fromMaybe False c)
+          conf
+          (case m of
+             Nothing -> ""
+             Just m' -> T.filter (/= '\NUL') $ decodeHexText m')
+
+instance ToJSON ZcashTx where
+  toJSON (ZcashTx t a aZ bh bt c conf m) =
+    object
+      [ "amount" .= a
+      , "amountZat" .= aZ
+      , "txid" .= t
+      , "blockheight" .= bh
+      , "blocktime" .= bt
+      , "change" .= c
+      , "confirmations" .= conf
+      , "memo" .= m
+      ]
+
+-- | Type for the UA balance
+data UABalance = UABalance
+  { uatransparent :: !Integer
+  , uasapling :: !Integer
+  , uaorchard :: !Integer
+  } deriving (Eq)
+
+instance Show UABalance where
+  show (UABalance t s o) =
+    " T: " ++ show t ++ " S: " ++ show s ++ " O: " ++ show o
+
+instance FromJSON UABalance where
+  parseJSON =
+    withObject "UABalance" $ \obj -> do
+      p <- obj .: "pools"
+      t <- p .:? "transparent"
+      s <- p .:? "sapling"
+      o <- p .:? "orchard"
+      vT <-
+        case t of
+          Nothing -> return 0
+          Just t' -> t' .: "valueZat"
+      vS <-
+        case s of
+          Nothing -> return 0
+          Just s' -> s' .: "valueZat"
+      vO <-
+        case o of
+          Nothing -> return 0
+          Just o' -> o' .: "valueZat"
+      pure $ UABalance vT vS vO
+
+-- | Type for Operation Result
+data OpResult = OpResult
+  { opsuccess :: !T.Text
+  , opmessage :: !(Maybe T.Text)
+  , optxid :: !(Maybe T.Text)
+  } deriving (Show, Eq)
+
+instance FromJSON OpResult where
+  parseJSON =
+    withObject "OpResult" $ \obj -> do
+      s <- obj .: "status"
+      r <- obj .:? "result"
+      e <- obj .:? "error"
+      t <-
+        case r of
+          Nothing -> return Nothing
+          Just r' -> r' .: "txid"
+      m <-
+        case e of
+          Nothing -> return Nothing
+          Just m' -> m' .: "message"
+      pure $ OpResult s m t
+
+-- * Helper functions
+-- | Helper function to turn a hex-encoded memo strings to readable text
+decodeHexText :: String -> T.Text
+decodeHexText h = E.decodeUtf8With lenientDecode $ BS.pack $ hexRead h
+  where
+    hexRead hexText
+      | null chunk = []
+      | otherwise =
+        fromIntegral (read ("0x" <> chunk)) : hexRead (drop 2 hexText)
+      where
+        chunk = take 2 hexText
+
+-- | Helper function to turn a text into a hex-encoded string
+encodeHexText' :: T.Text -> String
+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"

src/Zenith/Utils.hs

@@ -0,0 +1,74 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module Zenith.Utils where
+
+import Data.Aeson
+import Data.Functor (void)
+import Data.Maybe
+import Data.Scientific (Scientific(..), scientific)
+import qualified Data.Text as T
+import qualified Data.Text.Encoding as E
+import System.Process (createProcess_, shell)
+import Text.Regex.Posix
+import ZcashHaskell.Orchard (encodeUnifiedAddress, isValidUnifiedAddress)
+import ZcashHaskell.Sapling (isValidShieldedAddress)
+import Zenith.Types
+  ( AddressGroup(..)
+  , UnifiedAddressDB(..)
+  , ZcashAddress(..)
+  , ZcashPool(..)
+  )
+
+-- | Helper function to convert numbers into JSON
+jsonNumber :: Int -> Value
+jsonNumber i = Number $ scientific (fromIntegral i) 0
+
+-- | Helper function to display small amounts of ZEC
+displayZec :: Integer -> String
+displayZec s
+  | abs s < 100 = show s ++ " zats "
+  | abs s < 100000 = show (fromIntegral s / 100) ++ " μZEC "
+  | abs s < 100000000 = show (fromIntegral s / 100000) ++ " mZEC "
+  | otherwise = show (fromIntegral s / 100000000) ++ " ZEC "
+
+-- | Helper function to display small amounts of ZEC
+displayTaz :: Integer -> String
+displayTaz s
+  | abs s < 100 = show s ++ " tazs "
+  | abs s < 100000 = show (fromIntegral s / 100) ++ " μTAZ "
+  | abs s < 100000000 = show (fromIntegral s / 100000) ++ " mTAZ "
+  | otherwise = show (fromIntegral s / 100000000) ++ " TAZ "
+
+-- | Helper function to display abbreviated Unified Address
+showAddress :: UnifiedAddressDB -> T.Text
+showAddress u = T.take 20 t <> "..."
+  where
+    t = getUA u
+
+-- | Helper function to extract addresses from AddressGroups
+getAddresses :: AddressGroup -> [ZcashAddress]
+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 Transparent
+  | sReg && chkS = Just Sapling
+  | uReg && chk = Just Orchard
+  | otherwise = Nothing
+  where
+    transparentRegex = "^t1[a-zA-Z0-9]{33}$" :: String
+    shieldedRegex = "^zs[a-zA-Z0-9]{76}$" :: String
+    unifiedRegex = "^u[a-zA-Z0-9]" :: String
+    tReg = T.unpack txt =~ transparentRegex :: Bool
+    sReg = T.unpack txt =~ shieldedRegex :: Bool
+    uReg = T.unpack txt =~ unifiedRegex :: Bool
+    chk = isJust $ isValidUnifiedAddress $ E.encodeUtf8 txt
+    chkS = isValidShieldedAddress $ E.encodeUtf8 txt
+
+-- | Copy an address to the clipboard
+copyAddress :: ZcashAddress -> IO ()
+copyAddress a =
+  void $
+  createProcess_ "toClipboard" $
+  shell $ "echo " ++ T.unpack (addy a) ++ " | xclip -r -selection clipboard"

src/Zenith/Zcashd.hs

@@ -0,0 +1,343 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module Zenith.Zcashd where
+
+import Control.Concurrent (threadDelay)
+import Control.Monad (when)
+import Data.Aeson
+import qualified Data.Array as A
+import qualified Data.ByteString as BS
+import qualified Data.ByteString.Base64 as B64
+import qualified Data.ByteString.Char8 as C
+import qualified Data.ByteString.Lazy as LBS
+import Data.Maybe
+import qualified Data.Scientific as Scientific
+import qualified Data.Text as T
+import qualified Data.Text.Encoding as E
+import Data.Text.Encoding.Error (lenientDecode)
+import qualified Data.Text.IO as TIO
+import qualified Data.Vector as V
+import Network.HTTP.Simple
+import System.Clipboard
+import System.Exit
+import System.IO
+import Text.Read (readMaybe)
+import Text.Regex
+import Text.Regex.Base
+import ZcashHaskell.Types (RpcCall(..), RpcResponse(..))
+import Zenith.Types
+  ( AddressGroup
+  , AddressSource(..)
+  , NodeVersion(..)
+  , OpResult(..)
+  , UABalance(..)
+  , ZcashAddress(..)
+  , ZcashPool(..)
+  , ZcashTx
+  , encodeHexText'
+  )
+import Zenith.Utils (displayZec, getAddresses, validateAddress)
+
+-- * RPC methods
+-- | List addresses
+listAddresses :: BS.ByteString -> BS.ByteString -> IO [ZcashAddress]
+listAddresses user pwd = do
+  response <- makeZcashCall user pwd "listaddresses" []
+  let rpcResp = decode response :: Maybe (RpcResponse [AddressGroup])
+  case rpcResp of
+    Nothing -> fail "Couldn't parse node response"
+    Just res -> do
+      let addys = result res
+      case addys of
+        Nothing -> fail "Empty response"
+        Just addys' -> do
+          let addList = concatMap getAddresses addys'
+          return addList
+
+-- | Get address balance
+getBalance :: BS.ByteString -> BS.ByteString -> ZcashAddress -> IO [Integer]
+getBalance user pwd zadd = do
+  let a = account zadd
+  case a of
+    Nothing -> do
+      response <-
+        makeZcashCall
+          user
+          pwd
+          "z_getbalance"
+          [ String (addy zadd)
+          , Number (Scientific.scientific 1 0)
+          , Data.Aeson.Bool True
+          ]
+      let rpcResp = decode response :: Maybe (RpcResponse Integer)
+      case rpcResp of
+        Nothing -> fail "Couldn't parse node response"
+        Just res -> do
+          case result res of
+            Nothing -> return []
+            Just r -> return [r]
+    Just acct -> do
+      response <-
+        makeZcashCall
+          user
+          pwd
+          "z_getbalanceforaccount"
+          [Number (Scientific.scientific acct 0)]
+      let rpcResp = decode response :: Maybe (RpcResponse UABalance)
+      case rpcResp of
+        Nothing -> fail "Couldn't parse node response"
+        Just res -> do
+          case result res of
+            Nothing -> return [0, 0, 0]
+            Just r -> return $ readUABalance r
+          where readUABalance ua =
+                  [uatransparent ua, uasapling ua, uaorchard ua]
+
+-- | List transactions
+listTxs :: BS.ByteString -> BS.ByteString -> ZcashAddress -> IO [ZcashTx]
+listTxs user pwd zaddy = do
+  response <-
+    makeZcashCall user pwd "z_listreceivedbyaddress" [String $ addy zaddy]
+  let rpcResp = decode response :: Maybe (RpcResponse [ZcashTx])
+  case rpcResp of
+    Nothing -> fail "listTxs: Couldn't parse node response"
+    Just res -> do
+      case result res of
+        Nothing -> fail "listTxs: Empty response"
+        Just res' -> return res'
+
+-- | Send Tx
+sendTx ::
+     BS.ByteString
+  -> BS.ByteString
+  -> ZcashAddress
+  -> T.Text
+  -> Double
+  -> Maybe T.Text
+  -> IO ()
+sendTx user pwd fromAddy toAddy amount memo = do
+  bal <- getBalance user pwd fromAddy
+  let valAdd = validateAddress toAddy
+  if sum bal - floor (amount * 100000000) >= 1000
+    then do
+      if source fromAddy /= ImportedWatchOnly
+        then do
+          let privacyPolicy
+                | valAdd == Just Transparent = "AllowRevealedRecipients"
+                | isNothing (account fromAddy) &&
+                    elem Transparent (pool fromAddy) = "AllowRevealedSenders"
+                | otherwise = "AllowRevealedAmounts"
+          let pd =
+                case memo of
+                  Nothing ->
+                    [ Data.Aeson.String (addy fromAddy)
+                    , Data.Aeson.Array
+                        (V.fromList
+                           [object ["address" .= toAddy, "amount" .= amount]])
+                    , Data.Aeson.Number $ Scientific.scientific 1 1
+                    , Data.Aeson.Null
+                    , Data.Aeson.String privacyPolicy
+                    ]
+                  Just memo' ->
+                    [ Data.Aeson.String (addy fromAddy)
+                    , Data.Aeson.Array
+                        (V.fromList
+                           [ object
+                               [ "address" .= toAddy
+                               , "amount" .= amount
+                               , "memo" .= encodeHexText' memo'
+                               ]
+                           ])
+                    , Data.Aeson.Number $ Scientific.scientific 1 1
+                    , Data.Aeson.Null
+                    , Data.Aeson.String privacyPolicy
+                    ]
+          response <- makeZcashCall user pwd "z_sendmany" pd
+          let rpcResp = decode response :: Maybe (RpcResponse T.Text)
+          case rpcResp of
+            Nothing -> fail "Couldn't parse node response"
+            Just res -> do
+              putStr "  Sending."
+              checkOpResult user pwd (fromMaybe "" $ result res)
+        else putStrLn "Error: Source address is view-only."
+    else putStrLn "Error: Insufficient balance in source address."
+
+-- | Check Zcash full node server
+checkServer :: BS.ByteString -> BS.ByteString -> IO ()
+checkServer user pwd = do
+  resp <- makeZcashCall user pwd "getinfo" []
+  let rpcResp = decode resp :: Maybe (RpcResponse NodeVersion)
+  case rpcResp of
+    Nothing -> fail "Couldn't parse node response"
+    Just myResp -> do
+      let r = result myResp
+      case r of
+        Nothing -> fail "Empty node response"
+        Just r' -> do
+          if isNodeValid r'
+            then putStrLn $ "Connected to Zcash Full Node (" <> show r <> ") :)"
+            else do
+              putStrLn "Deprecated Zcash Full Node version found. Exiting"
+              exitFailure
+      where isNodeValid (NodeVersion i) = i >= 5000000
+
+-- | Check for accounts
+checkAccounts :: BS.ByteString -> BS.ByteString -> IO Bool
+checkAccounts user pwd = do
+  response <- makeZcashCall user pwd "z_listaccounts" []
+  let rpcResp = decode response :: Maybe (RpcResponse [Object])
+  case rpcResp of
+    Nothing -> fail "Couldn't parse node response"
+    Just res -> do
+      let r = result res
+      return $ not (null r)
+
+-- | Add account to node
+createAccount :: BS.ByteString -> BS.ByteString -> IO ()
+createAccount user pwd = do
+  response <- makeZcashCall user pwd "z_getnewaccount" []
+  let rpcResp = decode response :: Maybe (RpcResponse Object)
+  case rpcResp of
+    Nothing -> fail "Couldn't parse node response"
+    Just res -> do
+      let r = result res
+      putStrLn "  Account created!"
+
+-- | Create new Unified Address
+createUnifiedAddress :: BS.ByteString -> BS.ByteString -> Bool -> Bool -> IO ()
+createUnifiedAddress user pwd tRec sRec = do
+  let recs = getReceivers tRec sRec
+  let pd = [Data.Aeson.Number $ Scientific.scientific 0 1, recs]
+  newResp <- makeZcashCall user pwd "z_getaddressforaccount" pd
+  let rpcResp = decode newResp :: Maybe (RpcResponse Object)
+  case rpcResp of
+    Nothing -> fail "Couldn't parse node response"
+    Just res -> do
+      let r = result res
+      putStrLn "  New UA created!"
+  where
+    getReceivers t s
+      | t && s =
+        Data.Aeson.Array
+          (V.fromList
+             [ Data.Aeson.String "p2pkh"
+             , Data.Aeson.String "sapling"
+             , Data.Aeson.String "orchard"
+             ])
+      | t =
+        Data.Aeson.Array
+          (V.fromList [Data.Aeson.String "p2pkh", Data.Aeson.String "orchard"])
+      | s =
+        Data.Aeson.Array
+          (V.fromList [Data.Aeson.String "sapling", Data.Aeson.String "orchard"])
+      | otherwise = Data.Aeson.Array (V.fromList [Data.Aeson.String "orchard"])
+
+-- | Verify operation result
+checkOpResult :: BS.ByteString -> BS.ByteString -> T.Text -> IO ()
+checkOpResult user pwd opid = do
+  response <-
+    makeZcashCall
+      user
+      pwd
+      "z_getoperationstatus"
+      [Data.Aeson.Array (V.fromList [Data.Aeson.String opid])]
+  let rpcResp = decode response :: Maybe (RpcResponse [OpResult])
+  case rpcResp of
+    Nothing -> fail "Couldn't parse node response"
+    Just res -> do
+      let r = result res
+      case r of
+        Nothing -> fail "Empty node response"
+        Just r' -> mapM_ showResult r'
+  where
+    showResult t =
+      case opsuccess t of
+        "success" ->
+          putStrLn $ "  Success! Tx ID: " ++ maybe "" T.unpack (optxid t)
+        "executing" -> do
+          putStr "."
+          hFlush stdout
+          threadDelay 1000000 >> checkOpResult user pwd opid
+        _ -> putStrLn $ "  Failed :( " ++ maybe "" T.unpack (opmessage t)
+
+-- | Make a Zcash RPC call
+makeZcashCall ::
+     BS.ByteString
+  -> BS.ByteString
+  -> T.Text
+  -> [Data.Aeson.Value]
+  -> IO LBS.ByteString
+makeZcashCall username password m p = do
+  let payload = RpcCall "1.0" "test" m p
+  let myRequest =
+        setRequestBodyJSON payload $
+        setRequestPort 8232 $
+        setRequestBasicAuth username password $
+        setRequestMethod "POST" defaultRequest
+  response <- httpLBS myRequest
+  let respStatus = getResponseStatusCode response
+  let body = getResponseBody response
+  case respStatus of
+    500 -> do
+      let rpcResp = decode body :: Maybe (RpcResponse String)
+      case rpcResp of
+        Nothing -> fail $ "Unknown server error " ++ show response
+        Just x -> fail (fromMaybe "" $ result x)
+    401 -> fail "Incorrect full node credentials"
+    200 -> return body
+    _ -> fail "Unknown error"
+
+-- | Read ZIP-321 URI
+sendWithUri ::
+     BS.ByteString -> BS.ByteString -> ZcashAddress -> String -> Bool -> IO ()
+sendWithUri user pwd fromAddy uri repTo = do
+  let uriRegex = mkRegex "^zcash:(\\w+)\\?amount=(.*)\\&memo=(.*)$"
+  if matchTest uriRegex uri
+    then do
+      let reg = matchAllText uriRegex uri
+      let parsedAddress = fst $ head reg A.! 1
+      let parsedAmount = fst $ head reg A.! 2
+      let parsedEncodedMemo = fst $ head reg A.! 3
+      let addType = validateAddress $ T.pack parsedAddress
+      case addType of
+        Nothing -> putStrLn "   Invalid address"
+        Just Transparent -> do
+          putStrLn $ "   Address is valid: " ++ parsedAddress
+          case (readMaybe parsedAmount :: Maybe Double) of
+            Nothing -> putStrLn "   Invalid amount."
+            Just amt -> do
+              putStrLn $ "   Valid ZEC amount: " ++ show amt
+              sendTx user pwd fromAddy (T.pack parsedAddress) amt Nothing
+        Just _ -> do
+          putStrLn $ "   Address is valid: " ++ parsedAddress
+          case (readMaybe parsedAmount :: Maybe Double) of
+            Nothing -> putStrLn "   Invalid amount."
+            Just amt -> do
+              putStrLn $ "   Valid ZEC amount: " ++ show amt
+              let decodedMemo =
+                    E.decodeUtf8With lenientDecode $
+                    B64.decodeLenient $ C.pack parsedEncodedMemo
+              TIO.putStrLn $ "   Memo: " <> decodedMemo
+              sendTx
+                user
+                pwd
+                fromAddy
+                (T.pack parsedAddress)
+                amt
+                (if repTo
+                   then Just $
+                        T.concat [decodedMemo, "\nReply-To:\n", addy fromAddy]
+                   else Just decodedMemo)
+    else putStrLn "URI is not compliant with ZIP-321"
+
+-- | Display an address
+displayZcashAddress ::
+     BS.ByteString -> BS.ByteString -> (Int, ZcashAddress) -> IO ()
+displayZcashAddress user pwd (idx, zaddy) = do
+  zats <- getBalance user pwd zaddy
+  putStr $ show idx ++ ": "
+  putStr $ show zaddy
+  when (source zaddy == ImportedWatchOnly) (putStr "[VK]")
+  putStr " Balance: "
+  mapM_ (putStr . displayZec) zats
+  putStrLn ""

stack.yaml

@@ -1,81 +0,0 @@
-# This file was automatically generated by 'stack init'
-#
-# Some commonly used options have been documented as comments in this file.
-# For advanced use and comprehensive documentation of the format, please see:
-# https://docs.haskellstack.org/en/stable/yaml_configuration/
-
-# Resolver to choose a 'specific' stackage snapshot or a compiler version.
-# A snapshot resolver dictates the compiler version and the set of packages
-# to be used for project dependencies. For example:
-#
-# resolver: lts-3.5
-# resolver: nightly-2015-09-21
-# resolver: ghc-7.10.2
-#
-# The location of a snapshot can be provided as a file or url. Stack assumes
-# a snapshot provided as a file might change, whereas a url resource does not.
-#
-# resolver: ./custom-snapshot.yaml
-# resolver: https://example.com/snapshots/2018-01-01.yaml
-resolver: lts-21.6
-
-# User packages to be built.
-# Various formats can be used as shown in the example below.
-#
-# packages:
-# - some-directory
-# - https://example.com/foo/bar/baz-0.0.2.tar.gz
-#   subdirs:
-#   - auto-update
-#   - wai
-packages:
-- .
-#- haskoin-core
-#- zcash-haskell
-# Dependency packages to be pulled from upstream that are not in the resolver.
-# These entries can reference officially published versions as well as
-# forks / in-progress versions pinned to a git hash. For example:
-#
-# extra-deps:
-# - acme-missiles-0.3
-# - git: https://github.com/commercialhaskell/stack.git
-#   commit: e7b331f14bcffb8367cd58fbfc8b40ec7642100a
-#
-# extra-deps: []
-extra-deps:
-  - git: https://git.vergara.tech/Vergara_Tech/zcash-haskell.git
-    commit: fef3d3af35a09db718cddb8fc9166b2d2691a744
-  - git: https://git.vergara.tech/Vergara_Tech/haskell-foreign-rust.git
-    commit: 787c2e813eb3a5d16c375d4b37dfefbd2adcdf05
-  - git: https://github.com/reach-sh/haskell-hexstring.git
-    commit: 085c16fb21b9f856a435a3faab980e7e0b319341
-  - git: https://github.com/well-typed/borsh.git
-    commit: d2fcfa159e0a844b1ec5e8ed3e232d4b380fa831
-  - vector-0.13.0.0@sha256:fa5cac81a17a5af388716792e8b99c24b3b66770086756d0d8b23f8272a0244c,9112
-  - generically-0.1.1
-  - vector-algorithms-0.9.0.1
- #- vector-0.12.3.1@sha256:abbfe8830e13549596e1295219d340eb01bd00e1c7124d0dd16586911a291c59,8218
-#extra-lib-dirs: [/home/rav/Documents/programs/haskoin]
-#
-# Override default flag values for local packages and extra-deps
-# flags: {}
-
-# Extra package databases containing global packages
-# extra-package-dbs: []
-
-# Control whether we use the GHC we find on the path
-# system-ghc: true
-#
-# Require a specific version of stack, using version ranges
-# require-stack-version: -any # Default
-# require-stack-version: ">=2.7"
-#
-# Override the architecture used by stack, especially useful on Windows
-# arch: i386
-# arch: x86_64
-#
-# Extra directories used by stack for building
-# extra-include-dirs: [/path/to/dir]
-#
-# Allow a newer minor version of GHC than the snapshot specifies
-# compiler-check: newer-minor

stack.yaml.lock

@@ -1,77 +0,0 @@
-# This file was autogenerated by Stack.
-# You should not edit this file by hand.
-# For more information, please see the documentation at:
-#   https://docs.haskellstack.org/en/stable/lock_files
-
-packages:
-- completed:
-    commit: fef3d3af35a09db718cddb8fc9166b2d2691a744
-    git: https://git.vergara.tech/Vergara_Tech/zcash-haskell.git
-    name: zcash-haskell
-    pantry-tree:
-      sha256: ec7782cf2646da17548d59af0ea98dcbaac1b6c2176258c696a7f508db6dbc21
-      size: 1126
-    version: 0.1.0
-  original:
-    commit: fef3d3af35a09db718cddb8fc9166b2d2691a744
-    git: https://git.vergara.tech/Vergara_Tech/zcash-haskell.git
-- completed:
-    commit: 787c2e813eb3a5d16c375d4b37dfefbd2adcdf05
-    git: https://git.vergara.tech/Vergara_Tech/haskell-foreign-rust.git
-    name: foreign-rust
-    pantry-tree:
-      sha256: be2f6fc0fab58a90fec657bdb6bd0ccf0810c7dccfe95c78b85e174fae227e42
-      size: 2315
-    version: 0.1.0
-  original:
-    commit: 787c2e813eb3a5d16c375d4b37dfefbd2adcdf05
-    git: https://git.vergara.tech/Vergara_Tech/haskell-foreign-rust.git
-- completed:
-    commit: 085c16fb21b9f856a435a3faab980e7e0b319341
-    git: https://github.com/reach-sh/haskell-hexstring.git
-    name: hexstring
-    pantry-tree:
-      sha256: 9ecf67856f59dfb382b283eceb42e4fc1865935d1a7e59111556ed381c6a2ffd
-      size: 687
-    version: 0.11.1
-  original:
-    commit: 085c16fb21b9f856a435a3faab980e7e0b319341
-    git: https://github.com/reach-sh/haskell-hexstring.git
-- completed:
-    commit: d2fcfa159e0a844b1ec5e8ed3e232d4b380fa831
-    git: https://github.com/well-typed/borsh.git
-    name: borsh
-    pantry-tree:
-      sha256: 8335925f495a5a653fcb74b6b8bb18cd0b6b7fe7099a1686108704e6ab82f47b
-      size: 2268
-    version: 0.3.0
-  original:
-    commit: d2fcfa159e0a844b1ec5e8ed3e232d4b380fa831
-    git: https://github.com/well-typed/borsh.git
-- completed:
-    hackage: vector-0.13.0.0@sha256:fa5cac81a17a5af388716792e8b99c24b3b66770086756d0d8b23f8272a0244c,9112
-    pantry-tree:
-      sha256: d2461d28022c8c0a91da08b579b1bff478f617102d2f5ef596cc5b28d14b8b6a
-      size: 4092
-  original:
-    hackage: vector-0.13.0.0@sha256:fa5cac81a17a5af388716792e8b99c24b3b66770086756d0d8b23f8272a0244c,9112
-- completed:
-    hackage: generically-0.1.1@sha256:aa00d9a77b7fb90c08f935699758ed9de55975021b1e979c6a4a4b5b49a940a9,1133
-    pantry-tree:
-      sha256: ec19e6d2aecfbe7a59e789526b9d7ab5c8ba853f017248d0203ee69a9769adb7
-      size: 233
-  original:
-    hackage: generically-0.1.1
-- completed:
-    hackage: vector-algorithms-0.9.0.1@sha256:f3e5c6695529a94edf762117cafd91c989cb642ad3f8ca4014dbb13c8f6c2a20,3826
-    pantry-tree:
-      sha256: aef389e57ae6020e5da719bee40aaf6cccf1c4d1e7743a85d30c9d8c25d170a0
-      size: 1510
-  original:
-    hackage: vector-algorithms-0.9.0.1
-snapshots:
-- completed:
-    sha256: 2e7d4a730d8eb5373b2d383fac84efcf7c81e3b7a5fce71b4c2e19a1768f25a6
-    size: 640239
-    url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/21/6.yaml
-  original: lts-21.6

test/Spec.hs

@@ -1,2 +1,253 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+import Control.Monad (when)
+import Control.Monad.Logger (runNoLoggingT)
+import Data.HexString
+import qualified Data.Text.Encoding as E
+import Database.Persist
+import Database.Persist.Sqlite
+import System.Directory
+import Test.HUnit
+import Test.Hspec
+import ZcashHaskell.Orchard (isValidUnifiedAddress)
+import ZcashHaskell.Sapling
+  ( decodeSaplingOutputEsk
+  , encodeSaplingAddress
+  , getSaplingNotePosition
+  , getSaplingWitness
+  , isValidShieldedAddress
+  , updateSaplingCommitmentTree
+  )
+import ZcashHaskell.Transparent
+  ( decodeExchangeAddress
+  , decodeTransparentAddress
+  )
+import ZcashHaskell.Types
+  ( DecodedNote(..)
+  , OrchardSpendingKey(..)
+  , Phrase(..)
+  , SaplingCommitmentTree(..)
+  , SaplingReceiver(..)
+  , SaplingSpendingKey(..)
+  , Scope(..)
+  , ShieldedOutput(..)
+  , ZcashNet(..)
+  )
+import Zenith.Core
+import Zenith.DB
+import Zenith.Types
+
 main :: IO ()
-main = putStrLn "Test suite not yet implemented"
+main = do
+  checkDbFile <- doesFileExist "test.db"
+  when checkDbFile $ removeFile "test.db"
+  hspec $ do
+    describe "Database tests" $ do
+      it "Create table" $ do
+        s <- runSqlite "test.db" $ do runMigration migrateAll
+        s `shouldBe` ()
+      describe "Wallet Table" $ do
+        it "insert wallet record" $ do
+          s <-
+            runSqlite "test.db" $ do
+              insert $
+                ZcashWallet
+                  "Main Wallet"
+                  (ZcashNetDB MainNet)
+                  (PhraseDB $
+                   Phrase
+                     "one two three four five six seven eight nine ten eleven twelve")
+                  2000000
+                  0
+          fromSqlKey s `shouldBe` 1
+        it "read wallet record" $ do
+          s <-
+            runSqlite "test.db" $ do
+              selectList [ZcashWalletBirthdayHeight >. 0] []
+          length s `shouldBe` 1
+        it "modify wallet record" $ do
+          s <-
+            runSqlite "test.db" $ do
+              let recId = toSqlKey 1 :: ZcashWalletId
+              update recId [ZcashWalletName =. "New Wallet"]
+              get recId
+          "New Wallet" `shouldBe` maybe "None" zcashWalletName s
+        it "delete wallet record" $ do
+          s <-
+            runSqlite "test.db" $ do
+              let recId = toSqlKey 1 :: ZcashWalletId
+              delete recId
+              get recId
+          "None" `shouldBe` maybe "None" zcashWalletName s
+      describe "Wallet function tests:" $ do
+        it "Save Wallet:" $ do
+          pool <- runNoLoggingT $ initPool "test.db"
+          zw <-
+            saveWallet pool $
+            ZcashWallet
+              "Testing"
+              (ZcashNetDB MainNet)
+              (PhraseDB $
+               Phrase
+                 "cloth swing left trap random tornado have great onion element until make shy dad success art tuition canvas thunder apple decade elegant struggle invest")
+              2200000
+              0
+          zw `shouldNotBe` Nothing
+        it "Save Account:" $ do
+          pool <- runNoLoggingT $ initPool "test.db"
+          s <-
+            runSqlite "test.db" $ do
+              selectList [ZcashWalletName ==. "Testing"] []
+          za <- saveAccount pool =<< createZcashAccount "TestAccount" 0 (head s)
+          za `shouldNotBe` Nothing
+        it "Save address:" $ do
+          pool <- runNoLoggingT $ initPool "test.db"
+          acList <-
+            runSqlite "test.db" $
+            selectList [ZcashAccountName ==. "TestAccount"] []
+          zAdd <-
+            saveAddress pool =<<
+            createWalletAddress "Personal123" 0 MainNet External (head acList)
+          addList <-
+            runSqlite "test.db" $
+            selectList
+              [ WalletAddressName ==. "Personal123"
+              , WalletAddressScope ==. ScopeDB External
+              ]
+              []
+          getUA (walletAddressUAddress (entityVal $ head addList)) `shouldBe`
+            "u1trd8cvc6265ywwj4mmvuznsye5ghe2dhhn3zy8kcuyg4vx3svskw9r2dedp5hu6m740vylkqc34t4w9eqkl9fyu5uyzn3af72jg235440ke6tu5cf994eq85n97x69x9824hqejmwz3d8qqthtesrd6gerjupdymldhl9xccejjwfj0dhh9mt4rw4kytp325twlutsxd20rfqhzxu3m"
+        it "Address components are correct" $ do
+          let ua =
+                "utest1mvlny48qd4x94w8vz5u2lrxx0enuquajt72yekgq24p6pjaky3czk6m7x358h7g900ex6gzvdehaekl96qnakjzw8yaasp8y0u3j5jnlfd33trduznh6k3fcn5ek9qc857fgz8ehm37etx94sj58nrkc0k5hurxnuxpcpms3j8uy2t8kt2vy6vetvsfxxdhtjq0yqulqprvh7mf2u3x"
+          isValidUnifiedAddress ua `shouldNotBe` Nothing
+      describe "Function tests" $ do
+        describe "Sapling Decoding" $ do
+          let sk =
+                SaplingSpendingKey
+                  "\ETX}\195.\SUB\NUL\NUL\NUL\128\NUL\203\"\229IL\CANJ*\209\EM\145\228m\172\&4\SYNNl\DC3\161\147\SO\157\238H\192\147eQ\143L\201\216\163\180\147\145\156Zs+\146>8\176`ta\161\223\SO\140\177\b;\161\SO\236\151W\148<\STX\171|\DC2\172U\195(I\140\146\214\182\137\211\228\159\128~bV\STXy{m'\224\175\221\219\180!\ENQ_\161\132\240?\255\236\"6\133\181\170t\181\139\143\207\170\211\ENQ\167a\184\163\243\246\140\158t\155\133\138X\a\241\200\140\EMT\GS~\175\249&z\250\214\231\239mi\223\206\STX\t\EM<{V~J\253FB"
+          let tree =
+                SaplingCommitmentTree $
+                hexString
+                  "01818f2bd58b1e392334d0565181cc7843ae09e3533b2a50a8f1131af657340a5c001001161f962245812ba5e1804fd0a336bc78fa4ee4441a8e0f1525ca5da1b285d35101120f45afa700b8c1854aa8b9c8fe8ed92118ef790584bfcb926078812a10c83a00000000012f4f72c03f8c937a94919a01a07f21165cc8394295291cb888ca91ed003810390107114fe4bb4cd08b47f6ae47477c182d5da9fe5c189061808c1091e9bf3b4524000001447d6b9100cddd5f80c8cf4ddee2b87eba053bd987465aec2293bd0514e68b0d015f6c95e75f4601a0a31670a7deb970fc8988c611685161d2e1629d0a1a0ebd07015f8b9205e0514fa235d75c150b87e23866b882b39786852d1ab42aab11d31a4a0117ddeb3a5f8d2f6b2d0a07f28f01ab25e03a05a9319275bb86d72fcaef6fc01501f08f39275112dd8905b854170b7f247cf2df18454d4fa94e6e4f9320cca05f24011f8322ef806eb2430dc4a7a41c1b344bea5be946efc7b4349c1c9edb14ff9d39"
+          let nextTree =
+                SaplingCommitmentTree $
+                hexString
+                  "01bd8a3f3cfc964332a2ada8c09a0da9dfc24174befb938abb086b9be5ca049e4900100000019f0d7efb00169bb2202152d3266059d208ab17d14642c3339f9075e997160657000000012f4f72c03f8c937a94919a01a07f21165cc8394295291cb888ca91ed003810390107114fe4bb4cd08b47f6ae47477c182d5da9fe5c189061808c1091e9bf3b4524000001447d6b9100cddd5f80c8cf4ddee2b87eba053bd987465aec2293bd0514e68b0d015f6c95e75f4601a0a31670a7deb970fc8988c611685161d2e1629d0a1a0ebd07015f8b9205e0514fa235d75c150b87e23866b882b39786852d1ab42aab11d31a4a0117ddeb3a5f8d2f6b2d0a07f28f01ab25e03a05a9319275bb86d72fcaef6fc01501f08f39275112dd8905b854170b7f247cf2df18454d4fa94e6e4f9320cca05f24011f8322ef806eb2430dc4a7a41c1b344bea5be946efc7b4349c1c9edb14ff9d39"
+          it "Sapling is decoded correctly" $ do
+            so <-
+              runSqlite "zenith.db" $
+              selectList [ShieldOutputTx ==. toSqlKey 38318] []
+            let cmus = map (getHex . shieldOutputCmu . entityVal) so
+            let pos =
+                  getSaplingNotePosition <$>
+                  (getSaplingWitness =<<
+                   updateSaplingCommitmentTree tree (head cmus))
+            let pos1 = getSaplingNotePosition <$> getSaplingWitness tree
+            let pos2 = getSaplingNotePosition <$> getSaplingWitness nextTree
+            case pos of
+              Nothing -> assertFailure "couldn't get note position"
+              Just p -> do
+                print p
+                print pos1
+                print pos2
+                let dn =
+                      decodeSaplingOutputEsk
+                        sk
+                        (ShieldedOutput
+                           (getHex $ shieldOutputCv $ entityVal $ head so)
+                           (getHex $ shieldOutputCmu $ entityVal $ head so)
+                           (getHex $ shieldOutputEphKey $ entityVal $ head so)
+                           (getHex $ shieldOutputEncCipher $ entityVal $ head so)
+                           (getHex $ shieldOutputOutCipher $ entityVal $ head so)
+                           (getHex $ shieldOutputProof $ entityVal $ head so))
+                        TestNet
+                        External
+                        p
+                case dn of
+                  Nothing -> assertFailure "couldn't decode Sap output"
+                  Just d ->
+                    a_nullifier d `shouldBe`
+                    hexString
+                      "6c5d1413c63a9a88db71c3f41dc12cd60197ee742fc75b217215e7144db48bd3"
+      describe "Note selection for Tx" $ do
+        it "Value less than balance" $ do
+          pool <- runNoLoggingT $ initPool "zenith.db"
+          res <- selectUnspentNotes pool (toSqlKey 1) 14000000
+          res `shouldNotBe` ([], [], [])
+        it "Value greater than balance" $ do
+          pool <- runNoLoggingT $ initPool "zenith.db"
+          let res = selectUnspentNotes pool (toSqlKey 1) 84000000
+          res `shouldThrow` anyIOException
+        it "Fee calculation" $ do
+          pool <- runNoLoggingT $ initPool "zenith.db"
+          res <- selectUnspentNotes pool (toSqlKey 1) 14000000
+          calculateTxFee res 3 `shouldBe` 20000
+      describe "Testing validation" $ do
+        it "Unified" $ do
+          let a =
+                "utest1zfnw84xuxg0ytzqc008gz0qntr8cvwu4qjsccgtxwdrjywra7uj85x8ldymjc2jd3jvvvhyj3xwsunyvwkr5084t6p5gmvzwdgvwpflrpd6a3squ2dp8vt7cxngmwk30l44wkmvyfegypqmezxfnqj572lr779gkqj5xekp66uv4jga58alnc5j7tuank758zd96ap4f09udg6y6pxu"
+          True `shouldBe`
+            (case isValidUnifiedAddress (E.encodeUtf8 a) of
+               Just _a1 -> True
+               Nothing ->
+                 isValidShieldedAddress (E.encodeUtf8 a) ||
+                 (case decodeTransparentAddress (E.encodeUtf8 a) of
+                    Just _a3 -> True
+                    Nothing ->
+                      case decodeExchangeAddress a of
+                        Just _a4 -> True
+                        Nothing -> False))
+        it "Sapling" $ do
+          let a =
+                "ztestsapling1tgjr4zppwk4ne8xy6gdq4z2gwq7dmf5jq8z2ctpn8nlmtse0a74fa5z0m8z383gmpgqz6q6duu4"
+          True `shouldBe`
+            (case isValidUnifiedAddress (E.encodeUtf8 a) of
+               Just _a1 -> True
+               Nothing ->
+                 isValidShieldedAddress (E.encodeUtf8 a) ||
+                 (case decodeTransparentAddress (E.encodeUtf8 a) of
+                    Just _a3 -> True
+                    Nothing ->
+                      case decodeExchangeAddress a of
+                        Just _a4 -> True
+                        Nothing -> False))
+        it "Transparent" $ do
+          let a = "tmGfVZHuGVJ5vcLAgBdkUU4w7fLTRE5nXm3"
+          True `shouldBe`
+            (case isValidUnifiedAddress (E.encodeUtf8 a) of
+               Just _a1 -> True
+               Nothing ->
+                 isValidShieldedAddress (E.encodeUtf8 a) ||
+                 (case decodeTransparentAddress (E.encodeUtf8 a) of
+                    Just _a3 -> True
+                    Nothing ->
+                      case decodeExchangeAddress a of
+                        Just _a4 -> True
+                        Nothing -> False))
+        it "Check Sapling Address" $ do
+          let a =
+                encodeSaplingAddress TestNet $
+                SaplingReceiver
+                  "Z$:\136!u\171<\156\196\210\SUB\n\137Hp<\221\166\146\SOH\196\172,3<\255\181\195/\239\170\158\208O\217\197\DC3\197\ESC\n\NUL-"
+          a `shouldBe`
+            Just
+              "ztestsapling1tgjr4zppwk4ne8xy6gdq4z2gwq7dmf5jq8z2ctpn8nlmtse0a74fa5z0m8z383gmpgqz6q6duu4"
+      {-describe "Creating Tx" $ do-}
+        {-xit "To Orchard" $ do-}
+          {-let uaRead =-}
+                {-isValidUnifiedAddress-}
+                  {-"utest1dl54utt6prjj5e0dnlknwumnxq9hycdjpkfr0sy6e6h522remqee8axe9zax0wsjrwpj76v555pdhvj9rnargpfyycs0vpkapq98xcdhem99gc4wchzn0ggepq3y6nz3a9sscwgqxgsh9vzhcad402y3x9szfregck5gslkya3c79d86xx0l33tpk8gnn7ew9vw37w43zh22u8dgdax"-}
+          {-case uaRead of-}
+            {-Nothing -> assertFailure "wrong address"-}
+            {-Just ua -> do-}
+              {-tx <--}
+                {-prepareTx-}
+                  {-"zenith.db"-}
+                  {-TestNet-}
+                  {-(toSqlKey 1)-}
+                  {-2819811-}
+                  {-0.04-}
+                  {-ua-}
+                  {-"sent with Zenith, test"-}
+              {-tx `shouldBe` Right (hexString "deadbeef")-}

zcash-haskell

@@ -0,0 +1 @@
+Subproject commit 9dddb42bb3ab78ed0c4d44efb00960ac112c2ce6

zenith.cabal

@@ -1,65 +1,93 @@
-cabal-version: 1.12
+cabal-version:    3.0
+name:             zenith
+version:          0.5.0.0
+license:          MIT
+license-file:     LICENSE
+author:           Rene Vergara
+maintainer:       pitmutt@vergara.tech
+copyright:        (c) 2022-2024 Vergara Technologies LLC
+build-type:       Custom
+category:         Blockchain
+extra-doc-files:
+  README.md
+  CHANGELOG.md
+  zenith.cfg
 
--- This file has been generated from package.yaml by hpack version 0.35.1.
---
--- see: https://github.com/sol/hpack
 
-name:           zenith
+custom-setup
-version:        0.4.0
+  setup-depends:
-synopsis:       Haskell CLI for Zcash Full Node
+      base >= 4.12 && < 5
-description:    Please see the README on repo at <https://git.vergara.tech/Vergara_Tech/zenith#readme>
+    , Cabal >= 3.2.0.0
-author:         Rene Vergara
+    , directory >= 1.3.6.0
-maintainer:     rene@vergara.network
+    , filepath >= 1.3.0.2
-copyright:      Copyright (c) 2022 Vergara Technologies LLC
+    , regex-base
-license:        BOSL
+    , regex-compat
-license-file:   LICENSE
-build-type:     Simple
-extra-source-files:
-    README.md
-    CHANGELOG.md
-    zenith.cfg
-
-source-repository head
-  type: git
-  location: https://git.vergara.tech/Vergara_Tech/zenith
 
 library
+  ghc-options: -Wall -Wunused-imports
   exposed-modules:
-      Zenith
+    Zenith.CLI
-  other-modules:
+    Zenith.Core
-      Paths_zenith
+    Zenith.DB
+    Zenith.Types
+    Zenith.Utils
+    Zenith.Zcashd
+    Zenith.Scanner
   hs-source-dirs:
-      src
+    src
   build-depends:
       Clipboard
     , aeson
     , array
-    , base >=4.7 && <5
+    , ascii-progress
+    , base >=4.12 && <5
     , base64-bytestring
-    , blake2
+    , brick
     , bytestring
+    , esqueleto
+    , resource-pool
+    , binary
+    , exceptions
+    , monad-logger
+    , vty-crossplatform
+    , secp256k1-haskell
+    , pureMD5
+    , ghc
+    , haskoin-core
     , hexstring
+    , http-client
     , http-conduit
     , http-types
+    , microlens
+    , microlens-mtl
+    , microlens-th
+    , mtl
+    , persistent
+    , Hclip
+    , persistent-sqlite
+    , persistent-template
     , process
     , regex-base
     , regex-compat
     , regex-posix
     , scientific
     , text
+    , time
     , vector
+    , vty
+    , word-wrap
     , zcash-haskell
+  --pkgconfig-depends: rustzcash_wrapper
   default-language: Haskell2010
 
 executable zenith
+  ghc-options: -threaded -rtsopts -with-rtsopts=-N
   main-is: Main.hs
-  other-modules:
-      Paths_zenith
   hs-source-dirs:
-      app
+    app
-  ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall -Wunused-imports
   build-depends:
-      base >=4.7 && <5
+      base >=4.12 && <5
+    , brick
     , bytestring
     , configurator
     , data-default
@@ -68,17 +96,45 @@ executable zenith
     , text
     , time
     , zenith
+    , zcash-haskell
+  pkgconfig-depends: rustzcash_wrapper
   default-language: Haskell2010
 
-test-suite zenith-test
+executable zenscan
-  type: exitcode-stdio-1.0
+  ghc-options: -main-is ZenScan -threaded -rtsopts -with-rtsopts=-N
-  main-is: Spec.hs
+  main-is: ZenScan.hs
-  other-modules:
-      Paths_zenith
   hs-source-dirs:
-      test
+    app
-  ghc-options: -threaded -rtsopts -with-rtsopts=-N
   build-depends:
-      base >=4.7 && <5
+      base >=4.12 && <5
+    , configurator
+    , monad-logger
     , zenith
+  pkgconfig-depends: rustzcash_wrapper
+  default-language: Haskell2010
+
+test-suite zenith-tests
+  type: exitcode-stdio-1.0
+  ghc-options: -threaded -rtsopts -with-rtsopts=-N
+  main-is: Spec.hs
+  hs-source-dirs:
+    test
+  build-depends:
+      base >=4.12 && <5
+    , bytestring
+    , configurator
+    , monad-logger
+    , data-default
+    , sort
+    , text
+    , time
+    , persistent
+    , persistent-sqlite
+    , hspec
+    , hexstring
+    , HUnit
+    , directory
+    , zcash-haskell
+    , zenith
+  pkgconfig-depends: rustzcash_wrapper
   default-language: Haskell2010

zenith.cfg

@@ -1,2 +1,5 @@
 nodeUser = "user"
 nodePwd = "superSecret"
+dbFilePath = "zenith.db"
+zebraHost = "127.0.0.1"
+zebraPort = 18232