Enable QR codes for addresses

Reviewed-on: #86

CHANGELOG.md

@@ -9,6 +9,16 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0
 
 - Add GUI module
 
+## [0.5.3.0-beta]
+
+### Changed
+
+- Improved formatting of sync progress
+
+### Fixed
+
+- Wallet sync when no new block has been detected on-chain.
+
 ## [0.5.2.0-beta]
 
 ### Changed

src/Zenith/CLI.hs

@@ -62,7 +62,7 @@ import Control.Monad (forever, void)
 import Control.Monad.IO.Class (liftIO)
 import Control.Monad.Logger (LoggingT, runFileLoggingT, runNoLoggingT)
 import Data.Aeson
-import Data.HexString (toText)
+import Data.HexString (HexString(..), toText)
 import Data.Maybe
 import qualified Data.Text as T
 import qualified Data.Text.Encoding as E
@@ -76,6 +76,7 @@ import Lens.Micro ((&), (.~), (^.), set)
 import Lens.Micro.Mtl
 import Lens.Micro.TH
 import System.Hclip
+import Text.Printf
 import Text.Wrap (FillScope(..), FillStrategy(..), WrapSettings(..), wrapText)
 import ZcashHaskell.Keys (generateWalletSeedPhrase, getWalletSeed)
 import ZcashHaskell.Orchard (getSaplingFromUA, isValidUnifiedAddress)
@@ -138,6 +139,7 @@ data DisplayType
   | MsgDisplay
   | PhraseDisplay
   | TxDisplay
+  | TxIdDisplay
   | SyncDisplay
   | SendDisplay
   | BlankDisplay
@@ -145,6 +147,7 @@ data DisplayType
 data Tick
   = TickVal !Float
   | TickMsg !String
+  | TickTx !HexString
 
 data State = State
   { _network :: !ZcashNet
@@ -169,6 +172,7 @@ data State = State
   , _eventDispatch :: !(BC.BChan Tick)
   , _timer :: !Int
   , _txForm :: !(Form SendInput () Name)
+  , _sentTx :: !(Maybe HexString)
   }
 
 makeLenses ''State
@@ -348,7 +352,7 @@ drawUI s = [splashDialog s, helpDialog s, displayDialog s, inputDialog s, ui s]
                   (str
                      " _____          _ _   _     \n|__  /___ _ __ (_) |_| |__\n  / // _ \\ '_ \\| | __| '_ \\\n / /|  __/ | | | | |_| | | |\n/____\\___|_| |_|_|\\__|_| |_|") <=>
                 C.hCenter
-                  (withAttr titleAttr (str "Zcash Wallet v0.5.2.0-beta")) <=>
+                  (withAttr titleAttr (str "Zcash Wallet v0.5.3.0-beta")) <=>
                 C.hCenter (withAttr blinkAttr $ str "Press any key..."))
         else emptyWidget
     capCommand :: String -> String -> Widget Name
@@ -412,6 +416,16 @@ drawUI s = [splashDialog s, helpDialog s, displayDialog s, inputDialog s, ui s]
           D.renderDialog
             (D.dialog (Just $ txt "Message") Nothing 50)
             (padAll 1 $ strWrap $ st ^. msg)
+        TxIdDisplay ->
+          withBorderStyle unicodeBold $
+          D.renderDialog
+            (D.dialog (Just $ txt "Success") Nothing 50)
+            (padAll 1 $
+             (txt "Tx ID: " <+>
+              txtWrapWith
+                (WrapSettings False True NoFill FillAfterFirst)
+                (maybe "None" toText (st ^. sentTx))) <=>
+             C.hCenter (hBox [capCommand "C" "opy", xCommand]))
         TxDisplay ->
           case L.listSelectedElement $ st ^. transactions of
             Nothing -> emptyWidget
@@ -453,7 +467,7 @@ drawUI s = [splashDialog s, helpDialog s, displayDialog s, inputDialog s, ui s]
                      , (barToDoAttr, P.progressIncompleteAttr)
                      ])
                   (P.progressBar
-                     (Just $ show (st ^. barValue * 100))
+                     (Just $ printf "%.2f%%" (st ^. barValue * 100))
                      (_barValue st))))
         SendDisplay ->
           withBorderStyle unicodeBold $
@@ -590,8 +604,12 @@ scanZebra dbP zHost zPort b eChan = do
       liftIO $ BC.writeBChan eChan $ TickMsg "Invalid starting block for scan"
     else do
       let bList = [(sb + 1) .. (zgb_blocks bStatus)]
-      let step = (1.0 :: Float) / fromIntegral (zgb_blocks bStatus - (sb + 1))
+      if not (null bList)
-      mapM_ (processBlock pool step) bList
+        then do
+          let step =
+                (1.0 :: Float) / fromIntegral (zgb_blocks bStatus - (sb + 1))
+          mapM_ (processBlock pool step) bList
+        else liftIO $ BC.writeBChan eChan $ TickVal 1.0
   where
     processBlock :: ConnectionPool -> Float -> Int -> IO ()
     processBlock pool step bl = do
@@ -640,16 +658,21 @@ appEvent (BT.AppEvent t) = do
         MsgDisplay -> return ()
         PhraseDisplay -> return ()
         TxDisplay -> return ()
+        TxIdDisplay -> return ()
         SyncDisplay -> return ()
         SendDisplay -> do
           BT.modify $ set msg m
         BlankDisplay -> return ()
+    TickTx txid -> do
+      BT.modify $ set sentTx (Just txid)
+      BT.modify $ set displayBox TxIdDisplay
     TickVal v -> do
       case s ^. displayBox of
         AddrDisplay -> return ()
         MsgDisplay -> return ()
         PhraseDisplay -> return ()
         TxDisplay -> return ()
+        TxIdDisplay -> return ()
         SendDisplay -> return ()
         SyncDisplay -> do
           if s ^. barValue == 1.0
@@ -770,6 +793,16 @@ appEvent (BT.VtyEvent e) = do
                MsgDisplay -> BT.modify $ set displayBox BlankDisplay
                PhraseDisplay -> BT.modify $ set displayBox BlankDisplay
                TxDisplay -> BT.modify $ set displayBox BlankDisplay
+               TxIdDisplay -> do
+                 case e of
+                   V.EvKey (V.KChar 'x') [] ->
+                     BT.modify $ set displayBox BlankDisplay
+                   V.EvKey (V.KChar 'c') [] -> do
+                     liftIO $
+                       setClipboard $
+                       T.unpack $ maybe "None" toText (s ^. sentTx)
+                     BT.modify $ set msg "Copied transaction ID!"
+                   _ev -> return ()
                SendDisplay -> BT.modify $ set displayBox BlankDisplay
                SyncDisplay -> BT.modify $ set displayBox BlankDisplay
                BlankDisplay -> do
@@ -1058,6 +1091,7 @@ runZenithCLI config = do
               eventChan
               0
               (mkSendForm 0 $ SendInput "" 0.0 "")
+              Nothing
     Left e -> do
       print $
         "No Zebra node available on port " <>
@@ -1267,7 +1301,7 @@ sendTransaction pool chan zHost zPort znet accId bl amt ua memo = do
           [Data.Aeson.String $ toText rawTx]
       case resp of
         Left e1 -> BC.writeBChan chan $ TickMsg $ "Zebra error: " ++ show e1
-        Right txId -> BC.writeBChan chan $ TickMsg $ "Tx ID: " ++ txId
+        Right txId -> BC.writeBChan chan $ TickTx txId
   where
     parseAddress :: T.Text -> IO UnifiedAddress
     parseAddress a =

src/Zenith/GUI.hs

@@ -3,18 +3,29 @@
 
 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
-  ( ZcashNet(..)
+  ( UnifiedAddress(..)
+  , ZcashNet(..)
   , ZebraGetBlockChainInfo(..)
   , ZebraGetInfo(..)
   )
@@ -39,6 +50,7 @@ data AppModel = AppModel
   , _zebraOn :: !Bool
   , _balance :: !Integer
   , _unconfBalance :: !(Maybe Integer)
+  , _selPool :: !ZcashPool
   } deriving (Eq, Show)
 
 makeLenses ''AppModel
@@ -49,6 +61,7 @@ data AppEvent
   | CloseMsg
   | WalletClicked
   | AccountClicked
+  | SetPool !ZcashPool
   deriving (Eq, Show)
 
 remixArrowRightWideLine :: T.Text
@@ -64,7 +77,7 @@ buildUI ::
      WidgetEnv AppModel AppEvent -> AppModel -> WidgetNode AppModel AppEvent
 buildUI wenv model = widgetTree
   where
-    btnColor = rgbHex "#1818B2"
+    btnColor = rgbHex "#ff5722" --rgbHex "#1818B2"
     btnHiLite = rgbHex "#207DE8"
     currentWallet =
       if null (model ^. wallets)
@@ -74,6 +87,10 @@ buildUI wenv model = widgetTree
       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 =
@@ -95,8 +112,9 @@ buildUI wenv model = widgetTree
           [cursorHand, height 25, padding 3] `styleHover`
           [bgColor btnHiLite]
         , filler
-        , remixIcon remixErrorWarningFill
+        , remixIcon remixErrorWarningFill `styleBasic` [textColor white]
-        , label "Testnet" `nodeVisible` (model ^. network == TestNet)
+        , label "Testnet" `styleBasic` [textColor white] `nodeVisible`
+          (model ^. network == TestNet)
         ] `styleBasic`
       [bgColor btnColor]
     walletButton =
@@ -115,47 +133,177 @@ buildUI wenv model = widgetTree
         ]
     mainPane = box_ [alignMiddle] $ hstack [addressBox, txBox]
     balanceBox =
-      box_
+      hstack
-        [alignMiddle]
+        [ filler
-        (vstack
+        , boxShadow $
-           [ animFadeIn
+          box_
-               (label (displayAmount (model ^. network) $ model ^. balance) `styleBasic`
+            [alignMiddle]
-                [textSize 20])
+            (vstack
-           , hstack
+               [ animFadeIn
-               [ filler
+                   (label (displayAmount (model ^. network) $ model ^. balance) `styleBasic`
-               , remixIcon remixHourglassFill `styleBasic` [textSize 8]
+                    [textSize 20])
-               , label
+               , hstack
-                   (maybe "0" (displayAmount (model ^. network)) $
+                   [ filler
-                    model ^. unconfBalance) `styleBasic`
+                   , remixIcon remixHourglassFill `styleBasic` [textSize 8]
-                 [textSize 8] `nodeVisible`
+                   , label
-                 isJust (model ^. unconfBalance)
+                       (maybe "0" (displayAmount (model ^. network)) $
-               , filler
+                        model ^. unconfBalance) `styleBasic`
-               ]
+                     [textSize 8] `nodeVisible`
-           ])
+                     isJust (model ^. unconfBalance)
+                   , filler
+                   ]
+               ]) `styleBasic`
+          [bgColor white, radius 5, border 1 btnColor]
+        , filler
+        ]
     addressBox =
-      box_
+      boxShadow $
-        [alignMiddle]
+      vstack
-        (vstack
+        [ box_
-           [ label "Addresses:" `styleBasic` [textFont "Regular"]
+            [alignMiddle]
-           , vscroll (vstack (zipWith addrRow [0 ..] (model ^. addresses))) `nodeKey`
+            (vstack
-             "addrScroll"
+               [ label "Addresses" `styleBasic`
-           ]) `styleBasic`
+                 [textFont "Bold", textColor white, bgColor btnColor]
-      [border 1 whiteSmoke]
+               , 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)]
+        [onClick $ ShowMsg ("You clicked address " <> showt idx), alignLeft]
         (label
            (walletAddressName (entityVal wAddr) <>
-            ": " <> showAddress (walletAddressUAddress $ entityVal wAddr)))
+            ": " <> showAddress (walletAddressUAddress $ entityVal wAddr))) `styleBasic`
+      [padding 1, borderB 1 gray]
     txBox =
+      boxShadow $
       box_
         [alignMiddle]
         (vstack
-           [ label "Transactions:" `styleBasic` [textFont "Regular"]
+           [ label "Transactions" `styleBasic`
-           , label "2024-04-05 0.003 ZEC" `styleBasic` [textFont "Regular"]
+             [textFont "Bold", bgColor btnColor, textColor white]
+           , vscroll (vstack (zipWith txRow [0 ..] (model ^. transactions))) `nodeKey`
+             "txScroll"
            ]) `styleBasic`
-      [border 1 whiteSmoke]
+      [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
@@ -191,6 +339,7 @@ handleEvent wenv node model evt =
     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 ()
@@ -238,6 +387,7 @@ runZenithGUI config = do
                   True
                   314259000
                   (Just 300000)
+                  Transparent
           startApp model handleEvent buildUI params
     Left e -> do
       initDb dbFilePath
@@ -259,6 +409,7 @@ runZenithGUI config = do
               False
               314259000
               (Just 30000)
+              Orchard
       startApp model handleEvent buildUI params
   where
     params =

src/Zenith/GUI/Theme.hs

@@ -14,13 +14,13 @@ import qualified Monomer.Lens as L
 
 zenithTheme :: Theme
 zenithTheme =
-  baseTheme zenithThemeColors & L.basic . L.labelStyle . L.text ?~
+  baseTheme zgoThemeColors & L.basic . L.labelStyle . L.text ?~
   TextStyle
     Nothing
     (Just . FontSize $ 10)
     Nothing
     Nothing
-    (Just whiteSmoke)
+    (Just black)
     Nothing
     Nothing
     Nothing
@@ -34,7 +34,7 @@ zenithTheme =
     (Just . FontSize $ 10)
     Nothing
     Nothing
-    (Just whiteSmoke)
+    (Just black)
     Nothing
     Nothing
     Nothing
@@ -122,6 +122,85 @@ zenithThemeColors =
     , tooltipText = white
     }
 
+zgoThemeColors =
+  BaseThemeColors
+    { clearColor = gray10 -- gray12,
+    , sectionColor = gray09 -- gray11,
+    , btnFocusBorder = blue08
+    , btnBgBasic = gray07
+    , btnBgHover = gray07c
+    , btnBgFocus = gray07b
+    , btnBgActive = gray06
+    , btnBgDisabled = gray05
+    , btnText = gray02
+    , btnTextDisabled = gray02
+    , btnMainFocusBorder = blue09
+    , btnMainBgBasic = blue05b
+    , btnMainBgHover = blue06
+    , btnMainBgFocus = blue05c
+    , btnMainBgActive = blue05
+    , btnMainBgDisabled = blue04
+    , btnMainText = white
+    , btnMainTextDisabled = white
+    , dialogBg = white
+    , dialogBorder = white
+    , dialogText = black
+    , dialogTitleText = black
+    , emptyOverlay = gray07 & L.a .~ 0.8
+    , shadow = gray00 & L.a .~ 0.2
+    , externalLinkBasic = blue07
+    , externalLinkHover = blue08
+    , externalLinkFocus = blue07
+    , externalLinkActive = blue06
+    , externalLinkDisabled = gray06
+    , iconBg = gray07
+    , iconFg = gray01
+    , inputIconFg = black
+    , inputBorder = gray06
+    , inputFocusBorder = blue07
+    , inputBgBasic = gray10
+    , inputBgHover = white
+    , inputBgFocus = white
+    , inputBgActive = gray09
+    , inputBgDisabled = gray05
+    , inputFgBasic = gray05
+    , inputFgHover = blue07
+    , inputFgFocus = blue07
+    , inputFgActive = blue06
+    , inputFgDisabled = gray04
+    , inputSndBasic = gray04
+    , inputSndHover = gray05
+    , inputSndFocus = gray05
+    , inputSndActive = gray04
+    , inputSndDisabled = gray03
+    , inputHlBasic = gray06
+    , inputHlHover = blue07
+    , inputHlFocus = blue07
+    , inputHlActive = blue06
+    , inputHlDisabled = gray05
+    , inputSelBasic = gray07
+    , inputSelFocus = blue08
+    , inputText = black
+    , inputTextDisabled = gray02
+    , labelText = black
+    , scrollBarBasic = gray03 & L.a .~ 0.2
+    , scrollThumbBasic = gray01 & L.a .~ 0.2
+    , scrollBarHover = gray07 & L.a .~ 0.8
+    , scrollThumbHover = gray05 & L.a .~ 0.8
+    , slMainBg = white
+    , slNormalBgBasic = transparent
+    , slNormalBgHover = gray09
+    , slNormalText = black
+    , slNormalFocusBorder = blue07
+    , slSelectedBgBasic = gray08
+    , slSelectedBgHover = gray09
+    , slSelectedText = black
+    , slSelectedFocusBorder = blue07
+    , tooltipBorder = gray08
+    , tooltipBg = gray07
+    , tooltipText = black
+    }
+
 --black = rgbHex "#000000"
 {-white = rgbHex "#FFFFFF"-}
 blue01 = rgbHex "#002159"

zenith.cabal

@@ -1,6 +1,6 @@
 cabal-version:    3.0
 name:             zenith
-version:          0.5.2.0-beta
+version:          0.5.3.0-beta
 license:          MIT
 license-file:     LICENSE
 author:           Rene Vergara
@@ -60,6 +60,9 @@ library
     , http-client
     , http-conduit
     , http-types
+    , JuicyPixels
+    , qrcode-core
+    , qrcode-juicypixels
     , microlens
     , microlens-mtl
     , microlens-th