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

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