100 lines
2.7 KiB
Haskell
100 lines
2.7 KiB
Haskell
|
{-# 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 TextShow
|
||
|
|
import ZcashHaskell.Types
|
||
|
|
( ZcashNet(..)
|
||
|
|
, ZebraGetBlockChainInfo(..)
|
||
|
|
, ZebraGetInfo(..)
|
||
|
|
)
|
||
|
|
import Zenith.Core
|
||
|
|
import Zenith.DB
|
||
|
|
import Zenith.Types
|
||
|
|
|
||
|
|
data AppModel = AppModel
|
||
|
|
{ _network :: !ZcashNet
|
||
|
|
, _wallets :: ![Entity ZcashWallet]
|
||
|
|
, _msg :: !(Maybe T.Text)
|
||
|
|
} deriving (Eq, Show)
|
||
|
|
|
||
|
|
makeLenses ''AppModel
|
||
|
|
|
||
|
|
data AppEvent
|
||
|
|
= AppInit
|
||
|
|
| ShowMsg !T.Text
|
||
|
|
| CloseMsg
|
||
|
|
deriving (Eq, Show)
|
||
|
|
|
||
|
|
buildUI ::
|
||
|
|
WidgetEnv AppModel AppEvent -> AppModel -> WidgetNode AppModel AppEvent
|
||
|
|
buildUI wenv model = widgetTree
|
||
|
|
where
|
||
|
|
widgetTree =
|
||
|
|
zstack
|
||
|
|
[ vstack
|
||
|
|
[ label "Hello World"
|
||
|
|
, spacer
|
||
|
|
, hstack [button "Try the overlay" $ ShowMsg "It works!"]
|
||
|
|
] `styleBasic`
|
||
|
|
[padding 10]
|
||
|
|
, msgOverlay `nodeVisible` isJust (model ^. msg)
|
||
|
|
]
|
||
|
|
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]
|
||
|
|
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
|
||
|
|
let model = AppModel (zgb_net chainInfo) walList Nothing
|
||
|
|
startApp model handleEvent buildUI params
|
||
|
|
Left e ->
|
||
|
|
print $
|
||
|
|
"No Zebra node available on port " <>
|
||
|
|
show port <> ". Check your configuration."
|
||
|
|
where
|
||
|
|
params =
|
||
|
|
[ appWindowTitle "Zenith - Zcash Full Node Wallet"
|
||
|
|
, appTheme darkTheme
|
||
|
|
, appFontDef "Regular" "./assets/DejaVuSansMono.ttf"
|
||
|
|
, appFontDef "Bold" "./assets/DejaVuSansMono-Bold.ttf"
|
||
|
|
, appFontDef "Italic" "./assets/DejaVuSansMono-Oblique.ttf"
|
||
|
|
, appInitEvent AppInit
|
||
|
|
]
|