CHANGELOG.md

@@ -5,6 +5,12 @@ All notable changes to this project will be documented in this file.
 The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.0.0/),
 and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0.html).
 
+## [0.4.1]
+
+### Fixed
+
+- Handling of transactions to transparent receivers
+
 ## [0.4.0]
 
 ### Added

app/Main.hs

@@ -15,7 +15,9 @@ import System.Console.StructuredCLI
 import System.Exit
 import System.IO
 import Text.Read (readMaybe)
-import Zenith
+import Zenith.Types (ZcashAddress(..), ZcashPool(..), ZcashTx(..))
+import Zenith.Utils
+import Zenith.Zcashd
 
 prompt :: String -> IO String
 prompt text = do

package.yaml

@@ -1,5 +1,5 @@
 name:                zenith
-version:             0.4.0
+version:             0.4.1
 git:                 "https://git.vergara.tech/Vergara_Tech/zenith"
 license:             BOSL
 author:              "Rene Vergara"

src/Zenith/DB.hs

@@ -0,0 +1 @@
+module Zenith.DB where

src/Zenith/Types.hs

@@ -0,0 +1,275 @@
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE OverloadedStrings #-}
+
+module Zenith.Types where
+
+import Data.Aeson
+import Data.Aeson.Types (prependFailure, typeMismatch)
+import qualified Data.ByteString as BS
+import qualified Data.ByteString.Base64 as B64
+import qualified Data.ByteString.Char8 as C
+import Data.Maybe (fromMaybe)
+import qualified Data.Text as T
+import qualified Data.Text.Encoding as E
+import Data.Text.Encoding.Error (lenientDecode)
+import GHC.Generics
+
+-- | 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 $ maybe [] (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
+          (fromMaybe False c)
+          conf
+          (case m of
+             Nothing -> ""
+             Just m' -> T.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 :: !T.Text
+  , opmessage :: !(Maybe T.Text)
+  , optxid :: !(Maybe T.Text)
+  } deriving (Show, Eq)
+
+instance FromJSON OpResult where
+  parseJSON =
+    withObject "OpResult" $ \obj -> do
+      s <- obj .: "status"
+      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 functions
+-- | Helper function to turn a hex-encoded memo strings to readable text
+decodeHexText :: String -> T.Text
+decodeHexText h = E.decodeUtf8With lenientDecode $ BS.pack $ hexRead h
+  where
+    hexRead hexText
+      | null chunk = []
+      | otherwise =
+        fromIntegral (read ("0x" <> chunk)) : hexRead (drop 2 hexText)
+      where
+        chunk = take 2 hexText
+
+-- | Helper function to turn a text into a hex-encoded string
+encodeHexText' :: T.Text -> String
+encodeHexText' t =
+  if T.length t > 0
+    then C.unpack . B64.encode $ E.encodeUtf8 t
+    else C.unpack . B64.encode $ E.encodeUtf8 "Sent from Zenith"

src/Zenith/Utils.hs

@@ -0,0 +1,59 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module Zenith.Utils where
+
+import qualified Data.ByteString as BS
+import qualified Data.ByteString.Char8 as C
+import Data.Char
+import Data.Functor (void)
+import Data.Maybe
+import qualified Data.Text as T
+import qualified Data.Text.Encoding as E
+import qualified Data.Text.IO as TIO
+import System.Process (createProcess_, shell)
+import Text.Read (readMaybe)
+import Text.Regex.Posix
+import ZcashHaskell.Orchard (isValidUnifiedAddress)
+import ZcashHaskell.Sapling (isValidShieldedAddress)
+import Zenith.Types
+  ( AddressGroup(..)
+  , AddressSource(..)
+  , ZcashAddress(..)
+  , ZcashPool(..)
+  )
+
+-- | Helper function to display small amounts of ZEC
+displayZec :: Integer -> String
+displayZec s
+  | s < 100 = show s ++ " zats "
+  | s < 100000 = show (fromIntegral s / 100) ++ " μZEC "
+  | s < 100000000 = show (fromIntegral s / 100000) ++ " mZEC "
+  | otherwise = show (fromIntegral s / 100000000) ++ " ZEC "
+
+-- | 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 -> Maybe ZcashPool
+validateAddress txt --(tReg || sReg && isJust chk) || (uReg && isJust chk)
+  | tReg = Just Transparent
+  | sReg && chkS = Just Sapling
+  | uReg && chk = Just Orchard
+  | otherwise = Nothing
+  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 = isJust $ isValidUnifiedAddress $ E.encodeUtf8 txt
+    chkS = isValidShieldedAddress $ E.encodeUtf8 txt
+
+-- | Copy an address to the clipboard
+copyAddress :: ZcashAddress -> IO ()
+copyAddress a =
+  void $
+  createProcess_ "toClipboard" $
+  shell $ "echo " ++ T.unpack (addy a) ++ " | xclip -r -selection clipboard"

src/Zenith/Zcashd.hs

@@ -1,24 +1,15 @@
-{-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE DeriveAnyClass #-}
 {-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE LambdaCase #-}
 
-module Zenith where
+module Zenith.Zcashd where
 
 import Control.Concurrent (threadDelay)
-import Control.Monad
+import Control.Monad (when)
-import Crypto.Hash.BLAKE2.BLAKE2b
 import Data.Aeson
-import Data.Aeson.Types
 import qualified Data.Array as A
-import Data.Bits
+import qualified Data.ByteString as BS
-import qualified Data.ByteString as B
 import qualified Data.ByteString.Base64 as B64
 import qualified Data.ByteString.Char8 as C
-import qualified Data.ByteString.Lazy as LB
+import qualified Data.ByteString.Lazy as LBS
-import Data.Char
-import Data.Functor (void)
-import Data.HexString
 import Data.Maybe
 import qualified Data.Scientific as Scientific
 import qualified Data.Text as T
@@ -26,318 +17,31 @@ import qualified Data.Text.Encoding as E
 import Data.Text.Encoding.Error (lenientDecode)
 import qualified Data.Text.IO as TIO
 import qualified Data.Vector as V
-import Data.Word
-import GHC.Generics
 import Network.HTTP.Simple
-import Network.HTTP.Types
-import Numeric
 import System.Clipboard
 import System.Exit
 import System.IO
-import System.Process (createProcess_, shell)
 import Text.Read (readMaybe)
 import Text.Regex
 import Text.Regex.Base
-import Text.Regex.Posix
+import Zenith.Types
-import ZcashHaskell.Orchard (isValidUnifiedAddress)
+  ( AddressGroup
-import ZcashHaskell.Sapling (isValidShieldedAddress)
+  , AddressSource(..)
+  , NodeVersion(..)
+  , OpResult(..)
+  , RpcCall(..)
+  , RpcResponse(..)
+  , UABalance(..)
+  , ZcashAddress(..)
+  , ZcashPool(..)
+  , ZcashTx
+  , encodeHexText'
+  )
+import Zenith.Utils (displayZec, getAddresses, validateAddress)
 
--- | A type to model Zcash RPC calls
+-- * RPC methods
-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 $ maybe [] (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
-
-displayZec :: Integer -> String
-displayZec s
-  | s < 100 = show s ++ " zats "
-  | s < 100000 = show (fromIntegral s / 100) ++ " μZEC "
-  | s < 100000000 = show (fromIntegral s / 100000) ++ " mZEC "
-  | otherwise = show (fromIntegral s / 100000000) ++ " ZEC "
-
--- | 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
-          (fromMaybe False c)
-          conf
-          (case m of
-             Nothing -> ""
-             Just m' -> T.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 :: T.Text
-  , opmessage :: Maybe T.Text
-  , optxid :: Maybe T.Text
-  } deriving (Show, Eq)
-
-instance FromJSON OpResult where
-  parseJSON =
-    withObject "OpResult" $ \obj -> do
-      s <- obj .: "status"
-      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 -> T.Text
-decodeHexText h = E.decodeUtf8With lenientDecode $ B.pack $ hexRead h
-  where
-    hexRead hexText
-      | null chunk = []
-      | otherwise =
-        fromIntegral (read ("0x" <> chunk)) : hexRead (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) ""
-
-encodeHexText' :: T.Text -> String
-encodeHexText' t =
-  if T.length t > 0
-    then T.unpack . toText . fromBytes $ E.encodeUtf8 t
-    else T.unpack . toText . fromBytes $ E.encodeUtf8 "Sent from Zenith"
-
--- | 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 -> Maybe ZcashPool
-validateAddress txt --(tReg || sReg && isJust chk) || (uReg && isJust chk)
-  | tReg = Just Transparent
-  | sReg && chkS = Just Sapling
-  | uReg && chk = Just Orchard
-  | otherwise = Nothing
-  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 = isValidUnifiedAddress $ E.encodeUtf8 txt
-    chkS = isValidShieldedAddress $ E.encodeUtf8 txt
-
--- | RPC methods
 -- | List addresses
-listAddresses :: B.ByteString -> B.ByteString -> IO [ZcashAddress]
+listAddresses :: BS.ByteString -> BS.ByteString -> IO [ZcashAddress]
 listAddresses user pwd = do
   response <- makeZcashCall user pwd "listaddresses" []
   let rpcResp = decode response :: Maybe (RpcResponse [AddressGroup])
@@ -349,7 +53,7 @@ listAddresses user pwd = do
       return addList
 
 -- | Get address balance
-getBalance :: B.ByteString -> B.ByteString -> ZcashAddress -> IO [Integer]
+getBalance :: BS.ByteString -> BS.ByteString -> ZcashAddress -> IO [Integer]
 getBalance user pwd zadd = do
   let a = account zadd
   case a of
@@ -384,7 +88,7 @@ getBalance user pwd zadd = do
                   [uatransparent ua, uasapling ua, uaorchard ua]
 
 -- | List transactions
-listTxs :: B.ByteString -> B.ByteString -> ZcashAddress -> IO [ZcashTx]
+listTxs :: BS.ByteString -> BS.ByteString -> ZcashAddress -> IO [ZcashTx]
 listTxs user pwd zaddy = do
   response <-
     makeZcashCall user pwd "z_listreceivedbyaddress" [String $ addy zaddy]
@@ -396,8 +100,8 @@ listTxs user pwd zaddy = do
 
 -- | Send Tx
 sendTx ::
-     B.ByteString
+     BS.ByteString
-  -> B.ByteString
+  -> BS.ByteString
   -> ZcashAddress
   -> T.Text
   -> Double
@@ -450,80 +154,24 @@ sendTx user pwd fromAddy toAddy amount memo = do
         else putStrLn "Error: Source address is view-only."
     else putStrLn "Error: Insufficient balance in source address."
 
--- | Make a Zcash RPC call
+-- | Check Zcash full node server
-makeZcashCall ::
+checkServer :: BS.ByteString -> BS.ByteString -> IO ()
-     B.ByteString
+checkServer user pwd = do
-  -> B.ByteString
+  resp <- makeZcashCall user pwd "getinfo" []
-  -> T.Text
+  let rpcResp = decode resp :: Maybe (RpcResponse NodeVersion)
-  -> [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 " ++ show response
-        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
-  when (source zaddy == ImportedWatchOnly) (putStr "[VK]")
-  putStr " Balance: "
-  mapM_ (putStr . displayZec) zats
-  putStrLn ""
-
--- | 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
+    Just myResp -> do
-      let r = result res
+      let r = result myResp
-      mapM_ showResult r
+      if isNodeValid r
-  where
+        then putStrLn $ "Connected to Zcash Full Node (" <> show r <> ") :)"
-    showResult t =
+        else do
-      case opsuccess t of
+          putStrLn "Deprecated Zcash Full Node version found. Exiting"
-        "success" ->
+          exitFailure
-          putStrLn $ "  Success! Tx ID: " ++ maybe "" T.unpack (optxid t)
+      where isNodeValid (NodeVersion i) = i >= 5000000
-        "executing" -> do
-          putStr "."
-          hFlush stdout
-          threadDelay 1000000 >> checkOpResult user pwd opid
-        _ -> putStrLn $ "  Failed :( " ++ maybe "" T.unpack (opmessage t)
 
 -- | Check for accounts
-checkAccounts :: B.ByteString -> B.ByteString -> IO Bool
+checkAccounts :: BS.ByteString -> BS.ByteString -> IO Bool
 checkAccounts user pwd = do
   response <- makeZcashCall user pwd "z_listaccounts" []
   let rpcResp = decode response :: Maybe (RpcResponse [Object])
@@ -534,7 +182,7 @@ checkAccounts user pwd = do
       return $ not (null r)
 
 -- | Add account to node
-createAccount :: B.ByteString -> B.ByteString -> IO ()
+createAccount :: BS.ByteString -> BS.ByteString -> IO ()
 createAccount user pwd = do
   response <- makeZcashCall user pwd "z_getnewaccount" []
   let rpcResp = decode response :: Maybe (RpcResponse Object)
@@ -545,7 +193,7 @@ createAccount user pwd = do
       putStrLn "  Account created!"
 
 -- | Create new Unified Address
-createUnifiedAddress :: B.ByteString -> B.ByteString -> Bool -> Bool -> IO ()
+createUnifiedAddress :: BS.ByteString -> BS.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]
@@ -573,25 +221,62 @@ createUnifiedAddress user pwd tRec sRec = do
           (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
+-- | Verify operation result
-checkServer :: B.ByteString -> B.ByteString -> IO ()
+checkOpResult :: BS.ByteString -> BS.ByteString -> T.Text -> IO ()
-checkServer user pwd = do
+checkOpResult user pwd opid = do
-  resp <- makeZcashCall user pwd "getinfo" []
+  response <-
-  let rpcResp = decode resp :: Maybe (RpcResponse NodeVersion)
+    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 myResp -> do
+    Just res -> do
-      let r = result myResp
+      let r = result res
-      if isNodeValid r
+      mapM_ showResult r
-        then putStrLn $ "Connected to Zcash Full Node (" <> show r <> ") :)"
+  where
-        else do
+    showResult t =
-          putStrLn "Deprecated Zcash Full Node version found. Exiting"
+      case opsuccess t of
-          exitFailure
+        "success" ->
-      where isNodeValid (NodeVersion i) = i >= 5000000
+          putStrLn $ "  Success! Tx ID: " ++ maybe "" T.unpack (optxid t)
+        "executing" -> do
+          putStr "."
+          hFlush stdout
+          threadDelay 1000000 >> checkOpResult user pwd opid
+        _ -> putStrLn $ "  Failed :( " ++ maybe "" T.unpack (opmessage t)
+
+-- | Make a Zcash RPC call
+makeZcashCall ::
+     BS.ByteString
+  -> BS.ByteString
+  -> T.Text
+  -> [Data.Aeson.Value]
+  -> IO LBS.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 " ++ show response
+        Just x -> fail (result x)
+    401 -> fail "Incorrect full node credentials"
+    200 -> return body
+    _ -> fail "Unknown error"
 
 -- | Read ZIP-321 URI
 sendWithUri ::
-     B.ByteString -> B.ByteString -> ZcashAddress -> String -> Bool -> IO ()
+     BS.ByteString -> BS.ByteString -> ZcashAddress -> String -> Bool -> IO ()
 sendWithUri user pwd fromAddy uri repTo = do
   let uriRegex = mkRegex "^zcash:(\\w+)\\?amount=(.*)\\&memo=(.*)$"
   if matchTest uriRegex uri
@@ -631,3 +316,15 @@ sendWithUri user pwd fromAddy uri repTo = do
                         T.concat [decodedMemo, "\nReply-To:\n", addy fromAddy]
                    else Just decodedMemo)
     else putStrLn "URI is not compliant with ZIP-321"
+
+-- | Display an address
+displayZcashAddress ::
+     BS.ByteString -> BS.ByteString -> (Int, ZcashAddress) -> IO ()
+displayZcashAddress user pwd (idx, zaddy) = do
+  zats <- getBalance user pwd zaddy
+  putStr $ show idx ++ ": "
+  putStr $ show zaddy
+  when (source zaddy == ImportedWatchOnly) (putStr "[VK]")
+  putStr " Balance: "
+  mapM_ (putStr . displayZec) zats
+  putStrLn ""

stack.yaml

@@ -17,7 +17,7 @@
 #
 # resolver: ./custom-snapshot.yaml
 # resolver: https://example.com/snapshots/2018-01-01.yaml
-resolver: lts-21.6
+resolver: lts-21.22
 
 # User packages to be built.
 # Various formats can be used as shown in the example below.
@@ -44,7 +44,7 @@ packages:
 # extra-deps: []
 extra-deps:
   - git: https://git.vergara.tech/Vergara_Tech/zcash-haskell.git
-    commit: fef3d3af35a09db718cddb8fc9166b2d2691a744
+    commit: 0858b805d066d0ce91dcc05594d929e63a99484e
   - git: https://git.vergara.tech/Vergara_Tech/haskell-foreign-rust.git
     commit: 787c2e813eb3a5d16c375d4b37dfefbd2adcdf05
   - git: https://github.com/reach-sh/haskell-hexstring.git

stack.yaml.lock

@@ -5,15 +5,15 @@
 
 packages:
 - completed:
-    commit: fef3d3af35a09db718cddb8fc9166b2d2691a744
+    commit: 0858b805d066d0ce91dcc05594d929e63a99484e
     git: https://git.vergara.tech/Vergara_Tech/zcash-haskell.git
     name: zcash-haskell
     pantry-tree:
-      sha256: ec7782cf2646da17548d59af0ea98dcbaac1b6c2176258c696a7f508db6dbc21
+      sha256: 1f36dc81c65790bb090acc7b5337a149fe82dfeeea278c89033245cd85c462fc
-      size: 1126
+      size: 1430
-    version: 0.1.0
+    version: 0.4.1
   original:
-    commit: fef3d3af35a09db718cddb8fc9166b2d2691a744
+    commit: 0858b805d066d0ce91dcc05594d929e63a99484e
     git: https://git.vergara.tech/Vergara_Tech/zcash-haskell.git
 - completed:
     commit: 787c2e813eb3a5d16c375d4b37dfefbd2adcdf05
@@ -56,22 +56,22 @@ packages:
   original:
     hackage: vector-0.13.0.0@sha256:fa5cac81a17a5af388716792e8b99c24b3b66770086756d0d8b23f8272a0244c,9112
 - completed:
-    hackage: generically-0.1.1@sha256:aa00d9a77b7fb90c08f935699758ed9de55975021b1e979c6a4a4b5b49a940a9,1133
+    hackage: generically-0.1.1@sha256:378ec049bc2853b8011df116647fbd34bb9f00edce9840e4957f98abc097597c,1169
     pantry-tree:
-      sha256: ec19e6d2aecfbe7a59e789526b9d7ab5c8ba853f017248d0203ee69a9769adb7
+      sha256: 9f30503d1fe709f3849c5dd8b9751697a8db4d66105d7ba9c3b98bf4e36bb232
       size: 233
   original:
     hackage: generically-0.1.1
 - completed:
-    hackage: vector-algorithms-0.9.0.1@sha256:f3e5c6695529a94edf762117cafd91c989cb642ad3f8ca4014dbb13c8f6c2a20,3826
+    hackage: vector-algorithms-0.9.0.1@sha256:222b01a4c0b9e13d73d04fba7c65930df16d1647acc07d84c47ef0356fa33dba,3880
     pantry-tree:
-      sha256: aef389e57ae6020e5da719bee40aaf6cccf1c4d1e7743a85d30c9d8c25d170a0
+      sha256: f2442ae23235b332dcd8b593bb20bfae02890ec891330c060ac4a410a5f1d64d
       size: 1510
   original:
     hackage: vector-algorithms-0.9.0.1
 snapshots:
 - completed:
-    sha256: 2e7d4a730d8eb5373b2d383fac84efcf7c81e3b7a5fce71b4c2e19a1768f25a6
+    sha256: afd5ba64ab602cabc2d3942d3d7e7dd6311bc626dcb415b901eaf576cb62f0ea
-    size: 640239
+    size: 640060
-    url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/21/6.yaml
+    url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/21/22.yaml
-  original: lts-21.6
+  original: lts-21.22

zenith.cabal

@@ -1,11 +1,11 @@
 cabal-version: 1.12
 
--- This file has been generated from package.yaml by hpack version 0.35.1.
+-- This file has been generated from package.yaml by hpack version 0.36.0.
 --
 -- see: https://github.com/sol/hpack
 
 name:           zenith
-version:        0.4.0
+version:        0.4.1
 synopsis:       Haskell CLI for Zcash Full Node
 description:    Please see the README on repo at <https://git.vergara.tech/Vergara_Tech/zenith#readme>
 author:         Rene Vergara
@@ -25,7 +25,10 @@ source-repository head
 
 library
   exposed-modules:
-      Zenith
+      Zenith.DB
+      Zenith.Types
+      Zenith.Utils
+      Zenith.Zcashd
   other-modules:
       Paths_zenith
   hs-source-dirs: