zenith/src/Zenith/GUI.hs

{-# 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 Data.Time.Clock.POSIX (posixSecondsToUTCTime)
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 "#ff5722" --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 `styleBasic` [textColor white]
        , label "Testnet" `styleBasic` [textColor white] `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 =
      hstack
        [ filler
        , boxShadow $
          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
                   ]
               ]) `styleBasic`
          [bgColor white, radius 5, border 1 btnColor]
        , filler
        ]
    addressBox =
      boxShadow $
      box_
        [alignMiddle]
        (vstack
           [ label "Addresses" `styleBasic`
             [textFont "Bold", textColor white, bgColor btnColor]
           , vscroll (vstack (zipWith addrRow [0 ..] (model ^. addresses))) `nodeKey`
             "addrScroll"
           ]) `styleBasic`
      [padding 3, radius 2, bgColor white]
    addrRow :: Int -> Entity WalletAddress -> WidgetNode AppModel AppEvent
    addrRow idx wAddr =
      box_
        [onClick $ ShowMsg ("You clicked address " <> showt idx), alignLeft]
        (label
           (walletAddressName (entityVal wAddr) <>
            ": " <> showAddress (walletAddressUAddress $ entityVal wAddr))) `styleBasic`
      [padding 1, borderB 1 gray]
    txBox =
      boxShadow $
      box_
        [alignMiddle]
        (vstack
           [ label "Transactions" `styleBasic`
             [textFont "Bold", bgColor btnColor, textColor white]
           , vscroll (vstack (zipWith txRow [0 ..] (model ^. transactions))) `nodeKey`
             "txScroll"
           ]) `styleBasic`
      [radius 2, padding 3, bgColor white]
    txRow :: Int -> Entity UserTx -> WidgetNode AppModel AppEvent
    txRow idx tx =
      box_
        [onClick $ ShowMsg ("You clicked transaction " <> showt idx)]
        (hstack
           [ label
               (T.pack $
                show
                  (posixSecondsToUTCTime
                     (fromIntegral (userTxTime $ entityVal tx))))
           , filler
           , widgetIf
               (T.length (userTxMemo $ entityVal tx) > 1)
               (remixIcon remixDiscussFill)
           , if 0 >= userTxAmount (entityVal tx)
               then remixIcon remixArrowRightUpFill `styleBasic` [textColor red]
               else remixIcon remixArrowRightDownFill `styleBasic`
                    [textColor green]
           , label $
             displayAmount (model ^. network) $
             fromIntegral $ userTxAmount (entityVal tx)
           ]) `styleBasic`
      [padding 2, borderB 1 gray]
    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
      ]