diff --git a/src/Zenith/CLI.hs b/src/Zenith/CLI.hs index a657a71..f245e2e 100644 --- a/src/Zenith/CLI.hs +++ b/src/Zenith/CLI.hs @@ -95,7 +95,10 @@ import ZcashHaskell.Orchard , isValidUnifiedAddress , parseAddress ) -import ZcashHaskell.Transparent (encodeTransparentReceiver) +import ZcashHaskell.Transparent + ( decodeTransparentAddress + , encodeTransparentReceiver + ) import ZcashHaskell.Types import ZcashHaskell.Utils (getBlockTime, makeZebraCall) import Zenith.Core @@ -823,7 +826,7 @@ scanZebra :: -> Int -> BC.BChan Tick -> ZcashNet - -> NoLoggingT IO () + -> LoggingT IO () scanZebra dbP zHost zPort b eChan znet = do bStatus <- liftIO $ checkBlockChain zHost zPort pool <- liftIO $ runNoLoggingT $ initPool dbP @@ -855,7 +858,7 @@ scanZebra dbP zHost zPort b eChan znet = do _ <- liftIO $ startSync pool mapM_ (liftIO . processBlock pool step) bList confUp <- - liftIO $ try $ updateConfs zHost zPort pool :: NoLoggingT + liftIO $ try $ updateConfs zHost zPort pool :: LoggingT IO (Either IOError ()) case confUp of @@ -960,11 +963,11 @@ appEvent (BT.AppEvent t) = do "pwd" 8080) selWallet - BT.modify $ set displayBox BlankDisplay - BT.modify $ set barValue 0.0 updatedState <- BT.get ns <- liftIO $ refreshWallet updatedState BT.put ns + BT.modify $ set displayBox BlankDisplay + BT.modify $ set barValue 0.0 else BT.modify $ set barValue $ validBarValue (v + s ^. barValue) BlankDisplay -> do case s ^. dialogBox of @@ -989,7 +992,7 @@ appEvent (BT.AppEvent t) = do _ <- liftIO $ forkIO $ - runNoLoggingT $ + runStderrLoggingT $ scanZebra (s ^. dbPath) (s ^. zebraHost) @@ -1234,6 +1237,92 @@ appEvent (BT.VtyEvent e) = do DeshieldForm -> do case e of V.EvKey V.KEsc [] -> BT.modify $ set dialogBox Blank + V.EvKey (V.KChar 'p') [] -> do + if allFieldsValid (s ^. deshieldForm) + then do + pool <- + liftIO $ runNoLoggingT $ initPool $ s ^. dbPath + selWal <- + do case L.listSelectedElement $ s ^. wallets of + Nothing -> do + let fWall = + L.listSelectedElement $ + L.listMoveToBeginning $ s ^. wallets + case fWall of + Nothing -> + throw $ + userError "Failed to select wallet" + Just (_j, w1) -> return w1 + Just (_k, w) -> return w + selAcc <- + do case L.listSelectedElement $ s ^. accounts of + Nothing -> do + let fAcc = + L.listSelectedElement $ + L.listMoveToBeginning $ + s ^. accounts + case fAcc of + Nothing -> + throw $ + userError "Failed to select wallet" + Just (_j, w1) -> return w1 + Just (_k, w) -> return w + selAddr <- + do case L.listSelectedElement $ s ^. addresses of + Nothing -> do + let fAddr = + L.listSelectedElement $ + L.listMoveToBeginning $ + s ^. addresses + case fAddr of + Nothing -> + throw $ + userError "Failed to select address" + Just (_j, w1) -> return w1 + Just (_k, w) -> return w + fs1 <- BT.zoom deshieldForm $ BT.gets formState + let tAddrMaybe = + Transparent <$> + ((decodeTransparentAddress . + E.encodeUtf8 . + encodeTransparentReceiver (s ^. network)) =<< + (t_rec =<< + (isValidUnifiedAddress . + E.encodeUtf8 . + getUA . walletAddressUAddress) + (entityVal selAddr))) + bl <- + liftIO $ getLastSyncBlock pool $ entityKey selWal + case tAddrMaybe of + Nothing -> do + BT.modify $ + set + msg + "Failed to obtain transparent address" + BT.modify $ set displayBox MsgDisplay + BT.modify $ set dialogBox Blank + Just tAddr -> do + _ <- + liftIO $ + forkIO $ + deshieldTransaction + pool + (s ^. eventDispatch) + (s ^. zebraHost) + (s ^. zebraPort) + (s ^. network) + (entityKey selAcc) + bl + (ProposedNote + (ValidAddressAPI tAddr) + (fs1 ^. shAmt) + Nothing) + BT.modify $ set displayBox SendDisplay + BT.modify $ set dialogBox Blank + else do + BT.modify $ set msg "Invalid inputs" + BT.modify $ set displayBox MsgDisplay + BT.modify $ set dialogBox Blank ev -> BT.zoom deshieldForm $ do handleFormEvent (BT.VtyEvent ev) @@ -1714,7 +1803,7 @@ refreshWallet s = do Just (j, w1) -> return (j, w1) Just (k, w) -> return (k, w) aL <- runNoLoggingT $ getAccounts pool $ entityKey selWallet - let bl = zcashWalletLastSync $ entityVal selWallet + let bl = zcashWalletLastSync $ entityVal $ walList !! ix addrL <- if not (null aL) then runNoLoggingT $ getAddresses pool $ entityKey $ head aL @@ -1971,3 +2060,30 @@ shieldTransaction pool chan zHost zPort znet accId bl = do case resp of Left e1 -> BC.writeBChan chan $ TickMsg $ "Zebra error: " ++ show e1 Right txId -> BC.writeBChan chan $ TickTx txId + +deshieldTransaction :: + ConnectionPool + -> BC.BChan Tick + -> T.Text + -> Int + -> ZcashNet + -> ZcashAccountId + -> Int + -> ProposedNote + -> IO () +deshieldTransaction pool chan zHost zPort znet accId bl pnote = do + BC.writeBChan chan $ TickMsg "Deshielding funds..." + res <- runNoLoggingT $ deshieldNotes pool zHost zPort znet accId bl pnote + case res of + Left e -> BC.writeBChan chan $ TickMsg $ show e + Right rawTx -> do + BC.writeBChan chan $ TickMsg "Transaction ready, sending to Zebra..." + resp <- + makeZebraCall + zHost + zPort + "sendrawtransaction" + [Data.Aeson.String $ toText rawTx] + case resp of + Left e1 -> BC.writeBChan chan $ TickMsg $ "Zebra error: " ++ show e1 + Right txId -> BC.writeBChan chan $ TickTx txId diff --git a/src/Zenith/DB.hs b/src/Zenith/DB.hs index 1a24fd4..1caf781 100644 --- a/src/Zenith/DB.hs +++ b/src/Zenith/DB.hs @@ -2038,6 +2038,36 @@ rewindWalletTransactions pool b = do delete $ do _ <- from $ table @UserTx return () + oldTxs <- + select $ do + txs <- from $ table @WalletTransaction + where_ $ txs ^. WalletTransactionBlock >. val b + pure txs + let oldKeys = map entityKey oldTxs + delete $ do + x <- from $ table @WalletOrchSpend + where_ $ x ^. WalletOrchSpendTx `in_` valList oldKeys + return () + delete $ do + x <- from $ table @WalletOrchNote + where_ $ x ^. WalletOrchNoteTx `in_` valList oldKeys + return () + delete $ do + x <- from $ table @WalletSapNote + where_ $ x ^. WalletSapNoteTx `in_` valList oldKeys + return () + delete $ do + x <- from $ table @WalletSapSpend + where_ $ x ^. WalletSapSpendTx `in_` valList oldKeys + return () + delete $ do + x <- from $ table @WalletTrNote + where_ $ x ^. WalletTrNoteTx `in_` valList oldKeys + return () + delete $ do + x <- from $ table @WalletTrSpend + where_ $ x ^. WalletTrSpendTx `in_` valList oldKeys + return () delete $ do txs <- from $ table @WalletTransaction where_ $ txs ^. WalletTransactionBlock >. val b @@ -2596,7 +2626,37 @@ rewindWalletData pool b = do rewindWalletTransactions pool b runNoLoggingT $ PS.retryOnBusy $ - flip PS.runSqlPool pool $ - delete $ do - blk <- from $ table @ZcashBlock - where_ $ blk ^. ZcashBlockHeight >=. val b + flip PS.runSqlPool pool $ do + oldBlocks <- + select $ do + blk <- from $ table @ZcashBlock + where_ $ blk ^. ZcashBlockHeight >. val b + pure blk + let oldBlkKeys = map entityKey oldBlocks + oldTxs <- + select $ do + txs <- from $ table @ZcashTransaction + where_ $ txs ^. ZcashTransactionBlockId `in_` valList oldBlkKeys + pure txs + let oldTxKeys = map entityKey oldTxs + delete $ do + x <- from $ table @TransparentNote + where_ $ x ^. TransparentNoteTx `in_` valList oldTxKeys + delete $ do + x <- from $ table @TransparentSpend + where_ $ x ^. TransparentSpendTx `in_` valList oldTxKeys + delete $ do + x <- from $ table @ShieldOutput + where_ $ x ^. ShieldOutputTx `in_` valList oldTxKeys + delete $ do + x <- from $ table @ShieldSpend + where_ $ x ^. ShieldSpendTx `in_` valList oldTxKeys + delete $ do + x <- from $ table @OrchAction + where_ $ x ^. OrchActionTx `in_` valList oldTxKeys + delete $ do + x <- from $ table @ZcashTransaction + where_ $ x ^. ZcashTransactionId `in_` valList oldTxKeys + delete $ do + blk <- from $ table @ZcashBlock + where_ $ blk ^. ZcashBlockHeight >. val b