src/Zenith/GUI.hs

@@ -21,6 +21,7 @@ import Lens.Micro ((&), (+~), (.~), (?~), (^.), set)
 import Lens.Micro.TH
 import Monomer
 import qualified Monomer.Lens as L
+import System.Hclip
 import TextShow
 import ZcashHaskell.Orchard (getSaplingFromUA, isValidUnifiedAddress)
 import ZcashHaskell.Transparent (encodeTransparentReceiver)
@@ -45,6 +46,8 @@ data AppEvent
   | SetPool !ZcashPool
   | SwitchQr !(Maybe QrCode)
   | SwitchAddr !Int
+  | CopyAddr !(Maybe (Entity WalletAddress))
+  | LoadTxs ![Entity UserTx]
   deriving (Eq, Show)
 
 data AppModel = AppModel
@@ -161,9 +164,9 @@ buildUI wenv model = widgetTree
         , filler
         ]
     addressBox =
-      boxShadow $
       vstack
-        [ box_
+        [ boxShadow $
+          box_
             [alignMiddle]
             (vstack
                [ label "Addresses" `styleBasic`
@@ -180,28 +183,41 @@ buildUI wenv model = widgetTree
         [alignMiddle]
         (hstack
            [ filler
-           , vstack
+           , boxShadow $
-               [ box_
+             hstack
+               [ vstack
+                   [ tooltip "Unified" $
+                     box_
                        [onClick (SetPool Orchard)]
                        (remixIcon remixShieldCheckFill `styleBasic`
                         [ textSize 14
                         , padding 4
-                    , styleIf (model ^. selPool == Orchard) (bgColor btnColor)
+                        , styleIf
-                    , styleIf (model ^. selPool == Orchard) (textColor white)
+                            (model ^. selPool == Orchard)
+                            (bgColor btnColor)
+                        , styleIf
+                            (model ^. selPool == Orchard)
+                            (textColor white)
                         ])
                    , filler
-               , box_
+                   , tooltip "Legacy Shielded" $
+                     box_
                        [onClick (SetPool Sapling)]
                        (remixIcon remixShieldLine `styleBasic`
                         [ textSize 14
                         , padding 4
-                    , styleIf (model ^. selPool == Sapling) (bgColor btnColor)
+                        , styleIf
-                    , styleIf (model ^. selPool == Sapling) (textColor white)
+                            (model ^. selPool == Sapling)
+                            (bgColor btnColor)
+                        , styleIf
+                            (model ^. selPool == Sapling)
+                            (textColor white)
                         ])
                    , filler
-               , box_
+                   , tooltip "Transparent" $
+                     box_
                        [onClick (SetPool Transparent)]
-                   (remixIcon remixDislikeLine `styleBasic`
+                       (remixIcon remixEyeLine `styleBasic`
                         [ textSize 14
                         , padding 4
                         , styleIf
@@ -211,8 +227,14 @@ buildUI wenv model = widgetTree
                             (model ^. selPool == Transparent)
                             (textColor white)
                         ])
-               ]
+                   ] `styleBasic`
+                 [bgColor white]
                , vstack
+                   [ filler
+                   , tooltip "Copy" $
+                     box_
+                       [onClick $ CopyAddr currentAddress]
+                       (hstack
                           [ label
                               (case model ^. selPool of
                                  Orchard -> "Unified"
@@ -220,6 +242,10 @@ buildUI wenv model = widgetTree
                                  Transparent -> "Transparent"
                                  Sprout -> "Unknown") `styleBasic`
                             [textColor white]
+                          , remixIcon remixFileCopyFill `styleBasic`
+                            [textSize 14, padding 4, textColor white]
+                          ]) `styleBasic`
+                     [cursorHand]
                    , box_
                        [alignMiddle]
                        (case model ^. qrCodeWidget of
@@ -231,13 +257,16 @@ buildUI wenv model = widgetTree
                                  (fromIntegral $ qrCodeHeight qr)
                                  (fromIntegral $ qrCodeWidth qr))
                               [fitWidth]
-                      Nothing -> image_ "./assets/2620_color.png" [fitEither]) `styleBasic`
+                          Nothing ->
+                            image_ "./assets/2620_color.png" [fitEither]) `styleBasic`
                      [bgColor white, height 100, width 100]
-               ] `styleBasic`
-             [bgColor btnColor, border 2 btnColor]
                    , filler
                    ] `styleBasic`
-         [bgColor white])
+                 [bgColor btnColor, border 2 btnColor]
+               ] `styleBasic`
+             [radius 3, border 1 btnColor]
+           , filler
+           ])
     addrRow :: Int -> Entity WalletAddress -> WidgetNode AppModel AppEvent
     addrRow idx wAddr =
       box_
@@ -395,9 +424,35 @@ handleEvent wenv node model evt =
           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]
+    CopyAddr a ->
+      [ 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!"
+      ]
+    LoadTxs t -> [Model $ model & transactions .~ t]
     CloseMsg -> [Model $ model & msg .~ Nothing]
   where
     currentWallet =
@@ -492,7 +547,7 @@ runZenithGUI config = do
   where
     params =
       [ appWindowTitle "Zenith - Zcash Full Node Wallet"
-      , appWindowState $ MainWindowNormal (1000, 600)
+      , appWindowState $ MainWindowNormal (1000, 700)
       , appTheme zenithTheme
       , appFontDef "Regular" "./assets/Atkinson-Hyperlegible-Regular-102.ttf" --"./assets/DejaVuSansMono.ttf" 
       , appFontDef "Bold" "./assets/Atkinson-Hyperlegible-Bold-102.ttf"

src/Zenith/GUI/Theme.hs

@@ -28,6 +28,20 @@ zenithTheme =
     Nothing
     Nothing &
   L.hover .
+  L.tooltipStyle . L.text ?~
+  TextStyle
+    Nothing
+    (Just . FontSize $ 10)
+    Nothing
+    Nothing
+    (Just black)
+    Nothing
+    Nothing
+    Nothing
+    Nothing
+    Nothing
+    Nothing &
+  L.hover .
   L.labelStyle . L.text ?~
   TextStyle
     Nothing