diff --git a/cabal.project b/cabal.project index cf9dbbc..217198a 100644 --- a/cabal.project +++ b/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: fd1ddce73c0ad18a2a4509a299c6e93f8c6c383d + tag: 39d8da7b11a80269454c2f134a5c834e0f3cb9a7 source-repository-package type: git diff --git a/src/Zenith/CLI.hs b/src/Zenith/CLI.hs index 447383e..8855d4e 100644 --- a/src/Zenith/CLI.hs +++ b/src/Zenith/CLI.hs @@ -3,15 +3,6 @@ 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 @@ -37,13 +28,16 @@ import Brick.Widgets.Core , (<=>) , emptyWidget , fill + , hBox , hLimit , joinBorders , padAll , padBottom - , padRight , str + , strWrap , txt + , txtWrap + , txtWrapWith , vBox , vLimit , withAttr @@ -51,12 +45,25 @@ 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 ZcashHaskell.Keys (generateWalletSeedPhrase) +import qualified Graphics.Vty as V +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 @@ -76,13 +83,22 @@ makeLenses ''DialogInput data DialogType = WName | AName + | AdName + | WSelect + | ASelect | Blank +data DisplayType + = AddrDisplay + | MsgDisplay + | PhraseDisplay + | BlankDisplay + data State = State - { _network :: !String + { _network :: !ZcashNet , _wallets :: !(L.List Name (Entity ZcashWallet)) , _accounts :: !(L.List Name (Entity ZcashAccount)) - , _addresses :: !(L.List Name String) + , _addresses :: !(L.List Name (Entity WalletAddress)) , _transactions :: !(L.List Name String) , _msg :: !String , _helpBox :: !Bool @@ -92,12 +108,13 @@ 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, inputDialog s, ui s] +drawUI s = [splashDialog s, helpDialog s, displayDialog s, inputDialog s, ui s] where ui :: State -> Widget Name ui st = @@ -106,25 +123,31 @@ drawUI s = [splashDialog s, helpDialog s, inputDialog s, ui s] B.borderWithLabel (str ("Zenith - " <> - st ^. network <> + show (st ^. network) <> " - " <> T.unpack (maybe "(None)" (\(_, w) -> zcashWalletName $ entityVal w) - (L.listSelectedElement (st ^. wallets))))) $ - (C.hCenter - (str - ("Account: " ++ - T.unpack - (maybe - "(None)" - (\(_, a) -> zcashAccountName $ entityVal a) - (L.listSelectedElement (st ^. accounts))))) <=> - listBox "Addresses" (st ^. addresses) <+> - B.vBorder <+> C.center (listBox "Transactions" (st ^. transactions))) <=> - msgBox (st ^. msg) - listBox :: String -> L.List Name String -> Widget Name + (L.listSelectedElement (st ^. wallets))))) + (C.hCenter + (str + ("Account: " ++ + T.unpack + (maybe + "(None)" + (\(_, a) -> zcashAccountName $ entityVal a) + (L.listSelectedElement (st ^. accounts))))) <=> + listAddressBox "Addresses" (st ^. addresses) <+> + B.vBorder <+> C.center (listBox "Transactions" (st ^. transactions))) <=> + C.hCenter + (hBox + [ 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 @@ -134,10 +157,30 @@ drawUI s = [splashDialog s, helpDialog s, inputDialog s, ui s] , str " " , C.hCenter $ str "Select " ] - msgBox :: String -> Widget Name - msgBox m = + selectListBox :: + Show e + => String + -> L.List Name e + -> (Bool -> e -> Widget Name) + -> Widget Name + selectListBox titleLabel l drawF = vBox - [B.hBorderWithLabel (str "Messages"), hLimit 70 $ padRight Max $ str m] + [ C.hCenter + (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 @@ -147,11 +190,17 @@ drawUI s = [splashDialog s, helpDialog s, inputDialog s, ui s] vBox ([str "Actions", B.hBorder] <> actionList)) else emptyWidget where - keyList = map (C.hCenter . str) ["?", "Esc", "c", "q"] + keyList = map (C.hCenter . str) ["?", "Esc", "w", "a", "v", "q"] actionList = map (hLimit 40 . str) - ["Open help", "Close dialog", "Create Wallet", "Quit"] + [ "Open help" + , "Close dialog" + , "Switch wallets" + , "Switch accounts" + , "View address" + , "Quit" + ] inputDialog :: State -> Widget Name inputDialog st = case st ^. dialogBox of @@ -163,6 +212,33 @@ drawUI s = [splashDialog s, helpDialog 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 = @@ -174,9 +250,46 @@ drawUI s = [splashDialog s, helpDialog s, inputDialog s, ui s] titleAttr (str " _____ _ _ _ \n|__ /___ _ __ (_) |_| |__\n / // _ \\ '_ \\| | __| '_ \\\n / /| __/ | | | | |_| | | |\n/____\\___|_| |_|_|\\__|_| |_|") <=> - C.hCenter (withAttr titleAttr (str "Zcash Wallet v0.4.3.0")) <=> + C.hCenter (withAttr titleAttr (str "Zcash Wallet v0.4.4.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 = @@ -194,6 +307,33 @@ 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" @@ -216,52 +356,113 @@ appEvent (BT.VtyEvent e) = do BT.modify $ set helpBox False _ev -> return () else do - case s ^. dialogBox of - WName -> 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 - nw <- liftIO $ addNewWallet (fs ^. dialogInput) s - BT.put nw - aL <- use accounts - BT.modify $ - set dialogBox $ - if not (null $ L.listElements aL) - then Blank - else AName - 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 - na <- liftIO $ addNewAccount (fs ^. dialogInput) s - BT.put na - BT.modify $ set dialogBox Blank - ev -> BT.zoom inputForm $ handleFormEvent (BT.VtyEvent 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 'w') [] -> do - BT.modify $ - set inputForm $ - updateFormState (DialogInput "New Wallet") $ - s ^. inputForm - BT.modify $ set dialogBox WName - V.EvKey (V.KChar 'a') [] -> do - BT.modify $ - set inputForm $ - updateFormState (DialogInput "New Account") $ - s ^. inputForm - BT.modify $ set dialogBox AName - ev -> - case r of - Just AList -> BT.zoom addresses $ L.handleListEvent ev - Just TList -> BT.zoom transactions $ L.handleListEvent ev - _anyName -> return () + 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 + V.EvKey V.KEsc [] -> BT.modify $ set dialogBox Blank + V.EvKey V.KEnter [] -> do + fs <- BT.zoom inputForm $ BT.gets formState + nw <- liftIO $ addNewWallet (fs ^. dialogInput) s + ns <- liftIO $ refreshWallet 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 -> + 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 <- + liftIO $ + 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 -> + 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') [] -> + BT.modify $ set dialogBox AdName + V.EvKey (V.KChar 'v') [] -> + BT.modify $ set displayBox AddrDisplay + V.EvKey (V.KChar 'w') [] -> + BT.modify $ set dialogBox WSelect + V.EvKey (V.KChar 'a') [] -> + BT.modify $ set dialogBox ASelect + ev -> + case r of + Just AList -> + BT.zoom addresses $ L.handleListEvent ev + Just TList -> + BT.zoom transactions $ L.handleListEvent ev + _anyName -> return () where printMsg :: String -> BT.EventM Name State () printMsg s = BT.modify $ updateMsg s @@ -298,7 +499,7 @@ runZenithCLI host port dbFilePath = do Just zebra -> do bc <- checkBlockChain host port case (bc :: Maybe ZebraGetBlockChainInfo) of - Nothing -> print "Unable to determine blockchain status" + Nothing -> throwIO $ userError "Unable to determine blockchain status" Just chainInfo -> do initDb dbFilePath walList <- getWallets dbFilePath $ zgb_net chainInfo @@ -306,13 +507,17 @@ 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 - ((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 ["utest...hn8zg", "utest...qfex8"]) 1) + (L.list AList (Vec.fromList addrList) 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 ++ ".") @@ -325,17 +530,42 @@ 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 = read $ s ^. network - r <- saveWallet (s ^. dbPath) $ ZcashWallet n netName sP bH + let netName = s ^. network + r <- + saveWallet (s ^. dbPath) $ + ZcashWallet n (ZcashNetDB netName) (PhraseDB sP) bH case r of Nothing -> do return $ s & msg .~ ("Wallet already exists: " ++ T.unpack n) @@ -358,21 +588,70 @@ addNewAccount n s = do Just (_j, w1) -> return w1 Just (_k, w) -> return w aL' <- getMaxAccount (s ^. dbPath) (entityKey selWallet) - r <- - saveAccount (s ^. dbPath) $ - ZcashAccount - (aL' + 1) - (entityKey selWallet) - n - "fakeOrchKey" - "fakeSapKey" - "fakeTKey" - case r of - Nothing -> return $ s & msg .~ ("Account already exists: " ++ T.unpack n) - Just x -> do - aL <- getAccounts (s ^. dbPath) (entityKey selWallet) - let nL = - L.listMoveToElement x $ - L.listReplace (Vec.fromList aL) (Just 0) (s ^. accounts) - return $ - (s & accounts .~ nL) & msg .~ "Created new account: " ++ T.unpack n + zA <- + try $ createZcashAccount n (aL' + 1) selWallet :: IO + (Either IOError ZcashAccount) + case zA of + Left e -> return $ s & msg .~ ("Error: " ++ show e) + Right zA' -> do + r <- saveAccount (s ^. dbPath) zA' + case r of + Nothing -> + return $ s & msg .~ ("Account already exists: " ++ T.unpack n) + Just x -> do + aL <- getAccounts (s ^. dbPath) (entityKey selWallet) + let nL = + L.listMoveToElement x $ + 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) ++ ")" diff --git a/src/Zenith/Core.hs b/src/Zenith/Core.hs index 7d6a4e7..4e1d2c6 100644 --- a/src/Zenith/Core.hs +++ b/src/Zenith/Core.hs @@ -3,63 +3,36 @@ -- 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 - --- * Database functions --- | Initializes the database -initDb :: - T.Text -- ^ The database path to check - -> IO () -initDb dbName = do - 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] [] +import Zenith.Types + ( OrchardSpendingKeyDB(..) + , PhraseDB(..) + , SaplingSpendingKeyDB(..) + , ScopeDB(..) + , TransparentSpendingKeyDB(..) + , UnifiedAddressDB(..) + , ZcashNetDB(..) + ) -- * Zebra Node interaction -- | Checks the status of the `zebrad` node @@ -79,7 +52,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 :: @@ -88,3 +61,104 @@ 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) diff --git a/src/Zenith/DB.hs b/src/Zenith/DB.hs index ef6b324..8345aef 100644 --- a/src/Zenith/DB.hs +++ b/src/Zenith/DB.hs @@ -23,17 +23,24 @@ import qualified Data.Text as T import Database.Persist import Database.Persist.Sqlite import Database.Persist.TH -import ZcashHaskell.Types (Phrase, ZcashNet) - -derivePersistField "ZcashNet" +import ZcashHaskell.Types (Scope(..), ZcashNet) +import Zenith.Types + ( OrchardSpendingKeyDB(..) + , PhraseDB(..) + , SaplingSpendingKeyDB(..) + , ScopeDB(..) + , TransparentSpendingKeyDB + , UnifiedAddressDB(..) + , ZcashNetDB(..) + ) share [mkPersist sqlSettings, mkMigrate "migrateAll"] [persistLowerCase| ZcashWallet name T.Text - network ZcashNet - seedPhrase Phrase + network ZcashNetDB + seedPhrase PhraseDB birthdayHeight Int UniqueWallet name network deriving Show Eq @@ -41,23 +48,100 @@ share index Int walletId ZcashWalletId name T.Text - orchSpendKey BS.ByteString - sapSpendKey BS.ByteString - tPrivateKey BS.ByteString + orchSpendKey OrchardSpendingKeyDB + sapSpendKey SaplingSpendingKeyDB + tPrivateKey TransparentSpendingKeyDB UniqueAccount index walletId + UniqueAccName walletId name deriving Show Eq WalletAddress - accId ZcashAccountId index Int - orchRec BS.ByteString Maybe - sapRec BS.ByteString Maybe - tRec BS.ByteString Maybe - encoded T.Text + accId ZcashAccountId + name T.Text + uAddress UnifiedAddressDB + scope ScopeDB + UniqueAddress index scope accId + UniqueAddName accId name 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 $ do - s <- selectList [ZcashWalletNetwork ==. n] [] - liftIO $ return s + runSqlite dbFp $ selectList [ZcashWalletNetwork ==. ZcashNetDB n] [] + +-- | 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, 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 diff --git a/src/Zenith/Types.hs b/src/Zenith/Types.hs index 1ec4408..715e338 100644 --- a/src/Zenith/Types.hs +++ b/src/Zenith/Types.hs @@ -1,7 +1,11 @@ {-# LANGUAGE LambdaCase #-} +{-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE GeneralisedNewtypeDeriving #-} +{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE StandaloneDeriving #-} module Zenith.Types where @@ -14,7 +18,58 @@ 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 diff --git a/src/Zenith/Utils.hs b/src/Zenith/Utils.hs index f2b42a4..ed648a4 100644 --- a/src/Zenith/Utils.hs +++ b/src/Zenith/Utils.hs @@ -9,15 +9,13 @@ 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.Orchard (encodeUnifiedAddress, isValidUnifiedAddress) import ZcashHaskell.Sapling (isValidShieldedAddress) import Zenith.Types ( AddressGroup(..) - , AddressSource(..) + , UnifiedAddressDB(..) , ZcashAddress(..) , ZcashPool(..) ) @@ -30,6 +28,12 @@ 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 diff --git a/test/Spec.hs b/test/Spec.hs index 03a2d20..bfc6f68 100644 --- a/test/Spec.hs +++ b/test/Spec.hs @@ -5,9 +5,17 @@ import Database.Persist import Database.Persist.Sqlite import System.Directory import Test.Hspec -import ZcashHaskell.Types (ZcashNet(..)) -import Zenith.Core (getAccounts) +import ZcashHaskell.Orchard (isValidUnifiedAddress) +import ZcashHaskell.Types + ( OrchardSpendingKey(..) + , Phrase(..) + , SaplingSpendingKey(..) + , Scope(..) + , ZcashNet(..) + ) +import Zenith.Core import Zenith.DB +import Zenith.Types main :: IO () main = do @@ -24,10 +32,12 @@ main = do runSqlite "test.db" $ do insert $ ZcashWallet - "one two three four five six seven eight nine ten eleven twelve" - 2000000 "Main Wallet" - MainNet + (ZcashNetDB MainNet) + (PhraseDB $ + Phrase + "one two three four five six seven eight nine ten eleven twelve") + 2000000 fromSqlKey s `shouldBe` 1 it "read wallet record" $ do s <- @@ -48,21 +58,43 @@ main = do delete recId get recId "None" `shouldBe` maybe "None" zcashWalletName s - describe "Account table" $ do - it "insert account" $ do + describe "Wallet function tests:" $ do + it "Save Wallet:" $ 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 - insert $ - ZcashWallet - "one two three four five six seven eight nine ten eleven twelve" - 2000000 - "Main Wallet" - MainNet - t <- - runSqlite "test.db" $ do - insert $ ZcashAccount s 0 "132465798" "987654321" "739182462" - fromSqlKey t `shouldBe` 1 - it "read accounts for wallet" $ do - wList <- getWallets "test.db" MainNet - acc <- getAccounts "test.db" $ entityKey (head wList) - length acc `shouldBe` 1 + selectList [ZcashWalletName ==. "Testing"] [] + za <- + saveAccount "test.db" =<< + createZcashAccount "TestAccount" 0 (head s) + za `shouldNotBe` Nothing + it "Save address:" $ do + acList <- + runSqlite "test.db" $ + selectList [ZcashAccountName ==. "TestAccount"] [] + zAdd <- + saveAddress "test.db" =<< + createWalletAddress "Personal123" 0 MainNet External (head acList) + addList <- + runSqlite "test.db" $ + 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 diff --git a/zcash-haskell b/zcash-haskell index a52d223..f228eff 160000 --- a/zcash-haskell +++ b/zcash-haskell @@ -1 +1 @@ -Subproject commit a52d2231f1a4f85a6504bfb9228a1475a0773088 +Subproject commit f228eff367c776469455adc4d443102cc53e5538 diff --git a/zenith.cabal b/zenith.cabal index b14f4ea..081df74 100644 --- a/zenith.cabal +++ b/zenith.cabal @@ -1,10 +1,10 @@ cabal-version: 3.0 name: zenith -version: 0.4.3.0 +version: 0.4.4.1 license: MIT license-file: LICENSE author: Rene Vergara -maintainer: pitmut@vergara.tech +maintainer: pitmutt@vergara.tech copyright: (c) 2022-2024 Vergara Technologies LLC build-type: Custom category: Blockchain @@ -13,8 +13,6 @@ extra-doc-files: CHANGELOG.md zenith.cfg -common warnings - ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N -Wunused-imports custom-setup setup-depends: @@ -26,7 +24,6 @@ custom-setup , regex-compat library - import: warnings ghc-options: -Wall -Wunused-imports exposed-modules: Zenith.CLI @@ -56,6 +53,7 @@ library , persistent-sqlite , persistent-template , process + , hexstring , regex-base , regex-compat , regex-posix @@ -63,12 +61,13 @@ library , text , vector , vty + , word-wrap , zcash-haskell --pkgconfig-depends: rustzcash_wrapper default-language: Haskell2010 executable zenith - import: warnings + ghc-options: -threaded -rtsopts -with-rtsopts=-N main-is: Main.hs hs-source-dirs: app @@ -88,8 +87,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