Initial commit

.gitignore

@@ -0,0 +1,2 @@
+.stack-work/
+*~

CHANGELOG.md

@@ -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
+

LICENSE

@@ -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

README.md

@@ -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.
+
+

Setup.hs

@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain

app/Main.hs

@@ -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)

haskoin

@@ -0,0 +1 @@
+/home/rav/Documents/programs/haskoin-core/

package.yaml

@@ -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

src/Zenith.hs

@@ -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

stack.yaml

@@ -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

stack.yaml.lock

@@ -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

test/Spec.hs

@@ -0,0 +1,2 @@
+main :: IO ()
+main = putStrLn "Test suite not yet implemented"

zenith.cabal

@@ -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

zenith.cfg

@@ -0,0 +1,2 @@
+nodeUser = "user"
+nodePwd = "superSecret"