diff --git a/src/Zenith/CLI.hs b/src/Zenith/CLI.hs index 4530ccf..f18493a 100644 --- 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,11 +620,13 @@ mkSendForm :: Integer -> SendInput -> Form SendInput e Name mkSendForm bal = newForm [ label "Privacy Level :" @@= - radioField policyField [ (Full, PrivacyFullField, "Full") - , (Medium, PrivacyMediumField, "Medium") - , (Low, PrivacyLowField, "Low") - , (None, PrivacyNoneField, "None") - ] + radioField + policyField + [ (Full, PrivacyFullField, "Full") + , (Medium, PrivacyMediumField, "Medium") + , (Low, PrivacyLowField, "Low") + , (None, PrivacyNoneField, "None") + ] , label "To: " @@= editTextField sendTo RecField (Just 1) , label "Amount: " @@= editShowableFieldWithValidate sendAmt AmtField (isAmountValid bal) @@ -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 diff --git a/src/Zenith/DB.hs b/src/Zenith/DB.hs index 38a4b8a..3f50113 100644 --- 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 :: diff --git a/src/Zenith/GUI.hs b/src/Zenith/GUI.hs index 442190e..b23ff0d 100644 --- 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 ) @@ -604,29 +606,29 @@ buildUI wenv model = widgetTree [textFont "Bold", textSize 12]) , separatorLine `styleBasic` [fgColor btnColor] , spacer - , hstack - [ - label "Privacy Level:" `styleBasic` [width 70, textFont "Bold"] + , hstack + [ label "Privacy Level:" `styleBasic` + [width 70, textFont "Bold"] , spacer , label "Full " `styleBasic` [width 40] - , radio Full privacyChoice + , radio Full privacyChoice , spacer , label "Medium " `styleBasic` [width 40] - , radio Medium privacyChoice + , radio Medium privacyChoice ] - , hstack - [ - label " " `styleBasic` [width 70, textFont "Bold"] + , hstack + [ label " " `styleBasic` + [width 70, textFont "Bold"] , spacer , label "Low " `styleBasic` [width 40] - , radio Low privacyChoice + , radio Low privacyChoice , spacer , label "None " `styleBasic` [width 40] - , radio None privacyChoice + , radio None privacyChoice ] , spacer , hstack - [ label "To:" `styleBasic` [width 50, textFont "Bold"] + [ label "To:" `styleBasic` [width 50, textFont "Bold"] , spacer , textField_ sendRecipient [onChange CheckRecipient] `styleBasic` [ width 150 @@ -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 -> @@ -1262,10 +1271,11 @@ handleEvent wenv node model evt = ("Wallet Sync: " <> 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) ] + ResetRecipientValid -> [Model $ model & recipientValid .~ False] + 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 diff --git a/src/Zenith/Scanner.hs b/src/Zenith/Scanner.hs index 7642d86..e6241b0 100644 --- 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