zenith/src/Zenith/GUI.hs

{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE OverloadedStrings #-}

module Zenith.GUI where

import Codec.Picture
import Codec.Picture.Types (pixelFold, promoteImage)
import Codec.QRCode
import Codec.QRCode.JuicyPixels
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 qualified Data.Text as T
import qualified Data.Text.Encoding as E
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.Orchard (getSaplingFromUA, isValidUnifiedAddress)
import ZcashHaskell.Transparent (encodeTransparentReceiver)
import ZcashHaskell.Types
  ( UnifiedAddress(..)
  , 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)
  , _selPool :: !ZcashPool
  } deriving (Eq, Show)

makeLenses ''AppModel

data AppEvent
  = AppInit
  | ShowMsg !T.Text
  | CloseMsg
  | WalletClicked
  | AccountClicked
  | SetPool !ZcashPool
  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))
    currentAddress =
      if null (model ^. addresses)
        then Nothing
        else Just ((model ^. addresses) !! (model ^. selAddr))
    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 $
      vstack
        [ 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]
        , addrQRCode currentAddress (model ^. selPool)
        ]
    addrQRCode ::
         Maybe (Entity WalletAddress)
      -> ZcashPool
      -> WidgetNode AppModel AppEvent
    addrQRCode wAddr zp =
      case encodeText (defaultQRCodeOptions L) Utf8WithoutECI =<< dispAddr of
        Just qr ->
          box_
            [alignMiddle]
            (hstack
               [ filler
               , vstack
                   [ box_
                       [onClick (SetPool Orchard)]
                       (remixIcon remixShieldCheckFill `styleBasic`
                        [ textSize 14
                        , padding 4
                        , styleIf
                            (model ^. selPool == Orchard)
                            (bgColor btnColor)
                        ])
                   , filler
                   , box_
                       [onClick (SetPool Sapling)]
                       (remixIcon remixShieldLine `styleBasic`
                        [ textSize 14
                        , padding 4
                        , styleIf
                            (model ^. selPool == Sapling)
                            (bgColor btnColor)
                        ])
                   , filler
                   , box_
                       [onClick (SetPool Transparent)]
                       (remixIcon remixDislikeLine `styleBasic`
                        [ textSize 14
                        , padding 4
                        , styleIf
                            (model ^. selPool == Transparent)
                            (bgColor btnColor)
                        ])
                   ]
               , vstack
                   [ label
                       (case model ^. selPool of
                          Orchard -> "Unified"
                          Sapling -> "Legacy Shielded"
                          Transparent -> "Transparent"
                          Sprout -> "Unknown")
                   , imageMem_
                       (T.pack $ show zp)
                       (qrCodeBytes qr)
                       (qrCodeSize qr)
                       [fitNone]
                   ]
               , filler
               ])
        Nothing ->
          box_ [alignMiddle] (image_ "./assets/2620_color.png" [fitFill])
      where
        qrCodeImg :: QRImage -> Image PixelRGBA8
        qrCodeImg qr = promoteImage (toImage 4 1 qr)
        qrCodeSize :: QRImage -> Size
        qrCodeSize qr =
          Size
            (fromIntegral $ imageWidth $ qrCodeImg qr)
            (fromIntegral $ imageHeight $ qrCodeImg qr)
        qrCodeBytes :: QRImage -> BS.ByteString
        qrCodeBytes qr =
          BS.pack $
          pixelFold
            (\bs _ _ (PixelRGBA8 i j k l) -> bs <> [i, j, k, l])
            []
            (qrCodeImg qr)
        dispAddr :: Maybe T.Text
        dispAddr =
          case zp of
            Transparent ->
              T.append "zcash:" . encodeTransparentReceiver (model ^. network) <$>
              (t_rec =<<
               (isValidUnifiedAddress .
                E.encodeUtf8 . getUA . walletAddressUAddress . entityVal) =<<
               wAddr)
            Sapling ->
              T.append "zcash:" <$>
              (getSaplingFromUA .
               E.encodeUtf8 . getUA . walletAddressUAddress . entityVal =<<
               wAddr)
            Orchard ->
              T.append "zcash:" . getUA . walletAddressUAddress . entityVal <$>
              wAddr
            Sprout -> Nothing
    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!"]
    SetPool p -> [Model $ model & selPool .~ p]
    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)
                  Transparent
          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)
              Orchard
      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
      ]