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.Concurrent (threadDelay)
import Control.Exception (throwIO, try)
import Control.Monad.IO.Class (liftIO)
import Control.Monad.Logger (runFileLoggingT, runNoLoggingT)
import Data.Aeson
import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as LBS
import Data.HexString (toText)
import Data.Maybe (fromJust, fromMaybe, isJust, isNothing)
import qualified Data.Text as T
import qualified Data.Text.Encoding as E
import Data.Time.Clock.POSIX (posixSecondsToUTCTime)
import Database.Esqueleto.Experimental (ConnectionPool)
import Database.Persist
import Lens.Micro ((&), (+~), (.~), (?~), (^.), set)
import Lens.Micro.TH
import Monomer
import qualified Monomer.Lens as L
import System.Directory (getHomeDirectory)
import System.FilePath ((</>))
import System.Hclip
import Text.Printf
import Text.Wrap (FillScope(..), FillStrategy(..), WrapSettings(..), wrapText)
import TextShow hiding (toText)
import ZcashHaskell.Keys (generateWalletSeedPhrase)
import ZcashHaskell.Orchard (getSaplingFromUA, isValidUnifiedAddress)
import ZcashHaskell.Transparent (encodeTransparentReceiver)
import ZcashHaskell.Types
  ( BlockResponse(..)
  , Phrase(..)
  , Scope(..)
  , ToBytes(..)
  , UnifiedAddress(..)
  , ZcashNet(..)
  , ZebraGetBlockChainInfo(..)
  , ZebraGetInfo(..)
  )
import ZcashHaskell.Utils (getBlockTime, makeZebraCall)
import Zenith.Core
import Zenith.DB
import Zenith.GUI.Theme
import Zenith.Scanner (processTx, updateConfs)
import Zenith.Types hiding (ZcashAddress(..))
import Zenith.Utils
  ( displayAmount
  , isRecipientValid
  , jsonNumber
  , parseAddress
  , showAddress
  , validBarValue
  )

data AppEvent
  = AppInit
  | ShowMsg !T.Text
  | ShowError !T.Text
  | ShowModal !T.Text
  | CloseMsg
  | WalletClicked
  | AccountClicked
  | MenuClicked
  | NewClicked
  | NewAddress !(Maybe (Entity ZcashAccount))
  | NewAccount !(Maybe (Entity ZcashWallet))
  | NewWallet
  | SetPool !ZcashPool
  | SwitchQr !(Maybe QrCode)
  | SwitchAddr !Int
  | SwitchAcc !Int
  | SwitchWal !Int
  | UpdateBalance !(Integer, Integer)
  | CopyAddr !(Maybe (Entity WalletAddress))
  | LoadTxs ![Entity UserTx]
  | LoadAddrs ![Entity WalletAddress]
  | LoadAccs ![Entity ZcashAccount]
  | LoadWallets ![Entity ZcashWallet]
  | ConfirmCancel
  | SaveAddress !(Maybe (Entity ZcashAccount))
  | SaveAccount !(Maybe (Entity ZcashWallet))
  | SaveWallet
  | CloseSeed
  | CloseTxId
  | ShowSeed
  | CopySeed !T.Text
  | CopyTx !T.Text
  | CloseTx
  | ShowTx !Int
  | TickUp
  | SyncVal !Float
  | SendTx
  | ShowSend
  | CancelSend
  | CheckRecipient !T.Text
  | CheckAmount !Float
  | ShowTxId !T.Text
  deriving (Eq, Show)

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
  , _qrCodeWidget :: !(Maybe QrCode)
  , _accPopup :: !Bool
  , _walPopup :: !Bool
  , _menuPopup :: !Bool
  , _newPopup :: !Bool
  , _mainInput :: !T.Text
  , _confirmTitle :: !(Maybe T.Text)
  , _confirmAccept :: !T.Text
  , _confirmCancel :: !T.Text
  , _confirmEvent :: !AppEvent
  , _inError :: !Bool
  , _showSeed :: !Bool
  , _modalMsg :: !(Maybe T.Text)
  , _showTx :: !(Maybe Int)
  , _timer :: !Int
  , _barValue :: !Float
  , _openSend :: !Bool
  , _sendRecipient :: !T.Text
  , _sendAmount :: !Float
  , _sendMemo :: !T.Text
  , _recipientValid :: !Bool
  , _amountValid :: !Bool
  , _showId :: !(Maybe T.Text)
  , _home :: !FilePath
  } deriving (Eq, Show)

makeLenses ''AppModel

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
        , confirmOverlay `nodeVisible` isJust (model ^. confirmTitle)
        , seedOverlay `nodeVisible` model ^. showSeed
        , txOverlay `nodeVisible` isJust (model ^. showTx)
        , sendTxOverlay `nodeVisible` model ^. openSend
        , txIdOverlay `nodeVisible` isJust (model ^. showId)
        , msgOverlay `nodeVisible` isJust (model ^. msg)
        , modalOverlay `nodeVisible` isJust (model ^. modalMsg)
        ]
    mainWindow =
      vstack
        [ windowHeader
        , spacer
        , balanceBox
        , filler
        , mainPane
        , filler
        , windowFooter
        ]
    windowHeader =
      hstack
        [ vstack
            [ box_
                [onClick MenuClicked, alignMiddle]
                (remixIcon remixMenuFill `styleBasic`
                 [textSize 16, textColor white]) `styleBasic`
              [cursorHand, height 25, padding 3] `styleHover`
              [bgColor btnHiLite]
            , popup menuPopup menuBox
            ]
        , vstack
            [ box_ [onClick WalletClicked, alignMiddle] walletButton `styleBasic`
              [cursorHand, height 25, padding 3] `styleHover`
              [bgColor btnHiLite]
            , popup walPopup walListPopup
            ]
        , vstack
            [ box_ [onClick AccountClicked, alignMiddle] accountButton `styleBasic`
              [cursorHand, height 25, padding 3] `styleHover`
              [bgColor btnHiLite]
            , popup accPopup accListPopup
            ]
        , filler
        , remixIcon remixErrorWarningFill `styleBasic` [textColor white]
        , label "Testnet" `styleBasic` [textColor white] `nodeVisible`
          (model ^. network == TestNet)
        ] `styleBasic`
      [bgColor btnColor]
    menuBox =
      box_
        [alignMiddle]
        (vstack
           [ box_
               [alignLeft]
               (vstack
                  [ box_
                      [alignLeft, onClick NewClicked]
                      (hstack
                         [ label "New"
                         , filler
                         , widgetIf (not $ model ^. newPopup) $
                           remixIcon remixMenuUnfoldFill
                         , widgetIf (model ^. newPopup) $
                           remixIcon remixMenuFoldFill
                         ])
                  , widgetIf (model ^. newPopup) $ animSlideIn newBox
                  ]) `styleBasic`
             [bgColor white, borderB 1 gray, padding 3]
           , box_ [alignLeft, onClick ShowSeed] (label "Backup Wallet") `styleBasic`
             [bgColor white, borderB 1 gray, padding 3]
           ]) `styleBasic`
      [bgColor btnColor, padding 3]
    newBox =
      box_
        [alignMiddle]
        (vstack
           [ box_
               [alignLeft, onClick $ NewAddress currentAccount]
               (hstack [label "Address", filler]) `styleBasic`
             [bgColor white, borderB 1 gray, padding 3]
           , box_
               [alignLeft, onClick $ NewAccount currentWallet]
               (hstack [label "Account", filler]) `styleBasic`
             [bgColor white, borderB 1 gray, padding 3]
           , box_
               [alignLeft, onClick NewWallet]
               (hstack [label "Wallet", filler]) `styleBasic`
             [bgColor white, borderB 1 gray, padding 3]
           ])
    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]
        ]
    walListPopup =
      box_ [alignMiddle] dispWalList `styleBasic` [bgColor btnColor, padding 3]
    dispWalList = vstack (zipWith walRow [0 ..] (model ^. wallets))
    walRow :: Int -> Entity ZcashWallet -> WidgetNode AppModel AppEvent
    walRow idx wal =
      box_
        [onClick $ SwitchWal idx, alignCenter]
        (label (zcashWalletName (entityVal wal))) `styleBasic`
      [ padding 1
      , borderB 1 gray
      , bgColor white
      , width 80
      , styleIf (model ^. selWallet == idx) (borderL 2 btnHiLite)
      , styleIf (model ^. selWallet == idx) (borderR 2 btnHiLite)
      ]
    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]
        ]
    accListPopup =
      box_ [alignMiddle] dispAccList `styleBasic` [bgColor btnColor, padding 3]
    dispAccList = vstack (zipWith accRow [0 ..] (model ^. accounts))
    accRow :: Int -> Entity ZcashAccount -> WidgetNode AppModel AppEvent
    accRow idx wAcc =
      box_
        [onClick $ SwitchAcc idx, alignLeft]
        (label (zcashAccountName (entityVal wAcc))) `styleBasic`
      [ padding 1
      , borderB 1 gray
      , bgColor white
      , width 80
      , styleIf (model ^. selAcc == idx) (borderL 2 btnHiLite)
      , styleIf (model ^. selAcc == idx) (borderR 2 btnHiLite)
      ]
    mainPane =
      box_ [alignMiddle] $
      hstack
        [ addressBox
        , vstack
            [ mainButton "Send" ShowSend `styleBasic` [textFont "Bold"]
            , txBox `nodeVisible` not (null $ model ^. transactions)
            ]
        ]
    balanceBox =
      hstack
        [ filler
        , boxShadow $
          box_
            [alignMiddle]
            (vstack
               [ hstack
                   [ filler
                   , animFadeIn
                       (label
                          (displayAmount (model ^. network) $ model ^. balance) `styleBasic`
                        [textSize 20])
                   , filler
                   ]
               , hstack
                   [ filler
                   , remixIcon remixHourglassFill `styleBasic` [textSize 8]
                   , label
                       (maybe "0" (displayAmount (model ^. network)) $
                        model ^. unconfBalance) `styleBasic`
                     [textSize 8]
                   , filler
                   ] `nodeVisible`
                 isJust (model ^. unconfBalance)
               ]) `styleBasic`
          [bgColor white, radius 5, border 1 btnColor]
        , filler
        ]
    addressBox =
      vstack
        [ 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]
        , addrQRCode
        ]
    addrQRCode :: WidgetNode AppModel AppEvent
    addrQRCode =
      box_
        [alignMiddle]
        (hstack
           [ filler
           , boxShadow $
             hstack
               [ vstack
                   [ tooltip "Unified" $
                     box_
                       [onClick (SetPool Orchard)]
                       (remixIcon remixShieldCheckFill `styleBasic`
                        [ textSize 14
                        , padding 4
                        , styleIf
                            (model ^. selPool == Orchard)
                            (bgColor btnColor)
                        , styleIf
                            (model ^. selPool == Orchard)
                            (textColor white)
                        ])
                   , filler
                   , tooltip "Legacy Shielded" $
                     box_
                       [onClick (SetPool Sapling)]
                       (remixIcon remixShieldLine `styleBasic`
                        [ textSize 14
                        , padding 4
                        , styleIf
                            (model ^. selPool == Sapling)
                            (bgColor btnColor)
                        , styleIf
                            (model ^. selPool == Sapling)
                            (textColor white)
                        ])
                   , filler
                   , tooltip "Transparent" $
                     box_
                       [onClick (SetPool Transparent)]
                       (remixIcon remixEyeLine `styleBasic`
                        [ textSize 14
                        , padding 4
                        , styleIf
                            (model ^. selPool == Transparent)
                            (bgColor btnColor)
                        , styleIf
                            (model ^. selPool == Transparent)
                            (textColor white)
                        ])
                   ] `styleBasic`
                 [bgColor white]
               , vstack
                   [ filler
                   , tooltip "Copy" $
                     box_
                       [onClick $ CopyAddr currentAddress]
                       (hstack
                          [ label
                              (case model ^. selPool of
                                 Orchard -> "Unified"
                                 Sapling -> "Legacy Shielded"
                                 Transparent -> "Transparent"
                                 Sprout -> "Unknown") `styleBasic`
                            [textColor white]
                          , remixIcon remixFileCopyFill `styleBasic`
                            [textSize 14, padding 4, textColor white]
                          ]) `styleBasic`
                     [cursorHand]
                   , box_
                       [alignMiddle]
                       (case model ^. qrCodeWidget of
                          Just qr ->
                            imageMem_
                              (qrCodeName qr)
                              (qrCodeBytes qr)
                              (Size
                                 (fromIntegral $ qrCodeHeight qr)
                                 (fromIntegral $ qrCodeWidth qr))
                              [fitWidth]
                          Nothing ->
                            image_
                              (T.pack $
                               (model ^. home) </>
                               "Zenith/assets/1F928_color.png")
                              [fitEither]) `styleBasic`
                     [bgColor white, height 100, width 100]
                   , filler
                   ] `styleBasic`
                 [bgColor btnColor, border 2 btnColor]
               ] `styleBasic`
             [radius 3, border 1 btnColor]
           , filler
           ])
    addrRow :: Int -> Entity WalletAddress -> WidgetNode AppModel AppEvent
    addrRow idx wAddr =
      box_
        [onClick $ SwitchAddr idx, alignLeft]
        (label
           (walletAddressName (entityVal wAddr) <>
            ": " <> showAddress (walletAddressUAddress $ entityVal wAddr))) `styleBasic`
      [ padding 1
      , borderB 1 gray
      , styleIf (model ^. selAddr == idx) (borderL 2 btnHiLite)
      , styleIf (model ^. selAddr == idx) (borderR 2 btnHiLite)
      ]
    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 $ ShowTx 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]
        , spacer
        , label (showt $ model ^. timer) `styleBasic` [padding 3, textSize 8]
        , filler
        , image_
            (T.pack $ (model ^. home) </> "Zenith/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
        , remixIcon remixErrorWarningFill `styleBasic`
          [textSize 32, textColor btnColor] `nodeVisible`
          (model ^. inError)
        , spacer
        , label $ fromMaybe "" (model ^. msg)
        , filler
        ]
    confirmOverlay =
      confirm_
        (model ^. confirmEvent)
        ConfirmCancel
        [ titleCaption $ fromMaybe "" $ model ^. confirmTitle
        , acceptCaption $ model ^. confirmAccept
        , cancelCaption $ model ^. confirmCancel
        ]
        (hstack [label "Name:", filler, textField_ mainInput [maxLength 25]])
    sendTxOverlay =
      box
        (vstack
           [ filler
           , hstack
               [ filler
               , box_
                   []
                   (vstack
                      [ box_
                          [alignMiddle]
                          (label "Send Zcash" `styleBasic`
                           [textFont "Bold", textSize 12])
                      , separatorLine `styleBasic` [fgColor btnColor]
                      , spacer
                      , hstack
                          [ label "To:" `styleBasic` [width 50]
                          , spacer
                          , textField_ sendRecipient [onChange CheckRecipient] `styleBasic`
                            [ width 150
                            , styleIf
                                (not $ model ^. recipientValid)
                                (textColor red)
                            ]
                          ]
                      , hstack
                          [ label "Amount:" `styleBasic` [width 50]
                          , spacer
                          , numericField_
                              sendAmount
                              [ decimals 8
                              , minValue 0.0
                              , maxValue
                                  (fromIntegral (model ^. balance) / 100000000.0)
                              , validInput amountValid
                              , onChange CheckAmount
                              ] `styleBasic`
                            [ width 150
                            , styleIf
                                (not $ model ^. amountValid)
                                (textColor red)
                            ]
                          ]
                      , hstack
                          [ label "Memo:" `styleBasic` [width 50]
                          , spacer
                          , textArea sendMemo `styleBasic`
                            [width 150, height 40]
                          ]
                      , spacer
                      , box_
                          [alignMiddle]
                          (hstack
                             [ spacer
                             , button "Cancel" CancelSend
                             , spacer
                             , mainButton "Send" SendTx `nodeEnabled`
                               (model ^. amountValid && model ^. recipientValid)
                             , spacer
                             ])
                      ]) `styleBasic`
                 [radius 4, border 2 btnColor, bgColor white, padding 4]
               , filler
               ]
           , filler
           ]) `styleBasic`
      [bgColor (white & L.a .~ 0.5)]
    seedOverlay =
      alert CloseSeed $
      vstack
        [ box_
            []
            (label "Seed Phrase" `styleBasic`
             [textFont "Bold", textSize 12, textColor white]) `styleBasic`
          [bgColor btnColor, radius 2, padding 3]
        , spacer
        , textAreaV_
            (maybe
               "None"
               (E.decodeUtf8Lenient .
                getBytes . getPhrase . zcashWalletSeedPhrase . entityVal)
               currentWallet)
            (const CloseSeed)
            [readOnly, maxLines 2] `styleBasic`
          [textSize 8]
        , spacer
        , hstack
            [ filler
            , box_
                [ onClick $
                  CopySeed $
                  maybe
                    "None"
                    (E.decodeUtf8Lenient .
                     getBytes . getPhrase . zcashWalletSeedPhrase . entityVal)
                    currentWallet
                ]
                (hstack
                   [ label "Copy" `styleBasic` [textColor white]
                   , remixIcon remixFileCopyLine `styleBasic` [textColor white]
                   ]) `styleBasic`
              [cursorHand, bgColor btnColor, radius 2, padding 3]
            , filler
            ]
        ]
    modalOverlay =
      box
        (label (fromMaybe "?" $ model ^. modalMsg) `styleBasic`
         [textSize 12, textFont "Bold"]) `styleBasic`
      [bgColor (white & L.a .~ 0.5)]
    txOverlay =
      case model ^. showTx of
        Nothing -> alert CloseTx $ label "N/A"
        Just i ->
          alert CloseTx $
          vstack
            [ box_
                [alignLeft]
                (hstack
                   [ label "Date  " `styleBasic` [width 60, textFont "Bold"]
                   , separatorLine `styleBasic` [fgColor btnColor]
                   , spacer
                   , label
                       (T.pack $
                        show $
                        posixSecondsToUTCTime $
                        fromIntegral $
                        userTxTime $ entityVal $ (model ^. transactions) !! i)
                   ]) `styleBasic`
              [padding 2, bgColor white, width 280, borderB 1 gray]
            , box_
                [alignLeft]
                (hstack
                   [ label "Tx ID " `styleBasic` [width 60, textFont "Bold"]
                   , separatorLine `styleBasic` [fgColor btnColor]
                   , spacer
                   , label_
                       (txtWrap $
                        toText $
                        getHex $
                        userTxHex $ entityVal $ (model ^. transactions) !! i)
                       [multiline]
                   , spacer
                   , box_
                       [ onClick $
                         CopyTx $
                         toText $
                         getHex $
                         userTxHex $ entityVal $ (model ^. transactions) !! i
                       ]
                       (remixIcon remixFileCopyFill `styleBasic`
                        [textColor white]) `styleBasic`
                     [cursorHand, bgColor btnColor, radius 2, padding 2]
                   ]) `styleBasic`
              [padding 2, bgColor white, width 280, borderB 1 gray]
            , box_
                [alignLeft]
                (hstack
                   [ label "Amount" `styleBasic` [width 60, textFont "Bold"]
                   , separatorLine `styleBasic` [fgColor btnColor]
                   , spacer
                   , label $
                     displayAmount (model ^. network) $
                     fromIntegral $
                     userTxAmount $ entityVal $ (model ^. transactions) !! i
                   ]) `styleBasic`
              [padding 2, bgColor white, width 280, borderB 1 gray]
            , box_
                [alignLeft]
                (hstack
                   [ label "Memo  " `styleBasic` [width 60, textFont "Bold"]
                   , separatorLine `styleBasic` [fgColor btnColor]
                   , spacer
                   , label_
                       (txtWrap $
                        userTxMemo $ entityVal $ (model ^. transactions) !! i)
                       [multiline]
                   ]) `styleBasic`
              [padding 2, bgColor white, width 280, borderB 1 gray]
            ]
    txIdOverlay =
      case model ^. showId of
        Nothing -> alert CloseTxId $ label "N/A"
        Just t ->
          alert CloseTxId $
          box_
            [alignLeft]
            (vstack
               [ box_ [alignMiddle] $
                 label "Transaction Sent!" `styleBasic` [textFont "Bold"]
               , spacer
               , hstack
                   [ label "Tx ID " `styleBasic` [width 60, textFont "Bold"]
                   , separatorLine `styleBasic` [fgColor btnColor]
                   , spacer
                   , label_ (txtWrap t) [multiline]
                   , spacer
                   , box_
                       [onClick $ CopyTx t]
                       (remixIcon remixFileCopyFill `styleBasic`
                        [textColor white]) `styleBasic`
                     [cursorHand, bgColor btnColor, radius 2, padding 2]
                   ]
               ]) `styleBasic`
          [padding 2, bgColor white, width 280, borderB 1 gray, borderT 1 gray]

generateQRCodes :: Config -> IO ()
generateQRCodes config = do
  let dbFilePath = c_dbPath config
  pool <- runNoLoggingT $ initPool dbFilePath
  addrs <- getExternalAddresses pool
  mapM_ (checkExistingQrs pool) addrs
  where
    checkExistingQrs :: ConnectionPool -> Entity WalletAddress -> IO ()
    checkExistingQrs pool wAddr = do
      s <- getQrCodes pool (entityKey wAddr)
      if not (null s)
        then return ()
        else do
          generateOneQr pool Orchard wAddr
          generateOneQr pool Sapling wAddr
          generateOneQr pool Transparent wAddr
    generateOneQr ::
         ConnectionPool -> ZcashPool -> Entity WalletAddress -> IO ()
    generateOneQr p zp wAddr =
      case encodeText (defaultQRCodeOptions L) Utf8WithoutECI =<<
           dispAddr zp (entityVal wAddr) of
        Just qr -> do
          _ <-
            runNoLoggingT $
            saveQrCode p $
            QrCode
              (entityKey wAddr)
              zp
              (qrCodeData qr)
              (qrCodeH qr)
              (qrCodeW qr)
              (walletAddressName (entityVal wAddr) <> T.pack (show zp))
          return ()
        Nothing -> return ()
    qrCodeImg :: QRImage -> Image PixelRGBA8
    qrCodeImg qr = promoteImage (toImage 4 2 qr)
    qrCodeH :: QRImage -> Int
    qrCodeH qr = fromIntegral $ imageHeight $ qrCodeImg qr
    qrCodeW :: QRImage -> Int
    qrCodeW qr = fromIntegral $ imageWidth $ qrCodeImg qr
    qrCodeData :: QRImage -> BS.ByteString
    qrCodeData qr =
      BS.pack $
      pixelFold
        (\bs _ _ (PixelRGBA8 i j k l) -> bs <> [i, j, k, l])
        []
        (qrCodeImg qr)
    dispAddr :: ZcashPool -> WalletAddress -> Maybe T.Text
    dispAddr zp w =
      case zp of
        Transparent ->
          T.append "zcash:" .
          encodeTransparentReceiver
            (maybe
               TestNet
               ua_net
               ((isValidUnifiedAddress .
                 E.encodeUtf8 . getUA . walletAddressUAddress)
                  w)) <$>
          (t_rec =<<
           (isValidUnifiedAddress . E.encodeUtf8 . getUA . walletAddressUAddress)
             w)
        Sapling ->
          T.append "zcash:" <$>
          (getSaplingFromUA . E.encodeUtf8 . getUA . walletAddressUAddress) w
        Orchard -> Just $ (T.append "zcash:" . getUA . walletAddressUAddress) w
        Sprout -> Nothing

handleEvent ::
     WidgetEnv AppModel AppEvent
  -> WidgetNode AppModel AppEvent
  -> AppModel
  -> AppEvent
  -> [AppEventResponse AppModel AppEvent]
handleEvent wenv node model evt =
  case evt of
    AppInit ->
      [Event NewWallet | isNothing currentWallet] <> [Producer timeTicker]
    ShowMsg t -> [Model $ model & msg ?~ t & menuPopup .~ False]
    ShowError t ->
      [ Model $
        model & msg ?~ t & menuPopup .~ False & inError .~ True & modalMsg .~
        Nothing
      ]
    ShowModal t -> [Model $ model & modalMsg ?~ t]
    WalletClicked -> [Model $ model & walPopup .~ True]
    AccountClicked -> [Model $ model & accPopup .~ True]
    MenuClicked -> [Model $ model & menuPopup .~ True]
    NewClicked -> [Model $ model & newPopup .~ not (model ^. newPopup)]
    NewAddress acc ->
      [ Model $
        model & confirmTitle ?~ "New Address" & confirmAccept .~ "Create" &
        confirmCancel .~
        "Cancel" &
        confirmEvent .~
        SaveAddress acc &
        menuPopup .~
        False
      ]
    NewAccount wal ->
      [ Model $
        model & confirmTitle ?~ "New Account" & confirmAccept .~ "Create" &
        confirmCancel .~
        "Cancel" &
        confirmEvent .~
        SaveAccount wal &
        menuPopup .~
        False
      ]
    NewWallet ->
      [ Model $
        model & confirmTitle ?~ "New Wallet" & confirmAccept .~ "Create" &
        confirmCancel .~
        "Cancel" &
        confirmEvent .~
        SaveWallet &
        menuPopup .~
        False
      ]
    ConfirmCancel -> [Model $ model & confirmTitle .~ Nothing & mainInput .~ ""]
    ShowSeed -> [Model $ model & showSeed .~ True & menuPopup .~ False]
    ShowSend -> [Model $ model & openSend .~ True]
    SendTx ->
      case currentAccount of
        Nothing -> [Event $ ShowError "No account available", Event CancelSend]
        Just acc ->
          case currentWallet of
            Nothing ->
              [Event $ ShowError "No wallet available", Event CancelSend]
            Just wal ->
              [ Producer $
                sendTransaction
                  (model ^. configuration)
                  (model ^. network)
                  (entityKey acc)
                  (zcashWalletLastSync $ entityVal wal)
                  (model ^. sendAmount)
                  (model ^. sendRecipient)
                  (model ^. sendMemo)
              , Event CancelSend
              ]
    CancelSend ->
      [ Model $
        model & openSend .~ False & sendRecipient .~ "" & sendAmount .~ 0.0 &
        sendMemo .~
        ""
      ]
    SaveAddress acc ->
      if T.length (model ^. mainInput) > 1
        then [ Task $ addNewAddress (model ^. mainInput) External acc
             , Event $ ShowModal "Generating QR codes..."
             , Event ConfirmCancel
             ]
        else [Event $ ShowError "Invalid input", Event ConfirmCancel]
    SaveAccount wal ->
      if T.length (model ^. mainInput) > 1
        then [ Task $ addNewAccount (model ^. mainInput) wal
             , Event ConfirmCancel
             ]
        else [Event $ ShowError "Invalid input", Event ConfirmCancel]
    SaveWallet ->
      if T.length (model ^. mainInput) > 1
        then [Task addNewWallet, Event ConfirmCancel]
        else [Event $ ShowError "Invalid input"]
    SetPool p ->
      [ Model $ model & selPool .~ p & modalMsg .~ Nothing
      , Task $
        SwitchQr <$> do
          dbPool <- runNoLoggingT $ initPool $ c_dbPath $ model ^. configuration
          case currentAddress of
            Nothing -> return Nothing
            Just wAddr -> getQrCode dbPool p $ entityKey wAddr
      , Task $
        LoadTxs <$> do
          dbPool <- runNoLoggingT $ initPool $ c_dbPath $ model ^. configuration
          case currentAddress of
            Nothing -> return []
            Just wAddr -> getUserTx dbPool $ entityKey wAddr
      ]
    SwitchQr q -> [Model $ model & qrCodeWidget .~ q]
    SwitchAddr i -> [Model $ model & selAddr .~ i, Event $ SetPool Orchard]
    SwitchAcc i ->
      [ Model $ model & selAcc .~ i
      , Task $
        LoadAddrs <$> do
          dbPool <- runNoLoggingT $ initPool $ c_dbPath $ model ^. configuration
          case selectAccount i of
            Nothing -> return []
            Just acc -> runNoLoggingT $ getAddresses dbPool $ entityKey acc
      , Task $
        UpdateBalance <$> do
          dbPool <- runNoLoggingT $ initPool $ c_dbPath $ model ^. configuration
          case selectAccount i of
            Nothing -> return (0, 0)
            Just acc -> do
              b <- getBalance dbPool $ entityKey acc
              u <- getUnconfirmedBalance dbPool $ entityKey acc
              return (b, u)
      , Event $ SetPool Orchard
      ]
    SwitchWal i ->
      [ Model $ model & selWallet .~ i & selAcc .~ 0 & selAddr .~ 0
      , Task $
        LoadAccs <$> do
          dbPool <- runNoLoggingT $ initPool $ c_dbPath $ model ^. configuration
          case selectWallet i of
            Nothing -> return []
            Just wal -> runNoLoggingT $ getAccounts dbPool $ entityKey wal
      ]
    UpdateBalance (b, u) ->
      [ Model $
        model & balance .~ b & unconfBalance .~
        (if u == 0
           then Nothing
           else Just u)
      ]
    CopyAddr a ->
      [ setClipboardData ClipboardEmpty
      , setClipboardData $
        ClipboardText $
        case model ^. selPool of
          Orchard -> maybe "None" (getUA . walletAddressUAddress . entityVal) a
          Sapling ->
            fromMaybe "None" $
            (getSaplingFromUA .
             E.encodeUtf8 . getUA . walletAddressUAddress . entityVal) =<<
            a
          Sprout -> "None"
          Transparent ->
            maybe "None" (encodeTransparentReceiver (model ^. network)) $
            t_rec =<<
            (isValidUnifiedAddress .
             E.encodeUtf8 . getUA . walletAddressUAddress . entityVal) =<<
            a
      , Event $ ShowMsg "Copied address!"
      ]
    CopySeed s ->
      [ setClipboardData ClipboardEmpty
      , setClipboardData $ ClipboardText s
      , Event $ ShowMsg "Copied seed phrase!"
      ]
    CopyTx t ->
      [ setClipboardData ClipboardEmpty
      , setClipboardData $ ClipboardText t
      , Event $ ShowMsg "Copied transaction ID!"
      ]
    LoadTxs t -> [Model $ model & transactions .~ t]
    LoadAddrs a ->
      if not (null a)
        then [ Model $ model & addresses .~ a
             , Event $ SwitchAddr $ model ^. selAddr
             , Event $ SetPool Orchard
             ]
        else [Event $ NewAddress currentAccount]
    LoadAccs a ->
      if not (null a)
        then [Model $ model & accounts .~ a, Event $ SwitchAcc 0]
        else [Event $ NewAccount currentWallet]
    LoadWallets a ->
      if not (null a)
        then [ Model $ model & wallets .~ a
             , Event $ SwitchWal $ model ^. selWallet
             ]
        else [Event NewWallet]
    CloseMsg -> [Model $ model & msg .~ Nothing & inError .~ False]
    CloseSeed -> [Model $ model & showSeed .~ False]
    CloseTx -> [Model $ model & showTx .~ Nothing]
    CloseTxId -> [Model $ model & showId .~ Nothing]
    ShowTx i -> [Model $ model & showTx ?~ i]
    TickUp ->
      if (model ^. timer) < 90
        then [Model $ model & timer .~ (1 + model ^. timer)]
        else if (model ^. barValue) == 1.0
               then [ Model $ model & timer .~ 0 & barValue .~ 0.0
                    , Producer $
                      scanZebra
                        (c_dbPath $ model ^. configuration)
                        (c_zebraHost $ model ^. configuration)
                        (c_zebraPort $ model ^. configuration)
                    ]
               else [Model $ model & timer .~ 0]
    SyncVal i ->
      if (i + model ^. barValue) >= 0.999
        then [ Model $ model & barValue .~ 1.0 & modalMsg .~ Nothing
             , Task $ do
                 case currentWallet of
                   Nothing -> return $ ShowError "No wallet available"
                   Just cW -> do
                     syncWallet (model ^. configuration) cW
                     pool <-
                       runNoLoggingT $
                       initPool $ c_dbPath $ model ^. configuration
                     wL <- getWallets pool (model ^. network)
                     return $ LoadWallets wL
             ]
        else [ Model $
               model & barValue .~ validBarValue (i + model ^. barValue) &
               modalMsg ?~
               ("Wallet Sync: " <>
                T.pack (printf "%.2f%%" (model ^. barValue * 100)))
             ]
    CheckRecipient a -> [Model $ model & recipientValid .~ isRecipientValid a]
    CheckAmount i ->
      [ Model $
        model & amountValid .~
        (i < (fromIntegral (model ^. balance) / 100000000.0))
      ]
    ShowTxId tx -> [Model $ model & showId ?~ tx & modalMsg .~ Nothing]
  where
    currentWallet =
      if null (model ^. wallets)
        then Nothing
        else Just ((model ^. wallets) !! (model ^. selWallet))
    selectWallet i =
      if null (model ^. wallets)
        then Nothing
        else Just ((model ^. wallets) !! i)
    currentAccount =
      if null (model ^. accounts)
        then Nothing
        else Just ((model ^. accounts) !! (model ^. selAcc))
    selectAccount i =
      if null (model ^. accounts)
        then Nothing
        else Just ((model ^. accounts) !! i)
    currentAddress =
      if null (model ^. addresses)
        then Nothing
        else Just ((model ^. addresses) !! (model ^. selAddr))
    addNewAddress ::
         T.Text -> Scope -> Maybe (Entity ZcashAccount) -> IO AppEvent
    addNewAddress n scope acc = do
      case acc of
        Nothing -> return $ ShowError "No account available"
        Just a -> do
          pool <- runNoLoggingT $ initPool $ c_dbPath $ model ^. configuration
          maxAddr <- getMaxAddress pool (entityKey a) scope
          uA <-
            try $ createWalletAddress n (maxAddr + 1) (model ^. network) scope a :: IO
              (Either IOError WalletAddress)
          case uA of
            Left e -> return $ ShowError $ "Error: " <> T.pack (show e)
            Right uA' -> do
              nAddr <- saveAddress pool uA'
              case nAddr of
                Nothing -> return $ ShowError $ "Address already exists: " <> n
                Just _x -> do
                  generateQRCodes $ model ^. configuration
                  addrL <- runNoLoggingT $ getAddresses pool $ entityKey a
                  return $ LoadAddrs addrL
    addNewAccount :: T.Text -> Maybe (Entity ZcashWallet) -> IO AppEvent
    addNewAccount n w = do
      case w of
        Nothing -> return $ ShowError "No wallet available"
        Just w' -> do
          pool <- runNoLoggingT $ initPool $ c_dbPath $ model ^. configuration
          accIx <- getMaxAccount pool $ entityKey w'
          newAcc <-
            try $ createZcashAccount n (accIx + 1) w' :: IO
              (Either IOError ZcashAccount)
          case newAcc of
            Left e -> return $ ShowError "Failed to create account"
            Right newAcc' -> do
              r <- saveAccount pool newAcc'
              case r of
                Nothing -> return $ ShowError "Account already exists"
                Just _x -> do
                  aList <- runNoLoggingT $ getAccounts pool (entityKey w')
                  return $ LoadAccs aList
    addNewWallet :: IO AppEvent
    addNewWallet = do
      sP <- generateWalletSeedPhrase
      pool <- runNoLoggingT $ initPool $ c_dbPath $ model ^. configuration
      bc <-
        try $
        checkBlockChain
          (c_zebraHost $ model ^. configuration)
          (c_zebraPort $ model ^. configuration) :: IO
          (Either IOError ZebraGetBlockChainInfo)
      case bc of
        Left e1 -> return $ ShowError $ T.pack $ show e1
        Right chainInfo -> do
          r <-
            saveWallet pool $
            ZcashWallet
              (model ^. mainInput)
              (ZcashNetDB (model ^. network))
              (PhraseDB sP)
              (zgb_blocks chainInfo)
              0
          case r of
            Nothing -> return $ ShowError "Wallet already exists"
            Just _ -> do
              wL <- getWallets pool (model ^. network)
              return $ LoadWallets wL

scanZebra :: T.Text -> T.Text -> Int -> (AppEvent -> IO ()) -> IO ()
scanZebra dbPath zHost zPort sendMsg = do
  _ <- liftIO $ initDb dbPath
  bStatus <- liftIO $ checkBlockChain zHost zPort
  pool <- runNoLoggingT $ initPool dbPath
  b <- liftIO $ getMinBirthdayHeight pool
  dbBlock <- runNoLoggingT $ getMaxBlock pool
  let sb = max dbBlock b
  confUp <- try $ updateConfs zHost zPort pool :: IO (Either IOError ())
  case confUp of
    Left _e0 -> sendMsg (ShowError "Failed to update unconfirmed transactions")
    Right _ -> do
      if sb > zgb_blocks bStatus || sb < 1
        then sendMsg (ShowError "Invalid starting block for scan")
        else do
          let bList = [(sb + 1) .. (zgb_blocks bStatus)]
          if not (null bList)
            then do
              let step = (1.0 :: Float) / fromIntegral (length bList)
              mapM_ (processBlock pool step) bList
            else sendMsg (SyncVal 1.0)
  where
    processBlock :: ConnectionPool -> Float -> Int -> IO ()
    processBlock pool step bl = do
      r <-
        liftIO $
        makeZebraCall
          zHost
          zPort
          "getblock"
          [Data.Aeson.String $ showt bl, jsonNumber 1]
      case r of
        Left e1 -> sendMsg (ShowError $ showt e1)
        Right blk -> do
          r2 <-
            liftIO $
            makeZebraCall
              zHost
              zPort
              "getblock"
              [Data.Aeson.String $ showt bl, jsonNumber 0]
          case r2 of
            Left e2 -> sendMsg (ShowError $ showt e2)
            Right hb -> do
              let blockTime = getBlockTime hb
              mapM_ (runNoLoggingT . processTx zHost zPort blockTime pool) $
                bl_txs $ addTime blk blockTime
              sendMsg (SyncVal step)
    addTime :: BlockResponse -> Int -> BlockResponse
    addTime bl t =
      BlockResponse
        (bl_confirmations bl)
        (bl_height bl)
        (fromIntegral t)
        (bl_txs bl)

sendTransaction ::
     Config
  -> ZcashNet
  -> ZcashAccountId
  -> Int
  -> Float
  -> T.Text
  -> T.Text
  -> (AppEvent -> IO ())
  -> IO ()
sendTransaction config znet accId bl amt ua memo sendMsg = do
  sendMsg $ ShowModal "Preparing transaction..."
  case parseAddress ua znet of
    Nothing -> sendMsg $ ShowError "Incorrect address"
    Just outUA -> do
      let dbPath = c_dbPath config
      let zHost = c_zebraHost config
      let zPort = c_zebraPort config
      pool <- runNoLoggingT $ initPool dbPath
      res <-
        runFileLoggingT "zenith.log" $
        prepareTx pool zHost zPort znet accId bl amt outUA memo
      case res of
        Left e -> sendMsg $ ShowError $ T.pack $ show e
        Right rawTx -> do
          sendMsg $ ShowModal "Transaction ready, sending to Zebra..."
          resp <-
            makeZebraCall
              zHost
              zPort
              "sendrawtransaction"
              [Data.Aeson.String $ toText rawTx]
          case resp of
            Left e1 -> sendMsg $ ShowError $ "Zebra error: " <> showt e1
            Right txId -> sendMsg $ ShowTxId txId

timeTicker :: (AppEvent -> IO ()) -> IO ()
timeTicker sendMsg = do
  sendMsg TickUp
  threadDelay $ 1000 * 1000
  timeTicker sendMsg

txtWrap :: T.Text -> T.Text
txtWrap = wrapText (WrapSettings False True NoFill FillAfterFirst) 32

runZenithGUI :: Config -> IO ()
runZenithGUI config = do
  homeDir <- try getHomeDirectory :: IO (Either IOError FilePath)
  case homeDir of
    Left e -> print e
    Right hD -> 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
              generateQRCodes config
              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 []
              qr <-
                if not (null addrList)
                  then getQrCode pool Orchard $ entityKey $ head addrList
                  else return Nothing
              bal <-
                if not (null accList)
                  then getBalance pool $ entityKey $ head accList
                  else return 0
              unconfBal <-
                if not (null accList)
                  then getUnconfirmedBalance pool $ entityKey $ head accList
                  else return 0
              let model =
                    AppModel
                      config
                      (zgb_net chainInfo)
                      walList
                      0
                      accList
                      0
                      addrList
                      0
                      txList
                      0
                      Nothing
                      True
                      bal
                      (if unconfBal == 0
                         then Nothing
                         else Just unconfBal)
                      Orchard
                      qr
                      False
                      False
                      False
                      False
                      ""
                      Nothing
                      ""
                      ""
                      (SaveAddress $
                       if not (null accList)
                         then Just (head accList)
                         else Nothing)
                      False
                      False
                      Nothing
                      Nothing
                      0
                      1.0
                      False
                      ""
                      0.0
                      ""
                      False
                      False
                      Nothing
                      hD
              startApp model handleEvent buildUI (params hD)
        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
                  Nothing
                  False
                  False
                  False
                  False
                  ""
                  Nothing
                  ""
                  ""
                  (SaveAddress Nothing)
                  False
                  False
                  Nothing
                  Nothing
                  0
                  1.0
                  False
                  ""
                  0.0
                  ""
                  False
                  False
                  Nothing
                  hD
          startApp model handleEvent buildUI (params hD)
  where
    params hd =
      [ appWindowTitle "Zenith - Zcash Full Node Wallet"
      , appWindowState $ MainWindowNormal (1000, 700)
      , appTheme zenithTheme
      , appFontDef
          "Regular"
          (T.pack $
           hd </>
           "Zenith/assets/Atkinson-Hyperlegible-Regular-102.ttf" --"./assets/DejaVuSansMono.ttf" 
           )
      , appFontDef
          "Bold"
          (T.pack $ hd </> "Zenith/assets/Atkinson-Hyperlegible-Bold-102.ttf")
      , appFontDef
          "Italic"
          (T.pack $ hd </> "Zenith/assets/Atkinson-Hyperlegible-Italic-102.ttf")
      , appFontDef "Remix" (T.pack $ hd </> "Zenith/assets/remixicon.ttf")
      , appDisableAutoScale True
      , appScaleFactor 2.0
      , appInitEvent AppInit
      ]