{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE OverloadedStrings #-} module Zenith.GUI where import Control.Exception (throwIO, try) import Control.Monad.Logger (runNoLoggingT) import Data.Maybe (fromMaybe, isJust) import qualified Data.Text as T import Database.Persist import Lens.Micro ((&), (+~), (.~), (?~), (^.), set) import Lens.Micro.TH import Monomer import qualified Monomer.Lens as L import TextShow import ZcashHaskell.Types ( ZcashNet(..) , ZebraGetBlockChainInfo(..) , ZebraGetInfo(..) ) import Zenith.Core import Zenith.DB import Zenith.GUI.Theme import Zenith.Types hiding (ZcashAddress) import Zenith.Utils (displayAmount, showAddress) data AppModel = AppModel { _configuration :: !Config , _network :: !ZcashNet , _wallets :: ![Entity ZcashWallet] , _selWallet :: !Int , _accounts :: ![Entity ZcashAccount] , _selAcc :: !Int , _addresses :: ![Entity WalletAddress] , _selAddr :: !Int , _transactions :: ![Entity UserTx] , _setTx :: !Int , _msg :: !(Maybe T.Text) , _zebraOn :: !Bool , _balance :: !Integer , _unconfBalance :: !(Maybe Integer) } deriving (Eq, Show) makeLenses ''AppModel data AppEvent = AppInit | ShowMsg !T.Text | CloseMsg | WalletClicked | AccountClicked deriving (Eq, Show) remixArrowRightWideLine :: T.Text remixArrowRightWideLine = toGlyph 0xF496 remixHourglassFill :: T.Text remixHourglassFill = toGlyph 0xF338 remixIcon :: T.Text -> WidgetNode s e remixIcon i = label i `styleBasic` [textFont "Remix", textMiddle] buildUI :: WidgetEnv AppModel AppEvent -> AppModel -> WidgetNode AppModel AppEvent buildUI wenv model = widgetTree where btnColor = rgbHex "#1818B2" btnHiLite = rgbHex "#207DE8" currentWallet = if null (model ^. wallets) then Nothing else Just ((model ^. wallets) !! (model ^. selWallet)) currentAccount = if null (model ^. accounts) then Nothing else Just ((model ^. accounts) !! (model ^. selAcc)) widgetTree = zstack [mainWindow, msgOverlay `nodeVisible` isJust (model ^. msg)] mainWindow = vstack [ windowHeader , spacer , balanceBox , filler , mainPane , filler , windowFooter ] windowHeader = hstack [ box_ [onClick WalletClicked, alignMiddle] walletButton `styleBasic` [cursorHand, height 25, padding 3] `styleHover` [bgColor btnHiLite] , box_ [onClick AccountClicked, alignMiddle] accountButton `styleBasic` [cursorHand, height 25, padding 3] `styleHover` [bgColor btnHiLite] , filler , remixIcon remixErrorWarningFill , label "Testnet" `nodeVisible` (model ^. network == TestNet) ] `styleBasic` [bgColor btnColor] walletButton = hstack [ label "Wallet: " `styleBasic` [textFont "Bold", textColor white] , label (maybe "None" (zcashWalletName . entityVal) currentWallet) `styleBasic` [textFont "Regular", textColor white] , remixIcon remixArrowRightWideLine `styleBasic` [textColor white] ] accountButton = hstack [ label "Account: " `styleBasic` [textFont "Bold", textColor white] , label (maybe "None" (zcashAccountName . entityVal) currentAccount) `styleBasic` [textFont "Regular", textColor white] , remixIcon remixArrowRightWideLine `styleBasic` [textColor white] ] mainPane = box_ [alignMiddle] $ hstack [addressBox, txBox] balanceBox = box_ [alignMiddle] (vstack [ animFadeIn (label (displayAmount (model ^. network) $ model ^. balance) `styleBasic` [textSize 20]) , hstack [ filler , remixIcon remixHourglassFill `styleBasic` [textSize 8] , label (maybe "0" (displayAmount (model ^. network)) $ model ^. unconfBalance) `styleBasic` [textSize 8] `nodeVisible` isJust (model ^. unconfBalance) , filler ] ]) addressBox = box_ [alignMiddle] (vstack [ label "Addresses:" `styleBasic` [textFont "Regular"] , vscroll (vstack (zipWith addrRow [0 ..] (model ^. addresses))) `nodeKey` "addrScroll" ]) `styleBasic` [border 1 whiteSmoke] addrRow :: Int -> Entity WalletAddress -> WidgetNode AppModel AppEvent addrRow idx wAddr = box_ [onClick $ ShowMsg ("You clicked address " <> showt idx)] (label (walletAddressName (entityVal wAddr) <> ": " <> showAddress (walletAddressUAddress $ entityVal wAddr))) txBox = box_ [alignMiddle] (vstack [ label "Transactions:" `styleBasic` [textFont "Regular"] , label "2024-04-05 0.003 ZEC" `styleBasic` [textFont "Regular"] ]) `styleBasic` [border 1 whiteSmoke] windowFooter = hstack [ label ("Last block sync: " <> maybe "N/A" (showt . zcashWalletLastSync . entityVal) currentWallet) `styleBasic` [padding 3, textSize 8] , filler , image_ "./assets/1F993.png" [fitHeight] `styleBasic` [height 24, width 24] `nodeVisible` (model ^. zebraOn) , label ("Connected on " <> c_zebraHost (model ^. configuration) <> ":" <> showt (c_zebraPort $ model ^. configuration)) `styleBasic` [padding 3, textSize 8] `nodeVisible` (model ^. zebraOn) , label "Disconnected" `styleBasic` [padding 3, textSize 8] `nodeVisible` not (model ^. zebraOn) ] msgOverlay = alert CloseMsg $ hstack [filler, label $ fromMaybe "" (model ^. msg), filler] handleEvent :: WidgetEnv AppModel AppEvent -> WidgetNode AppModel AppEvent -> AppModel -> AppEvent -> [AppEventResponse AppModel AppEvent] handleEvent wenv node model evt = case evt of AppInit -> [] ShowMsg t -> [Model $ model & msg ?~ t] WalletClicked -> [Model $ model & msg ?~ "You clicked Wallet!"] AccountClicked -> [Model $ model & msg ?~ "You clicked Account!"] CloseMsg -> [Model $ model & msg .~ Nothing] runZenithGUI :: Config -> IO () runZenithGUI config = do let host = c_zebraHost config let port = c_zebraPort config let dbFilePath = c_dbPath config 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 initDb dbFilePath walList <- getWallets pool $ zgb_net chainInfo accList <- if not (null walList) then runNoLoggingT $ getAccounts pool $ entityKey $ head walList else return [] addrList <- if not (null accList) then runNoLoggingT $ getAddresses pool $ entityKey $ head accList else return [] txList <- if not (null addrList) then getUserTx pool $ entityKey $ head addrList else return [] let model = AppModel config (zgb_net chainInfo) walList 0 accList 0 addrList 0 txList 0 Nothing True 314259000 (Just 300000) startApp model handleEvent buildUI params Left e -> do initDb dbFilePath let model = AppModel config TestNet [] 0 [] 0 [] 0 [] 0 (Just $ "Couldn't connect to Zebra on " <> host <> ":" <> showt port <> ". Check your configuration.") False 314259000 (Just 30000) startApp model handleEvent buildUI params where params = [ appWindowTitle "Zenith - Zcash Full Node Wallet" , appTheme zenithTheme , appFontDef "Regular" "./assets/Atkinson-Hyperlegible-Regular-102.ttf" --"./assets/DejaVuSansMono.ttf" , appFontDef "Bold" "./assets/Atkinson-Hyperlegible-Bold-102.ttf" , appFontDef "Italic" "./assets/Atkinson-Hyperlegible-Italic-102.ttf" , appFontDef "Remix" "./assets/remixicon.ttf" , appDisableAutoScale True , appScaleFactor 2.0 , appInitEvent AppInit ]