diff --git a/assets/2620_color.png b/assets/2620_color.png new file mode 100644 index 0000000..ecfdc10 Binary files /dev/null and b/assets/2620_color.png differ diff --git a/src/Zenith/GUI.hs b/src/Zenith/GUI.hs index 0913f5d..2caf5ef 100644 --- a/src/Zenith/GUI.hs +++ b/src/Zenith/GUI.hs @@ -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 = diff --git a/zenith.cabal b/zenith.cabal index 5348b48..402f47d 100644 --- a/zenith.cabal +++ b/zenith.cabal @@ -60,6 +60,9 @@ library , http-client , http-conduit , http-types + , JuicyPixels + , qrcode-core + , qrcode-juicypixels , microlens , microlens-mtl , microlens-th