feat: add QR code table upgrade

2024-10-01 12:42:38 -05:00 · 2024-10-01 12:42:38 -05:00 · b6b586f9bf
commit b6b586f9bf
parent adfaed6753
4 changed files with 87 additions and 38 deletions
--- a/src/Zenith/CLI.hs
+++ b/src/Zenith/CLI.hs
@ -10,7 +10,7 @@ import qualified Brick.BChan as BC
 import qualified Brick.Focus as F
 import Brick.Forms
  ( Form(..)
-  , radioField
+  , (@@=)
  , allFieldsValid
  , editShowableFieldWithValidate
  , editTextField
@ -18,10 +18,10 @@ import Brick.Forms
  , handleFormEvent
  , invalidFormInputAttr
  , newForm
+  , radioField
  , renderForm
  , setFieldValid
  , updateFormState
-  , (@@=)
  )
 import qualified Brick.Main as M
 import qualified Brick.Types as BT
@ -99,9 +99,9 @@ import Zenith.Types
  ( Config(..)
  , HexStringDB(..)
  , PhraseDB(..)
+  , PrivacyPolicy(..)
  , UnifiedAddressDB(..)
  , ZcashNetDB(..)
-  , PrivacyPolicy(..)
  )
 import Zenith.Utils
  ( displayTaz
@ -184,7 +184,8 @@ data Tick
  | TickMsg !String
  | TickTx !HexString

-data DropDownItem = DropdownItem String  
+data DropDownItem =
+  DropdownItem String

 data State = State
  { _network :: !ZcashNet
@ -619,7 +620,9 @@ mkSendForm :: Integer -> SendInput -> Form SendInput e Name
 mkSendForm bal =
  newForm
    [ label "Privacy Level :" @@=
-       radioField policyField [ (Full, PrivacyFullField, "Full")
+      radioField
+        policyField
+        [ (Full, PrivacyFullField, "Full")
        , (Medium, PrivacyMediumField, "Medium")
        , (Low, PrivacyLowField, "Low")
        , (None, PrivacyNoneField, "None")
@ -1403,6 +1406,7 @@ runZenithTUI config = do
        Left e1 -> throwIO e1
        Right chainInfo -> do
          x <- initDb dbFilePath
+          _ <- upgradeQrTable pool
          case x of
            Left e2 -> throwIO $ userError e2
            Right x' -> do
--- a/src/Zenith/DB.hs
+++ b/src/Zenith/DB.hs
@ -19,7 +19,7 @@
 module Zenith.DB where

 import Control.Exception (SomeException(..), throw, throwIO, try)
-import Control.Monad (when)
+import Control.Monad (unless, when)
 import Control.Monad.IO.Class (MonadIO, liftIO)
 import Control.Monad.Logger (NoLoggingT, runNoLoggingT)
 import qualified Data.ByteString as BS
@ -448,8 +448,10 @@ initDb dbName = do
          (Either SomeException [T.Text])
      case m of
        Left e2 -> return $ Left $ "Failed to migrate data tables" ++ show e2
-        Right _ -> return $ Right True
-    Right _ -> return $ Right False
+        Right _ -> do
+          return $ Right True
+    Right _ -> do
+      return $ Right False

 initPool :: T.Text -> NoLoggingT IO ConnectionPool
 initPool dbPath = do
@ -839,6 +841,32 @@ getQrCode pool zp wId = do
        return qrs
  return $ entityVal <$> r

+upgradeQrTable :: ConnectionPool -> IO ()
+upgradeQrTable pool = do
+  r <-
+    runNoLoggingT $
+    PS.retryOnBusy $
+    flip PS.runSqlPool pool $
+    selectOne $ do
+      qrs <- from $ table @QrCode
+      where_ $ qrs ^. QrCodeVersion ==. val OrchardPool
+      return countRows
+  unless (maybe 0 (\(Value x) -> x) r > (0 :: Int)) $ do
+    _ <-
+      runNoLoggingT $
+      PS.retryOnBusy $
+      flip PS.runSqlPool pool $ do
+        rawExecute
+          "update qr_code set version = ? where version = ?"
+          [PersistText "OrchardPool", PersistText "Orchard"]
+        rawExecute
+          "update qr_code set version = ? where version = ?"
+          [PersistText "SaplingPool", PersistText "Sapling"]
+        rawExecute
+          "update qr_code set version = ? where version = ?"
+          [PersistText "TransparentPool", PersistText "Transparent"]
+    return ()
+
 -- * Wallet
 -- | Get the block of the last transaction known to the wallet
 getMaxWalletBlock ::
--- a/src/Zenith/GUI.hs
+++ b/src/Zenith/GUI.hs
@ -32,7 +32,11 @@ import Text.Printf
 import Text.Wrap (FillScope(..), FillStrategy(..), WrapSettings(..), wrapText)
 import TextShow hiding (toText)
 import ZcashHaskell.Keys (generateWalletSeedPhrase)
-import ZcashHaskell.Orchard (getSaplingFromUA, isValidUnifiedAddress)
+import ZcashHaskell.Orchard
+  ( getSaplingFromUA
+  , isValidUnifiedAddress
+  , parseAddress
+  )
 import ZcashHaskell.Transparent (encodeTransparentReceiver)
 import ZcashHaskell.Types
  ( BlockResponse(..)
@ -51,13 +55,11 @@ import Zenith.Scanner (checkIntegrity, processTx, rescanZebra, updateConfs)
 import Zenith.Types hiding (ZcashAddress(..))
 import Zenith.Utils
  ( displayAmount
-  , isRecipientValid
  , isRecipientValidGUI
-  , isZecAddressValid
  , isValidString
+  , isZecAddressValid
  , jsonNumber
  , padWithZero
-  , parseAddressUA
  , showAddress
  , validBarValue
  )
@ -605,8 +607,8 @@ buildUI wenv model = widgetTree
                      , separatorLine `styleBasic` [fgColor btnColor]
                      , spacer
                      , hstack
-                          [ 
-                            label "Privacy Level:" `styleBasic` [width 70, textFont "Bold"]
+                          [ label "Privacy Level:" `styleBasic`
+                            [width 70, textFont "Bold"]
                          , spacer
                          , label "Full " `styleBasic` [width 40]
                          , radio Full privacyChoice
@ -615,8 +617,8 @@ buildUI wenv model = widgetTree
                          , radio Medium privacyChoice
                          ]
                      , hstack
-                          [
-                            label "               " `styleBasic` [width 70,  textFont "Bold"]
+                          [ label "               " `styleBasic`
+                            [width 70, textFont "Bold"]
                          , spacer
                          , label "Low " `styleBasic` [width 40]
                          , radio Low privacyChoice
@ -636,7 +638,8 @@ buildUI wenv model = widgetTree
                            ]
                          ]
                      , hstack
-                          [ label "Amount:" `styleBasic` [width 50,  textFont "Bold"]
+                          [ label "Amount:" `styleBasic`
+                            [width 50, textFont "Bold"]
                          , spacer
                          , numericField_
                              sendAmount
@ -654,7 +657,8 @@ buildUI wenv model = widgetTree
                            ]
                          ]
                      , hstack
-                          [ label "Memo:" `styleBasic` [width 50,  textFont "Bold"]
+                          [ label "Memo:" `styleBasic`
+                            [width 50, textFont "Bold"]
                          , spacer
                          , textArea sendMemo `styleBasic`
                            [width 150, height 40]
@ -1079,7 +1083,11 @@ handleEvent wenv node model evt =
      ]
    ConfirmCancel -> [Model $ model & confirmTitle .~ Nothing & mainInput .~ ""]
    ShowSeed -> [Model $ model & showSeed .~ True & menuPopup .~ False]
-    ShowSend -> [Model $ model & openSend .~ True & privacyChoice .~ Full & recipientValid .~ False]
+    ShowSend ->
+      [ Model $
+        model & openSend .~ True & privacyChoice .~ Full & recipientValid .~
+        False
+      ]
    SendTx ->
      case currentAccount of
        Nothing -> [Event $ ShowError "No account available", Event CancelSend]
@ -1097,6 +1105,7 @@ handleEvent wenv node model evt =
                  (model ^. sendAmount)
                  (model ^. sendRecipient)
                  (model ^. sendMemo)
+                  (model ^. privacyChoice)
              , Event CancelSend
              ]
    CancelSend ->
@ -1263,9 +1272,10 @@ handleEvent wenv node model evt =
                T.pack (printf "%.2f%%" (model ^. barValue * 100)))
             ]
    ResetRecipientValid -> [Model $ model & recipientValid .~ False]
-    CheckRecipient a -> [Model $ 
-                            model & recipientValid .~ isRecipientValidGUI (model ^.privacyChoice) a ]
--                            model & recipientValid .~ ((model ^. privacyChoice) == Low)  ]
+    CheckRecipient a ->
+      [ Model $
+        model & recipientValid .~ isRecipientValidGUI (model ^. privacyChoice) a
+      ]
    CheckAmount i ->
      [ Model $
        model & amountValid .~
@ -1465,6 +1475,7 @@ handleEvent wenv node model evt =
      res <- liftIO $ updateAdrsInAdrBook pool d a a
      return $ ShowMessage "Address Book entry updated!!"

+--                            model & recipientValid .~ ((model ^. privacyChoice) == Low)  ]
 scanZebra :: T.Text -> T.Text -> Int -> ZcashNet -> (AppEvent -> IO ()) -> IO ()
 scanZebra dbPath zHost zPort net sendMsg = do
  bStatus <- liftIO $ checkBlockChain zHost zPort
@ -1533,20 +1544,21 @@ sendTransaction ::
  -> Float
  -> T.Text
  -> T.Text
+  -> PrivacyPolicy
  -> (AppEvent -> IO ())
  -> IO ()
-sendTransaction config znet accId bl amt ua memo sendMsg = do
+sendTransaction config znet accId bl amt ua memo policy sendMsg = do
  sendMsg $ ShowModal "Preparing transaction..."
-  case parseAddressUA ua znet of
+  case parseAddress (E.encodeUtf8 ua) of
    Nothing -> sendMsg $ ShowError "Incorrect address"
-    Just outUA -> do
+    Just addr -> do
      let dbPath = c_dbPath config
      let zHost = c_zebraHost config
      let zPort = c_zebraPort config
      pool <- runNoLoggingT $ initPool dbPath
      res <-
        runFileLoggingT "zenith.log" $
-        prepareTx pool zHost zPort znet accId bl amt outUA memo
+        prepareTxV2 pool zHost zPort znet accId bl amt addr memo policy
      case res of
        Left e -> sendMsg $ ShowError $ T.pack $ show e
        Right rawTx -> do
@ -1593,6 +1605,7 @@ runZenithGUI config = do
            Left e1 -> throwIO e1
            Right chainInfo -> do
              x <- initDb dbFilePath
+              _ <- upgradeQrTable pool
              case x of
                Left e2 -> throwIO $ userError e2
                Right x' -> do
--- a/src/Zenith/Scanner.hs
+++ b/src/Zenith/Scanner.hs
@ -48,6 +48,7 @@ import Zenith.DB
  , saveConfs
  , saveTransaction
  , updateWalletSync
+  , upgradeQrTable
  )
 import Zenith.Types (Config(..), HexStringDB(..), ZcashNetDB(..))
 import Zenith.Utils (jsonNumber)
@ -69,6 +70,8 @@ rescanZebra host port dbFilePath = do
      pool1 <- runNoLoggingT $ initPool dbFilePath
      {-pool2 <- runNoLoggingT $ initPool dbFilePath-}
      {-pool3 <- runNoLoggingT $ initPool dbFilePath-}
+      _ <- initDb dbFilePath
+      upgradeQrTable pool1
      clearWalletTransactions pool1
      clearWalletData pool1
      dbBlock <- getMaxBlock pool1 znet
@ -211,6 +214,7 @@ clearSync config = do
    Left e1 -> throwIO e1
    Right chainInfo -> do
      x <- initDb dbPath
+      _ <- upgradeQrTable pool
      case x of
        Left e2 -> throwIO $ userError e2
        Right x' -> do