Merge branch 'dev041' into rvv041
This commit is contained in:
commit
f167ef3eec
8 changed files with 730 additions and 203 deletions
|
@ -7,7 +7,7 @@ with-compiler: ghc-9.4.8
|
||||||
source-repository-package
|
source-repository-package
|
||||||
type: git
|
type: git
|
||||||
location: https://git.vergara.tech/Vergara_Tech/haskell-hexstring.git
|
location: https://git.vergara.tech/Vergara_Tech/haskell-hexstring.git
|
||||||
tag: fd1ddce73c0ad18a2a4509a299c6e93f8c6c383d
|
tag: 39d8da7b11a80269454c2f134a5c834e0f3cb9a7
|
||||||
|
|
||||||
source-repository-package
|
source-repository-package
|
||||||
type: git
|
type: git
|
||||||
|
|
|
@ -3,15 +3,6 @@
|
||||||
|
|
||||||
module Zenith.CLI where
|
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.AttrMap as A
|
||||||
import qualified Brick.Focus as F
|
import qualified Brick.Focus as F
|
||||||
import Brick.Forms
|
import Brick.Forms
|
||||||
|
@ -37,13 +28,16 @@ import Brick.Widgets.Core
|
||||||
, (<=>)
|
, (<=>)
|
||||||
, emptyWidget
|
, emptyWidget
|
||||||
, fill
|
, fill
|
||||||
|
, hBox
|
||||||
, hLimit
|
, hLimit
|
||||||
, joinBorders
|
, joinBorders
|
||||||
, padAll
|
, padAll
|
||||||
, padBottom
|
, padBottom
|
||||||
, padRight
|
|
||||||
, str
|
, str
|
||||||
|
, strWrap
|
||||||
, txt
|
, txt
|
||||||
|
, txtWrap
|
||||||
|
, txtWrapWith
|
||||||
, vBox
|
, vBox
|
||||||
, vLimit
|
, vLimit
|
||||||
, withAttr
|
, withAttr
|
||||||
|
@ -51,12 +45,25 @@ import Brick.Widgets.Core
|
||||||
)
|
)
|
||||||
import qualified Brick.Widgets.Dialog as D
|
import qualified Brick.Widgets.Dialog as D
|
||||||
import qualified Brick.Widgets.List as L
|
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 qualified Data.Vector as Vec
|
||||||
import Database.Persist
|
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 ZcashHaskell.Types
|
||||||
import Zenith.Core
|
import Zenith.Core
|
||||||
import Zenith.DB
|
import Zenith.DB
|
||||||
|
import Zenith.Types (PhraseDB(..), UnifiedAddressDB(..), ZcashNetDB(..))
|
||||||
|
import Zenith.Utils (showAddress)
|
||||||
|
|
||||||
data Name
|
data Name
|
||||||
= WList
|
= WList
|
||||||
|
@ -76,13 +83,22 @@ makeLenses ''DialogInput
|
||||||
data DialogType
|
data DialogType
|
||||||
= WName
|
= WName
|
||||||
| AName
|
| AName
|
||||||
|
| AdName
|
||||||
|
| WSelect
|
||||||
|
| ASelect
|
||||||
| Blank
|
| Blank
|
||||||
|
|
||||||
|
data DisplayType
|
||||||
|
= AddrDisplay
|
||||||
|
| MsgDisplay
|
||||||
|
| PhraseDisplay
|
||||||
|
| BlankDisplay
|
||||||
|
|
||||||
data State = State
|
data State = State
|
||||||
{ _network :: !String
|
{ _network :: !ZcashNet
|
||||||
, _wallets :: !(L.List Name (Entity ZcashWallet))
|
, _wallets :: !(L.List Name (Entity ZcashWallet))
|
||||||
, _accounts :: !(L.List Name (Entity ZcashAccount))
|
, _accounts :: !(L.List Name (Entity ZcashAccount))
|
||||||
, _addresses :: !(L.List Name String)
|
, _addresses :: !(L.List Name (Entity WalletAddress))
|
||||||
, _transactions :: !(L.List Name String)
|
, _transactions :: !(L.List Name String)
|
||||||
, _msg :: !String
|
, _msg :: !String
|
||||||
, _helpBox :: !Bool
|
, _helpBox :: !Bool
|
||||||
|
@ -92,12 +108,13 @@ data State = State
|
||||||
, _focusRing :: !(F.FocusRing Name)
|
, _focusRing :: !(F.FocusRing Name)
|
||||||
, _startBlock :: !Int
|
, _startBlock :: !Int
|
||||||
, _dbPath :: !T.Text
|
, _dbPath :: !T.Text
|
||||||
|
, _displayBox :: !DisplayType
|
||||||
}
|
}
|
||||||
|
|
||||||
makeLenses ''State
|
makeLenses ''State
|
||||||
|
|
||||||
drawUI :: State -> [Widget Name]
|
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
|
where
|
||||||
ui :: State -> Widget Name
|
ui :: State -> Widget Name
|
||||||
ui st =
|
ui st =
|
||||||
|
@ -106,25 +123,31 @@ drawUI s = [splashDialog s, helpDialog s, inputDialog s, ui s]
|
||||||
B.borderWithLabel
|
B.borderWithLabel
|
||||||
(str
|
(str
|
||||||
("Zenith - " <>
|
("Zenith - " <>
|
||||||
st ^. network <>
|
show (st ^. network) <>
|
||||||
" - " <>
|
" - " <>
|
||||||
T.unpack
|
T.unpack
|
||||||
(maybe
|
(maybe
|
||||||
"(None)"
|
"(None)"
|
||||||
(\(_, w) -> zcashWalletName $ entityVal w)
|
(\(_, w) -> zcashWalletName $ entityVal w)
|
||||||
(L.listSelectedElement (st ^. wallets))))) $
|
(L.listSelectedElement (st ^. wallets)))))
|
||||||
(C.hCenter
|
(C.hCenter
|
||||||
(str
|
(str
|
||||||
("Account: " ++
|
("Account: " ++
|
||||||
T.unpack
|
T.unpack
|
||||||
(maybe
|
(maybe
|
||||||
"(None)"
|
"(None)"
|
||||||
(\(_, a) -> zcashAccountName $ entityVal a)
|
(\(_, a) -> zcashAccountName $ entityVal a)
|
||||||
(L.listSelectedElement (st ^. accounts))))) <=>
|
(L.listSelectedElement (st ^. accounts))))) <=>
|
||||||
listBox "Addresses" (st ^. addresses) <+>
|
listAddressBox "Addresses" (st ^. addresses) <+>
|
||||||
B.vBorder <+> C.center (listBox "Transactions" (st ^. transactions))) <=>
|
B.vBorder <+> C.center (listBox "Transactions" (st ^. transactions))) <=>
|
||||||
msgBox (st ^. msg)
|
C.hCenter
|
||||||
listBox :: String -> L.List Name String -> Widget Name
|
(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 =
|
listBox titleLabel l =
|
||||||
C.vCenter $
|
C.vCenter $
|
||||||
vBox
|
vBox
|
||||||
|
@ -134,10 +157,30 @@ drawUI s = [splashDialog s, helpDialog s, inputDialog s, ui s]
|
||||||
, str " "
|
, str " "
|
||||||
, C.hCenter $ str "Select "
|
, C.hCenter $ str "Select "
|
||||||
]
|
]
|
||||||
msgBox :: String -> Widget Name
|
selectListBox ::
|
||||||
msgBox m =
|
Show e
|
||||||
|
=> String
|
||||||
|
-> L.List Name e
|
||||||
|
-> (Bool -> e -> Widget Name)
|
||||||
|
-> Widget Name
|
||||||
|
selectListBox titleLabel l drawF =
|
||||||
vBox
|
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 :: State -> Widget Name
|
||||||
helpDialog st =
|
helpDialog st =
|
||||||
if st ^. helpBox
|
if st ^. helpBox
|
||||||
|
@ -147,11 +190,17 @@ drawUI s = [splashDialog s, helpDialog s, inputDialog s, ui s]
|
||||||
vBox ([str "Actions", B.hBorder] <> actionList))
|
vBox ([str "Actions", B.hBorder] <> actionList))
|
||||||
else emptyWidget
|
else emptyWidget
|
||||||
where
|
where
|
||||||
keyList = map (C.hCenter . str) ["?", "Esc", "c", "q"]
|
keyList = map (C.hCenter . str) ["?", "Esc", "w", "a", "v", "q"]
|
||||||
actionList =
|
actionList =
|
||||||
map
|
map
|
||||||
(hLimit 40 . str)
|
(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 :: State -> Widget Name
|
||||||
inputDialog st =
|
inputDialog st =
|
||||||
case st ^. dialogBox of
|
case st ^. dialogBox of
|
||||||
|
@ -163,6 +212,33 @@ drawUI s = [splashDialog s, helpDialog s, inputDialog s, ui s]
|
||||||
D.renderDialog
|
D.renderDialog
|
||||||
(D.dialog (Just (str "Create Account")) Nothing 50)
|
(D.dialog (Just (str "Create Account")) Nothing 50)
|
||||||
(renderForm $ st ^. inputForm)
|
(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
|
Blank -> emptyWidget
|
||||||
splashDialog :: State -> Widget Name
|
splashDialog :: State -> Widget Name
|
||||||
splashDialog st =
|
splashDialog st =
|
||||||
|
@ -174,9 +250,46 @@ drawUI s = [splashDialog s, helpDialog s, inputDialog s, ui s]
|
||||||
titleAttr
|
titleAttr
|
||||||
(str
|
(str
|
||||||
" _____ _ _ _ \n|__ /___ _ __ (_) |_| |__\n / // _ \\ '_ \\| | __| '_ \\\n / /| __/ | | | | |_| | | |\n/____\\___|_| |_|_|\\__|_| |_|") <=>
|
" _____ _ _ _ \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..."))
|
C.hCenter (withAttr blinkAttr $ str "Press any key..."))
|
||||||
else emptyWidget
|
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 :: DialogInput -> Form DialogInput e Name
|
||||||
mkInputForm =
|
mkInputForm =
|
||||||
|
@ -194,6 +307,33 @@ listDrawElement sel a =
|
||||||
else str s
|
else str s
|
||||||
in C.hCenter $ selStr $ show a
|
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 :: A.AttrName
|
||||||
customAttr = L.listSelectedAttr <> A.attrName "custom"
|
customAttr = L.listSelectedAttr <> A.attrName "custom"
|
||||||
|
|
||||||
|
@ -216,52 +356,113 @@ appEvent (BT.VtyEvent e) = do
|
||||||
BT.modify $ set helpBox False
|
BT.modify $ set helpBox False
|
||||||
_ev -> return ()
|
_ev -> return ()
|
||||||
else do
|
else do
|
||||||
case s ^. dialogBox of
|
case s ^. displayBox of
|
||||||
WName -> do
|
AddrDisplay -> BT.modify $ set displayBox BlankDisplay
|
||||||
case e of
|
MsgDisplay -> BT.modify $ set displayBox BlankDisplay
|
||||||
V.EvKey V.KEsc [] -> BT.modify $ set dialogBox Blank
|
PhraseDisplay -> BT.modify $ set displayBox BlankDisplay
|
||||||
V.EvKey V.KEnter [] -> do
|
BlankDisplay -> do
|
||||||
fs <- BT.zoom inputForm $ BT.gets formState
|
case s ^. dialogBox of
|
||||||
nw <- liftIO $ addNewWallet (fs ^. dialogInput) s
|
WName -> do
|
||||||
BT.put nw
|
case e of
|
||||||
aL <- use accounts
|
V.EvKey V.KEsc [] -> BT.modify $ set dialogBox Blank
|
||||||
BT.modify $
|
V.EvKey V.KEnter [] -> do
|
||||||
set dialogBox $
|
fs <- BT.zoom inputForm $ BT.gets formState
|
||||||
if not (null $ L.listElements aL)
|
nw <- liftIO $ addNewWallet (fs ^. dialogInput) s
|
||||||
then Blank
|
ns <- liftIO $ refreshWallet nw
|
||||||
else AName
|
BT.put ns
|
||||||
ev -> BT.zoom inputForm $ handleFormEvent (BT.VtyEvent ev)
|
aL <- use accounts
|
||||||
AName -> do
|
BT.modify $ set displayBox MsgDisplay
|
||||||
case e of
|
BT.modify $
|
||||||
V.EvKey V.KEsc [] -> BT.modify $ set dialogBox Blank
|
set dialogBox $
|
||||||
V.EvKey V.KEnter [] -> do
|
if not (null $ L.listElements aL)
|
||||||
fs <- BT.zoom inputForm $ BT.gets formState
|
then Blank
|
||||||
na <- liftIO $ addNewAccount (fs ^. dialogInput) s
|
else AName
|
||||||
BT.put na
|
ev ->
|
||||||
BT.modify $ set dialogBox Blank
|
BT.zoom inputForm $ handleFormEvent (BT.VtyEvent ev)
|
||||||
ev -> BT.zoom inputForm $ handleFormEvent (BT.VtyEvent ev)
|
AName -> do
|
||||||
Blank -> do
|
case e of
|
||||||
case e of
|
V.EvKey V.KEsc [] -> BT.modify $ set dialogBox Blank
|
||||||
V.EvKey (V.KChar '\t') [] -> focusRing %= F.focusNext
|
V.EvKey V.KEnter [] -> do
|
||||||
V.EvKey (V.KChar 'q') [] -> M.halt
|
fs <- BT.zoom inputForm $ BT.gets formState
|
||||||
V.EvKey (V.KChar '?') [] -> BT.modify $ set helpBox True
|
ns <-
|
||||||
V.EvKey (V.KChar 'w') [] -> do
|
liftIO $
|
||||||
BT.modify $
|
refreshAccount =<<
|
||||||
set inputForm $
|
addNewAddress "Change" Internal =<<
|
||||||
updateFormState (DialogInput "New Wallet") $
|
addNewAccount (fs ^. dialogInput) s
|
||||||
s ^. inputForm
|
BT.put ns
|
||||||
BT.modify $ set dialogBox WName
|
addrL <- use addresses
|
||||||
V.EvKey (V.KChar 'a') [] -> do
|
BT.modify $ set displayBox MsgDisplay
|
||||||
BT.modify $
|
BT.modify $
|
||||||
set inputForm $
|
set dialogBox $
|
||||||
updateFormState (DialogInput "New Account") $
|
if not (null $ L.listElements addrL)
|
||||||
s ^. inputForm
|
then Blank
|
||||||
BT.modify $ set dialogBox AName
|
else AdName
|
||||||
ev ->
|
ev ->
|
||||||
case r of
|
BT.zoom inputForm $ handleFormEvent (BT.VtyEvent ev)
|
||||||
Just AList -> BT.zoom addresses $ L.handleListEvent ev
|
AdName -> do
|
||||||
Just TList -> BT.zoom transactions $ L.handleListEvent ev
|
case e of
|
||||||
_anyName -> return ()
|
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
|
where
|
||||||
printMsg :: String -> BT.EventM Name State ()
|
printMsg :: String -> BT.EventM Name State ()
|
||||||
printMsg s = BT.modify $ updateMsg s
|
printMsg s = BT.modify $ updateMsg s
|
||||||
|
@ -298,7 +499,7 @@ runZenithCLI host port dbFilePath = do
|
||||||
Just zebra -> do
|
Just zebra -> do
|
||||||
bc <- checkBlockChain host port
|
bc <- checkBlockChain host port
|
||||||
case (bc :: Maybe ZebraGetBlockChainInfo) of
|
case (bc :: Maybe ZebraGetBlockChainInfo) of
|
||||||
Nothing -> print "Unable to determine blockchain status"
|
Nothing -> throwIO $ userError "Unable to determine blockchain status"
|
||||||
Just chainInfo -> do
|
Just chainInfo -> do
|
||||||
initDb dbFilePath
|
initDb dbFilePath
|
||||||
walList <- getWallets dbFilePath $ zgb_net chainInfo
|
walList <- getWallets dbFilePath $ zgb_net chainInfo
|
||||||
|
@ -306,13 +507,17 @@ runZenithCLI host port dbFilePath = do
|
||||||
if not (null walList)
|
if not (null walList)
|
||||||
then getAccounts dbFilePath $ entityKey $ head walList
|
then getAccounts dbFilePath $ entityKey $ head walList
|
||||||
else return []
|
else return []
|
||||||
|
addrList <-
|
||||||
|
if not (null accList)
|
||||||
|
then getAddresses dbFilePath $ entityKey $ head accList
|
||||||
|
else return []
|
||||||
void $
|
void $
|
||||||
M.defaultMain theApp $
|
M.defaultMain theApp $
|
||||||
State
|
State
|
||||||
((show . zgb_net) chainInfo)
|
(zgb_net chainInfo)
|
||||||
(L.list WList (Vec.fromList walList) 1)
|
(L.list WList (Vec.fromList walList) 1)
|
||||||
(L.list AcList (Vec.fromList accList) 0)
|
(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)
|
(L.list TList (Vec.fromList ["tx1", "tx2", "tx3"]) 1)
|
||||||
("Start up Ok! Connected to Zebra " ++
|
("Start up Ok! Connected to Zebra " ++
|
||||||
(T.unpack . zgi_build) zebra ++ " on port " ++ show port ++ ".")
|
(T.unpack . zgi_build) zebra ++ " on port " ++ show port ++ ".")
|
||||||
|
@ -325,17 +530,42 @@ runZenithCLI host port dbFilePath = do
|
||||||
(F.focusRing [AList, TList])
|
(F.focusRing [AList, TList])
|
||||||
(zgb_blocks chainInfo)
|
(zgb_blocks chainInfo)
|
||||||
dbFilePath
|
dbFilePath
|
||||||
|
MsgDisplay
|
||||||
Nothing -> do
|
Nothing -> do
|
||||||
print $
|
print $
|
||||||
"No Zebra node available on port " <>
|
"No Zebra node available on port " <>
|
||||||
show port <> ". Check your configuration"
|
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 :: T.Text -> State -> IO State
|
||||||
addNewWallet n s = do
|
addNewWallet n s = do
|
||||||
sP <- generateWalletSeedPhrase
|
sP <- generateWalletSeedPhrase
|
||||||
let bH = s ^. startBlock
|
let bH = s ^. startBlock
|
||||||
let netName = read $ s ^. network
|
let netName = s ^. network
|
||||||
r <- saveWallet (s ^. dbPath) $ ZcashWallet n netName sP bH
|
r <-
|
||||||
|
saveWallet (s ^. dbPath) $
|
||||||
|
ZcashWallet n (ZcashNetDB netName) (PhraseDB sP) bH
|
||||||
case r of
|
case r of
|
||||||
Nothing -> do
|
Nothing -> do
|
||||||
return $ s & msg .~ ("Wallet already exists: " ++ T.unpack n)
|
return $ s & msg .~ ("Wallet already exists: " ++ T.unpack n)
|
||||||
|
@ -358,21 +588,70 @@ addNewAccount n s = do
|
||||||
Just (_j, w1) -> return w1
|
Just (_j, w1) -> return w1
|
||||||
Just (_k, w) -> return w
|
Just (_k, w) -> return w
|
||||||
aL' <- getMaxAccount (s ^. dbPath) (entityKey selWallet)
|
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
|
|
||||||
|
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) ++ ")"
|
||||||
|
|
|
@ -3,63 +3,36 @@
|
||||||
-- Core wallet functionality for Zenith
|
-- Core wallet functionality for Zenith
|
||||||
module Zenith.Core where
|
module Zenith.Core where
|
||||||
|
|
||||||
|
import Control.Exception (throwIO)
|
||||||
import Data.Aeson
|
import Data.Aeson
|
||||||
|
import Data.HexString (hexString)
|
||||||
import qualified Data.Text as T
|
import qualified Data.Text as T
|
||||||
import Database.Persist
|
import Database.Persist
|
||||||
import Database.Persist.Sqlite
|
|
||||||
import Network.HTTP.Client
|
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.Types
|
||||||
import ZcashHaskell.Utils
|
import ZcashHaskell.Utils
|
||||||
import Zenith.DB
|
import Zenith.DB
|
||||||
|
import Zenith.Types
|
||||||
-- * Database functions
|
( OrchardSpendingKeyDB(..)
|
||||||
-- | Initializes the database
|
, PhraseDB(..)
|
||||||
initDb ::
|
, SaplingSpendingKeyDB(..)
|
||||||
T.Text -- ^ The database path to check
|
, ScopeDB(..)
|
||||||
-> IO ()
|
, TransparentSpendingKeyDB(..)
|
||||||
initDb dbName = do
|
, UnifiedAddressDB(..)
|
||||||
runSqlite dbName $ do runMigration migrateAll
|
, ZcashNetDB(..)
|
||||||
|
)
|
||||||
-- | 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
|
-- * Zebra Node interaction
|
||||||
-- | Checks the status of the `zebrad` node
|
-- | Checks the status of the `zebrad` node
|
||||||
|
@ -79,7 +52,7 @@ checkBlockChain ::
|
||||||
-> IO (Maybe ZebraGetBlockChainInfo)
|
-> IO (Maybe ZebraGetBlockChainInfo)
|
||||||
checkBlockChain nodeHost nodePort = do
|
checkBlockChain nodeHost nodePort = do
|
||||||
let f = makeZebraCall nodeHost nodePort
|
let f = makeZebraCall nodeHost nodePort
|
||||||
result <$> (responseBody <$> f "getblockchaininfo" [])
|
result . responseBody <$> f "getblockchaininfo" []
|
||||||
|
|
||||||
-- | Generic RPC call function
|
-- | Generic RPC call function
|
||||||
connectZebra ::
|
connectZebra ::
|
||||||
|
@ -88,3 +61,104 @@ connectZebra nodeHost nodePort m params = do
|
||||||
res <- makeZebraCall nodeHost nodePort m params
|
res <- makeZebraCall nodeHost nodePort m params
|
||||||
let body = responseBody res
|
let body = responseBody res
|
||||||
return $ result body
|
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)
|
||||||
|
|
116
src/Zenith/DB.hs
116
src/Zenith/DB.hs
|
@ -23,17 +23,24 @@ import qualified Data.Text as T
|
||||||
import Database.Persist
|
import Database.Persist
|
||||||
import Database.Persist.Sqlite
|
import Database.Persist.Sqlite
|
||||||
import Database.Persist.TH
|
import Database.Persist.TH
|
||||||
import ZcashHaskell.Types (Phrase, ZcashNet)
|
import ZcashHaskell.Types (Scope(..), ZcashNet)
|
||||||
|
import Zenith.Types
|
||||||
derivePersistField "ZcashNet"
|
( OrchardSpendingKeyDB(..)
|
||||||
|
, PhraseDB(..)
|
||||||
|
, SaplingSpendingKeyDB(..)
|
||||||
|
, ScopeDB(..)
|
||||||
|
, TransparentSpendingKeyDB
|
||||||
|
, UnifiedAddressDB(..)
|
||||||
|
, ZcashNetDB(..)
|
||||||
|
)
|
||||||
|
|
||||||
share
|
share
|
||||||
[mkPersist sqlSettings, mkMigrate "migrateAll"]
|
[mkPersist sqlSettings, mkMigrate "migrateAll"]
|
||||||
[persistLowerCase|
|
[persistLowerCase|
|
||||||
ZcashWallet
|
ZcashWallet
|
||||||
name T.Text
|
name T.Text
|
||||||
network ZcashNet
|
network ZcashNetDB
|
||||||
seedPhrase Phrase
|
seedPhrase PhraseDB
|
||||||
birthdayHeight Int
|
birthdayHeight Int
|
||||||
UniqueWallet name network
|
UniqueWallet name network
|
||||||
deriving Show Eq
|
deriving Show Eq
|
||||||
|
@ -41,23 +48,100 @@ share
|
||||||
index Int
|
index Int
|
||||||
walletId ZcashWalletId
|
walletId ZcashWalletId
|
||||||
name T.Text
|
name T.Text
|
||||||
orchSpendKey BS.ByteString
|
orchSpendKey OrchardSpendingKeyDB
|
||||||
sapSpendKey BS.ByteString
|
sapSpendKey SaplingSpendingKeyDB
|
||||||
tPrivateKey BS.ByteString
|
tPrivateKey TransparentSpendingKeyDB
|
||||||
UniqueAccount index walletId
|
UniqueAccount index walletId
|
||||||
|
UniqueAccName walletId name
|
||||||
deriving Show Eq
|
deriving Show Eq
|
||||||
WalletAddress
|
WalletAddress
|
||||||
accId ZcashAccountId
|
|
||||||
index Int
|
index Int
|
||||||
orchRec BS.ByteString Maybe
|
accId ZcashAccountId
|
||||||
sapRec BS.ByteString Maybe
|
name T.Text
|
||||||
tRec BS.ByteString Maybe
|
uAddress UnifiedAddressDB
|
||||||
encoded T.Text
|
scope ScopeDB
|
||||||
|
UniqueAddress index scope accId
|
||||||
|
UniqueAddName accId name
|
||||||
deriving Show Eq
|
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 :: T.Text -> ZcashNet -> IO [Entity ZcashWallet]
|
||||||
getWallets dbFp n =
|
getWallets dbFp n =
|
||||||
runSqlite dbFp $ do
|
runSqlite dbFp $ selectList [ZcashWalletNetwork ==. ZcashNetDB n] []
|
||||||
s <- selectList [ZcashWalletNetwork ==. n] []
|
|
||||||
liftIO $ return s
|
-- | 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
|
||||||
|
|
|
@ -1,7 +1,11 @@
|
||||||
{-# LANGUAGE LambdaCase #-}
|
{-# LANGUAGE LambdaCase #-}
|
||||||
|
{-# LANGUAGE DerivingStrategies #-}
|
||||||
|
{-# LANGUAGE GeneralisedNewtypeDeriving #-}
|
||||||
|
{-# LANGUAGE TemplateHaskell #-}
|
||||||
{-# LANGUAGE DeriveGeneric #-}
|
{-# LANGUAGE DeriveGeneric #-}
|
||||||
{-# LANGUAGE DeriveAnyClass #-}
|
{-# LANGUAGE DeriveAnyClass #-}
|
||||||
{-# LANGUAGE OverloadedStrings #-}
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
|
{-# LANGUAGE StandaloneDeriving #-}
|
||||||
|
|
||||||
module Zenith.Types where
|
module Zenith.Types where
|
||||||
|
|
||||||
|
@ -14,7 +18,58 @@ import Data.Maybe (fromMaybe)
|
||||||
import qualified Data.Text as T
|
import qualified Data.Text as T
|
||||||
import qualified Data.Text.Encoding as E
|
import qualified Data.Text.Encoding as E
|
||||||
import Data.Text.Encoding.Error (lenientDecode)
|
import Data.Text.Encoding.Error (lenientDecode)
|
||||||
|
import Database.Persist.TH
|
||||||
import GHC.Generics
|
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
|
-- | A type to model Zcash RPC calls
|
||||||
data RpcCall = RpcCall
|
data RpcCall = RpcCall
|
||||||
|
|
|
@ -9,15 +9,13 @@ import Data.Functor (void)
|
||||||
import Data.Maybe
|
import Data.Maybe
|
||||||
import qualified Data.Text as T
|
import qualified Data.Text as T
|
||||||
import qualified Data.Text.Encoding as E
|
import qualified Data.Text.Encoding as E
|
||||||
import qualified Data.Text.IO as TIO
|
|
||||||
import System.Process (createProcess_, shell)
|
import System.Process (createProcess_, shell)
|
||||||
import Text.Read (readMaybe)
|
|
||||||
import Text.Regex.Posix
|
import Text.Regex.Posix
|
||||||
import ZcashHaskell.Orchard (isValidUnifiedAddress)
|
import ZcashHaskell.Orchard (encodeUnifiedAddress, isValidUnifiedAddress)
|
||||||
import ZcashHaskell.Sapling (isValidShieldedAddress)
|
import ZcashHaskell.Sapling (isValidShieldedAddress)
|
||||||
import Zenith.Types
|
import Zenith.Types
|
||||||
( AddressGroup(..)
|
( AddressGroup(..)
|
||||||
, AddressSource(..)
|
, UnifiedAddressDB(..)
|
||||||
, ZcashAddress(..)
|
, ZcashAddress(..)
|
||||||
, ZcashPool(..)
|
, ZcashPool(..)
|
||||||
)
|
)
|
||||||
|
@ -30,6 +28,12 @@ displayZec s
|
||||||
| s < 100000000 = show (fromIntegral s / 100000) ++ " mZEC "
|
| s < 100000000 = show (fromIntegral s / 100000) ++ " mZEC "
|
||||||
| otherwise = show (fromIntegral s / 100000000) ++ " ZEC "
|
| 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
|
-- | Helper function to extract addresses from AddressGroups
|
||||||
getAddresses :: AddressGroup -> [ZcashAddress]
|
getAddresses :: AddressGroup -> [ZcashAddress]
|
||||||
getAddresses ag = agtransparent ag <> agsapling ag <> agunified ag
|
getAddresses ag = agtransparent ag <> agsapling ag <> agunified ag
|
||||||
|
|
74
test/Spec.hs
74
test/Spec.hs
|
@ -5,9 +5,17 @@ import Database.Persist
|
||||||
import Database.Persist.Sqlite
|
import Database.Persist.Sqlite
|
||||||
import System.Directory
|
import System.Directory
|
||||||
import Test.Hspec
|
import Test.Hspec
|
||||||
import ZcashHaskell.Types (ZcashNet(..))
|
import ZcashHaskell.Orchard (isValidUnifiedAddress)
|
||||||
import Zenith.Core (getAccounts)
|
import ZcashHaskell.Types
|
||||||
|
( OrchardSpendingKey(..)
|
||||||
|
, Phrase(..)
|
||||||
|
, SaplingSpendingKey(..)
|
||||||
|
, Scope(..)
|
||||||
|
, ZcashNet(..)
|
||||||
|
)
|
||||||
|
import Zenith.Core
|
||||||
import Zenith.DB
|
import Zenith.DB
|
||||||
|
import Zenith.Types
|
||||||
|
|
||||||
main :: IO ()
|
main :: IO ()
|
||||||
main = do
|
main = do
|
||||||
|
@ -24,10 +32,12 @@ main = do
|
||||||
runSqlite "test.db" $ do
|
runSqlite "test.db" $ do
|
||||||
insert $
|
insert $
|
||||||
ZcashWallet
|
ZcashWallet
|
||||||
"one two three four five six seven eight nine ten eleven twelve"
|
|
||||||
2000000
|
|
||||||
"Main Wallet"
|
"Main Wallet"
|
||||||
MainNet
|
(ZcashNetDB MainNet)
|
||||||
|
(PhraseDB $
|
||||||
|
Phrase
|
||||||
|
"one two three four five six seven eight nine ten eleven twelve")
|
||||||
|
2000000
|
||||||
fromSqlKey s `shouldBe` 1
|
fromSqlKey s `shouldBe` 1
|
||||||
it "read wallet record" $ do
|
it "read wallet record" $ do
|
||||||
s <-
|
s <-
|
||||||
|
@ -48,21 +58,43 @@ main = do
|
||||||
delete recId
|
delete recId
|
||||||
get recId
|
get recId
|
||||||
"None" `shouldBe` maybe "None" zcashWalletName s
|
"None" `shouldBe` maybe "None" zcashWalletName s
|
||||||
describe "Account table" $ do
|
describe "Wallet function tests:" $ do
|
||||||
it "insert account" $ 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 <-
|
s <-
|
||||||
runSqlite "test.db" $ do
|
runSqlite "test.db" $ do
|
||||||
insert $
|
selectList [ZcashWalletName ==. "Testing"] []
|
||||||
ZcashWallet
|
za <-
|
||||||
"one two three four five six seven eight nine ten eleven twelve"
|
saveAccount "test.db" =<<
|
||||||
2000000
|
createZcashAccount "TestAccount" 0 (head s)
|
||||||
"Main Wallet"
|
za `shouldNotBe` Nothing
|
||||||
MainNet
|
it "Save address:" $ do
|
||||||
t <-
|
acList <-
|
||||||
runSqlite "test.db" $ do
|
runSqlite "test.db" $
|
||||||
insert $ ZcashAccount s 0 "132465798" "987654321" "739182462"
|
selectList [ZcashAccountName ==. "TestAccount"] []
|
||||||
fromSqlKey t `shouldBe` 1
|
zAdd <-
|
||||||
it "read accounts for wallet" $ do
|
saveAddress "test.db" =<<
|
||||||
wList <- getWallets "test.db" MainNet
|
createWalletAddress "Personal123" 0 MainNet External (head acList)
|
||||||
acc <- getAccounts "test.db" $ entityKey (head wList)
|
addList <-
|
||||||
length acc `shouldBe` 1
|
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
|
||||||
|
|
13
zenith.cabal
13
zenith.cabal
|
@ -1,10 +1,10 @@
|
||||||
cabal-version: 3.0
|
cabal-version: 3.0
|
||||||
name: zenith
|
name: zenith
|
||||||
version: 0.4.3.0
|
version: 0.4.4.1
|
||||||
license: MIT
|
license: MIT
|
||||||
license-file: LICENSE
|
license-file: LICENSE
|
||||||
author: Rene Vergara
|
author: Rene Vergara
|
||||||
maintainer: pitmut@vergara.tech
|
maintainer: pitmutt@vergara.tech
|
||||||
copyright: (c) 2022-2024 Vergara Technologies LLC
|
copyright: (c) 2022-2024 Vergara Technologies LLC
|
||||||
build-type: Custom
|
build-type: Custom
|
||||||
category: Blockchain
|
category: Blockchain
|
||||||
|
@ -13,8 +13,6 @@ extra-doc-files:
|
||||||
CHANGELOG.md
|
CHANGELOG.md
|
||||||
zenith.cfg
|
zenith.cfg
|
||||||
|
|
||||||
common warnings
|
|
||||||
ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N -Wunused-imports
|
|
||||||
|
|
||||||
custom-setup
|
custom-setup
|
||||||
setup-depends:
|
setup-depends:
|
||||||
|
@ -26,7 +24,6 @@ custom-setup
|
||||||
, regex-compat
|
, regex-compat
|
||||||
|
|
||||||
library
|
library
|
||||||
import: warnings
|
|
||||||
ghc-options: -Wall -Wunused-imports
|
ghc-options: -Wall -Wunused-imports
|
||||||
exposed-modules:
|
exposed-modules:
|
||||||
Zenith.CLI
|
Zenith.CLI
|
||||||
|
@ -56,6 +53,7 @@ library
|
||||||
, persistent-sqlite
|
, persistent-sqlite
|
||||||
, persistent-template
|
, persistent-template
|
||||||
, process
|
, process
|
||||||
|
, hexstring
|
||||||
, regex-base
|
, regex-base
|
||||||
, regex-compat
|
, regex-compat
|
||||||
, regex-posix
|
, regex-posix
|
||||||
|
@ -63,12 +61,13 @@ library
|
||||||
, text
|
, text
|
||||||
, vector
|
, vector
|
||||||
, vty
|
, vty
|
||||||
|
, word-wrap
|
||||||
, zcash-haskell
|
, zcash-haskell
|
||||||
--pkgconfig-depends: rustzcash_wrapper
|
--pkgconfig-depends: rustzcash_wrapper
|
||||||
default-language: Haskell2010
|
default-language: Haskell2010
|
||||||
|
|
||||||
executable zenith
|
executable zenith
|
||||||
import: warnings
|
ghc-options: -threaded -rtsopts -with-rtsopts=-N
|
||||||
main-is: Main.hs
|
main-is: Main.hs
|
||||||
hs-source-dirs:
|
hs-source-dirs:
|
||||||
app
|
app
|
||||||
|
@ -88,8 +87,8 @@ executable zenith
|
||||||
default-language: Haskell2010
|
default-language: Haskell2010
|
||||||
|
|
||||||
test-suite zenith-tests
|
test-suite zenith-tests
|
||||||
import: warnings
|
|
||||||
type: exitcode-stdio-1.0
|
type: exitcode-stdio-1.0
|
||||||
|
ghc-options: -threaded -rtsopts -with-rtsopts=-N
|
||||||
main-is: Spec.hs
|
main-is: Spec.hs
|
||||||
hs-source-dirs:
|
hs-source-dirs:
|
||||||
test
|
test
|
||||||
|
|
Loading…
Reference in a new issue