Compare commits

..

No commits in common. "master" and "legacy" have entirely different histories.

55 changed files with 1130 additions and 16477 deletions

5
.gitignore vendored
View file

@ -1,7 +1,2 @@
.stack-work/
*~
dist-newstyle/
zenith.db
zenith.log
zenith.db-shm
zenith.db-wal

6
.gitmodules vendored
View file

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

View file

@ -5,164 +5,6 @@ All notable changes to this project will be documented in this file.
The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.0.0/),
and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0.html).
## [0.7.0.0-beta]
### Added
- RPC module
- OpenRPC specification
- `listwallets` RPC method
- `listaccounts` RPC method
- `listaddresses` RPC method
- `listreceived` RPC method
- `getbalance` RPC method
- `getnewwallet` RPC method
- `getnewaccount` RPC method
- `getnewaddress` RPC method
- `getoperationstatus` RPC method
- `sendmany` RPC method
- Function `prepareTxV2` implementing `PrivacyPolicy`
- Support for TEX addresses
- Functionality to shield transparent balance
- Functionality to de-shield shielded notes
- Native commitment trees
- Batch append to trees in O(log n)
### Changed
- Detection of changes in database schema for automatic re-scan
- Block tracking for chain re-org detection
- Refactored `ZcashPool`
- Preventing write operations to occur during wallet sync
## [0.6.0.0-beta]
### Added
- GUI module
- Address list
- Transaction list
- Balance display
- Account selector
- Menu for new addresses, accounts, wallets
- Dialog to display and copy seed phrase
- Dialog to add new address
- Dialog to add new account
- Dialog to add new wallet
- Dialog to display transaction details and copy TX ID
- Dialog to send a new transaction
- Dialog to display Tx ID after successful broadcast
- Unconfirmed balance display on TUI and GUI
- Tracking of unconfirmed notes
### Changed
- Upgraded to GHC 9.6.5
- Implemented config and data folder
- Improved the `configure` script for installation
### Fixed
- Validation of input of amount for sending in TUI
### Removed
- Legacy interface to `zcashd`
## [0.5.3.1-beta]
### Added
- Docker image
## [0.5.3.0-beta]
### Added
- Address Book functionality. Allows users to store frequently used zcash addresses and
generate transactions using them.
### Changed
- Improved formatting of sync progress
### Fixed
- Wallet sync when no new block has been detected on-chain.
## [0.5.2.0-beta]
### Changed
- Update to `zcash-haskell-0.6.2.0` to increase performance of transaction creation
### Fixed
- Truncation of transaction ID when displaying a successfully sent transaction
- Missing command in menu for Send
## [0.5.1.1-beta.1]
### Changed
- Installation instructions in README
## [0.5.1.1-beta]
### Added
- Implement CLI changes to send transactions
## [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

190
LICENSE
View file

@ -1,22 +1,178 @@
MIT License
Copyright (c) 2022 Vergara Technologies
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:
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:
*Licensed under the Bootstrap Open Source Licence version 1.0*
The above copyright notice and this permission notice shall be included in all
copies or substantial portions of the Software.
1. **Grant of Copyright License.** Licensor grants You a worldwide,
royalty-free, non-exclusive, sublicensable license, for the duration of the
copyright in the Original Work, to do the following:
THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
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.
a. to reproduce the Original Work in copies, either alone or as part of
a collective work;
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.

View file

@ -10,29 +10,23 @@
Zcash Full Node CLI
```
[![Please don't upload to GitHub](https://nogithub.codeberg.page/badge.svg)](https://nogithub.codeberg.page) ![](https://img.shields.io/badge/License-MIT-green
)
[![Please don't upload to GitHub](https://nogithub.codeberg.page/badge.svg)](https://nogithub.codeberg.page)
Zenith is a wallet for the [Zebra](https://zfnd.org/zebra/) Zcash node . It has the following features:
Zenith is a command-line interface for the Zcash Full Node (`zcashd`). It has the following features:
- Creating new wallets.
- Creating new accounts.
- Creating new Unified Addresses.
- Listing transparent and shielded addresses and balances known to the node, including viewing-only.
- Listing transactions for specific addresses, decoding memos for easy reading.
- Copying addresses to the clipboard.
- Creating new Unified Addresses.
- Sending transactions with shielded memo support.
- Address Book for storing frequently used zcash addresses
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:
- [Cabal](https://www.haskell.org/cabal/#install-upgrade)
- [Zebra](https://zfnd.org/zebra/)
- [Cargo](https://doc.rust-lang.org/cargo/getting-started/installation.html)
- Install `cargo-c`:
```shell
cargo install cargo-c
```
- [Stack](https://docs.haskellstack.org/en/stable/README/#how-to-install)
- [Zcash Full Node v.5.0.0](https://zcash.readthedocs.io/en/latest/rtd_pages/zcashd.html#install)
- `xclip`
- `libsecp256k1-dev`
- `libxss-dev`
@ -43,27 +37,41 @@ Zenith is a wallet for the [Zebra](https://zfnd.org/zebra/) Zcash node . It has
git clone https://git.vergara.tech/Vergara_Tech/zenith.git
cd zenith
git submodule init
git submodule update --remote
git submodule update
```
- Install using `cabal`:
- Install using `stack`:
```
cabal install
stack install
```
## Configuration
- Copy the sample `zenith.cfg` file to your home directory and update the values of your Zebra host and port.
- Copy the sample `zenith.cfg` file to a location of your choice and update the values of the user and password for the `zcashd` node. These values can be found in the `zcash.conf` file for the Zcash node.
## Usage
**Note:** This is beta software under active development. We recommend to use it on testnet. Zenith runs on the network Zebra is running, to use the testnet you need to configure your Zebra node to run on testnet.
From the location where the configured `zenith.cfg` file is placed, use `zenith` to start.
From the location where the configured `zenith.cfg` file is placed, use `zenith cli` to start.
Zenith will attempt to connect to the node and check compatibility. Connections to `zcashd` versions less than 5.0.0 will fail.
Zenith will attempt to connect to the node and start up, the app will guide you through the creation of the first wallet.
### Available commands
- `?`: Lists available commands.
- `list`: Lists all transparent and shielded addresses and their balance.
- Notes about balances:
- Addresses from an imported viewing key will list a balance but it may be inaccurate, as viewing keys cannot see ZEC spent out of that address.
- Balances for Unified Addresses *belonging to the same account* are shared. Zenith will list the full account balances for each of the UAs in the account.
- `txs <id>`: Lists all transactions belonging to the address corresponding to the `id` given, in chronological order.
- `copy`: Copies the selected address to the clipboard.
- `new`: Prompts the user for the option to include a transparent receiver, a Sapling receiver or both. An Orchard receiver is always included.
- `send`: Prompts the user to prepare an outgoing transaction, selecting the source address, validating the destination address, the amount and the memo.
- If the source is a transparent address, the privacy policy is set to `AllowRevealedSenders`, favoring the shielding of funds when sent to a UA.
- If the source is a shielded address, the privacy policy is set to `AllowRevealedAmounts`, favoring the move of funds from legacy shielded pools to Orchard.
- `uri`: Prompts the user to select the source account and to enter a [ZIP-321](https://zips.z.cash/zip-0321) compliant URI to generate and send a transaction.
- `exit`: Ends the session.
### Support
If you would have any questions or suggestions, please join us on our [Support channel](https://matrix.to/#/#support:vergara.tech)
If you would like to support the development of Zenith, please visit our [Free2Z](https://free2z.com/zenith-full-node-cli) page.

131
Setup.hs
View file

@ -1,131 +0,0 @@
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

View file

@ -11,20 +11,12 @@ import Data.Sort
import qualified Data.Text as T
import qualified Data.Text.IO as TIO
import Data.Time.Clock.POSIX
{-import System.Console.StructuredCLI-}
import System.Environment (getArgs)
import System.Console.StructuredCLI
import System.Exit
import System.IO
import Text.Read (readMaybe)
import ZcashHaskell.Types
import Zenith.CLI
import Zenith.GUI (runZenithGUI)
import Zenith.Scanner (clearSync, rescanZebra)
import Zenith.Types (Config(..), ZcashAddress(..), ZcashPool(..), ZcashTx(..))
import Zenith.Utils
import Zenith.Zcashd
{-
import Zenith
prompt :: String -> IO String
prompt text = do
putStr text
@ -198,25 +190,12 @@ processUri user pwd =
_ -> False
_ <- liftIO $ sendWithUri user pwd (addList !! (idx - 1)) u repTo
return NoAction
-}
main :: IO ()
main = do
config <- load ["$(HOME)/Zenith/zenith.cfg"]
args <- getArgs
dbFileName <- require config "dbFileName"
config <- load ["zenith.cfg"]
nodeUser <- require config "nodeUser"
nodePwd <- require config "nodePwd"
zebraPort <- require config "zebraPort"
zebraHost <- require config "zebraHost"
nodePort <- require config "nodePort"
dbFP <- getZenithPath
let dbFilePath = T.pack $ dbFP ++ dbFileName
let myConfig = Config dbFilePath zebraHost zebraPort nodeUser nodePwd nodePort
if not (null args)
then do
case head args
{-"legacy" -> do
checkServer nodeUser nodePwd
void $
runCLI
@ -225,20 +204,4 @@ main = do
{ getBanner =
" ______ _ _ _ \n |___ / (_) | | | \n / / ___ _ __ _| |_| |__ \n / / / _ \\ '_ \\| | __| '_ \\ \n / /_| __/ | | | | |_| | | |\n /_____\\___|_| |_|_|\\__|_| |_|\n Zcash Full Node CLI v0.4.0"
}
(root nodeUser nodePwd) -}
of
"gui" -> runZenithGUI myConfig
"tui" -> runZenithTUI myConfig
"rescan" -> rescanZebra zebraHost zebraPort dbFilePath
"resync" -> clearSync myConfig
_ -> printUsage
else printUsage
printUsage :: IO ()
printUsage = do
putStrLn "zenith [command] [parameters]\n"
putStrLn "Available commands:"
{-putStrLn "legacy\tLegacy CLI for zcashd"-}
putStrLn "tui\tTUI for zebrad"
putStrLn "gui\tGUI for zebrad"
putStrLn "rescan\tRescan the existing wallet(s)"
(root nodeUser nodePwd)

View file

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

View file

@ -1,15 +0,0 @@
{-# LANGUAGE OverloadedStrings #-}
module ZenScan where
import Control.Monad.Logger (runNoLoggingT)
import Data.Configurator
import Zenith.Scanner (rescanZebra)
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

Binary file not shown.

Before

Width:  |  Height:  |  Size: 11 KiB

Binary file not shown.

Before

Width:  |  Height:  |  Size: 10 KiB

Binary file not shown.

Before

Width:  |  Height:  |  Size: 2.3 KiB

Binary file not shown.

Before

Width:  |  Height:  |  Size: 17 KiB

Binary file not shown.

Binary file not shown.

Binary file not shown.

Binary file not shown.

Binary file not shown.

View file

@ -1,15 +0,0 @@
packages:
./*.cabal
zcash-haskell/zcash-haskell.cabal
with-compiler: ghc-9.6.5
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

View file

@ -1,373 +0,0 @@
active-repositories: hackage.haskell.org:merge
constraints: any.Cabal ==3.10.3.0,
any.Cabal-syntax ==3.10.3.0,
any.Clipboard ==2.3.2.0,
any.HUnit ==1.6.2.0,
any.Hclip ==3.0.0.4,
any.JuicyPixels ==3.3.9,
JuicyPixels -mmap,
any.OneTuple ==0.4.2,
any.OpenGLRaw ==3.3.4.1,
OpenGLRaw -osandroid +usegles2 +useglxgetprocaddress +usenativewindowslibraries,
any.QuickCheck ==2.14.3,
QuickCheck -old-random +templatehaskell,
any.RSA ==2.4.1,
any.SHA ==1.6.4.4,
SHA -exe,
any.StateVar ==1.2.2,
any.X11 ==1.10.3,
X11 -pedantic,
any.adjunctions ==4.4.2,
any.aeson ==2.2.3.0,
aeson +ordered-keymap,
any.alex ==3.5.1.0,
any.ansi-terminal ==1.1.1,
ansi-terminal -example,
any.ansi-terminal-types ==1.1,
any.appar ==0.1.8,
any.array ==0.5.6.0,
any.ascii-progress ==0.3.3.0,
ascii-progress -examples,
any.asn1-encoding ==0.9.6,
any.asn1-parse ==0.9.5,
any.asn1-types ==0.3.4,
any.assoc ==1.1.1,
assoc -tagged,
any.async ==2.2.5,
async -bench,
any.attoparsec ==0.14.4,
attoparsec -developer,
any.attoparsec-aeson ==2.2.2.0,
any.authenticate-oauth ==1.7,
any.auto-update ==0.2.1,
any.base ==4.18.2.1,
any.base-compat ==0.13.1,
any.base-compat-batteries ==0.13.1,
any.base-orphans ==0.9.2,
any.base16 ==1.0,
any.base16-bytestring ==1.0.2.0,
any.base58-bytestring ==0.1.0,
any.base64-bytestring ==1.2.1.0,
any.basement ==0.0.16,
any.bifunctors ==5.6.2,
bifunctors +tagged,
any.bimap ==0.5.0,
any.binary ==0.8.9.1,
any.binary-orphans ==1.0.5,
any.bitvec ==1.1.5.0,
bitvec +simd,
any.blaze-builder ==0.4.2.3,
any.blaze-html ==0.9.2.0,
any.blaze-markup ==0.8.3.0,
any.boring ==0.2.2,
boring +tagged,
any.borsh ==0.3.0,
any.brick ==2.4,
brick -demos,
any.bsb-http-chunked ==0.0.0.4,
any.byteorder ==1.0.4,
any.bytes ==0.17.3,
any.bytestring ==0.11.5.3,
any.bytestring-builder ==0.10.8.2.0,
bytestring-builder +bytestring_has_builder,
any.bytestring-to-vector ==0.3.0.1,
any.c2hs ==0.28.8,
c2hs +base3 -regression,
any.cabal-doctest ==1.0.10,
any.call-stack ==0.4.0,
any.case-insensitive ==1.2.1.0,
any.cborg ==0.2.10.0,
cborg +optimize-gmp,
any.cereal ==0.5.8.3,
cereal -bytestring-builder,
any.character-ps ==0.1,
any.clock ==0.8.4,
clock -llvm,
any.colour ==2.3.6,
any.comonad ==5.0.8,
comonad +containers +distributive +indexed-traversable,
any.concurrent-output ==1.10.21,
any.conduit ==1.3.5,
any.conduit-extra ==1.3.6,
any.config-ini ==0.2.7.0,
config-ini -enable-doctests,
any.configurator ==0.3.0.0,
configurator -developer,
any.constraints ==0.14.2,
any.containers ==0.6.7,
any.contravariant ==1.5.5,
contravariant +semigroups +statevar +tagged,
any.cookie ==0.5.0,
any.crypto-api ==0.13.3,
crypto-api -all_cpolys,
any.crypto-pubkey-types ==0.4.3,
any.crypton ==1.0.0,
crypton -check_alignment +integer-gmp -old_toolchain_inliner +support_aesni +support_deepseq +support_pclmuldq +support_rdrand -support_sse +use_target_attributes,
any.crypton-connection ==0.4.1,
any.crypton-x509 ==1.7.7,
any.crypton-x509-store ==1.6.9,
any.crypton-x509-system ==1.6.7,
any.crypton-x509-validation ==1.6.12,
any.cryptonite ==0.30,
cryptonite -check_alignment +integer-gmp -old_toolchain_inliner +support_aesni +support_deepseq -support_pclmuldq +support_rdrand -support_sse +use_target_attributes,
any.data-clist ==0.2,
any.data-default ==0.7.1.1,
any.data-default-class ==0.1.2.0,
any.data-default-instances-containers ==0.0.1,
any.data-default-instances-dlist ==0.0.1,
any.data-default-instances-old-locale ==0.0.1,
any.data-fix ==0.3.4,
any.dec ==0.0.6,
any.deepseq ==1.4.8.1,
any.directory ==1.3.8.4,
any.distributive ==0.6.2.1,
distributive +semigroups +tagged,
any.dlist ==1.0,
dlist -werror,
any.double-conversion ==2.0.5.0,
double-conversion -developer +embedded_double_conversion,
any.easy-file ==0.2.5,
any.entropy ==0.4.1.10,
entropy -donotgetentropy,
any.envy ==2.1.3.0,
any.esqueleto ==3.5.11.2,
any.exceptions ==0.10.7,
any.extra ==1.7.16,
any.fast-logger ==3.2.3,
any.file-embed ==0.0.16.0,
any.filepath ==1.4.300.1,
any.fixed ==0.3,
any.foreign-rust ==0.1.0,
any.foreign-store ==0.2.1,
any.formatting ==7.2.0,
formatting -no-double-conversion,
any.free ==5.2,
any.generic-deriving ==1.14.5,
generic-deriving +base-4-9,
any.generically ==0.1.1,
any.generics-sop ==0.5.1.4,
any.ghc ==9.6.5,
any.ghc-bignum ==1.3,
any.ghc-boot ==9.6.5,
any.ghc-boot-th ==9.6.5,
any.ghc-heap ==9.6.5,
any.ghc-prim ==0.10.0,
any.ghci ==9.6.5,
any.half ==0.3.1,
any.happy ==1.20.1.1,
any.hashable ==1.4.7.0,
hashable -arch-native +integer-gmp -random-initial-seed,
any.haskell-lexer ==1.1.1,
any.haskoin-core ==1.1.0,
any.hexstring ==0.12.1.0,
any.hourglass ==0.2.12,
any.hpc ==0.6.2.0,
any.hsc2hs ==0.68.10,
hsc2hs -in-ghc-tree,
any.hspec ==2.11.9,
any.hspec-core ==2.11.9,
any.hspec-discover ==2.11.9,
any.hspec-expectations ==0.8.4,
any.http-api-data ==0.6.1,
http-api-data -use-text-show,
any.http-client ==0.7.17,
http-client +network-uri,
any.http-client-tls ==0.3.6.3,
any.http-conduit ==2.3.8.3,
http-conduit +aeson,
any.http-date ==0.0.11,
any.http-media ==0.8.1.1,
any.http-semantics ==0.1.2,
any.http-types ==0.12.4,
any.http2 ==5.2.6,
http2 -devel -h2spec,
any.indexed-traversable ==0.1.4,
any.indexed-traversable-instances ==0.1.2,
any.integer-conversion ==0.1.1,
any.integer-gmp ==1.1,
any.integer-logarithms ==1.0.3.1,
integer-logarithms -check-bounds +integer-gmp,
any.invariant ==0.6.3,
any.iproute ==1.7.12,
any.kan-extensions ==5.2.6,
any.language-c ==0.9.3,
language-c -allwarnings +iecfpextension +usebytestrings,
any.lens ==5.3.2,
lens -benchmark-uniplate -dump-splices +inlining -j +test-hunit +test-properties +test-templates +trustworthy,
any.lens-aeson ==1.2.3,
any.lift-type ==0.1.1.1,
any.lifted-base ==0.2.3.12,
any.linear ==1.22,
linear -herbie +template-haskell,
any.megaparsec ==9.6.1,
megaparsec -dev,
any.memory ==0.18.0,
memory +support_bytestring +support_deepseq,
any.microlens ==0.4.13.1,
any.microlens-mtl ==0.2.0.3,
any.microlens-th ==0.4.3.15,
any.mime-types ==0.1.2.0,
any.mmorph ==1.2.0,
any.monad-control ==1.0.3.1,
any.monad-logger ==0.3.40,
monad-logger +template_haskell,
any.monad-loops ==0.4.3,
monad-loops +base4,
any.mono-traversable ==1.0.17.0,
any.monomer ==1.6.0.1,
monomer -examples,
any.mtl ==2.3.1,
any.murmur3 ==1.0.5,
any.nanovg ==0.8.1.0,
nanovg -examples -gl2 -gles3 -stb_truetype,
any.network ==3.2.1.0,
network -devel,
any.network-byte-order ==0.1.7,
any.network-control ==0.1.1,
any.network-uri ==2.6.4.2,
any.old-locale ==1.0.0.7,
any.old-time ==1.1.0.4,
any.optparse-applicative ==0.18.1.0,
optparse-applicative +process,
any.os-string ==2.0.6,
any.parallel ==3.2.2.0,
any.parsec ==3.1.16.1,
any.parser-combinators ==1.3.0,
parser-combinators -dev,
any.path-pieces ==0.2.1,
any.pem ==0.2.4,
any.persistent ==2.14.6.1,
any.persistent-sqlite ==2.13.3.0,
persistent-sqlite -build-sanity-exe +full-text-search +have-usleep +json1 -systemlib +uri-filenames -use-pkgconfig -use-stat3 +use-stat4,
any.persistent-template ==2.12.0.0,
any.pretty ==1.1.3.6,
any.prettyprinter ==1.7.1,
prettyprinter -buildreadme +text,
any.prettyprinter-ansi-terminal ==1.1.3,
any.primitive ==0.9.0.0,
any.process ==1.6.19.0,
any.profunctors ==5.6.2,
any.psqueues ==0.2.8.0,
any.pureMD5 ==2.1.4,
pureMD5 -test,
any.qrcode-core ==0.9.9,
any.qrcode-juicypixels ==0.8.5,
any.quickcheck-io ==0.2.0,
any.quickcheck-transformer ==0.3.1.2,
any.random ==1.2.1.2,
any.recv ==0.1.0,
any.reflection ==2.1.8,
reflection -slow +template-haskell,
any.regex-base ==0.94.0.2,
any.regex-compat ==0.95.2.1,
any.regex-posix ==0.96.0.1,
regex-posix -_regex-posix-clib,
any.resource-pool ==0.4.0.0,
any.resourcet ==1.3.0,
any.rts ==1.0.2,
any.safe ==0.3.21,
any.safe-exceptions ==0.1.7.4,
any.scientific ==0.3.8.0,
scientific -integer-simple,
any.sdl2 ==2.5.5.0,
sdl2 -examples -no-linear -opengl-example +pkgconfig +recent-ish,
any.secp256k1-haskell ==1.2.0,
any.semialign ==1.3.1,
semialign +semigroupoids,
any.semigroupoids ==6.0.1,
semigroupoids +comonad +containers +contravariant +distributive +tagged +unordered-containers,
any.semigroups ==0.20,
semigroups +binary +bytestring -bytestring-builder +containers +deepseq +hashable +tagged +template-haskell +text +transformers +unordered-containers,
any.serialise ==0.2.6.1,
serialise +newtime15,
any.servant ==0.20.1,
any.servant-server ==0.20,
any.silently ==1.2.5.3,
any.simple-sendfile ==0.2.32,
simple-sendfile +allow-bsd -fallback,
any.singleton-bool ==0.1.8,
any.socks ==0.6.1,
any.some ==1.0.6,
some +newtype-unsafe,
any.sop-core ==0.5.0.2,
any.sort ==1.0.0.0,
any.split ==0.2.5,
any.splitmix ==0.1.0.5,
splitmix -optimised-mixer,
any.stm ==2.5.1.0,
any.stm-chans ==3.0.0.9,
any.streaming-commons ==0.2.2.6,
streaming-commons -use-bytestring-builder,
any.strict ==0.5.1,
any.string-conversions ==0.4.0.1,
any.system-cxx-std-lib ==1.0,
any.tagged ==0.8.8,
tagged +deepseq +transformers,
any.template-haskell ==2.20.0.0,
any.terminal-size ==0.3.4,
any.terminfo ==0.4.1.6,
any.text ==2.0.2,
any.text-iso8601 ==0.1.1,
any.text-short ==0.1.6,
text-short -asserts,
any.text-show ==3.10.5,
text-show +base-4-9 +integer-gmp +new-functor-classes +template-haskell-2-11,
any.text-zipper ==0.13,
any.tf-random ==0.5,
any.th-abstraction ==0.7.0.0,
any.th-compat ==0.1.5,
any.th-lift ==0.8.4,
any.th-lift-instances ==0.1.20,
any.these ==1.2.1,
any.time ==1.12.2,
any.time-compat ==1.9.7,
any.time-locale-compat ==0.1.1.5,
time-locale-compat -old-locale,
any.time-manager ==0.1.0,
any.tls ==2.1.0,
tls -devel,
any.transformers ==0.6.1.0,
any.transformers-base ==0.4.6,
transformers-base +orphaninstances,
any.transformers-compat ==0.7.2,
transformers-compat -five +five-three -four +generic-deriving +mtl -three -two,
any.typed-process ==0.2.11.1,
any.unix ==2.8.4.0,
any.unix-compat ==0.7.2,
any.unix-time ==0.4.15,
any.unliftio ==0.2.25.0,
any.unliftio-core ==0.2.1.0,
any.unordered-containers ==0.2.20,
unordered-containers -debug,
any.utf8-string ==1.0.2,
any.uuid-types ==1.0.6,
any.vault ==0.3.1.5,
vault +useghc,
any.vector ==0.13.1.0,
vector +boundschecks -internalchecks -unsafechecks -wall,
any.vector-algorithms ==0.9.0.2,
vector-algorithms +bench +boundschecks -internalchecks -llvm +properties -unsafechecks,
any.vector-stream ==0.1.0.1,
any.void ==0.7.3,
void -safe,
any.vty ==6.2,
any.vty-crossplatform ==0.4.0.0,
vty-crossplatform -demos,
any.vty-unix ==0.2.0.0,
any.wai ==3.2.4,
any.wai-app-static ==3.1.9,
wai-app-static +crypton -print,
any.wai-extra ==3.1.15,
wai-extra -build-example,
any.wai-logger ==2.4.0,
any.warp ==3.4.1,
warp +allow-sendfilefd -network-bytestring -warp-debug +x509,
any.wide-word ==0.1.6.0,
any.witherable ==0.5,
any.word-wrap ==0.5,
any.word8 ==0.1.3,
any.wreq ==0.5.4.3,
wreq -aws -developer +doctest -httpbin,
any.zlib ==0.7.1.0,
zlib -bundled-c-zlib +non-blocking-ffi +pkg-config
index-state: hackage.haskell.org 2024-07-10T18:40:26Z

17
configure vendored
View file

@ -1,17 +0,0 @@
#!/bin/bash
echo "Configuring Zenith...."
if grep -q "local/share/zcash-haskell" "$HOME/.bashrc"; then
echo "... Paths already exist"
else
# Set Paths
echo "... Adding new zenith paths to local configuration"
echo "export PKG_CONFIG_PATH=$HOME/.local/share/zcash-haskell:\$PKG_CONFIG_PATH" | tee -a ~/.bashrc
echo "export LD_LIBRARY_PATH=$HOME/.local/share/zcash-haskell:\$LD_LIBRARY_PATH" | tee -a ~/.bashrc
fi
echo "... Reloading paths"
source ~/.bashrc
echo "... building zcash-haskell"
cd zcash-haskell && cabal build
echo
echo "Done"
echo

View file

@ -1,5 +0,0 @@
#!/bin/bash
echo "Deploying Zenith executable..."
ln -s ${PWD}/dist-newstyle/build/x86_64-linux/ghc-9.6.5/zenith-0.6.0.0/build/zenith/zenith ~/.local/bin/zenith
echo "Done."

76
package.yaml Normal file
View file

@ -0,0 +1,76 @@
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

Binary file not shown.

Binary file not shown.

635
src/Zenith.hs Normal file
View file

@ -0,0 +1,635 @@
{-# 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"

File diff suppressed because it is too large Load diff

File diff suppressed because it is too large Load diff

File diff suppressed because it is too large Load diff

File diff suppressed because it is too large Load diff

View file

@ -1,343 +0,0 @@
{-# LANGUAGE OverloadedStrings #-}
module Zenith.GUI.Theme
( zenithTheme
) where
import Data.Default
import Lens.Micro ((&), (+~), (.~), (?~), (^.), at, set)
import Monomer
import Monomer.Core.Themes.BaseTheme
import Monomer.Core.Themes.SampleThemes
import Monomer.Graphics (rgbHex, transparent)
import Monomer.Graphics.ColorTable
import qualified Monomer.Lens as L
baseTextStyle :: TextStyle
baseTextStyle = def & L.fontSize ?~ FontSize 10 & L.fontColor ?~ black
hiliteTextStyle :: TextStyle
hiliteTextStyle = def & L.fontSize ?~ FontSize 10 & L.fontColor ?~ white
zenithTheme :: Theme
zenithTheme =
baseTheme zgoThemeColors & L.basic . L.labelStyle . L.text ?~ baseTextStyle &
L.hover .
L.tooltipStyle . L.text ?~
baseTextStyle &
L.hover .
L.labelStyle . L.text ?~
baseTextStyle &
L.basic .
L.dialogTitleStyle . L.text ?~
(baseTextStyle & L.fontSize ?~ FontSize 12 & L.font ?~ "Bold") &
L.hover .
L.dialogTitleStyle . L.text ?~
(baseTextStyle & L.fontSize ?~ FontSize 12 & L.font ?~ "Bold") &
L.basic .
L.btnStyle . L.text ?~
baseTextStyle &
L.hover .
L.btnStyle . L.text ?~
baseTextStyle &
L.focus .
L.btnStyle . L.text ?~
baseTextStyle &
L.focusHover .
L.btnStyle . L.text ?~
baseTextStyle &
L.active .
L.btnStyle . L.text ?~
baseTextStyle &
L.disabled .
L.btnStyle . L.text ?~
baseTextStyle &
L.basic .
L.btnMainStyle . L.text ?~
hiliteTextStyle &
L.hover .
L.btnMainStyle . L.text ?~
hiliteTextStyle &
L.focus .
L.btnMainStyle . L.text ?~
hiliteTextStyle &
L.focusHover .
L.btnMainStyle . L.text ?~
hiliteTextStyle &
L.active .
L.btnMainStyle . L.text ?~
hiliteTextStyle &
L.disabled .
L.btnMainStyle . L.text ?~
hiliteTextStyle &
L.disabled .
L.btnMainStyle . L.bgColor ?~
gray07c &
L.basic .
L.textFieldStyle . L.text ?~
baseTextStyle &
L.hover .
L.textFieldStyle . L.text ?~
baseTextStyle &
L.focus .
L.textFieldStyle . L.text ?~
baseTextStyle &
L.active .
L.textFieldStyle . L.text ?~
baseTextStyle &
L.focusHover .
L.textFieldStyle . L.text ?~
baseTextStyle &
L.basic .
L.numericFieldStyle . L.text ?~
baseTextStyle &
L.hover .
L.numericFieldStyle . L.text ?~
baseTextStyle &
L.focus .
L.numericFieldStyle . L.text ?~
baseTextStyle &
L.active .
L.numericFieldStyle . L.text ?~
baseTextStyle &
L.focusHover .
L.numericFieldStyle . L.text ?~
baseTextStyle &
L.basic .
L.textAreaStyle . L.text ?~
baseTextStyle &
L.hover .
L.textAreaStyle . L.text ?~
baseTextStyle &
L.focus .
L.textAreaStyle . L.text ?~
baseTextStyle &
L.active .
L.textAreaStyle . L.text ?~
baseTextStyle &
L.focusHover .
L.textAreaStyle . L.text ?~
baseTextStyle
zenithThemeColors :: BaseThemeColors
zenithThemeColors =
BaseThemeColors
{ clearColor = gray01
, sectionColor = gray01
, btnFocusBorder = blue09
, btnBgBasic = gray07b
, btnBgHover = gray08
, btnBgFocus = gray07c
, btnBgActive = gray06
, btnBgDisabled = gray05
, btnText = gray02
, btnTextDisabled = gray01
, btnMainFocusBorder = blue08
, btnMainBgBasic = btnColor
, btnMainBgHover = btnHiLite
, btnMainBgFocus = btnColor
, btnMainBgActive = btnHiLite
, btnMainBgDisabled = blue04
, btnMainText = white
, btnMainTextDisabled = gray08
, dialogBg = gray01
, dialogBorder = gray01
, dialogText = white
, dialogTitleText = white
, emptyOverlay = gray05 & L.a .~ 0.8
, shadow = gray00 & L.a .~ 0.33
, externalLinkBasic = blue07
, externalLinkHover = blue08
, externalLinkFocus = blue07
, externalLinkActive = blue06
, externalLinkDisabled = gray06
, iconBg = gray08
, iconFg = gray01
, inputIconFg = black
, inputBorder = gray02
, inputFocusBorder = blue08
, inputBgBasic = gray04
, inputBgHover = gray06
, inputBgFocus = gray05
, inputBgActive = gray03
, inputBgDisabled = gray07
, inputFgBasic = gray06
, inputFgHover = blue08
, inputFgFocus = blue08
, inputFgActive = blue07
, inputFgDisabled = gray07
, inputSndBasic = gray05
, inputSndHover = gray06
, inputSndFocus = gray05
, inputSndActive = gray05
, inputSndDisabled = gray03
, inputHlBasic = gray07
, inputHlHover = blue08
, inputHlFocus = blue08
, inputHlActive = blue08
, inputHlDisabled = gray08
, inputSelBasic = gray06
, inputSelFocus = blue06
, inputText = white
, inputTextDisabled = gray02
, labelText = white
, scrollBarBasic = gray01 & L.a .~ 0.2
, scrollThumbBasic = gray07 & L.a .~ 0.6
, scrollBarHover = gray01 & L.a .~ 0.4
, scrollThumbHover = gray07 & L.a .~ 0.8
, slMainBg = gray00
, slNormalBgBasic = transparent
, slNormalBgHover = gray05
, slNormalText = white
, slNormalFocusBorder = blue08
, slSelectedBgBasic = gray04
, slSelectedBgHover = gray05
, slSelectedText = white
, slSelectedFocusBorder = blue08
, tooltipBorder = gray05
, tooltipBg = rgbHex "#1D212B"
, tooltipText = white
}
zgoThemeColors =
BaseThemeColors
{ clearColor = gray10 -- gray12,
, sectionColor = gray09 -- gray11,
, btnFocusBorder = blue08
, btnBgBasic = gray07
, btnBgHover = gray07c
, btnBgFocus = gray07b
, btnBgActive = gray06
, btnBgDisabled = gray05
, btnText = gray02
, btnTextDisabled = gray02
, btnMainFocusBorder = blue09
, btnMainBgBasic = btnColor
, btnMainBgHover = btnHiLite
, btnMainBgFocus = btnColor
, btnMainBgActive = btnHiLite
, btnMainBgDisabled = blue04
, btnMainText = white
, btnMainTextDisabled = white
, dialogBg = white
, dialogBorder = white
, dialogText = black
, dialogTitleText = black
, emptyOverlay = gray07 & L.a .~ 0.8
, shadow = gray00 & L.a .~ 0.2
, externalLinkBasic = blue07
, externalLinkHover = blue08
, externalLinkFocus = blue07
, externalLinkActive = blue06
, externalLinkDisabled = gray06
, iconBg = gray07
, iconFg = gray01
, inputIconFg = black
, inputBorder = gray06
, inputFocusBorder = blue07
, inputBgBasic = gray10
, inputBgHover = white
, inputBgFocus = white
, inputBgActive = gray09
, inputBgDisabled = gray05
, inputFgBasic = gray05
, inputFgHover = blue07
, inputFgFocus = blue07
, inputFgActive = blue06
, inputFgDisabled = gray04
, inputSndBasic = gray04
, inputSndHover = gray05
, inputSndFocus = gray05
, inputSndActive = gray04
, inputSndDisabled = gray03
, inputHlBasic = gray06
, inputHlHover = blue07
, inputHlFocus = blue07
, inputHlActive = blue06
, inputHlDisabled = gray05
, inputSelBasic = gray07
, inputSelFocus = blue08
, inputText = black
, inputTextDisabled = gray02
, labelText = black
, scrollBarBasic = gray03 & L.a .~ 0.2
, scrollThumbBasic = gray01 & L.a .~ 0.2
, scrollBarHover = gray07 & L.a .~ 0.8
, scrollThumbHover = gray05 & L.a .~ 0.8
, slMainBg = white
, slNormalBgBasic = transparent
, slNormalBgHover = gray09
, slNormalText = black
, slNormalFocusBorder = blue07
, slSelectedBgBasic = gray08
, slSelectedBgHover = gray09
, slSelectedText = black
, slSelectedFocusBorder = blue07
, tooltipBorder = gray08
, tooltipBg = gray07
, tooltipText = black
}
--black = rgbHex "#000000"
{-white = rgbHex "#FFFFFF"-}
btnColor = rgbHex "#ff5722" --rgbHex "#1818B2"
btnHiLite = rgbHex "#207DE8"
blue01 = rgbHex "#002159"
blue02 = rgbHex "#01337D"
blue03 = rgbHex "#03449E"
blue04 = rgbHex "#0552B5"
blue05 = rgbHex "#0967D2"
blue05b = rgbHex "#0F6BD7"
blue05c = rgbHex "#1673DE"
blue06 = rgbHex "#2186EB"
blue06b = rgbHex "#2489EE"
blue06c = rgbHex "#2B8FF6"
blue07 = rgbHex "#47A3F3"
blue07b = rgbHex "#50A6F6"
blue07c = rgbHex "#57ACFC"
blue08 = rgbHex "#7CC4FA"
blue09 = rgbHex "#BAE3FF"
blue10 = rgbHex "#E6F6FF"
gray00 = rgbHex "#111111"
gray01 = rgbHex "#2E2E2E"
gray02 = rgbHex "#393939"
gray03 = rgbHex "#515151"
gray04 = rgbHex "#626262"
gray05 = rgbHex "#7E7E7E"
gray06 = rgbHex "#9E9E9E"
gray07 = rgbHex "#B1B1B1"
gray07b = rgbHex "#B4B4B4"
gray07c = rgbHex "#BBBBBB"
gray08 = rgbHex "#CFCFCF"
gray09 = rgbHex "#E1E1E1"
gray10 = rgbHex "#F7F7F7"

View file

@ -1,953 +0,0 @@
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE DerivingStrategies #-}
module Zenith.RPC where
import Control.Concurrent (forkIO)
import Control.Exception (try)
import Control.Monad (unless, when)
import Control.Monad.IO.Class (liftIO)
import Control.Monad.Logger (runFileLoggingT, runNoLoggingT, runStderrLoggingT)
import Data.Aeson
import qualified Data.HexString as H
import Data.Int
import Data.Scientific (floatingOrInteger)
import qualified Data.Text as T
import qualified Data.Text.Encoding as E
import Data.Time.Clock (getCurrentTime)
import qualified Data.UUID as U
import Data.UUID.V4 (nextRandom)
import qualified Data.Vector as V
import Database.Esqueleto.Experimental
( ConnectionPool
, entityKey
, entityVal
, fromSqlKey
, toSqlKey
)
import Servant
import Text.Read (readMaybe)
import ZcashHaskell.Keys (generateWalletSeedPhrase)
import ZcashHaskell.Orchard (parseAddress)
import ZcashHaskell.Types
( BlockResponse(..)
, RpcError(..)
, Scope(..)
, ZcashNet(..)
, ZebraGetBlockChainInfo(..)
)
import ZcashHaskell.Utils (getBlockTime, makeZebraCall)
import Zenith.Core
( checkBlockChain
, createCustomWalletAddress
, createZcashAccount
, prepareTxV2
, syncWallet
, updateCommitmentTrees
)
import Zenith.DB
( Operation(..)
, ZcashAccount(..)
, ZcashBlock(..)
, ZcashWallet(..)
, completeSync
, finalizeOperation
, findNotesByAddress
, getAccountById
, getAccounts
, getAddressById
, getAddresses
, getExternalAddresses
, getLastSyncBlock
, getMaxAccount
, getMaxAddress
, getMaxBlock
, getMinBirthdayHeight
, getOperation
, getPoolBalance
, getUnconfPoolBalance
, getWalletNotes
, getWallets
, initPool
, isSyncing
, rewindWalletData
, saveAccount
, saveAddress
, saveBlock
, saveOperation
, saveWallet
, startSync
, toZcashAccountAPI
, toZcashAddressAPI
, toZcashWalletAPI
, walletExists
)
import Zenith.Scanner (checkIntegrity, processTx, updateConfs)
import Zenith.Types
( AccountBalance(..)
, Config(..)
, HexStringDB(..)
, PhraseDB(..)
, PrivacyPolicy(..)
, ProposedNote(..)
, ZcashAccountAPI(..)
, ZcashAddressAPI(..)
, ZcashNetDB(..)
, ZcashNoteAPI(..)
, ZcashWalletAPI(..)
, ZenithStatus(..)
, ZenithUuid(..)
)
import Zenith.Utils (jsonNumber)
data ZenithMethod
= GetInfo
| ListWallets
| ListAccounts
| ListAddresses
| ListReceived
| GetBalance
| GetNewWallet
| GetNewAccount
| GetNewAddress
| GetOperationStatus
| SendMany
| UnknownMethod
deriving (Eq, Prelude.Show)
instance ToJSON ZenithMethod where
toJSON GetInfo = Data.Aeson.String "getinfo"
toJSON ListWallets = Data.Aeson.String "listwallets"
toJSON ListAccounts = Data.Aeson.String "listaccounts"
toJSON ListAddresses = Data.Aeson.String "listaddresses"
toJSON ListReceived = Data.Aeson.String "listreceived"
toJSON GetBalance = Data.Aeson.String "getbalance"
toJSON GetNewWallet = Data.Aeson.String "getnewwallet"
toJSON GetNewAccount = Data.Aeson.String "getnewaccount"
toJSON GetNewAddress = Data.Aeson.String "getnewaddress"
toJSON GetOperationStatus = Data.Aeson.String "getoperationstatus"
toJSON SendMany = Data.Aeson.String "sendmany"
toJSON UnknownMethod = Data.Aeson.Null
instance FromJSON ZenithMethod where
parseJSON =
withText "ZenithMethod" $ \case
"getinfo" -> pure GetInfo
"listwallets" -> pure ListWallets
"listaccounts" -> pure ListAccounts
"listaddresses" -> pure ListAddresses
"listreceived" -> pure ListReceived
"getbalance" -> pure GetBalance
"getnewwallet" -> pure GetNewWallet
"getnewaccount" -> pure GetNewAccount
"getnewaddress" -> pure GetNewAddress
"getoperationstatus" -> pure GetOperationStatus
"sendmany" -> pure SendMany
_ -> pure UnknownMethod
data ZenithParams
= BlankParams
| BadParams
| AccountsParams !Int
| AddressesParams !Int
| NotesParams !T.Text
| BalanceParams !Int64
| NameParams !T.Text
| NameIdParams !T.Text !Int
| NewAddrParams !Int !T.Text !Bool !Bool
| OpParams !ZenithUuid
| SendParams !Int ![ProposedNote] !PrivacyPolicy
| TestParams !T.Text
deriving (Eq, Prelude.Show)
instance ToJSON ZenithParams where
toJSON BlankParams = Data.Aeson.Array V.empty
toJSON BadParams = Data.Aeson.Null
toJSON (AccountsParams n) = Data.Aeson.Array $ V.fromList [jsonNumber n]
toJSON (AddressesParams n) = Data.Aeson.Array $ V.fromList [jsonNumber n]
toJSON (TestParams t) = Data.Aeson.Array $ V.fromList [Data.Aeson.String t]
toJSON (NotesParams t) = Data.Aeson.Array $ V.fromList [Data.Aeson.String t]
toJSON (NameParams t) = Data.Aeson.Array $ V.fromList [Data.Aeson.String t]
toJSON (NameIdParams t i) =
Data.Aeson.Array $ V.fromList [Data.Aeson.String t, jsonNumber i]
toJSON (BalanceParams n) =
Data.Aeson.Array $ V.fromList [jsonNumber $ fromIntegral n]
toJSON (NewAddrParams a n s t) =
Data.Aeson.Array $
V.fromList $
[jsonNumber a, Data.Aeson.String n] <>
[Data.Aeson.String "ExcludeSapling" | s] <>
[Data.Aeson.String "ExcludeTransparent" | t]
toJSON (OpParams i) =
Data.Aeson.Array $ V.fromList [Data.Aeson.String $ U.toText $ getUuid i]
toJSON (SendParams i ns p) =
Data.Aeson.Array $ V.fromList [jsonNumber i, toJSON ns, toJSON p]
data ZenithResponse
= InfoResponse !T.Text !ZenithInfo
| WalletListResponse !T.Text ![ZcashWalletAPI]
| AccountListResponse !T.Text ![ZcashAccountAPI]
| AddressListResponse !T.Text ![ZcashAddressAPI]
| NoteListResponse !T.Text ![ZcashNoteAPI]
| BalanceResponse !T.Text !AccountBalance !AccountBalance
| NewItemResponse !T.Text !Int64
| NewAddrResponse !T.Text !ZcashAddressAPI
| OpResponse !T.Text !Operation
| SendResponse !T.Text !U.UUID
| ErrorResponse !T.Text !Double !T.Text
deriving (Eq, Prelude.Show)
instance ToJSON ZenithResponse where
toJSON (InfoResponse t i) = packRpcResponse t i
toJSON (WalletListResponse i w) = packRpcResponse i w
toJSON (AccountListResponse i a) = packRpcResponse i a
toJSON (AddressListResponse i a) = packRpcResponse i a
toJSON (NoteListResponse i n) = packRpcResponse i n
toJSON (ErrorResponse i c m) =
object
[ "jsonrpc" .= ("2.0" :: String)
, "id" .= i
, "error" .= object ["code" .= c, "message" .= m]
]
toJSON (BalanceResponse i c u) =
packRpcResponse i $ object ["confirmed" .= c, "unconfirmed" .= u]
toJSON (NewItemResponse i ix) = packRpcResponse i ix
toJSON (NewAddrResponse i a) = packRpcResponse i a
toJSON (OpResponse i u) = packRpcResponse i u
toJSON (SendResponse i o) = packRpcResponse i o
instance FromJSON ZenithResponse where
parseJSON =
withObject "ZenithResponse" $ \obj -> do
jr <- obj .: "jsonrpc"
i <- obj .: "id"
e <- obj .:? "error"
r <- obj .:? "result"
if jr /= ("2.0" :: String)
then fail "Malformed JSON"
else do
case e of
Nothing -> do
case r of
Nothing -> fail "Malformed JSON"
Just r1 ->
case r1 of
Object k -> do
v <- k .:? "version"
v5 <- k .:? "unconfirmed"
v6 <- k .:? "ua"
v7 <- k .:? "uuid"
case (v :: Maybe String) of
Just _v' -> do
k1 <- parseJSON r1
pure $ InfoResponse i k1
Nothing ->
case (v5 :: Maybe AccountBalance) of
Just _v5' -> do
k6 <- parseJSON r1
j1 <- k6 .: "confirmed"
j2 <- k6 .: "unconfirmed"
pure $ BalanceResponse i j1 j2
Nothing ->
case (v6 :: Maybe String) of
Just _v6' -> do
k7 <- parseJSON r1
pure $ NewAddrResponse i k7
Nothing ->
case (v7 :: Maybe U.UUID) of
Just _v7' -> do
k8 <- parseJSON r1
pure $ OpResponse i k8
Nothing -> fail "Unknown object"
Array n -> do
if V.null n
then fail "Malformed JSON"
else do
case V.head n of
Object n' -> do
v1 <- n' .:? "lastSync"
v2 <- n' .:? "wallet"
v3 <- n' .:? "ua"
v4 <- n' .:? "amountZats"
case (v1 :: Maybe Int) of
Just _v1' -> do
k2 <- parseJSON r1
pure $ WalletListResponse i k2
Nothing ->
case (v2 :: Maybe Int) of
Just _v2' -> do
k3 <- parseJSON r1
pure $ AccountListResponse i k3
Nothing ->
case (v3 :: Maybe String) of
Just _v3' -> do
k4 <- parseJSON r1
pure $ AddressListResponse i k4
Nothing ->
case (v4 :: Maybe Int) of
Just _v4' -> do
k5 <- parseJSON r1
pure $ NoteListResponse i k5
Nothing -> fail "Unknown object"
_anyOther -> fail "Malformed JSON"
Number k -> do
case floatingOrInteger k of
Left _e -> fail "Unknown value"
Right k' -> pure $ NewItemResponse i k'
String s -> do
case U.fromText s of
Nothing -> fail "Unknown value"
Just u -> pure $ SendResponse i u
_anyOther -> fail "Malformed JSON"
Just e1 -> pure $ ErrorResponse i (ecode e1) (emessage e1)
data ZenithInfo = ZenithInfo
{ zi_version :: !T.Text
, zi_network :: !ZcashNet
, zi_zebra :: !T.Text
} deriving (Eq, Prelude.Show)
instance ToJSON ZenithInfo where
toJSON (ZenithInfo v n z) =
object ["version" .= v, "network" .= n, "zebraVersion" .= z]
instance FromJSON ZenithInfo where
parseJSON =
withObject "ZenithInfo" $ \obj -> do
v <- obj .: "version"
n <- obj .: "network"
z <- obj .: "zebraVersion"
pure $ ZenithInfo v n z
-- | A type to model Zenith RPC calls
data RpcCall = RpcCall
{ jsonrpc :: !T.Text
, callId :: !T.Text
, method :: !ZenithMethod
, parameters :: !ZenithParams
} deriving (Eq, Prelude.Show)
instance ToJSON RpcCall where
toJSON (RpcCall jr i m p) =
object ["jsonrpc" .= jr, "id" .= i, "method" .= m, "params" .= p]
instance FromJSON RpcCall where
parseJSON =
withObject "RpcCall" $ \obj -> do
v <- obj .: "jsonrpc"
i <- obj .: "id"
m <- obj .: "method"
case m of
UnknownMethod -> pure $ RpcCall v i UnknownMethod BlankParams
ListWallets -> do
p <- obj .: "params"
if null (p :: [Value])
then pure $ RpcCall v i ListWallets BlankParams
else pure $ RpcCall v i ListWallets BadParams
GetInfo -> do
p <- obj .: "params"
if null (p :: [Value])
then pure $ RpcCall v i GetInfo BlankParams
else pure $ RpcCall v i GetInfo BadParams
ListAccounts -> do
p <- obj .: "params"
case p of
Array a ->
if V.length a == 1
then do
w <- parseJSON $ V.head a
pure $ RpcCall v i ListAccounts (AccountsParams w)
else pure $ RpcCall v i ListAccounts BadParams
_anyOther -> pure $ RpcCall v i ListAccounts BadParams
ListAddresses -> do
p <- obj .: "params"
case p of
Array a ->
if V.length a == 1
then do
x <- parseJSON $ V.head a
pure $ RpcCall v i ListAddresses (AddressesParams x)
else pure $ RpcCall v i ListAddresses BadParams
_anyOther -> pure $ RpcCall v i ListAddresses BadParams
ListReceived -> do
p <- obj .: "params"
case p of
Array a ->
if V.length a == 1
then do
x <- parseJSON $ V.head a
pure $ RpcCall v i ListReceived (NotesParams x)
else pure $ RpcCall v i ListReceived BadParams
_anyOther -> pure $ RpcCall v i ListReceived BadParams
GetBalance -> do
p <- obj .: "params"
case p of
Array a ->
if V.length a == 1
then do
x <- parseJSON $ V.head a
pure $ RpcCall v i GetBalance (BalanceParams x)
else pure $ RpcCall v i GetBalance BadParams
_anyOther -> pure $ RpcCall v i GetBalance BadParams
GetNewWallet -> do
p <- obj .: "params"
case p of
Array a ->
if V.length a == 1
then do
x <- parseJSON $ V.head a
pure $ RpcCall v i GetNewWallet (NameParams x)
else pure $ RpcCall v i GetNewWallet BadParams
_anyOther -> pure $ RpcCall v i GetNewWallet BadParams
GetNewAccount -> do
p <- obj .: "params"
case p of
Array a ->
if V.length a == 2
then do
x <- parseJSON $ a V.! 0
y <- parseJSON $ a V.! 1
pure $ RpcCall v i GetNewAccount (NameIdParams x y)
else pure $ RpcCall v i GetNewAccount BadParams
_anyOther -> pure $ RpcCall v i GetNewAccount BadParams
GetNewAddress -> do
p <- obj .: "params"
case p of
Array a ->
if V.length a >= 2
then do
x <- parseJSON $ a V.! 0
y <- parseJSON $ a V.! 1
(sap, tr) <-
case a V.!? 2 of
Nothing -> return (False, False)
Just s -> do
s' <- parseJSON s
case s' of
("ExcludeSapling" :: String) -> do
case a V.!? 3 of
Nothing -> return (True, False)
Just t -> do
t' <- parseJSON t
return
(True, t' == ("ExcludeTransparent" :: String))
("ExcludeTransparent" :: String) -> do
case a V.!? 3 of
Nothing -> return (False, True)
Just t -> do
t' <- parseJSON t
return
(t' == ("ExcludeSapling" :: String), True)
_anyOther -> return (False, False)
pure $ RpcCall v i GetNewAddress (NewAddrParams x y sap tr)
else pure $ RpcCall v i GetNewAddress BadParams
_anyOther -> pure $ RpcCall v i GetNewAddress BadParams
GetOperationStatus -> do
p <- obj .: "params"
case p of
Array a ->
if V.length a == 1
then do
x <- parseJSON $ a V.! 0
case U.fromText x of
Just u -> do
pure $
RpcCall v i GetOperationStatus (OpParams $ ZenithUuid u)
Nothing -> pure $ RpcCall v i GetOperationStatus BadParams
else pure $ RpcCall v i GetOperationStatus BadParams
_anyOther -> pure $ RpcCall v i GetOperationStatus BadParams
SendMany -> do
p <- obj .: "params"
case p of
Array a ->
if V.length a >= 2
then do
acc <- parseJSON $ a V.! 0
x <- parseJSON $ a V.! 1
case x of
String _ -> do
x' <- parseJSON $ a V.! 1
y <- parseJSON $ a V.! 2
if not (null y)
then pure $ RpcCall v i SendMany (SendParams acc y x')
else pure $ RpcCall v i SendMany BadParams
Array _ -> do
x' <- parseJSON $ a V.! 1
if not (null x')
then pure $
RpcCall v i SendMany (SendParams acc x' Full)
else pure $ RpcCall v i SendMany BadParams
_anyOther -> pure $ RpcCall v i SendMany BadParams
else pure $ RpcCall v i SendMany BadParams
_anyOther -> pure $ RpcCall v i SendMany BadParams
type ZenithRPC
= "status" :> Get '[ JSON] Value :<|> BasicAuth "zenith-realm" Bool :> ReqBody
'[ JSON]
RpcCall :> Post '[ JSON] ZenithResponse
data State = State
{ w_network :: !ZcashNet
, w_host :: !T.Text
, w_port :: !Int
, w_dbPath :: !T.Text
, w_build :: !T.Text
, w_startBlock :: !Int
}
zenithServer :: State -> Server ZenithRPC
zenithServer state = getinfo :<|> handleRPC
where
getinfo :: Handler Value
getinfo =
return $
object
[ "version" .= ("0.7.0.0-beta" :: String)
, "network" .= ("testnet" :: String)
]
handleRPC :: Bool -> RpcCall -> Handler ZenithResponse
handleRPC isAuth req =
case method req of
UnknownMethod ->
return $ ErrorResponse (callId req) (-32601) "Method not found"
ListWallets ->
case parameters req of
BlankParams -> do
pool <- liftIO $ runNoLoggingT $ initPool $ w_dbPath state
walList <- liftIO $ getWallets pool $ w_network state
if not (null walList)
then return $
WalletListResponse
(callId req)
(map toZcashWalletAPI walList)
else return $
ErrorResponse
(callId req)
(-32001)
"No wallets available. Please create one first"
_anyOther ->
return $ ErrorResponse (callId req) (-32602) "Invalid params"
ListAccounts ->
case parameters req of
AccountsParams w -> do
let dbPath = w_dbPath state
pool <- liftIO $ runNoLoggingT $ initPool dbPath
wl <- liftIO $ walletExists pool w
case wl of
Just wl' -> do
accList <-
liftIO $ runNoLoggingT $ getAccounts pool (entityKey wl')
if not (null accList)
then return $
AccountListResponse
(callId req)
(map toZcashAccountAPI accList)
else return $
ErrorResponse
(callId req)
(-32002)
"No accounts available for this wallet. Please create one first"
Nothing ->
return $
ErrorResponse (callId req) (-32008) "Wallet does not exist."
_anyOther ->
return $ ErrorResponse (callId req) (-32602) "Invalid params"
ListAddresses ->
case parameters req of
AddressesParams a -> do
let dbPath = w_dbPath state
pool <- liftIO $ runNoLoggingT $ initPool dbPath
addrList <-
liftIO $
runNoLoggingT $ getAddresses pool (toSqlKey $ fromIntegral a)
if not (null addrList)
then return $
AddressListResponse
(callId req)
(map toZcashAddressAPI addrList)
else return $
ErrorResponse
(callId req)
(-32003)
"No addresses available for this account. Please create one first"
_anyOther ->
return $ ErrorResponse (callId req) (-32602) "Invalid params"
GetInfo ->
case parameters req of
BlankParams ->
return $
InfoResponse
(callId req)
(ZenithInfo "0.7.0.0-beta" (w_network state) (w_build state))
_anyOtherParams ->
return $ ErrorResponse (callId req) (-32602) "Invalid params"
ListReceived ->
case parameters req of
NotesParams x -> do
case (readMaybe (T.unpack x) :: Maybe Int64) of
Just x' -> do
let dbPath = w_dbPath state
pool <- liftIO $ runNoLoggingT $ initPool dbPath
a <- liftIO $ getAddressById pool $ toSqlKey x'
case a of
Just a' -> do
nList <- liftIO $ getWalletNotes pool a'
return $ NoteListResponse (callId req) nList
Nothing ->
return $
ErrorResponse
(callId req)
(-32004)
"Address does not belong to the wallet"
Nothing ->
case parseAddress (E.encodeUtf8 x) of
Nothing ->
return $
ErrorResponse
(callId req)
(-32005)
"Unable to parse address"
Just x' -> do
let dbPath = w_dbPath state
pool <- liftIO $ runNoLoggingT $ initPool dbPath
addrs <- liftIO $ getExternalAddresses pool
nList <-
liftIO $
concat <$> mapM (findNotesByAddress pool x') addrs
return $ NoteListResponse (callId req) nList
_anyOtherParams ->
return $ ErrorResponse (callId req) (-32602) "Invalid params"
GetBalance ->
case parameters req of
BalanceParams i -> do
let dbPath = w_dbPath state
pool <- liftIO $ runNoLoggingT $ initPool dbPath
acc <- liftIO $ getAccountById pool $ toSqlKey i
case acc of
Just acc' -> do
c <- liftIO $ getPoolBalance pool $ entityKey acc'
u <- liftIO $ getUnconfPoolBalance pool $ entityKey acc'
return $ BalanceResponse (callId req) c u
Nothing ->
return $
ErrorResponse (callId req) (-32006) "Account does not exist."
_anyOtherParams ->
return $ ErrorResponse (callId req) (-32602) "Invalid params"
GetNewWallet ->
case parameters req of
NameParams t -> do
let dbPath = w_dbPath state
pool <- liftIO $ runNoLoggingT $ initPool dbPath
syncChk <- liftIO $ isSyncing pool
if syncChk
then return $
ErrorResponse
(callId req)
(-32012)
"The Zenith server is syncing, please try again later."
else do
sP <- liftIO generateWalletSeedPhrase
r <-
liftIO $
saveWallet pool $
ZcashWallet
t
(ZcashNetDB $ w_network state)
(PhraseDB sP)
(w_startBlock state)
0
case r of
Nothing ->
return $
ErrorResponse
(callId req)
(-32007)
"Entity with that name already exists."
Just r' ->
return $
NewItemResponse (callId req) $ fromSqlKey $ entityKey r'
_anyOtherParams ->
return $ ErrorResponse (callId req) (-32602) "Invalid params"
GetNewAccount ->
case parameters req of
NameIdParams t i -> do
let dbPath = w_dbPath state
pool <- liftIO $ runNoLoggingT $ initPool dbPath
syncChk <- liftIO $ isSyncing pool
if syncChk
then return $
ErrorResponse
(callId req)
(-32012)
"The Zenith server is syncing, please try again later."
else do
w <- liftIO $ walletExists pool i
case w of
Just w' -> do
aIdx <- liftIO $ getMaxAccount pool $ entityKey w'
nAcc <-
liftIO
(try $ createZcashAccount t (aIdx + 1) w' :: IO
(Either IOError ZcashAccount))
case nAcc of
Left e ->
return $
ErrorResponse (callId req) (-32010) $ T.pack $ show e
Right nAcc' -> do
r <- liftIO $ saveAccount pool nAcc'
case r of
Nothing ->
return $
ErrorResponse
(callId req)
(-32007)
"Entity with that name already exists."
Just x ->
return $
NewItemResponse (callId req) $
fromSqlKey $ entityKey x
Nothing ->
return $
ErrorResponse
(callId req)
(-32008)
"Wallet does not exist."
_anyOtherParams ->
return $ ErrorResponse (callId req) (-32602) "Invalid params"
GetNewAddress ->
case parameters req of
NewAddrParams i n s t -> do
let dbPath = w_dbPath state
let net = w_network state
pool <- liftIO $ runNoLoggingT $ initPool dbPath
syncChk <- liftIO $ isSyncing pool
if syncChk
then return $
ErrorResponse
(callId req)
(-32012)
"The Zenith server is syncing, please try again later."
else do
acc <-
liftIO $ getAccountById pool $ toSqlKey $ fromIntegral i
case acc of
Just acc' -> do
maxAddr <-
liftIO $ getMaxAddress pool (entityKey acc') External
newAddr <-
liftIO $
createCustomWalletAddress
n
(maxAddr + 1)
net
External
acc'
s
t
dbAddr <- liftIO $ saveAddress pool newAddr
case dbAddr of
Just nAddr -> do
return $
NewAddrResponse
(callId req)
(toZcashAddressAPI nAddr)
Nothing ->
return $
ErrorResponse
(callId req)
(-32007)
"Entity with that name already exists."
Nothing ->
return $
ErrorResponse
(callId req)
(-32006)
"Account does not exist."
_anyOtherParams ->
return $ ErrorResponse (callId req) (-32602) "Invalid params"
GetOperationStatus ->
case parameters req of
OpParams u -> do
let dbPath = w_dbPath state
pool <- liftIO $ runNoLoggingT $ initPool dbPath
op <- liftIO $ getOperation pool $ getUuid u
case op of
Just o -> do
return $ OpResponse (callId req) $ entityVal o
Nothing ->
return $
ErrorResponse (callId req) (-32009) "Operation ID not found"
_anyOtherParams ->
return $ ErrorResponse (callId req) (-32602) "Invalid params"
SendMany ->
case parameters req of
SendParams a ns p -> do
let dbPath = w_dbPath state
let zHost = w_host state
let zPort = w_port state
let znet = w_network state
pool <- liftIO $ runNoLoggingT $ initPool dbPath
syncChk <- liftIO $ isSyncing pool
if syncChk
then return $
ErrorResponse
(callId req)
(-32012)
"The Zenith server is syncing, please try again later."
else do
opid <- liftIO nextRandom
startTime <- liftIO getCurrentTime
opkey <-
liftIO $
saveOperation pool $
Operation
(ZenithUuid opid)
startTime
Nothing
Processing
Nothing
case opkey of
Nothing ->
return $
ErrorResponse (callId req) (-32010) "Internal Error"
Just opkey' -> do
acc <-
liftIO $ getAccountById pool $ toSqlKey $ fromIntegral a
case acc of
Just acc' -> do
bl <-
liftIO $
getLastSyncBlock
pool
(zcashAccountWalletId $ entityVal acc')
_ <-
liftIO $
forkIO $ do
res <-
liftIO $
runNoLoggingT $
prepareTxV2
pool
zHost
zPort
znet
(entityKey acc')
bl
ns
p
case res of
Left e ->
finalizeOperation pool opkey' Failed $
T.pack $ show e
Right rawTx -> do
zebraRes <-
makeZebraCall
zHost
zPort
"sendrawtransaction"
[Data.Aeson.String $ H.toText rawTx]
case zebraRes of
Left e1 ->
finalizeOperation pool opkey' Failed $
T.pack $ show e1
Right txId ->
finalizeOperation pool opkey' Successful $
"Tx ID: " <> H.toText txId
return $ SendResponse (callId req) opid
Nothing ->
return $
ErrorResponse
(callId req)
(-32006)
"Account does not exist."
_anyOtherParams ->
return $ ErrorResponse (callId req) (-32602) "Invalid params"
authenticate :: Config -> BasicAuthCheck Bool
authenticate config = BasicAuthCheck check
where
check (BasicAuthData username password) =
if username == c_zenithUser config && password == c_zenithPwd config
then return $ Authorized True
else return Unauthorized
packRpcResponse :: ToJSON a => T.Text -> a -> Value
packRpcResponse i x =
object ["jsonrpc" .= ("2.0" :: String), "id" .= i, "result" .= x]
scanZebra :: T.Text -> T.Text -> Int -> ZcashNet -> IO ()
scanZebra dbPath zHost zPort net = do
bStatus <- checkBlockChain zHost zPort
pool <- runNoLoggingT $ initPool dbPath
b <- getMinBirthdayHeight pool $ ZcashNetDB net
dbBlock <- getMaxBlock pool $ ZcashNetDB net
chkBlock <- checkIntegrity dbPath zHost zPort net dbBlock 1
syncChk <- isSyncing pool
unless syncChk $ do
let sb =
if chkBlock == dbBlock
then max dbBlock b
else max chkBlock b
unless (chkBlock == dbBlock || chkBlock == 1) $
runNoLoggingT $ rewindWalletData pool sb $ ZcashNetDB net
unless (sb > zgb_blocks bStatus || sb < 1) $ do
let bList = [(sb + 1) .. (zgb_blocks bStatus)]
unless (null bList) $ do
_ <- startSync pool
mapM_ (processBlock pool) bList
confUp <- try $ updateConfs zHost zPort pool :: IO (Either IOError ())
case confUp of
Left _e0 -> do
_ <- completeSync pool Failed
return ()
Right _ -> do
wals <- getWallets pool net
_ <-
runNoLoggingT $
updateCommitmentTrees pool zHost zPort $ ZcashNetDB net
runNoLoggingT $
mapM_
(syncWallet (Config dbPath zHost zPort "user" "pwd" 8080))
wals
_ <- completeSync pool Successful
return ()
where
processBlock :: ConnectionPool -> Int -> IO ()
processBlock pool bl = do
r <-
makeZebraCall
zHost
zPort
"getblock"
[Data.Aeson.String $ T.pack (show bl), jsonNumber 1]
case r of
Left _ -> completeSync pool Failed
Right blk -> do
r2 <-
makeZebraCall
zHost
zPort
"getblock"
[Data.Aeson.String $ T.pack (show bl), jsonNumber 0]
case r2 of
Left _ -> completeSync pool Failed
Right hb -> do
let blockTime = getBlockTime hb
bi <-
saveBlock pool $
ZcashBlock
(fromIntegral $ bl_height blk)
(HexStringDB $ bl_hash blk)
(fromIntegral $ bl_confirmations blk)
blockTime
(ZcashNetDB net)
mapM_ (processTx zHost zPort bi pool) $ bl_txs blk

View file

@ -1,274 +0,0 @@
{-# LANGUAGE OverloadedStrings #-}
module Zenith.Scanner where
import Control.Concurrent.Async (concurrently_, withAsync)
import Control.Exception (throwIO, try)
import Control.Monad (when)
import Control.Monad.IO.Class (liftIO)
import Control.Monad.Logger
( NoLoggingT
, logErrorN
, logInfoN
, runNoLoggingT
, runStderrLoggingT
)
import Data.Aeson
import Data.HexString
import qualified Data.Text as T
import Data.Time (getCurrentTime)
import Database.Persist.Sqlite
import System.Console.AsciiProgress
import ZcashHaskell.Types
( BlockResponse(..)
, RawZebraTx(..)
, Transaction(..)
, ZcashNet(..)
, ZebraGetBlockChainInfo(..)
, ZebraTxResponse(..)
, fromRawOBundle
, fromRawSBundle
, fromRawTBundle
)
import ZcashHaskell.Utils (getBlockTime, makeZebraCall, readZebraTransaction)
import Zenith.Core (checkBlockChain, syncWallet, updateCommitmentTrees)
import Zenith.DB
( ZcashBlock(..)
, ZcashBlockId
, clearWalletData
, clearWalletTransactions
, completeSync
, getBlock
, getMaxBlock
, getMinBirthdayHeight
, getUnconfirmedBlocks
, getWallets
, initDb
, initPool
, saveBlock
, saveConfs
, saveTransaction
, startSync
, updateWalletSync
, upgradeQrTable
)
import Zenith.Types
( Config(..)
, HexStringDB(..)
, ZcashNetDB(..)
, ZenithStatus(..)
)
import Zenith.Utils (jsonNumber)
-- | Function to scan the Zcash blockchain through the Zebra node and populate the Zenith database
rescanZebra ::
T.Text -- ^ Host
-> Int -- ^ Port
-> T.Text -- ^ Path to database file
-> IO ()
rescanZebra host port dbFilePath = do
bc <-
try $ checkBlockChain host port :: IO
(Either IOError ZebraGetBlockChainInfo)
case bc of
Left e -> print e
Right bStatus -> do
let znet = ZcashNetDB $ zgb_net bStatus
pool1 <- runNoLoggingT $ initPool dbFilePath
{-pool2 <- runNoLoggingT $ initPool dbFilePath-}
{-pool3 <- runNoLoggingT $ initPool dbFilePath-}
_ <- initDb dbFilePath
upgradeQrTable pool1
clearWalletTransactions pool1
clearWalletData pool1
_ <- startSync pool1
dbBlock <- getMaxBlock pool1 znet
b <- liftIO $ getMinBirthdayHeight pool1 znet
let sb = max dbBlock b
if sb > zgb_blocks bStatus || sb < 1
then liftIO $ throwIO $ userError "Invalid starting block for scan"
else do
print $
"Scanning from " ++ show sb ++ " to " ++ show (zgb_blocks bStatus)
let bList = [sb .. (zgb_blocks bStatus)]
{-
let batch = length bList `div` 3
let bl1 = take batch bList
let bl2 = take batch $ drop batch bList
let bl3 = drop (2 * batch) bList
-}
_ <-
displayConsoleRegions $ do
pg1 <- newProgressBar def {pgTotal = fromIntegral $ length bList}
{-pg2 <- newProgressBar def {pgTotal = fromIntegral $ length bl2}-}
{-pg3 <- newProgressBar def {pgTotal = fromIntegral $ length bl3}-}
mapM_ (processBlock host port pool1 pg1 znet) bList
{-`concurrently_`-}
{-mapM_ (processBlock host port pool2 pg2 znet) bl2 `concurrently_`-}
{-mapM_ (processBlock host port pool3 pg3 znet) bl3-}
print "Please wait..."
_ <- completeSync pool1 Successful
_ <- runNoLoggingT $ updateCommitmentTrees pool1 host port znet
print "Rescan complete"
-- | 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
-> ZcashNetDB -- ^ the network
-> Int -- ^ The block number to process
-> IO ()
processBlock host port pool pg net b = do
r <-
liftIO $
makeZebraCall
host
port
"getblock"
[Data.Aeson.String $ T.pack $ show b, jsonNumber 1]
case r of
Left e -> do
_ <- completeSync pool Failed
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 -> do
_ <- completeSync pool Failed
liftIO $ throwIO $ userError e2
Right hb -> do
let blockTime = getBlockTime hb
bi <-
saveBlock pool $
ZcashBlock
(fromIntegral $ bl_height blk)
(HexStringDB $ bl_hash blk)
(fromIntegral $ bl_confirmations blk)
blockTime
net
mapM_ (processTx host port bi pool) $ bl_txs blk
liftIO $ tick pg
-- | Function to process a raw transaction
processTx ::
T.Text -- ^ Host name for `zebrad`
-> Int -- ^ Port for `zebrad`
-> ZcashBlockId -- ^ Block ID
-> ConnectionPool -- ^ DB file path
-> HexString -- ^ transaction id
-> 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 -> do
_ <- completeSync pool Failed
liftIO $ throwIO $ userError e
Right rawTx -> do
case readZebraTransaction (ztr_hex rawTx) of
Nothing -> return ()
Just rzt -> do
_ <-
runNoLoggingT $
saveTransaction pool bt $
Transaction
t
(ztr_blockheight rawTx)
(ztr_conf rawTx)
(fromIntegral $ zt_expiry rzt)
(fromRawTBundle $ zt_tBundle rzt)
(fromRawSBundle $ zt_sBundle rzt)
(fromRawOBundle $ zt_oBundle rzt)
return ()
-- | Function to update unconfirmed transactions
updateConfs ::
T.Text -- ^ Host name for `zebrad`
-> Int -- ^ Port for `zebrad`
-> ConnectionPool
-> IO ()
updateConfs host port pool = do
targetBlocks <- getUnconfirmedBlocks pool
mapM_ updateTx targetBlocks
where
updateTx :: Int -> IO ()
updateTx b = do
r <-
makeZebraCall
host
port
"getblock"
[Data.Aeson.String $ T.pack $ show b, jsonNumber 1]
case r of
Left e -> throwIO $ userError e
Right blk -> do
saveConfs pool b $ fromInteger $ bl_confirmations blk
clearSync :: Config -> IO ()
clearSync config = do
let zHost = c_zebraHost config
let zPort = c_zebraPort config
let dbPath = c_dbPath config
pool <- runNoLoggingT $ initPool dbPath
bc <-
try $ checkBlockChain zHost zPort :: IO
(Either IOError ZebraGetBlockChainInfo)
case bc of
Left e1 -> throwIO e1
Right chainInfo -> do
x <- initDb dbPath
_ <- upgradeQrTable pool
case x of
Left e2 -> throwIO $ userError e2
Right x' -> do
when x' $ rescanZebra zHost zPort dbPath
_ <- clearWalletTransactions pool
w <- getWallets pool $ zgb_net chainInfo
liftIO $ mapM_ (updateWalletSync pool 0 . entityKey) w
w' <- liftIO $ getWallets pool $ zgb_net chainInfo
r <- runNoLoggingT $ mapM (syncWallet config) w'
liftIO $ print r
-- | Detect chain re-orgs
checkIntegrity ::
T.Text -- ^ Database path
-> T.Text -- ^ Zebra host
-> Int -- ^ Zebra port
-> ZcashNet -- ^ the network to scan
-> Int -- ^ The block to start the check
-> Int -- ^ depth
-> IO Int
checkIntegrity dbP zHost zPort znet b d =
if b < 1
then return 1
else do
r <-
makeZebraCall
zHost
zPort
"getblock"
[Data.Aeson.String $ T.pack $ show b, jsonNumber 1]
case r of
Left e -> throwIO $ userError e
Right blk -> do
pool <- runNoLoggingT $ initPool dbP
dbBlk <- getBlock pool b $ ZcashNetDB znet
case dbBlk of
Nothing -> return 1
Just dbBlk' ->
if bl_hash blk == getHex (zcashBlockHash $ entityVal dbBlk')
then return b
else checkIntegrity dbP zHost zPort znet (b - 5 * d) (d + 1)

View file

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

View file

@ -1,509 +0,0 @@
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE GeneralisedNewtypeDeriving #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE StandaloneDeriving #-}
module Zenith.Types where
import Data.Aeson
import Data.Aeson.TH (deriveJSON)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Base64 as B64
import qualified Data.ByteString.Char8 as C
import Data.HexString
import Data.Int (Int64)
import Data.Maybe (fromMaybe)
import Data.Scientific (Scientific)
import qualified Data.Text as T
import qualified Data.Text.Encoding as E
import Data.Text.Encoding.Error (lenientDecode)
import qualified Data.UUID as U
import Database.Persist.TH
import GHC.Generics
import ZcashHaskell.Orchard (encodeUnifiedAddress, parseAddress)
import ZcashHaskell.Sapling (encodeSaplingAddress)
import ZcashHaskell.Transparent
( encodeExchangeAddress
, encodeTransparentReceiver
)
import ZcashHaskell.Types
( ExchangeAddress(..)
, OrchardSpendingKey(..)
, Phrase(..)
, Rseed(..)
, SaplingAddress(..)
, SaplingSpendingKey(..)
, Scope(..)
, TransparentAddress(..)
, TransparentSpendingKey
, ValidAddress(..)
, 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)
instance ToJSON ZcashNetDB where
toJSON (ZcashNetDB z) = toJSON z
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
, c_zenithUser :: !BS.ByteString
, c_zenithPwd :: !BS.ByteString
, c_zenithPort :: !Int
} deriving (Eq, Prelude.Show)
data ZcashPool
= TransparentPool
| SproutPool
| SaplingPool
| OrchardPool
deriving (Show, Read, Eq)
derivePersistField "ZcashPool"
instance ToJSON ZcashPool where
toJSON zp =
case zp of
TransparentPool -> Data.Aeson.String "p2pkh"
SproutPool -> Data.Aeson.String "sprout"
SaplingPool -> Data.Aeson.String "sapling"
OrchardPool -> Data.Aeson.String "orchard"
instance FromJSON ZcashPool where
parseJSON =
withText "ZcashPool" $ \case
"p2pkh" -> return TransparentPool
"sprout" -> return SproutPool
"sapling" -> return SaplingPool
"orchard" -> return OrchardPool
_ -> fail "Not a known Zcash pool"
newtype ZenithUuid = ZenithUuid
{ getUuid :: U.UUID
} deriving newtype (Show, Eq, Read, ToJSON, FromJSON)
derivePersistField "ZenithUuid"
-- ** API types
data ZcashWalletAPI = ZcashWalletAPI
{ zw_index :: !Int
, zw_name :: !T.Text
, zw_network :: !ZcashNet
, zw_birthday :: !Int
, zw_lastSync :: !Int
} deriving (Eq, Prelude.Show)
$(deriveJSON defaultOptions {fieldLabelModifier = drop 3} ''ZcashWalletAPI)
data ZcashAccountAPI = ZcashAccountAPI
{ za_index :: !Int
, za_wallet :: !Int
, za_name :: !T.Text
} deriving (Eq, Prelude.Show)
$(deriveJSON defaultOptions {fieldLabelModifier = drop 3} ''ZcashAccountAPI)
data ZcashAddressAPI = ZcashAddressAPI
{ zd_index :: !Int
, zd_account :: !Int
, zd_name :: !T.Text
, zd_ua :: !T.Text
, zd_legacy :: !(Maybe T.Text)
, zd_transparent :: !(Maybe T.Text)
} deriving (Eq, Prelude.Show)
$(deriveJSON defaultOptions {fieldLabelModifier = drop 3} ''ZcashAddressAPI)
data ZcashNoteAPI = ZcashNoteAPI
{ zn_txid :: !HexString
, zn_pool :: !ZcashPool
, zn_amount :: !Float
, zn_amountZats :: !Int64
, zn_memo :: !T.Text
, zn_confirmed :: !Bool
, zn_blockheight :: !Int
, zn_blocktime :: !Int
, zn_outindex :: !Int
, zn_change :: !Bool
} deriving (Eq, Prelude.Show)
$(deriveJSON defaultOptions {fieldLabelModifier = drop 3} ''ZcashNoteAPI)
data AccountBalance = AccountBalance
{ acb_transparent :: !Int64
, acb_sapling :: !Int64
, acb_orchard :: !Int64
} deriving (Eq, Prelude.Show)
$(deriveJSON defaultOptions {fieldLabelModifier = drop 4} ''AccountBalance)
data ZenithStatus
= Processing
| Failed
| Successful
deriving (Eq, Prelude.Show, Read)
$(deriveJSON defaultOptions ''ZenithStatus)
derivePersistField "ZenithStatus"
data PrivacyPolicy
= None
| Low
| Medium
| Full
deriving (Eq, Show, Read, Ord)
$(deriveJSON defaultOptions ''PrivacyPolicy)
newtype ValidAddressAPI = ValidAddressAPI
{ getVA :: ValidAddress
} deriving newtype (Eq, Show)
instance ToJSON ValidAddressAPI where
toJSON (ValidAddressAPI va) =
case va of
Unified ua -> Data.Aeson.String $ encodeUnifiedAddress ua
Sapling sa ->
maybe
Data.Aeson.Null
Data.Aeson.String
(encodeSaplingAddress (net_type sa) (sa_receiver sa))
Transparent ta ->
Data.Aeson.String $
encodeTransparentReceiver (ta_network ta) (ta_receiver ta)
Exchange ea ->
maybe
Data.Aeson.Null
Data.Aeson.String
(encodeExchangeAddress (ex_network ea) (ex_address ea))
data ProposedNote = ProposedNote
{ pn_addr :: !ValidAddressAPI
, pn_amt :: !Scientific
, pn_memo :: !(Maybe T.Text)
} deriving (Eq, Prelude.Show)
instance FromJSON ProposedNote where
parseJSON =
withObject "ProposedNote" $ \obj -> do
a <- obj .: "address"
n <- obj .: "amount"
m <- obj .:? "memo"
case parseAddress (E.encodeUtf8 a) of
Nothing -> fail "Invalid address"
Just a' ->
if n > 0 && n < 21000000
then pure $ ProposedNote (ValidAddressAPI a') n m
else fail "Invalid amount"
instance ToJSON ProposedNote where
toJSON (ProposedNote a n m) =
object ["address" .= a, "amount" .= n, "memo" .= m]
data ShieldDeshieldOp
= Shield
| Deshield
deriving (Eq, Show, Read, Ord)
-- ** `zebrad`
-- | Type for modeling the tree state response
data ZebraTreeInfo = ZebraTreeInfo
{ 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 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 [TransparentPool] 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 [SaplingPool] 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"

View file

@ -1,250 +0,0 @@
{-# LANGUAGE OverloadedStrings #-}
module Zenith.Utils where
import Data.Aeson
import Data.Char (isAlphaNum, isSpace)
import Data.Functor (void)
import Data.Maybe
import Data.Ord (clamp)
import Data.Scientific (Scientific(..), scientific)
import qualified Data.Text as T
import qualified Data.Text.Encoding as E
import System.Directory
import System.Process (createProcess_, shell)
import Text.Regex.Posix
import ZcashHaskell.Orchard
( encodeUnifiedAddress
, isValidUnifiedAddress
, parseAddress
)
import ZcashHaskell.Sapling (decodeSaplingAddress, isValidShieldedAddress)
import ZcashHaskell.Transparent
( decodeExchangeAddress
, decodeTransparentAddress
)
import ZcashHaskell.Types
( ExchangeAddress(..)
, SaplingAddress(..)
, TransparentAddress(..)
, UnifiedAddress(..)
, ValidAddress(..)
, ZcashNet(..)
)
import ZcashHaskell.Utils (makeZebraCall)
import Zenith.Types
( AddressGroup(..)
, PrivacyPolicy(..)
, 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"
displayAmount :: ZcashNet -> Integer -> T.Text
displayAmount n a =
if n == MainNet
then T.pack $ displayZec a
else T.pack $ displayTaz a
-- | Helper function to display abbreviated Unified Address
showAddress :: UnifiedAddressDB -> T.Text
showAddress u = T.take 20 t <> "..."
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 TransparentPool
| sReg && chkS = Just SaplingPool
| uReg && chk = Just OrchardPool
| 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
-- | Return True if Address is valid
validateAddressBool :: T.Text -> Bool
validateAddressBool a = do
case (validateAddress a) of
Nothing -> False
_ -> True
-- | Copy an address to the clipboard
copyAddress :: ZcashAddress -> IO ()
copyAddress a =
void $
createProcess_ "toClipboard" $
shell $ "echo " ++ T.unpack (addy a) ++ " | xclip -r -selection clipboard"
-- | Get current user and build zenith path
getZenithPath :: IO String
getZenithPath = do
homeDirectory <- getHomeDirectory
return (homeDirectory ++ "/Zenith/")
-- | Bound a value to the 0..1 range, used for progress reporting on UIs
validBarValue :: Float -> Float
validBarValue = clamp (0, 1)
isRecipientValid :: T.Text -> Bool
isRecipientValid a = do
case isValidUnifiedAddress (E.encodeUtf8 a) of
Just _a1 -> True
Nothing ->
isValidShieldedAddress (E.encodeUtf8 a) ||
(case decodeTransparentAddress (E.encodeUtf8 a) of
Just _a3 -> True
Nothing ->
case decodeExchangeAddress (E.encodeUtf8 a) of
Just _a4 -> True
Nothing -> False)
isUnifiedAddressValid :: T.Text -> Bool
isUnifiedAddressValid ua =
case isValidUnifiedAddress (E.encodeUtf8 ua) of
Just _a1 -> True
Nothing -> False
isSaplingAddressValid :: T.Text -> Bool
isSaplingAddressValid sa = isValidShieldedAddress (E.encodeUtf8 sa)
isTransparentAddressValid :: T.Text -> Bool
isTransparentAddressValid ta =
case decodeTransparentAddress (E.encodeUtf8 ta) of
Just _a3 -> True
Nothing -> False
isExchangeAddressValid :: T.Text -> Bool
isExchangeAddressValid xa =
case decodeExchangeAddress (E.encodeUtf8 xa) of
Just _a4 -> True
Nothing -> False
isRecipientValidGUI :: PrivacyPolicy -> T.Text -> Bool
isRecipientValidGUI p a = do
let adr = parseAddress (E.encodeUtf8 a)
case p of
Full ->
case adr of
Just a ->
case a of
Unified ua -> True
Sapling sa -> True
_ -> False
Nothing -> False
Medium ->
case adr of
Just a ->
case a of
Unified ua -> True
Sapling sa -> True
_ -> False
Nothing -> False
Low ->
case adr of
Just a ->
case a of
Unified ua -> True
Sapling sa -> True
Transparent ta -> True
_ -> False
Nothing -> False
None ->
case adr of
Just a ->
case a of
Transparent ta -> True
Exchange ea -> True
_ -> False
Nothing -> False
isZecAddressValid :: T.Text -> Bool
isZecAddressValid a = do
case isValidUnifiedAddress (E.encodeUtf8 a) of
Just _a1 -> True
Nothing ->
isValidShieldedAddress (E.encodeUtf8 a) ||
(case decodeTransparentAddress (E.encodeUtf8 a) of
Just _a3 -> True
Nothing ->
case decodeExchangeAddress (E.encodeUtf8 a) of
Just _a4 -> True
Nothing -> False)
parseAddressUA :: T.Text -> ZcashNet -> Maybe UnifiedAddress
parseAddressUA a znet =
case isValidUnifiedAddress (E.encodeUtf8 a) of
Just a1 -> Just a1
Nothing ->
case decodeSaplingAddress (E.encodeUtf8 a) of
Just a2 ->
Just $ UnifiedAddress znet Nothing (Just $ sa_receiver a2) Nothing
Nothing ->
case decodeTransparentAddress (E.encodeUtf8 a) of
Just a3 ->
Just $ UnifiedAddress znet Nothing Nothing (Just $ ta_receiver a3)
Nothing -> Nothing
isValidContent :: String -> Bool
isValidContent [] = False -- an empty string is invalid
isValidContent (x:xs)
| not (isAlphaNum x) = False -- string must start with an alphanumeric character
| otherwise = allValidChars xs -- process the rest of the string
where
allValidChars :: String -> Bool
allValidChars [] = True -- if we got here, string is valid
allValidChars (y:ys)
| isAlphaNum y || isSpace y = allValidChars ys -- char is valid, continue
| otherwise = False -- found an invalid character, return false
isValidString :: T.Text -> Bool
isValidString c = do
let a = T.unpack c
isValidContent a
padWithZero :: Int -> String -> String
padWithZero n s
| (length s) >= n = s
| otherwise = padWithZero n ("0" ++ s)
isEmpty :: [a] -> Bool
isEmpty [] = True
isEmpty _ = False
getChainTip :: T.Text -> Int -> IO Int
getChainTip zHost zPort = do
r <- makeZebraCall zHost zPort "getblockcount" []
case r of
Left e1 -> pure 0
Right i -> pure i

View file

@ -1,344 +0,0 @@
{-# 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 TransparentPool = "AllowRevealedRecipients"
| isNothing (account fromAddy) &&
elem TransparentPool (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 TransparentPool -> 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 ""

81
stack.yaml Normal file
View file

@ -0,0 +1,81 @@
# 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

77
stack.yaml.lock Normal file
View file

@ -0,0 +1,77 @@
# 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

View file

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

File diff suppressed because it is too large Load diff

@ -1 +0,0 @@
Subproject commit d45bd7dcf3c3cf4e893900a1774d24b14bf56591

File diff suppressed because it is too large Load diff

View file

@ -1,900 +0,0 @@
{
"openrpc": "1.0.0-rc1",
"info": {
"version": "0.7.0.0-beta",
"title": "Zenith RPC",
"description": "The RPC methods to interact with the Zenith Zcash wallet",
"license": {
"name": "MIT",
"url": "https://choosealicense.com/licenses/mit/"
}
},
"servers": [
{
"name": "Zenith RPC",
"summary": "The Zenith wallet RPC server",
"description": "This is the server that allows programmatic interaction with the Zenith Zcash wallet via RPC",
"url": "http://localhost:8234"
}
],
"methods": [
{
"name": "getinfo",
"summary": "Get basic Zenith information",
"description": "Get basic information about Zenith, such as the network it is running on and the version of Zebra it is connected to",
"tags": [],
"result" : {
"name": "Zenith information",
"schema": { "$ref": "#/components/schemas/ZenithInfo" }
},
"params" : [],
"examples": [
{
"name": "GetInfo example",
"summary": "Get information from Zenith",
"description": "Gets the status of the Zenith wallet server",
"params": [],
"result": {
"name": "GetInfo result",
"value": {
"version": "0.7.0.0-beta",
"network": "TestNet",
"zebraVersion": "v1.8.0"
}
}
}
],
"errors": [
{ "$ref": "#/components/errors/ZebraNotAvailable" }
]
},
{
"name": "listwallets",
"summary": "Get the list of available wallets",
"description": "Returns a list of available wallets per the network that the Zebra node is running on.",
"tags": [],
"result": {
"name": "Wallets",
"schema": {
"type": "array",
"items": {
"$ref": "#/components/schemas/ZcashWallet"
}
}
},
"params": [],
"examples": [
{
"name": "ListWallets example",
"summary": "Get list of wallets",
"description": "Get the list of wallets available in Zenith for the current network (Mainnet/Testnet)",
"params": [],
"result": {
"name": "ListWallets result",
"value": [
{
"birthday": 2762066,
"index": 1,
"lastSync": 2919374,
"name": "Main",
"network": "TestNet"
},
{
"birthday": 2798877,
"index": 2,
"lastSync": 2894652,
"name": "zcashd",
"network": "TestNet"
}
]
}
}
],
"errors": [
{ "$ref": "#/components/errors/ZebraNotAvailable" },
{ "$ref": "#/components/errors/NoWallets" }
]
},
{
"name": "getnewwallet",
"summary": "Create a new wallet",
"description": "Create a new wallet for Zenith.",
"tags": [],
"params": [
{ "$ref": "#/components/contentDescriptors/Name"}
],
"paramStructure": "by-position",
"result": {
"name": "Wallet",
"schema": {
"$ref": "#/components/contentDescriptors/WalletId"
}
},
"examples": [
{
"name": "GetNewWallet example",
"summary": "Create a wallet",
"description": "Creates a new wallet with the given name",
"params": [
{
"name": "Wallet name",
"summary": "The user-friendly name for the wallet",
"value": "Main"
}
],
"result": {
"name": "GetNewWallet result",
"value": 1
}
}
],
"errors": [
{ "$ref": "#/components/errors/ZebraNotAvailable" },
{ "$ref": "#/components/errors/ZenithBusy" },
{ "$ref": "#/components/errors/DuplicateName" }
]
},
{
"name": "listaccounts",
"summary": "List existing accounts for a wallet ID",
"description": "List existing accounts for the given wallet ID or provide an error if none",
"tags": [],
"result": {
"name": "Accounts",
"schema": {
"type": "array",
"items": {
"$ref": "#/components/schemas/ZcashAccount"
}
}
},
"params": [{ "$ref": "#/components/contentDescriptors/WalletId"}],
"paramStructure": "by-position",
"examples": [
{
"name": "ListAccounts example",
"summary": "Get list of accounts",
"description": "Get the list of accounts available in Zenith for the given wallet ID",
"params": [
{
"name": "walletId",
"summary": "The integer ID of the wallet to use",
"value": 1
}
],
"result": {
"name": "ListAccounts result",
"value": [
{
"index": 3,
"name": "Business",
"wallet": 1
},
{
"index": 1,
"name": "Savings",
"wallet": 1
}
]
}
}
],
"errors": [
{ "$ref": "#/components/errors/ZebraNotAvailable" },
{ "$ref": "#/components/errors/NoAccounts" }
]
},
{
"name": "getnewaccount",
"summary": "Create a new account",
"description": "Create a new account in the given wallet.",
"tags": [],
"params": [
{ "$ref": "#/components/contentDescriptors/Name"},
{ "$ref": "#/components/contentDescriptors/WalletId"}
],
"paramStructure": "by-position",
"result": {
"name": "Account",
"schema": {
"$ref": "#/components/contentDescriptors/AccountId"
}
},
"examples": [
{
"name": "GetNewAccount example",
"summary": "Create an account",
"description": "Creates a new account with the given name",
"params": [
{
"name": "Account name",
"summary": "The user-friendly name for the Account",
"value": "Personal"
},
{
"name": "Wallet Id",
"summary": "The internal index of the Wallet to use",
"value": 1
}
],
"result": {
"name": "GetNewAccount result",
"value": 1
}
}
],
"errors": [
{ "$ref": "#/components/errors/ZebraNotAvailable" },
{ "$ref": "#/components/errors/DuplicateName" },
{ "$ref": "#/components/errors/ZenithBusy" },
{ "$ref": "#/components/errors/InvalidWallet" }
]
},
{
"name": "listaddresses",
"summary": "List existing addresses for an account ID",
"description": "List existing addresses for the given account ID or provide an error if none",
"tags": [],
"result": {
"name": "Addresses",
"schema": {
"type": "array",
"items": {
"$ref": "#/components/schemas/ZcashAddress"
}
}
},
"params": [{ "$ref": "#/components/contentDescriptors/AccountId"}],
"paramStructure": "by-position",
"examples": [
{
"name": "ListAddresses example",
"summary": "Get list of addresses",
"description": "Get the list of addresses available in Zenith for the given account ID",
"params": [
{
"name": "accountId",
"summary": "The integer ID of the account to use",
"value": 1
}
],
"result": {
"name": "ListAddresses result",
"value": [
{
"index": 3,
"account": 1,
"name": "Clothes",
"ua": "utest13dq4u4dnf3yddw8lq2n6zdclshra6xsp8zgkc5ydyu6k20zrsscmuex46qa4vh84rgd78sqnlleapznnz7mnzx9wv0unts8pv32paj8se5ca3kves2u4a89uy6e8cf4hnarxydxh7hq2e9uu39punfmm53k5h45xn9k3dx35la8j7munh9td7774m8gkqgc4mn40t69w20uu2gtks7a",
"legacy": "ztestsapling188csdsvhdny25am8ume03qr2026hdy03zpg5pq7jmmfxtxtct0e93p0rg80yfxvynqd4gwlwft5",
"transparent": "tmMouLwVfRYrF91fWjDJToivmsTWBhxfX4E"
},
{
"index": 2,
"account": 1,
"name": "Vacation",
"ua": "utest1hhggl4nxfdx63evps6r7qz50cgacgtdpt9k7dl0734w63zn5qmrp6c2xdv9rkqyfkj6kgau4kz48xtm80e67l534qp02teqq86zuzetxql6z5v32yglg9n2un5zsu0hwcvaunzdfg5qnry6syh2dh9x8eu27de03j9pjfvrqda6acgtc6f0emdfh6r5jvfanmjml4ms5wwj9wfqmamq",
"legacy": "ztestsapling1mpup3xv2k9clxaf9wjcr0dt5gnmkprz9s9qsn298mqs356pf39wmh30q3pgsp0w5vyrmj6mrzw2",
"transparent": "tmX8qCB96Dq49YZkww3bSty7eZDA4Fq6F4R"
}
]
}
}
],
"errors": [
{ "$ref": "#/components/errors/NoAddress" }
]
},
{
"name": "getnewaddress",
"summary": "Add a new address",
"description": "Derive a new address in the given account.",
"tags": [],
"params": [
{ "$ref": "#/components/contentDescriptors/AccountId"},
{ "$ref": "#/components/contentDescriptors/Name"},
{ "$ref": "#/components/contentDescriptors/ExcludeSapling"},
{ "$ref": "#/components/contentDescriptors/ExcludeTransparent"}
],
"result": {
"name": "Address",
"schema": {
"$ref": "#/components/schemas/ZcashAddress"
}
},
"examples": [
{
"name": "GetNewAddress example",
"summary": "Get a new address for the given account",
"description": "Get a new address for the given account with an Orchard receiver, a Sapling receiver and a transparent receiver (default)",
"params": [
{
"name": "Account Id",
"summary": "The account index",
"value": 1
},
{
"name": "Name",
"summary": "User-friendly name for the address",
"value": "AllRecvs"
}
],
"result":
{
"name": "Default receivers",
"value": {
"index": 14,
"account": 1,
"name": "AllRecvs",
"ua": "utest1as2fhusjt5r7xl8963jnkkums6gue6qvu7fpw2cvrctwnwrku9r4av9zmmjt7mmet927cq9z4z0hq2w7tpm7qa8lzl5fyj6d83un6v3q78c76j7thpuzyzr260apm8xvjua5fvmrfzy59mpurec7tfamp6nd6eq95pe8vzm69hfsfea29u4v3a6lyuaah20c4k6rvf9skz35ct2r54z",
"legacy": "ztestsapling1esn0wamf8w3nz2juwryscc3l8e5xtll6aewx0r2h5xtmrpnzsw2k23lec65agn8v59r72v2krrh",
"transparent": "tmMteg5HxFnmn4mbm2UNEGzWgLX16bGLg16"
}
}
},
{
"name": "GetNewAddress - no transparent",
"summary": "Get a new address for the given account with no transparent receiver",
"description": "Get a new address for the given account with an Orchard receiver, a Sapling receiver and *no* transparent receiver (default)",
"params": [
{
"name": "Account Id",
"summary": "The account index",
"value": 1
},
{
"name": "Name",
"summary": "User-friendly name for the address",
"value": "NoTransparent"
},
{
"name": "ExcludeTransparent",
"summary": "Option to exclude transparent receivers from the address",
"value": "ExcludeTransparent"
}
],
"result":
{
"name": "NoTransparent",
"value": {
"index": 15,
"account": 1,
"name": "NoTransparent",
"ua": "utest1l0t3uzadaxa4jg7qatsfwqdvfp0qtedyyall65hm2nzwnwdmcvd7j4z6wdrftpsjxv8aw4qh0hka3wdqj0z48xrhg356dlapy36ug6tt20tkzavwccjfup8wy8sdkcc60rpf400mwek73n0ph9jyw9ae60rm5jt8rx75nzhyuymern2t",
"legacy": "ztestsapling1vp3kzw7rqldfvaw5edfgqq66qm0xnexmscwnys220403mqqh9uyl0sqsye37aelrese42y8ecnx",
"transparent": null
}
}
},
{
"name": "GetNewAddress - no Sapling",
"summary": "Get a new address for the given account with no Sapling receiver",
"description": "Get a new address for the given account with an Orchard receiver and a transparent receiver, and *no* Sapling receiver.",
"params": [
{
"name": "Account Id",
"summary": "The account index",
"value": 1
},
{
"name": "Name",
"summary": "User-friendly name for the address",
"value": "NoSapling"
},
{
"name": "ExcludeSapling",
"summary": "Option to exclude Sapling receivers from the address",
"value": "ExcludeSapling"
}
],
"result":
{
"name": "NoSapling",
"value": {
"index": 16,
"account": 3,
"name": "NoSapling",
"ua": "utest14yvw4msvn9r5nggv2s0yye8phqwrhsx8ddfvpg30zp4gtf928myaua8jwxssl7frr8eagvcrsa8tuu9dlh7cvksv3lkudvyrq2ysrtzate0dud7x0zhgz26wqccn8w7346v4kfagv3e",
"legacy": null,
"transparent": "tmQ7z6q46NLQXpeNkfeRL6wJwJWA4picf6b"
}
}
},
{
"name": "GetNewAddress - Orchard only",
"summary": "Get a new address for the given account with only an Orchard receiver",
"description": "Get a new address for the given account with an Orchard receiver and *no* transparent receiver, and *no* Sapling receiver.",
"params": [
{
"name": "Account Id",
"summary": "The account index",
"value": 1
},
{
"name": "Name",
"summary": "User-friendly name for the address",
"value": "OrchardOnly"
},
{
"name": "ExcludeSapling",
"summary": "Option to exclude Sapling receivers from the address",
"value": "ExcludeSapling"
},
{
"name": "ExcludeTransparent",
"summary": "Option to exclude transparent receivers from the address",
"value": "ExcludeTransparent"
}
],
"result":
{
"name": "OrchardOnly",
"value": {
"index": 17,
"account": 3,
"name": "OrchardOnly",
"ua": "utest1890l0xjxcsapk0u7jnqdglzwp04rt4r8zfvh7qx6a76fq96fyxg9xysvklwjymm9xuxzk0578pvv3yzv0w8l5x4run96mahky5defw0m",
"legacy": null,
"transparent": null
}
}
}
],
"errors": [
{ "$ref": "#/components/errors/InvalidAccount" },
{ "$ref": "#/components/errors/ZenithBusy" },
{ "$ref": "#/components/errors/DuplicateName" }
]
},
{
"name": "getbalance",
"summary": "Get the balance of the given account",
"description": "Get the balance of the given account, including any unconfirmed balance.",
"tags": [],
"params": [{ "$ref": "#/components/contentDescriptors/AccountId"}],
"result": {
"name": "Balance",
"schema": {
"type": "object",
"properties": {
"confirmed": {"$ref": "#/components/schemas/Balance" },
"unconfirmed": {"$ref": "#/components/schemas/Balance" }
}
}
},
"examples": [
{
"name": "GetBalance example",
"summary": "Get account balance",
"description": "Provides the balance for the current account, showing the balance for the transparent, Sapling and Orchard pools, both for confirmed notes and unconfirmed notes",
"params": [
{
"name": "accountId",
"summary": "The integer ID of the account to use",
"value": 1
}
],
"result": {
"name": "GetBalance result",
"value":{
"confirmed": {
"orchard": 22210259,
"sapling": 0,
"transparent": 0
},
"unconfirmed": {
"orchard": 0,
"sapling": 0,
"transparent": 0
}
}
}
}
],
"errors": [
{ "$ref": "#/components/errors/InvalidAccount" }
]
},
{
"name": "listreceived",
"summary": "List received transactions",
"description": "List transactions received by the given address.",
"tags": [],
"params": [{ "$ref": "#/components/contentDescriptors/Address"}],
"paramStructure": "by-position",
"result": {
"name": "Transactions",
"schema": {
"type": "array",
"items": {
"$ref": "#/components/schemas/ZcashNote"
}
}
},
"examples": [
{
"name": "ListReceived by Id",
"summary": "Get list of notes received by the address ID",
"description": "Provides the list of notes received by the address identified by the index provided as a parameter",
"params": [
{
"name": "Address index",
"summary": "The index for the address to use",
"value": "1"
}
],
"result": {
"name": "ListReceived by Id result",
"value": [
{
"txid": "987fcdb9bd37cbb5b205a8336de60d043f7028bebaa372828d81f3da296c7ef9",
"pool": "p2pkh",
"amount": 0.13773064,
"amountZats": 13773064,
"memo": "",
"confirmed": true,
"blockheight": 2767099,
"blocktime": 1711132723,
"outindex": 0,
"change": false
},
{
"txid": "186bdbc64f728c9d0be96082e946a9228153e24a70e20d8a82f0601da679e0c2",
"pool": "orchard",
"amount": 0.0005,
"amountZats": 50000,
"memo": "<22>",
"confirmed": true,
"blockheight": 2801820,
"blocktime": 1713399060,
"outindex": 0,
"change": false
}
]
}
},
{
"name": "ListReceived by Address",
"summary": "Get list of notes received by the address",
"description": "Provides the list of notes received by the address provided as a parameter",
"params": [
{
"name": "Address",
"summary": "The address to use",
"value": "ztestsapling1mpup3xv2k9clxaf9wjcr0dt5gnmkprz9s9qsn298mqs356pf39wmh30q3pgsp0w5vyrmj6mrzw2"
}
],
"result": {
"name": "ListReceived by Address result",
"value": [
{
"txid": "2a104393d72d1e62c94654950a92931e786a1f04aa732512597638b5c4a69a91",
"pool": "sapling",
"amount": 0.11447195,
"amountZats": 11447195,
"memo": "<22>",
"confirmed": true,
"blockheight": 2800319,
"blocktime": 1713301802,
"outindex": 0,
"change": false
}
]
}
}
],
"errors": [
{ "$ref": "#/components/errors/ZebraNotAvailable" },
{ "$ref": "#/components/errors/UnknownAddress" },
{ "$ref": "#/components/errors/InvalidAddress" }
]
},
{
"name": "sendmany",
"summary": "Send transaction(s)",
"description": "Send one transaction by specifying the source account, the privacy policy (optional, default 'Full') and an array of proposed outputs. Each output needs a recipient address, an amount and an optional shielded memo.",
"tags": [],
"params": [
{ "$ref": "#/components/contentDescriptors/AccountId"},
{ "$ref": "#/components/contentDescriptors/PrivacyPolicy"},
{ "$ref": "#/components/contentDescriptors/TxRequestArray"}
],
"paramStructure": "by-position",
"result": {
"name": "Operation ID(s)",
"schema": {
"type": "array",
"items": { "$ref": "#/components/contentDescriptors/OperationId"}
}
},
"examples": [
{
"name": "Send a transaction",
"summary": "Send a transaction",
"description": "Send a transaction with one output",
"params": [
{
"name": "Account index",
"summary": "The index for the account to use",
"value": "1"
},
{
"name": "Privacy Policy",
"summary": "The selected privacy policy",
"value": "Full"
},
{
"name": "Transaction request",
"summary": "The transaction to attempt",
"value": [
{
"address": "utest13dq4u4dnf3yddw8lq2n6zdclshra6xsp8zgkc5ydyu6k20zrsscmuex46qa4vh84rgd78sqnlleapznnz7mnzx9wv0unts8pv32paj8se5ca3kves2u4a89uy6e8cf4hnarxydxh7hq2e9uu39punfmm53k5h45xn9k3dx35la8j7munh9td7774m8gkqgc4mn40t69w20uu2gtks7a",
"amount": 2.45,
"memo": "Simple transaction"
}
]
}
],
"result": {
"name": "SendMany result",
"value": [
"3cc31c07-07cf-4a6e-9190-156c4b8c4088"
]
}
}
],
"errors": [
{ "$ref": "#/components/errors/ZebraNotAvailable" },
{ "$ref": "#/components/errors/ZenithBusy" },
{ "$ref": "#/components/errors/InvalidAccount" }
]
},
{
"name": "getoperationstatus",
"summary": "Get the status of a Zenith operation",
"description": "Get the status of the given operation",
"tags": [],
"params": [{ "$ref": "#/components/contentDescriptors/OperationId"}],
"paramStructure": "by-position",
"result": {
"name": "Operation",
"schema": {
"$ref": "#/components/schemas/Operation"
}
},
"errors": [
{ "$ref": "#/components/errors/OpNotFound" }
]
}
],
"components": {
"contentDescriptors": {
"WalletId": {
"name": "Wallet ID",
"summary": "The wallet's internal index used for unique identification",
"description": "An Integer value that uniquely identifies a wallet in Zenith",
"required": true,
"schema": {
"type": "integer"
}
},
"AccountId": {
"name": "Account ID",
"summary": "The account's internal index used for unique identification",
"description": "An Integer value that uniquely identifies an account in Zenith",
"required": true,
"schema": {
"type": "integer"
}
},
"Address": {
"name": "Address identifier",
"summary": "The address identifier",
"description": "A string that identifies a specific address, either by its index or the [ZIP-316](https://zips.z.cash/zip-0316) encoded address itself",
"required": true,
"schema": {
"type": "string"
}
},
"Name": {
"name": "Name",
"summary": "A user-friendly name",
"description": "A string that represents an entity in Zenith, like a wallet, an account or an address.",
"required": true,
"schema": {
"type": "string"
}
},
"ExcludeSapling": {
"name": "ExcludeSapling",
"summary": "Setting that indicates that the new address requested should not contain a Sapling component",
"description": "When this parameter is present, Zenith will generate an address with no Sapling receiver",
"required": false,
"schema" : {
"type": "string"
}
},
"ExcludeTransparent": {
"name": "ExcludeTransparent",
"summary": "Setting that indicates that the new address requested should not contain a Transparent component",
"description": "When this parameter is present, Zenith will generate an address with no Transparent receiver",
"required": false,
"schema" : {
"type": "string"
}
},
"OperationId": {
"name": "Operation ID",
"summary": "A unique identifier for Zenith operations",
"description": "A [UUID](http://en.wikipedia.org/wiki/UUID) assigned to an operation (like sending a transaction) that can be used to query Zenith to see the status and outcome of the operation.",
"required": true,
"schema" : {
"type": "string"
}
},
"TxRequestArray": {
"name": "Transaction Request Array",
"summary": "An array of proposed transactions",
"description": "An array of proposed new outgoing transactions, including the recipient's address, the amount in ZEC, the optional shielded memo, and the optional privacy level.",
"required": true,
"schema": {
"type": "array",
"items": { "$ref": "#/components/schemas/TxRequest"}
}
},
"PrivacyPolicy": {
"name": "Privacy Policy",
"summary": "The chosen privacy policy to use for the transaction",
"description": "The privacy policy to use for the transaction. `Full` policy allows shielded funds to be transferred within their shielded pools. `Medium` policy allows shielded funds to cross shielded pools. `Low` allows deshielding transactions into transparent receivers but not to exchange addresses. `None` allows for transparent funds to be spent to transparent addresses and exchange addresses.",
"required": false,
"schema": {
"type": "string",
"enum": ["None", "Low", "Medium", "Full"]
}
}
},
"schemas": {
"ZenithInfo": {
"type": "object",
"properties": {
"version": { "type": "string", "description": "Zenith's version"},
"network": { "type": "string", "description": "The network the wallet is connected to"},
"zebraVersion": { "type": "string", "description": "The version of the Zebra node used by Zenith"}
}
},
"ZcashWallet": {
"type": "object",
"properties": {
"index": { "type": "integer", "description": "Internal index of wallet"},
"name": { "type": "string", "description": "User-friendly name of the wallet" },
"network": { "type": "string", "description": "Network the wallet is for. Testnet or MainNet" },
"birthday": { "type": "integer", "description": "Wallet's birthday height" },
"lastSync": { "type": "integer", "description": "Last block the wallet is synced to" }
}
},
"ZcashAccount": {
"type": "object",
"properties": {
"index": { "type": "integer", "description": "Internal index for account"},
"wallet": { "type": "integer", "description": "ID of the wallet this account belongs to"},
"name": { "type": "string", "description": "User-friendly name of the account"}
}
},
"ZcashAddress": {
"type": "object",
"properties": {
"index": { "type": "integer", "description": "Internal index for address"},
"account": { "type": "integer", "description": "ID of the account this address belongs to"},
"name": { "type": "string", "description": "User-friendly name of the address"},
"ua": { "type": "string", "description": "Unified address"},
"legacy": { "type": "string", "description": "Legacy Sapling address"},
"transparent": { "type": "string", "description": "Transparent address"}
}
},
"ZcashNote": {
"type": "object",
"properties": {
"txid": { "type": "string", "description": "Transaction ID"},
"pool": { "type": "string", "description": "Orchard, Sapling, or Transparent" },
"amount" : { "type": "number", "description": "The amount of the note in ZEC"},
"amountZats": { "type": "integer", "description": "The amount of the note in zats"},
"memo": { "type": "string", "description": "The memo corresponding to the note, if any"},
"confirmed": { "type": "boolean", "description": "If the note is confirmed per the thresholds in the configuration"},
"blockheight": { "type": "integer", "description": "The block height containing the transaction"},
"blocktime": { "type": "integer", "description": "The transaction time in seconds since epoch"},
"outindex": { "type": "integer", "description": "The Sapling output index, or the Orchard action index"},
"change": { "type": "boolean", "description": "True if this output was received by a change address"}
}
},
"Balance": {
"type": "object",
"properties": {
"transparent": { "type": "integer", "description": "Confirmed transparent balance in zats." },
"sapling": { "type": "integer", "description": "Confirmed Sapling balance in zats." },
"orchard": { "type": "integer", "description": "Confirmed Orchard balance in zats." }
}
},
"Operation": {
"type": "object",
"properties": {
"uuid": {"type": "string", "description": "Operation Identifier"},
"start": {"type": "string", "description": "The date and time the operation started"},
"end": {"type": ["string", "null"], "description": "The date and time the operation ended. If the operation is still running, this field is null"},
"status": {"type": "string", "enum": ["Processing", "Failed", "Successful"], "description": "If the operation has started it will show Processing, once it completes it will show Failed or Successful depending on the outcome"},
"result": {"type": ["string", "null"], "description": "For a succesful transaction operation, the transaction ID. For failed operations, the error message. For pending operations, this field is null."}
}
},
"TxRequest": {
"type": "object",
"properties": {
"address": { "type": "string", "description": "Recipient's address (unified, Sapling or transparent)" },
"amount": { "type": "number", "description": "The amount to send in ZEC"},
"memo": { "type": "string", "description": "The shielded memo to include, if applicable"}
}
}
},
"examples": {},
"tags": {
"draft": {"name": "Draft"},
"wip": {"name": "WIP"}
},
"errors": {
"ZebraNotAvailable": {
"code": -32000,
"message": "Zebra not available"
},
"NoWallets": {
"code": -32001,
"message": "No wallets available. Please create one first"
},
"NoAccounts": {
"code": -32002,
"message": "No accounts available. Please create one first"
},
"NoAddress": {
"code": -32003,
"message": "No addresses available for this account. Please create one first"
},
"UnknownAddress": {
"code": -32004,
"message": "Address does not belong to the wallet"
},
"InvalidAddress": {
"code": -32005,
"message": "Unable to parse address"
},
"InvalidAccount": {
"code": -32006,
"message": "Account does not exist."
},
"DuplicateName": {
"code": -32007,
"message": "Entity with that name already exists."
},
"InvalidWallet": {
"code": -32008,
"message": "Wallet does not exist."
},
"OpNotFound": {
"code": -32009,
"message": "Operation ID not found."
},
"InternalError": {
"code": -32010,
"message": "Varies"
},
"InvalidRecipient": {
"code": -32011,
"message": "The provided recipient address is not valid."
},
"ZenithBusy": {
"code": -32012,
"message": "The Zenith server is syncing, please try again later."
}
}
}
}

View file

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

View file

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

Binary file not shown.

Before

Width:  |  Height:  |  Size: 7.7 MiB

Binary file not shown.

Before

Width:  |  Height:  |  Size: 329 KiB