cabal.project

@@ -7,7 +7,7 @@ with-compiler: ghc-9.4.8
 source-repository-package
   type: git
   location: https://git.vergara.tech/Vergara_Tech/haskell-hexstring.git
-  tag: 39d8da7b11a80269454c2f134a5c834e0f3cb9a7
+  tag: fd1ddce73c0ad18a2a4509a299c6e93f8c6c383d
 
 source-repository-package
   type: git

src/Zenith/CLI.hs

@@ -3,6 +3,15 @@
 
 module Zenith.CLI where
 
+import Control.Exception (throw)
+import Control.Monad (void)
+import Control.Monad.IO.Class (liftIO)
+import qualified Data.Text as T
+import qualified Graphics.Vty as V
+import Lens.Micro ((&), (.~), (^.), set)
+import Lens.Micro.Mtl
+import Lens.Micro.TH
+
 import qualified Brick.AttrMap as A
 import qualified Brick.Focus as F
 import Brick.Forms
@@ -28,16 +37,13 @@ import Brick.Widgets.Core
   , (<=>)
   , emptyWidget
   , fill
-  , hBox
   , hLimit
   , joinBorders
   , padAll
   , padBottom
+  , padRight
   , str
-  , strWrap
   , txt
-  , txtWrap
-  , txtWrapWith
   , vBox
   , vLimit
   , withAttr
@@ -45,25 +51,12 @@ 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.Monad (void)
-import Control.Monad.IO.Class (liftIO)
-import Data.Maybe
-import qualified Data.Text as T
-import qualified Data.Text.Encoding as E
 import qualified Data.Vector as Vec
 import Database.Persist
-import qualified Graphics.Vty as V
+import ZcashHaskell.Keys (generateWalletSeedPhrase)
-import Lens.Micro ((&), (.~), (^.), set)
-import Lens.Micro.Mtl
-import Lens.Micro.TH
-import Text.Wrap (FillScope(..), FillStrategy(..), WrapSettings(..), wrapText)
-import ZcashHaskell.Keys (generateWalletSeedPhrase, getWalletSeed)
 import ZcashHaskell.Types
 import Zenith.Core
 import Zenith.DB
-import Zenith.Types (PhraseDB(..), UnifiedAddressDB(..), ZcashNetDB(..))
-import Zenith.Utils (showAddress)
 
 data Name
   = WList
@@ -83,22 +76,13 @@ makeLenses ''DialogInput
 data DialogType
   = WName
   | AName
-  | AdName
-  | WSelect
-  | ASelect
   | Blank
 
-data DisplayType
-  = AddrDisplay
-  | MsgDisplay
-  | PhraseDisplay
-  | BlankDisplay
-
 data State = State
-  { _network :: !ZcashNet
+  { _network :: !String
   , _wallets :: !(L.List Name (Entity ZcashWallet))
   , _accounts :: !(L.List Name (Entity ZcashAccount))
-  , _addresses :: !(L.List Name (Entity WalletAddress))
+  , _addresses :: !(L.List Name String)
   , _transactions :: !(L.List Name String)
   , _msg :: !String
   , _helpBox :: !Bool
@@ -108,13 +92,12 @@ data State = State
   , _focusRing :: !(F.FocusRing Name)
   , _startBlock :: !Int
   , _dbPath :: !T.Text
-  , _displayBox :: !DisplayType
   }
 
 makeLenses ''State
 
 drawUI :: State -> [Widget Name]
-drawUI s = [splashDialog s, helpDialog s, displayDialog s, inputDialog s, ui s]
+drawUI s = [splashDialog s, helpDialog s, inputDialog s, ui s]
   where
     ui :: State -> Widget Name
     ui st =
@@ -123,13 +106,13 @@ drawUI s = [splashDialog s, helpDialog s, displayDialog s, inputDialog s, ui s]
       B.borderWithLabel
         (str
            ("Zenith - " <>
-            show (st ^. network) <>
+            st ^. network <>
             " - " <>
             T.unpack
               (maybe
                  "(None)"
                  (\(_, w) -> zcashWalletName $ entityVal w)
-                 (L.listSelectedElement (st ^. wallets)))))
+                 (L.listSelectedElement (st ^. wallets))))) $
       (C.hCenter
          (str
             ("Account: " ++
@@ -138,16 +121,10 @@ drawUI s = [splashDialog s, helpDialog s, displayDialog s, inputDialog s, ui s]
                   "(None)"
                   (\(_, a) -> zcashAccountName $ entityVal a)
                   (L.listSelectedElement (st ^. accounts))))) <=>
-         listAddressBox "Addresses" (st ^. addresses) <+>
+       listBox "Addresses" (st ^. addresses) <+>
        B.vBorder <+> C.center (listBox "Transactions" (st ^. transactions))) <=>
-      C.hCenter
+      msgBox (st ^. msg)
-        (hBox
+    listBox :: String -> L.List Name String -> Widget Name
-           [ capCommand "W" "allets"
-           , capCommand "A" "ccounts"
-           , capCommand "V" "iew address"
-           , capCommand "Q" "uit"
-           ])
-    listBox :: Show e => String -> L.List Name e -> Widget Name
     listBox titleLabel l =
       C.vCenter $
       vBox
@@ -157,30 +134,10 @@ drawUI s = [splashDialog s, helpDialog s, displayDialog s, inputDialog s, ui s]
         , str " "
         , C.hCenter $ str "Select "
         ]
-    selectListBox ::
+    msgBox :: String -> Widget Name
-         Show e
+    msgBox m =
-      => String
-      -> L.List Name e
-      -> (Bool -> e -> Widget Name)
-      -> Widget Name
-    selectListBox titleLabel l drawF =
       vBox
-        [ C.hCenter
+        [B.hBorderWithLabel (str "Messages"), hLimit 70 $ padRight Max $ str m]
-            (B.borderWithLabel (str titleLabel) $
-             hLimit 25 $ vLimit 15 $ L.renderList drawF True l)
-        , str " "
-        ]
-    listAddressBox ::
-         String -> L.List Name (Entity WalletAddress) -> Widget Name
-    listAddressBox titleLabel a =
-      C.vCenter $
-      vBox
-        [ C.hCenter
-            (B.borderWithLabel (str titleLabel) $
-             hLimit 40 $ vLimit 15 $ L.renderList listDrawAddress True a)
-        , str " "
-        , C.hCenter $ str "Use arrows to select"
-        ]
     helpDialog :: State -> Widget Name
     helpDialog st =
       if st ^. helpBox
@@ -190,17 +147,11 @@ drawUI s = [splashDialog s, helpDialog s, displayDialog s, inputDialog s, ui s]
                 vBox ([str "Actions", B.hBorder] <> actionList))
         else emptyWidget
       where
-        keyList = map (C.hCenter . str) ["?", "Esc", "w", "a", "v", "q"]
+        keyList = map (C.hCenter . str) ["?", "Esc", "c", "q"]
         actionList =
           map
             (hLimit 40 . str)
-            [ "Open help"
+            ["Open help", "Close dialog", "Create Wallet", "Quit"]
-            , "Close dialog"
-            , "Switch wallets"
-            , "Switch accounts"
-            , "View address"
-            , "Quit"
-            ]
     inputDialog :: State -> Widget Name
     inputDialog st =
       case st ^. dialogBox of
@@ -212,33 +163,6 @@ drawUI s = [splashDialog s, helpDialog s, displayDialog s, inputDialog s, ui s]
           D.renderDialog
             (D.dialog (Just (str "Create Account")) Nothing 50)
             (renderForm $ st ^. inputForm)
-        AdName ->
-          D.renderDialog
-            (D.dialog (Just (str "Create Address")) Nothing 50)
-            (renderForm $ st ^. inputForm)
-        WSelect ->
-          D.renderDialog
-            (D.dialog (Just (str "Select Wallet")) Nothing 50)
-            (selectListBox "Wallets" (st ^. wallets) listDrawWallet <=>
-             C.hCenter
-               (hBox
-                  [ capCommand "↑↓ " "move"
-                  , capCommand "↲ " "select"
-                  , capCommand "N" "ew"
-                  , capCommand "S" "how phrase"
-                  , xCommand
-                  ]))
-        ASelect ->
-          D.renderDialog
-            (D.dialog (Just (str "Select Account")) Nothing 50)
-            (selectListBox "Accounts" (st ^. accounts) listDrawAccount <=>
-             C.hCenter
-               (hBox
-                  [ capCommand "↑↓ " "move"
-                  , capCommand "↲ " "select"
-                  , capCommand "N" "ew"
-                  , xCommand
-                  ]))
         Blank -> emptyWidget
     splashDialog :: State -> Widget Name
     splashDialog st =
@@ -250,46 +174,9 @@ drawUI s = [splashDialog s, helpDialog s, displayDialog s, inputDialog s, ui s]
                   titleAttr
                   (str
                      " _____          _ _   _     \n|__  /___ _ __ (_) |_| |__\n  / // _ \\ '_ \\| | __| '_ \\\n / /|  __/ | | | | |_| | | |\n/____\\___|_| |_|_|\\__|_| |_|") <=>
-                C.hCenter (withAttr titleAttr (str "Zcash Wallet v0.4.4.0")) <=>
+                C.hCenter (withAttr titleAttr (str "Zcash Wallet v0.4.3.0")) <=>
                 C.hCenter (withAttr blinkAttr $ str "Press any key..."))
         else emptyWidget
-    capCommand :: String -> String -> Widget Name
-    capCommand k comm = hBox [withAttr titleAttr (str k), str comm, str " | "]
-    xCommand :: Widget Name
-    xCommand = hBox [str "E", withAttr titleAttr (str "x"), str "it"]
-    displayDialog :: State -> Widget Name
-    displayDialog st =
-      case st ^. displayBox of
-        AddrDisplay ->
-          case L.listSelectedElement $ st ^. addresses of
-            Just (_, a) ->
-              withBorderStyle unicodeBold $
-              D.renderDialog
-                (D.dialog
-                   (Just $ txt ("Address: " <> walletAddressName (entityVal a)))
-                   Nothing
-                   60)
-                (padAll 1 $
-                 txtWrapWith (WrapSettings False True NoFill FillAfterFirst) $
-                 getUA $ walletAddressUAddress $ entityVal a)
-            Nothing -> emptyWidget
-        PhraseDisplay ->
-          case L.listSelectedElement $ st ^. wallets of
-            Just (_, w) ->
-              withBorderStyle unicodeBold $
-              D.renderDialog
-                (D.dialog (Just $ txt "Seed Phrase") Nothing 50)
-                (padAll 1 $
-                 txtWrap $
-                 E.decodeUtf8Lenient $
-                 getBytes $ getPhrase $ zcashWalletSeedPhrase $ entityVal w)
-            Nothing -> emptyWidget
-        MsgDisplay ->
-          withBorderStyle unicodeBold $
-          D.renderDialog
-            (D.dialog (Just $ txt "Message") Nothing 50)
-            (padAll 1 $ strWrap $ st ^. msg)
-        BlankDisplay -> emptyWidget
 
 mkInputForm :: DialogInput -> Form DialogInput e Name
 mkInputForm =
@@ -307,33 +194,6 @@ listDrawElement sel a =
           else str s
    in C.hCenter $ selStr $ show a
 
-listDrawWallet :: Bool -> Entity ZcashWallet -> Widget Name
-listDrawWallet sel w =
-  let selStr s =
-        if sel
-          then withAttr customAttr (txt $ "<" <> s <> ">")
-          else txt s
-   in C.hCenter $ selStr $ zcashWalletName (entityVal w)
-
-listDrawAccount :: Bool -> Entity ZcashAccount -> Widget Name
-listDrawAccount sel w =
-  let selStr s =
-        if sel
-          then withAttr customAttr (txt $ "<" <> s <> ">")
-          else txt s
-   in C.hCenter $ selStr $ zcashAccountName (entityVal w)
-
-listDrawAddress :: Bool -> Entity WalletAddress -> Widget Name
-listDrawAddress sel w =
-  let selStr s =
-        if sel
-          then withAttr customAttr (txt $ "<" <> s <> ">")
-          else txt s
-   in C.hCenter $
-      selStr $
-      walletAddressName (entityVal w) <>
-      ": " <> showAddress (walletAddressUAddress (entityVal w))
-
 customAttr :: A.AttrName
 customAttr = L.listSelectedAttr <> A.attrName "custom"
 
@@ -356,11 +216,6 @@ appEvent (BT.VtyEvent e) = do
                  BT.modify $ set helpBox False
                _ev -> return ()
            else do
-             case s ^. displayBox of
-               AddrDisplay -> BT.modify $ set displayBox BlankDisplay
-               MsgDisplay -> BT.modify $ set displayBox BlankDisplay
-               PhraseDisplay -> BT.modify $ set displayBox BlankDisplay
-               BlankDisplay -> do
              case s ^. dialogBox of
                WName -> do
                  case e of
@@ -368,100 +223,44 @@ appEvent (BT.VtyEvent e) = do
                    V.EvKey V.KEnter [] -> do
                      fs <- BT.zoom inputForm $ BT.gets formState
                      nw <- liftIO $ addNewWallet (fs ^. dialogInput) s
-                         ns <- liftIO $ refreshWallet nw
+                     BT.put nw
-                         BT.put ns
                      aL <- use accounts
-                         BT.modify $ set displayBox MsgDisplay
                      BT.modify $
                        set dialogBox $
                        if not (null $ L.listElements aL)
                          then Blank
                          else AName
-                       ev ->
+                   ev -> BT.zoom inputForm $ handleFormEvent (BT.VtyEvent ev)
-                         BT.zoom inputForm $ handleFormEvent (BT.VtyEvent ev)
                AName -> do
                  case e of
                    V.EvKey V.KEsc [] -> BT.modify $ set dialogBox Blank
                    V.EvKey V.KEnter [] -> do
                      fs <- BT.zoom inputForm $ BT.gets formState
-                         ns <-
+                     na <- liftIO $ addNewAccount (fs ^. dialogInput) s
-                           liftIO $
+                     BT.put na
-                           refreshAccount =<<
-                           addNewAddress "Change" Internal =<<
-                           addNewAccount (fs ^. dialogInput) s
-                         BT.put ns
-                         addrL <- use addresses
-                         BT.modify $ set displayBox MsgDisplay
-                         BT.modify $
-                           set dialogBox $
-                           if not (null $ L.listElements addrL)
-                             then Blank
-                             else AdName
-                       ev ->
-                         BT.zoom inputForm $ handleFormEvent (BT.VtyEvent ev)
-                   AdName -> do
-                     case e of
-                       V.EvKey V.KEsc [] -> BT.modify $ set dialogBox Blank
-                       V.EvKey V.KEnter [] -> do
-                         fs <- BT.zoom inputForm $ BT.gets formState
-                         nAddr <-
-                           liftIO $ addNewAddress (fs ^. dialogInput) External s
-                         BT.put nAddr
-                         BT.modify $ set displayBox MsgDisplay
                      BT.modify $ set dialogBox Blank
-                       ev ->
+                   ev -> BT.zoom inputForm $ handleFormEvent (BT.VtyEvent ev)
-                         BT.zoom inputForm $ handleFormEvent (BT.VtyEvent ev)
-                   WSelect -> do
-                     case e of
-                       V.EvKey (V.KChar 'x') [] ->
-                         BT.modify $ set dialogBox Blank
-                       V.EvKey V.KEnter [] -> do
-                         ns <- liftIO $ refreshWallet s
-                         BT.put ns
-                         BT.modify $ set dialogBox Blank
-                       V.EvKey (V.KChar 'n') [] -> do
-                         BT.modify $
-                           set inputForm $
-                           updateFormState (DialogInput "New Wallet") $
-                           s ^. inputForm
-                         BT.modify $ set dialogBox WName
-                       V.EvKey (V.KChar 's') [] ->
-                         BT.modify $ set displayBox PhraseDisplay
-                       ev -> BT.zoom wallets $ L.handleListEvent ev
-                   ASelect -> do
-                     case e of
-                       V.EvKey (V.KChar 'x') [] ->
-                         BT.modify $ set dialogBox Blank
-                       V.EvKey V.KEnter [] -> do
-                         ns <- liftIO $ refreshAccount s
-                         BT.put ns
-                         BT.modify $ set dialogBox Blank
-                       V.EvKey (V.KChar 'n') [] -> do
-                         BT.modify $
-                           set inputForm $
-                           updateFormState (DialogInput "New Account") $
-                           s ^. inputForm
-                         BT.modify $ set dialogBox AName
-                       ev -> BT.zoom accounts $ L.handleListEvent ev
                Blank -> do
                  case e of
                    V.EvKey (V.KChar '\t') [] -> focusRing %= F.focusNext
                    V.EvKey (V.KChar 'q') [] -> M.halt
                    V.EvKey (V.KChar '?') [] -> BT.modify $ set helpBox True
-                       V.EvKey (V.KChar 'n') [] ->
+                   V.EvKey (V.KChar 'w') [] -> do
-                         BT.modify $ set dialogBox AdName
+                     BT.modify $
-                       V.EvKey (V.KChar 'v') [] ->
+                       set inputForm $
-                         BT.modify $ set displayBox AddrDisplay
+                       updateFormState (DialogInput "New Wallet") $
-                       V.EvKey (V.KChar 'w') [] ->
+                       s ^. inputForm
-                         BT.modify $ set dialogBox WSelect
+                     BT.modify $ set dialogBox WName
-                       V.EvKey (V.KChar 'a') [] ->
+                   V.EvKey (V.KChar 'a') [] -> do
-                         BT.modify $ set dialogBox ASelect
+                     BT.modify $
+                       set inputForm $
+                       updateFormState (DialogInput "New Account") $
+                       s ^. inputForm
+                     BT.modify $ set dialogBox AName
                    ev ->
                      case r of
-                           Just AList ->
+                       Just AList -> BT.zoom addresses $ L.handleListEvent ev
-                             BT.zoom addresses $ L.handleListEvent ev
+                       Just TList -> BT.zoom transactions $ L.handleListEvent ev
-                           Just TList ->
-                             BT.zoom transactions $ L.handleListEvent ev
                        _anyName -> return ()
   where
     printMsg :: String -> BT.EventM Name State ()
@@ -499,7 +298,7 @@ runZenithCLI host port dbFilePath = do
     Just zebra -> do
       bc <- checkBlockChain host port
       case (bc :: Maybe ZebraGetBlockChainInfo) of
-        Nothing -> throwIO $ userError "Unable to determine blockchain status"
+        Nothing -> print "Unable to determine blockchain status"
         Just chainInfo -> do
           initDb dbFilePath
           walList <- getWallets dbFilePath $ zgb_net chainInfo
@@ -507,17 +306,13 @@ runZenithCLI host port dbFilePath = do
             if not (null walList)
               then getAccounts dbFilePath $ entityKey $ head walList
               else return []
-          addrList <-
-            if not (null accList)
-              then getAddresses dbFilePath $ entityKey $ head accList
-              else return []
           void $
             M.defaultMain theApp $
             State
-              (zgb_net chainInfo)
+              ((show . zgb_net) chainInfo)
               (L.list WList (Vec.fromList walList) 1)
               (L.list AcList (Vec.fromList accList) 0)
-              (L.list AList (Vec.fromList addrList) 1)
+              (L.list AList (Vec.fromList ["utest...hn8zg", "utest...qfex8"]) 1)
               (L.list TList (Vec.fromList ["tx1", "tx2", "tx3"]) 1)
               ("Start up Ok! Connected to Zebra " ++
                (T.unpack . zgi_build) zebra ++ " on port " ++ show port ++ ".")
@@ -530,42 +325,17 @@ runZenithCLI host port dbFilePath = do
               (F.focusRing [AList, TList])
               (zgb_blocks chainInfo)
               dbFilePath
-              MsgDisplay
     Nothing -> do
       print $
         "No Zebra node available on port " <>
         show port <> ". Check your configuration"
 
-refreshWallet :: State -> IO State
-refreshWallet s = do
-  selWallet <-
-    do case L.listSelectedElement $ s ^. wallets of
-         Nothing -> do
-           let fWall =
-                 L.listSelectedElement $ L.listMoveToBeginning $ s ^. wallets
-           case fWall of
-             Nothing -> throw $ userError "Failed to select wallet"
-             Just (_j, w1) -> return w1
-         Just (_k, w) -> return w
-  aL <- getAccounts (s ^. dbPath) $ entityKey selWallet
-  addrL <-
-    if not (null aL)
-      then getAddresses (s ^. dbPath) $ entityKey $ head aL
-      else return []
-  let aL' = L.listReplace (Vec.fromList aL) (Just 0) (s ^. accounts)
-  let addrL' = L.listReplace (Vec.fromList addrL) (Just 0) (s ^. addresses)
-  return $
-    (s & accounts .~ aL') & addresses .~ addrL' & msg .~ "Switched to wallet: " ++
-    T.unpack (zcashWalletName $ entityVal selWallet)
-
 addNewWallet :: T.Text -> State -> IO State
 addNewWallet n s = do
   sP <- generateWalletSeedPhrase
   let bH = s ^. startBlock
-  let netName = s ^. network
+  let netName = read $ s ^. network
-  r <-
+  r <- saveWallet (s ^. dbPath) $ ZcashWallet n netName sP bH
-    saveWallet (s ^. dbPath) $
-    ZcashWallet n (ZcashNetDB netName) (PhraseDB sP) bH
   case r of
     Nothing -> do
       return $ s & msg .~ ("Wallet already exists: " ++ T.unpack n)
@@ -588,16 +358,17 @@ addNewAccount n s = do
              Just (_j, w1) -> return w1
          Just (_k, w) -> return w
   aL' <- getMaxAccount (s ^. dbPath) (entityKey selWallet)
-  zA <-
+  r <-
-    try $ createZcashAccount n (aL' + 1) selWallet :: IO
+    saveAccount (s ^. dbPath) $
-      (Either IOError ZcashAccount)
+    ZcashAccount
-  case zA of
+      (aL' + 1)
-    Left e -> return $ s & msg .~ ("Error: " ++ show e)
+      (entityKey selWallet)
-    Right zA' -> do
+      n
-      r <- saveAccount (s ^. dbPath) zA'
+      "fakeOrchKey"
+      "fakeSapKey"
+      "fakeTKey"
   case r of
-        Nothing ->
+    Nothing -> return $ s & msg .~ ("Account already exists: " ++ T.unpack n)
-          return $ s & msg .~ ("Account already exists: " ++ T.unpack n)
     Just x -> do
       aL <- getAccounts (s ^. dbPath) (entityKey selWallet)
       let nL =
@@ -605,53 +376,3 @@ addNewAccount n s = do
             L.listReplace (Vec.fromList aL) (Just 0) (s ^. accounts)
       return $
         (s & accounts .~ nL) & msg .~ "Created new account: " ++ T.unpack n
-
-refreshAccount :: State -> IO State
-refreshAccount s = do
-  selAccount <-
-    do case L.listSelectedElement $ s ^. accounts of
-         Nothing -> do
-           let fAcc =
-                 L.listSelectedElement $ L.listMoveToBeginning $ s ^. accounts
-           case fAcc of
-             Nothing -> throw $ userError "Failed to select account"
-             Just (_j, w1) -> return w1
-         Just (_k, w) -> return w
-  aL <- getAddresses (s ^. dbPath) $ entityKey selAccount
-  let aL' = L.listReplace (Vec.fromList aL) (Just 0) (s ^. addresses)
-  return $
-    s & addresses .~ aL' & msg .~ "Switched to account: " ++
-    T.unpack (zcashAccountName $ entityVal selAccount)
-
-addNewAddress :: T.Text -> Scope -> State -> IO State
-addNewAddress n scope s = do
-  selAccount <-
-    do case L.listSelectedElement $ s ^. accounts of
-         Nothing -> do
-           let fAcc =
-                 L.listSelectedElement $ L.listMoveToBeginning $ s ^. accounts
-           case fAcc of
-             Nothing -> throw $ userError "Failed to select account"
-             Just (_j, a1) -> return a1
-         Just (_k, a) -> return a
-  maxAddr <- getMaxAddress (s ^. dbPath) (entityKey selAccount) scope
-  uA <-
-    try $ createWalletAddress n (maxAddr + 1) (s ^. network) scope selAccount :: IO
-      (Either IOError WalletAddress)
-  case uA of
-    Left e -> return $ s & msg .~ ("Error: " ++ show e)
-    Right uA' -> do
-      nAddr <- saveAddress (s ^. dbPath) uA'
-      case nAddr of
-        Nothing ->
-          return $ s & msg .~ ("Address already exists: " ++ T.unpack n)
-        Just x -> do
-          addrL <- getAddresses (s ^. dbPath) (entityKey selAccount)
-          let nL =
-                L.listMoveToElement x $
-                L.listReplace (Vec.fromList addrL) (Just 0) (s ^. addresses)
-          return $
-            (s & addresses .~ nL) & msg .~ "Created new address: " ++
-            T.unpack n ++
-            "(" ++
-            T.unpack (showAddress $ walletAddressUAddress $ entityVal x) ++ ")"

src/Zenith/Core.hs

@@ -3,36 +3,63 @@
 -- Core wallet functionality for Zenith
 module Zenith.Core where
 
-import Control.Exception (throwIO)
 import Data.Aeson
-import Data.HexString (hexString)
 import qualified Data.Text as T
 import Database.Persist
+import Database.Persist.Sqlite
 import Network.HTTP.Client
-import ZcashHaskell.Keys
-import ZcashHaskell.Orchard
-  ( encodeUnifiedAddress
-  , genOrchardReceiver
-  , genOrchardSpendingKey
-  )
-import ZcashHaskell.Sapling
-  ( genSaplingInternalAddress
-  , genSaplingPaymentAddress
-  , genSaplingSpendingKey
-  )
-import ZcashHaskell.Transparent (genTransparentPrvKey, genTransparentReceiver)
 import ZcashHaskell.Types
 import ZcashHaskell.Utils
 import Zenith.DB
-import Zenith.Types
+
-  ( OrchardSpendingKeyDB(..)
+-- * Database functions
-  , PhraseDB(..)
+-- | Initializes the database
-  , SaplingSpendingKeyDB(..)
+initDb ::
-  , ScopeDB(..)
+     T.Text -- ^ The database path to check
-  , TransparentSpendingKeyDB(..)
+  -> IO ()
-  , UnifiedAddressDB(..)
+initDb dbName = do
-  , ZcashNetDB(..)
+  runSqlite dbName $ do runMigration migrateAll
-  )
+
+-- | Save a new wallet to the database
+saveWallet ::
+     T.Text -- ^ The database path to use
+  -> ZcashWallet -- ^ The wallet to add to the database
+  -> IO (Maybe (Entity ZcashWallet))
+saveWallet dbFp w = runSqlite dbFp $ insertUniqueEntity w
+
+-- | Returns a list of accounts associated with the given wallet
+getAccounts ::
+     T.Text -- ^ The database path
+  -> ZcashWalletId -- ^ The wallet ID to check
+  -> IO [Entity ZcashAccount]
+getAccounts dbFp w = runSqlite dbFp $ selectList [ZcashAccountWalletId ==. w] []
+
+-- | Returns the largest account index for the given wallet
+getMaxAccount ::
+     T.Text -- ^ The database path
+  -> ZcashWalletId -- ^ The wallet ID to check
+  -> IO Int
+getMaxAccount dbFp w = do
+  a <-
+    runSqlite dbFp $
+    selectFirst [ZcashAccountWalletId ==. w] [Desc ZcashAccountIndex]
+  case a of
+    Nothing -> return $ -1
+    Just x -> return $ zcashAccountIndex $ entityVal x
+
+-- | Save a new account to the database
+saveAccount ::
+     T.Text -- ^ The database path
+  -> ZcashAccount -- ^ The account to add to the database
+  -> IO (Maybe (Entity ZcashAccount))
+saveAccount dbFp a = runSqlite dbFp $ insertUniqueEntity a
+
+-- | Returns a list of addresses associated with the given account
+getAddresses ::
+     T.Text -- ^ The database path
+  -> ZcashAccountId -- ^ The account ID to check
+  -> IO [Entity WalletAddress]
+getAddresses dbFp a = runSqlite dbFp $ selectList [WalletAddressAccId ==. a] []
 
 -- * Zebra Node interaction
 -- | Checks the status of the `zebrad` node
@@ -52,7 +79,7 @@ checkBlockChain ::
   -> IO (Maybe ZebraGetBlockChainInfo)
 checkBlockChain nodeHost nodePort = do
   let f = makeZebraCall nodeHost nodePort
-  result . responseBody <$> f "getblockchaininfo" []
+  result <$> (responseBody <$> f "getblockchaininfo" [])
 
 -- | Generic RPC call function
 connectZebra ::
@@ -61,104 +88,3 @@ connectZebra nodeHost nodePort m params = do
   res <- makeZebraCall nodeHost nodePort m params
   let body = responseBody res
   return $ result body
-
--- * Spending Keys
--- | Create an Orchard Spending Key for the given wallet and account index
-createOrchardSpendingKey :: ZcashWallet -> Int -> IO OrchardSpendingKey
-createOrchardSpendingKey zw i = do
-  let s = getWalletSeed $ getPhrase $ zcashWalletSeedPhrase zw
-  case s of
-    Nothing -> throwIO $ userError "Unable to generate seed"
-    Just s' -> do
-      let coinType =
-            case getNet $ zcashWalletNetwork zw of
-              MainNet -> MainNetCoin
-              TestNet -> TestNetCoin
-              RegTestNet -> RegTestNetCoin
-      let r = genOrchardSpendingKey s' coinType i
-      case r of
-        Nothing -> throwIO $ userError "Unable to generate Orchard spending key"
-        Just sk -> return sk
-
--- | Create a Sapling spending key for the given wallet and account index
-createSaplingSpendingKey :: ZcashWallet -> Int -> IO SaplingSpendingKey
-createSaplingSpendingKey zw i = do
-  let s = getWalletSeed $ getPhrase $ zcashWalletSeedPhrase zw
-  case s of
-    Nothing -> throwIO $ userError "Unable to generate seed"
-    Just s' -> do
-      let coinType =
-            case getNet $ zcashWalletNetwork zw of
-              MainNet -> MainNetCoin
-              TestNet -> TestNetCoin
-              RegTestNet -> RegTestNetCoin
-      let r = genSaplingSpendingKey s' coinType i
-      case r of
-        Nothing -> throwIO $ userError "Unable to generate Sapling spending key"
-        Just sk -> return sk
-
-createTransparentSpendingKey :: ZcashWallet -> Int -> IO TransparentSpendingKey
-createTransparentSpendingKey zw i = do
-  let s = getWalletSeed $ getPhrase $ zcashWalletSeedPhrase zw
-  case s of
-    Nothing -> throwIO $ userError "Unable to generate seed"
-    Just s' -> do
-      let coinType =
-            case getNet $ zcashWalletNetwork zw of
-              MainNet -> MainNetCoin
-              TestNet -> TestNetCoin
-              RegTestNet -> RegTestNetCoin
-      genTransparentPrvKey s' coinType i
-
--- * Accounts
--- | Create an account for the given wallet and account index
-createZcashAccount ::
-     T.Text -- ^ The account's name
-  -> Int -- ^ The account's index
-  -> Entity ZcashWallet -- ^ The Zcash wallet that this account will be attached to
-  -> IO ZcashAccount
-createZcashAccount n i zw = do
-  orSk <- createOrchardSpendingKey (entityVal zw) i
-  sapSk <- createSaplingSpendingKey (entityVal zw) i
-  tSk <- createTransparentSpendingKey (entityVal zw) i
-  return $
-    ZcashAccount
-      i
-      (entityKey zw)
-      n
-      (OrchardSpendingKeyDB orSk)
-      (SaplingSpendingKeyDB sapSk)
-      (TransparentSpendingKeyDB tSk)
-
--- * Addresses
--- | Create an external unified address for the given account and index
-createWalletAddress ::
-     T.Text -- ^ The address nickname
-  -> Int -- ^ The address' index
-  -> ZcashNet -- ^ The network for this address
-  -> Scope -- ^ External or Internal
-  -> Entity ZcashAccount -- ^ The Zcash account that the address will be attached to
-  -> IO WalletAddress
-createWalletAddress n i zNet scope za = do
-  let oRec =
-        genOrchardReceiver i scope $
-        getOrchSK $ zcashAccountOrchSpendKey $ entityVal za
-  let sRec =
-        case scope of
-          External ->
-            genSaplingPaymentAddress i $
-            getSapSK $ zcashAccountSapSpendKey $ entityVal za
-          Internal ->
-            genSaplingInternalAddress $
-            getSapSK $ zcashAccountSapSpendKey $ entityVal za
-  tRec <-
-    genTransparentReceiver i scope $
-    getTranSK $ zcashAccountTPrivateKey $ entityVal za
-  return $
-    WalletAddress
-      i
-      (entityKey za)
-      n
-      (UnifiedAddressDB $
-       encodeUnifiedAddress $ UnifiedAddress zNet oRec sRec (Just tRec))
-      (ScopeDB scope)

src/Zenith/DB.hs

@@ -23,24 +23,17 @@ import qualified Data.Text as T
 import Database.Persist
 import Database.Persist.Sqlite
 import Database.Persist.TH
-import ZcashHaskell.Types (Scope(..), ZcashNet)
+import ZcashHaskell.Types (Phrase, ZcashNet)
-import Zenith.Types
+
-  ( OrchardSpendingKeyDB(..)
+derivePersistField "ZcashNet"
-  , PhraseDB(..)
-  , SaplingSpendingKeyDB(..)
-  , ScopeDB(..)
-  , TransparentSpendingKeyDB
-  , UnifiedAddressDB(..)
-  , ZcashNetDB(..)
-  )
 
 share
   [mkPersist sqlSettings, mkMigrate "migrateAll"]
   [persistLowerCase|
   ZcashWallet
     name T.Text
-    network ZcashNetDB
+    network ZcashNet
-    seedPhrase PhraseDB
+    seedPhrase Phrase
     birthdayHeight Int
     UniqueWallet name network
     deriving Show Eq
@@ -48,100 +41,23 @@ share
     index Int
     walletId ZcashWalletId
     name T.Text
-    orchSpendKey OrchardSpendingKeyDB
+    orchSpendKey BS.ByteString
-    sapSpendKey SaplingSpendingKeyDB
+    sapSpendKey BS.ByteString
-    tPrivateKey TransparentSpendingKeyDB
+    tPrivateKey BS.ByteString
     UniqueAccount index walletId
-    UniqueAccName walletId name
     deriving Show Eq
   WalletAddress
-    index Int
     accId ZcashAccountId
-    name T.Text
+    index Int
-    uAddress UnifiedAddressDB
+    orchRec BS.ByteString Maybe
-    scope ScopeDB
+    sapRec BS.ByteString Maybe
-    UniqueAddress index scope accId
+    tRec BS.ByteString Maybe
-    UniqueAddName accId name
+    encoded T.Text
     deriving Show Eq
     |]
 
--- * Database functions
--- | Initializes the database
-initDb ::
-     T.Text -- ^ The database path to check
-  -> IO ()
-initDb dbName = do
-  runSqlite dbName $ do runMigration migrateAll
-
--- | Get existing wallets from database
 getWallets :: T.Text -> ZcashNet -> IO [Entity ZcashWallet]
 getWallets dbFp n =
-  runSqlite dbFp $ selectList [ZcashWalletNetwork ==. ZcashNetDB n] []
+  runSqlite dbFp $ do
-
+    s <- selectList [ZcashWalletNetwork ==. n] []
--- | Save a new wallet to the database
+    liftIO $ return s
-saveWallet ::
-     T.Text -- ^ The database path to use
-  -> ZcashWallet -- ^ The wallet to add to the database
-  -> IO (Maybe (Entity ZcashWallet))
-saveWallet dbFp w = runSqlite dbFp $ insertUniqueEntity w
-
--- | Returns a list of accounts associated with the given wallet
-getAccounts ::
-     T.Text -- ^ The database path
-  -> ZcashWalletId -- ^ The wallet ID to check
-  -> IO [Entity ZcashAccount]
-getAccounts dbFp w = runSqlite dbFp $ selectList [ZcashAccountWalletId ==. w] []
-
--- | Returns the largest account index for the given wallet
-getMaxAccount ::
-     T.Text -- ^ The database path
-  -> ZcashWalletId -- ^ The wallet ID to check
-  -> IO Int
-getMaxAccount dbFp w = do
-  a <-
-    runSqlite dbFp $
-    selectFirst [ZcashAccountWalletId ==. w] [Desc ZcashAccountIndex]
-  case a of
-    Nothing -> return $ -1
-    Just x -> return $ zcashAccountIndex $ entityVal x
-
--- | Save a new account to the database
-saveAccount ::
-     T.Text -- ^ The database path
-  -> ZcashAccount -- ^ The account to add to the database
-  -> IO (Maybe (Entity ZcashAccount))
-saveAccount dbFp a = runSqlite dbFp $ insertUniqueEntity a
-
--- | Returns a list of addresses associated with the given account
-getAddresses ::
-     T.Text -- ^ The database path
-  -> ZcashAccountId -- ^ The account ID to check
-  -> IO [Entity WalletAddress]
-getAddresses dbFp a =
-  runSqlite dbFp $
-  selectList
-    [WalletAddressAccId ==. a, WalletAddressScope ==. ScopeDB External]
-    []
-
--- | Returns the largest address index for the given account
-getMaxAddress ::
-     T.Text -- ^ The database path
-  -> ZcashAccountId -- ^ The account ID to check
-  -> Scope -- ^ The scope of the address
-  -> IO Int
-getMaxAddress dbFp aw s = do
-  a <-
-    runSqlite dbFp $
-    selectFirst
-      [WalletAddressAccId ==. aw, WalletAddressScope ==. ScopeDB s]
-      [Desc WalletAddressIndex]
-  case a of
-    Nothing -> return $ -1
-    Just x -> return $ walletAddressIndex $ entityVal x
-
--- | Save a new address to the database
-saveAddress ::
-     T.Text -- ^ the database path
-  -> WalletAddress -- ^ The wallet to add to the database
-  -> IO (Maybe (Entity WalletAddress))
-saveAddress dbFp w = runSqlite dbFp $ insertUniqueEntity w

src/Zenith/Types.hs

@@ -1,11 +1,7 @@
 {-# LANGUAGE LambdaCase #-}
-{-# LANGUAGE DerivingStrategies #-}
-{-# LANGUAGE GeneralisedNewtypeDeriving #-}
-{-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE DeriveAnyClass #-}
 {-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE StandaloneDeriving #-}
 
 module Zenith.Types where
 
@@ -18,58 +14,7 @@ import Data.Maybe (fromMaybe)
 import qualified Data.Text as T
 import qualified Data.Text.Encoding as E
 import Data.Text.Encoding.Error (lenientDecode)
-import Database.Persist.TH
 import GHC.Generics
-import ZcashHaskell.Types
-  ( OrchardSpendingKey(..)
-  , Phrase(..)
-  , SaplingSpendingKey(..)
-  , Scope(..)
-  , TransparentSpendingKey
-  , ZcashNet(..)
-  )
-
-newtype ZcashNetDB = ZcashNetDB
-  { getNet :: ZcashNet
-  } deriving newtype (Eq, Show, Read)
-
-derivePersistField "ZcashNetDB"
-
-newtype UnifiedAddressDB = UnifiedAddressDB
-  { getUA :: T.Text
-  } deriving newtype (Eq, Show, Read)
-
-derivePersistField "UnifiedAddressDB"
-
-newtype PhraseDB = PhraseDB
-  { getPhrase :: Phrase
-  } deriving newtype (Eq, Show, Read)
-
-derivePersistField "PhraseDB"
-
-newtype ScopeDB = ScopeDB
-  { getScope :: Scope
-  } deriving newtype (Eq, Show, Read)
-
-derivePersistField "ScopeDB"
-
-newtype OrchardSpendingKeyDB = OrchardSpendingKeyDB
-  { getOrchSK :: OrchardSpendingKey
-  } deriving newtype (Eq, Show, Read)
-
-derivePersistField "OrchardSpendingKeyDB"
-
-newtype SaplingSpendingKeyDB = SaplingSpendingKeyDB
-  { getSapSK :: SaplingSpendingKey
-  } deriving newtype (Eq, Show, Read)
-
-derivePersistField "SaplingSpendingKeyDB"
-
-newtype TransparentSpendingKeyDB = TransparentSpendingKeyDB
-  { getTranSK :: TransparentSpendingKey
-  } deriving newtype (Eq, Show, Read)
-
-derivePersistField "TransparentSpendingKeyDB"
 
 -- | A type to model Zcash RPC calls
 data RpcCall = RpcCall

src/Zenith/Utils.hs

@@ -9,13 +9,15 @@ 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 (encodeUnifiedAddress, isValidUnifiedAddress)
+import ZcashHaskell.Orchard (isValidUnifiedAddress)
 import ZcashHaskell.Sapling (isValidShieldedAddress)
 import Zenith.Types
   ( AddressGroup(..)
-  , UnifiedAddressDB(..)
+  , AddressSource(..)
   , ZcashAddress(..)
   , ZcashPool(..)
   )
@@ -28,12 +30,6 @@ displayZec s
   | s < 100000000 = show (fromIntegral s / 100000) ++ " mZEC "
   | otherwise = show (fromIntegral s / 100000000) ++ " ZEC "
 
--- | Helper function to display abbreviated Unified Address
-showAddress :: UnifiedAddressDB -> T.Text
-showAddress u = T.take 20 t <> "..."
-  where
-    t = getUA u
-
 -- | Helper function to extract addresses from AddressGroups
 getAddresses :: AddressGroup -> [ZcashAddress]
 getAddresses ag = agtransparent ag <> agsapling ag <> agunified ag

test/Spec.hs

@@ -5,17 +5,9 @@ import Database.Persist
 import Database.Persist.Sqlite
 import System.Directory
 import Test.Hspec
-import ZcashHaskell.Orchard (isValidUnifiedAddress)
+import ZcashHaskell.Types (ZcashNet(..))
-import ZcashHaskell.Types
+import Zenith.Core (getAccounts)
-  ( OrchardSpendingKey(..)
-  , Phrase(..)
-  , SaplingSpendingKey(..)
-  , Scope(..)
-  , ZcashNet(..)
-  )
-import Zenith.Core
 import Zenith.DB
-import Zenith.Types
 
 main :: IO ()
 main = do
@@ -32,12 +24,10 @@ main = do
             runSqlite "test.db" $ do
               insert $
                 ZcashWallet
-                  "Main Wallet"
+                  "one two three four five six seven eight nine ten eleven twelve"
-                  (ZcashNetDB MainNet)
-                  (PhraseDB $
-                   Phrase
-                     "one two three four five six seven eight nine ten eleven twelve")
                   2000000
+                  "Main Wallet"
+                  MainNet
           fromSqlKey s `shouldBe` 1
         it "read wallet record" $ do
           s <-
@@ -58,43 +48,21 @@ main = do
               delete recId
               get recId
           "None" `shouldBe` maybe "None" zcashWalletName s
-      describe "Wallet function tests:" $ do
+      describe "Account table" $ do
-        it "Save Wallet:" $ do
+        it "insert account" $ do
-          zw <-
-            saveWallet "test.db" $
-            ZcashWallet
-              "Testing"
-              (ZcashNetDB MainNet)
-              (PhraseDB $
-               Phrase
-                 "cloth swing left trap random tornado have great onion element until make shy dad success art tuition canvas thunder apple decade elegant struggle invest")
-              2200000
-          zw `shouldNotBe` Nothing
-        it "Save Account:" $ do
           s <-
             runSqlite "test.db" $ do
-              selectList [ZcashWalletName ==. "Testing"] []
+              insert $
-          za <-
+                ZcashWallet
-            saveAccount "test.db" =<<
+                  "one two three four five six seven eight nine ten eleven twelve"
-            createZcashAccount "TestAccount" 0 (head s)
+                  2000000
-          za `shouldNotBe` Nothing
+                  "Main Wallet"
-        it "Save address:" $ do
+                  MainNet
-          acList <-
+          t <-
-            runSqlite "test.db" $
+            runSqlite "test.db" $ do
-            selectList [ZcashAccountName ==. "TestAccount"] []
+              insert $ ZcashAccount s 0 "132465798" "987654321" "739182462"
-          zAdd <-
+          fromSqlKey t `shouldBe` 1
-            saveAddress "test.db" =<<
+        it "read accounts for wallet" $ do
-            createWalletAddress "Personal123" 0 MainNet External (head acList)
+          wList <- getWallets "test.db" MainNet
-          addList <-
+          acc <- getAccounts "test.db" $ entityKey (head wList)
-            runSqlite "test.db" $
+          length acc `shouldBe` 1
-            selectList
-              [ WalletAddressName ==. "Personal123"
-              , WalletAddressScope ==. ScopeDB External
-              ]
-              []
-          getUA (walletAddressUAddress (entityVal $ head addList)) `shouldBe`
-            "u1trd8cvc6265ywwj4mmvuznsye5ghe2dhhn3zy8kcuyg4vx3svskw9r2dedp5hu6m740vylkqc34t4w9eqkl9fyu5uyzn3af72jg235440ke6tu5cf994eq85n97x69x9824hqejmwz3d8qqthtesrd6gerjupdymldhl9xccejjwfj0dhh9mt4rw4kytp325twlutsxd20rfqhzxu3m"
-        it "Address components are correct" $ do
-          let ua =
-                "utest1mvlny48qd4x94w8vz5u2lrxx0enuquajt72yekgq24p6pjaky3czk6m7x358h7g900ex6gzvdehaekl96qnakjzw8yaasp8y0u3j5jnlfd33trduznh6k3fcn5ek9qc857fgz8ehm37etx94sj58nrkc0k5hurxnuxpcpms3j8uy2t8kt2vy6vetvsfxxdhtjq0yqulqprvh7mf2u3x"
-          isValidUnifiedAddress ua `shouldNotBe` Nothing

zcash-haskell

@@ -1 +1 @@
-Subproject commit f228eff367c776469455adc4d443102cc53e5538
+Subproject commit a52d2231f1a4f85a6504bfb9228a1475a0773088

zenith.cabal

@@ -1,10 +1,10 @@
 cabal-version:    3.0
 name:             zenith
-version:          0.4.4.1
+version:          0.4.3.0
 license:          MIT
 license-file:     LICENSE
 author:           Rene Vergara
-maintainer:       pitmutt@vergara.tech
+maintainer:       pitmut@vergara.tech
 copyright:        (c) 2022-2024 Vergara Technologies LLC
 build-type:       Custom
 category:         Blockchain
@@ -13,6 +13,8 @@ extra-doc-files:
   CHANGELOG.md
   zenith.cfg
 
+common warnings
+  ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N -Wunused-imports
 
 custom-setup
   setup-depends:
@@ -24,6 +26,7 @@ custom-setup
     , regex-compat
 
 library
+  import: warnings
   ghc-options: -Wall -Wunused-imports
   exposed-modules:
     Zenith.CLI
@@ -53,7 +56,6 @@ library
     , persistent-sqlite
     , persistent-template
     , process
-    , hexstring
     , regex-base
     , regex-compat
     , regex-posix
@@ -61,13 +63,12 @@ library
     , text
     , vector
     , vty
-    , word-wrap
     , zcash-haskell
   --pkgconfig-depends: rustzcash_wrapper
   default-language: Haskell2010
 
 executable zenith
-  ghc-options: -threaded -rtsopts -with-rtsopts=-N
+  import: warnings
   main-is: Main.hs
   hs-source-dirs:
     app
@@ -87,8 +88,8 @@ executable zenith
   default-language: Haskell2010
 
 test-suite zenith-tests
+  import: warnings
   type: exitcode-stdio-1.0
-  ghc-options: -threaded -rtsopts -with-rtsopts=-N
   main-is: Spec.hs
   hs-source-dirs:
     test