Milestone 2: Graphic User Interface #93
3 changed files with 93 additions and 11 deletions
|
@ -15,6 +15,7 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0
|
||||||
- Balance display
|
- Balance display
|
||||||
- Account selector
|
- Account selector
|
||||||
- Menu for new addresses, accounts, wallets
|
- Menu for new addresses, accounts, wallets
|
||||||
|
- Dialog to add new address
|
||||||
|
|
||||||
|
|
||||||
## [0.5.3.0-beta]
|
## [0.5.3.0-beta]
|
||||||
|
|
|
@ -233,6 +233,8 @@ constraints: any.Cabal ==3.8.1.0,
|
||||||
any.psqueues ==0.2.8.0,
|
any.psqueues ==0.2.8.0,
|
||||||
any.pureMD5 ==2.1.4,
|
any.pureMD5 ==2.1.4,
|
||||||
pureMD5 -test,
|
pureMD5 -test,
|
||||||
|
any.qrcode-core ==0.9.9,
|
||||||
|
any.qrcode-juicypixels ==0.8.5,
|
||||||
any.quickcheck-io ==0.2.0,
|
any.quickcheck-io ==0.2.0,
|
||||||
any.quickcheck-transformer ==0.3.1.2,
|
any.quickcheck-transformer ==0.3.1.2,
|
||||||
any.random ==1.2.1.2,
|
any.random ==1.2.1.2,
|
||||||
|
|
|
@ -26,7 +26,10 @@ import TextShow
|
||||||
import ZcashHaskell.Orchard (getSaplingFromUA, isValidUnifiedAddress)
|
import ZcashHaskell.Orchard (getSaplingFromUA, isValidUnifiedAddress)
|
||||||
import ZcashHaskell.Transparent (encodeTransparentReceiver)
|
import ZcashHaskell.Transparent (encodeTransparentReceiver)
|
||||||
import ZcashHaskell.Types
|
import ZcashHaskell.Types
|
||||||
( UnifiedAddress(..)
|
( Phrase(..)
|
||||||
|
, Scope(..)
|
||||||
|
, ToBytes(..)
|
||||||
|
, UnifiedAddress(..)
|
||||||
, ZcashNet(..)
|
, ZcashNet(..)
|
||||||
, ZebraGetBlockChainInfo(..)
|
, ZebraGetBlockChainInfo(..)
|
||||||
, ZebraGetInfo(..)
|
, ZebraGetInfo(..)
|
||||||
|
@ -34,7 +37,7 @@ import ZcashHaskell.Types
|
||||||
import Zenith.Core
|
import Zenith.Core
|
||||||
import Zenith.DB
|
import Zenith.DB
|
||||||
import Zenith.GUI.Theme
|
import Zenith.GUI.Theme
|
||||||
import Zenith.Types hiding (ZcashAddress)
|
import Zenith.Types hiding (ZcashAddress(..))
|
||||||
import Zenith.Utils (displayAmount, showAddress)
|
import Zenith.Utils (displayAmount, showAddress)
|
||||||
|
|
||||||
data AppEvent
|
data AppEvent
|
||||||
|
@ -62,6 +65,9 @@ data AppEvent
|
||||||
| SaveAddress
|
| SaveAddress
|
||||||
| SaveAccount
|
| SaveAccount
|
||||||
| SaveWallet
|
| SaveWallet
|
||||||
|
| CloseSeed
|
||||||
|
| ShowSeed
|
||||||
|
| CopySeed !T.Text
|
||||||
deriving (Eq, Show)
|
deriving (Eq, Show)
|
||||||
|
|
||||||
data AppModel = AppModel
|
data AppModel = AppModel
|
||||||
|
@ -91,6 +97,7 @@ data AppModel = AppModel
|
||||||
, _confirmCancel :: !T.Text
|
, _confirmCancel :: !T.Text
|
||||||
, _confirmEvent :: !AppEvent
|
, _confirmEvent :: !AppEvent
|
||||||
, _inError :: !Bool
|
, _inError :: !Bool
|
||||||
|
, _showSeed :: !Bool
|
||||||
} deriving (Eq, Show)
|
} deriving (Eq, Show)
|
||||||
|
|
||||||
makeLenses ''AppModel
|
makeLenses ''AppModel
|
||||||
|
@ -126,6 +133,7 @@ buildUI wenv model = widgetTree
|
||||||
zstack
|
zstack
|
||||||
[ mainWindow
|
[ mainWindow
|
||||||
, confirmOverlay `nodeVisible` isJust (model ^. confirmTitle)
|
, confirmOverlay `nodeVisible` isJust (model ^. confirmTitle)
|
||||||
|
, seedOverlay `nodeVisible` model ^. showSeed
|
||||||
, msgOverlay `nodeVisible` isJust (model ^. msg)
|
, msgOverlay `nodeVisible` isJust (model ^. msg)
|
||||||
]
|
]
|
||||||
mainWindow =
|
mainWindow =
|
||||||
|
@ -187,7 +195,7 @@ buildUI wenv model = widgetTree
|
||||||
, widgetIf (model ^. newPopup) $ animSlideIn newBox
|
, widgetIf (model ^. newPopup) $ animSlideIn newBox
|
||||||
]) `styleBasic`
|
]) `styleBasic`
|
||||||
[bgColor white, borderB 1 gray, padding 3]
|
[bgColor white, borderB 1 gray, padding 3]
|
||||||
, box_ [alignLeft] (label "Backup Wallet") `styleBasic`
|
, box_ [alignLeft, onClick ShowSeed] (label "Backup Wallet") `styleBasic`
|
||||||
[bgColor white, borderB 1 gray, padding 3]
|
[bgColor white, borderB 1 gray, padding 3]
|
||||||
]) `styleBasic`
|
]) `styleBasic`
|
||||||
[bgColor btnColor, padding 3]
|
[bgColor btnColor, padding 3]
|
||||||
|
@ -252,7 +260,10 @@ buildUI wenv model = widgetTree
|
||||||
, styleIf (model ^. selAcc == idx) (borderL 2 btnHiLite)
|
, styleIf (model ^. selAcc == idx) (borderL 2 btnHiLite)
|
||||||
, styleIf (model ^. selAcc == idx) (borderR 2 btnHiLite)
|
, styleIf (model ^. selAcc == idx) (borderR 2 btnHiLite)
|
||||||
]
|
]
|
||||||
mainPane = box_ [alignMiddle] $ hstack [addressBox, txBox]
|
mainPane =
|
||||||
|
box_ [alignMiddle] $
|
||||||
|
hstack
|
||||||
|
[addressBox, txBox `nodeVisible` not (null $ model ^. transactions)]
|
||||||
balanceBox =
|
balanceBox =
|
||||||
hstack
|
hstack
|
||||||
[ filler
|
[ filler
|
||||||
|
@ -450,9 +461,10 @@ buildUI wenv model = widgetTree
|
||||||
alert CloseMsg $
|
alert CloseMsg $
|
||||||
hstack
|
hstack
|
||||||
[ filler
|
[ filler
|
||||||
, image_ "./assets/1F616_color.png" [fitHeight] `styleBasic`
|
, remixIcon remixErrorWarningFill `styleBasic`
|
||||||
[height 44, width 44] `nodeVisible`
|
[textSize 32, textColor btnColor] `nodeVisible`
|
||||||
(model ^. inError)
|
(model ^. inError)
|
||||||
|
, spacer
|
||||||
, label $ fromMaybe "" (model ^. msg)
|
, label $ fromMaybe "" (model ^. msg)
|
||||||
, filler
|
, filler
|
||||||
]
|
]
|
||||||
|
@ -465,6 +477,44 @@ buildUI wenv model = widgetTree
|
||||||
, cancelCaption $ model ^. confirmCancel
|
, cancelCaption $ model ^. confirmCancel
|
||||||
]
|
]
|
||||||
(hstack [label "Name:", filler, textField_ mainInput [maxLength 25]])
|
(hstack [label "Name:", filler, textField_ mainInput [maxLength 25]])
|
||||||
|
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
|
||||||
|
]
|
||||||
|
]
|
||||||
|
|
||||||
generateQRCodes :: Config -> IO ()
|
generateQRCodes :: Config -> IO ()
|
||||||
generateQRCodes config = do
|
generateQRCodes config = do
|
||||||
|
@ -581,12 +631,13 @@ handleEvent wenv node model evt =
|
||||||
False
|
False
|
||||||
]
|
]
|
||||||
ConfirmCancel -> [Model $ model & confirmTitle .~ Nothing & mainInput .~ ""]
|
ConfirmCancel -> [Model $ model & confirmTitle .~ Nothing & mainInput .~ ""]
|
||||||
|
ShowSeed -> [Model $ model & showSeed .~ True & menuPopup .~ False]
|
||||||
SaveAddress ->
|
SaveAddress ->
|
||||||
[ if T.length (model ^. mainInput) > 1
|
if T.length (model ^. mainInput) > 1
|
||||||
then Event $ ShowMsg $ "You saved address: " <> model ^. mainInput
|
then [ Task $ addNewAddress (model ^. mainInput) External currentAccount
|
||||||
else Event $ ShowError "Invalid input"
|
, Event ConfirmCancel
|
||||||
, Event ConfirmCancel
|
]
|
||||||
]
|
else [Event $ ShowError "Invalid input", Event ConfirmCancel]
|
||||||
SaveAccount ->
|
SaveAccount ->
|
||||||
[ if T.length (model ^. mainInput) > 1
|
[ if T.length (model ^. mainInput) > 1
|
||||||
then Event $ ShowMsg $ "You saved account: " <> model ^. mainInput
|
then Event $ ShowMsg $ "You saved account: " <> model ^. mainInput
|
||||||
|
@ -654,10 +705,15 @@ handleEvent wenv node model evt =
|
||||||
a
|
a
|
||||||
, Event $ ShowMsg "Copied address!"
|
, Event $ ShowMsg "Copied address!"
|
||||||
]
|
]
|
||||||
|
CopySeed s ->
|
||||||
|
[ setClipboardData $ ClipboardText s
|
||||||
|
, Event $ ShowMsg "Copied seed phrase!"
|
||||||
|
]
|
||||||
LoadTxs t -> [Model $ model & transactions .~ t]
|
LoadTxs t -> [Model $ model & transactions .~ t]
|
||||||
LoadAddrs a -> [Model $ model & addresses .~ a, Event $ SetPool Orchard]
|
LoadAddrs a -> [Model $ model & addresses .~ a, Event $ SetPool Orchard]
|
||||||
LoadAccs a -> [Model $ model & accounts .~ a, Event $ SwitchAcc 0]
|
LoadAccs a -> [Model $ model & accounts .~ a, Event $ SwitchAcc 0]
|
||||||
CloseMsg -> [Model $ model & msg .~ Nothing & inError .~ False]
|
CloseMsg -> [Model $ model & msg .~ Nothing & inError .~ False]
|
||||||
|
CloseSeed -> [Model $ model & showSeed .~ False]
|
||||||
where
|
where
|
||||||
currentWallet =
|
currentWallet =
|
||||||
if null (model ^. wallets)
|
if null (model ^. wallets)
|
||||||
|
@ -679,6 +735,27 @@ handleEvent wenv node model evt =
|
||||||
if null (model ^. addresses)
|
if null (model ^. addresses)
|
||||||
then Nothing
|
then Nothing
|
||||||
else Just ((model ^. addresses) !! (model ^. selAddr))
|
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
|
||||||
|
|
||||||
runZenithGUI :: Config -> IO ()
|
runZenithGUI :: Config -> IO ()
|
||||||
runZenithGUI config = do
|
runZenithGUI config = do
|
||||||
|
@ -742,6 +819,7 @@ runZenithGUI config = do
|
||||||
""
|
""
|
||||||
SaveAddress
|
SaveAddress
|
||||||
False
|
False
|
||||||
|
False
|
||||||
startApp model handleEvent buildUI params
|
startApp model handleEvent buildUI params
|
||||||
Left e -> do
|
Left e -> do
|
||||||
initDb dbFilePath
|
initDb dbFilePath
|
||||||
|
@ -775,6 +853,7 @@ runZenithGUI config = do
|
||||||
""
|
""
|
||||||
SaveAddress
|
SaveAddress
|
||||||
False
|
False
|
||||||
|
False
|
||||||
startApp model handleEvent buildUI params
|
startApp model handleEvent buildUI params
|
||||||
where
|
where
|
||||||
params =
|
params =
|
||||||
|
|
Loading…
Reference in a new issue