diff --git a/assets/1F928_color.png b/assets/1F928_color.png new file mode 100644 index 0000000..10095c0 Binary files /dev/null and b/assets/1F928_color.png differ diff --git a/src/Zenith/GUI.hs b/src/Zenith/GUI.hs index 7b01f6b..cb3b28f 100644 --- a/src/Zenith/GUI.hs +++ b/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 - then Event $ ShowMsg $ "You saved wallet: " <> model ^. mainInput - else Event $ ShowError "Invalid input" - , Event ConfirmCancel - ] + if T.length (model ^. mainInput) > 1 + then [Task addNewWallet, Event ConfirmCancel] + else [Event $ ShowError "Invalid input"] 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 =