Add Zenith Scanner module

Add zebra_openapi.yaml file to the zenith folder.

Co-authored-by: Rene Vergara <rene@vergara.network>
Reviewed-on: #70
Co-authored-by: Rene V. Vergara <rvergara59@protonmail.com>
Co-committed-by: Rene V. Vergara <rvergara59@protonmail.com>

.gitignore

@@ -1,2 +1,3 @@
 .stack-work/
-*~
+*~
+dist-newstyle/

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

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

@@ -77,6 +77,35 @@ share
     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

src/Zenith/Scanner.hs

@@ -2,9 +2,11 @@
 
 module Zenith.Scanner where
 
-import Control.Exception (throwIO)
+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(..)
@@ -13,6 +15,8 @@ import ZcashHaskell.Types
   )
 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 ::
@@ -22,26 +26,37 @@ scanZebra ::
   -> T.Text -- ^ Path to database file
   -> IO ()
 scanZebra b host port dbFilePath = do
-  bc <- checkBlockChain host port
+  _ <- initRawStore dbFilePath
+  bc <-
+    try $ checkBlockChain host port :: IO
+      (Either IOError ZebraGetBlockChainInfo)
   case bc of
-    Nothing -> throwIO $ userError "Failed to determine blockchain status"
-    Just bStatus -> do
+    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)]
-          print bList
+          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 ::
-     Int -- ^ The block number to process
-  -> T.Text -- ^ Host name for `zebrad`
+     T.Text -- ^ Host name for `zebrad`
   -> Int -- ^ Port for `zebrad`
+  -> Int -- ^ The block number to process
   -> IO [HexString]
-processBlock b host port = do
+processBlock host port b = do
   r <-
-    result . getResponseBody <$>
-    makeZebraCall host port "getblock" [fromIntegral b, 1]
+    makeZebraCall
+      host
+      port
+      "getblock"
+      [Data.Aeson.String $ T.pack $ show b, jsonNumber 1]
   case r of
-    Nothing -> throwIO $ userError "Unable to get block data from Zebra"
-    Just b' -> return $ bl_txs b'
+    Left e -> throwIO $ userError e
+    Right blk -> return $ bl_txs blk

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

@@ -43,6 +43,8 @@ library
     , base64-bytestring
     , brick
     , bytestring
+    , ghc
+    , hexstring
     , http-client
     , http-conduit
     , http-types
@@ -54,7 +56,6 @@ library
     , persistent-sqlite
     , persistent-template
     , process
-    , hexstring
     , regex-base
     , regex-compat
     , regex-posix
@@ -87,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