commit a100087646392009ac7141c0e47018846f458709 Author: Rene Vergara Date: Mon Jun 20 16:46:13 2022 -0500 Initial commit diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..c368d45 --- /dev/null +++ b/.gitignore @@ -0,0 +1,2 @@ +.stack-work/ +*~ \ No newline at end of file diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 index 0000000..4db212e --- /dev/null +++ b/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 + diff --git a/LICENSE b/LICENSE new file mode 100644 index 0000000..2caba40 --- /dev/null +++ b/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 diff --git a/README.md b/README.md new file mode 100644 index 0000000..7defc84 --- /dev/null +++ b/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 `: 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. + + diff --git a/Setup.hs b/Setup.hs new file mode 100644 index 0000000..9a994af --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/app/Main.hs b/app/Main.hs new file mode 100644 index 0000000..5bee76b --- /dev/null +++ b/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 ' shows transactions for address 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) diff --git a/haskoin b/haskoin new file mode 120000 index 0000000..88c0a48 --- /dev/null +++ b/haskoin @@ -0,0 +1 @@ +/home/rav/Documents/programs/haskoin-core/ \ No newline at end of file diff --git a/package.yaml b/package.yaml new file mode 100644 index 0000000..665f994 --- /dev/null +++ b/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 + +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 diff --git a/src/Zenith.hs b/src/Zenith.hs new file mode 100644 index 0000000..9aa2b73 --- /dev/null +++ b/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 diff --git a/stack.yaml b/stack.yaml new file mode 100644 index 0000000..fd6300b --- /dev/null +++ b/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 diff --git a/stack.yaml.lock b/stack.yaml.lock new file mode 100644 index 0000000..7a63f03 --- /dev/null +++ b/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 diff --git a/test/Spec.hs b/test/Spec.hs new file mode 100644 index 0000000..cd4753f --- /dev/null +++ b/test/Spec.hs @@ -0,0 +1,2 @@ +main :: IO () +main = putStrLn "Test suite not yet implemented" diff --git a/zenith.cabal b/zenith.cabal new file mode 100644 index 0000000..1d393ad --- /dev/null +++ b/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 +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 diff --git a/zenith.cfg b/zenith.cfg new file mode 100644 index 0000000..e1d4a4f --- /dev/null +++ b/zenith.cfg @@ -0,0 +1,2 @@ +nodeUser = "user" +nodePwd = "superSecret"