Improvements for release #92
26 changed files with 9031 additions and 1249 deletions
2
.gitmodules
vendored
2
.gitmodules
vendored
|
|
@ -1,4 +1,4 @@
|
||||||
[submodule "zcash-haskell"]
|
[submodule "zcash-haskell"]
|
||||||
path = zcash-haskell
|
path = zcash-haskell
|
||||||
url = https://git.vergara.tech/Vergara_Tech/zcash-haskell.git
|
url = https://git.vergara.tech/Vergara_Tech/zcash-haskell.git
|
||||||
branch = milestone2
|
branch = master
|
||||||
|
|
|
||||||
37
CHANGELOG.md
37
CHANGELOG.md
|
|
@ -5,6 +5,43 @@ 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/),
|
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).
|
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]
|
## [0.6.0.0-beta]
|
||||||
|
|
||||||
### Added
|
### Added
|
||||||
|
|
|
||||||
17
app/Main.hs
17
app/Main.hs
|
|
@ -19,8 +19,8 @@ import System.IO
|
||||||
import Text.Read (readMaybe)
|
import Text.Read (readMaybe)
|
||||||
import ZcashHaskell.Types
|
import ZcashHaskell.Types
|
||||||
import Zenith.CLI
|
import Zenith.CLI
|
||||||
import Zenith.Core (clearSync, testSync)
|
|
||||||
import Zenith.GUI (runZenithGUI)
|
import Zenith.GUI (runZenithGUI)
|
||||||
|
import Zenith.Scanner (clearSync, rescanZebra)
|
||||||
import Zenith.Types (Config(..), ZcashAddress(..), ZcashPool(..), ZcashTx(..))
|
import Zenith.Types (Config(..), ZcashAddress(..), ZcashPool(..), ZcashTx(..))
|
||||||
import Zenith.Utils
|
import Zenith.Utils
|
||||||
import Zenith.Zcashd
|
import Zenith.Zcashd
|
||||||
|
|
@ -204,12 +204,15 @@ main :: IO ()
|
||||||
main = do
|
main = do
|
||||||
config <- load ["$(HOME)/Zenith/zenith.cfg"]
|
config <- load ["$(HOME)/Zenith/zenith.cfg"]
|
||||||
args <- getArgs
|
args <- getArgs
|
||||||
dbFilePath <- require config "dbFilePath"
|
dbFileName <- require config "dbFileName"
|
||||||
{-nodeUser <- require config "nodeUser"-}
|
nodeUser <- require config "nodeUser"
|
||||||
{-nodePwd <- require config "nodePwd"-}
|
nodePwd <- require config "nodePwd"
|
||||||
zebraPort <- require config "zebraPort"
|
zebraPort <- require config "zebraPort"
|
||||||
zebraHost <- require config "zebraHost"
|
zebraHost <- require config "zebraHost"
|
||||||
let myConfig = Config dbFilePath zebraHost zebraPort
|
nodePort <- require config "nodePort"
|
||||||
|
dbFP <- getZenithPath
|
||||||
|
let dbFilePath = T.pack $ dbFP ++ dbFileName
|
||||||
|
let myConfig = Config dbFilePath zebraHost zebraPort nodeUser nodePwd nodePort
|
||||||
if not (null args)
|
if not (null args)
|
||||||
then do
|
then do
|
||||||
case head args
|
case head args
|
||||||
|
|
@ -226,7 +229,8 @@ main = do
|
||||||
of
|
of
|
||||||
"gui" -> runZenithGUI myConfig
|
"gui" -> runZenithGUI myConfig
|
||||||
"tui" -> runZenithTUI myConfig
|
"tui" -> runZenithTUI myConfig
|
||||||
"rescan" -> clearSync myConfig
|
"rescan" -> rescanZebra zebraHost zebraPort dbFilePath
|
||||||
|
"resync" -> clearSync myConfig
|
||||||
_ -> printUsage
|
_ -> printUsage
|
||||||
else printUsage
|
else printUsage
|
||||||
|
|
||||||
|
|
@ -236,4 +240,5 @@ printUsage = do
|
||||||
putStrLn "Available commands:"
|
putStrLn "Available commands:"
|
||||||
{-putStrLn "legacy\tLegacy CLI for zcashd"-}
|
{-putStrLn "legacy\tLegacy CLI for zcashd"-}
|
||||||
putStrLn "tui\tTUI for zebrad"
|
putStrLn "tui\tTUI for zebrad"
|
||||||
|
putStrLn "gui\tGUI for zebrad"
|
||||||
putStrLn "rescan\tRescan the existing wallet(s)"
|
putStrLn "rescan\tRescan the existing wallet(s)"
|
||||||
|
|
|
||||||
91
app/Server.hs
Normal file
91
app/Server.hs
Normal file
|
|
@ -0,0 +1,91 @@
|
||||||
|
{-# 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.8.0.0-beta"
|
||||||
|
putStrLn "------------------------------"
|
||||||
|
putStrLn $
|
||||||
|
"Connected to " ++
|
||||||
|
show (zgb_net chainInfo) ++
|
||||||
|
" Zebra " ++
|
||||||
|
T.unpack (zgi_build zebra) ++ " on port " ++ show zebraPort
|
||||||
|
let myState =
|
||||||
|
State
|
||||||
|
(zgb_net chainInfo)
|
||||||
|
zebraHost
|
||||||
|
zebraPort
|
||||||
|
dbFilePath
|
||||||
|
(zgi_build zebra)
|
||||||
|
(zgb_blocks chainInfo)
|
||||||
|
run nodePort $
|
||||||
|
serveWithContext
|
||||||
|
(Proxy :: Proxy ZenithRPC)
|
||||||
|
ctx
|
||||||
|
(zenithServer myState)
|
||||||
|
else putStrLn
|
||||||
|
"No wallets available. Please start Zenith interactively to create a wallet"
|
||||||
|
|
@ -4,7 +4,7 @@ module ZenScan where
|
||||||
|
|
||||||
import Control.Monad.Logger (runNoLoggingT)
|
import Control.Monad.Logger (runNoLoggingT)
|
||||||
import Data.Configurator
|
import Data.Configurator
|
||||||
import Zenith.Scanner (scanZebra)
|
import Zenith.Scanner (rescanZebra)
|
||||||
|
|
||||||
main :: IO ()
|
main :: IO ()
|
||||||
main = do
|
main = do
|
||||||
|
|
|
||||||
|
|
@ -9,19 +9,18 @@ constraints: any.Cabal ==3.10.3.0,
|
||||||
any.OneTuple ==0.4.2,
|
any.OneTuple ==0.4.2,
|
||||||
any.OpenGLRaw ==3.3.4.1,
|
any.OpenGLRaw ==3.3.4.1,
|
||||||
OpenGLRaw -osandroid +usegles2 +useglxgetprocaddress +usenativewindowslibraries,
|
OpenGLRaw -osandroid +usegles2 +useglxgetprocaddress +usenativewindowslibraries,
|
||||||
any.QuickCheck ==2.14.3,
|
any.QuickCheck ==2.15.0.1,
|
||||||
QuickCheck -old-random +templatehaskell,
|
QuickCheck -old-random +templatehaskell,
|
||||||
any.RSA ==2.4.1,
|
any.RSA ==2.4.1,
|
||||||
any.SHA ==1.6.4.4,
|
any.SHA ==1.6.4.4,
|
||||||
SHA -exe,
|
SHA -exe,
|
||||||
any.StateVar ==1.2.2,
|
any.StateVar ==1.2.2,
|
||||||
any.X11 ==1.10.3,
|
any.X11 ==1.9.2,
|
||||||
X11 -pedantic,
|
|
||||||
any.adjunctions ==4.4.2,
|
any.adjunctions ==4.4.2,
|
||||||
any.aeson ==2.2.3.0,
|
any.aeson ==2.2.3.0,
|
||||||
aeson +ordered-keymap,
|
aeson +ordered-keymap,
|
||||||
any.alex ==3.5.1.0,
|
any.alex ==3.5.1.0,
|
||||||
any.ansi-terminal ==1.1.1,
|
any.ansi-terminal ==1.1.2,
|
||||||
ansi-terminal -example,
|
ansi-terminal -example,
|
||||||
any.ansi-terminal-types ==1.1,
|
any.ansi-terminal-types ==1.1,
|
||||||
any.appar ==0.1.8,
|
any.appar ==0.1.8,
|
||||||
|
|
@ -39,11 +38,11 @@ constraints: any.Cabal ==3.10.3.0,
|
||||||
attoparsec -developer,
|
attoparsec -developer,
|
||||||
any.attoparsec-aeson ==2.2.2.0,
|
any.attoparsec-aeson ==2.2.2.0,
|
||||||
any.authenticate-oauth ==1.7,
|
any.authenticate-oauth ==1.7,
|
||||||
any.auto-update ==0.2.1,
|
any.auto-update ==0.2.4,
|
||||||
any.base ==4.18.2.1,
|
any.base ==4.18.2.1,
|
||||||
any.base-compat ==0.14.0,
|
any.base-compat ==0.14.1,
|
||||||
any.base-compat-batteries ==0.14.0,
|
any.base-compat-batteries ==0.14.1,
|
||||||
any.base-orphans ==0.9.2,
|
any.base-orphans ==0.9.3,
|
||||||
any.base16 ==1.0,
|
any.base16 ==1.0,
|
||||||
any.base16-bytestring ==1.0.2.0,
|
any.base16-bytestring ==1.0.2.0,
|
||||||
any.base58-bytestring ==0.1.0,
|
any.base58-bytestring ==0.1.0,
|
||||||
|
|
@ -59,18 +58,19 @@ constraints: any.Cabal ==3.10.3.0,
|
||||||
any.blaze-builder ==0.4.2.3,
|
any.blaze-builder ==0.4.2.3,
|
||||||
any.blaze-html ==0.9.2.0,
|
any.blaze-html ==0.9.2.0,
|
||||||
any.blaze-markup ==0.8.3.0,
|
any.blaze-markup ==0.8.3.0,
|
||||||
|
any.boring ==0.2.2,
|
||||||
|
boring +tagged,
|
||||||
any.borsh ==0.3.0,
|
any.borsh ==0.3.0,
|
||||||
any.brick ==2.4,
|
any.brick ==2.6,
|
||||||
brick -demos,
|
brick -demos,
|
||||||
|
any.bsb-http-chunked ==0.0.0.4,
|
||||||
any.byteorder ==1.0.4,
|
any.byteorder ==1.0.4,
|
||||||
any.bytes ==0.17.3,
|
any.bytes ==0.17.4,
|
||||||
any.bytestring ==0.11.5.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.bytestring-to-vector ==0.3.0.1,
|
||||||
any.c2hs ==0.28.8,
|
any.c2hs ==0.28.8,
|
||||||
c2hs +base3 -regression,
|
c2hs +base3 -regression,
|
||||||
any.cabal-doctest ==1.0.10,
|
any.cabal-doctest ==1.0.11,
|
||||||
any.call-stack ==0.4.0,
|
any.call-stack ==0.4.0,
|
||||||
any.case-insensitive ==1.2.1.0,
|
any.case-insensitive ==1.2.1.0,
|
||||||
any.cborg ==0.2.10.0,
|
any.cborg ==0.2.10.0,
|
||||||
|
|
@ -81,15 +81,16 @@ constraints: any.Cabal ==3.10.3.0,
|
||||||
any.clock ==0.8.4,
|
any.clock ==0.8.4,
|
||||||
clock -llvm,
|
clock -llvm,
|
||||||
any.colour ==2.3.6,
|
any.colour ==2.3.6,
|
||||||
any.comonad ==5.0.8,
|
any.comonad ==5.0.9,
|
||||||
comonad +containers +distributive +indexed-traversable,
|
comonad +containers +distributive +indexed-traversable,
|
||||||
any.concurrent-output ==1.10.21,
|
any.concurrent-output ==1.10.21,
|
||||||
any.conduit ==1.3.5,
|
any.conduit ==1.3.6,
|
||||||
any.conduit-extra ==1.3.6,
|
any.conduit-extra ==1.3.6,
|
||||||
any.config-ini ==0.2.7.0,
|
any.config-ini ==0.2.7.0,
|
||||||
config-ini -enable-doctests,
|
config-ini -enable-doctests,
|
||||||
any.configurator ==0.3.0.0,
|
any.configurator ==0.3.0.0,
|
||||||
configurator -developer,
|
configurator -developer,
|
||||||
|
any.constraints ==0.14.2,
|
||||||
any.containers ==0.6.7,
|
any.containers ==0.6.7,
|
||||||
any.contravariant ==1.5.5,
|
any.contravariant ==1.5.5,
|
||||||
contravariant +semigroups +statevar +tagged,
|
contravariant +semigroups +statevar +tagged,
|
||||||
|
|
@ -97,22 +98,22 @@ constraints: any.Cabal ==3.10.3.0,
|
||||||
any.crypto-api ==0.13.3,
|
any.crypto-api ==0.13.3,
|
||||||
crypto-api -all_cpolys,
|
crypto-api -all_cpolys,
|
||||||
any.crypto-pubkey-types ==0.4.3,
|
any.crypto-pubkey-types ==0.4.3,
|
||||||
any.crypton ==1.0.0,
|
any.cryptohash-md5 ==0.11.101.0,
|
||||||
|
any.cryptohash-sha1 ==0.11.101.0,
|
||||||
|
any.crypton ==1.0.1,
|
||||||
crypton -check_alignment +integer-gmp -old_toolchain_inliner +support_aesni +support_deepseq +support_pclmuldq +support_rdrand -support_sse +use_target_attributes,
|
crypton -check_alignment +integer-gmp -old_toolchain_inliner +support_aesni +support_deepseq +support_pclmuldq +support_rdrand -support_sse +use_target_attributes,
|
||||||
any.crypton-connection ==0.4.1,
|
any.crypton-connection ==0.4.3,
|
||||||
any.crypton-x509 ==1.7.7,
|
any.crypton-x509 ==1.7.7,
|
||||||
any.crypton-x509-store ==1.6.9,
|
any.crypton-x509-store ==1.6.9,
|
||||||
any.crypton-x509-system ==1.6.7,
|
any.crypton-x509-system ==1.6.7,
|
||||||
any.crypton-x509-validation ==1.6.12,
|
any.crypton-x509-validation ==1.6.13,
|
||||||
any.cryptonite ==0.30,
|
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,
|
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-clist ==0.2,
|
||||||
any.data-default ==0.7.1.1,
|
any.data-default ==0.8.0.0,
|
||||||
any.data-default-class ==0.1.2.0,
|
any.data-default-class ==0.2.0.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.data-fix ==0.3.4,
|
||||||
|
any.dec ==0.0.6,
|
||||||
any.deepseq ==1.4.8.1,
|
any.deepseq ==1.4.8.1,
|
||||||
any.directory ==1.3.8.4,
|
any.directory ==1.3.8.4,
|
||||||
any.distributive ==0.6.2.1,
|
any.distributive ==0.6.2.1,
|
||||||
|
|
@ -124,11 +125,12 @@ constraints: any.Cabal ==3.10.3.0,
|
||||||
any.easy-file ==0.2.5,
|
any.easy-file ==0.2.5,
|
||||||
any.entropy ==0.4.1.10,
|
any.entropy ==0.4.1.10,
|
||||||
entropy -donotgetentropy,
|
entropy -donotgetentropy,
|
||||||
any.envy ==2.1.3.0,
|
any.envy ==2.1.4.0,
|
||||||
any.esqueleto ==3.5.11.2,
|
any.esqueleto ==3.5.13.1,
|
||||||
any.exceptions ==0.10.7,
|
any.exceptions ==0.10.7,
|
||||||
any.extra ==1.7.16,
|
any.extra ==1.8,
|
||||||
any.fast-logger ==3.2.3,
|
any.fast-logger ==3.2.5,
|
||||||
|
any.file-embed ==0.0.16.0,
|
||||||
any.filepath ==1.4.300.1,
|
any.filepath ==1.4.300.1,
|
||||||
any.fixed ==0.3,
|
any.fixed ==0.3,
|
||||||
any.foreign-rust ==0.1.0,
|
any.foreign-rust ==0.1.0,
|
||||||
|
|
@ -136,8 +138,6 @@ constraints: any.Cabal ==3.10.3.0,
|
||||||
any.formatting ==7.2.0,
|
any.formatting ==7.2.0,
|
||||||
formatting -no-double-conversion,
|
formatting -no-double-conversion,
|
||||||
any.free ==5.2,
|
any.free ==5.2,
|
||||||
any.generic-deriving ==1.14.5,
|
|
||||||
generic-deriving +base-4-9,
|
|
||||||
any.generically ==0.1.1,
|
any.generically ==0.1.1,
|
||||||
any.generics-sop ==0.5.1.4,
|
any.generics-sop ==0.5.1.4,
|
||||||
any.ghc ==9.6.5,
|
any.ghc ==9.6.5,
|
||||||
|
|
@ -147,48 +147,54 @@ constraints: any.Cabal ==3.10.3.0,
|
||||||
any.ghc-heap ==9.6.5,
|
any.ghc-heap ==9.6.5,
|
||||||
any.ghc-prim ==0.10.0,
|
any.ghc-prim ==0.10.0,
|
||||||
any.ghci ==9.6.5,
|
any.ghci ==9.6.5,
|
||||||
any.half ==0.3.1,
|
any.half ==0.3.2,
|
||||||
any.happy ==1.20.1.1,
|
any.happy ==2.1.3,
|
||||||
|
any.happy-lib ==2.1.3,
|
||||||
any.hashable ==1.4.7.0,
|
any.hashable ==1.4.7.0,
|
||||||
hashable -arch-native +integer-gmp -random-initial-seed,
|
hashable -arch-native +integer-gmp -random-initial-seed,
|
||||||
any.haskell-lexer ==1.1.1,
|
any.haskell-lexer ==1.1.2,
|
||||||
any.haskoin-core ==1.1.0,
|
any.haskoin-core ==1.1.0,
|
||||||
any.hexstring ==0.12.1.0,
|
any.hexstring ==0.12.1.0,
|
||||||
any.hourglass ==0.2.12,
|
any.hourglass ==0.2.12,
|
||||||
any.hpc ==0.6.2.0,
|
any.hpc ==0.6.2.0,
|
||||||
any.hsc2hs ==0.68.10,
|
any.hsc2hs ==0.68.10,
|
||||||
hsc2hs -in-ghc-tree,
|
hsc2hs -in-ghc-tree,
|
||||||
any.hspec ==2.11.9,
|
any.hspec ==2.11.10,
|
||||||
any.hspec-core ==2.11.9,
|
any.hspec-core ==2.11.10,
|
||||||
any.hspec-discover ==2.11.9,
|
any.hspec-discover ==2.11.10,
|
||||||
any.hspec-expectations ==0.8.4,
|
any.hspec-expectations ==0.8.4,
|
||||||
any.http-api-data ==0.6.1,
|
any.http-api-data ==0.6.1,
|
||||||
http-api-data -use-text-show,
|
http-api-data -use-text-show,
|
||||||
any.http-client ==0.7.17,
|
any.http-client ==0.7.17,
|
||||||
http-client +network-uri,
|
http-client +network-uri,
|
||||||
any.http-client-tls ==0.3.6.3,
|
any.http-client-tls ==0.3.6.4,
|
||||||
any.http-conduit ==2.3.8.3,
|
any.http-conduit ==2.3.9.1,
|
||||||
http-conduit +aeson,
|
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.http-types ==0.12.4,
|
||||||
|
any.http2 ==5.3.9,
|
||||||
|
http2 -devel -h2spec,
|
||||||
any.indexed-traversable ==0.1.4,
|
any.indexed-traversable ==0.1.4,
|
||||||
any.indexed-traversable-instances ==0.1.2,
|
any.indexed-traversable-instances ==0.1.2,
|
||||||
any.integer-conversion ==0.1.1,
|
any.integer-conversion ==0.1.1,
|
||||||
any.integer-gmp ==1.1,
|
any.integer-gmp ==1.1,
|
||||||
any.integer-logarithms ==1.0.3.1,
|
any.integer-logarithms ==1.0.3.1,
|
||||||
integer-logarithms -check-bounds +integer-gmp,
|
integer-logarithms -check-bounds +integer-gmp,
|
||||||
any.invariant ==0.6.3,
|
any.invariant ==0.6.4,
|
||||||
any.iproute ==1.7.12,
|
any.iproute ==1.7.15,
|
||||||
any.kan-extensions ==5.2.6,
|
any.kan-extensions ==5.2.6,
|
||||||
any.language-c ==0.9.3,
|
any.language-c ==0.10.0,
|
||||||
language-c -allwarnings +iecfpextension +usebytestrings,
|
language-c +iecfpextension +usebytestrings,
|
||||||
any.lens ==5.3.2,
|
any.lens ==5.3.2,
|
||||||
lens -benchmark-uniplate -dump-splices +inlining -j +test-hunit +test-properties +test-templates +trustworthy,
|
lens -benchmark-uniplate -dump-splices +inlining -j +test-hunit +test-properties +test-templates +trustworthy,
|
||||||
any.lens-aeson ==1.2.3,
|
any.lens-aeson ==1.2.3,
|
||||||
any.lift-type ==0.1.1.1,
|
any.lift-type ==0.1.2.0,
|
||||||
any.lifted-base ==0.2.3.12,
|
any.lifted-base ==0.2.3.12,
|
||||||
any.linear ==1.22,
|
any.linear ==1.22,
|
||||||
linear -herbie +template-haskell,
|
linear -herbie +template-haskell,
|
||||||
any.megaparsec ==9.6.1,
|
any.megaparsec ==9.7.0,
|
||||||
megaparsec -dev,
|
megaparsec -dev,
|
||||||
any.memory ==0.18.0,
|
any.memory ==0.18.0,
|
||||||
memory +support_bytestring +support_deepseq,
|
memory +support_bytestring +support_deepseq,
|
||||||
|
|
@ -196,47 +202,57 @@ constraints: any.Cabal ==3.10.3.0,
|
||||||
any.microlens-mtl ==0.2.0.3,
|
any.microlens-mtl ==0.2.0.3,
|
||||||
any.microlens-th ==0.4.3.15,
|
any.microlens-th ==0.4.3.15,
|
||||||
any.mime-types ==0.1.2.0,
|
any.mime-types ==0.1.2.0,
|
||||||
|
any.mmorph ==1.2.0,
|
||||||
any.monad-control ==1.0.3.1,
|
any.monad-control ==1.0.3.1,
|
||||||
any.monad-logger ==0.3.40,
|
any.monad-logger ==0.3.40,
|
||||||
monad-logger +template_haskell,
|
monad-logger +template_haskell,
|
||||||
any.monad-loops ==0.4.3,
|
any.monad-loops ==0.4.3,
|
||||||
monad-loops +base4,
|
monad-loops +base4,
|
||||||
any.mono-traversable ==1.0.17.0,
|
any.mono-traversable ==1.0.21.0,
|
||||||
any.monomer ==1.6.0.1,
|
any.monomer ==1.6.0.1,
|
||||||
monomer -examples,
|
monomer -examples,
|
||||||
any.mtl ==2.3.1,
|
any.mtl ==2.3.1,
|
||||||
any.murmur3 ==1.0.5,
|
any.murmur3 ==1.0.5,
|
||||||
any.nanovg ==0.8.1.0,
|
any.nanovg ==0.8.1.0,
|
||||||
nanovg -examples -gl2 -gles3 -stb_truetype,
|
nanovg -examples -gl2 -gles3 -stb_truetype,
|
||||||
any.network ==3.2.1.0,
|
any.network ==3.2.7.0,
|
||||||
network -devel,
|
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.network-uri ==2.6.4.2,
|
||||||
any.old-locale ==1.0.0.7,
|
any.old-locale ==1.0.0.7,
|
||||||
any.old-time ==1.1.0.4,
|
any.old-time ==1.1.0.4,
|
||||||
any.os-string ==2.0.6,
|
any.optparse-applicative ==0.18.1.0,
|
||||||
|
optparse-applicative +process,
|
||||||
|
any.os-string ==2.0.7,
|
||||||
any.parallel ==3.2.2.0,
|
any.parallel ==3.2.2.0,
|
||||||
any.parsec ==3.1.16.1,
|
any.parsec ==3.1.16.1,
|
||||||
any.parser-combinators ==1.3.0,
|
any.parser-combinators ==1.3.0,
|
||||||
parser-combinators -dev,
|
parser-combinators -dev,
|
||||||
any.path-pieces ==0.2.1,
|
any.path-pieces ==0.2.1,
|
||||||
any.pem ==0.2.4,
|
any.pem ==0.2.4,
|
||||||
any.persistent ==2.14.6.1,
|
any.persistent ==2.14.6.3,
|
||||||
any.persistent-sqlite ==2.13.3.0,
|
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,
|
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.persistent-template ==2.12.0.0,
|
||||||
any.pretty ==1.1.3.6,
|
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.primitive ==0.9.0.0,
|
||||||
any.process ==1.6.19.0,
|
any.process ==1.6.19.0,
|
||||||
any.profunctors ==5.6.2,
|
any.profunctors ==5.6.2,
|
||||||
any.psqueues ==0.2.8.0,
|
any.psqueues ==0.2.8.0,
|
||||||
any.pureMD5 ==2.1.4,
|
any.pureMD5 ==2.1.4,
|
||||||
pureMD5 -test,
|
pureMD5 -test,
|
||||||
any.qrcode-core ==0.9.9,
|
any.qrcode-core ==0.9.10,
|
||||||
any.qrcode-juicypixels ==0.8.5,
|
any.qrcode-juicypixels ==0.8.6,
|
||||||
any.quickcheck-io ==0.2.0,
|
any.quickcheck-io ==0.2.0,
|
||||||
any.quickcheck-transformer ==0.3.1.2,
|
any.quickcheck-transformer ==0.3.1.2,
|
||||||
any.random ==1.2.1.2,
|
any.random ==1.2.1.2,
|
||||||
any.reflection ==2.1.8,
|
any.recv ==0.1.0,
|
||||||
|
any.reflection ==2.1.9,
|
||||||
reflection -slow +template-haskell,
|
reflection -slow +template-haskell,
|
||||||
any.regex-base ==0.94.0.2,
|
any.regex-base ==0.94.0.2,
|
||||||
any.regex-compat ==0.95.2.1,
|
any.regex-compat ==0.95.2.1,
|
||||||
|
|
@ -251,7 +267,7 @@ constraints: any.Cabal ==3.10.3.0,
|
||||||
scientific -integer-simple,
|
scientific -integer-simple,
|
||||||
any.sdl2 ==2.5.5.0,
|
any.sdl2 ==2.5.5.0,
|
||||||
sdl2 -examples -no-linear -opengl-example +pkgconfig +recent-ish,
|
sdl2 -examples -no-linear -opengl-example +pkgconfig +recent-ish,
|
||||||
any.secp256k1-haskell ==1.2.0,
|
any.secp256k1-haskell ==1.4.2,
|
||||||
any.semialign ==1.3.1,
|
any.semialign ==1.3.1,
|
||||||
semialign +semigroupoids,
|
semialign +semigroupoids,
|
||||||
any.semigroupoids ==6.0.1,
|
any.semigroupoids ==6.0.1,
|
||||||
|
|
@ -260,8 +276,15 @@ constraints: any.Cabal ==3.10.3.0,
|
||||||
semigroups +binary +bytestring -bytestring-builder +containers +deepseq +hashable +tagged +template-haskell +text +transformers +unordered-containers,
|
semigroups +binary +bytestring -bytestring-builder +containers +deepseq +hashable +tagged +template-haskell +text +transformers +unordered-containers,
|
||||||
any.serialise ==0.2.6.1,
|
any.serialise ==0.2.6.1,
|
||||||
serialise +newtime15,
|
serialise +newtime15,
|
||||||
any.silently ==1.2.5.3,
|
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.socks ==0.6.1,
|
any.socks ==0.6.1,
|
||||||
|
any.some ==1.0.6,
|
||||||
|
some +newtype-unsafe,
|
||||||
any.sop-core ==0.5.0.2,
|
any.sop-core ==0.5.0.2,
|
||||||
any.sort ==1.0.0.0,
|
any.sort ==1.0.0.0,
|
||||||
any.split ==0.2.5,
|
any.split ==0.2.5,
|
||||||
|
|
@ -274,8 +297,10 @@ constraints: any.Cabal ==3.10.3.0,
|
||||||
any.strict ==0.5.1,
|
any.strict ==0.5.1,
|
||||||
any.string-conversions ==0.4.0.1,
|
any.string-conversions ==0.4.0.1,
|
||||||
any.system-cxx-std-lib ==1.0,
|
any.system-cxx-std-lib ==1.0,
|
||||||
any.tagged ==0.8.8,
|
any.tagged ==0.8.9,
|
||||||
tagged +deepseq +transformers,
|
tagged +deepseq +transformers,
|
||||||
|
any.tasty ==1.5.2,
|
||||||
|
tasty +unix,
|
||||||
any.template-haskell ==2.20.0.0,
|
any.template-haskell ==2.20.0.0,
|
||||||
any.terminal-size ==0.3.4,
|
any.terminal-size ==0.3.4,
|
||||||
any.terminfo ==0.4.1.6,
|
any.terminfo ==0.4.1.6,
|
||||||
|
|
@ -283,41 +308,43 @@ constraints: any.Cabal ==3.10.3.0,
|
||||||
any.text-iso8601 ==0.1.1,
|
any.text-iso8601 ==0.1.1,
|
||||||
any.text-short ==0.1.6,
|
any.text-short ==0.1.6,
|
||||||
text-short -asserts,
|
text-short -asserts,
|
||||||
any.text-show ==3.10.5,
|
any.text-show ==3.11,
|
||||||
text-show +base-4-9 +integer-gmp +new-functor-classes +template-haskell-2-11,
|
text-show +integer-gmp,
|
||||||
any.text-zipper ==0.13,
|
any.text-zipper ==0.13,
|
||||||
any.tf-random ==0.5,
|
any.tf-random ==0.5,
|
||||||
any.th-abstraction ==0.7.0.0,
|
any.th-abstraction ==0.7.1.0,
|
||||||
any.th-compat ==0.1.5,
|
any.th-compat ==0.1.6,
|
||||||
any.th-lift ==0.8.4,
|
any.th-lift ==0.8.6,
|
||||||
any.th-lift-instances ==0.1.20,
|
any.th-lift-instances ==0.1.20,
|
||||||
any.these ==1.2.1,
|
any.these ==1.2.1,
|
||||||
any.time ==1.12.2,
|
any.time ==1.12.2,
|
||||||
any.time-compat ==1.9.7,
|
any.time-compat ==1.9.7,
|
||||||
any.time-locale-compat ==0.1.1.5,
|
any.time-locale-compat ==0.1.1.5,
|
||||||
time-locale-compat -old-locale,
|
time-locale-compat -old-locale,
|
||||||
any.tls ==2.1.0,
|
any.time-manager ==0.2.1,
|
||||||
|
any.tls ==2.1.5,
|
||||||
tls -devel,
|
tls -devel,
|
||||||
any.transformers ==0.6.1.0,
|
any.transformers ==0.6.1.0,
|
||||||
any.transformers-base ==0.4.6,
|
any.transformers-base ==0.4.6,
|
||||||
transformers-base +orphaninstances,
|
transformers-base +orphaninstances,
|
||||||
any.transformers-compat ==0.7.2,
|
any.transformers-compat ==0.7.2,
|
||||||
transformers-compat -five +five-three -four +generic-deriving +mtl -three -two,
|
transformers-compat -five +five-three -four +generic-deriving +mtl -three -two,
|
||||||
any.typed-process ==0.2.11.1,
|
any.typed-process ==0.2.12.0,
|
||||||
any.unix ==2.8.4.0,
|
any.unix ==2.8.4.0,
|
||||||
any.unix-compat ==0.7.2,
|
any.unix-compat ==0.7.3,
|
||||||
any.unix-time ==0.4.15,
|
any.unix-time ==0.4.16,
|
||||||
any.unliftio ==0.2.25.0,
|
any.unliftio ==0.2.25.0,
|
||||||
any.unliftio-core ==0.2.1.0,
|
any.unliftio-core ==0.2.1.0,
|
||||||
any.unordered-containers ==0.2.20,
|
any.unordered-containers ==0.2.20,
|
||||||
unordered-containers -debug,
|
unordered-containers -debug,
|
||||||
any.utf8-string ==1.0.2,
|
any.utf8-string ==1.0.2,
|
||||||
|
any.uuid ==1.3.16,
|
||||||
any.uuid-types ==1.0.6,
|
any.uuid-types ==1.0.6,
|
||||||
any.vault ==0.3.1.5,
|
any.vault ==0.3.1.5,
|
||||||
vault +useghc,
|
vault +useghc,
|
||||||
any.vector ==0.13.1.0,
|
any.vector ==0.13.2.0,
|
||||||
vector +boundschecks -internalchecks -unsafechecks -wall,
|
vector +boundschecks -internalchecks -unsafechecks -wall,
|
||||||
any.vector-algorithms ==0.9.0.2,
|
any.vector-algorithms ==0.9.0.3,
|
||||||
vector-algorithms +bench +boundschecks -internalchecks -llvm +properties -unsafechecks,
|
vector-algorithms +bench +boundschecks -internalchecks -llvm +properties -unsafechecks,
|
||||||
any.vector-stream ==0.1.0.1,
|
any.vector-stream ==0.1.0.1,
|
||||||
any.void ==0.7.3,
|
any.void ==0.7.3,
|
||||||
|
|
@ -326,11 +353,20 @@ constraints: any.Cabal ==3.10.3.0,
|
||||||
any.vty-crossplatform ==0.4.0.0,
|
any.vty-crossplatform ==0.4.0.0,
|
||||||
vty-crossplatform -demos,
|
vty-crossplatform -demos,
|
||||||
any.vty-unix ==0.2.0.0,
|
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.wide-word ==0.1.6.0,
|
||||||
any.witherable ==0.5,
|
any.witherable ==0.5,
|
||||||
any.word-wrap ==0.5,
|
any.word-wrap ==0.5,
|
||||||
|
any.word8 ==0.1.3,
|
||||||
any.wreq ==0.5.4.3,
|
any.wreq ==0.5.4.3,
|
||||||
wreq -aws -developer +doctest -httpbin,
|
wreq -aws -developer +doctest -httpbin,
|
||||||
any.zlib ==0.7.1.0,
|
any.zlib ==0.7.1.0,
|
||||||
zlib -bundled-c-zlib +non-blocking-ffi +pkg-config
|
zlib -bundled-c-zlib +non-blocking-ffi +pkg-config
|
||||||
index-state: hackage.haskell.org 2024-07-10T18:40:26Z
|
index-state: hackage.haskell.org 2024-12-14T09:52:48Z
|
||||||
|
|
|
||||||
Binary file not shown.
Binary file not shown.
File diff suppressed because it is too large
Load diff
1452
src/Zenith/Core.hs
1452
src/Zenith/Core.hs
File diff suppressed because it is too large
Load diff
1683
src/Zenith/DB.hs
1683
src/Zenith/DB.hs
File diff suppressed because it is too large
Load diff
1074
src/Zenith/GUI.hs
1074
src/Zenith/GUI.hs
File diff suppressed because it is too large
Load diff
|
|
@ -49,6 +49,9 @@ zenithTheme =
|
||||||
L.active .
|
L.active .
|
||||||
L.btnStyle . L.text ?~
|
L.btnStyle . L.text ?~
|
||||||
baseTextStyle &
|
baseTextStyle &
|
||||||
|
L.disabled .
|
||||||
|
L.btnStyle . L.text ?~
|
||||||
|
baseTextStyle &
|
||||||
L.basic .
|
L.basic .
|
||||||
L.btnMainStyle . L.text ?~
|
L.btnMainStyle . L.text ?~
|
||||||
hiliteTextStyle &
|
hiliteTextStyle &
|
||||||
|
|
|
||||||
1113
src/Zenith/RPC.hs
Normal file
1113
src/Zenith/RPC.hs
Normal file
File diff suppressed because it is too large
Load diff
|
|
@ -2,29 +2,28 @@
|
||||||
|
|
||||||
module Zenith.Scanner where
|
module Zenith.Scanner where
|
||||||
|
|
||||||
|
import Control.Concurrent.Async (concurrently_, withAsync)
|
||||||
import Control.Exception (throwIO, try)
|
import Control.Exception (throwIO, try)
|
||||||
import qualified Control.Monad.Catch as CM (try)
|
import Control.Monad (when)
|
||||||
import Control.Monad.IO.Class (liftIO)
|
import Control.Monad.IO.Class (liftIO)
|
||||||
import Control.Monad.Logger
|
import Control.Monad.Logger
|
||||||
( LoggingT
|
( NoLoggingT
|
||||||
, NoLoggingT
|
|
||||||
, logErrorN
|
, logErrorN
|
||||||
, logInfoN
|
, logInfoN
|
||||||
, runNoLoggingT
|
, runNoLoggingT
|
||||||
|
, runStderrLoggingT
|
||||||
)
|
)
|
||||||
import Data.Aeson
|
import Data.Aeson
|
||||||
import Data.HexString
|
import Data.HexString
|
||||||
import Data.Maybe
|
|
||||||
import qualified Data.Text as T
|
import qualified Data.Text as T
|
||||||
import Data.Time (getCurrentTime)
|
import Data.Time (getCurrentTime)
|
||||||
import Database.Persist.Sqlite
|
import Database.Persist.Sqlite
|
||||||
import GHC.Utils.Monad (concatMapM)
|
|
||||||
import Lens.Micro ((&), (.~), (^.), set)
|
|
||||||
import System.Console.AsciiProgress
|
import System.Console.AsciiProgress
|
||||||
import ZcashHaskell.Types
|
import ZcashHaskell.Types
|
||||||
( BlockResponse(..)
|
( BlockResponse(..)
|
||||||
, RawZebraTx(..)
|
, RawZebraTx(..)
|
||||||
, Transaction(..)
|
, Transaction(..)
|
||||||
|
, ZcashNet(..)
|
||||||
, ZebraGetBlockChainInfo(..)
|
, ZebraGetBlockChainInfo(..)
|
||||||
, ZebraTxResponse(..)
|
, ZebraTxResponse(..)
|
||||||
, fromRawOBundle
|
, fromRawOBundle
|
||||||
|
|
@ -32,59 +31,85 @@ import ZcashHaskell.Types
|
||||||
, fromRawTBundle
|
, fromRawTBundle
|
||||||
)
|
)
|
||||||
import ZcashHaskell.Utils (getBlockTime, makeZebraCall, readZebraTransaction)
|
import ZcashHaskell.Utils (getBlockTime, makeZebraCall, readZebraTransaction)
|
||||||
import Zenith.Core (checkBlockChain)
|
import Zenith.Core (checkBlockChain, syncWallet, updateCommitmentTrees)
|
||||||
import Zenith.DB
|
import Zenith.DB
|
||||||
( getMaxBlock
|
( ZcashBlock(..)
|
||||||
|
, ZcashBlockId
|
||||||
|
, clearWalletData
|
||||||
|
, clearWalletTransactions
|
||||||
|
, completeSync
|
||||||
|
, getBlock
|
||||||
|
, getMaxBlock
|
||||||
|
, getMinBirthdayHeight
|
||||||
, getUnconfirmedBlocks
|
, getUnconfirmedBlocks
|
||||||
|
, getWallets
|
||||||
, initDb
|
, initDb
|
||||||
|
, initPool
|
||||||
|
, saveBlock
|
||||||
, saveConfs
|
, saveConfs
|
||||||
, saveTransaction
|
, saveTransaction
|
||||||
|
, startSync
|
||||||
|
, updateWalletSync
|
||||||
|
, upgradeQrTable
|
||||||
|
)
|
||||||
|
import Zenith.Types
|
||||||
|
( Config(..)
|
||||||
|
, HexStringDB(..)
|
||||||
|
, ZcashNetDB(..)
|
||||||
|
, ZenithStatus(..)
|
||||||
)
|
)
|
||||||
import Zenith.Utils (jsonNumber)
|
import Zenith.Utils (jsonNumber)
|
||||||
|
|
||||||
-- | Function to scan the Zcash blockchain through the Zebra node and populate the Zenith database
|
-- | Function to scan the Zcash blockchain through the Zebra node and populate the Zenith database
|
||||||
scanZebra ::
|
rescanZebra ::
|
||||||
Int -- ^ Starting block
|
T.Text -- ^ Host
|
||||||
-> T.Text -- ^ Host
|
|
||||||
-> Int -- ^ Port
|
-> Int -- ^ Port
|
||||||
-> T.Text -- ^ Path to database file
|
-> T.Text -- ^ Path to database file
|
||||||
-> NoLoggingT IO ()
|
-> IO ()
|
||||||
scanZebra b host port dbFilePath = do
|
rescanZebra host port dbFilePath = do
|
||||||
_ <- liftIO $ initDb dbFilePath
|
|
||||||
startTime <- liftIO getCurrentTime
|
|
||||||
logInfoN $ "Started sync: " <> T.pack (show startTime)
|
|
||||||
bc <-
|
bc <-
|
||||||
liftIO $ try $ checkBlockChain host port :: NoLoggingT
|
try $ checkBlockChain host port :: IO
|
||||||
IO
|
|
||||||
(Either IOError ZebraGetBlockChainInfo)
|
(Either IOError ZebraGetBlockChainInfo)
|
||||||
case bc of
|
case bc of
|
||||||
Left e -> logErrorN $ T.pack (show e)
|
Left e -> print e
|
||||||
Right bStatus -> do
|
Right bStatus -> do
|
||||||
let dbInfo =
|
let znet = ZcashNetDB $ zgb_net bStatus
|
||||||
mkSqliteConnectionInfo dbFilePath & extraPragmas .~
|
pool1 <- runNoLoggingT $ initPool dbFilePath
|
||||||
["read_uncommited = true"]
|
{-pool2 <- runNoLoggingT $ initPool dbFilePath-}
|
||||||
pool <- createSqlitePoolFromInfo dbInfo 5
|
{-pool3 <- runNoLoggingT $ initPool dbFilePath-}
|
||||||
dbBlock <- getMaxBlock pool
|
_ <- initDb dbFilePath
|
||||||
|
upgradeQrTable pool1
|
||||||
|
clearWalletTransactions pool1
|
||||||
|
clearWalletData pool1
|
||||||
|
_ <- startSync pool1
|
||||||
|
dbBlock <- getMaxBlock pool1 znet
|
||||||
|
b <- liftIO $ getMinBirthdayHeight pool1 znet
|
||||||
let sb = max dbBlock b
|
let sb = max dbBlock b
|
||||||
if sb > zgb_blocks bStatus || sb < 1
|
if sb > zgb_blocks bStatus || sb < 1
|
||||||
then liftIO $ throwIO $ userError "Invalid starting block for scan"
|
then liftIO $ throwIO $ userError "Invalid starting block for scan"
|
||||||
else do
|
else do
|
||||||
liftIO $
|
print $
|
||||||
print $
|
"Scanning from " ++ show sb ++ " to " ++ show (zgb_blocks bStatus)
|
||||||
"Scanning from " ++
|
let bList = [sb .. (zgb_blocks bStatus)]
|
||||||
show (sb + 1) ++ " to " ++ show (zgb_blocks bStatus)
|
{-
|
||||||
let bList = [(sb + 1) .. (zgb_blocks bStatus)]
|
let batch = length bList `div` 3
|
||||||
displayConsoleRegions $ do
|
let bl1 = take batch bList
|
||||||
pg <-
|
let bl2 = take batch $ drop batch bList
|
||||||
liftIO $
|
let bl3 = drop (2 * batch) bList
|
||||||
newProgressBar def {pgTotal = fromIntegral $ length bList}
|
-}
|
||||||
txList <-
|
_ <-
|
||||||
CM.try $ mapM_ (processBlock host port pool pg) bList :: NoLoggingT
|
displayConsoleRegions $ do
|
||||||
IO
|
pg1 <- newProgressBar def {pgTotal = fromIntegral $ length bList}
|
||||||
(Either IOError ())
|
{-pg2 <- newProgressBar def {pgTotal = fromIntegral $ length bl2}-}
|
||||||
case txList of
|
{-pg3 <- newProgressBar def {pgTotal = fromIntegral $ length bl3}-}
|
||||||
Left e1 -> logErrorN $ T.pack (show e1)
|
mapM_ (processBlock host port pool1 pg1 znet) bList
|
||||||
Right txList' -> logInfoN "Finished scan"
|
{-`concurrently_`-}
|
||||||
|
{-mapM_ (processBlock host port pool2 pg2 znet) bl2 `concurrently_`-}
|
||||||
|
{-mapM_ (processBlock host port pool3 pg3 znet) bl3-}
|
||||||
|
print "Please wait..."
|
||||||
|
_ <- completeSync pool1 Successful
|
||||||
|
_ <- runNoLoggingT $ updateCommitmentTrees pool1 host port znet
|
||||||
|
print "Rescan complete"
|
||||||
|
|
||||||
-- | Function to process a raw block and extract the transaction information
|
-- | Function to process a raw block and extract the transaction information
|
||||||
processBlock ::
|
processBlock ::
|
||||||
|
|
@ -92,9 +117,10 @@ processBlock ::
|
||||||
-> Int -- ^ Port for `zebrad`
|
-> Int -- ^ Port for `zebrad`
|
||||||
-> ConnectionPool -- ^ DB file path
|
-> ConnectionPool -- ^ DB file path
|
||||||
-> ProgressBar -- ^ Progress bar
|
-> ProgressBar -- ^ Progress bar
|
||||||
|
-> ZcashNetDB -- ^ the network
|
||||||
-> Int -- ^ The block number to process
|
-> Int -- ^ The block number to process
|
||||||
-> NoLoggingT IO ()
|
-> IO ()
|
||||||
processBlock host port pool pg b = do
|
processBlock host port pool pg net b = do
|
||||||
r <-
|
r <-
|
||||||
liftIO $
|
liftIO $
|
||||||
makeZebraCall
|
makeZebraCall
|
||||||
|
|
@ -103,39 +129,29 @@ processBlock host port pool pg b = do
|
||||||
"getblock"
|
"getblock"
|
||||||
[Data.Aeson.String $ T.pack $ show b, jsonNumber 1]
|
[Data.Aeson.String $ T.pack $ show b, jsonNumber 1]
|
||||||
case r of
|
case r of
|
||||||
Left e -> liftIO $ throwIO $ userError e
|
Left e -> do
|
||||||
|
_ <- completeSync pool Failed
|
||||||
|
liftIO $ throwIO $ userError e
|
||||||
Right blk -> do
|
Right blk -> do
|
||||||
r2 <-
|
bi <-
|
||||||
liftIO $
|
saveBlock pool $
|
||||||
makeZebraCall
|
ZcashBlock
|
||||||
host
|
(fromIntegral $ bl_height blk)
|
||||||
port
|
(HexStringDB $ bl_hash blk)
|
||||||
"getblock"
|
(fromIntegral $ bl_confirmations blk)
|
||||||
[Data.Aeson.String $ T.pack $ show b, jsonNumber 0]
|
(fromIntegral $ bl_time blk)
|
||||||
case r2 of
|
net
|
||||||
Left e2 -> liftIO $ throwIO $ userError e2
|
mapM_ (processTx host port bi pool) $ bl_txs blk
|
||||||
Right hb -> do
|
liftIO $ tick pg
|
||||||
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
|
-- | Function to process a raw transaction
|
||||||
processTx ::
|
processTx ::
|
||||||
T.Text -- ^ Host name for `zebrad`
|
T.Text -- ^ Host name for `zebrad`
|
||||||
-> Int -- ^ Port for `zebrad`
|
-> Int -- ^ Port for `zebrad`
|
||||||
-> Int -- ^ Block time
|
-> ZcashBlockId -- ^ Block ID
|
||||||
-> ConnectionPool -- ^ DB file path
|
-> ConnectionPool -- ^ DB file path
|
||||||
-> HexString -- ^ transaction id
|
-> HexString -- ^ transaction id
|
||||||
-> NoLoggingT IO ()
|
-> IO ()
|
||||||
processTx host port bt pool t = do
|
processTx host port bt pool t = do
|
||||||
r <-
|
r <-
|
||||||
liftIO $
|
liftIO $
|
||||||
|
|
@ -145,12 +161,15 @@ processTx host port bt pool t = do
|
||||||
"getrawtransaction"
|
"getrawtransaction"
|
||||||
[Data.Aeson.String $ toText t, jsonNumber 1]
|
[Data.Aeson.String $ toText t, jsonNumber 1]
|
||||||
case r of
|
case r of
|
||||||
Left e -> liftIO $ throwIO $ userError e
|
Left e -> do
|
||||||
|
_ <- completeSync pool Failed
|
||||||
|
liftIO $ throwIO $ userError e
|
||||||
Right rawTx -> do
|
Right rawTx -> do
|
||||||
case readZebraTransaction (ztr_hex rawTx) of
|
case readZebraTransaction (ztr_hex rawTx) of
|
||||||
Nothing -> return ()
|
Nothing -> return ()
|
||||||
Just rzt -> do
|
Just rzt -> do
|
||||||
_ <-
|
_ <-
|
||||||
|
runNoLoggingT $
|
||||||
saveTransaction pool bt $
|
saveTransaction pool bt $
|
||||||
Transaction
|
Transaction
|
||||||
t
|
t
|
||||||
|
|
@ -184,3 +203,59 @@ updateConfs host port pool = do
|
||||||
Left e -> throwIO $ userError e
|
Left e -> throwIO $ userError e
|
||||||
Right blk -> do
|
Right blk -> do
|
||||||
saveConfs pool b $ fromInteger $ bl_confirmations blk
|
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)
|
||||||
|
|
|
||||||
400
src/Zenith/Tree.hs
Normal file
400
src/Zenith/Tree.hs
Normal file
|
|
@ -0,0 +1,400 @@
|
||||||
|
{-# 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,23 +10,37 @@
|
||||||
module Zenith.Types where
|
module Zenith.Types where
|
||||||
|
|
||||||
import Data.Aeson
|
import Data.Aeson
|
||||||
|
import Data.Aeson.TH (deriveJSON)
|
||||||
import qualified Data.ByteString as BS
|
import qualified Data.ByteString as BS
|
||||||
import qualified Data.ByteString.Base64 as B64
|
import qualified Data.ByteString.Base64 as B64
|
||||||
import qualified Data.ByteString.Char8 as C
|
import qualified Data.ByteString.Char8 as C
|
||||||
import Data.HexString
|
import Data.HexString
|
||||||
|
import Data.Int (Int64)
|
||||||
import Data.Maybe (fromMaybe)
|
import Data.Maybe (fromMaybe)
|
||||||
|
import Data.Scientific (Scientific)
|
||||||
import qualified Data.Text as T
|
import qualified Data.Text as T
|
||||||
import qualified Data.Text.Encoding as E
|
import qualified Data.Text.Encoding as E
|
||||||
import Data.Text.Encoding.Error (lenientDecode)
|
import Data.Text.Encoding.Error (lenientDecode)
|
||||||
|
import qualified Data.UUID as U
|
||||||
import Database.Persist.TH
|
import Database.Persist.TH
|
||||||
import GHC.Generics
|
import GHC.Generics
|
||||||
|
import ZcashHaskell.Orchard (encodeUnifiedAddress, parseAddress)
|
||||||
|
import ZcashHaskell.Sapling (encodeSaplingAddress)
|
||||||
|
import ZcashHaskell.Transparent
|
||||||
|
( encodeExchangeAddress
|
||||||
|
, encodeTransparentReceiver
|
||||||
|
)
|
||||||
import ZcashHaskell.Types
|
import ZcashHaskell.Types
|
||||||
( OrchardSpendingKey(..)
|
( ExchangeAddress(..)
|
||||||
|
, OrchardSpendingKey(..)
|
||||||
, Phrase(..)
|
, Phrase(..)
|
||||||
, Rseed(..)
|
, Rseed(..)
|
||||||
|
, SaplingAddress(..)
|
||||||
, SaplingSpendingKey(..)
|
, SaplingSpendingKey(..)
|
||||||
, Scope(..)
|
, Scope(..)
|
||||||
|
, TransparentAddress(..)
|
||||||
, TransparentSpendingKey
|
, TransparentSpendingKey
|
||||||
|
, ValidAddress(..)
|
||||||
, ZcashNet(..)
|
, ZcashNet(..)
|
||||||
)
|
)
|
||||||
|
|
||||||
|
|
@ -42,6 +56,9 @@ newtype ZcashNetDB = ZcashNetDB
|
||||||
{ getNet :: ZcashNet
|
{ getNet :: ZcashNet
|
||||||
} deriving newtype (Eq, Show, Read)
|
} deriving newtype (Eq, Show, Read)
|
||||||
|
|
||||||
|
instance ToJSON ZcashNetDB where
|
||||||
|
toJSON (ZcashNetDB z) = toJSON z
|
||||||
|
|
||||||
derivePersistField "ZcashNetDB"
|
derivePersistField "ZcashNetDB"
|
||||||
|
|
||||||
newtype UnifiedAddressDB = UnifiedAddressDB
|
newtype UnifiedAddressDB = UnifiedAddressDB
|
||||||
|
|
@ -92,8 +109,165 @@ data Config = Config
|
||||||
{ c_dbPath :: !T.Text
|
{ c_dbPath :: !T.Text
|
||||||
, c_zebraHost :: !T.Text
|
, c_zebraHost :: !T.Text
|
||||||
, c_zebraPort :: !Int
|
, c_zebraPort :: !Int
|
||||||
|
, c_zenithUser :: !BS.ByteString
|
||||||
|
, c_zenithPwd :: !BS.ByteString
|
||||||
|
, c_zenithPort :: !Int
|
||||||
} deriving (Eq, Prelude.Show)
|
} 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`
|
-- ** `zebrad`
|
||||||
-- | Type for modeling the tree state response
|
-- | Type for modeling the tree state response
|
||||||
data ZebraTreeInfo = ZebraTreeInfo
|
data ZebraTreeInfo = ZebraTreeInfo
|
||||||
|
|
@ -138,24 +312,6 @@ instance FromJSON AddressSource where
|
||||||
"mnemonic_seed" -> return MnemonicSeed
|
"mnemonic_seed" -> return MnemonicSeed
|
||||||
_ -> fail "Not a known address source"
|
_ -> 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
|
data ZcashAddress = ZcashAddress
|
||||||
{ source :: AddressSource
|
{ source :: AddressSource
|
||||||
, pool :: [ZcashPool]
|
, pool :: [ZcashPool]
|
||||||
|
|
@ -203,7 +359,8 @@ instance FromJSON AddressGroup where
|
||||||
Nothing -> return []
|
Nothing -> return []
|
||||||
Just x -> do
|
Just x -> do
|
||||||
x' <- x .:? "addresses"
|
x' <- x .:? "addresses"
|
||||||
return $ maybe [] (map (ZcashAddress s1 [Transparent] Nothing)) x'
|
return $
|
||||||
|
maybe [] (map (ZcashAddress s1 [TransparentPool] Nothing)) x'
|
||||||
processSapling k s2 =
|
processSapling k s2 =
|
||||||
case k of
|
case k of
|
||||||
Nothing -> return []
|
Nothing -> return []
|
||||||
|
|
@ -211,7 +368,7 @@ instance FromJSON AddressGroup where
|
||||||
where processOneSapling sx =
|
where processOneSapling sx =
|
||||||
withObject "Sapling" $ \oS -> do
|
withObject "Sapling" $ \oS -> do
|
||||||
oS' <- oS .: "addresses"
|
oS' <- oS .: "addresses"
|
||||||
return $ map (ZcashAddress sx [Sapling] Nothing) oS'
|
return $ map (ZcashAddress sx [SaplingPool] Nothing) oS'
|
||||||
processUnified u =
|
processUnified u =
|
||||||
case u of
|
case u of
|
||||||
Nothing -> return []
|
Nothing -> return []
|
||||||
|
|
|
||||||
|
|
@ -3,28 +3,38 @@
|
||||||
module Zenith.Utils where
|
module Zenith.Utils where
|
||||||
|
|
||||||
import Data.Aeson
|
import Data.Aeson
|
||||||
|
import Data.Char (isAlphaNum, isSpace)
|
||||||
import Data.Functor (void)
|
import Data.Functor (void)
|
||||||
import Data.Maybe
|
import Data.Maybe
|
||||||
import Data.Ord (clamp)
|
import Data.Ord (clamp)
|
||||||
import Data.Scientific (Scientific(..), scientific)
|
import Data.Scientific (Scientific(..), scientific)
|
||||||
import qualified Data.Text as T
|
import qualified Data.Text as T
|
||||||
import qualified Data.Text.Encoding as E
|
import qualified Data.Text.Encoding as E
|
||||||
|
import System.Directory
|
||||||
import System.Process (createProcess_, shell)
|
import System.Process (createProcess_, shell)
|
||||||
import Text.Regex.Posix
|
import Text.Regex.Posix
|
||||||
import ZcashHaskell.Orchard (encodeUnifiedAddress, isValidUnifiedAddress)
|
import ZcashHaskell.Orchard
|
||||||
|
( encodeUnifiedAddress
|
||||||
|
, isValidUnifiedAddress
|
||||||
|
, parseAddress
|
||||||
|
)
|
||||||
import ZcashHaskell.Sapling (decodeSaplingAddress, isValidShieldedAddress)
|
import ZcashHaskell.Sapling (decodeSaplingAddress, isValidShieldedAddress)
|
||||||
import ZcashHaskell.Transparent
|
import ZcashHaskell.Transparent
|
||||||
( decodeExchangeAddress
|
( decodeExchangeAddress
|
||||||
, decodeTransparentAddress
|
, decodeTransparentAddress
|
||||||
)
|
)
|
||||||
import ZcashHaskell.Types
|
import ZcashHaskell.Types
|
||||||
( SaplingAddress(..)
|
( ExchangeAddress(..)
|
||||||
|
, SaplingAddress(..)
|
||||||
, TransparentAddress(..)
|
, TransparentAddress(..)
|
||||||
, UnifiedAddress(..)
|
, UnifiedAddress(..)
|
||||||
|
, ValidAddress(..)
|
||||||
, ZcashNet(..)
|
, ZcashNet(..)
|
||||||
)
|
)
|
||||||
|
import ZcashHaskell.Utils (makeZebraCall)
|
||||||
import Zenith.Types
|
import Zenith.Types
|
||||||
( AddressGroup(..)
|
( AddressGroup(..)
|
||||||
|
, PrivacyPolicy(..)
|
||||||
, UnifiedAddressDB(..)
|
, UnifiedAddressDB(..)
|
||||||
, ZcashAddress(..)
|
, ZcashAddress(..)
|
||||||
, ZcashPool(..)
|
, ZcashPool(..)
|
||||||
|
|
@ -69,9 +79,9 @@ getAddresses ag = agtransparent ag <> agsapling ag <> agunified ag
|
||||||
-- | Helper function to validate potential Zcash addresses
|
-- | Helper function to validate potential Zcash addresses
|
||||||
validateAddress :: T.Text -> Maybe ZcashPool
|
validateAddress :: T.Text -> Maybe ZcashPool
|
||||||
validateAddress txt --(tReg || sReg && isJust chk) || (uReg && isJust chk)
|
validateAddress txt --(tReg || sReg && isJust chk) || (uReg && isJust chk)
|
||||||
| tReg = Just Transparent
|
| tReg = Just TransparentPool
|
||||||
| sReg && chkS = Just Sapling
|
| sReg && chkS = Just SaplingPool
|
||||||
| uReg && chk = Just Orchard
|
| uReg && chk = Just OrchardPool
|
||||||
| otherwise = Nothing
|
| otherwise = Nothing
|
||||||
where
|
where
|
||||||
transparentRegex = "^t1[a-zA-Z0-9]{33}$" :: String
|
transparentRegex = "^t1[a-zA-Z0-9]{33}$" :: String
|
||||||
|
|
@ -83,6 +93,13 @@ validateAddress txt --(tReg || sReg && isJust chk) || (uReg && isJust chk)
|
||||||
chk = isJust $ isValidUnifiedAddress $ E.encodeUtf8 txt
|
chk = isJust $ isValidUnifiedAddress $ E.encodeUtf8 txt
|
||||||
chkS = isValidShieldedAddress $ 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
|
-- | Copy an address to the clipboard
|
||||||
copyAddress :: ZcashAddress -> IO ()
|
copyAddress :: ZcashAddress -> IO ()
|
||||||
copyAddress a =
|
copyAddress a =
|
||||||
|
|
@ -90,12 +107,18 @@ copyAddress a =
|
||||||
createProcess_ "toClipboard" $
|
createProcess_ "toClipboard" $
|
||||||
shell $ "echo " ++ T.unpack (addy a) ++ " | xclip -r -selection clipboard"
|
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
|
-- | Bound a value to the 0..1 range, used for progress reporting on UIs
|
||||||
validBarValue :: Float -> Float
|
validBarValue :: Float -> Float
|
||||||
validBarValue = clamp (0, 1)
|
validBarValue = clamp (0, 1)
|
||||||
|
|
||||||
isRecipientValid :: T.Text -> Bool
|
isRecipientValid :: T.Text -> Bool
|
||||||
isRecipientValid a =
|
isRecipientValid a = do
|
||||||
case isValidUnifiedAddress (E.encodeUtf8 a) of
|
case isValidUnifiedAddress (E.encodeUtf8 a) of
|
||||||
Just _a1 -> True
|
Just _a1 -> True
|
||||||
Nothing ->
|
Nothing ->
|
||||||
|
|
@ -103,12 +126,84 @@ isRecipientValid a =
|
||||||
(case decodeTransparentAddress (E.encodeUtf8 a) of
|
(case decodeTransparentAddress (E.encodeUtf8 a) of
|
||||||
Just _a3 -> True
|
Just _a3 -> True
|
||||||
Nothing ->
|
Nothing ->
|
||||||
case decodeExchangeAddress a of
|
case decodeExchangeAddress (E.encodeUtf8 a) of
|
||||||
Just _a4 -> True
|
Just _a4 -> True
|
||||||
Nothing -> False)
|
Nothing -> False)
|
||||||
|
|
||||||
parseAddress :: T.Text -> ZcashNet -> Maybe UnifiedAddress
|
isUnifiedAddressValid :: T.Text -> Bool
|
||||||
parseAddress a znet =
|
isUnifiedAddressValid ua =
|
||||||
|
case isValidUnifiedAddress (E.encodeUtf8 ua) of
|
||||||
|
Just _a1 -> True
|
||||||
|
Nothing -> False
|
||||||
|
|
||||||
|
isSaplingAddressValid :: T.Text -> Bool
|
||||||
|
isSaplingAddressValid sa = isValidShieldedAddress (E.encodeUtf8 sa)
|
||||||
|
|
||||||
|
isTransparentAddressValid :: T.Text -> Bool
|
||||||
|
isTransparentAddressValid ta =
|
||||||
|
case decodeTransparentAddress (E.encodeUtf8 ta) of
|
||||||
|
Just _a3 -> True
|
||||||
|
Nothing -> False
|
||||||
|
|
||||||
|
isExchangeAddressValid :: T.Text -> Bool
|
||||||
|
isExchangeAddressValid xa =
|
||||||
|
case decodeExchangeAddress (E.encodeUtf8 xa) of
|
||||||
|
Just _a4 -> True
|
||||||
|
Nothing -> False
|
||||||
|
|
||||||
|
isRecipientValidGUI :: PrivacyPolicy -> T.Text -> Bool
|
||||||
|
isRecipientValidGUI p a = do
|
||||||
|
let adr = parseAddress (E.encodeUtf8 a)
|
||||||
|
case p of
|
||||||
|
Full ->
|
||||||
|
case adr of
|
||||||
|
Just a ->
|
||||||
|
case a of
|
||||||
|
Unified ua -> True
|
||||||
|
Sapling sa -> True
|
||||||
|
_ -> False
|
||||||
|
Nothing -> False
|
||||||
|
Medium ->
|
||||||
|
case adr of
|
||||||
|
Just a ->
|
||||||
|
case a of
|
||||||
|
Unified ua -> True
|
||||||
|
Sapling sa -> True
|
||||||
|
_ -> False
|
||||||
|
Nothing -> False
|
||||||
|
Low ->
|
||||||
|
case adr of
|
||||||
|
Just a ->
|
||||||
|
case a of
|
||||||
|
Unified ua -> True
|
||||||
|
Sapling sa -> True
|
||||||
|
Transparent ta -> True
|
||||||
|
_ -> False
|
||||||
|
Nothing -> False
|
||||||
|
None ->
|
||||||
|
case adr of
|
||||||
|
Just a ->
|
||||||
|
case a of
|
||||||
|
Transparent ta -> True
|
||||||
|
Exchange ea -> True
|
||||||
|
_ -> False
|
||||||
|
Nothing -> False
|
||||||
|
|
||||||
|
isZecAddressValid :: T.Text -> Bool
|
||||||
|
isZecAddressValid a = do
|
||||||
|
case isValidUnifiedAddress (E.encodeUtf8 a) of
|
||||||
|
Just _a1 -> True
|
||||||
|
Nothing ->
|
||||||
|
isValidShieldedAddress (E.encodeUtf8 a) ||
|
||||||
|
(case decodeTransparentAddress (E.encodeUtf8 a) of
|
||||||
|
Just _a3 -> True
|
||||||
|
Nothing ->
|
||||||
|
case decodeExchangeAddress (E.encodeUtf8 a) of
|
||||||
|
Just _a4 -> True
|
||||||
|
Nothing -> False)
|
||||||
|
|
||||||
|
parseAddressUA :: T.Text -> ZcashNet -> Maybe UnifiedAddress
|
||||||
|
parseAddressUA a znet =
|
||||||
case isValidUnifiedAddress (E.encodeUtf8 a) of
|
case isValidUnifiedAddress (E.encodeUtf8 a) of
|
||||||
Just a1 -> Just a1
|
Just a1 -> Just a1
|
||||||
Nothing ->
|
Nothing ->
|
||||||
|
|
@ -120,3 +215,39 @@ parseAddress a znet =
|
||||||
Just a3 ->
|
Just a3 ->
|
||||||
Just $ UnifiedAddress znet Nothing Nothing (Just $ ta_receiver a3)
|
Just $ UnifiedAddress znet Nothing Nothing (Just $ ta_receiver a3)
|
||||||
Nothing -> Nothing
|
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
|
||||||
|
|
||||||
|
getTransparentFromUA :: UnifiedAddress -> Maybe TransparentAddress
|
||||||
|
getTransparentFromUA ua = TransparentAddress (ua_net ua) <$> t_rec ua
|
||||||
|
|
|
||||||
|
|
@ -123,9 +123,10 @@ sendTx user pwd fromAddy toAddy amount memo = do
|
||||||
if source fromAddy /= ImportedWatchOnly
|
if source fromAddy /= ImportedWatchOnly
|
||||||
then do
|
then do
|
||||||
let privacyPolicy
|
let privacyPolicy
|
||||||
| valAdd == Just Transparent = "AllowRevealedRecipients"
|
| valAdd == Just TransparentPool = "AllowRevealedRecipients"
|
||||||
| isNothing (account fromAddy) &&
|
| isNothing (account fromAddy) &&
|
||||||
elem Transparent (pool fromAddy) = "AllowRevealedSenders"
|
elem TransparentPool (pool fromAddy) =
|
||||||
|
"AllowRevealedSenders"
|
||||||
| otherwise = "AllowRevealedAmounts"
|
| otherwise = "AllowRevealedAmounts"
|
||||||
let pd =
|
let pd =
|
||||||
case memo of
|
case memo of
|
||||||
|
|
@ -301,7 +302,7 @@ sendWithUri user pwd fromAddy uri repTo = do
|
||||||
let addType = validateAddress $ T.pack parsedAddress
|
let addType = validateAddress $ T.pack parsedAddress
|
||||||
case addType of
|
case addType of
|
||||||
Nothing -> putStrLn " Invalid address"
|
Nothing -> putStrLn " Invalid address"
|
||||||
Just Transparent -> do
|
Just TransparentPool -> do
|
||||||
putStrLn $ " Address is valid: " ++ parsedAddress
|
putStrLn $ " Address is valid: " ++ parsedAddress
|
||||||
case (readMaybe parsedAmount :: Maybe Double) of
|
case (readMaybe parsedAmount :: Maybe Double) of
|
||||||
Nothing -> putStrLn " Invalid amount."
|
Nothing -> putStrLn " Invalid amount."
|
||||||
|
|
|
||||||
802
test/ServerSpec.hs
Normal file
802
test/ServerSpec.hs
Normal file
|
|
@ -0,0 +1,802 @@
|
||||||
|
{-# 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.8.0.0-beta" TestNet "v2.1.0")
|
||||||
|
describe "Wallets" $ do
|
||||||
|
describe "listwallet" $ do
|
||||||
|
it "bad credentials" $ do
|
||||||
|
res <-
|
||||||
|
makeZenithCall
|
||||||
|
"127.0.0.1"
|
||||||
|
nodePort
|
||||||
|
"baduser"
|
||||||
|
"idontknow"
|
||||||
|
ListWallets
|
||||||
|
BlankParams
|
||||||
|
res `shouldBe` Left "Invalid credentials"
|
||||||
|
it "correct credentials, no wallet" $ do
|
||||||
|
res <-
|
||||||
|
makeZenithCall
|
||||||
|
"127.0.0.1"
|
||||||
|
nodePort
|
||||||
|
nodeUser
|
||||||
|
nodePwd
|
||||||
|
ListWallets
|
||||||
|
BlankParams
|
||||||
|
case res of
|
||||||
|
Left e -> assertFailure e
|
||||||
|
Right r ->
|
||||||
|
r `shouldBe`
|
||||||
|
ErrorResponse
|
||||||
|
"zh"
|
||||||
|
(-32001)
|
||||||
|
"No wallets available. Please create one first"
|
||||||
|
describe "getnewwallet" $ do
|
||||||
|
it "bad credentials" $ do
|
||||||
|
res <-
|
||||||
|
makeZenithCall
|
||||||
|
"127.0.0.1"
|
||||||
|
nodePort
|
||||||
|
"baduser"
|
||||||
|
"idontknow"
|
||||||
|
GetNewWallet
|
||||||
|
BlankParams
|
||||||
|
res `shouldBe` Left "Invalid credentials"
|
||||||
|
describe "correct credentials" $ do
|
||||||
|
it "no params" $ do
|
||||||
|
res <-
|
||||||
|
makeZenithCall
|
||||||
|
"127.0.0.1"
|
||||||
|
nodePort
|
||||||
|
nodeUser
|
||||||
|
nodePwd
|
||||||
|
GetNewWallet
|
||||||
|
BlankParams
|
||||||
|
case res of
|
||||||
|
Left e -> assertFailure e
|
||||||
|
Right r ->
|
||||||
|
r `shouldBe` ErrorResponse "zh" (-32602) "Invalid params"
|
||||||
|
it "Valid params" $ do
|
||||||
|
res <-
|
||||||
|
makeZenithCall
|
||||||
|
"127.0.0.1"
|
||||||
|
nodePort
|
||||||
|
nodeUser
|
||||||
|
nodePwd
|
||||||
|
GetNewWallet
|
||||||
|
(NameParams "Main")
|
||||||
|
case res of
|
||||||
|
Left e -> assertFailure e
|
||||||
|
Right r -> r `shouldBe` NewItemResponse "zh" 1
|
||||||
|
it "duplicate name" $ do
|
||||||
|
res <-
|
||||||
|
makeZenithCall
|
||||||
|
"127.0.0.1"
|
||||||
|
nodePort
|
||||||
|
nodeUser
|
||||||
|
nodePwd
|
||||||
|
GetNewWallet
|
||||||
|
(NameParams "Main")
|
||||||
|
case res of
|
||||||
|
Left e -> assertFailure e
|
||||||
|
Right r ->
|
||||||
|
r `shouldBe`
|
||||||
|
ErrorResponse
|
||||||
|
"zh"
|
||||||
|
(-32007)
|
||||||
|
"Entity with that name already exists."
|
||||||
|
describe "listwallet" $ do
|
||||||
|
it "wallet exists" $ do
|
||||||
|
res <-
|
||||||
|
makeZenithCall
|
||||||
|
"127.0.0.1"
|
||||||
|
nodePort
|
||||||
|
nodeUser
|
||||||
|
nodePwd
|
||||||
|
ListWallets
|
||||||
|
BlankParams
|
||||||
|
case res of
|
||||||
|
Left e -> assertFailure e
|
||||||
|
Right (WalletListResponse i k) ->
|
||||||
|
zw_name (head k) `shouldBe` "Main"
|
||||||
|
Right _ -> assertFailure "Unexpected response"
|
||||||
|
describe "Accounts" $ do
|
||||||
|
describe "listaccounts" $ do
|
||||||
|
it "bad credentials" $ do
|
||||||
|
res <-
|
||||||
|
makeZenithCall
|
||||||
|
"127.0.0.1"
|
||||||
|
nodePort
|
||||||
|
"baduser"
|
||||||
|
"idontknow"
|
||||||
|
ListAccounts
|
||||||
|
BlankParams
|
||||||
|
res `shouldBe` Left "Invalid credentials"
|
||||||
|
describe "correct credentials" $ do
|
||||||
|
it "invalid wallet" $ do
|
||||||
|
res <-
|
||||||
|
makeZenithCall
|
||||||
|
"127.0.0.1"
|
||||||
|
nodePort
|
||||||
|
nodeUser
|
||||||
|
nodePwd
|
||||||
|
ListAccounts
|
||||||
|
(AccountsParams 17)
|
||||||
|
case res of
|
||||||
|
Left e -> assertFailure e
|
||||||
|
Right r ->
|
||||||
|
r `shouldBe`
|
||||||
|
ErrorResponse "zh" (-32008) "Wallet does not exist."
|
||||||
|
it "valid wallet, no accounts" $ do
|
||||||
|
res <-
|
||||||
|
makeZenithCall
|
||||||
|
"127.0.0.1"
|
||||||
|
nodePort
|
||||||
|
nodeUser
|
||||||
|
nodePwd
|
||||||
|
ListAccounts
|
||||||
|
(AccountsParams 1)
|
||||||
|
case res of
|
||||||
|
Left e -> assertFailure e
|
||||||
|
Right r ->
|
||||||
|
r `shouldBe`
|
||||||
|
ErrorResponse
|
||||||
|
"zh"
|
||||||
|
(-32002)
|
||||||
|
"No accounts available for this wallet. Please create one first"
|
||||||
|
describe "getnewaccount" $ do
|
||||||
|
it "invalid credentials" $ do
|
||||||
|
res <-
|
||||||
|
makeZenithCall
|
||||||
|
"127.0.0.1"
|
||||||
|
nodePort
|
||||||
|
"baduser"
|
||||||
|
"idontknow"
|
||||||
|
GetNewAccount
|
||||||
|
BlankParams
|
||||||
|
res `shouldBe` Left "Invalid credentials"
|
||||||
|
describe "correct credentials" $ do
|
||||||
|
it "invalid wallet" $ do
|
||||||
|
res <-
|
||||||
|
makeZenithCall
|
||||||
|
"127.0.0.1"
|
||||||
|
nodePort
|
||||||
|
nodeUser
|
||||||
|
nodePwd
|
||||||
|
GetNewAccount
|
||||||
|
(NameIdParams "Personal" 17)
|
||||||
|
case res of
|
||||||
|
Left e -> assertFailure e
|
||||||
|
Right r ->
|
||||||
|
r `shouldBe`
|
||||||
|
ErrorResponse "zh" (-32008) "Wallet does not exist."
|
||||||
|
it "valid wallet" $ do
|
||||||
|
res <-
|
||||||
|
makeZenithCall
|
||||||
|
"127.0.0.1"
|
||||||
|
nodePort
|
||||||
|
nodeUser
|
||||||
|
nodePwd
|
||||||
|
GetNewAccount
|
||||||
|
(NameIdParams "Personal" 1)
|
||||||
|
case res of
|
||||||
|
Left e -> assertFailure e
|
||||||
|
Right r -> r `shouldBe` NewItemResponse "zh" 1
|
||||||
|
it "valid wallet, duplicate name" $ do
|
||||||
|
res <-
|
||||||
|
makeZenithCall
|
||||||
|
"127.0.0.1"
|
||||||
|
nodePort
|
||||||
|
nodeUser
|
||||||
|
nodePwd
|
||||||
|
GetNewAccount
|
||||||
|
(NameIdParams "Personal" 1)
|
||||||
|
case res of
|
||||||
|
Left e -> assertFailure e
|
||||||
|
Right r ->
|
||||||
|
r `shouldBe`
|
||||||
|
ErrorResponse
|
||||||
|
"zh"
|
||||||
|
(-32007)
|
||||||
|
"Entity with that name already exists."
|
||||||
|
describe "listaccounts" $ do
|
||||||
|
it "valid wallet" $ do
|
||||||
|
res <-
|
||||||
|
makeZenithCall
|
||||||
|
"127.0.0.1"
|
||||||
|
nodePort
|
||||||
|
nodeUser
|
||||||
|
nodePwd
|
||||||
|
ListAccounts
|
||||||
|
(AccountsParams 1)
|
||||||
|
case res of
|
||||||
|
Left e -> assertFailure e
|
||||||
|
Right r ->
|
||||||
|
r `shouldBe`
|
||||||
|
AccountListResponse "zh" [ZcashAccountAPI 1 1 "Personal"]
|
||||||
|
describe "Addresses" $ do
|
||||||
|
describe "listaddresses" $ do
|
||||||
|
it "bad credentials" $ do
|
||||||
|
res <-
|
||||||
|
makeZenithCall
|
||||||
|
"127.0.0.1"
|
||||||
|
nodePort
|
||||||
|
"baduser"
|
||||||
|
"idontknow"
|
||||||
|
ListAddresses
|
||||||
|
BlankParams
|
||||||
|
res `shouldBe` Left "Invalid credentials"
|
||||||
|
it "correct credentials, no addresses" $ do
|
||||||
|
res <-
|
||||||
|
makeZenithCall
|
||||||
|
"127.0.0.1"
|
||||||
|
nodePort
|
||||||
|
nodeUser
|
||||||
|
nodePwd
|
||||||
|
ListAddresses
|
||||||
|
(AddressesParams 1)
|
||||||
|
case res of
|
||||||
|
Left e -> assertFailure e
|
||||||
|
Right r ->
|
||||||
|
r `shouldBe`
|
||||||
|
ErrorResponse
|
||||||
|
"zh"
|
||||||
|
(-32003)
|
||||||
|
"No addresses available for this account. Please create one first"
|
||||||
|
describe "getnewaddress" $ do
|
||||||
|
it "bad credentials" $ do
|
||||||
|
res <-
|
||||||
|
makeZenithCall
|
||||||
|
"127.0.0.1"
|
||||||
|
nodePort
|
||||||
|
"baduser"
|
||||||
|
"idontknow"
|
||||||
|
GetNewAddress
|
||||||
|
BlankParams
|
||||||
|
res `shouldBe` Left "Invalid credentials"
|
||||||
|
describe "correct credentials" $ do
|
||||||
|
it "invalid account" $ do
|
||||||
|
res <-
|
||||||
|
makeZenithCall
|
||||||
|
"127.0.0.1"
|
||||||
|
nodePort
|
||||||
|
nodeUser
|
||||||
|
nodePwd
|
||||||
|
GetNewAddress
|
||||||
|
(NewAddrParams 17 "Business" False False)
|
||||||
|
case res of
|
||||||
|
Left e -> assertFailure e
|
||||||
|
Right r ->
|
||||||
|
r `shouldBe`
|
||||||
|
ErrorResponse "zh" (-32006) "Account does not exist."
|
||||||
|
it "valid account" $ do
|
||||||
|
res <-
|
||||||
|
makeZenithCall
|
||||||
|
"127.0.0.1"
|
||||||
|
nodePort
|
||||||
|
nodeUser
|
||||||
|
nodePwd
|
||||||
|
GetNewAddress
|
||||||
|
(NewAddrParams 1 "Business" False False)
|
||||||
|
case res of
|
||||||
|
Left e -> assertFailure e
|
||||||
|
Right (NewAddrResponse i a) -> zd_name a `shouldBe` "Business"
|
||||||
|
Right _ -> assertFailure "unexpected response"
|
||||||
|
it "valid account, duplicate name" $ do
|
||||||
|
res <-
|
||||||
|
makeZenithCall
|
||||||
|
"127.0.0.1"
|
||||||
|
nodePort
|
||||||
|
nodeUser
|
||||||
|
nodePwd
|
||||||
|
GetNewAddress
|
||||||
|
(NewAddrParams 1 "Business" False False)
|
||||||
|
case res of
|
||||||
|
Left e -> assertFailure e
|
||||||
|
Right r ->
|
||||||
|
r `shouldBe`
|
||||||
|
ErrorResponse
|
||||||
|
"zh"
|
||||||
|
(-32007)
|
||||||
|
"Entity with that name already exists."
|
||||||
|
it "valid account, no sapling" $ do
|
||||||
|
res <-
|
||||||
|
makeZenithCall
|
||||||
|
"127.0.0.1"
|
||||||
|
nodePort
|
||||||
|
nodeUser
|
||||||
|
nodePwd
|
||||||
|
GetNewAddress
|
||||||
|
(NewAddrParams 1 "NoSapling" True False)
|
||||||
|
case res of
|
||||||
|
Left e -> assertFailure e
|
||||||
|
Right (NewAddrResponse i a) -> zd_legacy a `shouldBe` Nothing
|
||||||
|
Right _ -> assertFailure "unexpected response"
|
||||||
|
it "valid account, no transparent" $ do
|
||||||
|
res <-
|
||||||
|
makeZenithCall
|
||||||
|
"127.0.0.1"
|
||||||
|
nodePort
|
||||||
|
nodeUser
|
||||||
|
nodePwd
|
||||||
|
GetNewAddress
|
||||||
|
(NewAddrParams 1 "NoTransparent" False True)
|
||||||
|
case res of
|
||||||
|
Left e -> assertFailure e
|
||||||
|
Right (NewAddrResponse i a) ->
|
||||||
|
zd_transparent a `shouldBe` Nothing
|
||||||
|
Right _ -> assertFailure "unexpected response"
|
||||||
|
it "valid account, orchard only" $ do
|
||||||
|
res <-
|
||||||
|
makeZenithCall
|
||||||
|
"127.0.0.1"
|
||||||
|
nodePort
|
||||||
|
nodeUser
|
||||||
|
nodePwd
|
||||||
|
GetNewAddress
|
||||||
|
(NewAddrParams 1 "OrchOnly" True True)
|
||||||
|
case res of
|
||||||
|
Left e -> assertFailure e
|
||||||
|
Right (NewAddrResponse i a) ->
|
||||||
|
a `shouldSatisfy`
|
||||||
|
(\b ->
|
||||||
|
(zd_transparent b == Nothing) && (zd_legacy b == Nothing))
|
||||||
|
Right _ -> assertFailure "unexpected response"
|
||||||
|
describe "listaddresses" $ do
|
||||||
|
it "correct credentials, addresses exist" $ do
|
||||||
|
res <-
|
||||||
|
makeZenithCall
|
||||||
|
"127.0.0.1"
|
||||||
|
nodePort
|
||||||
|
nodeUser
|
||||||
|
nodePwd
|
||||||
|
ListAddresses
|
||||||
|
(AddressesParams 1)
|
||||||
|
case res of
|
||||||
|
Left e -> assertFailure e
|
||||||
|
Right (AddressListResponse i a) -> length a `shouldBe` 4
|
||||||
|
describe "Notes" $ do
|
||||||
|
describe "listreceived" $ do
|
||||||
|
it "bad credentials" $ do
|
||||||
|
res <-
|
||||||
|
makeZenithCall
|
||||||
|
"127.0.0.1"
|
||||||
|
nodePort
|
||||||
|
"baduser"
|
||||||
|
"idontknow"
|
||||||
|
ListReceived
|
||||||
|
BlankParams
|
||||||
|
res `shouldBe` Left "Invalid credentials"
|
||||||
|
describe "correct credentials" $ do
|
||||||
|
it "no parameters" $ do
|
||||||
|
res <-
|
||||||
|
makeZenithCall
|
||||||
|
"127.0.0.1"
|
||||||
|
nodePort
|
||||||
|
nodeUser
|
||||||
|
nodePwd
|
||||||
|
ListReceived
|
||||||
|
BlankParams
|
||||||
|
case res of
|
||||||
|
Left e -> assertFailure e
|
||||||
|
Right (ErrorResponse i c m) -> c `shouldBe` (-32602)
|
||||||
|
it "unknown index" $ do
|
||||||
|
res <-
|
||||||
|
makeZenithCall
|
||||||
|
"127.0.0.1"
|
||||||
|
nodePort
|
||||||
|
nodeUser
|
||||||
|
nodePwd
|
||||||
|
ListReceived
|
||||||
|
(NotesParams "17")
|
||||||
|
case res of
|
||||||
|
Left e -> assertFailure e
|
||||||
|
Right (ErrorResponse i c m) -> c `shouldBe` (-32004)
|
||||||
|
describe "Balance" $ do
|
||||||
|
describe "getbalance" $ do
|
||||||
|
it "bad credentials" $ do
|
||||||
|
res <-
|
||||||
|
makeZenithCall
|
||||||
|
"127.0.0.1"
|
||||||
|
nodePort
|
||||||
|
"baduser"
|
||||||
|
"idontknow"
|
||||||
|
GetBalance
|
||||||
|
BlankParams
|
||||||
|
res `shouldBe` Left "Invalid credentials"
|
||||||
|
describe "correct credentials" $ do
|
||||||
|
it "no parameters" $ do
|
||||||
|
res <-
|
||||||
|
makeZenithCall
|
||||||
|
"127.0.0.1"
|
||||||
|
nodePort
|
||||||
|
nodeUser
|
||||||
|
nodePwd
|
||||||
|
GetBalance
|
||||||
|
BlankParams
|
||||||
|
case res of
|
||||||
|
Left e -> assertFailure e
|
||||||
|
Right (ErrorResponse i c m) -> c `shouldBe` (-32602)
|
||||||
|
it "unknown index" $ do
|
||||||
|
res <-
|
||||||
|
makeZenithCall
|
||||||
|
"127.0.0.1"
|
||||||
|
nodePort
|
||||||
|
nodeUser
|
||||||
|
nodePwd
|
||||||
|
GetBalance
|
||||||
|
(BalanceParams 17)
|
||||||
|
case res of
|
||||||
|
Left e -> assertFailure e
|
||||||
|
Right (ErrorResponse i c m) -> c `shouldBe` (-32006)
|
||||||
|
describe "Operations" $ do
|
||||||
|
describe "getoperationstatus" $ do
|
||||||
|
it "bad credentials" $ do
|
||||||
|
res <-
|
||||||
|
makeZenithCall
|
||||||
|
"127.0.0.1"
|
||||||
|
nodePort
|
||||||
|
"baduser"
|
||||||
|
"idontknow"
|
||||||
|
GetOperationStatus
|
||||||
|
BlankParams
|
||||||
|
res `shouldBe` Left "Invalid credentials"
|
||||||
|
describe "correct credentials" $ do
|
||||||
|
it "invalid ID" $ do
|
||||||
|
res <-
|
||||||
|
makeZenithCall
|
||||||
|
"127.0.0.1"
|
||||||
|
nodePort
|
||||||
|
nodeUser
|
||||||
|
nodePwd
|
||||||
|
GetOperationStatus
|
||||||
|
(NameParams "badId")
|
||||||
|
case res of
|
||||||
|
Left e -> assertFailure e
|
||||||
|
Right (ErrorResponse i c m) -> c `shouldBe` (-32602)
|
||||||
|
it "valid ID" $ do
|
||||||
|
res <-
|
||||||
|
makeZenithCall
|
||||||
|
"127.0.0.1"
|
||||||
|
nodePort
|
||||||
|
nodeUser
|
||||||
|
nodePwd
|
||||||
|
GetOperationStatus
|
||||||
|
(OpParams
|
||||||
|
(ZenithUuid $
|
||||||
|
fromMaybe U.nil $
|
||||||
|
U.fromText "bd2aa95a-db51-4cc4-9fea-0f9cf79003a4"))
|
||||||
|
case res of
|
||||||
|
Left e -> assertFailure e
|
||||||
|
Right (OpResponse i o) ->
|
||||||
|
operationUuid o `shouldBe`
|
||||||
|
(ZenithUuid $
|
||||||
|
fromMaybe U.nil $
|
||||||
|
U.fromText "bd2aa95a-db51-4cc4-9fea-0f9cf79003a4")
|
||||||
|
Right _ -> assertFailure "unexpected response"
|
||||||
|
it "valid ID not found" $ do
|
||||||
|
res <-
|
||||||
|
makeZenithCall
|
||||||
|
"127.0.0.1"
|
||||||
|
nodePort
|
||||||
|
nodeUser
|
||||||
|
nodePwd
|
||||||
|
GetOperationStatus
|
||||||
|
(OpParams
|
||||||
|
(ZenithUuid $
|
||||||
|
fromMaybe U.nil $
|
||||||
|
U.fromText "bd2aa95a-db51-4cc4-9fea-0f9cf79003a5"))
|
||||||
|
case res of
|
||||||
|
Left e -> assertFailure e
|
||||||
|
Right (ErrorResponse i c m) -> c `shouldBe` (-32009)
|
||||||
|
Right _ -> assertFailure "unexpected response"
|
||||||
|
describe "Send tx" $ do
|
||||||
|
describe "sendmany" $ do
|
||||||
|
it "bad credentials" $ do
|
||||||
|
res <-
|
||||||
|
makeZenithCall
|
||||||
|
"127.0.0.1"
|
||||||
|
nodePort
|
||||||
|
"baduser"
|
||||||
|
"idontknow"
|
||||||
|
SendMany
|
||||||
|
BlankParams
|
||||||
|
res `shouldBe` Left "Invalid credentials"
|
||||||
|
describe "correct credentials" $ do
|
||||||
|
it "invalid account" $ do
|
||||||
|
let uaRead =
|
||||||
|
parseAddress
|
||||||
|
"utest1dl54utt6prjj5e0dnlknwumnxq9hycdjpkfr0sy6e6h522remqee8axe9zax0wsjrwpj76v555pdhvj9rnargpfyycs0vpkapq98xcdhem99gc4wchzn0ggepq3y6nz3a9sscwgqxgsh9vzhcad402y3x9szfregck5gslkya3c79d86xx0l33tpk8gnn7ew9vw37w43zh22u8dgdax"
|
||||||
|
res <-
|
||||||
|
makeZenithCall
|
||||||
|
"127.0.0.1"
|
||||||
|
nodePort
|
||||||
|
nodeUser
|
||||||
|
nodePwd
|
||||||
|
SendMany
|
||||||
|
(SendParams
|
||||||
|
17
|
||||||
|
[ ProposedNote
|
||||||
|
(ValidAddressAPI $ fromJust uaRead)
|
||||||
|
0.005
|
||||||
|
(Just "A cool memo")
|
||||||
|
]
|
||||||
|
Full)
|
||||||
|
case res of
|
||||||
|
Left e -> assertFailure e
|
||||||
|
Right (ErrorResponse i c m) -> c `shouldBe` (-32006)
|
||||||
|
it "valid account, empty notes" $ do
|
||||||
|
let uaRead =
|
||||||
|
parseAddress
|
||||||
|
"utest1dl54utt6prjj5e0dnlknwumnxq9hycdjpkfr0sy6e6h522remqee8axe9zax0wsjrwpj76v555pdhvj9rnargpfyycs0vpkapq98xcdhem99gc4wchzn0ggepq3y6nz3a9sscwgqxgsh9vzhcad402y3x9szfregck5gslkya3c79d86xx0l33tpk8gnn7ew9vw37w43zh22u8dgdax"
|
||||||
|
res <-
|
||||||
|
makeZenithCall
|
||||||
|
"127.0.0.1"
|
||||||
|
nodePort
|
||||||
|
nodeUser
|
||||||
|
nodePwd
|
||||||
|
SendMany
|
||||||
|
(SendParams 1 [] Full)
|
||||||
|
case res of
|
||||||
|
Left e -> assertFailure e
|
||||||
|
Right (ErrorResponse i c m) -> c `shouldBe` (-32602)
|
||||||
|
it "valid account, single output" $ do
|
||||||
|
let uaRead =
|
||||||
|
parseAddress
|
||||||
|
"utest1dl54utt6prjj5e0dnlknwumnxq9hycdjpkfr0sy6e6h522remqee8axe9zax0wsjrwpj76v555pdhvj9rnargpfyycs0vpkapq98xcdhem99gc4wchzn0ggepq3y6nz3a9sscwgqxgsh9vzhcad402y3x9szfregck5gslkya3c79d86xx0l33tpk8gnn7ew9vw37w43zh22u8dgdax"
|
||||||
|
res <-
|
||||||
|
makeZenithCall
|
||||||
|
"127.0.0.1"
|
||||||
|
nodePort
|
||||||
|
nodeUser
|
||||||
|
nodePwd
|
||||||
|
SendMany
|
||||||
|
(SendParams
|
||||||
|
1
|
||||||
|
[ ProposedNote
|
||||||
|
(ValidAddressAPI $ fromJust uaRead)
|
||||||
|
5.0
|
||||||
|
(Just "A cool memo")
|
||||||
|
]
|
||||||
|
Full)
|
||||||
|
case res of
|
||||||
|
Left e -> assertFailure e
|
||||||
|
Right (SendResponse i o) -> o `shouldNotBe` U.nil
|
||||||
|
it "valid account, multiple outputs" $ do
|
||||||
|
let uaRead =
|
||||||
|
parseAddress
|
||||||
|
"utest1dl54utt6prjj5e0dnlknwumnxq9hycdjpkfr0sy6e6h522remqee8axe9zax0wsjrwpj76v555pdhvj9rnargpfyycs0vpkapq98xcdhem99gc4wchzn0ggepq3y6nz3a9sscwgqxgsh9vzhcad402y3x9szfregck5gslkya3c79d86xx0l33tpk8gnn7ew9vw37w43zh22u8dgdax"
|
||||||
|
let uaRead2 =
|
||||||
|
parseAddress
|
||||||
|
"ztestsapling136jp8z89v2jh6kqd5rs4dtvlxym90m43svzdwzxaplyvc5ttzppytpvx80ncllcsqzpmukxjl3y"
|
||||||
|
res <-
|
||||||
|
makeZenithCall
|
||||||
|
"127.0.0.1"
|
||||||
|
nodePort
|
||||||
|
nodeUser
|
||||||
|
nodePwd
|
||||||
|
SendMany
|
||||||
|
(SendParams
|
||||||
|
1
|
||||||
|
[ ProposedNote
|
||||||
|
(ValidAddressAPI $ fromJust uaRead)
|
||||||
|
5.0
|
||||||
|
(Just "A cool memo")
|
||||||
|
, ProposedNote
|
||||||
|
(ValidAddressAPI $ fromJust uaRead2)
|
||||||
|
1.0
|
||||||
|
(Just "Not so cool memo")
|
||||||
|
]
|
||||||
|
Full)
|
||||||
|
case res of
|
||||||
|
Left e -> assertFailure e
|
||||||
|
Right (SendResponse i o) -> o `shouldNotBe` U.nil
|
||||||
|
describe "Shield notes" $ do
|
||||||
|
it "bad credentials" $ do
|
||||||
|
res <-
|
||||||
|
makeZenithCall
|
||||||
|
"127.0.0.1"
|
||||||
|
nodePort
|
||||||
|
"baduser"
|
||||||
|
"idontknow"
|
||||||
|
ShieldNotes
|
||||||
|
BlankParams
|
||||||
|
res `shouldBe` Left "Invalid credentials"
|
||||||
|
describe "correct credentials" $ do
|
||||||
|
it "no parameters" $ do
|
||||||
|
res <-
|
||||||
|
makeZenithCall
|
||||||
|
"127.0.0.1"
|
||||||
|
nodePort
|
||||||
|
nodeUser
|
||||||
|
nodePwd
|
||||||
|
ShieldNotes
|
||||||
|
BlankParams
|
||||||
|
case res of
|
||||||
|
Left e -> assertFailure e
|
||||||
|
Right (ErrorResponse i c m) -> c `shouldBe` (-32602)
|
||||||
|
it "invalid account" $ do
|
||||||
|
res <-
|
||||||
|
makeZenithCall
|
||||||
|
"127.0.0.1"
|
||||||
|
nodePort
|
||||||
|
nodeUser
|
||||||
|
nodePwd
|
||||||
|
ShieldNotes
|
||||||
|
(ShieldNotesParams 27)
|
||||||
|
case res of
|
||||||
|
Left e -> assertFailure e
|
||||||
|
Right (ErrorResponse i c m) -> c `shouldBe` (-32006)
|
||||||
|
it "valid account" $ do
|
||||||
|
res <-
|
||||||
|
makeZenithCall
|
||||||
|
"127.0.0.1"
|
||||||
|
nodePort
|
||||||
|
nodeUser
|
||||||
|
nodePwd
|
||||||
|
ShieldNotes
|
||||||
|
(ShieldNotesParams 1)
|
||||||
|
case res of
|
||||||
|
Left e -> assertFailure e
|
||||||
|
Right (MultiOpResponse i c) -> c `shouldNotBe` []
|
||||||
|
|
||||||
|
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)
|
||||||
1009
test/Spec.hs
1009
test/Spec.hs
File diff suppressed because it is too large
Load diff
|
|
@ -1 +1 @@
|
||||||
Subproject commit e8074419cfb54559a4c09731ad2448d5930869a2
|
Subproject commit 7d3ae36d2b48b8ed91a70e40a77fb7efe57765a0
|
||||||
1031
zenith-openrpc.json
Normal file
1031
zenith-openrpc.json
Normal file
File diff suppressed because it is too large
Load diff
79
zenith.cabal
79
zenith.cabal
|
|
@ -1,6 +1,6 @@
|
||||||
cabal-version: 3.0
|
cabal-version: 3.0
|
||||||
name: zenith
|
name: zenith
|
||||||
version: 0.6.0.0-beta
|
version: 0.7.1.0-beta
|
||||||
license: MIT
|
license: MIT
|
||||||
license-file: LICENSE
|
license-file: LICENSE
|
||||||
author: Rene Vergara
|
author: Rene Vergara
|
||||||
|
|
@ -35,56 +35,65 @@ library
|
||||||
Zenith.Utils
|
Zenith.Utils
|
||||||
Zenith.Zcashd
|
Zenith.Zcashd
|
||||||
Zenith.Scanner
|
Zenith.Scanner
|
||||||
|
Zenith.RPC
|
||||||
|
Zenith.Tree
|
||||||
hs-source-dirs:
|
hs-source-dirs:
|
||||||
src
|
src
|
||||||
build-depends:
|
build-depends:
|
||||||
Clipboard
|
Clipboard
|
||||||
|
, Hclip
|
||||||
|
, JuicyPixels
|
||||||
, aeson
|
, aeson
|
||||||
, array
|
, array
|
||||||
, ascii-progress
|
, ascii-progress
|
||||||
|
, async
|
||||||
, base >=4.12 && <5
|
, base >=4.12 && <5
|
||||||
, base64-bytestring
|
, base64-bytestring
|
||||||
|
, binary
|
||||||
|
, borsh
|
||||||
, brick
|
, brick
|
||||||
, bytestring
|
, bytestring
|
||||||
|
, configurator
|
||||||
, data-default
|
, data-default
|
||||||
, directory
|
, directory
|
||||||
, filepath
|
|
||||||
, esqueleto
|
, esqueleto
|
||||||
, resource-pool
|
|
||||||
, binary
|
|
||||||
, exceptions
|
, exceptions
|
||||||
, monad-logger
|
, filepath
|
||||||
, vty-crossplatform
|
|
||||||
, secp256k1-haskell >= 1
|
|
||||||
, pureMD5
|
|
||||||
, ghc
|
, ghc
|
||||||
|
, generics-sop
|
||||||
, haskoin-core
|
, haskoin-core
|
||||||
, hexstring
|
, hexstring
|
||||||
, http-client
|
, http-client
|
||||||
, http-conduit
|
, http-conduit
|
||||||
, http-types
|
, http-types
|
||||||
, JuicyPixels
|
|
||||||
, qrcode-core
|
|
||||||
, qrcode-juicypixels
|
|
||||||
, microlens
|
, microlens
|
||||||
, microlens-mtl
|
, microlens-mtl
|
||||||
, microlens-th
|
, microlens-th
|
||||||
|
, monad-logger
|
||||||
|
, transformers
|
||||||
, monomer
|
, monomer
|
||||||
, mtl
|
, mtl
|
||||||
, persistent
|
, persistent
|
||||||
, Hclip
|
|
||||||
, persistent-sqlite
|
, persistent-sqlite
|
||||||
, persistent-template
|
, persistent-template
|
||||||
, process
|
, process
|
||||||
|
, pureMD5
|
||||||
|
, qrcode-core
|
||||||
|
, qrcode-juicypixels
|
||||||
, regex-base
|
, regex-base
|
||||||
, regex-compat
|
, regex-compat
|
||||||
, regex-posix
|
, regex-posix
|
||||||
|
, resource-pool
|
||||||
, scientific
|
, scientific
|
||||||
|
, secp256k1-haskell >= 1
|
||||||
|
, servant-server
|
||||||
, text
|
, text
|
||||||
, text-show
|
, text-show
|
||||||
, time
|
, time
|
||||||
|
, uuid
|
||||||
, vector
|
, vector
|
||||||
, vty
|
, vty
|
||||||
|
, vty-crossplatform
|
||||||
, word-wrap
|
, word-wrap
|
||||||
, zcash-haskell
|
, zcash-haskell
|
||||||
--pkgconfig-depends: rustzcash_wrapper
|
--pkgconfig-depends: rustzcash_wrapper
|
||||||
|
|
@ -110,15 +119,21 @@ executable zenith
|
||||||
pkgconfig-depends: rustzcash_wrapper
|
pkgconfig-depends: rustzcash_wrapper
|
||||||
default-language: Haskell2010
|
default-language: Haskell2010
|
||||||
|
|
||||||
executable zenscan
|
executable zenithserver
|
||||||
ghc-options: -main-is ZenScan -threaded -rtsopts -with-rtsopts=-N
|
ghc-options: -main-is Server -threaded -rtsopts -with-rtsopts=-N
|
||||||
main-is: ZenScan.hs
|
main-is: Server.hs
|
||||||
hs-source-dirs:
|
hs-source-dirs:
|
||||||
app
|
app
|
||||||
build-depends:
|
build-depends:
|
||||||
base >=4.12 && <5
|
base >=4.12 && <5
|
||||||
, configurator
|
, configurator
|
||||||
, monad-logger
|
, monad-logger
|
||||||
|
, wai-extra
|
||||||
|
, warp
|
||||||
|
, servant-server
|
||||||
|
, text
|
||||||
|
, unix
|
||||||
|
, zcash-haskell
|
||||||
, zenith
|
, zenith
|
||||||
pkgconfig-depends: rustzcash_wrapper
|
pkgconfig-depends: rustzcash_wrapper
|
||||||
default-language: Haskell2010
|
default-language: Haskell2010
|
||||||
|
|
@ -132,8 +147,11 @@ test-suite zenith-tests
|
||||||
build-depends:
|
build-depends:
|
||||||
base >=4.12 && <5
|
base >=4.12 && <5
|
||||||
, bytestring
|
, bytestring
|
||||||
|
, aeson
|
||||||
, configurator
|
, configurator
|
||||||
, monad-logger
|
, monad-logger
|
||||||
|
, borsh
|
||||||
|
, aeson
|
||||||
, data-default
|
, data-default
|
||||||
, sort
|
, sort
|
||||||
, text
|
, text
|
||||||
|
|
@ -148,3 +166,34 @@ test-suite zenith-tests
|
||||||
, zenith
|
, zenith
|
||||||
pkgconfig-depends: rustzcash_wrapper
|
pkgconfig-depends: rustzcash_wrapper
|
||||||
default-language: Haskell2010
|
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
|
||||||
|
|
|
||||||
BIN
zenith_er.bmp
BIN
zenith_er.bmp
Binary file not shown.
|
Before Width: | Height: | Size: 7.7 MiB |
BIN
zenith_er.png
BIN
zenith_er.png
Binary file not shown.
|
Before Width: | Height: | Size: 329 KiB |
Loading…
Reference in a new issue