src/Zenith/DB.hs

@@ -77,7 +77,6 @@ import Zenith.Types
   , TransparentSpendingKeyDB
   , UnifiedAddressDB(..)
   , ZcashNetDB(..)
-  , ZcashPool(..)
   )
 
 share
@@ -247,15 +246,6 @@ share
     position Int
     UniqueSSPos tx position
     deriving Show Eq
-  QrCode
-    address WalletAddressId OnDeleteCascade OnUpdateCascade
-    version ZcashPool
-    bytes BS.ByteString
-    height Int
-    width Int
-    name T.Text
-    UniqueQr address version
-    deriving Show Eq
     |]
 
 -- * Database functions
@@ -426,16 +416,6 @@ getWalletAddresses pool w = do
   addrs <- mapM (getAddresses pool . entityKey) accs
   return $ concat addrs
 
-getExternalAddresses :: ConnectionPool -> IO [Entity WalletAddress]
-getExternalAddresses pool = do
-  runNoLoggingT $
-    PS.retryOnBusy $
-    flip PS.runSqlPool pool $ do
-      select $ do
-        addrs <- from $ table @WalletAddress
-        where_ $ addrs ^. WalletAddressScope ==. val (ScopeDB External)
-        return addrs
-
 -- | Returns the largest address index for the given account
 getMaxAddress ::
      ConnectionPool -- ^ The database path
@@ -568,41 +548,6 @@ getZcashTransactions pool b =
       orderBy [asc $ txs ^. ZcashTransactionBlock]
       return txs
 
--- ** QR codes
--- | Functions to manage the QR codes stored in the database
-saveQrCode ::
-     ConnectionPool -- ^ the connection pool
-  -> QrCode
-  -> NoLoggingT IO (Maybe (Entity QrCode))
-saveQrCode pool qr =
-  PS.retryOnBusy $ flip PS.runSqlPool pool $ insertUniqueEntity qr
-
-getQrCodes ::
-     ConnectionPool -- ^ the connection pool
-  -> WalletAddressId
-  -> IO [Entity QrCode]
-getQrCodes pool wId =
-  runNoLoggingT $
-  PS.retryOnBusy $
-  flip PS.runSqlPool pool $ do
-    select $ do
-      qrs <- from $ table @QrCode
-      where_ $ qrs ^. QrCodeAddress ==. val wId
-      return qrs
-
-getQrCode :: ConnectionPool -> ZcashPool -> WalletAddressId -> IO (Maybe QrCode)
-getQrCode pool zp wId = do
-  r <-
-    runNoLoggingT $
-    PS.retryOnBusy $
-    flip PS.runSqlPool pool $ do
-      selectOne $ do
-        qrs <- from $ table @QrCode
-        where_ $ qrs ^. QrCodeAddress ==. val wId
-        where_ $ qrs ^. QrCodeVersion ==. val zp
-        return qrs
-  return $ entityVal <$> r
-
 -- * Wallet
 -- | Get the block of the last transaction known to the wallet
 getMaxWalletBlock ::

src/Zenith/GUI.hs

@@ -15,7 +15,6 @@ 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.Esqueleto.Experimental (ConnectionPool)
 import Database.Persist
 import Lens.Micro ((&), (+~), (.~), (?~), (^.), set)
 import Lens.Micro.TH
@@ -36,17 +35,6 @@ import Zenith.GUI.Theme
 import Zenith.Types hiding (ZcashAddress)
 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
   { _configuration :: !Config
   , _network :: !ZcashNet
@@ -63,11 +51,19 @@ data AppModel = AppModel
   , _balance :: !Integer
   , _unconfBalance :: !(Maybe Integer)
   , _selPool :: !ZcashPool
-  , _qrCodeWidget :: !(Maybe QrCode)
   } deriving (Eq, Show)
 
 makeLenses ''AppModel
 
+data AppEvent
+  = AppInit
+  | ShowMsg !T.Text
+  | CloseMsg
+  | WalletClicked
+  | AccountClicked
+  | SetPool !ZcashPool
+  deriving (Eq, Show)
+
 remixArrowRightWideLine :: T.Text
 remixArrowRightWideLine = toGlyph 0xF496
 
@@ -172,84 +168,108 @@ buildUI wenv model = widgetTree
                  "addrScroll"
                ]) `styleBasic`
           [padding 3, radius 2, bgColor white]
-        , addrQRCode
+        , addrQRCode currentAddress (model ^. selPool)
         ]
-    addrQRCode :: WidgetNode AppModel AppEvent
+    addrQRCode ::
-    addrQRCode =
+         Maybe (Entity WalletAddress)
-      box_
+      -> ZcashPool
-        [alignMiddle]
+      -> WidgetNode AppModel AppEvent
-        (hstack
+    addrQRCode wAddr zp =
-           [ filler
+      case encodeText (defaultQRCodeOptions L) Utf8WithoutECI =<< dispAddr of
-           , vstack
+        Just qr ->
-               [ box_
+          box_
-                   [onClick (SetPool Orchard)]
+            [alignMiddle]
-                   (remixIcon remixShieldCheckFill `styleBasic`
+            (hstack
-                    [ textSize 14
+               [ filler
-                    , padding 4
+               , vstack
-                    , styleIf (model ^. selPool == Orchard) (bgColor btnColor)
+                   [ box_
-                    , styleIf (model ^. selPool == Orchard) (textColor white)
+                       [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
-               , box_
+               ])
-                   [onClick (SetPool Sapling)]
+        Nothing ->
-                   (remixIcon remixShieldLine `styleBasic`
+          box_ [alignMiddle] (image_ "./assets/2620_color.png" [fitFill])
-                    [ textSize 14
+      where
-                    , padding 4
+        qrCodeImg :: QRImage -> Image PixelRGBA8
-                    , styleIf (model ^. selPool == Sapling) (bgColor btnColor)
+        qrCodeImg qr = promoteImage (toImage 4 1 qr)
-                    , styleIf (model ^. selPool == Sapling) (textColor white)
+        qrCodeSize :: QRImage -> Size
-                    ])
+        qrCodeSize qr =
-               , filler
+          Size
-               , box_
+            (fromIntegral $ imageWidth $ qrCodeImg qr)
-                   [onClick (SetPool Transparent)]
+            (fromIntegral $ imageHeight $ qrCodeImg qr)
-                   (remixIcon remixDislikeLine `styleBasic`
+        qrCodeBytes :: QRImage -> BS.ByteString
-                    [ textSize 14
+        qrCodeBytes qr =
-                    , padding 4
+          BS.pack $
-                    , styleIf
+          pixelFold
-                        (model ^. selPool == Transparent)
+            (\bs _ _ (PixelRGBA8 i j k l) -> bs <> [i, j, k, l])
-                        (bgColor btnColor)
+            []
-                    , styleIf
+            (qrCodeImg qr)
-                        (model ^. selPool == Transparent)
+        dispAddr :: Maybe T.Text
-                        (textColor white)
+        dispAddr =
-                    ])
+          case zp of
-               ]
+            Transparent ->
-           , vstack
+              T.append "zcash:" . encodeTransparentReceiver (model ^. network) <$>
-               [ label
+              (t_rec =<<
-                   (case model ^. selPool of
+               (isValidUnifiedAddress .
-                      Orchard -> "Unified"
+                E.encodeUtf8 . getUA . walletAddressUAddress . entityVal) =<<
-                      Sapling -> "Legacy Shielded"
+               wAddr)
-                      Transparent -> "Transparent"
+            Sapling ->
-                      Sprout -> "Unknown") `styleBasic`
+              T.append "zcash:" <$>
-                 [textColor white]
+              (getSaplingFromUA .
-               , box_
+               E.encodeUtf8 . getUA . walletAddressUAddress . entityVal =<<
-                   [alignMiddle]
+               wAddr)
-                   (case model ^. qrCodeWidget of
+            Orchard ->
-                      Just qr ->
+              T.append "zcash:" . getUA . walletAddressUAddress . entityVal <$>
-                        imageMem_
+              wAddr
-                          (qrCodeName qr)
+            Sprout -> Nothing
-                          (qrCodeBytes qr)
-                          (Size
-                             (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
-           ] `styleBasic`
-         [bgColor white])
     addrRow :: Int -> Entity WalletAddress -> WidgetNode AppModel AppEvent
     addrRow idx wAddr =
       box_
-        [onClick $ SwitchAddr idx, alignLeft]
+        [onClick $ ShowMsg ("You clicked address " <> showt idx), alignLeft]
         (label
            (walletAddressName (entityVal wAddr) <>
             ": " <> showAddress (walletAddressUAddress $ entityVal wAddr))) `styleBasic`
-      [ padding 1
+      [padding 1, borderB 1 gray]
-      , borderB 1 gray
-      , styleIf (model ^. selAddr == idx) (borderL 2 btnHiLite)
-      , styleIf (model ^. selAddr == idx) (borderR 2 btnHiLite)
-      ]
     txBox =
       boxShadow $
       box_
@@ -307,74 +327,6 @@ buildUI wenv model = widgetTree
       alert CloseMsg $
       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 ::
      WidgetEnv AppModel AppEvent
   -> WidgetNode AppModel AppEvent
@@ -387,31 +339,8 @@ 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 ->
+    SetPool p -> [Model $ model & selPool .~ 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]
-  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 = do
@@ -429,7 +358,6 @@ runZenithGUI config = do
         Left e1 -> throwIO e1
         Right chainInfo -> do
           initDb dbFilePath
-          generateQRCodes config
           walList <- getWallets pool $ zgb_net chainInfo
           accList <-
             if not (null walList)
@@ -443,10 +371,6 @@ runZenithGUI config = do
             if not (null addrList)
               then getUserTx pool $ entityKey $ head addrList
               else return []
-          qr <-
-            if not (null addrList)
-              then getQrCode pool Orchard $ entityKey $ head addrList
-              else return Nothing
           let model =
                 AppModel
                   config
@@ -463,8 +387,7 @@ runZenithGUI config = do
                   True
                   314259000
                   (Just 300000)
-                  Orchard
+                  Transparent
-                  qr
           startApp model handleEvent buildUI params
     Left e -> do
       initDb dbFilePath
@@ -487,12 +410,10 @@ runZenithGUI config = do
               314259000
               (Just 30000)
               Orchard
-              Nothing
       startApp model handleEvent buildUI params
   where
     params =
       [ appWindowTitle "Zenith - Zcash Full Node Wallet"
-      , appWindowState $ MainWindowNormal (1000, 600)
       , appTheme zenithTheme
       , appFontDef "Regular" "./assets/Atkinson-Hyperlegible-Regular-102.ttf" --"./assets/DejaVuSansMono.ttf" 
       , appFontDef "Bold" "./assets/Atkinson-Hyperlegible-Bold-102.ttf"

src/Zenith/Types.hs

@@ -143,9 +143,7 @@ data ZcashPool
   | Sprout
   | Sapling
   | Orchard
-  deriving (Show, Read, Eq, Generic, ToJSON)
+  deriving (Show, Eq, Generic, ToJSON)
-
-derivePersistField "ZcashPool"
 
 instance FromJSON ZcashPool where
   parseJSON =