Add the basic GUI

CHANGELOG.md

@@ -5,6 +5,10 @@ All notable changes to this project will be documented in this file.
 The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.0.0/),
 and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0.html).
 
+## [Unreleased]
+
+- Add GUI module
+
 ## [0.5.2.0-beta]
 
 ### Changed

app/Main.hs

@@ -19,6 +19,7 @@ import Text.Read (readMaybe)
 import ZcashHaskell.Types
 import Zenith.CLI
 import Zenith.Core (clearSync, testSync)
+import Zenith.GUI (runZenithGUI)
 import Zenith.Types (Config(..), ZcashAddress(..), ZcashPool(..), ZcashTx(..))
 import Zenith.Utils
 import Zenith.Zcashd
@@ -221,6 +222,7 @@ main = do
                 }
               (root nodeUser nodePwd)
         "cli" -> runZenithCLI myConfig
+        "gui" -> runZenithGUI myConfig
         "rescan" -> clearSync myConfig
         _ -> printUsage
     else printUsage

cabal.project.freeze

@@ -4,12 +4,20 @@ constraints: any.Cabal ==3.8.1.0,
              any.Clipboard ==2.3.2.0,
              any.HUnit ==1.6.2.0,
              any.Hclip ==3.0.0.4,
+             any.JuicyPixels ==3.3.8,
+             JuicyPixels -mmap,
              any.OneTuple ==0.4.1.1,
+             any.OpenGLRaw ==3.3.4.1,
+             OpenGLRaw -osandroid +usegles2 +useglxgetprocaddress +usenativewindowslibraries,
              any.QuickCheck ==2.14.3,
              QuickCheck -old-random +templatehaskell,
+             any.RSA ==2.4.1,
+             any.SHA ==1.6.4.4,
+             SHA -exe,
              any.StateVar ==1.2.2,
              any.X11 ==1.10.3,
              X11 -pedantic,
+             any.adjunctions ==4.4.2,
              any.aeson ==2.2.1.0,
              aeson +ordered-keymap,
              any.alex ==3.5.1.0,
@@ -30,8 +38,11 @@ constraints: any.Cabal ==3.8.1.0,
              any.attoparsec ==0.14.4,
              attoparsec -developer,
              any.attoparsec-aeson ==2.2.0.1,
+             any.authenticate-oauth ==1.7,
              any.auto-update ==0.1.6,
              any.base ==4.17.2.1,
+             any.base-compat ==0.13.1,
+             any.base-compat-batteries ==0.13.1,
              any.base-orphans ==0.9.1,
              any.base16 ==1.0,
              any.base16-bytestring ==1.0.2.0,
@@ -54,14 +65,20 @@ constraints: any.Cabal ==3.8.1.0,
              any.byteorder ==1.0.4,
              any.bytes ==0.17.3,
              any.bytestring ==0.11.5.3,
+             any.bytestring-builder ==0.10.8.2.0,
+             bytestring-builder +bytestring_has_builder,
+             any.bytestring-to-vector ==0.3.0.1,
              any.c2hs ==0.28.8,
              c2hs +base3 -regression,
+             any.cabal-doctest ==1.0.9,
              any.call-stack ==0.4.0,
              any.case-insensitive ==1.2.1.0,
              any.cborg ==0.2.10.0,
              cborg +optimize-gmp,
              any.cereal ==0.5.8.3,
              cereal -bytestring-builder,
+             any.clock ==0.8.4,
+             clock -llvm,
              any.colour ==2.3.6,
              any.comonad ==5.0.8,
              comonad +containers +distributive +indexed-traversable,
@@ -78,6 +95,7 @@ constraints: any.Cabal ==3.8.1.0,
              any.cookie ==0.4.6,
              any.crypto-api ==0.13.3,
              crypto-api -all_cpolys,
+             any.crypto-pubkey-types ==0.4.3,
              any.crypton ==0.34,
              crypton -check_alignment +integer-gmp -old_toolchain_inliner +support_aesni +support_deepseq +support_pclmuldq +support_rdrand -support_sse +use_target_attributes,
              any.crypton-connection ==0.3.2,
@@ -100,17 +118,27 @@ constraints: any.Cabal ==3.8.1.0,
              distributive +semigroups +tagged,
              any.dlist ==1.0,
              dlist -werror,
+             any.double-conversion ==2.0.5.0,
+             double-conversion -developer +embedded_double_conversion,
              any.easy-file ==0.2.5,
              any.entropy ==0.4.1.10,
              entropy -donotgetentropy,
              any.envy ==2.1.3.0,
              any.esqueleto ==3.5.11.2,
              any.exceptions ==0.10.5,
+             any.extra ==1.7.14,
              any.fast-logger ==3.2.2,
              any.filepath ==1.4.2.2,
+             any.fixed ==0.3,
              any.foldable1-classes-compat ==0.1,
              foldable1-classes-compat +tagged,
              any.foreign-rust ==0.1.0,
+             any.foreign-store ==0.2.1,
+             any.formatting ==7.2.0,
+             formatting -no-double-conversion,
+             any.free ==5.2,
+             any.generic-deriving ==1.14.5,
+             generic-deriving +base-4-9,
              any.generically ==0.1.1,
              any.generics-sop ==0.5.1.4,
              any.ghc ==9.4.8,
@@ -150,11 +178,18 @@ constraints: any.Cabal ==3.8.1.0,
              any.integer-gmp ==1.1,
              any.integer-logarithms ==1.0.3.1,
              integer-logarithms -check-bounds +integer-gmp,
+             any.invariant ==0.6.3,
              any.iproute ==1.7.12,
+             any.kan-extensions ==5.2.5,
              any.language-c ==0.9.3,
              language-c -allwarnings +iecfpextension +usebytestrings,
+             any.lens ==5.2.3,
+             lens -benchmark-uniplate -dump-splices +inlining -j +test-hunit +test-properties +test-templates +trustworthy,
+             any.lens-aeson ==1.2.3,
              any.lift-type ==0.1.1.1,
              any.lifted-base ==0.2.3.12,
+             any.linear ==1.22,
+             linear -herbie +template-haskell,
              any.megaparsec ==9.6.1,
              megaparsec -dev,
              any.memory ==0.18.0,
@@ -169,14 +204,19 @@ constraints: any.Cabal ==3.8.1.0,
              any.monad-loops ==0.4.3,
              monad-loops +base4,
              any.mono-traversable ==1.0.17.0,
+             any.monomer ==1.6.0.1,
+             monomer -examples,
              any.mtl ==2.2.2,
              any.murmur3 ==1.0.5,
+             any.nanovg ==0.8.1.0,
+             nanovg -examples -gl2 -gles3 -stb_truetype,
              any.network ==3.1.4.0,
              network -devel,
              any.network-uri ==2.6.4.2,
              any.old-locale ==1.0.0.7,
              any.old-time ==1.1.0.4,
              any.os-string ==2.0.2,
+             any.parallel ==3.2.2.0,
              any.parsec ==3.1.16.1,
              any.parser-combinators ==1.3.0,
              parser-combinators -dev,
@@ -189,11 +229,15 @@ constraints: any.Cabal ==3.8.1.0,
              any.pretty ==1.1.3.6,
              any.primitive ==0.9.0.0,
              any.process ==1.6.18.0,
+             any.profunctors ==5.6.2,
+             any.psqueues ==0.2.8.0,
              any.pureMD5 ==2.1.4,
              pureMD5 -test,
              any.quickcheck-io ==0.2.0,
              any.quickcheck-transformer ==0.3.1.2,
              any.random ==1.2.1.2,
+             any.reflection ==2.1.7,
+             reflection -slow +template-haskell,
              any.regex-base ==0.94.0.2,
              any.regex-compat ==0.95.2.1,
              any.regex-posix ==0.96.0.1,
@@ -205,11 +249,15 @@ constraints: any.Cabal ==3.8.1.0,
              any.safe-exceptions ==0.1.7.4,
              any.scientific ==0.3.7.0,
              scientific -bytestring-builder -integer-simple,
+             any.sdl2 ==2.5.5.0,
+             sdl2 -examples -no-linear -opengl-example +pkgconfig +recent-ish,
              any.secp256k1-haskell ==1.2.0,
              any.semialign ==1.3,
              semialign +semigroupoids,
              any.semigroupoids ==6.0.0.1,
              semigroupoids +comonad +containers +contravariant +distributive +tagged +unordered-containers,
+             any.semigroups ==0.20,
+             semigroups +binary +bytestring -bytestring-builder +containers +deepseq +hashable +tagged +template-haskell +text +transformers +unordered-containers,
              any.serialise ==0.2.6.1,
              serialise +newtime15,
              any.silently ==1.2.5.3,
@@ -227,6 +275,7 @@ constraints: any.Cabal ==3.8.1.0,
              any.string-conversions ==0.4.0.1,
              any.structured-cli ==2.7.0.1,
              structured-cli -debug,
+             any.system-cxx-std-lib ==1.0,
              any.tagged ==0.8.8,
              tagged +deepseq +transformers,
              any.template-haskell ==2.19.0.0,
@@ -236,6 +285,8 @@ constraints: any.Cabal ==3.8.1.0,
              any.text-iso8601 ==0.1,
              any.text-short ==0.1.5,
              text-short -asserts,
+             any.text-show ==3.10.4,
+             text-show +base-4-9 +integer-gmp +new-functor-classes +template-haskell-2-11,
              any.text-zipper ==0.13,
              any.tf-random ==0.5,
              any.th-abstraction ==0.6.0.0,
@@ -246,6 +297,8 @@ constraints: any.Cabal ==3.8.1.0,
              any.time ==1.12.2,
              any.time-compat ==1.9.6.1,
              time-compat -old-locale,
+             any.time-locale-compat ==0.1.1.5,
+             time-locale-compat -old-locale,
              any.tls ==2.0.2,
              tls -devel,
              any.transformers ==0.5.6.2,
@@ -280,6 +333,8 @@ constraints: any.Cabal ==3.8.1.0,
              any.wide-word ==0.1.6.0,
              any.witherable ==0.4.2,
              any.word-wrap ==0.5,
-             any.zlib ==0.7.0.0,
+             any.wreq ==0.5.4.3,
+             wreq -aws -developer +doctest -httpbin,
+             any.zlib ==0.6.3.0,
              zlib -bundled-c-zlib +non-blocking-ffi +pkg-config
 index-state: hackage.haskell.org 2024-04-07T10:14:52Z

src/Zenith/GUI.hs

@@ -0,0 +1,99 @@
+{-# 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
+      ]

zenith.cabal

@@ -27,6 +27,7 @@ library
   ghc-options: -Wall -Wunused-imports
   exposed-modules:
     Zenith.CLI
+    Zenith.GUI
     Zenith.Core
     Zenith.DB
     Zenith.Types
@@ -61,6 +62,7 @@ library
     , microlens
     , microlens-mtl
     , microlens-th
+    , monomer
     , mtl
     , persistent
     , Hclip
@@ -72,6 +74,7 @@ library
     , regex-posix
     , scientific
     , text
+    , text-show
     , time
     , vector
     , vty