Compare commits
No commits in common. "master" and "milestone2" have entirely different histories.
master
...
milestone2
22 changed files with 1245 additions and 8646 deletions
2
.gitmodules
vendored
2
.gitmodules
vendored
|
|
@ -1,4 +1,4 @@
|
|||
[submodule "zcash-haskell"]
|
||||
path = zcash-haskell
|
||||
url = https://git.vergara.tech/Vergara_Tech/zcash-haskell.git
|
||||
branch = master
|
||||
branch = milestone2
|
||||
|
|
|
|||
37
CHANGELOG.md
37
CHANGELOG.md
|
|
@ -5,43 +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.1.0-beta]
|
||||
|
||||
### Changed
|
||||
|
||||
- Removed workaround to obtain block time
|
||||
|
||||
## [0.7.0.0-beta]
|
||||
|
||||
### Added
|
||||
|
||||
- RPC module
|
||||
- OpenRPC specification
|
||||
- `listwallets` RPC method
|
||||
- `listaccounts` RPC method
|
||||
- `listaddresses` RPC method
|
||||
- `listreceived` RPC method
|
||||
- `getbalance` RPC method
|
||||
- `getnewwallet` RPC method
|
||||
- `getnewaccount` RPC method
|
||||
- `getnewaddress` RPC method
|
||||
- `getoperationstatus` RPC method
|
||||
- `sendmany` RPC method
|
||||
- Function `prepareTxV2` implementing `PrivacyPolicy`
|
||||
- Support for TEX addresses
|
||||
- Functionality to shield transparent balance
|
||||
- Functionality to de-shield shielded notes
|
||||
- Native commitment trees
|
||||
- Batch append to trees in O(log n)
|
||||
|
||||
### Changed
|
||||
|
||||
- Detection of changes in database schema for automatic re-scan
|
||||
- Block tracking for chain re-org detection
|
||||
- Refactored `ZcashPool`
|
||||
- Preventing write operations to occur during wallet sync
|
||||
|
||||
|
||||
## [0.6.0.0-beta]
|
||||
|
||||
### Added
|
||||
|
|
|
|||
17
app/Main.hs
17
app/Main.hs
|
|
@ -19,8 +19,8 @@ import System.IO
|
|||
import Text.Read (readMaybe)
|
||||
import ZcashHaskell.Types
|
||||
import Zenith.CLI
|
||||
import Zenith.Core (clearSync, testSync)
|
||||
import Zenith.GUI (runZenithGUI)
|
||||
import Zenith.Scanner (clearSync, rescanZebra)
|
||||
import Zenith.Types (Config(..), ZcashAddress(..), ZcashPool(..), ZcashTx(..))
|
||||
import Zenith.Utils
|
||||
import Zenith.Zcashd
|
||||
|
|
@ -204,15 +204,12 @@ main :: IO ()
|
|||
main = do
|
||||
config <- load ["$(HOME)/Zenith/zenith.cfg"]
|
||||
args <- getArgs
|
||||
dbFileName <- require config "dbFileName"
|
||||
nodeUser <- require config "nodeUser"
|
||||
nodePwd <- require config "nodePwd"
|
||||
dbFilePath <- require config "dbFilePath"
|
||||
{-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 myConfig = Config dbFilePath zebraHost zebraPort
|
||||
if not (null args)
|
||||
then do
|
||||
case head args
|
||||
|
|
@ -229,8 +226,7 @@ main = do
|
|||
of
|
||||
"gui" -> runZenithGUI myConfig
|
||||
"tui" -> runZenithTUI myConfig
|
||||
"rescan" -> rescanZebra zebraHost zebraPort dbFilePath
|
||||
"resync" -> clearSync myConfig
|
||||
"rescan" -> clearSync myConfig
|
||||
_ -> printUsage
|
||||
else printUsage
|
||||
|
||||
|
|
@ -240,5 +236,4 @@ printUsage = do
|
|||
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)"
|
||||
|
|
|
|||
|
|
@ -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"
|
||||
|
|
@ -4,7 +4,7 @@ module ZenScan where
|
|||
|
||||
import Control.Monad.Logger (runNoLoggingT)
|
||||
import Data.Configurator
|
||||
import Zenith.Scanner (rescanZebra)
|
||||
import Zenith.Scanner (scanZebra)
|
||||
|
||||
main :: IO ()
|
||||
main = do
|
||||
|
|
|
|||
|
|
@ -9,18 +9,19 @@ constraints: any.Cabal ==3.10.3.0,
|
|||
any.OneTuple ==0.4.2,
|
||||
any.OpenGLRaw ==3.3.4.1,
|
||||
OpenGLRaw -osandroid +usegles2 +useglxgetprocaddress +usenativewindowslibraries,
|
||||
any.QuickCheck ==2.15.0.1,
|
||||
any.QuickCheck ==2.14.3,
|
||||
QuickCheck -old-random +templatehaskell,
|
||||
any.RSA ==2.4.1,
|
||||
any.SHA ==1.6.4.4,
|
||||
SHA -exe,
|
||||
any.StateVar ==1.2.2,
|
||||
any.X11 ==1.9.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.2,
|
||||
any.ansi-terminal ==1.1.1,
|
||||
ansi-terminal -example,
|
||||
any.ansi-terminal-types ==1.1,
|
||||
any.appar ==0.1.8,
|
||||
|
|
@ -38,11 +39,11 @@ constraints: any.Cabal ==3.10.3.0,
|
|||
attoparsec -developer,
|
||||
any.attoparsec-aeson ==2.2.2.0,
|
||||
any.authenticate-oauth ==1.7,
|
||||
any.auto-update ==0.2.4,
|
||||
any.auto-update ==0.2.1,
|
||||
any.base ==4.18.2.1,
|
||||
any.base-compat ==0.14.1,
|
||||
any.base-compat-batteries ==0.14.1,
|
||||
any.base-orphans ==0.9.3,
|
||||
any.base-compat ==0.14.0,
|
||||
any.base-compat-batteries ==0.14.0,
|
||||
any.base-orphans ==0.9.2,
|
||||
any.base16 ==1.0,
|
||||
any.base16-bytestring ==1.0.2.0,
|
||||
any.base58-bytestring ==0.1.0,
|
||||
|
|
@ -58,19 +59,18 @@ constraints: any.Cabal ==3.10.3.0,
|
|||
any.blaze-builder ==0.4.2.3,
|
||||
any.blaze-html ==0.9.2.0,
|
||||
any.blaze-markup ==0.8.3.0,
|
||||
any.boring ==0.2.2,
|
||||
boring +tagged,
|
||||
any.borsh ==0.3.0,
|
||||
any.brick ==2.6,
|
||||
any.brick ==2.4,
|
||||
brick -demos,
|
||||
any.bsb-http-chunked ==0.0.0.4,
|
||||
any.byteorder ==1.0.4,
|
||||
any.bytes ==0.17.4,
|
||||
any.bytes ==0.17.3,
|
||||
any.bytestring ==0.11.5.3,
|
||||
any.bytestring-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.11,
|
||||
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,
|
||||
|
|
@ -81,16 +81,15 @@ constraints: any.Cabal ==3.10.3.0,
|
|||
any.clock ==0.8.4,
|
||||
clock -llvm,
|
||||
any.colour ==2.3.6,
|
||||
any.comonad ==5.0.9,
|
||||
any.comonad ==5.0.8,
|
||||
comonad +containers +distributive +indexed-traversable,
|
||||
any.concurrent-output ==1.10.21,
|
||||
any.conduit ==1.3.6,
|
||||
any.conduit ==1.3.5,
|
||||
any.conduit-extra ==1.3.6,
|
||||
any.config-ini ==0.2.7.0,
|
||||
config-ini -enable-doctests,
|
||||
any.configurator ==0.3.0.0,
|
||||
configurator -developer,
|
||||
any.constraints ==0.14.2,
|
||||
any.containers ==0.6.7,
|
||||
any.contravariant ==1.5.5,
|
||||
contravariant +semigroups +statevar +tagged,
|
||||
|
|
@ -98,22 +97,22 @@ constraints: any.Cabal ==3.10.3.0,
|
|||
any.crypto-api ==0.13.3,
|
||||
crypto-api -all_cpolys,
|
||||
any.crypto-pubkey-types ==0.4.3,
|
||||
any.cryptohash-md5 ==0.11.101.0,
|
||||
any.cryptohash-sha1 ==0.11.101.0,
|
||||
any.crypton ==1.0.1,
|
||||
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.3,
|
||||
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.13,
|
||||
any.crypton-x509-validation ==1.6.12,
|
||||
any.cryptonite ==0.30,
|
||||
cryptonite -check_alignment +integer-gmp -old_toolchain_inliner +support_aesni +support_deepseq -support_pclmuldq +support_rdrand -support_sse +use_target_attributes,
|
||||
any.data-clist ==0.2,
|
||||
any.data-default ==0.8.0.0,
|
||||
any.data-default-class ==0.2.0.0,
|
||||
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,
|
||||
|
|
@ -125,12 +124,11 @@ constraints: any.Cabal ==3.10.3.0,
|
|||
any.easy-file ==0.2.5,
|
||||
any.entropy ==0.4.1.10,
|
||||
entropy -donotgetentropy,
|
||||
any.envy ==2.1.4.0,
|
||||
any.esqueleto ==3.5.13.1,
|
||||
any.envy ==2.1.3.0,
|
||||
any.esqueleto ==3.5.11.2,
|
||||
any.exceptions ==0.10.7,
|
||||
any.extra ==1.8,
|
||||
any.fast-logger ==3.2.5,
|
||||
any.file-embed ==0.0.16.0,
|
||||
any.extra ==1.7.16,
|
||||
any.fast-logger ==3.2.3,
|
||||
any.filepath ==1.4.300.1,
|
||||
any.fixed ==0.3,
|
||||
any.foreign-rust ==0.1.0,
|
||||
|
|
@ -138,6 +136,8 @@ constraints: any.Cabal ==3.10.3.0,
|
|||
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,
|
||||
|
|
@ -147,54 +147,48 @@ constraints: any.Cabal ==3.10.3.0,
|
|||
any.ghc-heap ==9.6.5,
|
||||
any.ghc-prim ==0.10.0,
|
||||
any.ghci ==9.6.5,
|
||||
any.half ==0.3.2,
|
||||
any.happy ==2.1.3,
|
||||
any.happy-lib ==2.1.3,
|
||||
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.2,
|
||||
any.haskell-lexer ==1.1.1,
|
||||
any.haskoin-core ==1.1.0,
|
||||
any.hexstring ==0.12.1.0,
|
||||
any.hourglass ==0.2.12,
|
||||
any.hpc ==0.6.2.0,
|
||||
any.hsc2hs ==0.68.10,
|
||||
hsc2hs -in-ghc-tree,
|
||||
any.hspec ==2.11.10,
|
||||
any.hspec-core ==2.11.10,
|
||||
any.hspec-discover ==2.11.10,
|
||||
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.4,
|
||||
any.http-conduit ==2.3.9.1,
|
||||
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.3.0,
|
||||
any.http-types ==0.12.4,
|
||||
any.http2 ==5.3.9,
|
||||
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.4,
|
||||
any.iproute ==1.7.15,
|
||||
any.invariant ==0.6.3,
|
||||
any.iproute ==1.7.12,
|
||||
any.kan-extensions ==5.2.6,
|
||||
any.language-c ==0.10.0,
|
||||
language-c +iecfpextension +usebytestrings,
|
||||
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.2.0,
|
||||
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.7.0,
|
||||
any.megaparsec ==9.6.1,
|
||||
megaparsec -dev,
|
||||
any.memory ==0.18.0,
|
||||
memory +support_bytestring +support_deepseq,
|
||||
|
|
@ -202,57 +196,47 @@ constraints: any.Cabal ==3.10.3.0,
|
|||
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.21.0,
|
||||
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.7.0,
|
||||
any.network ==3.2.1.0,
|
||||
network -devel,
|
||||
any.network-byte-order ==0.1.7,
|
||||
any.network-control ==0.1.3,
|
||||
any.network-info ==0.2.1,
|
||||
any.network-uri ==2.6.4.2,
|
||||
any.old-locale ==1.0.0.7,
|
||||
any.old-time ==1.1.0.4,
|
||||
any.optparse-applicative ==0.18.1.0,
|
||||
optparse-applicative +process,
|
||||
any.os-string ==2.0.7,
|
||||
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.3,
|
||||
any.persistent ==2.14.6.1,
|
||||
any.persistent-sqlite ==2.13.3.0,
|
||||
persistent-sqlite -build-sanity-exe +full-text-search +have-usleep +json1 -systemlib +uri-filenames -use-pkgconfig -use-stat3 +use-stat4,
|
||||
any.persistent-template ==2.12.0.0,
|
||||
any.pretty ==1.1.3.6,
|
||||
any.prettyprinter ==1.7.1,
|
||||
prettyprinter -buildreadme +text,
|
||||
any.prettyprinter-ansi-terminal ==1.1.3,
|
||||
any.primitive ==0.9.0.0,
|
||||
any.process ==1.6.19.0,
|
||||
any.profunctors ==5.6.2,
|
||||
any.psqueues ==0.2.8.0,
|
||||
any.pureMD5 ==2.1.4,
|
||||
pureMD5 -test,
|
||||
any.qrcode-core ==0.9.10,
|
||||
any.qrcode-juicypixels ==0.8.6,
|
||||
any.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.9,
|
||||
any.reflection ==2.1.8,
|
||||
reflection -slow +template-haskell,
|
||||
any.regex-base ==0.94.0.2,
|
||||
any.regex-compat ==0.95.2.1,
|
||||
|
|
@ -267,7 +251,7 @@ constraints: any.Cabal ==3.10.3.0,
|
|||
scientific -integer-simple,
|
||||
any.sdl2 ==2.5.5.0,
|
||||
sdl2 -examples -no-linear -opengl-example +pkgconfig +recent-ish,
|
||||
any.secp256k1-haskell ==1.4.2,
|
||||
any.secp256k1-haskell ==1.2.0,
|
||||
any.semialign ==1.3.1,
|
||||
semialign +semigroupoids,
|
||||
any.semigroupoids ==6.0.1,
|
||||
|
|
@ -276,15 +260,8 @@ constraints: any.Cabal ==3.10.3.0,
|
|||
semigroups +binary +bytestring -bytestring-builder +containers +deepseq +hashable +tagged +template-haskell +text +transformers +unordered-containers,
|
||||
any.serialise ==0.2.6.1,
|
||||
serialise +newtime15,
|
||||
any.servant ==0.20.2,
|
||||
any.servant-server ==0.20.2,
|
||||
any.silently ==1.2.5.4,
|
||||
any.simple-sendfile ==0.2.32,
|
||||
simple-sendfile +allow-bsd -fallback,
|
||||
any.singleton-bool ==0.1.8,
|
||||
any.silently ==1.2.5.3,
|
||||
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,
|
||||
|
|
@ -297,10 +274,8 @@ constraints: any.Cabal ==3.10.3.0,
|
|||
any.strict ==0.5.1,
|
||||
any.string-conversions ==0.4.0.1,
|
||||
any.system-cxx-std-lib ==1.0,
|
||||
any.tagged ==0.8.9,
|
||||
any.tagged ==0.8.8,
|
||||
tagged +deepseq +transformers,
|
||||
any.tasty ==1.5.2,
|
||||
tasty +unix,
|
||||
any.template-haskell ==2.20.0.0,
|
||||
any.terminal-size ==0.3.4,
|
||||
any.terminfo ==0.4.1.6,
|
||||
|
|
@ -308,43 +283,41 @@ constraints: any.Cabal ==3.10.3.0,
|
|||
any.text-iso8601 ==0.1.1,
|
||||
any.text-short ==0.1.6,
|
||||
text-short -asserts,
|
||||
any.text-show ==3.11,
|
||||
text-show +integer-gmp,
|
||||
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.1.0,
|
||||
any.th-compat ==0.1.6,
|
||||
any.th-lift ==0.8.6,
|
||||
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.2.1,
|
||||
any.tls ==2.1.5,
|
||||
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.12.0,
|
||||
any.typed-process ==0.2.11.1,
|
||||
any.unix ==2.8.4.0,
|
||||
any.unix-compat ==0.7.3,
|
||||
any.unix-time ==0.4.16,
|
||||
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 ==1.3.16,
|
||||
any.uuid-types ==1.0.6,
|
||||
any.vault ==0.3.1.5,
|
||||
vault +useghc,
|
||||
any.vector ==0.13.2.0,
|
||||
any.vector ==0.13.1.0,
|
||||
vector +boundschecks -internalchecks -unsafechecks -wall,
|
||||
any.vector-algorithms ==0.9.0.3,
|
||||
any.vector-algorithms ==0.9.0.2,
|
||||
vector-algorithms +bench +boundschecks -internalchecks -llvm +properties -unsafechecks,
|
||||
any.vector-stream ==0.1.0.1,
|
||||
any.void ==0.7.3,
|
||||
|
|
@ -353,20 +326,11 @@ constraints: any.Cabal ==3.10.3.0,
|
|||
any.vty-crossplatform ==0.4.0.0,
|
||||
vty-crossplatform -demos,
|
||||
any.vty-unix ==0.2.0.0,
|
||||
any.wai ==3.2.4,
|
||||
any.wai-app-static ==3.1.9,
|
||||
wai-app-static +crypton -print,
|
||||
any.wai-extra ==3.1.17,
|
||||
wai-extra -build-example,
|
||||
any.wai-logger ==2.5.0,
|
||||
any.warp ==3.4.7,
|
||||
warp +allow-sendfilefd -network-bytestring -warp-debug +x509,
|
||||
any.wide-word ==0.1.6.0,
|
||||
any.witherable ==0.5,
|
||||
any.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-12-14T09:52:48Z
|
||||
index-state: hackage.haskell.org 2024-07-10T18:40:26Z
|
||||
|
|
|
|||
File diff suppressed because it is too large
Load diff
1386
src/Zenith/Core.hs
1386
src/Zenith/Core.hs
File diff suppressed because it is too large
Load diff
1674
src/Zenith/DB.hs
1674
src/Zenith/DB.hs
File diff suppressed because it is too large
Load diff
1094
src/Zenith/GUI.hs
1094
src/Zenith/GUI.hs
File diff suppressed because it is too large
Load diff
|
|
@ -49,9 +49,6 @@ zenithTheme =
|
|||
L.active .
|
||||
L.btnStyle . L.text ?~
|
||||
baseTextStyle &
|
||||
L.disabled .
|
||||
L.btnStyle . L.text ?~
|
||||
baseTextStyle &
|
||||
L.basic .
|
||||
L.btnMainStyle . L.text ?~
|
||||
hiliteTextStyle &
|
||||
|
|
|
|||
|
|
@ -1,943 +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
|
||||
bi <-
|
||||
saveBlock pool $
|
||||
ZcashBlock
|
||||
(fromIntegral $ bl_height blk)
|
||||
(HexStringDB $ bl_hash blk)
|
||||
(fromIntegral $ bl_confirmations blk)
|
||||
(fromIntegral $ bl_time blk)
|
||||
(ZcashNetDB net)
|
||||
mapM_ (processTx zHost zPort bi pool) $ bl_txs blk
|
||||
|
|
@ -2,28 +2,29 @@
|
|||
|
||||
module Zenith.Scanner where
|
||||
|
||||
import Control.Concurrent.Async (concurrently_, withAsync)
|
||||
import Control.Exception (throwIO, try)
|
||||
import Control.Monad (when)
|
||||
import qualified Control.Monad.Catch as CM (try)
|
||||
import Control.Monad.IO.Class (liftIO)
|
||||
import Control.Monad.Logger
|
||||
( NoLoggingT
|
||||
( LoggingT
|
||||
, NoLoggingT
|
||||
, logErrorN
|
||||
, logInfoN
|
||||
, runNoLoggingT
|
||||
, runStderrLoggingT
|
||||
)
|
||||
import Data.Aeson
|
||||
import Data.HexString
|
||||
import Data.Maybe
|
||||
import qualified Data.Text as T
|
||||
import Data.Time (getCurrentTime)
|
||||
import Database.Persist.Sqlite
|
||||
import GHC.Utils.Monad (concatMapM)
|
||||
import Lens.Micro ((&), (.~), (^.), set)
|
||||
import System.Console.AsciiProgress
|
||||
import ZcashHaskell.Types
|
||||
( BlockResponse(..)
|
||||
, RawZebraTx(..)
|
||||
, Transaction(..)
|
||||
, ZcashNet(..)
|
||||
, ZebraGetBlockChainInfo(..)
|
||||
, ZebraTxResponse(..)
|
||||
, fromRawOBundle
|
||||
|
|
@ -31,85 +32,59 @@ import ZcashHaskell.Types
|
|||
, fromRawTBundle
|
||||
)
|
||||
import ZcashHaskell.Utils (getBlockTime, makeZebraCall, readZebraTransaction)
|
||||
import Zenith.Core (checkBlockChain, syncWallet, updateCommitmentTrees)
|
||||
import Zenith.Core (checkBlockChain)
|
||||
import Zenith.DB
|
||||
( ZcashBlock(..)
|
||||
, ZcashBlockId
|
||||
, clearWalletData
|
||||
, clearWalletTransactions
|
||||
, completeSync
|
||||
, getBlock
|
||||
, getMaxBlock
|
||||
, getMinBirthdayHeight
|
||||
( getMaxBlock
|
||||
, 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
|
||||
scanZebra ::
|
||||
Int -- ^ Starting block
|
||||
-> T.Text -- ^ Host
|
||||
-> Int -- ^ Port
|
||||
-> T.Text -- ^ Path to database file
|
||||
-> IO ()
|
||||
rescanZebra host port dbFilePath = do
|
||||
-> NoLoggingT IO ()
|
||||
scanZebra b host port dbFilePath = do
|
||||
_ <- liftIO $ initDb dbFilePath
|
||||
startTime <- liftIO getCurrentTime
|
||||
logInfoN $ "Started sync: " <> T.pack (show startTime)
|
||||
bc <-
|
||||
try $ checkBlockChain host port :: IO
|
||||
liftIO $ try $ checkBlockChain host port :: NoLoggingT
|
||||
IO
|
||||
(Either IOError ZebraGetBlockChainInfo)
|
||||
case bc of
|
||||
Left e -> print e
|
||||
Left e -> logErrorN $ T.pack (show e)
|
||||
Right bStatus -> do
|
||||
let znet = ZcashNetDB $ zgb_net bStatus
|
||||
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 dbInfo =
|
||||
mkSqliteConnectionInfo dbFilePath & extraPragmas .~
|
||||
["read_uncommited = true"]
|
||||
pool <- createSqlitePoolFromInfo dbInfo 5
|
||||
dbBlock <- getMaxBlock pool
|
||||
let sb = max dbBlock b
|
||||
if sb > zgb_blocks bStatus || sb < 1
|
||||
then liftIO $ throwIO $ userError "Invalid starting block for scan"
|
||||
else do
|
||||
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"
|
||||
liftIO $
|
||||
print $
|
||||
"Scanning from " ++
|
||||
show (sb + 1) ++ " to " ++ show (zgb_blocks bStatus)
|
||||
let bList = [(sb + 1) .. (zgb_blocks bStatus)]
|
||||
displayConsoleRegions $ do
|
||||
pg <-
|
||||
liftIO $
|
||||
newProgressBar def {pgTotal = fromIntegral $ length bList}
|
||||
txList <-
|
||||
CM.try $ mapM_ (processBlock host port pool pg) bList :: NoLoggingT
|
||||
IO
|
||||
(Either IOError ())
|
||||
case txList of
|
||||
Left e1 -> logErrorN $ T.pack (show e1)
|
||||
Right txList' -> logInfoN "Finished scan"
|
||||
|
||||
-- | Function to process a raw block and extract the transaction information
|
||||
processBlock ::
|
||||
|
|
@ -117,10 +92,9 @@ processBlock ::
|
|||
-> 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
|
||||
-> NoLoggingT IO ()
|
||||
processBlock host port pool pg b = do
|
||||
r <-
|
||||
liftIO $
|
||||
makeZebraCall
|
||||
|
|
@ -129,29 +103,39 @@ processBlock host port pool pg net b = do
|
|||
"getblock"
|
||||
[Data.Aeson.String $ T.pack $ show b, jsonNumber 1]
|
||||
case r of
|
||||
Left e -> do
|
||||
_ <- completeSync pool Failed
|
||||
liftIO $ throwIO $ userError e
|
||||
Left e -> liftIO $ throwIO $ userError e
|
||||
Right blk -> do
|
||||
bi <-
|
||||
saveBlock pool $
|
||||
ZcashBlock
|
||||
(fromIntegral $ bl_height blk)
|
||||
(HexStringDB $ bl_hash blk)
|
||||
(fromIntegral $ bl_confirmations blk)
|
||||
(fromIntegral $ bl_time blk)
|
||||
net
|
||||
mapM_ (processTx host port bi pool) $ bl_txs blk
|
||||
liftIO $ tick pg
|
||||
r2 <-
|
||||
liftIO $
|
||||
makeZebraCall
|
||||
host
|
||||
port
|
||||
"getblock"
|
||||
[Data.Aeson.String $ T.pack $ show b, jsonNumber 0]
|
||||
case r2 of
|
||||
Left e2 -> liftIO $ throwIO $ userError e2
|
||||
Right hb -> do
|
||||
let blockTime = getBlockTime hb
|
||||
mapM_ (processTx host port blockTime pool) $
|
||||
bl_txs $ addTime blk blockTime
|
||||
liftIO $ tick pg
|
||||
where
|
||||
addTime :: BlockResponse -> Int -> BlockResponse
|
||||
addTime bl t =
|
||||
BlockResponse
|
||||
(bl_confirmations bl)
|
||||
(bl_height bl)
|
||||
(fromIntegral t)
|
||||
(bl_txs bl)
|
||||
|
||||
-- | Function to process a raw transaction
|
||||
processTx ::
|
||||
T.Text -- ^ Host name for `zebrad`
|
||||
-> Int -- ^ Port for `zebrad`
|
||||
-> ZcashBlockId -- ^ Block ID
|
||||
-> Int -- ^ Block time
|
||||
-> ConnectionPool -- ^ DB file path
|
||||
-> HexString -- ^ transaction id
|
||||
-> IO ()
|
||||
-> NoLoggingT IO ()
|
||||
processTx host port bt pool t = do
|
||||
r <-
|
||||
liftIO $
|
||||
|
|
@ -161,15 +145,12 @@ processTx host port bt pool t = do
|
|||
"getrawtransaction"
|
||||
[Data.Aeson.String $ toText t, jsonNumber 1]
|
||||
case r of
|
||||
Left e -> do
|
||||
_ <- completeSync pool Failed
|
||||
liftIO $ throwIO $ userError e
|
||||
Left e -> liftIO $ throwIO $ userError e
|
||||
Right rawTx -> do
|
||||
case readZebraTransaction (ztr_hex rawTx) of
|
||||
Nothing -> return ()
|
||||
Just rzt -> do
|
||||
_ <-
|
||||
runNoLoggingT $
|
||||
saveTransaction pool bt $
|
||||
Transaction
|
||||
t
|
||||
|
|
@ -203,59 +184,3 @@ updateConfs host port pool = do
|
|||
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)
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
@ -10,37 +10,23 @@
|
|||
module Zenith.Types where
|
||||
|
||||
import Data.Aeson
|
||||
import Data.Aeson.TH (deriveJSON)
|
||||
import qualified Data.ByteString as BS
|
||||
import qualified Data.ByteString.Base64 as B64
|
||||
import qualified Data.ByteString.Char8 as C
|
||||
import Data.HexString
|
||||
import Data.Int (Int64)
|
||||
import Data.Maybe (fromMaybe)
|
||||
import Data.Scientific (Scientific)
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.Text.Encoding as E
|
||||
import Data.Text.Encoding.Error (lenientDecode)
|
||||
import qualified Data.UUID as U
|
||||
import Database.Persist.TH
|
||||
import GHC.Generics
|
||||
import ZcashHaskell.Orchard (encodeUnifiedAddress, parseAddress)
|
||||
import ZcashHaskell.Sapling (encodeSaplingAddress)
|
||||
import ZcashHaskell.Transparent
|
||||
( encodeExchangeAddress
|
||||
, encodeTransparentReceiver
|
||||
)
|
||||
import ZcashHaskell.Types
|
||||
( ExchangeAddress(..)
|
||||
, OrchardSpendingKey(..)
|
||||
( OrchardSpendingKey(..)
|
||||
, Phrase(..)
|
||||
, Rseed(..)
|
||||
, SaplingAddress(..)
|
||||
, SaplingSpendingKey(..)
|
||||
, Scope(..)
|
||||
, TransparentAddress(..)
|
||||
, TransparentSpendingKey
|
||||
, ValidAddress(..)
|
||||
, ZcashNet(..)
|
||||
)
|
||||
|
||||
|
|
@ -56,9 +42,6 @@ newtype ZcashNetDB = ZcashNetDB
|
|||
{ getNet :: ZcashNet
|
||||
} deriving newtype (Eq, Show, Read)
|
||||
|
||||
instance ToJSON ZcashNetDB where
|
||||
toJSON (ZcashNetDB z) = toJSON z
|
||||
|
||||
derivePersistField "ZcashNetDB"
|
||||
|
||||
newtype UnifiedAddressDB = UnifiedAddressDB
|
||||
|
|
@ -109,165 +92,8 @@ data Config = Config
|
|||
{ c_dbPath :: !T.Text
|
||||
, c_zebraHost :: !T.Text
|
||||
, c_zebraPort :: !Int
|
||||
, c_zenithUser :: !BS.ByteString
|
||||
, c_zenithPwd :: !BS.ByteString
|
||||
, c_zenithPort :: !Int
|
||||
} 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
|
||||
|
|
@ -312,6 +138,24 @@ instance FromJSON AddressSource where
|
|||
"mnemonic_seed" -> return MnemonicSeed
|
||||
_ -> fail "Not a known address source"
|
||||
|
||||
data ZcashPool
|
||||
= Transparent
|
||||
| Sprout
|
||||
| Sapling
|
||||
| Orchard
|
||||
deriving (Show, Read, Eq, Generic, ToJSON)
|
||||
|
||||
derivePersistField "ZcashPool"
|
||||
|
||||
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]
|
||||
|
|
@ -359,8 +203,7 @@ instance FromJSON AddressGroup where
|
|||
Nothing -> return []
|
||||
Just x -> do
|
||||
x' <- x .:? "addresses"
|
||||
return $
|
||||
maybe [] (map (ZcashAddress s1 [TransparentPool] Nothing)) x'
|
||||
return $ maybe [] (map (ZcashAddress s1 [Transparent] Nothing)) x'
|
||||
processSapling k s2 =
|
||||
case k of
|
||||
Nothing -> return []
|
||||
|
|
@ -368,7 +211,7 @@ instance FromJSON AddressGroup where
|
|||
where processOneSapling sx =
|
||||
withObject "Sapling" $ \oS -> do
|
||||
oS' <- oS .: "addresses"
|
||||
return $ map (ZcashAddress sx [SaplingPool] Nothing) oS'
|
||||
return $ map (ZcashAddress sx [Sapling] Nothing) oS'
|
||||
processUnified u =
|
||||
case u of
|
||||
Nothing -> return []
|
||||
|
|
|
|||
|
|
@ -3,38 +3,28 @@
|
|||
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.Orchard (encodeUnifiedAddress, isValidUnifiedAddress)
|
||||
import ZcashHaskell.Sapling (decodeSaplingAddress, isValidShieldedAddress)
|
||||
import ZcashHaskell.Transparent
|
||||
( decodeExchangeAddress
|
||||
, decodeTransparentAddress
|
||||
)
|
||||
import ZcashHaskell.Types
|
||||
( ExchangeAddress(..)
|
||||
, SaplingAddress(..)
|
||||
( SaplingAddress(..)
|
||||
, TransparentAddress(..)
|
||||
, UnifiedAddress(..)
|
||||
, ValidAddress(..)
|
||||
, ZcashNet(..)
|
||||
)
|
||||
import ZcashHaskell.Utils (makeZebraCall)
|
||||
import Zenith.Types
|
||||
( AddressGroup(..)
|
||||
, PrivacyPolicy(..)
|
||||
, UnifiedAddressDB(..)
|
||||
, ZcashAddress(..)
|
||||
, ZcashPool(..)
|
||||
|
|
@ -79,9 +69,9 @@ getAddresses ag = agtransparent ag <> agsapling ag <> agunified ag
|
|||
-- | Helper function to validate potential Zcash addresses
|
||||
validateAddress :: T.Text -> Maybe ZcashPool
|
||||
validateAddress txt --(tReg || sReg && isJust chk) || (uReg && isJust chk)
|
||||
| tReg = Just TransparentPool
|
||||
| sReg && chkS = Just SaplingPool
|
||||
| uReg && chk = Just OrchardPool
|
||||
| tReg = Just Transparent
|
||||
| sReg && chkS = Just Sapling
|
||||
| uReg && chk = Just Orchard
|
||||
| otherwise = Nothing
|
||||
where
|
||||
transparentRegex = "^t1[a-zA-Z0-9]{33}$" :: String
|
||||
|
|
@ -93,13 +83,6 @@ validateAddress txt --(tReg || sReg && isJust chk) || (uReg && isJust chk)
|
|||
chk = isJust $ isValidUnifiedAddress $ E.encodeUtf8 txt
|
||||
chkS = isValidShieldedAddress $ E.encodeUtf8 txt
|
||||
|
||||
-- | Return True if Address is valid
|
||||
validateAddressBool :: T.Text -> Bool
|
||||
validateAddressBool a = do
|
||||
case (validateAddress a) of
|
||||
Nothing -> False
|
||||
_ -> True
|
||||
|
||||
-- | Copy an address to the clipboard
|
||||
copyAddress :: ZcashAddress -> IO ()
|
||||
copyAddress a =
|
||||
|
|
@ -107,18 +90,12 @@ copyAddress a =
|
|||
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
|
||||
isRecipientValid a =
|
||||
case isValidUnifiedAddress (E.encodeUtf8 a) of
|
||||
Just _a1 -> True
|
||||
Nothing ->
|
||||
|
|
@ -126,84 +103,12 @@ isRecipientValid a = do
|
|||
(case decodeTransparentAddress (E.encodeUtf8 a) of
|
||||
Just _a3 -> True
|
||||
Nothing ->
|
||||
case decodeExchangeAddress (E.encodeUtf8 a) of
|
||||
case decodeExchangeAddress 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 =
|
||||
parseAddress :: T.Text -> ZcashNet -> Maybe UnifiedAddress
|
||||
parseAddress a znet =
|
||||
case isValidUnifiedAddress (E.encodeUtf8 a) of
|
||||
Just a1 -> Just a1
|
||||
Nothing ->
|
||||
|
|
@ -215,36 +120,3 @@ parseAddressUA a znet =
|
|||
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
|
||||
|
|
|
|||
|
|
@ -123,10 +123,9 @@ sendTx user pwd fromAddy toAddy amount memo = do
|
|||
if source fromAddy /= ImportedWatchOnly
|
||||
then do
|
||||
let privacyPolicy
|
||||
| valAdd == Just TransparentPool = "AllowRevealedRecipients"
|
||||
| valAdd == Just Transparent = "AllowRevealedRecipients"
|
||||
| isNothing (account fromAddy) &&
|
||||
elem TransparentPool (pool fromAddy) =
|
||||
"AllowRevealedSenders"
|
||||
elem Transparent (pool fromAddy) = "AllowRevealedSenders"
|
||||
| otherwise = "AllowRevealedAmounts"
|
||||
let pd =
|
||||
case memo of
|
||||
|
|
@ -302,7 +301,7 @@ sendWithUri user pwd fromAddy uri repTo = do
|
|||
let addType = validateAddress $ T.pack parsedAddress
|
||||
case addType of
|
||||
Nothing -> putStrLn " Invalid address"
|
||||
Just TransparentPool -> do
|
||||
Just Transparent -> do
|
||||
putStrLn $ " Address is valid: " ++ parsedAddress
|
||||
case (readMaybe parsedAmount :: Maybe Double) of
|
||||
Nothing -> putStrLn " Invalid amount."
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
1010
test/Spec.hs
1010
test/Spec.hs
File diff suppressed because it is too large
Load diff
|
|
@ -1 +1 @@
|
|||
Subproject commit 4289a9ded67ef2ca432abc412934fb5b8b59a9cf
|
||||
Subproject commit e8074419cfb54559a4c09731ad2448d5930869a2
|
||||
|
|
@ -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."
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
81
zenith.cabal
81
zenith.cabal
|
|
@ -1,6 +1,6 @@
|
|||
cabal-version: 3.0
|
||||
name: zenith
|
||||
version: 0.7.1.0-beta
|
||||
version: 0.6.0.0-beta
|
||||
license: MIT
|
||||
license-file: LICENSE
|
||||
author: Rene Vergara
|
||||
|
|
@ -35,65 +35,56 @@ library
|
|||
Zenith.Utils
|
||||
Zenith.Zcashd
|
||||
Zenith.Scanner
|
||||
Zenith.RPC
|
||||
Zenith.Tree
|
||||
hs-source-dirs:
|
||||
src
|
||||
build-depends:
|
||||
Clipboard
|
||||
, Hclip
|
||||
, JuicyPixels
|
||||
, aeson
|
||||
, array
|
||||
, ascii-progress
|
||||
, async
|
||||
, base >=4.12 && <5
|
||||
, base64-bytestring
|
||||
, binary
|
||||
, borsh
|
||||
, brick
|
||||
, bytestring
|
||||
, configurator
|
||||
, data-default
|
||||
, directory
|
||||
, esqueleto
|
||||
, exceptions
|
||||
, filepath
|
||||
, esqueleto
|
||||
, resource-pool
|
||||
, binary
|
||||
, exceptions
|
||||
, monad-logger
|
||||
, vty-crossplatform
|
||||
, secp256k1-haskell >= 1
|
||||
, pureMD5
|
||||
, ghc
|
||||
, generics-sop
|
||||
, haskoin-core
|
||||
, hexstring
|
||||
, http-client
|
||||
, http-conduit
|
||||
, http-types
|
||||
, JuicyPixels
|
||||
, qrcode-core
|
||||
, qrcode-juicypixels
|
||||
, microlens
|
||||
, microlens-mtl
|
||||
, microlens-th
|
||||
, monad-logger
|
||||
, transformers
|
||||
, monomer
|
||||
, mtl
|
||||
, persistent
|
||||
, Hclip
|
||||
, persistent-sqlite
|
||||
, persistent-template
|
||||
, process
|
||||
, pureMD5
|
||||
, qrcode-core
|
||||
, qrcode-juicypixels
|
||||
, regex-base
|
||||
, regex-compat
|
||||
, regex-posix
|
||||
, resource-pool
|
||||
, scientific
|
||||
, secp256k1-haskell >= 1
|
||||
, servant-server
|
||||
, text
|
||||
, text-show
|
||||
, time
|
||||
, uuid
|
||||
, vector
|
||||
, vty
|
||||
, vty-crossplatform
|
||||
, word-wrap
|
||||
, zcash-haskell
|
||||
--pkgconfig-depends: rustzcash_wrapper
|
||||
|
|
@ -119,21 +110,15 @@ executable zenith
|
|||
pkgconfig-depends: rustzcash_wrapper
|
||||
default-language: Haskell2010
|
||||
|
||||
executable zenithserver
|
||||
ghc-options: -main-is Server -threaded -rtsopts -with-rtsopts=-N
|
||||
main-is: Server.hs
|
||||
executable zenscan
|
||||
ghc-options: -main-is ZenScan -threaded -rtsopts -with-rtsopts=-N
|
||||
main-is: ZenScan.hs
|
||||
hs-source-dirs:
|
||||
app
|
||||
build-depends:
|
||||
base >=4.12 && <5
|
||||
, configurator
|
||||
, monad-logger
|
||||
, wai-extra
|
||||
, warp
|
||||
, servant-server
|
||||
, text
|
||||
, unix
|
||||
, zcash-haskell
|
||||
, zenith
|
||||
pkgconfig-depends: rustzcash_wrapper
|
||||
default-language: Haskell2010
|
||||
|
|
@ -147,11 +132,8 @@ test-suite zenith-tests
|
|||
build-depends:
|
||||
base >=4.12 && <5
|
||||
, bytestring
|
||||
, aeson
|
||||
, configurator
|
||||
, monad-logger
|
||||
, borsh
|
||||
, aeson
|
||||
, data-default
|
||||
, sort
|
||||
, text
|
||||
|
|
@ -166,34 +148,3 @@ test-suite zenith-tests
|
|||
, zenith
|
||||
pkgconfig-depends: rustzcash_wrapper
|
||||
default-language: Haskell2010
|
||||
|
||||
test-suite zenithserver-tests
|
||||
type: exitcode-stdio-1.0
|
||||
ghc-options: -threaded -rtsopts -with-rtsopts=-N
|
||||
main-is: ServerSpec.hs
|
||||
hs-source-dirs:
|
||||
test
|
||||
build-depends:
|
||||
base >=4.12 && <5
|
||||
, bytestring
|
||||
, aeson
|
||||
, configurator
|
||||
, monad-logger
|
||||
, data-default
|
||||
, sort
|
||||
, text
|
||||
, time
|
||||
, uuid
|
||||
, http-conduit
|
||||
, persistent
|
||||
, persistent-sqlite
|
||||
, hspec
|
||||
, hexstring
|
||||
, warp
|
||||
, servant-server
|
||||
, HUnit
|
||||
, directory
|
||||
, zcash-haskell
|
||||
, zenith
|
||||
pkgconfig-depends: rustzcash_wrapper
|
||||
default-language: Haskell2010
|
||||
|
|
|
|||
Loading…
Reference in a new issue