Vergara_Tech/zenith
Vergara_Tech/zenith
2
0
Fork 0
Code Issues 21 Pull requests Projects Releases 6 Packages Wiki Activity

Release preparation #90

Merged
pitmutt merged 29 commits from rav001 into milestone2 2024-07-11 13:43:05 +00:00
Conversation 0 Commits 29 Files changed 28 +144 -14
2 changed files with 144 additions and 14 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files
Showing only changes of commit 7956a2ec22 - Show all commits

BIN
assets/1F928_color.png Normal file
View file

Binary file not shown.
Side by side

After

Width:  |  Height:  |  Size: 10 KiB

158
src/Zenith/GUI.hs
View file

@ -11,7 +11,8 @@ import Control.Exception (throwIO, try)
import Control.Monad.Logger (runNoLoggingT)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as LBS
import Data.Maybe (fromMaybe, isJust)
import Data.HexString (toText)
import Data.Maybe (fromJust, fromMaybe, isJust, isNothing)
import qualified Data.Text as T
import qualified Data.Text.Encoding as E
import Data.Time.Clock.POSIX (posixSecondsToUTCTime)
@ -22,7 +23,9 @@ import Lens.Micro.TH
import Monomer
import qualified Monomer.Lens as L
import System.Hclip
import TextShow
import Text.Wrap (FillScope(..), FillStrategy(..), WrapSettings(..), wrapText)
import TextShow hiding (toText)
import ZcashHaskell.Keys (generateWalletSeedPhrase)
import ZcashHaskell.Orchard (getSaplingFromUA, isValidUnifiedAddress)
import ZcashHaskell.Transparent (encodeTransparentReceiver)
import ZcashHaskell.Types
@ -44,6 +47,7 @@ data AppEvent
= AppInit
| ShowMsg !T.Text
| ShowError !T.Text
| ShowModal !T.Text
| CloseMsg
| WalletClicked
| AccountClicked
@ -61,6 +65,7 @@ data AppEvent
| LoadTxs ![Entity UserTx]
| LoadAddrs ![Entity WalletAddress]
| LoadAccs ![Entity ZcashAccount]
| LoadWallets ![Entity ZcashWallet]
| ConfirmCancel
| SaveAddress !(Maybe (Entity ZcashAccount))
| SaveAccount !(Maybe (Entity ZcashWallet))
@ -68,6 +73,9 @@ data AppEvent
| CloseSeed
| ShowSeed
| CopySeed !T.Text
| CopyTx !T.Text
| CloseTx
| ShowTx !Int
deriving (Eq, Show)
data AppModel = AppModel
@ -98,6 +106,8 @@ data AppModel = AppModel
, _confirmEvent :: !AppEvent
, _inError :: !Bool
, _showSeed :: !Bool
, _modalMsg :: !(Maybe T.Text)
, _showTx :: !(Maybe Int)
} deriving (Eq, Show)
makeLenses ''AppModel
@ -135,6 +145,8 @@ buildUI wenv model = widgetTree
, confirmOverlay `nodeVisible` isJust (model ^. confirmTitle)
, seedOverlay `nodeVisible` model ^. showSeed
, msgOverlay `nodeVisible` isJust (model ^. msg)
, txOverlay `nodeVisible` isJust (model ^. showTx)
, modalOverlay `nodeVisible` isJust (model ^. modalMsg)
]
mainWindow =
vstack
@ -383,7 +395,7 @@ buildUI wenv model = widgetTree
(fromIntegral $ qrCodeWidth qr))
[fitWidth]
Nothing ->
image_ "./assets/2620_color.png" [fitEither]) `styleBasic`
image_ "./assets/1F928_color.png" [fitEither]) `styleBasic`
[bgColor white, height 100, width 100]
, filler
] `styleBasic`
@ -418,7 +430,7 @@ buildUI wenv model = widgetTree
txRow :: Int -> Entity UserTx -> WidgetNode AppModel AppEvent
txRow idx tx =
box_
[onClick $ ShowMsg ("You clicked transaction " <> showt idx)]
[onClick $ ShowTx idx]
(hstack
[ label
(T.pack $
@ -515,6 +527,75 @@ buildUI wenv model = widgetTree
, filler
]
]
modalOverlay =
box
(label (fromMaybe "?" $ model ^. modalMsg) `styleBasic`
[textSize 12, textFont "Bold"]) `styleBasic`
[bgColor (white & L.a .~ 0.5)]
txOverlay =
case model ^. showTx of
Nothing -> alert CloseTx $ label "N/A"
Just i ->
alert CloseTx $
vstack
[ box_
[alignLeft]
(hstack
[ label "Date " `styleBasic` [width 60, textFont "Bold"]
, separatorLine `styleBasic` [fgColor btnColor]
, spacer
, label
(T.pack $
show $
posixSecondsToUTCTime $
fromIntegral $
userTxTime $ entityVal $ (model ^. transactions) !! i)
]) `styleBasic`
[padding 2, bgColor white, width 280, borderB 1 gray]
, box_
[alignLeft]
(hstack
[ label "Tx ID " `styleBasic` [width 60, textFont "Bold"]
, separatorLine `styleBasic` [fgColor btnColor]
, spacer
, label_
(txtWrap $
toText $
getHex $
userTxHex $ entityVal $ (model ^. transactions) !! i)
[multiline]
, box_
[]
(remixIcon remixFileCopyFill `styleBasic`
[textColor white]) `styleBasic`
[bgColor btnColor, radius 2]
]) `styleBasic`
[padding 2, bgColor white, width 280, borderB 1 gray]
, box_
[alignLeft]
(hstack
[ label "Amount" `styleBasic` [width 60, textFont "Bold"]
, separatorLine `styleBasic` [fgColor btnColor]
, spacer
, label $
displayAmount (model ^. network) $
fromIntegral $
userTxAmount $ entityVal $ (model ^. transactions) !! i
]) `styleBasic`
[padding 2, bgColor white, width 280, borderB 1 gray]
, box_
[alignLeft]
(hstack
[ label "Memo " `styleBasic` [width 60, textFont "Bold"]
, separatorLine `styleBasic` [fgColor btnColor]
, spacer
, label_
(txtWrap $
userTxMemo $ entityVal $ (model ^. transactions) !! i)
[multiline]
]) `styleBasic`
[padding 2, bgColor white, width 280, borderB 1 gray]
]
generateQRCodes :: Config -> IO ()
generateQRCodes config = do
@ -592,10 +673,11 @@ handleEvent ::
-> [AppEventResponse AppModel AppEvent]
handleEvent wenv node model evt =
case evt of
AppInit -> []
AppInit -> [Event NewWallet | isNothing currentWallet]
ShowMsg t -> [Model $ model & msg ?~ t & menuPopup .~ False]
ShowError t ->
[Model $ model & msg ?~ t & menuPopup .~ False & inError .~ True]
ShowModal t -> [Model $ model & modalMsg ?~ t]
WalletClicked -> [Model $ model & walPopup .~ True]
AccountClicked -> [Model $ model & accPopup .~ True]
MenuClicked -> [Model $ model & menuPopup .~ True]
@ -635,6 +717,7 @@ handleEvent wenv node model evt =
SaveAddress acc ->
if T.length (model ^. mainInput) > 1
then [ Task $ addNewAddress (model ^. mainInput) External acc
, Event $ ShowModal "Generating QR codes..."
, Event ConfirmCancel
]
else [Event $ ShowError "Invalid input", Event ConfirmCancel]
@ -645,13 +728,11 @@ handleEvent wenv node model evt =
]
else [Event $ ShowError "Invalid input", Event ConfirmCancel]
SaveWallet ->
[ if T.length (model ^. mainInput) > 1
then Event $ ShowMsg $ "You saved wallet: " <> model ^. mainInput
else Event $ ShowError "Invalid input"
, Event ConfirmCancel
]
if T.length (model ^. mainInput) > 1
then [Task addNewWallet, Event ConfirmCancel]
else [Event $ ShowError "Invalid input"]
SetPool p ->
[ Model $ model & selPool .~ p
[ Model $ model & selPool .~ p & modalMsg .~ Nothing
, Task $
SwitchQr <$> do
dbPool <- runNoLoggingT $ initPool $ c_dbPath $ model ^. configuration
@ -687,7 +768,8 @@ handleEvent wenv node model evt =
Just wal -> runNoLoggingT $ getAccounts dbPool $ entityKey wal
]
CopyAddr a ->
[ setClipboardData $
[ setClipboardData ClipboardEmpty
, setClipboardData $
ClipboardText $
case model ^. selPool of
Orchard -> maybe "None" (getUA . walletAddressUAddress . entityVal) a
@ -706,20 +788,35 @@ handleEvent wenv node model evt =
, Event $ ShowMsg "Copied address!"
]
CopySeed s ->
[ setClipboardData $ ClipboardText s
[ setClipboardData ClipboardEmpty
, setClipboardData $ ClipboardText s
, Event $ ShowMsg "Copied seed phrase!"
]
CopyTx t ->
[ setClipboardData ClipboardEmpty
, setClipboardData $ ClipboardText t
, Event $ ShowMsg "Copied transaction ID!"
]
LoadTxs t -> [Model $ model & transactions .~ t]
LoadAddrs a ->
if not (null a)
then [Model $ model & addresses .~ a, Event $ SetPool Orchard]
then [ Model $ model & addresses .~ a
, Event $ SwitchAddr $ model ^. selAddr
, Event $ SetPool Orchard
]
else [Event $ NewAddress currentAccount]
LoadAccs a ->
if not (null a)
then [Model $ model & accounts .~ a, Event $ SwitchAcc 0]
else [Event $ NewAccount currentWallet]
LoadWallets a ->
if not (null a)
then [Model $ model & wallets .~ a, Event $ SwitchWal 0]
else [Event NewWallet]
CloseMsg -> [Model $ model & msg .~ Nothing & inError .~ False]
CloseSeed -> [Model $ model & showSeed .~ False]
CloseTx -> [Model $ model & showTx .~ Nothing]
ShowTx i -> [Model $ model & showTx ?~ i]
where
currentWallet =
if null (model ^. wallets)
@ -781,6 +878,35 @@ handleEvent wenv node model evt =
Just _x -> do
aList <- runNoLoggingT $ getAccounts pool (entityKey w')
return $ LoadAccs aList
addNewWallet :: IO AppEvent
addNewWallet = do
sP <- generateWalletSeedPhrase
pool <- runNoLoggingT $ initPool $ c_dbPath $ model ^. configuration
bc <-
try $
checkBlockChain
(c_zebraHost $ model ^. configuration)
(c_zebraPort $ model ^. configuration) :: IO
(Either IOError ZebraGetBlockChainInfo)
case bc of
Left e1 -> return $ ShowError $ T.pack $ show e1
Right chainInfo -> do
r <-
saveWallet pool $
ZcashWallet
(model ^. mainInput)
(ZcashNetDB (model ^. network))
(PhraseDB sP)
(zgb_blocks chainInfo)
0
case r of
Nothing -> return $ ShowError "Wallet already exists"
Just _ -> do
wL <- getWallets pool (model ^. network)
return $ LoadWallets wL
txtWrap :: T.Text -> T.Text
txtWrap = wrapText (WrapSettings False True NoFill FillAfterFirst) 32
runZenithGUI :: Config -> IO ()
runZenithGUI config = do
@ -848,6 +974,8 @@ runZenithGUI config = do
else Nothing)
False
False
Nothing
Nothing
startApp model handleEvent buildUI params
Left e -> do
initDb dbFilePath
@ -882,6 +1010,8 @@ runZenithGUI config = do
(SaveAddress Nothing)
False
False
Nothing
Nothing
startApp model handleEvent buildUI params
where
params =