app/ZenScan.hs

@@ -0,0 +1,15 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module ZenScan where
+
+import Data.Configurator
+import Zenith.Scanner (scanZebra)
+
+main :: IO ()
+main = do
+  config <- load ["zenith.cfg"]
+  dbFilePath <- require config "dbFilePath"
+  {-dataStorePath <- require config "dataStorePath"-}
+  zebraPort <- require config "zebraPort"
+  zebraHost <- require config "zebraHost"
+  scanZebra 2764500 zebraHost zebraPort dbFilePath

src/Zenith/CLI.hs

@@ -1,5 +1,7 @@
 {-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ScopedTypeVariables #-}
 
 module Zenith.CLI where
 
@@ -45,7 +47,7 @@ import Brick.Widgets.Core
   )
 import qualified Brick.Widgets.Dialog as D
 import qualified Brick.Widgets.List as L
-import Control.Exception (throw, throwIO, try)
+import Control.Exception (catch, throw, throwIO, try)
 import Control.Monad (void)
 import Control.Monad.IO.Class (liftIO)
 import Data.Maybe
@@ -59,6 +61,8 @@ import Lens.Micro.Mtl
 import Lens.Micro.TH
 import Text.Wrap (FillScope(..), FillStrategy(..), WrapSettings(..), wrapText)
 import ZcashHaskell.Keys (generateWalletSeedPhrase, getWalletSeed)
+import ZcashHaskell.Orchard (isValidUnifiedAddress)
+import ZcashHaskell.Transparent (encodeTransparent)
 import ZcashHaskell.Types
 import Zenith.Core
 import Zenith.DB
@@ -270,8 +274,23 @@ drawUI s = [splashDialog s, helpDialog s, displayDialog s, inputDialog s, ui s]
                    Nothing
                    60)
                 (padAll 1 $
-                 txtWrapWith (WrapSettings False True NoFill FillAfterFirst) $
-                 getUA $ walletAddressUAddress $ entityVal a)
+                 B.borderWithLabel
+                   (str "Unified")
+                   (txtWrapWith (WrapSettings False True NoFill FillAfterFirst) $
+                    getUA $ walletAddressUAddress $ entityVal a) <=>
+                 B.borderWithLabel
+                   (str "Legacy Shielded")
+                   (txtWrapWith
+                      (WrapSettings False True NoFill FillAfterFirst)
+                      "Pending") <=>
+                 B.borderWithLabel
+                   (str "Transparent")
+                   (txtWrapWith (WrapSettings False True NoFill FillAfterFirst) $
+                    maybe "Pending" (encodeTransparent (st ^. network)) $
+                    t_rec =<<
+                    (isValidUnifiedAddress .
+                     E.encodeUtf8 . getUA . walletAddressUAddress)
+                      (entityVal a)))
             Nothing -> emptyWidget
         PhraseDisplay ->
           case L.listSelectedElement $ st ^. wallets of
@@ -494,13 +513,15 @@ theApp =
 
 runZenithCLI :: T.Text -> Int -> T.Text -> IO ()
 runZenithCLI host port dbFilePath = do
-  w <- checkZebra host port
-  case (w :: Maybe ZebraGetInfo) of
-    Just zebra -> do
-      bc <- checkBlockChain host port
-      case (bc :: Maybe ZebraGetBlockChainInfo) of
-        Nothing -> throwIO $ userError "Unable to determine blockchain status"
-        Just chainInfo -> do
+  w <- try $ checkZebra host port :: IO (Either IOError ZebraGetInfo)
+  case w of
+    Right zebra -> do
+      bc <-
+        try $ checkBlockChain host port :: IO
+          (Either IOError ZebraGetBlockChainInfo)
+      case bc of
+        Left e1 -> throwIO e1
+        Right chainInfo -> do
           initDb dbFilePath
           walList <- getWallets dbFilePath $ zgb_net chainInfo
           accList <-
@@ -531,10 +552,10 @@ runZenithCLI host port dbFilePath = do
               (zgb_blocks chainInfo)
               dbFilePath
               MsgDisplay
-    Nothing -> do
+    Left e -> do
       print $
         "No Zebra node available on port " <>
-        show port <> ". Check your configuration"
+        show port <> ". Check your configuration."
 
 refreshWallet :: State -> IO State
 refreshWallet s = do

src/Zenith/Core.hs

@@ -1,6 +1,6 @@
 {-# LANGUAGE OverloadedStrings #-}
 
--- Core wallet functionality for Zenith
+-- | Core wallet functionality for Zenith
 module Zenith.Core where
 
 import Control.Exception (throwIO)
@@ -39,28 +39,23 @@ import Zenith.Types
 checkZebra ::
      T.Text -- ^ Host where `zebrad` is available
   -> Int -- ^ Port where `zebrad` is available 
-  -> IO (Maybe ZebraGetInfo)
+  -> IO ZebraGetInfo
 checkZebra nodeHost nodePort = do
   res <- makeZebraCall nodeHost nodePort "getinfo" []
-  let body = responseBody (res :: Response (RpcResponse ZebraGetInfo))
-  return $ result body
+  case res of
+    Left e -> throwIO $ userError e
+    Right bi -> return bi
 
 -- | Checks the status of the Zcash blockchain
 checkBlockChain ::
      T.Text -- ^ Host where `zebrad` is available
   -> Int -- ^ Port where `zebrad` is available
-  -> IO (Maybe ZebraGetBlockChainInfo)
+  -> IO ZebraGetBlockChainInfo
 checkBlockChain nodeHost nodePort = do
-  let f = makeZebraCall nodeHost nodePort
-  result . responseBody <$> f "getblockchaininfo" []
-
--- | Generic RPC call function
-connectZebra ::
-     FromJSON a => T.Text -> Int -> T.Text -> [Data.Aeson.Value] -> IO (Maybe a)
-connectZebra nodeHost nodePort m params = do
-  res <- makeZebraCall nodeHost nodePort m params
-  let body = responseBody res
-  return $ result body
+  r <- makeZebraCall nodeHost nodePort "getblockchaininfo" []
+  case r of
+    Left e -> throwIO $ userError e
+    Right bci -> return bci
 
 -- * Spending Keys
 -- | Create an Orchard Spending Key for the given wallet and account index

src/Zenith/DB.hs

@@ -19,13 +19,15 @@ module Zenith.DB where
 
 import Control.Monad.IO.Class (liftIO)
 import qualified Data.ByteString as BS
+import Data.HexString
 import qualified Data.Text as T
 import Database.Persist
 import Database.Persist.Sqlite
 import Database.Persist.TH
 import ZcashHaskell.Types (Scope(..), ZcashNet)
 import Zenith.Types
-  ( OrchardSpendingKeyDB(..)
+  ( HexStringDB(..)
+  , OrchardSpendingKeyDB(..)
   , PhraseDB(..)
   , SaplingSpendingKeyDB(..)
   , ScopeDB(..)
@@ -65,6 +67,47 @@ share
     deriving Show Eq
     |]
 
+share
+  [mkPersist sqlSettings, mkMigrate "rawStorage"]
+  [persistLowerCase|
+  WalletTransaction
+    block Int
+    txId HexStringDB
+    conf Int
+    time Int
+    hex HexStringDB
+    deriving Show Eq
+  OrchAction
+    tx WalletTransactionId
+    nf HexStringDB
+    rk HexStringDB
+    cmx HexStringDB
+    ephKey HexStringDB
+    encCipher HexStringDB
+    outCipher HexStringDB
+    cv HexStringDB
+    auth HexStringDB
+    deriving Show Eq
+  ShieldOutput
+    tx WalletTransactionId
+    cv HexStringDB
+    cmu HexStringDB
+    ephKey HexStringDB
+    encCipher HexStringDB
+    outCipher HexStringDB
+    proof HexStringDB
+    deriving Show Eq
+  ShieldSpend
+    tx WalletTransactionId
+    cv HexStringDB
+    anchor HexStringDB
+    nullifier HexStringDB
+    rk HexStringDB
+    proof HexStringDB
+    authSig HexStringDB
+    deriving Show Eq
+    |]
+
 -- * Database functions
 -- | Initializes the database
 initDb ::
@@ -73,6 +116,12 @@ initDb ::
 initDb dbName = do
   runSqlite dbName $ do runMigration migrateAll
 
+-- | Initializes the raw data storage
+initRawStore ::
+     T.Text -- ^ the database path
+  -> IO ()
+initRawStore dbFilePath = runSqlite dbFilePath $ runMigration rawStorage
+
 -- | Get existing wallets from database
 getWallets :: T.Text -> ZcashNet -> IO [Entity ZcashWallet]
 getWallets dbFp n =

src/Zenith/Scanner.hs

@@ -0,0 +1,62 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module Zenith.Scanner where
+
+import Control.Exception (throwIO, try)
+import Data.Aeson
+import Data.HexString
+import qualified Data.Text as T
+import GHC.Utils.Monad (concatMapM)
+import Network.HTTP.Simple (getResponseBody)
+import ZcashHaskell.Types
+  ( BlockResponse(..)
+  , RpcResponse(..)
+  , ZebraGetBlockChainInfo(..)
+  )
+import ZcashHaskell.Utils (makeZebraCall)
+import Zenith.Core (checkBlockChain)
+import Zenith.DB (initRawStore)
+import Zenith.Utils (jsonNumber)
+
+-- | Function to scan the Zcash blockchain through the Zebra node and populate the Zenith database
+scanZebra ::
+     Int -- ^ Starting block
+  -> T.Text -- ^ Host
+  -> Int -- ^ Port
+  -> T.Text -- ^ Path to database file
+  -> IO ()
+scanZebra b host port dbFilePath = do
+  _ <- initRawStore dbFilePath
+  bc <-
+    try $ checkBlockChain host port :: IO
+      (Either IOError ZebraGetBlockChainInfo)
+  case bc of
+    Left e -> print e
+    Right bStatus -> do
+      if b > zgb_blocks bStatus || b < 1
+        then throwIO $ userError "Invalid starting block for scan"
+        else do
+          let bList = [b .. (zgb_blocks bStatus)]
+          txList <-
+            try $ concatMapM (processBlock host port) bList :: IO
+              (Either IOError [HexString])
+          case txList of
+            Left e1 -> print e1
+            Right txList' -> print txList'
+
+-- | Function to process a raw block and extract the transaction information
+processBlock ::
+     T.Text -- ^ Host name for `zebrad`
+  -> Int -- ^ Port for `zebrad`
+  -> Int -- ^ The block number to process
+  -> IO [HexString]
+processBlock host port b = do
+  r <-
+    makeZebraCall
+      host
+      port
+      "getblock"
+      [Data.Aeson.String $ T.pack $ show b, jsonNumber 1]
+  case r of
+    Left e -> throwIO $ userError e
+    Right blk -> return $ bl_txs blk

src/Zenith/Types.hs

@@ -14,6 +14,7 @@ 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.HexString
 import Data.Maybe (fromMaybe)
 import qualified Data.Text as T
 import qualified Data.Text.Encoding as E
@@ -29,6 +30,13 @@ import ZcashHaskell.Types
   , ZcashNet(..)
   )
 
+-- * Database field type wrappers
+newtype HexStringDB = HexStringDB
+  { getHex :: HexString
+  } deriving newtype (Eq, Show, Read)
+
+derivePersistField "HexStringDB"
+
 newtype ZcashNetDB = ZcashNetDB
   { getNet :: ZcashNet
   } deriving newtype (Eq, Show, Read)
@@ -71,15 +79,8 @@ newtype TransparentSpendingKeyDB = TransparentSpendingKeyDB
 
 derivePersistField "TransparentSpendingKeyDB"
 
--- | 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
+-- * RPC
+-- | Type for modelling the different address sources for `zcashd` 5.0.0
 data AddressSource
   = LegacyRandom
   | Imported
@@ -128,24 +129,6 @@ instance Show ZcashAddress where
     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)

src/Zenith/Utils.hs

@@ -2,11 +2,10 @@
 
 module Zenith.Utils where
 
-import qualified Data.ByteString as BS
-import qualified Data.ByteString.Char8 as C
-import Data.Char
+import Data.Aeson
 import Data.Functor (void)
 import Data.Maybe
+import Data.Scientific (Scientific(..), scientific)
 import qualified Data.Text as T
 import qualified Data.Text.Encoding as E
 import System.Process (createProcess_, shell)
@@ -20,6 +19,10 @@ import Zenith.Types
   , ZcashPool(..)
   )
 
+-- | Helper function to convert numbers into JSON
+jsonNumber :: Int -> Value
+jsonNumber i = Number $ scientific (fromIntegral i) 0
+
 -- | Helper function to display small amounts of ZEC
 displayZec :: Integer -> String
 displayZec s

src/Zenith/Zcashd.hs

@@ -24,13 +24,12 @@ import System.IO
 import Text.Read (readMaybe)
 import Text.Regex
 import Text.Regex.Base
+import ZcashHaskell.Types (RpcCall(..), RpcResponse(..))
 import Zenith.Types
   ( AddressGroup
   , AddressSource(..)
   , NodeVersion(..)
   , OpResult(..)
-  , RpcCall(..)
-  , RpcResponse(..)
   , UABalance(..)
   , ZcashAddress(..)
   , ZcashPool(..)
@@ -49,8 +48,11 @@ listAddresses user pwd = do
     Nothing -> fail "Couldn't parse node response"
     Just res -> do
       let addys = result res
-      let addList = concatMap getAddresses addys
-      return addList
+      case addys of
+        Nothing -> fail "Empty response"
+        Just addys' -> do
+          let addList = concatMap getAddresses addys'
+          return addList
 
 -- | Get address balance
 getBalance :: BS.ByteString -> BS.ByteString -> ZcashAddress -> IO [Integer]
@@ -71,7 +73,9 @@ getBalance user pwd zadd = do
       case rpcResp of
         Nothing -> fail "Couldn't parse node response"
         Just res -> do
-          return [result res]
+          case result res of
+            Nothing -> return []
+            Just r -> return [r]
     Just acct -> do
       response <-
         makeZcashCall
@@ -83,7 +87,9 @@ getBalance user pwd zadd = do
       case rpcResp of
         Nothing -> fail "Couldn't parse node response"
         Just res -> do
-          return $ readUABalance (result res)
+          case result res of
+            Nothing -> return [0, 0, 0]
+            Just r -> return $ readUABalance r
           where readUABalance ua =
                   [uatransparent ua, uasapling ua, uaorchard ua]
 
@@ -96,7 +102,9 @@ listTxs user pwd zaddy = do
   case rpcResp of
     Nothing -> fail "listTxs: Couldn't parse node response"
     Just res -> do
-      return $ result res
+      case result res of
+        Nothing -> fail "listTxs: Empty response"
+        Just res' -> return res'
 
 -- | Send Tx
 sendTx ::
@@ -150,7 +158,7 @@ sendTx user pwd fromAddy toAddy amount memo = do
             Nothing -> fail "Couldn't parse node response"
             Just res -> do
               putStr "  Sending."
-              checkOpResult user pwd (result res)
+              checkOpResult user pwd (fromMaybe "" $ result res)
         else putStrLn "Error: Source address is view-only."
     else putStrLn "Error: Insufficient balance in source address."
 
@@ -163,11 +171,14 @@ checkServer user pwd = do
     Nothing -> fail "Couldn't parse node response"
     Just myResp -> do
       let r = result myResp
-      if isNodeValid r
-        then putStrLn $ "Connected to Zcash Full Node (" <> show r <> ") :)"
-        else do
-          putStrLn "Deprecated Zcash Full Node version found. Exiting"
-          exitFailure
+      case r of
+        Nothing -> fail "Empty node response"
+        Just r' -> do
+          if isNodeValid r'
+            then putStrLn $ "Connected to Zcash Full Node (" <> show r <> ") :)"
+            else do
+              putStrLn "Deprecated Zcash Full Node version found. Exiting"
+              exitFailure
       where isNodeValid (NodeVersion i) = i >= 5000000
 
 -- | Check for accounts
@@ -235,7 +246,9 @@ checkOpResult user pwd opid = do
     Nothing -> fail "Couldn't parse node response"
     Just res -> do
       let r = result res
-      mapM_ showResult r
+      case r of
+        Nothing -> fail "Empty node response"
+        Just r' -> mapM_ showResult r'
   where
     showResult t =
       case opsuccess t of
@@ -269,7 +282,7 @@ makeZcashCall username password m p = do
       let rpcResp = decode body :: Maybe (RpcResponse String)
       case rpcResp of
         Nothing -> fail $ "Unknown server error " ++ show response
-        Just x -> fail (result x)
+        Just x -> fail (fromMaybe "" $ result x)
     401 -> fail "Incorrect full node credentials"
     200 -> return body
     _ -> fail "Unknown error"

zcash-haskell

@@ -1 +1 @@
-Subproject commit f228eff367c776469455adc4d443102cc53e5538
+Subproject commit f0995441628381fee14ae1c655c3c4f8d96162e5

zenith.cabal

@@ -32,6 +32,7 @@ library
     Zenith.Types
     Zenith.Utils
     Zenith.Zcashd
+    Zenith.Scanner
   hs-source-dirs:
     src
   build-depends:
@@ -42,6 +43,8 @@ library
     , base64-bytestring
     , brick
     , bytestring
+    , ghc
+    , hexstring
     , http-client
     , http-conduit
     , http-types
@@ -53,7 +56,6 @@ library
     , persistent-sqlite
     , persistent-template
     , process
-    , hexstring
     , regex-base
     , regex-compat
     , regex-posix
@@ -86,6 +88,18 @@ executable zenith
   pkgconfig-depends: rustzcash_wrapper
   default-language: Haskell2010
 
+executable zenscan
+  ghc-options: -main-is ZenScan -threaded -rtsopts -with-rtsopts=-N
+  main-is: ZenScan.hs
+  hs-source-dirs:
+    app
+  build-depends:
+      base >=4.12 && <5
+    , configurator
+    , zenith
+  pkgconfig-depends: rustzcash_wrapper
+  default-language: Haskell2010
+
 test-suite zenith-tests
   type: exitcode-stdio-1.0
   ghc-options: -threaded -rtsopts -with-rtsopts=-N

zenith.cfg

@@ -3,3 +3,4 @@ nodePwd = "superSecret"
 dbFilePath = "zenith.db"
 zebraHost = "127.0.0.1"
 zebraPort = 18232
+dataStorePath = "datastore.db"