Publish Zenith beta version #80
2 changed files with 254 additions and 104 deletions
|
@ -44,7 +44,9 @@ import Brick.Widgets.Core
|
||||||
, padBottom
|
, padBottom
|
||||||
, padRight
|
, padRight
|
||||||
, str
|
, str
|
||||||
|
, strWrap
|
||||||
, txt
|
, txt
|
||||||
|
, txtWrap
|
||||||
, vBox
|
, vBox
|
||||||
, vLimit
|
, vLimit
|
||||||
, withAttr
|
, withAttr
|
||||||
|
@ -55,7 +57,7 @@ import qualified Brick.Widgets.List as L
|
||||||
import qualified Data.Vector as Vec
|
import qualified Data.Vector as Vec
|
||||||
import Database.Persist
|
import Database.Persist
|
||||||
import ZcashHaskell.Keys (generateWalletSeedPhrase, getWalletSeed)
|
import ZcashHaskell.Keys (generateWalletSeedPhrase, getWalletSeed)
|
||||||
import ZcashHaskell.Orchard (genOrchardSpendingKey)
|
import ZcashHaskell.Orchard (encodeUnifiedAddress, genOrchardSpendingKey)
|
||||||
import ZcashHaskell.Types
|
import ZcashHaskell.Types
|
||||||
import Zenith.Core
|
import Zenith.Core
|
||||||
import Zenith.DB
|
import Zenith.DB
|
||||||
|
@ -80,8 +82,15 @@ data DialogType
|
||||||
= WName
|
= WName
|
||||||
| AName
|
| AName
|
||||||
| AdName
|
| AdName
|
||||||
|
| WSelect
|
||||||
|
| ASelect
|
||||||
| Blank
|
| Blank
|
||||||
|
|
||||||
|
data DisplayType
|
||||||
|
= AddrDisplay
|
||||||
|
| MsgDisplay
|
||||||
|
| BlankDisplay
|
||||||
|
|
||||||
data State = State
|
data State = State
|
||||||
{ _network :: !ZcashNet
|
{ _network :: !ZcashNet
|
||||||
, _wallets :: !(L.List Name (Entity ZcashWallet))
|
, _wallets :: !(L.List Name (Entity ZcashWallet))
|
||||||
|
@ -96,12 +105,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 =
|
||||||
|
@ -116,18 +126,17 @@ drawUI s = [splashDialog s, helpDialog s, inputDialog s, ui s]
|
||||||
(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))))) <=>
|
||||||
listAddressBox "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)
|
|
||||||
listBox :: Show e => String -> L.List Name e -> Widget Name
|
listBox :: Show e => String -> L.List Name e -> Widget Name
|
||||||
listBox titleLabel l =
|
listBox titleLabel l =
|
||||||
C.vCenter $
|
C.vCenter $
|
||||||
|
@ -138,6 +147,20 @@ drawUI s = [splashDialog s, helpDialog s, inputDialog s, ui s]
|
||||||
, str " "
|
, str " "
|
||||||
, C.hCenter $ str "Select "
|
, C.hCenter $ str "Select "
|
||||||
]
|
]
|
||||||
|
selectListBox ::
|
||||||
|
Show e
|
||||||
|
=> String
|
||||||
|
-> L.List Name e
|
||||||
|
-> (Bool -> e -> Widget Name)
|
||||||
|
-> Widget Name
|
||||||
|
selectListBox titleLabel l drawF =
|
||||||
|
vBox
|
||||||
|
[ C.hCenter
|
||||||
|
(B.borderWithLabel (str titleLabel) $
|
||||||
|
hLimit 25 $ vLimit 15 $ L.renderList drawF True l)
|
||||||
|
, str " "
|
||||||
|
, C.hCenter $ str "Select "
|
||||||
|
]
|
||||||
listAddressBox ::
|
listAddressBox ::
|
||||||
String -> L.List Name (Entity WalletAddress) -> Widget Name
|
String -> L.List Name (Entity WalletAddress) -> Widget Name
|
||||||
listAddressBox titleLabel a =
|
listAddressBox titleLabel a =
|
||||||
|
@ -149,10 +172,6 @@ drawUI s = [splashDialog s, helpDialog s, inputDialog s, ui s]
|
||||||
, str " "
|
, str " "
|
||||||
, C.hCenter $ str "Use arrows to select"
|
, C.hCenter $ str "Use arrows to select"
|
||||||
]
|
]
|
||||||
msgBox :: String -> Widget Name
|
|
||||||
msgBox m =
|
|
||||||
vBox
|
|
||||||
[B.hBorderWithLabel (str "Messages"), hLimit 70 $ padRight Max $ str m]
|
|
||||||
helpDialog :: State -> Widget Name
|
helpDialog :: State -> Widget Name
|
||||||
helpDialog st =
|
helpDialog st =
|
||||||
if st ^. helpBox
|
if st ^. helpBox
|
||||||
|
@ -162,11 +181,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
|
||||||
|
@ -182,6 +207,14 @@ drawUI s = [splashDialog s, helpDialog s, inputDialog s, ui s]
|
||||||
D.renderDialog
|
D.renderDialog
|
||||||
(D.dialog (Just (str "Create Address")) Nothing 50)
|
(D.dialog (Just (str "Create Address")) Nothing 50)
|
||||||
(renderForm $ st ^. inputForm)
|
(renderForm $ st ^. inputForm)
|
||||||
|
WSelect ->
|
||||||
|
D.renderDialog
|
||||||
|
(D.dialog (Just (str "Select Wallet")) Nothing 50)
|
||||||
|
(selectListBox "Wallets" (st ^. wallets) listDrawWallet)
|
||||||
|
ASelect ->
|
||||||
|
D.renderDialog
|
||||||
|
(D.dialog (Just (str "Select Account")) Nothing 50)
|
||||||
|
(selectListBox "Accounts" (st ^. accounts) listDrawAccount)
|
||||||
Blank -> emptyWidget
|
Blank -> emptyWidget
|
||||||
splashDialog :: State -> Widget Name
|
splashDialog :: State -> Widget Name
|
||||||
splashDialog st =
|
splashDialog st =
|
||||||
|
@ -196,6 +229,28 @@ drawUI s = [splashDialog s, helpDialog s, inputDialog s, ui s]
|
||||||
C.hCenter (withAttr titleAttr (str "Zcash Wallet v0.4.3.0")) <=>
|
C.hCenter (withAttr titleAttr (str "Zcash Wallet v0.4.3.0")) <=>
|
||||||
C.hCenter (withAttr blinkAttr $ str "Press any key..."))
|
C.hCenter (withAttr blinkAttr $ str "Press any key..."))
|
||||||
else emptyWidget
|
else emptyWidget
|
||||||
|
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 $
|
||||||
|
txtWrap $
|
||||||
|
encodeUnifiedAddress $ walletAddressUAddress $ entityVal a)
|
||||||
|
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 =
|
||||||
|
@ -262,66 +317,104 @@ 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
|
BlankDisplay -> do
|
||||||
V.EvKey V.KEnter [] -> do
|
case s ^. dialogBox of
|
||||||
fs <- BT.zoom inputForm $ BT.gets formState
|
WName -> do
|
||||||
nw <- liftIO $ addNewWallet (fs ^. dialogInput) s
|
case e of
|
||||||
BT.put nw
|
V.EvKey V.KEsc [] -> BT.modify $ set dialogBox Blank
|
||||||
aL <- use accounts
|
V.EvKey V.KEnter [] -> do
|
||||||
BT.modify $
|
fs <- BT.zoom inputForm $ BT.gets formState
|
||||||
set dialogBox $
|
nw <- liftIO $ addNewWallet (fs ^. dialogInput) s
|
||||||
if not (null $ L.listElements aL)
|
ns <- liftIO $ refreshWallet nw
|
||||||
then Blank
|
BT.put ns
|
||||||
else AName
|
aL <- use accounts
|
||||||
ev -> BT.zoom inputForm $ handleFormEvent (BT.VtyEvent ev)
|
BT.modify $ set displayBox MsgDisplay
|
||||||
AName -> do
|
BT.modify $
|
||||||
case e of
|
set dialogBox $
|
||||||
V.EvKey V.KEsc [] -> BT.modify $ set dialogBox Blank
|
if not (null $ L.listElements aL)
|
||||||
V.EvKey V.KEnter [] -> do
|
then Blank
|
||||||
fs <- BT.zoom inputForm $ BT.gets formState
|
else AName
|
||||||
na <- liftIO $ addNewAccount (fs ^. dialogInput) s
|
ev ->
|
||||||
BT.put na
|
BT.zoom inputForm $ handleFormEvent (BT.VtyEvent ev)
|
||||||
addrL <- use addresses
|
AName -> do
|
||||||
BT.modify $
|
case e of
|
||||||
set dialogBox $
|
V.EvKey V.KEsc [] -> BT.modify $ set dialogBox Blank
|
||||||
if not (null $ L.listElements addrL)
|
V.EvKey V.KEnter [] -> do
|
||||||
then Blank
|
fs <- BT.zoom inputForm $ BT.gets formState
|
||||||
else AdName
|
na <- liftIO $ addNewAccount (fs ^. dialogInput) s
|
||||||
ev -> BT.zoom inputForm $ handleFormEvent (BT.VtyEvent ev)
|
ns <- liftIO $ refreshAccount na
|
||||||
AdName -> do
|
BT.put ns
|
||||||
case e of
|
addrL <- use addresses
|
||||||
V.EvKey V.KEsc [] -> BT.modify $ set dialogBox Blank
|
BT.modify $ set displayBox MsgDisplay
|
||||||
V.EvKey V.KEnter [] -> do
|
BT.modify $
|
||||||
fs <- BT.zoom inputForm $ BT.gets formState
|
set dialogBox $
|
||||||
nAddr <- liftIO $ addNewAddress (fs ^. dialogInput) s
|
if not (null $ L.listElements addrL)
|
||||||
BT.put nAddr
|
then Blank
|
||||||
BT.modify $ set dialogBox Blank
|
else AdName
|
||||||
ev -> BT.zoom inputForm $ handleFormEvent (BT.VtyEvent ev)
|
ev ->
|
||||||
Blank -> do
|
BT.zoom inputForm $ handleFormEvent (BT.VtyEvent ev)
|
||||||
case e of
|
AdName -> do
|
||||||
V.EvKey (V.KChar '\t') [] -> focusRing %= F.focusNext
|
case e of
|
||||||
V.EvKey (V.KChar 'q') [] -> M.halt
|
V.EvKey V.KEsc [] -> BT.modify $ set dialogBox Blank
|
||||||
V.EvKey (V.KChar '?') [] -> BT.modify $ set helpBox True
|
V.EvKey V.KEnter [] -> do
|
||||||
V.EvKey (V.KChar 'w') [] -> do
|
fs <- BT.zoom inputForm $ BT.gets formState
|
||||||
BT.modify $
|
nAddr <- liftIO $ addNewAddress (fs ^. dialogInput) s
|
||||||
set inputForm $
|
BT.put nAddr
|
||||||
updateFormState (DialogInput "New Wallet") $
|
BT.modify $ set displayBox MsgDisplay
|
||||||
s ^. inputForm
|
BT.modify $ set dialogBox Blank
|
||||||
BT.modify $ set dialogBox WName
|
ev ->
|
||||||
V.EvKey (V.KChar 'a') [] -> do
|
BT.zoom inputForm $ handleFormEvent (BT.VtyEvent ev)
|
||||||
BT.modify $
|
WSelect -> do
|
||||||
set inputForm $
|
case e of
|
||||||
updateFormState (DialogInput "New Account") $
|
V.EvKey V.KEsc [] -> BT.modify $ set dialogBox Blank
|
||||||
s ^. inputForm
|
V.EvKey V.KEnter [] -> do
|
||||||
BT.modify $ set dialogBox AName
|
ns <- liftIO $ refreshWallet s
|
||||||
ev ->
|
BT.put ns
|
||||||
case r of
|
BT.modify $ set dialogBox Blank
|
||||||
Just AList -> BT.zoom addresses $ L.handleListEvent ev
|
V.EvKey (V.KChar 'c') [] -> do
|
||||||
Just TList -> BT.zoom transactions $ L.handleListEvent ev
|
BT.modify $
|
||||||
_anyName -> return ()
|
set inputForm $
|
||||||
|
updateFormState (DialogInput "New Wallet") $
|
||||||
|
s ^. inputForm
|
||||||
|
BT.modify $ set dialogBox WName
|
||||||
|
ev -> BT.zoom wallets $ L.handleListEvent ev
|
||||||
|
ASelect -> do
|
||||||
|
case e of
|
||||||
|
V.EvKey V.KEsc [] -> 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 'c') [] -> 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
|
||||||
|
@ -389,11 +482,34 @@ 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
|
||||||
|
@ -440,6 +556,23 @@ addNewAccount n s = do
|
||||||
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 -> State -> IO State
|
addNewAddress :: T.Text -> State -> IO State
|
||||||
addNewAddress n s = do
|
addNewAddress n s = do
|
||||||
selAccount <-
|
selAccount <-
|
||||||
|
@ -452,26 +585,23 @@ addNewAddress n s = do
|
||||||
Just (_j, a1) -> return a1
|
Just (_j, a1) -> return a1
|
||||||
Just (_k, a) -> return a
|
Just (_k, a) -> return a
|
||||||
maxAddr <- getMaxAddress (s ^. dbPath) (entityKey selAccount)
|
maxAddr <- getMaxAddress (s ^. dbPath) (entityKey selAccount)
|
||||||
nAddr <-
|
uA <-
|
||||||
saveAddress (s ^. dbPath) $
|
try $ createWalletAddress n (maxAddr + 1) (s ^. network) selAccount :: IO
|
||||||
WalletAddress
|
(Either IOError WalletAddress)
|
||||||
(maxAddr + 1)
|
case uA of
|
||||||
(entityKey selAccount)
|
Left e -> return $ s & msg .~ ("Error: " ++ show e)
|
||||||
n
|
Right uA' -> do
|
||||||
(UnifiedAddress
|
nAddr <- saveAddress (s ^. dbPath) uA'
|
||||||
MainNet
|
case nAddr of
|
||||||
"fakeBstring"
|
Nothing ->
|
||||||
"fakeBString"
|
return $ s & msg .~ ("Address already exists: " ++ T.unpack n)
|
||||||
(Just $ TransparentAddress P2PKH MainNet "fakeBString"))
|
Just x -> do
|
||||||
case nAddr of
|
addrL <- getAddresses (s ^. dbPath) (entityKey selAccount)
|
||||||
Nothing -> return $ s & msg .~ ("Address already exists: " ++ T.unpack n)
|
let nL =
|
||||||
Just x -> do
|
L.listMoveToElement x $
|
||||||
addrL <- getAddresses (s ^. dbPath) (entityKey selAccount)
|
L.listReplace (Vec.fromList addrL) (Just 0) (s ^. addresses)
|
||||||
let nL =
|
return $
|
||||||
L.listMoveToElement x $
|
(s & addresses .~ nL) & msg .~ "Created new address: " ++
|
||||||
L.listReplace (Vec.fromList addrL) (Just 0) (s ^. addresses)
|
T.unpack n ++
|
||||||
return $
|
"(" ++
|
||||||
(s & addresses .~ nL) & msg .~ "Created new address: " ++
|
T.unpack (showAddress $ walletAddressUAddress $ entityVal x) ++ ")"
|
||||||
T.unpack n ++
|
|
||||||
"(" ++
|
|
||||||
T.unpack (showAddress $ walletAddressUAddress $ entityVal x) ++ ")"
|
|
||||||
|
|
|
@ -33,7 +33,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 ::
|
||||||
|
@ -71,3 +71,23 @@ createZcashAccount ::
|
||||||
createZcashAccount n i zw = do
|
createZcashAccount n i zw = do
|
||||||
orSk <- createOrchardSpendingKey (entityVal zw) i
|
orSk <- createOrchardSpendingKey (entityVal zw) i
|
||||||
return $ ZcashAccount i (entityKey zw) n orSk "fakeSapKey" "fakeTkey"
|
return $ ZcashAccount i (entityKey zw) n orSk "fakeSapKey" "fakeTkey"
|
||||||
|
|
||||||
|
-- * Addresses
|
||||||
|
-- | Create a unified address for the given account and index
|
||||||
|
createWalletAddress ::
|
||||||
|
T.Text -- ^ The address nickname
|
||||||
|
-> Int -- ^ The address' index
|
||||||
|
-> ZcashNet -- ^ The network for this address
|
||||||
|
-> Entity ZcashAccount -- ^ The Zcash account that the address will be attached to
|
||||||
|
-> IO WalletAddress
|
||||||
|
createWalletAddress n i zNet za = do
|
||||||
|
return $
|
||||||
|
WalletAddress
|
||||||
|
i
|
||||||
|
(entityKey za)
|
||||||
|
n
|
||||||
|
(UnifiedAddress
|
||||||
|
zNet
|
||||||
|
"fakeBString"
|
||||||
|
"fakeBString"
|
||||||
|
(Just $ TransparentAddress P2PKH zNet "fakeBString"))
|
||||||
|
|
Loading…
Reference in a new issue