Add error handling for account creation

src/Zenith/CLI.hs

@@ -3,9 +3,10 @@
 
 module Zenith.CLI where
 
-import Control.Exception (throw)
+import Control.Exception (throw, try)
 import Control.Monad (void)
 import Control.Monad.IO.Class (liftIO)
+import Data.Maybe
 import qualified Data.Text as T
 import qualified Graphics.Vty as V
 import Lens.Micro ((&), (.~), (^.), set)
@@ -53,7 +54,8 @@ import qualified Brick.Widgets.Dialog as D
 import qualified Brick.Widgets.List as L
 import qualified Data.Vector as Vec
 import Database.Persist
-import ZcashHaskell.Keys (generateWalletSeedPhrase)
+import ZcashHaskell.Keys (generateWalletSeedPhrase, getWalletSeed)
+import ZcashHaskell.Orchard (genOrchardSpendingKey)
 import ZcashHaskell.Types
 import Zenith.Core
 import Zenith.DB
@@ -81,7 +83,7 @@ data DialogType
   | Blank
 
 data State = State
-  { _network :: !String
+  { _network :: !ZcashNet
   , _wallets :: !(L.List Name (Entity ZcashWallet))
   , _accounts :: !(L.List Name (Entity ZcashAccount))
   , _addresses :: !(L.List Name (Entity WalletAddress))
@@ -108,7 +110,7 @@ drawUI s = [splashDialog s, helpDialog s, inputDialog s, ui s]
       B.borderWithLabel
         (str
            ("Zenith - " <>
-            st ^. network <>
+            show (st ^. network) <>
             " - " <>
             T.unpack
               (maybe
@@ -371,7 +373,7 @@ runZenithCLI host port dbFilePath = do
           void $
             M.defaultMain theApp $
             State
-              ((show . zgb_net) chainInfo)
+              (zgb_net chainInfo)
               (L.list WList (Vec.fromList walList) 1)
               (L.list AcList (Vec.fromList accList) 0)
               (L.list AList (Vec.fromList addrList) 1)
@@ -396,7 +398,7 @@ addNewWallet :: T.Text -> State -> IO State
 addNewWallet n s = do
   sP <- generateWalletSeedPhrase
   let bH = s ^. startBlock
-  let netName = read $ s ^. network
+  let netName = s ^. network
   r <- saveWallet (s ^. dbPath) $ ZcashWallet n netName sP bH
   case r of
     Nothing -> do
@@ -420,24 +422,23 @@ addNewAccount n s = do
              Just (_j, w1) -> return w1
          Just (_k, w) -> return w
   aL' <- getMaxAccount (s ^. dbPath) (entityKey selWallet)
-  r <-
+  zA <-
-    saveAccount (s ^. dbPath) $
+    try $ createZcashAccount n (aL' + 1) selWallet :: IO
-    ZcashAccount
+      (Either IOError ZcashAccount)
-      (aL' + 1)
+  case zA of
-      (entityKey selWallet)
+    Left e -> return $ s & msg .~ ("Error: " ++ show e)
-      n
+    Right zA' -> do
-      "fakeOrchKey"
+      r <- saveAccount (s ^. dbPath) zA'
-      "fakeSapKey"
+      case r of
-      "fakeTKey"
+        Nothing ->
-  case r of
+          return $ s & msg .~ ("Account already exists: " ++ T.unpack n)
-    Nothing -> return $ s & msg .~ ("Account already exists: " ++ T.unpack n)
+        Just x -> do
-    Just x -> do
+          aL <- getAccounts (s ^. dbPath) (entityKey selWallet)
-      aL <- getAccounts (s ^. dbPath) (entityKey selWallet)
+          let nL =
-      let nL =
+                L.listMoveToElement x $
-            L.listMoveToElement x $
+                L.listReplace (Vec.fromList aL) (Just 0) (s ^. accounts)
-            L.listReplace (Vec.fromList aL) (Just 0) (s ^. accounts)
+          return $
-      return $
+            (s & accounts .~ nL) & msg .~ "Created new account: " ++ T.unpack n
-        (s & accounts .~ nL) & msg .~ "Created new account: " ++ T.unpack n
 
 addNewAddress :: T.Text -> State -> IO State
 addNewAddress n s = do

src/Zenith/Core.hs

@@ -3,11 +3,17 @@
 -- Core wallet functionality for Zenith
 module Zenith.Core where
 
+import Control.Exception (throwIO)
 import Data.Aeson
+import qualified Data.ByteString as BS
 import qualified Data.Text as T
+import Database.Persist
 import Network.HTTP.Client
+import ZcashHaskell.Keys
+import ZcashHaskell.Orchard
 import ZcashHaskell.Types
 import ZcashHaskell.Utils
+import Zenith.DB
 
 -- * Zebra Node interaction
 -- | Checks the status of the `zebrad` node
@@ -36,3 +42,32 @@ 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 BS.ByteString
+createOrchardSpendingKey zw i = do
+  let s = getWalletSeed $ zcashWalletSeedPhrase zw
+  case s of
+    Nothing -> throwIO $ userError "Unable to generate seed"
+    Just s' -> do
+      let coinType =
+            case 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
+
+-- * 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
+  return $ ZcashAccount i (entityKey zw) n orSk "fakeSapKey" "fakeTkey"

zcash-haskell

@@ -1 +1 @@
-Subproject commit c1507f36e0146f0be76ee2a71cb2b3b4ebd9f3cf
+Subproject commit e371fcdb724686bfb51157911c5d4c0fda433c53