Initial commit
This commit is contained in:
commit
a100087646
GPG Key ID:
65122AD495A7F5B2
|
|
@ -0,0 +1,2 @@
|
|||
.stack-work/
|
||||
*~
|
||||
|
|
@ -0,0 +1,20 @@
|
|||
# Changelog
|
||||
|
||||
All notable changes to this project will be documented in this file.
|
||||
|
||||
The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.0.0/),
|
||||
and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0.html).
|
||||
|
||||
## [Unreleased]
|
||||
|
||||
### Added
|
||||
|
||||
- CHANGELOG.md
|
||||
- README.md
|
||||
- List node addresses
|
||||
- Query an address balance
|
||||
- List transactions for an address, displaying decoded memos
|
||||
- Copy address to clipboard
|
||||
- Create new Unified Addresses
|
||||
- Sending transactions
|
||||
|
||||
|
|
@ -0,0 +1,23 @@
|
|||
[The MIT License (MIT)][]
|
||||
|
||||
Copyright (c) 2022 Rene Vergara
|
||||
|
||||
Permission is hereby granted, free of charge, to any person obtaining a copy of
|
||||
this software and associated documentation files (the "Software"), to deal in
|
||||
the Software without restriction, including without limitation the rights to
|
||||
use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies
|
||||
of the Software, and to permit persons to whom the Software is furnished to do
|
||||
so, subject to the following conditions:
|
||||
|
||||
The above copyright notice and this permission notice shall be included in all
|
||||
copies or substantial portions of the Software.
|
||||
|
||||
THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
|
||||
IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
|
||||
FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
|
||||
AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
|
||||
LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
|
||||
OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
|
||||
SOFTWARE.
|
||||
|
||||
[The MIT License (MIT)]: https://opensource.org/licenses/MIT
|
||||
|
|
@ -0,0 +1,63 @@
|
|||
# Zenith
|
||||
|
||||
```
|
||||
______ _ _ _
|
||||
|___ / (_) | | |
|
||||
/ / ___ _ __ _| |_| |__
|
||||
/ / / _ \ '_ \| | __| '_ \
|
||||
/ /_| __/ | | | | |_| | | |
|
||||
/_____\___|_| |_|_|\__|_| |_|
|
||||
Zcash Full Node CLI
|
||||
```
|
||||
|
||||
Zenith is a command-line interface for the Zcash Full Node (`zcashd`). It has the following features:
|
||||
|
||||
- Listing transparent and shielded addresses and balances known to the node, including viewing-only.
|
||||
- Listing transactions for specific addresses, decoding memos for easy reading.
|
||||
- Copying addresses to the clipboard.
|
||||
- Creating new Unified Addresses.
|
||||
- Sending transactions with shielded memo support.
|
||||
|
||||
Note: Zenith depends on a patched version of the `haskoin-core` Haskell package included in this repo. A pull request to the maintainers of `haskoin-core` has been submitted, if/when it is merged, Zenith will be updated to use the standard package.
|
||||
|
||||
## Installation
|
||||
|
||||
- Clone the repository.
|
||||
- Install dependencies:
|
||||
- [Stack](https://docs.haskellstack.org/en/stable/README/#how-to-install)
|
||||
- [Zcash Full Node v.5.0.0](https://zcash.readthedocs.io/en/latest/rtd_pages/zcashd.html#install)
|
||||
- `xclip`
|
||||
- `libsecp256k1-dev`
|
||||
- `libxss-dev`
|
||||
- Install using `stack`:
|
||||
|
||||
```
|
||||
stack install
|
||||
```
|
||||
|
||||
## Configuration
|
||||
|
||||
- Copy the sample `zenith.cfg` file to a location of your choice and update the values of the user and password for the `zcashd` node. These values can be found in the `zcash.conf` file for the Zcash node.
|
||||
|
||||
## Usage
|
||||
|
||||
From the location where the configured `zenith.cfg` file is placed, use `zenith` to start.
|
||||
|
||||
Zenith will attempt to connect to the node and check compatibility. Connections to `zcashd` versions less than 5.0.0 will fail.
|
||||
|
||||
### Available commands
|
||||
|
||||
- `?`: Lists available commands.
|
||||
- `list`: Lists all transparent and shielded addresses and their balance.
|
||||
- Notes about balances:
|
||||
- Addresses from an imported viewing key will list a balance but it may be inaccurate, as viewing keys cannot see ZEC spent out of that address.
|
||||
- Balances for Unified Addresses *belonging to the same account* are shared. Zenith will list the full account balances for each of the UAs in the account.
|
||||
- `txs <id>`: Lists all transactions belonging to the address corresponding to the `id` given, in chronological order.
|
||||
- `copy`: Copies the selected address to the clipboard.
|
||||
- `new`: Prompts the user for the option to include a transparent receiver, a Sapling receiver or both. An Orchard receiver is always included.
|
||||
- `send`: Prompts the user to prepare an outgoing transaction, selecting the source address, validating the destination address, the amount and the memo.
|
||||
- If the source is a transparent address, the privacy policy is set to `AllowRevealedSenders`, favoring the shielding of funds when sent to a UA.
|
||||
- If the source is a shielded address, the privacy policy is set to `AllowRevealedAmounts`, favoring the move of funds from legacy shielded pools to Orchard.
|
||||
- `exit`: Ends the session.
|
||||
|
||||
|
||||
|
|
@ -0,0 +1,157 @@
|
|||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
module Main where
|
||||
|
||||
import Control.Monad (void)
|
||||
import Control.Monad.IO.Class (liftIO)
|
||||
import qualified Data.ByteString as B
|
||||
import Data.Configurator
|
||||
import Data.Default (def)
|
||||
import Data.Sort
|
||||
import qualified Data.Text as T
|
||||
import Data.Time.Clock.POSIX
|
||||
import System.Console.StructuredCLI
|
||||
import System.Exit
|
||||
import System.IO
|
||||
import Text.Read (readMaybe)
|
||||
import Zenith
|
||||
|
||||
prompt :: String -> IO String
|
||||
prompt text = do
|
||||
putStr text
|
||||
hFlush stdout
|
||||
getLine
|
||||
|
||||
root :: B.ByteString -> B.ByteString -> Commands ()
|
||||
root user pwd = do
|
||||
list user pwd
|
||||
txs user pwd
|
||||
sendZec user pwd
|
||||
copyAdd user pwd
|
||||
createUA user pwd
|
||||
command "exit" "exit app" exitSuccess
|
||||
|
||||
copyAdd :: B.ByteString -> B.ByteString -> Commands ()
|
||||
copyAdd user pwd =
|
||||
command "copy" "copies an address to the clipboard" $ do
|
||||
liftIO . putStrLn $ "Please select the source address:"
|
||||
addList <- listAddresses user pwd
|
||||
let idList = zip [1 ..] addList
|
||||
liftIO $ mapM_ (displayZcashAddress user pwd) idList
|
||||
s <- liftIO . prompt $ " > Enter ID (0 to cancel): "
|
||||
let idx = read s
|
||||
if idx == 0
|
||||
then do
|
||||
liftIO . putStrLn $ " Cancelled!"
|
||||
return NoAction
|
||||
else do
|
||||
liftIO $ copyAddress (addList !! (idx - 1))
|
||||
liftIO . putStrLn $ " Copied address to clipboard!"
|
||||
return NoAction
|
||||
|
||||
list :: B.ByteString -> B.ByteString -> Commands ()
|
||||
list user pwd =
|
||||
command "list" "lists all addresses known to the node" $ do
|
||||
liftIO . putStrLn $ "Addresses known to the node:"
|
||||
liftIO . putStrLn $ "----------------------------"
|
||||
addList <- listAddresses user pwd
|
||||
let idList = zip [1 ..] addList
|
||||
liftIO $ mapM_ (displayZcashAddress user pwd) idList
|
||||
return NoAction
|
||||
|
||||
txs :: B.ByteString -> B.ByteString -> Commands ()
|
||||
txs user pwd =
|
||||
param
|
||||
"txs"
|
||||
"'txs <id>' shows transactions for address <id> from list command"
|
||||
parseId $ \i -> do
|
||||
addList <- listAddresses user pwd
|
||||
liftIO . putStrLn $
|
||||
"Txs for address " ++ T.unpack (addy (addList !! (i - 1))) ++ ":"
|
||||
liftIO . putStrLn $ "----------------------------"
|
||||
txList <- listTxs user pwd (addList !! (i - 1))
|
||||
let txList' = sortOn zblocktime $ filter (not . zchange) txList
|
||||
liftIO $ mapM_ displayTx txList'
|
||||
return NoAction
|
||||
|
||||
sendZec :: B.ByteString -> B.ByteString -> Commands ()
|
||||
sendZec user pwd =
|
||||
command "send" "prompt for sending ZEC" $ do
|
||||
liftIO . putStrLn $ "Please select the source address:"
|
||||
addList <- listAddresses user pwd
|
||||
let idList = zip [1 ..] addList
|
||||
liftIO $ mapM_ (displayZcashAddress user pwd) idList
|
||||
s <- liftIO . prompt $ " > Enter ID (0 to cancel): "
|
||||
let idx = read s
|
||||
if idx == 0
|
||||
then do
|
||||
liftIO . putStrLn $ " Cancelled!"
|
||||
return NoAction
|
||||
else do
|
||||
liftIO . putStrLn $ " Sending from " ++ show (addList !! (idx - 1))
|
||||
t <- liftIO . prompt $ " > Enter destination address: "
|
||||
let addChk = validateAddress (T.pack t)
|
||||
if addChk
|
||||
then do
|
||||
liftIO . putStrLn $ " Address is valid!"
|
||||
a <- liftIO . prompt $ " > Enter ZEC amount: "
|
||||
case (readMaybe a :: Maybe Double) of
|
||||
Just amt -> do
|
||||
m <- liftIO . prompt $ " > Enter memo: "
|
||||
liftIO $ sendTx user pwd (addList !! (idx - 1)) (T.pack t) amt m
|
||||
Nothing -> liftIO . putStrLn $ " Invalid amount"
|
||||
else liftIO . putStrLn $ " Invalid address, cancelling."
|
||||
return NoAction
|
||||
|
||||
createUA :: B.ByteString -> B.ByteString -> Commands ()
|
||||
createUA user pwd =
|
||||
command "new" "create new Unified Address" $ do
|
||||
accCheck <- liftIO $ checkAccounts user pwd
|
||||
if accCheck
|
||||
then do
|
||||
liftIO . putStrLn $ " Account found."
|
||||
else do
|
||||
liftIO . putStrLn $ " No existing accounts, creating one..."
|
||||
liftIO $ createAccount user pwd
|
||||
t <- liftIO . prompt $ " > Include transparent receiver? (Y/N): "
|
||||
let tRec =
|
||||
case T.toLower (T.pack t) of
|
||||
"y" -> True
|
||||
_ -> False
|
||||
s <- liftIO . prompt $ " > Include Sapling receiver? (Y/N): "
|
||||
let sRec =
|
||||
case T.toLower (T.pack s) of
|
||||
"y" -> True
|
||||
_ -> False
|
||||
liftIO $ createUnifiedAddress user pwd tRec sRec
|
||||
return NoAction
|
||||
|
||||
parseId :: Validator IO Int
|
||||
parseId = return . readMaybe
|
||||
|
||||
displayTx :: ZcashTx -> IO ()
|
||||
displayTx t = do
|
||||
putStr "Tx ID: "
|
||||
print $ ztxid t
|
||||
putStr "Block Time: "
|
||||
print $ posixSecondsToUTCTime (fromInteger (zblocktime t))
|
||||
putStr "Zats: "
|
||||
print $ zamountZat t
|
||||
putStr "Memo: "
|
||||
print $ zmemo t
|
||||
putStrLn "-----"
|
||||
|
||||
main :: IO ()
|
||||
main = do
|
||||
config <- load ["zenith.cfg"]
|
||||
nodeUser <- require config "nodeUser"
|
||||
nodePwd <- require config "nodePwd"
|
||||
checkServer nodeUser nodePwd
|
||||
void $
|
||||
runCLI
|
||||
"Zenith"
|
||||
def
|
||||
{ getBanner =
|
||||
" ______ _ _ _ \n |___ / (_) | | | \n / / ___ _ __ _| |_| |__ \n / / / _ \\ '_ \\| | __| '_ \\ \n / /_| __/ | | | | |_| | | |\n /_____\\___|_| |_|_|\\__|_| |_|\n Zcash Full Node CLI"
|
||||
}
|
||||
(root nodeUser nodePwd)
|
||||
|
|
@ -0,0 +1,69 @@
|
|||
name: zenith
|
||||
version: 0.1.0.0
|
||||
github: "pitmutt/zenit"
|
||||
license: MIT
|
||||
author: "Rene Vergara"
|
||||
maintainer: "rene@vergara.network"
|
||||
copyright: "Copyright (c) 2022 Vergara Technologies LLC"
|
||||
|
||||
extra-source-files:
|
||||
- README.md
|
||||
- ChangeLog.md
|
||||
|
||||
# Metadata used when publishing your package
|
||||
# synopsis: Short description of your package
|
||||
# category: Web
|
||||
|
||||
# To avoid duplicated efforts in documentation and dealing with the
|
||||
# complications of embedding Haddock markup inside cabal files, it is
|
||||
# common to point users to the README.md file.
|
||||
description: Please see the README on GitLab at <https://gitlab.com/pitmutt/zenit#readme>
|
||||
|
||||
dependencies:
|
||||
- base >= 4.7 && < 5
|
||||
|
||||
library:
|
||||
source-dirs: src
|
||||
dependencies:
|
||||
- aeson
|
||||
- text
|
||||
- bytestring
|
||||
- http-conduit
|
||||
- scientific
|
||||
- haskoin-core
|
||||
- vector
|
||||
- regex-base
|
||||
- regex-posix
|
||||
- Clipboard
|
||||
- process
|
||||
- http-types
|
||||
|
||||
executables:
|
||||
zenith:
|
||||
main: Main.hs
|
||||
source-dirs: app
|
||||
ghc-options:
|
||||
- -threaded
|
||||
- -rtsopts
|
||||
- -with-rtsopts=-N
|
||||
- -Wall
|
||||
dependencies:
|
||||
- zenith
|
||||
- configurator
|
||||
- structured-cli
|
||||
- data-default
|
||||
- bytestring
|
||||
- text
|
||||
- time
|
||||
- sort
|
||||
|
||||
tests:
|
||||
zenith-test:
|
||||
main: Spec.hs
|
||||
source-dirs: test
|
||||
ghc-options:
|
||||
- -threaded
|
||||
- -rtsopts
|
||||
- -with-rtsopts=-N
|
||||
dependencies:
|
||||
- zenith
|
||||
|
|
@ -0,0 +1,550 @@
|
|||
{-# LANGUAGE DeriveGeneric #-}
|
||||
{-# LANGUAGE DeriveAnyClass #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE LambdaCase #-}
|
||||
|
||||
module Zenith where
|
||||
|
||||
import Control.Concurrent (threadDelay)
|
||||
import Control.Monad
|
||||
import Data.Aeson
|
||||
import Data.Aeson.Types
|
||||
import qualified Data.ByteString as B
|
||||
import qualified Data.ByteString.Lazy as LB
|
||||
import Data.Char
|
||||
import Data.Functor (void)
|
||||
import Data.Maybe
|
||||
import qualified Data.Scientific as Scientific
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.Vector as V
|
||||
import GHC.Generics
|
||||
import Haskoin.Address.Bech32
|
||||
import Network.HTTP.Simple
|
||||
import Network.HTTP.Types
|
||||
import Numeric
|
||||
import System.Clipboard
|
||||
import System.Exit
|
||||
import System.Process (createProcess_, shell)
|
||||
import Text.Regex.Posix
|
||||
|
||||
-- | A type to model Zcash RPC calls
|
||||
data RpcCall =
|
||||
RpcCall
|
||||
{ jsonrpc :: T.Text
|
||||
, id :: T.Text
|
||||
, method :: T.Text
|
||||
, params :: [Value]
|
||||
}
|
||||
deriving (Show, Generic, ToJSON, FromJSON)
|
||||
|
||||
-- | Type for modelling the different address sources for Zcash 5.0.0
|
||||
data AddressSource
|
||||
= LegacyRandom
|
||||
| Imported
|
||||
| ImportedWatchOnly
|
||||
| KeyPool
|
||||
| LegacySeed
|
||||
| MnemonicSeed
|
||||
deriving (Read, Show, Eq, Generic, ToJSON)
|
||||
|
||||
instance FromJSON AddressSource where
|
||||
parseJSON =
|
||||
withText "AddressSource" $ \case
|
||||
"legacy_random" -> return LegacyRandom
|
||||
"imported" -> return Imported
|
||||
"imported_watchonly" -> return ImportedWatchOnly
|
||||
"keypool" -> return KeyPool
|
||||
"legacy_hdseed" -> return LegacySeed
|
||||
"mnemonic_seed" -> return MnemonicSeed
|
||||
_ -> fail "Not a known address source"
|
||||
|
||||
data ZcashPool
|
||||
= Transparent
|
||||
| Sprout
|
||||
| Sapling
|
||||
| Orchard
|
||||
deriving (Show, Eq, Generic, ToJSON)
|
||||
|
||||
instance FromJSON ZcashPool where
|
||||
parseJSON =
|
||||
withText "ZcashPool" $ \case
|
||||
"p2pkh" -> return Transparent
|
||||
"sprout" -> return Sprout
|
||||
"sapling" -> return Sapling
|
||||
"orchard" -> return Orchard
|
||||
_ -> fail "Not a known Zcash pool"
|
||||
|
||||
data ZcashAddress =
|
||||
ZcashAddress
|
||||
{ source :: AddressSource
|
||||
, pool :: [ZcashPool]
|
||||
, account :: Maybe Integer
|
||||
, addy :: T.Text
|
||||
}
|
||||
deriving (Eq)
|
||||
|
||||
instance Show ZcashAddress where
|
||||
show (ZcashAddress s p i a) =
|
||||
T.unpack (T.take 8 a) ++
|
||||
"..." ++ T.unpack (T.takeEnd 8 a) ++ " Pools: " ++ show p
|
||||
|
||||
-- | A type to model the response of the Zcash RPC
|
||||
data RpcResponse r =
|
||||
RpcResponse
|
||||
{ err :: Maybe T.Text
|
||||
, respId :: T.Text
|
||||
, result :: r
|
||||
}
|
||||
deriving (Show, Generic, ToJSON)
|
||||
|
||||
instance (FromJSON r) => FromJSON (RpcResponse r) where
|
||||
parseJSON (Object obj) = do
|
||||
e <- obj .: "error"
|
||||
rId <- obj .: "id"
|
||||
r <- obj .: "result"
|
||||
pure $ RpcResponse e rId r
|
||||
parseJSON invalid =
|
||||
prependFailure
|
||||
"parsing RpcResponse failed, "
|
||||
(typeMismatch "Object" invalid)
|
||||
|
||||
newtype NodeVersion =
|
||||
NodeVersion Integer
|
||||
deriving (Eq, Show)
|
||||
|
||||
instance FromJSON NodeVersion where
|
||||
parseJSON =
|
||||
withObject "NodeVersion" $ \obj -> do
|
||||
v <- obj .: "version"
|
||||
pure $ NodeVersion v
|
||||
|
||||
-- | A type to model an address group
|
||||
data AddressGroup =
|
||||
AddressGroup
|
||||
{ agsource :: AddressSource
|
||||
, agtransparent :: [ZcashAddress]
|
||||
, agsapling :: [ZcashAddress]
|
||||
, agunified :: [ZcashAddress]
|
||||
}
|
||||
deriving (Show, Generic)
|
||||
|
||||
instance FromJSON AddressGroup where
|
||||
parseJSON =
|
||||
withObject "AddressGroup" $ \obj -> do
|
||||
s <- obj .: "source"
|
||||
t <- obj .:? "transparent"
|
||||
sap <- obj .:? "sapling"
|
||||
uni <- obj .:? "unified"
|
||||
sL <- processSapling sap s
|
||||
tL <- processTransparent t s
|
||||
uL <- processUnified uni
|
||||
return $ AddressGroup s tL (concat sL) (concat uL)
|
||||
where
|
||||
processTransparent c s1 =
|
||||
case c of
|
||||
Nothing -> return []
|
||||
Just x -> do
|
||||
x' <- x .: "addresses"
|
||||
return $ map (ZcashAddress s1 [Transparent] Nothing) x'
|
||||
processSapling k s2 =
|
||||
case k of
|
||||
Nothing -> return []
|
||||
Just y -> mapM (processOneSapling s2) y
|
||||
where processOneSapling sx =
|
||||
withObject "Sapling" $ \oS -> do
|
||||
oS' <- oS .: "addresses"
|
||||
return $ map (ZcashAddress sx [Sapling] Nothing) oS'
|
||||
processUnified u =
|
||||
case u of
|
||||
Nothing -> return []
|
||||
Just z -> mapM processOneAccount z
|
||||
where processOneAccount =
|
||||
withObject "UAs" $ \uS -> do
|
||||
acct <- uS .: "account"
|
||||
uS' <- uS .: "addresses"
|
||||
mapM (processUAs acct) uS'
|
||||
where
|
||||
processUAs a =
|
||||
withObject "UAs" $ \v -> do
|
||||
addr <- v .: "address"
|
||||
p <- v .: "receiver_types"
|
||||
return $ ZcashAddress MnemonicSeed p a addr
|
||||
|
||||
-- | A type to model a Zcash transaction
|
||||
data ZcashTx =
|
||||
ZcashTx
|
||||
{ ztxid :: T.Text
|
||||
, zamount :: Double
|
||||
, zamountZat :: Integer
|
||||
, zblockheight :: Integer
|
||||
, zblocktime :: Integer
|
||||
, zchange :: Bool
|
||||
, zconfirmations :: Integer
|
||||
, zmemo :: T.Text
|
||||
}
|
||||
deriving (Show, Generic)
|
||||
|
||||
instance FromJSON ZcashTx where
|
||||
parseJSON =
|
||||
withObject "ZcashTx" $ \obj -> do
|
||||
t <- obj .: "txid"
|
||||
a <- obj .: "amount"
|
||||
aZ <- obj .: "amountZat"
|
||||
bh <- obj .: "blockheight"
|
||||
bt <- obj .: "blocktime"
|
||||
c <- obj .: "change"
|
||||
conf <- obj .: "confirmations"
|
||||
m <- obj .:? "memo"
|
||||
pure $
|
||||
ZcashTx
|
||||
t
|
||||
a
|
||||
aZ
|
||||
bh
|
||||
bt
|
||||
c
|
||||
conf
|
||||
(case m of
|
||||
Nothing -> ""
|
||||
Just m' -> T.pack (filter (/= '\NUL') $ decodeHexText m'))
|
||||
|
||||
instance ToJSON ZcashTx where
|
||||
toJSON (ZcashTx t a aZ bh bt c conf m) =
|
||||
object
|
||||
[ "amount" .= a
|
||||
, "amountZat" .= aZ
|
||||
, "txid" .= t
|
||||
, "blockheight" .= bh
|
||||
, "blocktime" .= bt
|
||||
, "change" .= c
|
||||
, "confirmations" .= conf
|
||||
, "memo" .= m
|
||||
]
|
||||
|
||||
-- | Type for the UA balance
|
||||
data UABalance =
|
||||
UABalance
|
||||
{ uatransparent :: Integer
|
||||
, uasapling :: Integer
|
||||
, uaorchard :: Integer
|
||||
}
|
||||
deriving (Eq)
|
||||
|
||||
instance Show UABalance where
|
||||
show (UABalance t s o) =
|
||||
" T: " ++ show t ++ " S: " ++ show s ++ " O: " ++ show o
|
||||
|
||||
instance FromJSON UABalance where
|
||||
parseJSON =
|
||||
withObject "UABalance" $ \obj -> do
|
||||
p <- obj .: "pools"
|
||||
t <- p .:? "transparent"
|
||||
s <- p .:? "sapling"
|
||||
o <- p .:? "orchard"
|
||||
vT <-
|
||||
case t of
|
||||
Nothing -> return 0
|
||||
Just t' -> t' .: "valueZat"
|
||||
vS <-
|
||||
case s of
|
||||
Nothing -> return 0
|
||||
Just s' -> s' .: "valueZat"
|
||||
vO <-
|
||||
case o of
|
||||
Nothing -> return 0
|
||||
Just o' -> o' .: "valueZat"
|
||||
pure $ UABalance vT vS vO
|
||||
|
||||
-- | Type for Operation Result
|
||||
data OpResult =
|
||||
OpResult
|
||||
{ opsuccess :: Bool
|
||||
, opmessage :: Maybe T.Text
|
||||
, optxid :: Maybe T.Text
|
||||
}
|
||||
deriving (Show, Eq)
|
||||
|
||||
instance FromJSON OpResult where
|
||||
parseJSON =
|
||||
withObject "OpResult" $ \obj -> do
|
||||
s <- obj .: "status"
|
||||
let s' = s == ("success" :: String)
|
||||
r <- obj .:? "result"
|
||||
e <- obj .:? "error"
|
||||
t <-
|
||||
case r of
|
||||
Nothing -> return Nothing
|
||||
Just r' -> r' .: "txid"
|
||||
m <-
|
||||
case e of
|
||||
Nothing -> return Nothing
|
||||
Just m' -> m' .: "message"
|
||||
pure $ OpResult s' m t
|
||||
|
||||
-- | Helper function to turn a hex-encoded memo strings to readable text
|
||||
decodeHexText :: String -> String
|
||||
decodeHexText hexText
|
||||
| null chunk = ""
|
||||
| otherwise = chr (read ("0x" <> chunk)) : decodeHexText (drop 2 hexText)
|
||||
where
|
||||
chunk = take 2 hexText
|
||||
|
||||
-- | Helper function to turn a string into a hex-encoded string
|
||||
encodeHexText :: String -> String
|
||||
encodeHexText t = mconcat (map padHex t)
|
||||
where
|
||||
padHex x =
|
||||
if ord x < 16
|
||||
then "0" ++ (showHex . ord) x ""
|
||||
else showHex (ord x) ""
|
||||
|
||||
-- | Helper function to extract addresses from AddressGroups
|
||||
getAddresses :: AddressGroup -> [ZcashAddress]
|
||||
getAddresses ag = agtransparent ag <> agsapling ag <> agunified ag
|
||||
|
||||
-- | Helper function to validate potential Zcash addresses
|
||||
validateAddress :: T.Text -> Bool
|
||||
validateAddress txt = (tReg || sReg && isJust chk) || (uReg && isJust chk)
|
||||
where
|
||||
transparentRegex = "^t1[a-zA-Z0-9]{33}$" :: String
|
||||
shieldedRegex = "^zs[a-zA-Z0-9]{76}$" :: String
|
||||
unifiedRegex = "^u[a-zA-Z0-9]" :: String
|
||||
tReg = T.unpack txt =~ transparentRegex :: Bool
|
||||
sReg = T.unpack txt =~ shieldedRegex :: Bool
|
||||
uReg = T.unpack txt =~ unifiedRegex :: Bool
|
||||
chk = bech32mDecode txt
|
||||
|
||||
-- | RPC methods
|
||||
-- | List addresses
|
||||
listAddresses :: B.ByteString -> B.ByteString -> IO [ZcashAddress]
|
||||
listAddresses user pwd = do
|
||||
response <- makeZcashCall user pwd "listaddresses" []
|
||||
let rpcResp = decode response :: Maybe (RpcResponse [AddressGroup])
|
||||
case rpcResp of
|
||||
Nothing -> fail "Couldn't parse node response"
|
||||
Just res -> do
|
||||
let addys = result res
|
||||
let addList = concatMap getAddresses addys
|
||||
return addList
|
||||
|
||||
-- | Get address balance
|
||||
getBalance :: B.ByteString -> B.ByteString -> ZcashAddress -> IO [Integer]
|
||||
getBalance user pwd zadd = do
|
||||
let a = account zadd
|
||||
case a of
|
||||
Nothing -> do
|
||||
response <-
|
||||
makeZcashCall
|
||||
user
|
||||
pwd
|
||||
"z_getbalance"
|
||||
[ String (addy zadd)
|
||||
, Number (Scientific.scientific 1 0)
|
||||
, Data.Aeson.Bool True
|
||||
]
|
||||
let rpcResp = decode response :: Maybe (RpcResponse Integer)
|
||||
case rpcResp of
|
||||
Nothing -> fail "Couldn't parse node response"
|
||||
Just res -> do
|
||||
return [result res]
|
||||
Just acct -> do
|
||||
response <-
|
||||
makeZcashCall
|
||||
user
|
||||
pwd
|
||||
"z_getbalanceforaccount"
|
||||
[Number (Scientific.scientific acct 0)]
|
||||
let rpcResp = decode response :: Maybe (RpcResponse UABalance)
|
||||
case rpcResp of
|
||||
Nothing -> fail "Couldn't parse node response"
|
||||
Just res -> do
|
||||
return $ readUABalance (result res)
|
||||
where readUABalance ua =
|
||||
[uatransparent ua, uasapling ua, uaorchard ua]
|
||||
|
||||
-- | List transactions
|
||||
listTxs :: B.ByteString -> B.ByteString -> ZcashAddress -> IO [ZcashTx]
|
||||
listTxs user pwd zaddy = do
|
||||
response <-
|
||||
makeZcashCall user pwd "z_listreceivedbyaddress" [String $ addy zaddy]
|
||||
let rpcResp = decode response :: Maybe (RpcResponse [ZcashTx])
|
||||
case rpcResp of
|
||||
Nothing -> fail "Couldn't parse node response"
|
||||
Just res -> do
|
||||
return $ result res
|
||||
|
||||
-- | Send Tx
|
||||
sendTx ::
|
||||
B.ByteString
|
||||
-> B.ByteString
|
||||
-> ZcashAddress
|
||||
-> T.Text
|
||||
-> Double
|
||||
-> String
|
||||
-> IO ()
|
||||
sendTx user pwd fromAddy toAddy amount memo = do
|
||||
bal <- getBalance user pwd fromAddy
|
||||
if sum bal - floor (amount * 100000000) >= 1000
|
||||
then do
|
||||
if source fromAddy /= ImportedWatchOnly
|
||||
then do
|
||||
let privacyPolicy =
|
||||
if isNothing (account fromAddy) &&
|
||||
elem Transparent (pool fromAddy)
|
||||
then "AllowRevealedSenders"
|
||||
else "AllowRevealedAmounts"
|
||||
let pd =
|
||||
[ Data.Aeson.String (addy fromAddy)
|
||||
, Data.Aeson.Array
|
||||
(V.fromList
|
||||
[ object
|
||||
[ "address" .= toAddy
|
||||
, "amount" .= amount
|
||||
, "memo" .= encodeHexText memo
|
||||
]
|
||||
])
|
||||
, Data.Aeson.Number $ Scientific.scientific 1 1
|
||||
, Data.Aeson.Number $ Scientific.scientific 1 (-5)
|
||||
, Data.Aeson.String privacyPolicy
|
||||
]
|
||||
response <- makeZcashCall user pwd "z_sendmany" pd
|
||||
let rpcResp = decode response :: Maybe (RpcResponse T.Text)
|
||||
case rpcResp of
|
||||
Nothing -> fail "Couldn't parse node response"
|
||||
Just res -> do
|
||||
putStrLn " Sending...."
|
||||
threadDelay 10000000 >> checkOpResult user pwd (result res)
|
||||
else putStrLn "Error: Source address is view-only."
|
||||
else putStrLn "Error: Insufficient balance in source address."
|
||||
|
||||
-- | Make a Zcash RPC call
|
||||
makeZcashCall ::
|
||||
B.ByteString
|
||||
-> B.ByteString
|
||||
-> T.Text
|
||||
-> [Data.Aeson.Value]
|
||||
-> IO LB.ByteString
|
||||
makeZcashCall username password m p = do
|
||||
let payload = RpcCall "1.0" "test" m p
|
||||
let myRequest =
|
||||
setRequestBodyJSON payload $
|
||||
setRequestPort 8232 $
|
||||
setRequestBasicAuth username password $
|
||||
setRequestMethod "POST" defaultRequest
|
||||
response <- httpLBS myRequest
|
||||
let respStatus = getResponseStatusCode response
|
||||
let body = getResponseBody response
|
||||
case respStatus of
|
||||
500 -> do
|
||||
let rpcResp = decode body :: Maybe (RpcResponse String)
|
||||
case rpcResp of
|
||||
Nothing -> fail "Unknown server error"
|
||||
Just x -> fail (result x)
|
||||
401 -> fail "Incorrect full node credentials"
|
||||
200 -> return body
|
||||
_ -> fail "Unknown error"
|
||||
|
||||
-- | Display an address
|
||||
displayZcashAddress ::
|
||||
B.ByteString -> B.ByteString -> (Int, ZcashAddress) -> IO ()
|
||||
displayZcashAddress user pwd (idx, zaddy) = do
|
||||
zats <- getBalance user pwd zaddy
|
||||
putStr $ show idx ++ ": "
|
||||
putStr $ show zaddy
|
||||
putStr " Zats: "
|
||||
print zats
|
||||
|
||||
-- | Copy an address to the clipboard
|
||||
copyAddress :: ZcashAddress -> IO ()
|
||||
copyAddress a =
|
||||
void $
|
||||
createProcess_ "toClipboard" $
|
||||
shell $ "echo " ++ T.unpack (addy a) ++ " | xclip -r -selection clipboard"
|
||||
|
||||
-- | Verify operation result
|
||||
checkOpResult :: B.ByteString -> B.ByteString -> T.Text -> IO ()
|
||||
checkOpResult user pwd opid = do
|
||||
response <-
|
||||
makeZcashCall
|
||||
user
|
||||
pwd
|
||||
"z_getoperationstatus"
|
||||
[Data.Aeson.Array (V.fromList [Data.Aeson.String opid])]
|
||||
let rpcResp = decode response :: Maybe (RpcResponse [OpResult])
|
||||
case rpcResp of
|
||||
Nothing -> fail "Couldn't parse node response"
|
||||
Just res -> do
|
||||
let r = result res
|
||||
mapM_ showResult r
|
||||
where
|
||||
showResult t =
|
||||
if opsuccess t
|
||||
then putStrLn $ " Success! Tx ID: " ++ maybe "" T.unpack (optxid t)
|
||||
else putStrLn $ " Failed :( " ++ maybe "" T.unpack (opmessage t)
|
||||
|
||||
-- | Check for accounts
|
||||
checkAccounts :: B.ByteString -> B.ByteString -> IO Bool
|
||||
checkAccounts user pwd = do
|
||||
response <- makeZcashCall user pwd "z_listaccounts" []
|
||||
let rpcResp = decode response :: Maybe (RpcResponse [Object])
|
||||
case rpcResp of
|
||||
Nothing -> fail "Couldn't parse node response"
|
||||
Just res -> do
|
||||
let r = result res
|
||||
return $ not (null r)
|
||||
|
||||
-- | Add account to node
|
||||
createAccount :: B.ByteString -> B.ByteString -> IO ()
|
||||
createAccount user pwd = do
|
||||
response <- makeZcashCall user pwd "z_getnewaccount" []
|
||||
let rpcResp = decode response :: Maybe (RpcResponse Object)
|
||||
case rpcResp of
|
||||
Nothing -> fail "Couldn't parse node response"
|
||||
Just res -> do
|
||||
let r = result res
|
||||
putStrLn " Account created!"
|
||||
|
||||
-- | Create new Unified Address
|
||||
createUnifiedAddress :: B.ByteString -> B.ByteString -> Bool -> Bool -> IO ()
|
||||
createUnifiedAddress user pwd tRec sRec = do
|
||||
let recs = getReceivers tRec sRec
|
||||
let pd = [Data.Aeson.Number $ Scientific.scientific 0 1, recs]
|
||||
newResp <- makeZcashCall user pwd "z_getaddressforaccount" pd
|
||||
let rpcResp = decode newResp :: Maybe (RpcResponse Object)
|
||||
case rpcResp of
|
||||
Nothing -> fail "Couldn't parse node response"
|
||||
Just res -> do
|
||||
let r = result res
|
||||
putStrLn " New UA created!"
|
||||
where
|
||||
getReceivers t s
|
||||
| t && s =
|
||||
Data.Aeson.Array
|
||||
(V.fromList
|
||||
[ Data.Aeson.String "p2pkh"
|
||||
, Data.Aeson.String "sapling"
|
||||
, Data.Aeson.String "orchard"
|
||||
])
|
||||
| t =
|
||||
Data.Aeson.Array
|
||||
(V.fromList [Data.Aeson.String "p2pkh", Data.Aeson.String "orchard"])
|
||||
| s =
|
||||
Data.Aeson.Array
|
||||
(V.fromList [Data.Aeson.String "sapling", Data.Aeson.String "orchard"])
|
||||
| otherwise = Data.Aeson.Array (V.fromList [Data.Aeson.String "orchard"])
|
||||
|
||||
-- | Check Zcash full node server
|
||||
checkServer :: B.ByteString -> B.ByteString -> IO ()
|
||||
checkServer user pwd = do
|
||||
resp <- makeZcashCall user pwd "getinfo" []
|
||||
let rpcResp = decode resp :: Maybe (RpcResponse NodeVersion)
|
||||
case rpcResp of
|
||||
Nothing -> fail "Couldn't parse node response"
|
||||
Just myResp -> do
|
||||
let r = result myResp
|
||||
if isNodeValid r
|
||||
then putStrLn "Connected to Zcash Full Node :)"
|
||||
else do
|
||||
putStrLn "Deprecated Zcash Full Node version found. Exiting"
|
||||
exitFailure
|
||||
where isNodeValid (NodeVersion i) = i >= 5000000
|
||||
|
|
@ -0,0 +1,68 @@
|
|||
# This file was automatically generated by 'stack init'
|
||||
#
|
||||
# Some commonly used options have been documented as comments in this file.
|
||||
# For advanced use and comprehensive documentation of the format, please see:
|
||||
# https://docs.haskellstack.org/en/stable/yaml_configuration/
|
||||
|
||||
# Resolver to choose a 'specific' stackage snapshot or a compiler version.
|
||||
# A snapshot resolver dictates the compiler version and the set of packages
|
||||
# to be used for project dependencies. For example:
|
||||
#
|
||||
# resolver: lts-3.5
|
||||
# resolver: nightly-2015-09-21
|
||||
# resolver: ghc-7.10.2
|
||||
#
|
||||
# The location of a snapshot can be provided as a file or url. Stack assumes
|
||||
# a snapshot provided as a file might change, whereas a url resource does not.
|
||||
#
|
||||
# resolver: ./custom-snapshot.yaml
|
||||
# resolver: https://example.com/snapshots/2018-01-01.yaml
|
||||
resolver:
|
||||
url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/19/9.yaml
|
||||
|
||||
# User packages to be built.
|
||||
# Various formats can be used as shown in the example below.
|
||||
#
|
||||
# packages:
|
||||
# - some-directory
|
||||
# - https://example.com/foo/bar/baz-0.0.2.tar.gz
|
||||
# subdirs:
|
||||
# - auto-update
|
||||
# - wai
|
||||
packages:
|
||||
- .
|
||||
- haskoin
|
||||
# Dependency packages to be pulled from upstream that are not in the resolver.
|
||||
# These entries can reference officially published versions as well as
|
||||
# forks / in-progress versions pinned to a git hash. For example:
|
||||
#
|
||||
# extra-deps:
|
||||
# - acme-missiles-0.3
|
||||
# - git: https://github.com/commercialhaskell/stack.git
|
||||
# commit: e7b331f14bcffb8367cd58fbfc8b40ec7642100a
|
||||
#
|
||||
# extra-deps: []
|
||||
|
||||
# Override default flag values for local packages and extra-deps
|
||||
# flags: {}
|
||||
|
||||
# Extra package databases containing global packages
|
||||
# extra-package-dbs: []
|
||||
|
||||
# Control whether we use the GHC we find on the path
|
||||
# system-ghc: true
|
||||
#
|
||||
# Require a specific version of stack, using version ranges
|
||||
# require-stack-version: -any # Default
|
||||
# require-stack-version: ">=2.7"
|
||||
#
|
||||
# Override the architecture used by stack, especially useful on Windows
|
||||
# arch: i386
|
||||
# arch: x86_64
|
||||
#
|
||||
# Extra directories used by stack for building
|
||||
# extra-include-dirs: [/path/to/dir]
|
||||
#extra-lib-dirs: [/home/rav/Documents/programs/haskoin]
|
||||
#
|
||||
# Allow a newer minor version of GHC than the snapshot specifies
|
||||
# compiler-check: newer-minor
|
||||
|
|
@ -0,0 +1,13 @@
|
|||
# This file was autogenerated by Stack.
|
||||
# You should not edit this file by hand.
|
||||
# For more information, please see the documentation at:
|
||||
# https://docs.haskellstack.org/en/stable/lock_files
|
||||
|
||||
packages: []
|
||||
snapshots:
|
||||
- completed:
|
||||
size: 618507
|
||||
url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/19/9.yaml
|
||||
sha256: 190a93d09d9d7bccc78a0f00d6fc0350eed76bc533611e5971202800805dd00e
|
||||
original:
|
||||
url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/19/9.yaml
|
||||
|
|
@ -0,0 +1,2 @@
|
|||
main :: IO ()
|
||||
main = putStrLn "Test suite not yet implemented"
|
||||
|
|
@ -0,0 +1,79 @@
|
|||
cabal-version: 1.12
|
||||
|
||||
-- This file has been generated from package.yaml by hpack version 0.34.4.
|
||||
--
|
||||
-- see: https://github.com/sol/hpack
|
||||
|
||||
name: zenith
|
||||
version: 0.1.0.0
|
||||
description: Please see the README on GitLab at <https://gitlab.com/pitmutt/zenit#readme>
|
||||
homepage: https://github.com/pitmutt/zenit#readme
|
||||
bug-reports: https://github.com/pitmutt/zenit/issues
|
||||
author: Rene Vergara
|
||||
maintainer: rene@vergara.network
|
||||
copyright: Copyright (c) 2022 Vergara Technologies LLC
|
||||
license: MIT
|
||||
license-file: LICENSE
|
||||
build-type: Simple
|
||||
extra-source-files:
|
||||
README.md
|
||||
ChangeLog.md
|
||||
|
||||
source-repository head
|
||||
type: git
|
||||
location: https://github.com/pitmutt/zenit
|
||||
|
||||
library
|
||||
exposed-modules:
|
||||
Zenith
|
||||
other-modules:
|
||||
Paths_zenith
|
||||
hs-source-dirs:
|
||||
src
|
||||
build-depends:
|
||||
Clipboard
|
||||
, aeson
|
||||
, base >=4.7 && <5
|
||||
, bytestring
|
||||
, haskoin-core
|
||||
, http-conduit
|
||||
, http-types
|
||||
, process
|
||||
, regex-base
|
||||
, regex-posix
|
||||
, scientific
|
||||
, text
|
||||
, vector
|
||||
default-language: Haskell2010
|
||||
|
||||
executable zenith
|
||||
main-is: Main.hs
|
||||
other-modules:
|
||||
Paths_zenith
|
||||
hs-source-dirs:
|
||||
app
|
||||
ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall
|
||||
build-depends:
|
||||
base >=4.7 && <5
|
||||
, bytestring
|
||||
, configurator
|
||||
, data-default
|
||||
, sort
|
||||
, structured-cli
|
||||
, text
|
||||
, time
|
||||
, zenith
|
||||
default-language: Haskell2010
|
||||
|
||||
test-suite zenith-test
|
||||
type: exitcode-stdio-1.0
|
||||
main-is: Spec.hs
|
||||
other-modules:
|
||||
Paths_zenith
|
||||
hs-source-dirs:
|
||||
test
|
||||
ghc-options: -threaded -rtsopts -with-rtsopts=-N
|
||||
build-depends:
|
||||
base >=4.7 && <5
|
||||
, zenith
|
||||
default-language: Haskell2010
|
||||
|
|
@ -0,0 +1,2 @@
|
|||
nodeUser = "user"
|
||||
nodePwd = "superSecret"
|
||||
Loading…
Reference in New Issue