zenith/src/Zenith/CLI.hs

1282 lines
46 KiB
Haskell
Raw Normal View History

{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
2024-02-08 19:26:54 +00:00
module Zenith.CLI where
import qualified Brick.AttrMap as A
2024-05-03 12:10:08 +00:00
import qualified Brick.BChan as BC
2024-02-14 18:03:18 +00:00
import qualified Brick.Focus as F
2024-02-19 20:05:32 +00:00
import Brick.Forms
( Form(..)
, (@@=)
2024-05-09 15:44:07 +00:00
, allFieldsValid
, editShowableFieldWithValidate
2024-02-19 20:05:32 +00:00
, editTextField
, focusedFormInputAttr
, handleFormEvent
2024-05-09 15:44:07 +00:00
, invalidFormInputAttr
2024-02-19 20:05:32 +00:00
, newForm
, renderForm
2024-05-09 15:44:07 +00:00
, setFieldValid
2024-02-27 17:17:36 +00:00
, updateFormState
2024-02-19 20:05:32 +00:00
)
import qualified Brick.Main as M
import qualified Brick.Types as BT
import Brick.Types (Widget)
2024-05-03 12:10:08 +00:00
import Brick.Util (bg, clamp, fg, on, style)
import qualified Brick.Widgets.Border as B
2024-02-14 18:03:18 +00:00
import Brick.Widgets.Border.Style (unicode, unicodeBold)
import qualified Brick.Widgets.Center as C
import Brick.Widgets.Core
2024-02-11 16:33:22 +00:00
( Padding(..)
, (<+>)
, (<=>)
2024-02-13 20:19:05 +00:00
, emptyWidget
2024-02-14 18:03:18 +00:00
, fill
2024-03-17 19:38:26 +00:00
, hBox
, hLimit
, joinBorders
2024-02-13 20:19:05 +00:00
, padAll
2024-02-14 18:03:18 +00:00
, padBottom
, str
2024-03-07 20:20:06 +00:00
, strWrap
, strWrapWith
2024-02-28 21:12:57 +00:00
, txt
2024-03-17 19:38:26 +00:00
, txtWrap
2024-03-17 12:17:52 +00:00
, txtWrapWith
2024-05-03 12:10:08 +00:00
, updateAttrMap
, vBox
, vLimit
, withAttr
, withBorderStyle
)
2024-02-13 20:19:05 +00:00
import qualified Brick.Widgets.Dialog as D
2024-05-09 15:44:07 +00:00
import qualified Brick.Widgets.Edit as E
import qualified Brick.Widgets.List as L
2024-05-03 12:10:08 +00:00
import qualified Brick.Widgets.ProgressBar as P
import Control.Concurrent (forkIO, threadDelay)
import Control.Exception (catch, throw, throwIO, try)
2024-05-03 12:10:08 +00:00
import Control.Monad (forever, void)
2024-03-17 12:17:52 +00:00
import Control.Monad.IO.Class (liftIO)
2024-05-05 14:49:55 +00:00
import Control.Monad.Logger (LoggingT, runFileLoggingT, runNoLoggingT)
2024-05-03 12:10:08 +00:00
import Data.Aeson
2024-05-09 15:44:07 +00:00
import Data.HexString (toText)
2024-03-17 12:17:52 +00:00
import Data.Maybe
import qualified Data.Text as T
2024-03-17 19:38:26 +00:00
import qualified Data.Text.Encoding as E
2024-04-21 12:07:51 +00:00
import Data.Time.Clock.POSIX (posixSecondsToUTCTime)
import qualified Data.Vector as Vec
2024-02-19 20:05:32 +00:00
import Database.Persist
2024-05-05 14:49:55 +00:00
import Database.Persist.Sqlite
2024-03-17 12:17:52 +00:00
import qualified Graphics.Vty as V
2024-05-03 12:10:08 +00:00
import qualified Graphics.Vty.CrossPlatform as VC
2024-03-17 12:17:52 +00:00
import Lens.Micro ((&), (.~), (^.), set)
import Lens.Micro.Mtl
import Lens.Micro.TH
2024-05-05 14:49:55 +00:00
import System.Hclip
2024-03-17 12:17:52 +00:00
import Text.Wrap (FillScope(..), FillStrategy(..), WrapSettings(..), wrapText)
import ZcashHaskell.Keys (generateWalletSeedPhrase, getWalletSeed)
2024-04-18 01:28:47 +00:00
import ZcashHaskell.Orchard (getSaplingFromUA, isValidUnifiedAddress)
2024-05-09 15:44:07 +00:00
import ZcashHaskell.Sapling (decodeSaplingAddress, isValidShieldedAddress)
import ZcashHaskell.Transparent
( decodeExchangeAddress
, decodeTransparentAddress
, encodeTransparentReceiver
)
import ZcashHaskell.Types
2024-05-03 12:10:08 +00:00
import ZcashHaskell.Utils (getBlockTime, makeZebraCall)
import Zenith.Core
2024-02-19 20:05:32 +00:00
import Zenith.DB
2024-05-03 12:10:08 +00:00
import Zenith.Scanner (processTx)
2024-04-18 01:28:47 +00:00
import Zenith.Types
( Config(..)
, PhraseDB(..)
, UnifiedAddressDB(..)
, ZcashNetDB(..)
)
2024-05-03 12:10:08 +00:00
import Zenith.Utils (displayTaz, displayZec, jsonNumber, showAddress)
data Name
= WList
| AList
2024-02-29 21:02:58 +00:00
| AcList
| TList
2024-02-13 20:19:05 +00:00
| HelpDialog
2024-02-27 15:44:17 +00:00
| DialogInputField
2024-05-09 15:44:07 +00:00
| RecField
| AmtField
| MemoField
deriving (Eq, Show, Ord)
2024-02-27 15:44:17 +00:00
data DialogInput = DialogInput
{ _dialogInput :: !T.Text
2024-02-14 18:03:18 +00:00
} deriving (Show)
2024-02-27 15:44:17 +00:00
makeLenses ''DialogInput
2024-05-09 15:44:07 +00:00
data SendInput = SendInput
{ _sendTo :: !T.Text
, _sendAmt :: !Float
, _sendMemo :: !T.Text
} deriving (Show)
makeLenses ''SendInput
2024-02-27 15:44:17 +00:00
data DialogType
= WName
| AName
2024-03-05 18:34:30 +00:00
| AdName
2024-03-07 20:20:06 +00:00
| WSelect
| ASelect
2024-05-09 15:44:07 +00:00
| SendTx
2024-02-27 15:44:17 +00:00
| Blank
2024-02-14 18:03:18 +00:00
2024-03-07 20:20:06 +00:00
data DisplayType
= AddrDisplay
| MsgDisplay
2024-03-17 19:38:26 +00:00
| PhraseDisplay
2024-04-21 12:07:51 +00:00
| TxDisplay
2024-05-03 12:10:08 +00:00
| SyncDisplay
2024-05-09 15:44:07 +00:00
| SendDisplay
2024-03-07 20:20:06 +00:00
| BlankDisplay
2024-05-05 14:49:55 +00:00
data Tick
= TickVal !Float
| TickMsg !String
2024-05-03 12:10:08 +00:00
data State = State
{ _network :: !ZcashNet
2024-02-19 20:05:32 +00:00
, _wallets :: !(L.List Name (Entity ZcashWallet))
2024-02-29 21:02:58 +00:00
, _accounts :: !(L.List Name (Entity ZcashAccount))
2024-03-05 18:34:30 +00:00
, _addresses :: !(L.List Name (Entity WalletAddress))
2024-04-24 12:42:35 +00:00
, _transactions :: !(L.List Name (Entity UserTx))
2024-02-11 16:33:22 +00:00
, _msg :: !String
2024-02-13 20:19:05 +00:00
, _helpBox :: !Bool
2024-02-27 15:44:17 +00:00
, _dialogBox :: !DialogType
2024-02-14 18:03:18 +00:00
, _splashBox :: !Bool
2024-02-27 15:44:17 +00:00
, _inputForm :: !(Form DialogInput () Name)
2024-02-14 18:03:18 +00:00
, _focusRing :: !(F.FocusRing Name)
2024-02-28 21:12:57 +00:00
, _startBlock :: !Int
, _dbPath :: !T.Text
2024-05-03 12:10:08 +00:00
, _zebraHost :: !T.Text
, _zebraPort :: !Int
2024-03-07 20:20:06 +00:00
, _displayBox :: !DisplayType
2024-04-21 12:07:51 +00:00
, _syncBlock :: !Int
2024-04-24 13:58:45 +00:00
, _balance :: !Integer
2024-05-03 12:10:08 +00:00
, _barValue :: !Float
, _eventDispatch :: !(BC.BChan Tick)
2024-05-05 14:49:55 +00:00
, _timer :: !Int
2024-05-09 15:44:07 +00:00
, _txForm :: !(Form SendInput () Name)
2024-02-14 18:03:18 +00:00
}
makeLenses ''State
drawUI :: State -> [Widget Name]
2024-03-07 20:20:06 +00:00
drawUI s = [splashDialog s, helpDialog s, displayDialog s, inputDialog s, ui s]
where
ui :: State -> Widget Name
2024-02-27 14:41:43 +00:00
ui st =
joinBorders $
withBorderStyle unicode $
2024-02-28 21:12:57 +00:00
B.borderWithLabel
(str
("Zenith - " <>
show (st ^. network) <>
2024-02-28 21:12:57 +00:00
" - " <>
T.unpack
(maybe
"(None)"
(\(_, w) -> zcashWalletName $ entityVal w)
2024-03-07 20:20:06 +00:00
(L.listSelectedElement (st ^. wallets)))))
(C.hCenter
(str
("Account: " ++
T.unpack
(maybe
"(None)"
(\(_, a) -> zcashAccountName $ entityVal a)
(L.listSelectedElement (st ^. accounts))))) <=>
2024-04-24 13:58:45 +00:00
C.hCenter
(str
("Balance: " ++
if st ^. network == MainNet
then displayZec (st ^. balance)
else displayTaz (st ^. balance))) <=>
2024-03-07 20:20:06 +00:00
listAddressBox "Addresses" (st ^. addresses) <+>
2024-04-21 12:07:51 +00:00
B.vBorder <+>
(C.hCenter (str ("Last block seen: " ++ show (st ^. syncBlock))) <=>
2024-05-09 15:44:07 +00:00
listTxBox "Transactions" (st ^. network) (st ^. transactions))) <=>
2024-03-17 19:38:26 +00:00
C.hCenter
(hBox
[ capCommand "W" "allets"
, capCommand "A" "ccounts"
, capCommand "V" "iew address"
, capCommand "Q" "uit"
2024-05-05 14:49:55 +00:00
, str $ show (st ^. timer)
2024-03-17 19:38:26 +00:00
])
2024-03-05 18:34:30 +00:00
listBox :: Show e => String -> L.List Name e -> Widget Name
listBox titleLabel l =
C.vCenter $
vBox
[ C.hCenter
(B.borderWithLabel (str titleLabel) $
hLimit 25 $ vLimit 15 $ L.renderList listDrawElement True l)
, str " "
, C.hCenter $ str "Select "
]
2024-03-07 20:20:06 +00:00
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 " "
]
2024-03-05 18:34:30 +00:00
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 " "
2024-05-05 14:49:55 +00:00
, C.hCenter
(hBox
[ capCommand "↑↓ " "move"
, capCommand "" "select"
, capCommand "Tab " "->"
])
2024-03-05 18:34:30 +00:00
]
2024-05-09 15:44:07 +00:00
listTxBox ::
String -> ZcashNet -> L.List Name (Entity UserTx) -> Widget Name
listTxBox titleLabel znet tx =
2024-04-21 12:07:51 +00:00
C.vCenter $
vBox
[ C.hCenter
(B.borderWithLabel (str titleLabel) $
2024-05-09 15:44:07 +00:00
hLimit 50 $ vLimit 15 $ L.renderList (listDrawTx znet) True tx)
2024-04-21 12:07:51 +00:00
, str " "
2024-05-05 14:49:55 +00:00
, C.hCenter
(hBox
[ capCommand "↑↓ " "move"
, capCommand "T" "x Display"
, capCommand "Tab " "<-"
])
2024-04-21 12:07:51 +00:00
]
2024-02-13 20:19:05 +00:00
helpDialog :: State -> Widget Name
2024-02-27 14:41:43 +00:00
helpDialog st =
if st ^. helpBox
2024-02-13 20:19:05 +00:00
then D.renderDialog
2024-02-14 18:03:18 +00:00
(D.dialog (Just (str "Commands")) Nothing 55)
2024-02-13 20:19:05 +00:00
(vBox ([C.hCenter $ str "Key", B.hBorder] <> keyList) <+>
vBox ([str "Actions", B.hBorder] <> actionList))
else emptyWidget
where
2024-03-07 20:20:06 +00:00
keyList = map (C.hCenter . str) ["?", "Esc", "w", "a", "v", "q"]
2024-02-14 18:03:18 +00:00
actionList =
map
(hLimit 40 . str)
2024-03-07 20:20:06 +00:00
[ "Open help"
, "Close dialog"
, "Switch wallets"
, "Switch accounts"
, "View address"
, "Quit"
]
2024-02-27 15:44:17 +00:00
inputDialog :: State -> Widget Name
inputDialog st =
case st ^. dialogBox of
WName ->
D.renderDialog
(D.dialog (Just (str "Create Wallet")) Nothing 50)
(renderForm $ st ^. inputForm)
AName ->
D.renderDialog
(D.dialog (Just (str "Create Account")) Nothing 50)
(renderForm $ st ^. inputForm)
2024-03-05 18:34:30 +00:00
AdName ->
D.renderDialog
(D.dialog (Just (str "Create Address")) Nothing 50)
(renderForm $ st ^. inputForm)
2024-03-07 20:20:06 +00:00
WSelect ->
D.renderDialog
(D.dialog (Just (str "Select Wallet")) Nothing 50)
2024-03-17 19:38:26 +00:00
(selectListBox "Wallets" (st ^. wallets) listDrawWallet <=>
C.hCenter
(hBox
[ capCommand "↑↓ " "move"
, capCommand "" "select"
, capCommand "N" "ew"
, capCommand "S" "how phrase"
, xCommand
]))
2024-03-07 20:20:06 +00:00
ASelect ->
D.renderDialog
(D.dialog (Just (str "Select Account")) Nothing 50)
2024-03-17 19:38:26 +00:00
(selectListBox "Accounts" (st ^. accounts) listDrawAccount <=>
C.hCenter
(hBox
[ capCommand "↑↓ " "move"
, capCommand "" "select"
, capCommand "N" "ew"
, xCommand
]))
2024-05-09 15:44:07 +00:00
SendTx ->
D.renderDialog
(D.dialog (Just (str "Send Transaction")) Nothing 50)
(renderForm (st ^. txForm) <=>
C.hCenter
(hBox [capCommand "" "Send", capCommand "<esc> " "Cancel"]))
2024-02-27 15:44:17 +00:00
Blank -> emptyWidget
2024-02-14 18:03:18 +00:00
splashDialog :: State -> Widget Name
2024-02-27 14:41:43 +00:00
splashDialog st =
if st ^. splashBox
2024-02-14 18:03:18 +00:00
then withBorderStyle unicodeBold $
D.renderDialog
(D.dialog Nothing Nothing 30)
(withAttr
titleAttr
(str
" _____ _ _ _ \n|__ /___ _ __ (_) |_| |__\n / // _ \\ '_ \\| | __| '_ \\\n / /| __/ | | | | |_| | | |\n/____\\___|_| |_|_|\\__|_| |_|") <=>
2024-05-09 19:09:35 +00:00
C.hCenter
(withAttr titleAttr (str "Zcash Wallet v0.5.1.0-beta")) <=>
2024-02-14 18:03:18 +00:00
C.hCenter (withAttr blinkAttr $ str "Press any key..."))
else emptyWidget
2024-03-17 19:38:26 +00:00
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"]
2024-03-07 20:20:06 +00:00
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 $
B.borderWithLabel
(str "Unified")
(txtWrapWith (WrapSettings False True NoFill FillAfterFirst) $
getUA $ walletAddressUAddress $ entityVal a) <=>
B.borderWithLabel
(str "Legacy Shielded")
2024-04-18 01:28:47 +00:00
(txtWrapWith (WrapSettings False True NoFill FillAfterFirst) $
fromMaybe "None" $
(getSaplingFromUA .
E.encodeUtf8 . getUA . walletAddressUAddress)
(entityVal a)) <=>
B.borderWithLabel
(str "Transparent")
(txtWrapWith (WrapSettings False True NoFill FillAfterFirst) $
2024-04-18 01:28:47 +00:00
maybe "None" (encodeTransparentReceiver (st ^. network)) $
t_rec =<<
(isValidUnifiedAddress .
E.encodeUtf8 . getUA . walletAddressUAddress)
2024-05-05 14:49:55 +00:00
(entityVal a)) <=>
C.hCenter
(hBox
[ str "Copy: "
, capCommand "U" "nified"
, capCommand "S" "apling"
, capCommand "T" "ransparent"
]) <=>
C.hCenter xCommand)
2024-03-07 20:20:06 +00:00
Nothing -> emptyWidget
2024-03-17 19:38:26 +00:00
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
2024-03-07 20:20:06 +00:00
MsgDisplay ->
withBorderStyle unicodeBold $
D.renderDialog
(D.dialog (Just $ txt "Message") Nothing 50)
(padAll 1 $ strWrap $ st ^. msg)
2024-04-21 12:07:51 +00:00
TxDisplay ->
case L.listSelectedElement $ st ^. transactions of
Nothing -> emptyWidget
Just (_, tx) ->
withBorderStyle unicodeBold $
D.renderDialog
(D.dialog (Just $ txt "Transaction") Nothing 50)
(padAll
1
(str
("Date: " ++
2024-04-24 12:42:35 +00:00
show
(posixSecondsToUTCTime
(fromIntegral (userTxTime $ entityVal tx)))) <=>
(str "Tx ID: " <+>
strWrapWith
(WrapSettings False True NoFill FillAfterFirst)
(show (userTxHex $ entityVal tx))) <=>
2024-04-21 12:07:51 +00:00
str
("Amount: " ++
if st ^. network == MainNet
2024-04-24 12:42:35 +00:00
then displayZec
(fromIntegral $ userTxAmount $ entityVal tx)
else displayTaz
(fromIntegral $ userTxAmount $ entityVal tx)) <=>
(txt "Memo: " <+>
txtWrapWith
(WrapSettings False True NoFill FillAfterFirst)
(userTxMemo (entityVal tx)))))
2024-05-03 12:10:08 +00:00
SyncDisplay ->
withBorderStyle unicodeBold $
D.renderDialog
(D.dialog (Just $ txt "Sync") Nothing 50)
(padAll
1
(updateAttrMap
(A.mapAttrNames
[ (barDoneAttr, P.progressCompleteAttr)
, (barToDoAttr, P.progressIncompleteAttr)
])
(P.progressBar
(Just $ show (st ^. barValue * 100))
(_barValue st))))
2024-05-09 15:44:07 +00:00
SendDisplay ->
withBorderStyle unicodeBold $
D.renderDialog
(D.dialog (Just $ txt "Sending Transaction") Nothing 50)
(padAll 1 (str $ st ^. msg))
2024-03-07 20:20:06 +00:00
BlankDisplay -> emptyWidget
2024-02-14 18:03:18 +00:00
2024-02-27 15:44:17 +00:00
mkInputForm :: DialogInput -> Form DialogInput e Name
mkInputForm =
newForm
[label "Name: " @@= editTextField dialogInput DialogInputField (Just 1)]
2024-02-14 18:03:18 +00:00
where
label s w =
padBottom (Pad 1) $ vLimit 1 (hLimit 15 $ str s <+> fill ' ') <+> w
2024-05-09 15:44:07 +00:00
mkSendForm :: Integer -> SendInput -> Form SendInput e Name
mkSendForm bal =
newForm
[ label "To: " @@= editTextField sendTo RecField (Just 1)
, label "Amount: " @@=
editShowableFieldWithValidate sendAmt AmtField (isAmountValid bal)
, label "Memo: " @@= editTextField sendMemo MemoField (Just 1)
]
where
isAmountValid :: Integer -> Float -> Bool
isAmountValid b i = (fromIntegral b * 100000000.0) >= i
label s w =
padBottom (Pad 1) $ vLimit 1 (hLimit 15 $ str s <+> fill ' ') <+> w
isRecipientValid :: T.Text -> Bool
isRecipientValid a =
case isValidUnifiedAddress (E.encodeUtf8 a) of
Just _a1 -> True
Nothing ->
isValidShieldedAddress (E.encodeUtf8 a) ||
(case decodeTransparentAddress (E.encodeUtf8 a) of
Just _a3 -> True
Nothing ->
case decodeExchangeAddress a of
Just _a4 -> True
Nothing -> False)
listDrawElement :: (Show a) => Bool -> a -> Widget Name
listDrawElement sel a =
let selStr s =
if sel
then withAttr customAttr (str $ "<" <> s <> ">")
else str s
in C.hCenter $ selStr $ show a
2024-03-05 18:34:30 +00:00
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))
2024-05-09 15:44:07 +00:00
listDrawTx :: ZcashNet -> Bool -> Entity UserTx -> Widget Name
listDrawTx znet sel tx =
2024-04-21 12:07:51 +00:00
selStr $
2024-04-24 12:42:35 +00:00
T.pack
(show $ posixSecondsToUTCTime (fromIntegral (userTxTime $ entityVal tx))) <>
2024-05-09 15:44:07 +00:00
" " <> T.pack fmtAmt
2024-04-21 12:07:51 +00:00
where
2024-05-09 15:44:07 +00:00
amt = fromIntegral $ userTxAmount $ entityVal tx
dispAmount =
if znet == MainNet
then displayZec amt
else displayTaz amt
2024-04-21 12:07:51 +00:00
fmtAmt =
if amt > 0
2024-05-09 15:44:07 +00:00
then "" <> dispAmount <> " "
else " " <> dispAmount <> ""
2024-04-21 12:07:51 +00:00
selStr s =
if sel
then withAttr customAttr (txt $ "> " <> s)
else txt $ " " <> s
customAttr :: A.AttrName
customAttr = L.listSelectedAttr <> A.attrName "custom"
2024-02-14 18:03:18 +00:00
titleAttr :: A.AttrName
titleAttr = A.attrName "title"
blinkAttr :: A.AttrName
blinkAttr = A.attrName "blink"
2024-05-03 12:10:08 +00:00
baseAttr :: A.AttrName
baseAttr = A.attrName "base"
barDoneAttr :: A.AttrName
barDoneAttr = A.attrName "done"
barToDoAttr :: A.AttrName
barToDoAttr = A.attrName "remaining"
validBarValue :: Float -> Float
validBarValue = clamp 0 1
2024-05-05 14:49:55 +00:00
scanZebra :: T.Text -> T.Text -> Int -> Int -> BC.BChan Tick -> IO ()
scanZebra dbP zHost zPort b eChan = do
_ <- liftIO $ initDb dbP
bStatus <- liftIO $ checkBlockChain zHost zPort
pool <- runNoLoggingT $ initPool dbP
dbBlock <- runNoLoggingT $ getMaxBlock pool
2024-05-03 12:10:08 +00:00
let sb = max dbBlock b
if sb > zgb_blocks bStatus || sb < 1
then do
2024-05-05 14:49:55 +00:00
liftIO $ BC.writeBChan eChan $ TickMsg "Invalid starting block for scan"
2024-05-03 12:10:08 +00:00
else do
let bList = [(sb + 1) .. (zgb_blocks bStatus)]
let step = (1.0 :: Float) / fromIntegral (zgb_blocks bStatus - (sb + 1))
2024-05-05 14:49:55 +00:00
mapM_ (processBlock pool step) bList
2024-05-03 12:10:08 +00:00
where
2024-05-05 14:49:55 +00:00
processBlock :: ConnectionPool -> Float -> Int -> IO ()
processBlock pool step bl = do
2024-05-03 12:10:08 +00:00
r <-
liftIO $
makeZebraCall
2024-05-05 14:49:55 +00:00
zHost
zPort
2024-05-03 12:10:08 +00:00
"getblock"
[Data.Aeson.String $ T.pack $ show bl, jsonNumber 1]
case r of
Left e1 -> do
2024-05-05 14:49:55 +00:00
liftIO $ BC.writeBChan eChan $ TickMsg e1
2024-05-03 12:10:08 +00:00
Right blk -> do
r2 <-
liftIO $
makeZebraCall
2024-05-05 14:49:55 +00:00
zHost
zPort
2024-05-03 12:10:08 +00:00
"getblock"
[Data.Aeson.String $ T.pack $ show bl, jsonNumber 0]
case r2 of
Left e2 -> do
2024-05-05 14:49:55 +00:00
liftIO $ BC.writeBChan eChan $ TickMsg e2
2024-05-03 12:10:08 +00:00
Right hb -> do
let blockTime = getBlockTime hb
2024-05-05 14:49:55 +00:00
mapM_ (runNoLoggingT . processTx zHost zPort blockTime pool) $
2024-05-03 12:10:08 +00:00
bl_txs $ addTime blk blockTime
2024-05-05 14:49:55 +00:00
liftIO $ BC.writeBChan eChan $ TickVal step
2024-05-03 12:10:08 +00:00
addTime :: BlockResponse -> Int -> BlockResponse
addTime bl t =
BlockResponse
(bl_confirmations bl)
(bl_height bl)
(fromIntegral t)
(bl_txs bl)
appEvent :: BT.BrickEvent Name Tick -> BT.EventM Name State ()
2024-05-05 14:49:55 +00:00
appEvent (BT.AppEvent t) = do
2024-05-03 12:10:08 +00:00
s <- BT.get
2024-05-05 14:49:55 +00:00
pool <- liftIO $ runNoLoggingT $ initPool $ s ^. dbPath
case t of
TickMsg m -> do
2024-05-09 15:44:07 +00:00
case s ^. displayBox of
AddrDisplay -> return ()
MsgDisplay -> return ()
PhraseDisplay -> return ()
TxDisplay -> return ()
SyncDisplay -> return ()
SendDisplay -> do
BT.modify $ set msg m
BlankDisplay -> return ()
2024-05-05 14:49:55 +00:00
TickVal v -> do
case s ^. displayBox of
AddrDisplay -> return ()
MsgDisplay -> return ()
PhraseDisplay -> return ()
TxDisplay -> return ()
2024-05-09 15:44:07 +00:00
SendDisplay -> return ()
2024-05-05 14:49:55 +00:00
SyncDisplay -> do
if s ^. barValue == 1.0
then 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
_ <-
liftIO $
syncWallet
(Config (s ^. dbPath) (s ^. zebraHost) (s ^. zebraPort))
selWallet
BT.modify $ set displayBox BlankDisplay
BT.modify $ set barValue 0.0
updatedState <- BT.get
ns <- liftIO $ refreshWallet updatedState
BT.put ns
else BT.modify $ set barValue $ validBarValue (v + s ^. barValue)
BlankDisplay -> do
case s ^. dialogBox of
AName -> return ()
AdName -> return ()
WName -> return ()
WSelect -> return ()
ASelect -> return ()
2024-05-09 15:44:07 +00:00
SendTx -> return ()
2024-05-05 14:49:55 +00:00
Blank -> do
if s ^. timer == 90
then do
BT.modify $ set barValue 0.0
BT.modify $ set displayBox SyncDisplay
sBlock <- liftIO $ getMinBirthdayHeight pool
_ <-
liftIO $
forkIO $
scanZebra
(s ^. dbPath)
(s ^. zebraHost)
(s ^. zebraPort)
sBlock
(s ^. eventDispatch)
BT.modify $ set timer 0
return ()
else do
BT.modify $ set timer $ 1 + s ^. timer
2024-02-14 18:03:18 +00:00
appEvent (BT.VtyEvent e) = do
r <- F.focusGetCurrent <$> use focusRing
s <- BT.get
if s ^. splashBox
then BT.modify $ set splashBox False
else if s ^. helpBox
then do
case e of
V.EvKey V.KEsc [] -> do
BT.modify $ set helpBox False
2024-02-27 14:41:43 +00:00
_ev -> return ()
2024-02-14 18:03:18 +00:00
else do
2024-03-07 20:20:06 +00:00
case s ^. displayBox of
2024-05-05 14:49:55 +00:00
AddrDisplay -> do
case e of
V.EvKey (V.KChar 'x') [] ->
BT.modify $ set displayBox BlankDisplay
V.EvKey (V.KChar 'u') [] -> do
case L.listSelectedElement $ s ^. addresses of
Just (_, a) -> do
liftIO $
setClipboard $
T.unpack $
getUA $ walletAddressUAddress $ entityVal a
2024-05-09 15:44:07 +00:00
BT.modify $
set msg $
"Copied Unified Address <" ++
T.unpack (walletAddressName (entityVal a)) ++ ">!"
BT.modify $ set displayBox MsgDisplay
2024-05-05 14:49:55 +00:00
Nothing -> return ()
V.EvKey (V.KChar 's') [] -> do
case L.listSelectedElement $ s ^. addresses of
Just (_, a) -> do
liftIO $
setClipboard $
maybe "None" T.unpack $
getSaplingFromUA $
E.encodeUtf8 $
getUA $ walletAddressUAddress $ entityVal a
2024-05-09 15:44:07 +00:00
BT.modify $
set msg $
"Copied Sapling Address <" ++
T.unpack (walletAddressName (entityVal a)) ++ ">!"
BT.modify $ set displayBox MsgDisplay
2024-05-05 14:49:55 +00:00
Nothing -> return ()
V.EvKey (V.KChar 't') [] -> do
case L.listSelectedElement $ s ^. addresses of
Just (_, a) -> do
liftIO $
setClipboard $
T.unpack $
maybe
"None"
(encodeTransparentReceiver (s ^. network)) $
t_rec =<<
(isValidUnifiedAddress .
E.encodeUtf8 . getUA . walletAddressUAddress)
(entityVal a)
2024-05-09 15:44:07 +00:00
BT.modify $
set msg $
"Copied Transparent Address <" ++
T.unpack (walletAddressName (entityVal a)) ++ ">!"
BT.modify $ set displayBox MsgDisplay
2024-05-05 14:49:55 +00:00
Nothing -> return ()
_ev -> return ()
2024-03-07 20:20:06 +00:00
MsgDisplay -> BT.modify $ set displayBox BlankDisplay
2024-03-17 19:38:26 +00:00
PhraseDisplay -> BT.modify $ set displayBox BlankDisplay
2024-04-21 12:07:51 +00:00
TxDisplay -> BT.modify $ set displayBox BlankDisplay
2024-05-09 15:44:07 +00:00
SendDisplay -> BT.modify $ set displayBox BlankDisplay
2024-05-05 14:49:55 +00:00
SyncDisplay -> BT.modify $ set displayBox BlankDisplay
2024-03-07 20:20:06 +00:00
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
2024-03-17 12:17:52 +00:00
ns <-
liftIO $
refreshAccount =<<
addNewAddress "Change" Internal =<<
addNewAccount (fs ^. dialogInput) s
2024-03-07 20:20:06 +00:00
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
2024-03-17 12:17:52 +00:00
nAddr <-
liftIO $ addNewAddress (fs ^. dialogInput) External s
2024-03-07 20:20:06 +00:00
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
2024-03-17 19:38:26 +00:00
V.EvKey (V.KChar 'x') [] ->
BT.modify $ set dialogBox Blank
2024-03-07 20:20:06 +00:00
V.EvKey V.KEnter [] -> do
ns <- liftIO $ refreshWallet s
BT.put ns
BT.modify $ set dialogBox Blank
2024-03-17 19:38:26 +00:00
V.EvKey (V.KChar 'n') [] -> do
2024-03-07 20:20:06 +00:00
BT.modify $
set inputForm $
updateFormState (DialogInput "New Wallet") $
s ^. inputForm
BT.modify $ set dialogBox WName
2024-03-17 19:38:26 +00:00
V.EvKey (V.KChar 's') [] ->
BT.modify $ set displayBox PhraseDisplay
2024-03-07 20:20:06 +00:00
ev -> BT.zoom wallets $ L.handleListEvent ev
ASelect -> do
case e of
2024-03-17 19:38:26 +00:00
V.EvKey (V.KChar 'x') [] ->
BT.modify $ set dialogBox Blank
2024-03-07 20:20:06 +00:00
V.EvKey V.KEnter [] -> do
ns <- liftIO $ refreshAccount s
BT.put ns
BT.modify $ set dialogBox Blank
2024-03-17 19:38:26 +00:00
V.EvKey (V.KChar 'n') [] -> do
2024-03-07 20:20:06 +00:00
BT.modify $
set inputForm $
updateFormState (DialogInput "New Account") $
s ^. inputForm
BT.modify $ set dialogBox AName
ev -> BT.zoom accounts $ L.handleListEvent ev
2024-05-09 15:44:07 +00:00
SendTx -> do
case e of
V.EvKey V.KEsc [] -> BT.modify $ set dialogBox Blank
V.EvKey V.KEnter [] -> do
if allFieldsValid (s ^. txForm)
then do
pool <-
liftIO $ runNoLoggingT $ initPool $ s ^. dbPath
selWal <-
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
selAcc <-
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 wallet"
Just (_j, w1) -> return w1
Just (_k, w) -> return w
fs1 <- BT.zoom txForm $ BT.gets formState
bl <-
liftIO $ getLastSyncBlock pool $ entityKey selWal
_ <-
liftIO $
forkIO $
sendTransaction
pool
(s ^. eventDispatch)
(s ^. zebraHost)
(s ^. zebraPort)
(s ^. network)
(entityKey selAcc)
bl
(fs1 ^. sendAmt)
(fs1 ^. sendTo)
(fs1 ^. sendMemo)
BT.modify $ set msg "Preparing transaction..."
BT.modify $ set displayBox SendDisplay
BT.modify $ set dialogBox Blank
else do
BT.modify $ set msg "Invalid inputs"
BT.modify $ set displayBox MsgDisplay
BT.modify $ set dialogBox Blank
ev -> do
BT.zoom txForm $ do
handleFormEvent (BT.VtyEvent ev)
fs <- BT.gets formState
BT.modify $
setFieldValid
(isRecipientValid (fs ^. sendTo))
RecField
2024-03-07 20:20:06 +00:00
Blank -> do
case e of
V.EvKey (V.KChar '\t') [] -> focusRing %= F.focusNext
2024-04-21 12:07:51 +00:00
V.EvKey V.KEnter [] -> do
ns <- liftIO $ refreshTxs s
BT.put ns
2024-03-07 20:20:06 +00:00
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
2024-04-21 12:07:51 +00:00
V.EvKey (V.KChar 't') [] ->
BT.modify $ set displayBox TxDisplay
2024-03-07 20:20:06 +00:00
V.EvKey (V.KChar 'a') [] ->
BT.modify $ set dialogBox ASelect
2024-05-09 15:44:07 +00:00
V.EvKey (V.KChar 's') [] -> do
BT.modify $
set txForm $
mkSendForm (s ^. balance) (SendInput "" 0.0 "")
BT.modify $ set dialogBox SendTx
2024-03-07 20:20:06 +00:00
ev ->
case r of
Just AList ->
BT.zoom addresses $ L.handleListEvent ev
Just TList ->
BT.zoom transactions $ L.handleListEvent ev
_anyName -> return ()
2024-02-11 16:33:22 +00:00
where
printMsg :: String -> BT.EventM Name State ()
printMsg s = BT.modify $ updateMsg s
updateMsg :: String -> State -> State
updateMsg = set msg
2024-02-27 14:41:43 +00:00
appEvent _ = return ()
theMap :: A.AttrMap
theMap =
A.attrMap
V.defAttr
[ (L.listAttr, V.white `on` V.blue)
, (L.listSelectedAttr, V.blue `on` V.white)
2024-02-14 18:03:18 +00:00
, (customAttr, fg V.black)
, (titleAttr, V.withStyle (fg V.brightGreen) V.bold)
, (blinkAttr, style V.blink)
2024-02-19 20:05:32 +00:00
, (focusedFormInputAttr, V.white `on` V.blue)
2024-05-09 15:44:07 +00:00
, (invalidFormInputAttr, V.red `on` V.black)
, (E.editAttr, V.white `on` V.blue)
, (E.editFocusedAttr, V.blue `on` V.white)
2024-05-03 12:10:08 +00:00
, (baseAttr, bg V.brightBlack)
, (barDoneAttr, V.white `on` V.blue)
, (barToDoAttr, V.white `on` V.black)
]
2024-05-03 12:10:08 +00:00
theApp :: M.App State Tick Name
theApp =
M.App
{ M.appDraw = drawUI
, M.appChooseCursor = M.showFirstCursor
, M.appHandleEvent = appEvent
, M.appStartEvent = return ()
, M.appAttrMap = const theMap
}
2024-04-18 01:28:47 +00:00
runZenithCLI :: Config -> IO ()
runZenithCLI config = do
let host = c_zebraHost config
let port = c_zebraPort config
let dbFilePath = c_dbPath config
2024-05-05 14:49:55 +00:00
pool <- runNoLoggingT $ initPool dbFilePath
w <- try $ checkZebra host port :: IO (Either IOError ZebraGetInfo)
case w of
Right zebra -> do
bc <-
try $ checkBlockChain host port :: IO
(Either IOError ZebraGetBlockChainInfo)
case bc of
Left e1 -> throwIO e1
Right chainInfo -> do
2024-02-28 21:12:57 +00:00
initDb dbFilePath
2024-05-05 14:49:55 +00:00
walList <- getWallets pool $ zgb_net chainInfo
2024-02-29 21:02:58 +00:00
accList <-
if not (null walList)
2024-05-05 14:49:55 +00:00
then runNoLoggingT $ getAccounts pool $ entityKey $ head walList
2024-02-29 21:02:58 +00:00
else return []
2024-03-05 18:34:30 +00:00
addrList <-
if not (null accList)
2024-05-05 14:49:55 +00:00
then runNoLoggingT $ getAddresses pool $ entityKey $ head accList
2024-03-05 18:34:30 +00:00
else return []
2024-04-21 12:07:51 +00:00
txList <-
if not (null addrList)
2024-05-05 14:49:55 +00:00
then getUserTx pool $ entityKey $ head addrList
2024-04-21 12:07:51 +00:00
else return []
2024-04-24 14:04:56 +00:00
let block =
if not (null walList)
then zcashWalletLastSync $ entityVal $ head walList
else 0
2024-04-24 13:58:45 +00:00
bal <-
if not (null accList)
2024-05-05 14:49:55 +00:00
then getBalance pool $ entityKey $ head accList
2024-04-24 13:58:45 +00:00
else return 0
2024-05-03 12:10:08 +00:00
eventChan <- BC.newBChan 10
2024-05-05 14:49:55 +00:00
_ <-
forkIO $
forever $ do
BC.writeBChan eventChan (TickVal 0.0)
threadDelay 1000000
2024-05-03 12:10:08 +00:00
let buildVty = VC.mkVty V.defaultConfig
initialVty <- buildVty
void $
2024-05-03 12:10:08 +00:00
M.customMain initialVty buildVty (Just eventChan) theApp $
State
(zgb_net chainInfo)
2024-02-19 20:05:32 +00:00
(L.list WList (Vec.fromList walList) 1)
2024-02-29 21:02:58 +00:00
(L.list AcList (Vec.fromList accList) 0)
2024-03-05 18:34:30 +00:00
(L.list AList (Vec.fromList addrList) 1)
2024-04-21 12:07:51 +00:00
(L.list TList (Vec.fromList txList) 1)
("Start up Ok! Connected to Zebra " ++
(T.unpack . zgi_build) zebra ++ " on port " ++ show port ++ ".")
2024-02-13 20:19:05 +00:00
False
2024-02-27 15:44:17 +00:00
(if null walList
then WName
else Blank)
2024-02-14 18:03:18 +00:00
True
2024-02-27 15:44:17 +00:00
(mkInputForm $ DialogInput "Main")
2024-02-14 18:03:18 +00:00
(F.focusRing [AList, TList])
2024-02-28 21:12:57 +00:00
(zgb_blocks chainInfo)
dbFilePath
2024-05-03 12:10:08 +00:00
host
port
2024-03-07 20:20:06 +00:00
MsgDisplay
2024-04-21 12:07:51 +00:00
block
2024-04-24 13:58:45 +00:00
bal
2024-05-03 12:10:08 +00:00
1.0
eventChan
2024-05-05 14:49:55 +00:00
0
2024-05-09 15:44:07 +00:00
(mkSendForm 0 $ SendInput "" 0.0 "")
Left e -> do
print $
"No Zebra node available on port " <>
show port <> ". Check your configuration."
2024-02-28 21:12:57 +00:00
2024-03-07 20:20:06 +00:00
refreshWallet :: State -> IO State
refreshWallet s = do
2024-05-05 14:49:55 +00:00
pool <- runNoLoggingT $ initPool $ s ^. dbPath
walList <- getWallets pool $ s ^. network
(ix, selWallet) <-
2024-03-07 20:20:06 +00:00
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"
2024-05-05 14:49:55 +00:00
Just (j, w1) -> return (j, w1)
Just (k, w) -> return (k, w)
aL <- runNoLoggingT $ getAccounts pool $ entityKey selWallet
2024-04-24 14:04:56 +00:00
let bl = zcashWalletLastSync $ entityVal selWallet
2024-03-07 20:20:06 +00:00
addrL <-
if not (null aL)
2024-05-05 14:49:55 +00:00
then runNoLoggingT $ getAddresses pool $ entityKey $ head aL
2024-03-07 20:20:06 +00:00
else return []
2024-04-24 13:58:45 +00:00
bal <-
if not (null aL)
2024-05-05 14:49:55 +00:00
then getBalance pool $ entityKey $ head aL
2024-04-24 13:58:45 +00:00
else return 0
2024-04-21 12:07:51 +00:00
txL <-
if not (null addrL)
2024-05-05 14:49:55 +00:00
then getUserTx pool $ entityKey $ head addrL
2024-04-21 12:07:51 +00:00
else return []
2024-05-05 14:49:55 +00:00
let wL = L.listReplace (Vec.fromList walList) (Just ix) (s ^. wallets)
2024-03-07 20:20:06 +00:00
let aL' = L.listReplace (Vec.fromList aL) (Just 0) (s ^. accounts)
let addrL' = L.listReplace (Vec.fromList addrL) (Just 0) (s ^. addresses)
2024-04-21 12:07:51 +00:00
let txL' = L.listReplace (Vec.fromList txL) (Just 0) (s ^. transactions)
2024-03-07 20:20:06 +00:00
return $
2024-05-05 14:49:55 +00:00
s & wallets .~ wL & accounts .~ aL' & syncBlock .~ bl & balance .~ bal &
addresses .~
2024-04-24 14:04:56 +00:00
addrL' &
transactions .~
2024-04-24 13:58:45 +00:00
txL' &
msg .~
2024-04-21 12:07:51 +00:00
"Switched to wallet: " ++
2024-03-07 20:20:06 +00:00
T.unpack (zcashWalletName $ entityVal selWallet)
addNewWallet :: T.Text -> State -> IO State
2024-02-28 21:12:57 +00:00
addNewWallet n s = do
sP <- generateWalletSeedPhrase
2024-05-05 14:49:55 +00:00
pool <- runNoLoggingT $ initPool $ s ^. dbPath
2024-02-28 21:12:57 +00:00
let bH = s ^. startBlock
let netName = s ^. network
2024-05-05 14:49:55 +00:00
r <- saveWallet pool $ ZcashWallet n (ZcashNetDB netName) (PhraseDB sP) bH 0
case r of
Nothing -> do
2024-03-01 20:57:13 +00:00
return $ s & msg .~ ("Wallet already exists: " ++ T.unpack n)
Just _ -> do
2024-05-05 14:49:55 +00:00
wL <- getWallets pool netName
2024-03-01 13:33:30 +00:00
let aL =
L.listFindBy (\x -> zcashWalletName (entityVal x) == n) $
L.listReplace (Vec.fromList wL) (Just 0) (s ^. wallets)
return $ (s & wallets .~ aL) & msg .~ "Created new wallet: " ++ T.unpack n
addNewAccount :: T.Text -> State -> IO State
2024-03-01 20:57:13 +00:00
addNewAccount n s = do
2024-05-05 14:49:55 +00:00
pool <- runNoLoggingT $ initPool $ s ^. dbPath
2024-03-01 20:57:13 +00:00
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
2024-05-05 14:49:55 +00:00
aL' <- getMaxAccount pool (entityKey selWallet)
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
2024-05-05 14:49:55 +00:00
r <- saveAccount pool zA'
case r of
Nothing ->
return $ s & msg .~ ("Account already exists: " ++ T.unpack n)
Just x -> do
2024-05-05 14:49:55 +00:00
aL <- runNoLoggingT $ getAccounts pool (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
2024-03-05 18:34:30 +00:00
2024-03-07 20:20:06 +00:00
refreshAccount :: State -> IO State
refreshAccount s = do
2024-05-05 14:49:55 +00:00
pool <- runNoLoggingT $ initPool $ s ^. dbPath
2024-03-07 20:20:06 +00:00
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
2024-05-05 14:49:55 +00:00
aL <- runNoLoggingT $ getAddresses pool $ entityKey selAccount
bal <- getBalance pool $ entityKey selAccount
2024-03-07 20:20:06 +00:00
let aL' = L.listReplace (Vec.fromList aL) (Just 0) (s ^. addresses)
2024-04-21 12:07:51 +00:00
selAddress <-
do case L.listSelectedElement aL' of
Nothing -> do
let fAdd = L.listSelectedElement $ L.listMoveToBeginning aL'
2024-04-24 12:42:35 +00:00
return fAdd
Just a2 -> return $ Just a2
case selAddress of
Nothing ->
return $
2024-04-24 13:58:45 +00:00
s & balance .~ bal & addresses .~ aL' & msg .~ "Switched to account: " ++
2024-04-24 12:42:35 +00:00
T.unpack (zcashAccountName $ entityVal selAccount)
Just (_i, a) -> do
2024-05-05 14:49:55 +00:00
tList <- getUserTx pool $ entityKey a
2024-04-24 12:42:35 +00:00
let tL' = L.listReplace (Vec.fromList tList) (Just 0) (s ^. transactions)
return $
2024-04-24 13:58:45 +00:00
s & balance .~ bal & addresses .~ aL' & transactions .~ tL' & msg .~
2024-04-24 12:42:35 +00:00
"Switched to account: " ++
T.unpack (zcashAccountName $ entityVal selAccount)
2024-03-07 20:20:06 +00:00
2024-04-21 12:07:51 +00:00
refreshTxs :: State -> IO State
refreshTxs s = do
2024-05-05 14:49:55 +00:00
pool <- runNoLoggingT $ initPool $ s ^. dbPath
2024-04-21 12:07:51 +00:00
selAddress <-
do case L.listSelectedElement $ s ^. addresses of
Nothing -> do
let fAdd =
L.listSelectedElement $ L.listMoveToBeginning $ s ^. addresses
2024-04-24 12:42:35 +00:00
return fAdd
Just a2 -> return $ Just a2
case selAddress of
Nothing -> return s
Just (_i, a) -> do
2024-05-05 14:49:55 +00:00
tList <- getUserTx pool $ entityKey a
2024-04-24 12:42:35 +00:00
let tL' = L.listReplace (Vec.fromList tList) (Just 0) (s ^. transactions)
return $ s & transactions .~ tL'
2024-04-21 12:07:51 +00:00
2024-03-17 12:17:52 +00:00
addNewAddress :: T.Text -> Scope -> State -> IO State
addNewAddress n scope s = do
2024-05-05 14:49:55 +00:00
pool <- runNoLoggingT $ initPool $ s ^. dbPath
2024-03-05 18:34:30 +00:00
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
2024-05-05 14:49:55 +00:00
maxAddr <- getMaxAddress pool (entityKey selAccount) scope
2024-03-07 20:20:06 +00:00
uA <-
2024-03-17 12:17:52 +00:00
try $ createWalletAddress n (maxAddr + 1) (s ^. network) scope selAccount :: IO
2024-03-07 20:20:06 +00:00
(Either IOError WalletAddress)
case uA of
Left e -> return $ s & msg .~ ("Error: " ++ show e)
Right uA' -> do
2024-05-05 14:49:55 +00:00
nAddr <- saveAddress pool uA'
2024-03-07 20:20:06 +00:00
case nAddr of
Nothing ->
return $ s & msg .~ ("Address already exists: " ++ T.unpack n)
Just x -> do
2024-05-05 14:49:55 +00:00
addrL <- runNoLoggingT $ getAddresses pool (entityKey selAccount)
2024-03-07 20:20:06 +00:00
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) ++ ")"
2024-05-09 15:44:07 +00:00
sendTransaction ::
ConnectionPool
-> BC.BChan Tick
-> T.Text
-> Int
-> ZcashNet
-> ZcashAccountId
-> Int
-> Float
-> T.Text
-> T.Text
-> IO ()
sendTransaction pool chan zHost zPort znet accId bl amt ua memo = do
BC.writeBChan chan $ TickMsg "Preparing transaction..."
outUA <- parseAddress ua
res <-
runFileLoggingT "zenith.log" $
prepareTx pool zHost zPort znet accId bl amt outUA memo
BC.writeBChan chan $ TickMsg "Transaction ready, sending to Zebra..."
case res of
Left e -> BC.writeBChan chan $ TickMsg $ show e
Right rawTx -> do
resp <-
makeZebraCall
zHost
zPort
"sendrawtransaction"
[Data.Aeson.String $ toText rawTx]
case resp of
Left e1 -> BC.writeBChan chan $ TickMsg $ "Zebra error: " ++ show e1
Right txId -> BC.writeBChan chan $ TickMsg $ "Tx ID: " ++ txId
where
parseAddress :: T.Text -> IO UnifiedAddress
parseAddress a =
case isValidUnifiedAddress (E.encodeUtf8 a) of
Just a1 -> return a1
Nothing ->
case decodeSaplingAddress (E.encodeUtf8 a) of
Just a2 ->
return $
UnifiedAddress znet Nothing (Just $ sa_receiver a2) Nothing
Nothing ->
case decodeTransparentAddress (E.encodeUtf8 a) of
Just a3 ->
return $
UnifiedAddress znet Nothing Nothing (Just $ ta_receiver a3)
Nothing -> throwIO $ userError "Incorrect address"