From ee71b7acbb9e17574f7b639cc180816689035d4a Mon Sep 17 00:00:00 2001 From: "Rene V. Vergara" Date: Wed, 15 Jan 2025 22:05:36 -0500 Subject: [PATCH] rvv001 - Issue 0085 - URI support implemented in GUI - Support to generate and display a QR Code containing a ZIP-321 formatted string --- src/Zenith/GUI.hs | 216 ++++++++++++++++++++++++++++++-------------- src/Zenith/Types.hs | 8 ++ src/Zenith/Utils.hs | 1 - 3 files changed, 157 insertions(+), 68 deletions(-) diff --git a/src/Zenith/GUI.hs b/src/Zenith/GUI.hs index 9723f46..9f62edf 100644 --- a/src/Zenith/GUI.hs +++ b/src/Zenith/GUI.hs @@ -22,11 +22,15 @@ import Control.Monad.Logger ) import Data.Aeson import qualified Data.ByteString as BS +import qualified Data.ByteString.Lazy as BL import Data.HexString (toText) import Data.Maybe (fromMaybe, isJust, isNothing) import Data.Scientific (Scientific, fromFloatDigits) +import Data.Text (Text) import qualified Data.Text as T import qualified Data.Text.Encoding as E +import qualified Data.Text.Lazy as TL +import qualified Data.Text.Lazy.Encoding as TLE import Data.Time.Clock.POSIX (posixSecondsToUTCTime) import Database.Esqueleto.Experimental (ConnectionPool, fromSqlKey) import Database.Persist @@ -170,7 +174,7 @@ data AppEvent | ClosePaymentURIForm | PrepareURIString | CloseShowURIOverlay - | ShowURIOverlay !T.Text + | ShowURIOverlay !(Maybe URIQrCode) !T.Text | CopyURIString !T.Text | DisplayPayUsingURI | ClosePayUsingURI @@ -247,6 +251,7 @@ data AppModel = AppModel , _usepmtURIOverlay :: !Bool , _uriString :: !T.Text , _uriAddr :: !T.Text + , _uriQRImage :: !(Maybe URIQrCode) } deriving (Eq, Show) makeLenses ''AppModel @@ -260,6 +265,18 @@ remixHourglassFill = toGlyph 0xF338 remixIcon :: T.Text -> WidgetNode s e remixIcon i = label i `styleBasic` [textFont "Remix", textMiddle] +getURIQRWidth :: Maybe URIQrCode -> Int +getURIQRWidth qr = + case qr of + Nothing -> 0 + Just qr -> round (uriWidth qr) + +getURIQRHeight :: Maybe URIQrCode -> Int +getURIQRHeight qr = + case qr of + Nothing -> 0 + Just qr -> round (uriHeight qr) + buildUI :: WidgetEnv AppModel AppEvent -> AppModel -> WidgetNode AppModel AppEvent buildUI wenv model = widgetTree @@ -1251,66 +1268,112 @@ buildUI wenv model = widgetTree [bgColor (white & L.a .~ 0.5)] -- paymentURIOverlay = - alert ClosePaymentURIForm $ - vstack - [ box_ - [] - (label "Create a Payment URI" `styleBasic` - [textFont "Bold", textColor white, textSize 10, padding 3]) `styleBasic` - [bgColor btnColor, radius 2, padding 3] - , spacer - , hstack - [ filler - , label "Current Address:" `styleBasic` [textFont "Bold"] - , spacer - , label_ (txtWrapN (model ^. uriAddr) 64) [multiline] - , filler - ] - , spacer - , hstack - [ label "Amount : " `styleBasic` [textFont "Bold"] - , numericField_ sendAmount - [ decimals 8 ] - `nodeKey` "floatInput" - `styleBasic` - [ width 150 - , styleIf (model ^. sendAmount <= 0.0) (textColor red) - ] - ] - , spacer - , hstack - [ label "Memo: " `styleBasic` [textFont "Bold"] - , spacer - , textField_ sendMemo [] `styleBasic` [width 300] - ] - , spacer - , hstack - [ filler - , mainButton "Create URI" PrepareURIString `nodeEnabled` - (model ^. sendAmount > 0.0) - , filler - ] - ] `styleBasic` [bgColor (white & L.a .~ 0.5)] - -- + box + (vstack + [ filler + , hstack + [ filler + , box_ + [] + (vstack + [ box_ + [] + (label "Create a Payment URI" `styleBasic` + [textFont "Bold", textColor white, textSize 10, padding 3]) `styleBasic` + [bgColor btnColor, radius 2, padding 3] + , spacer + , hstack + [ filler + , label "Current Address:" `styleBasic` [textFont "Bold"] + , spacer + , label_ (txtWrapN (model ^. uriAddr) 64) [multiline] + , filler + ] + , spacer + , hstack + [ label "Amount : " `styleBasic` [textFont "Bold"] + , numericField_ sendAmount + [ decimals 8 ] + `nodeKey` "floatInput" + `styleBasic` + [ width 150 + , styleIf (model ^. sendAmount <= 0.0) (textColor red) + ] + ] + , spacer + , hstack + [ label "Memo: " `styleBasic` [textFont "Bold"] + , spacer + , textField_ sendMemo [] `styleBasic` [width 300] + ] + , spacer + , hstack + [ filler + , mainButton "Create URI" PrepareURIString `nodeEnabled` + (model ^. sendAmount > 0.0) + , spacer + , button "Cancel" ClosePaymentURIForm + , filler + ] + ]) `styleBasic` + [radius 4, border 2 btnColor, bgColor white, padding 4] + , filler + ] + , filler + ]) `styleBasic` + [bgColor (white & L.a .~ 0.5)] + -- showURIOverlay = - alert CloseShowURIOverlay $ - vstack - [ box_ - [] - (label "Payment URI" `styleBasic` - [textFont "Bold", textColor white, textSize 12, padding 3]) `styleBasic` - [bgColor btnColor, radius 2, padding 3] - , spacer - , hstack - [filler, label_ (txtWrapN (model ^. uriString ) 64) [multiline], filler] - , spacer - , hstack - [ filler - , button "Copy to Clipboard" $ - CopyURIString (model ^. uriString) - , filler - ] - ] + box + (vstack + [ filler + , hstack + [ filler + , box_ + [] + (vstack + [ box_ + [alignMiddle] + (label "Payment URI" `styleBasic` + [textFont "Bold", textColor white, textSize 11, padding 3]) `styleBasic` + [bgColor btnColor, radius 2, padding 3] + , spacer + , hstack + [filler, label_ (txtWrapN (model ^. uriString ) 64) [multiline], filler] + , spacer + , hstack + [ filler + , box_ + [alignMiddle] + -- (image_ (T.pack ((model ^. home) "Zenith/assets/qr_image.png")) [fitFill]) + (case model ^. uriQRImage of + Just img -> imageMem_ "URIQRCode" (uriBytes img) (Size (uriWidth img) (uriHeight img) ) [fitWidth] + Nothing -> image_ + (T.pack $ (model ^. home) "Zenith/assets/cracked_qr.png") + [fitHeight] ) + `styleBasic` [ bgColor white + , height 120 + , width 120 + ] + , filler + ] + , spacer + , hstack + [ filler + , button "Copy to Clipboard" $ + CopyURIString (model ^. uriString) + , spacer + , button "Cancel" CloseShowURIOverlay + , filler + ] + ]) `styleBasic` + [radius 4, border 2 btnColor, bgColor white, padding 4] + , filler + ] + , filler + ] ) `styleBasic` + [bgColor (white & L.a .~ 0.5)] + -- pmtUsingURIOverlay = box (vstack @@ -1848,13 +1911,14 @@ handleEvent wenv node model evt = -- Generate URI -- PrepareURIString -> [ Task $ genURIString (model ^. uriAddr) (model ^. sendAmount) (model ^. sendMemo) ] - ShowURIOverlay uStr -> + ShowURIOverlay qr uStr -> [ Model $ - model & uriString .~ uStr + model & uriString .~ uStr + & uriQRImage .~ qr & paymentURIDisplay .~ False & showURIDisplay .~ True ] - CloseShowURIOverlay -> [ Model $ model & showURIDisplay .~ False & uriString .~ "" ] + CloseShowURIOverlay -> [ Model $ model & showURIDisplay .~ False & uriString .~ "" & uriQRImage .~ Nothing] -- -- Display Pay using URI Form -- @@ -2108,7 +2172,24 @@ handleEvent wenv node model evt = SproutPool -> "None" TransparentPool -> maybe "None" (encodeTransparentReceiver (model ^. network)) $ t_rec =<< (isValidUnifiedAddress . E.encodeUtf8 . getUA . walletAddressUAddress . entityVal) =<< a - return $ DisplayPaymentURIForm ua + return $ DisplayPaymentURIForm ua + -- + -- Generate a QR code for a String and save it as an PNG image + -- + genURIStringQR :: Int -> T.Text -> Maybe URIQrCode + genURIStringQR scaleFactor uriStr = do + let qrOptions = defaultQRCodeOptions L + case encodeText qrOptions Utf8WithoutECI uriStr of + Nothing -> Nothing + Just qrCode -> do + let qri = promoteImage (toImage 4 scaleFactor qrCode) + let qrw = fromIntegral $ imageWidth qri + let qrh = fromIntegral $ imageHeight qri + let qrb = BS.pack $ + pixelFold (\bs _ _ (PixelRGBA8 i j k l) -> bs <> [i, j, k, l]) + [] + qri + Just URIQrCode { uriBytes=qrb, uriWidth=qrw, uriHeight=qrh } -- -- Gen URI String -- @@ -2116,9 +2197,9 @@ handleEvent wenv node model evt = genURIString addr mAmt mMemo = do let mM = case mMemo of "" -> Nothing - _ -> Just (T.unpack mMemo) - let uriSt = createZip321 (T.unpack addr) (Just (realToFrac mAmt)) mM - return $ ShowURIOverlay (T.pack uriSt) + _ -> Just (T.unpack mMemo) + let uriSt = createZip321 (T.unpack addr) (Just (realToFrac mAmt)) mM + return $ ShowURIOverlay (genURIStringQR 3 (T.pack uriSt)) (T.pack uriSt) scanZebra :: T.Text @@ -2475,6 +2556,7 @@ runZenithGUI config = do False "" "" + Nothing startApp model handleEvent buildUI (params hD) Left _e -> print "Zebra not available" where diff --git a/src/Zenith/Types.hs b/src/Zenith/Types.hs index da2b4f5..1e0e0b2 100644 --- a/src/Zenith/Types.hs +++ b/src/Zenith/Types.hs @@ -517,3 +517,11 @@ data ZcashPaymentURI = ZcashPaymentURI , uriLabel :: Maybe String , uriMessage :: Maybe String } deriving (Show, Eq) + +-- | Define a data structure for the URI QR image +data URIQrCode = URIQrCode + { + uriBytes :: BS.ByteString -- Image as ByteString + , uriWidth :: Double -- Number of columns in QR Image + , uriHeight :: Double -- Number of rows in a QR Image + } deriving (Show, Eq) diff --git a/src/Zenith/Utils.hs b/src/Zenith/Utils.hs index 1a43456..c9781bd 100644 --- a/src/Zenith/Utils.hs +++ b/src/Zenith/Utils.hs @@ -17,7 +17,6 @@ import Data.Functor (void) import Data.Maybe import Data.Ord (clamp) import Data.Scientific (Scientific(..), scientific, Scientific, toRealFloat) ---import Data.Scientific (Scientific, toRealFloat) import qualified Data.Text as T import qualified Data.Text.Encoding as E import qualified Data.Text.Encoding as TE