Enable QR codes for addresses
This commit is contained in:
parent
e098480223
commit
dbbce675f5
GPG key ID:
65122AD495A7F5B2
3 changed files with 127 additions and 10 deletions
BIN
assets/2620_color.png
Normal file
BIN
assets/2620_color.png
Normal file
Binary file not shown.
|
After Width: | Height: | Size: 17 KiB |
|
|
@ -3,10 +3,17 @@
|
|||
|
||||
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)
|
||||
|
|
@ -14,8 +21,11 @@ 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(..)
|
||||
)
|
||||
|
|
@ -40,6 +50,7 @@ data AppModel = AppModel
|
|||
, _zebraOn :: !Bool
|
||||
, _balance :: !Integer
|
||||
, _unconfBalance :: !(Maybe Integer)
|
||||
, _selPool :: !ZcashPool
|
||||
} deriving (Eq, Show)
|
||||
|
||||
makeLenses ''AppModel
|
||||
|
|
@ -50,6 +61,7 @@ data AppEvent
|
|||
| CloseMsg
|
||||
| WalletClicked
|
||||
| AccountClicked
|
||||
| SetPool !ZcashPool
|
||||
deriving (Eq, Show)
|
||||
|
||||
remixArrowRightWideLine :: T.Text
|
||||
|
|
@ -75,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 =
|
||||
|
|
@ -142,15 +158,110 @@ buildUI wenv model = widgetTree
|
|||
]
|
||||
addressBox =
|
||||
boxShadow $
|
||||
box_
|
||||
[alignMiddle]
|
||||
(vstack
|
||||
[ label "Addresses" `styleBasic`
|
||||
[textFont "Bold", textColor white, bgColor btnColor]
|
||||
, vscroll (vstack (zipWith addrRow [0 ..] (model ^. addresses))) `nodeKey`
|
||||
"addrScroll"
|
||||
]) `styleBasic`
|
||||
[padding 3, radius 2, bgColor white]
|
||||
vstack
|
||||
[ box_
|
||||
[alignMiddle]
|
||||
(vstack
|
||||
[ label "Addresses" `styleBasic`
|
||||
[textFont "Bold", textColor white, bgColor btnColor]
|
||||
, 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_
|
||||
|
|
@ -228,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 ()
|
||||
|
|
@ -275,6 +387,7 @@ runZenithGUI config = do
|
|||
True
|
||||
314259000
|
||||
(Just 300000)
|
||||
Transparent
|
||||
startApp model handleEvent buildUI params
|
||||
Left e -> do
|
||||
initDb dbFilePath
|
||||
|
|
@ -296,6 +409,7 @@ runZenithGUI config = do
|
|||
False
|
||||
314259000
|
||||
(Just 30000)
|
||||
Orchard
|
||||
startApp model handleEvent buildUI params
|
||||
where
|
||||
params =
|
||||
|
|
|
|||
|
|
@ -60,6 +60,9 @@ library
|
|||
, http-client
|
||||
, http-conduit
|
||||
, http-types
|
||||
, JuicyPixels
|
||||
, qrcode-core
|
||||
, qrcode-juicypixels
|
||||
, microlens
|
||||
, microlens-mtl
|
||||
, microlens-th
|
||||
|
|
|
|||
Loading…
Reference in a new issue