Enable QR codes for addresses

This commit is contained in:
Rene Vergara 2024-06-06 05:43:24 -05:00
parent e098480223
commit dbbce675f5
Signed by: pitmutt
GPG key ID: 65122AD495A7F5B2
3 changed files with 127 additions and 10 deletions

BIN
assets/2620_color.png Normal file

Binary file not shown.

After

Width:  |  Height:  |  Size: 17 KiB

View file

@ -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,7 +158,8 @@ buildUI wenv model = widgetTree
]
addressBox =
boxShadow $
box_
vstack
[ box_
[alignMiddle]
(vstack
[ label "Addresses" `styleBasic`
@ -151,6 +168,100 @@ buildUI wenv model = widgetTree
"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 =

View file

@ -60,6 +60,9 @@ library
, http-client
, http-conduit
, http-types
, JuicyPixels
, qrcode-core
, qrcode-juicypixels
, microlens
, microlens-mtl
, microlens-th