Implement reading QR codes from database

This commit is contained in:
Rene Vergara 2024-06-06 14:10:58 -05:00
parent 0c5b2952c7
commit eb925c21f7
Signed by: pitmutt
GPG key ID: 65122AD495A7F5B2

View file

@ -15,6 +15,7 @@ import Data.Maybe (fromMaybe, isJust)
import qualified Data.Text as T import qualified Data.Text as T
import qualified Data.Text.Encoding as E import qualified Data.Text.Encoding as E
import Data.Time.Clock.POSIX (posixSecondsToUTCTime) import Data.Time.Clock.POSIX (posixSecondsToUTCTime)
import Database.Esqueleto.Experimental (ConnectionPool)
import Database.Persist import Database.Persist
import Lens.Micro ((&), (+~), (.~), (?~), (^.), set) import Lens.Micro ((&), (+~), (.~), (?~), (^.), set)
import Lens.Micro.TH import Lens.Micro.TH
@ -35,6 +36,17 @@ 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
= AppInit
| ShowMsg !T.Text
| CloseMsg
| WalletClicked
| AccountClicked
| SetPool !ZcashPool
| SwitchQr !(Maybe QrCode)
| SwitchAddr !Int
deriving (Eq, Show)
data AppModel = AppModel data AppModel = AppModel
{ _configuration :: !Config { _configuration :: !Config
, _network :: !ZcashNet , _network :: !ZcashNet
@ -51,19 +63,11 @@ data AppModel = AppModel
, _balance :: !Integer , _balance :: !Integer
, _unconfBalance :: !(Maybe Integer) , _unconfBalance :: !(Maybe Integer)
, _selPool :: !ZcashPool , _selPool :: !ZcashPool
, _qrCodeWidget :: !(Maybe QrCode)
} deriving (Eq, Show) } deriving (Eq, Show)
makeLenses ''AppModel makeLenses ''AppModel
data AppEvent
= AppInit
| ShowMsg !T.Text
| CloseMsg
| WalletClicked
| AccountClicked
| SetPool !ZcashPool
deriving (Eq, Show)
remixArrowRightWideLine :: T.Text remixArrowRightWideLine :: T.Text
remixArrowRightWideLine = toGlyph 0xF496 remixArrowRightWideLine = toGlyph 0xF496
@ -168,15 +172,10 @@ buildUI wenv model = widgetTree
"addrScroll" "addrScroll"
]) `styleBasic` ]) `styleBasic`
[padding 3, radius 2, bgColor white] [padding 3, radius 2, bgColor white]
, addrQRCode currentAddress (model ^. selPool) , addrQRCode
] ]
addrQRCode :: addrQRCode :: WidgetNode AppModel AppEvent
Maybe (Entity WalletAddress) addrQRCode =
-> ZcashPool
-> WidgetNode AppModel AppEvent
addrQRCode wAddr zp =
case encodeText (defaultQRCodeOptions L) Utf8WithoutECI =<< dispAddr of
Just qr ->
box_ box_
[alignMiddle] [alignMiddle]
(hstack (hstack
@ -187,9 +186,8 @@ buildUI wenv model = widgetTree
(remixIcon remixShieldCheckFill `styleBasic` (remixIcon remixShieldCheckFill `styleBasic`
[ textSize 14 [ textSize 14
, padding 4 , padding 4
, styleIf , styleIf (model ^. selPool == Orchard) (bgColor btnColor)
(model ^. selPool == Orchard) , styleIf (model ^. selPool == Orchard) (textColor white)
(bgColor btnColor)
]) ])
, filler , filler
, box_ , box_
@ -197,9 +195,8 @@ buildUI wenv model = widgetTree
(remixIcon remixShieldLine `styleBasic` (remixIcon remixShieldLine `styleBasic`
[ textSize 14 [ textSize 14
, padding 4 , padding 4
, styleIf , styleIf (model ^. selPool == Sapling) (bgColor btnColor)
(model ^. selPool == Sapling) , styleIf (model ^. selPool == Sapling) (textColor white)
(bgColor btnColor)
]) ])
, filler , filler
, box_ , box_
@ -210,6 +207,9 @@ buildUI wenv model = widgetTree
, styleIf , styleIf
(model ^. selPool == Transparent) (model ^. selPool == Transparent)
(bgColor btnColor) (bgColor btnColor)
, styleIf
(model ^. selPool == Transparent)
(textColor white)
]) ])
] ]
, vstack , vstack
@ -218,58 +218,38 @@ buildUI wenv model = widgetTree
Orchard -> "Unified" Orchard -> "Unified"
Sapling -> "Legacy Shielded" Sapling -> "Legacy Shielded"
Transparent -> "Transparent" Transparent -> "Transparent"
Sprout -> "Unknown") Sprout -> "Unknown") `styleBasic`
, imageMem_ [textColor white]
(T.pack $ show zp) , box_
[alignMiddle]
(case model ^. qrCodeWidget of
Just qr ->
imageMem_
(qrCodeName qr)
(qrCodeBytes qr) (qrCodeBytes qr)
(qrCodeSize qr) (Size
[fitNone] (fromIntegral $ qrCodeHeight qr)
] (fromIntegral $ qrCodeWidth qr))
[fitWidth]
Nothing -> image_ "./assets/2620_color.png" [fitEither]) `styleBasic`
[bgColor white, height 100, width 100]
] `styleBasic`
[bgColor btnColor, border 2 btnColor]
, filler , filler
]) ] `styleBasic`
Nothing -> [bgColor white])
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 :: Int -> Entity WalletAddress -> WidgetNode AppModel AppEvent
addrRow idx wAddr = addrRow idx wAddr =
box_ box_
[onClick $ ShowMsg ("You clicked address " <> showt idx), alignLeft] [onClick $ SwitchAddr idx, alignLeft]
(label (label
(walletAddressName (entityVal wAddr) <> (walletAddressName (entityVal wAddr) <>
": " <> showAddress (walletAddressUAddress $ entityVal wAddr))) `styleBasic` ": " <> showAddress (walletAddressUAddress $ entityVal wAddr))) `styleBasic`
[padding 1, borderB 1 gray] [ padding 1
, borderB 1 gray
, styleIf (model ^. selAddr == idx) (borderL 2 btnHiLite)
, styleIf (model ^. selAddr == idx) (borderR 2 btnHiLite)
]
txBox = txBox =
boxShadow $ boxShadow $
box_ box_
@ -327,6 +307,74 @@ buildUI wenv model = widgetTree
alert CloseMsg $ alert CloseMsg $
hstack [filler, label $ fromMaybe "" (model ^. msg), filler] hstack [filler, label $ fromMaybe "" (model ^. msg), filler]
generateQRCodes :: Config -> IO ()
generateQRCodes config = do
let dbFilePath = c_dbPath config
pool <- runNoLoggingT $ initPool dbFilePath
addrs <- getExternalAddresses pool
mapM_ (checkExistingQrs pool) addrs
where
checkExistingQrs :: ConnectionPool -> Entity WalletAddress -> IO ()
checkExistingQrs pool wAddr = do
s <- getQrCodes pool (entityKey wAddr)
if not (null s)
then return ()
else do
generateOneQr pool Orchard wAddr
generateOneQr pool Sapling wAddr
generateOneQr pool Transparent wAddr
generateOneQr ::
ConnectionPool -> ZcashPool -> Entity WalletAddress -> IO ()
generateOneQr p zp wAddr =
case encodeText (defaultQRCodeOptions L) Utf8WithoutECI =<<
dispAddr zp (entityVal wAddr) of
Just qr -> do
_ <-
runNoLoggingT $
saveQrCode p $
QrCode
(entityKey wAddr)
zp
(qrCodeData qr)
(qrCodeH qr)
(qrCodeW qr)
(walletAddressName (entityVal wAddr) <> T.pack (show zp))
return ()
Nothing -> return ()
qrCodeImg :: QRImage -> Image PixelRGBA8
qrCodeImg qr = promoteImage (toImage 4 2 qr)
qrCodeH :: QRImage -> Int
qrCodeH qr = fromIntegral $ imageHeight $ qrCodeImg qr
qrCodeW :: QRImage -> Int
qrCodeW qr = fromIntegral $ imageWidth $ qrCodeImg qr
qrCodeData :: QRImage -> BS.ByteString
qrCodeData qr =
BS.pack $
pixelFold
(\bs _ _ (PixelRGBA8 i j k l) -> bs <> [i, j, k, l])
[]
(qrCodeImg qr)
dispAddr :: ZcashPool -> WalletAddress -> Maybe T.Text
dispAddr zp w =
case zp of
Transparent ->
T.append "zcash:" .
encodeTransparentReceiver
(maybe
TestNet
ua_net
((isValidUnifiedAddress .
E.encodeUtf8 . getUA . walletAddressUAddress)
w)) <$>
(t_rec =<<
(isValidUnifiedAddress . E.encodeUtf8 . getUA . walletAddressUAddress)
w)
Sapling ->
T.append "zcash:" <$>
(getSaplingFromUA . E.encodeUtf8 . getUA . walletAddressUAddress) w
Orchard -> Just $ (T.append "zcash:" . getUA . walletAddressUAddress) w
Sprout -> Nothing
handleEvent :: handleEvent ::
WidgetEnv AppModel AppEvent WidgetEnv AppModel AppEvent
-> WidgetNode AppModel AppEvent -> WidgetNode AppModel AppEvent
@ -339,8 +387,31 @@ handleEvent wenv node model evt =
ShowMsg t -> [Model $ model & msg ?~ t] ShowMsg t -> [Model $ model & msg ?~ t]
WalletClicked -> [Model $ model & msg ?~ "You clicked Wallet!"] WalletClicked -> [Model $ model & msg ?~ "You clicked Wallet!"]
AccountClicked -> [Model $ model & msg ?~ "You clicked Account!"] AccountClicked -> [Model $ model & msg ?~ "You clicked Account!"]
SetPool p -> [Model $ model & selPool .~ p] SetPool p ->
[ Model $ model & selPool .~ p
, Task $
SwitchQr <$> do
dbPool <- runNoLoggingT $ initPool $ c_dbPath $ model ^. configuration
case currentAddress of
Nothing -> return Nothing
Just wAddr -> getQrCode dbPool p $ entityKey wAddr
]
SwitchQr q -> [Model $ model & qrCodeWidget .~ q]
SwitchAddr i -> [Model $ model & selAddr .~ i, Event $ SetPool Orchard]
CloseMsg -> [Model $ model & msg .~ Nothing] CloseMsg -> [Model $ model & msg .~ Nothing]
where
currentWallet =
if null (model ^. wallets)
then Nothing
else Just ((model ^. wallets) !! (model ^. selWallet))
currentAccount =
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))
runZenithGUI :: Config -> IO () runZenithGUI :: Config -> IO ()
runZenithGUI config = do runZenithGUI config = do
@ -358,6 +429,7 @@ runZenithGUI config = do
Left e1 -> throwIO e1 Left e1 -> throwIO e1
Right chainInfo -> do Right chainInfo -> do
initDb dbFilePath initDb dbFilePath
generateQRCodes config
walList <- getWallets pool $ zgb_net chainInfo walList <- getWallets pool $ zgb_net chainInfo
accList <- accList <-
if not (null walList) if not (null walList)
@ -371,6 +443,10 @@ runZenithGUI config = do
if not (null addrList) if not (null addrList)
then getUserTx pool $ entityKey $ head addrList then getUserTx pool $ entityKey $ head addrList
else return [] else return []
qr <-
if not (null addrList)
then getQrCode pool Orchard $ entityKey $ head addrList
else return Nothing
let model = let model =
AppModel AppModel
config config
@ -387,7 +463,8 @@ runZenithGUI config = do
True True
314259000 314259000
(Just 300000) (Just 300000)
Transparent Orchard
qr
startApp model handleEvent buildUI params startApp model handleEvent buildUI params
Left e -> do Left e -> do
initDb dbFilePath initDb dbFilePath
@ -410,10 +487,12 @@ runZenithGUI config = do
314259000 314259000
(Just 30000) (Just 30000)
Orchard Orchard
Nothing
startApp model handleEvent buildUI params startApp model handleEvent buildUI params
where where
params = params =
[ appWindowTitle "Zenith - Zcash Full Node Wallet" [ appWindowTitle "Zenith - Zcash Full Node Wallet"
, appWindowState $ MainWindowNormal (1000, 600)
, appTheme zenithTheme , appTheme zenithTheme
, appFontDef "Regular" "./assets/Atkinson-Hyperlegible-Regular-102.ttf" --"./assets/DejaVuSansMono.ttf" , appFontDef "Regular" "./assets/Atkinson-Hyperlegible-Regular-102.ttf" --"./assets/DejaVuSansMono.ttf"
, appFontDef "Bold" "./assets/Atkinson-Hyperlegible-Bold-102.ttf" , appFontDef "Bold" "./assets/Atkinson-Hyperlegible-Bold-102.ttf"