src/Zenith/GUI.hs

@@ -11,7 +11,8 @@ 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 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)
@@ -22,7 +23,9 @@ import Lens.Micro.TH
 import Monomer
 import qualified Monomer.Lens as L
 import System.Hclip
-import TextShow
+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
@@ -44,6 +47,7 @@ data AppEvent
   = AppInit
   | ShowMsg !T.Text
   | ShowError !T.Text
+  | ShowModal !T.Text
   | CloseMsg
   | WalletClicked
   | AccountClicked
@@ -61,6 +65,7 @@ data AppEvent
   | LoadTxs ![Entity UserTx]
   | LoadAddrs ![Entity WalletAddress]
   | LoadAccs ![Entity ZcashAccount]
+  | LoadWallets ![Entity ZcashWallet]
   | ConfirmCancel
   | SaveAddress !(Maybe (Entity ZcashAccount))
   | SaveAccount !(Maybe (Entity ZcashWallet))
@@ -68,6 +73,9 @@ data AppEvent
   | CloseSeed
   | ShowSeed
   | CopySeed !T.Text
+  | CopyTx !T.Text
+  | CloseTx
+  | ShowTx !Int
   deriving (Eq, Show)
 
 data AppModel = AppModel
@@ -98,6 +106,8 @@ data AppModel = AppModel
   , _confirmEvent :: !AppEvent
   , _inError :: !Bool
   , _showSeed :: !Bool
+  , _modalMsg :: !(Maybe T.Text)
+  , _showTx :: !(Maybe Int)
   } deriving (Eq, Show)
 
 makeLenses ''AppModel
@@ -135,6 +145,8 @@ buildUI wenv model = widgetTree
         , confirmOverlay `nodeVisible` isJust (model ^. confirmTitle)
         , seedOverlay `nodeVisible` model ^. showSeed
         , msgOverlay `nodeVisible` isJust (model ^. msg)
+        , txOverlay `nodeVisible` isJust (model ^. showTx)
+        , modalOverlay `nodeVisible` isJust (model ^. modalMsg)
         ]
     mainWindow =
       vstack
@@ -383,7 +395,7 @@ buildUI wenv model = widgetTree
                                  (fromIntegral $ qrCodeWidth qr))
                               [fitWidth]
                           Nothing ->
-                            image_ "./assets/2620_color.png" [fitEither]) `styleBasic`
+                            image_ "./assets/1F928_color.png" [fitEither]) `styleBasic`
                      [bgColor white, height 100, width 100]
                    , filler
                    ] `styleBasic`
@@ -418,7 +430,7 @@ buildUI wenv model = widgetTree
     txRow :: Int -> Entity UserTx -> WidgetNode AppModel AppEvent
     txRow idx tx =
       box_
-        [onClick $ ShowMsg ("You clicked transaction " <> showt idx)]
+        [onClick $ ShowTx idx]
         (hstack
            [ label
                (T.pack $
@@ -515,6 +527,75 @@ buildUI wenv model = widgetTree
             , 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]
+                   , box_
+                       []
+                       (remixIcon remixFileCopyFill `styleBasic`
+                        [textColor white]) `styleBasic`
+                     [bgColor btnColor, radius 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]
+            ]
 
 generateQRCodes :: Config -> IO ()
 generateQRCodes config = do
@@ -592,10 +673,11 @@ handleEvent ::
   -> [AppEventResponse AppModel AppEvent]
 handleEvent wenv node model evt =
   case evt of
-    AppInit -> []
+    AppInit -> [Event NewWallet | isNothing currentWallet]
     ShowMsg t -> [Model $ model & msg ?~ t & menuPopup .~ False]
     ShowError t ->
       [Model $ model & msg ?~ t & menuPopup .~ False & inError .~ True]
+    ShowModal t -> [Model $ model & modalMsg ?~ t]
     WalletClicked -> [Model $ model & walPopup .~ True]
     AccountClicked -> [Model $ model & accPopup .~ True]
     MenuClicked -> [Model $ model & menuPopup .~ True]
@@ -635,6 +717,7 @@ handleEvent wenv node model evt =
     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]
@@ -645,13 +728,11 @@ handleEvent wenv node model evt =
              ]
         else [Event $ ShowError "Invalid input", Event ConfirmCancel]
     SaveWallet ->
-      [ if T.length (model ^. mainInput) > 1
+      if T.length (model ^. mainInput) > 1
-          then Event $ ShowMsg $ "You saved wallet: " <> model ^. mainInput
+        then [Task addNewWallet, Event ConfirmCancel]
-          else Event $ ShowError "Invalid input"
+        else [Event $ ShowError "Invalid input"]
-      , Event ConfirmCancel
-      ]
     SetPool p ->
-      [ Model $ model & selPool .~ p
+      [ Model $ model & selPool .~ p & modalMsg .~ Nothing
       , Task $
         SwitchQr <$> do
           dbPool <- runNoLoggingT $ initPool $ c_dbPath $ model ^. configuration
@@ -687,7 +768,8 @@ handleEvent wenv node model evt =
             Just wal -> runNoLoggingT $ getAccounts dbPool $ entityKey wal
       ]
     CopyAddr a ->
-      [ setClipboardData $
+      [ setClipboardData ClipboardEmpty
+      , setClipboardData $
         ClipboardText $
         case model ^. selPool of
           Orchard -> maybe "None" (getUA . walletAddressUAddress . entityVal) a
@@ -706,20 +788,35 @@ handleEvent wenv node model evt =
       , Event $ ShowMsg "Copied address!"
       ]
     CopySeed s ->
-      [ setClipboardData $ ClipboardText 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 $ SetPool Orchard]
+        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 0]
+        else [Event NewWallet]
     CloseMsg -> [Model $ model & msg .~ Nothing & inError .~ False]
     CloseSeed -> [Model $ model & showSeed .~ False]
+    CloseTx -> [Model $ model & showTx .~ Nothing]
+    ShowTx i -> [Model $ model & showTx ?~ i]
   where
     currentWallet =
       if null (model ^. wallets)
@@ -781,6 +878,35 @@ handleEvent wenv node model evt =
                 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
+
+txtWrap :: T.Text -> T.Text
+txtWrap = wrapText (WrapSettings False True NoFill FillAfterFirst) 32
 
 runZenithGUI :: Config -> IO ()
 runZenithGUI config = do
@@ -848,6 +974,8 @@ runZenithGUI config = do
                      else Nothing)
                   False
                   False
+                  Nothing
+                  Nothing
           startApp model handleEvent buildUI params
     Left e -> do
       initDb dbFilePath
@@ -882,6 +1010,8 @@ runZenithGUI config = do
               (SaveAddress Nothing)
               False
               False
+              Nothing
+              Nothing
       startApp model handleEvent buildUI params
   where
     params =