diff --git a/src/Zenith/CLI.hs b/src/Zenith/CLI.hs index 5aaf8fc..891cb3f 100644 --- a/src/Zenith/CLI.hs +++ b/src/Zenith/CLI.hs @@ -66,6 +66,7 @@ import Control.Monad (forever, unless, void, when) import Control.Monad.IO.Class (liftIO) import Control.Monad.Logger ( LoggingT + , NoLoggingT , logDebugN , runFileLoggingT , runNoLoggingT @@ -88,7 +89,11 @@ import System.Hclip import Text.Printf import Text.Wrap (FillScope(..), FillStrategy(..), WrapSettings(..)) import ZcashHaskell.Keys (generateWalletSeedPhrase) -import ZcashHaskell.Orchard (getSaplingFromUA, isValidUnifiedAddress) +import ZcashHaskell.Orchard + ( getSaplingFromUA + , isValidUnifiedAddress + , parseAddress + ) import ZcashHaskell.Transparent (encodeTransparentReceiver) import ZcashHaskell.Types import ZcashHaskell.Utils (getBlockTime, makeZebraCall) @@ -100,8 +105,10 @@ import Zenith.Types , HexStringDB(..) , PhraseDB(..) , PrivacyPolicy(..) + , ProposedNote(..) , ShieldDeshieldOp(..) , UnifiedAddressDB(..) + , ValidAddressAPI(..) , ZcashNetDB(..) , ZenithStatus(..) ) @@ -805,7 +812,7 @@ scanZebra :: -> Int -> BC.BChan Tick -> ZcashNet - -> LoggingT IO () + -> NoLoggingT IO () scanZebra dbP zHost zPort b eChan znet = do bStatus <- liftIO $ checkBlockChain zHost zPort pool <- liftIO $ runNoLoggingT $ initPool dbP @@ -837,7 +844,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 :: LoggingT + liftIO $ try $ updateConfs zHost zPort pool :: NoLoggingT IO (Either IOError ()) case confUp of @@ -932,7 +939,7 @@ appEvent (BT.AppEvent t) = do Just (_k, w) -> return w _ <- liftIO $ - runFileLoggingT "zenith.log" $ + runNoLoggingT $ syncWallet (Config (s ^. dbPath) @@ -970,7 +977,7 @@ appEvent (BT.AppEvent t) = do _ <- liftIO $ forkIO $ - runFileLoggingT "zenith.log" $ + runNoLoggingT $ scanZebra (s ^. dbPath) (s ^. zebraHost) @@ -1194,6 +1201,7 @@ appEvent (BT.VtyEvent e) = do (fs1 ^. sendAmt) (fs1 ^. sendTo) (fs1 ^. sendMemo) + (fs1 ^. policyField) BT.modify $ set msg "Preparing transaction..." BT.modify $ set displayBox SendDisplay BT.modify $ set dialogBox Blank @@ -1233,7 +1241,7 @@ appEvent (BT.VtyEvent e) = do "Address copied to Clipboard from >>\n" ++ T.unpack (addressBookAbdescrip (entityVal a)) BT.modify $ set displayBox MsgDisplay - _ -> do + _any -> do BT.modify $ set msg "Error while copying the address!!" BT.modify $ set displayBox MsgDisplay @@ -1425,7 +1433,21 @@ appEvent (BT.VtyEvent e) = do BT.modify $ set dialogBox SendTx V.EvKey (V.KChar 'b') [] -> BT.modify $ set dialogBox AdrBook - V.EvKey (V.KChar 'd') [] -> + V.EvKey (V.KChar 'd') [] -> do + pool <- liftIO $ runNoLoggingT $ initPool $ s ^. dbPath + 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 + c <- liftIO $ getPoolBalance pool $ entityKey selAcc BT.modify $ set dialogBox ShieldDeshieldForm ev -> case r of @@ -1781,15 +1803,30 @@ sendTransaction :: -> Float -> T.Text -> T.Text + -> PrivacyPolicy -> IO () -sendTransaction pool chan zHost zPort znet accId bl amt ua memo = do +sendTransaction pool chan zHost zPort znet accId bl amt ua memo policy = do BC.writeBChan chan $ TickMsg "Preparing transaction..." - case parseAddressUA ua znet of + case parseAddress (E.encodeUtf8 ua) of Nothing -> BC.writeBChan chan $ TickMsg "Incorrect address" Just outUA -> do res <- - runFileLoggingT "zenith.log" $ - prepareTx pool zHost zPort znet accId bl amt outUA memo + runNoLoggingT $ + prepareTxV2 + pool + zHost + zPort + znet + accId + bl + [ ProposedNote + (ValidAddressAPI outUA) + amt + (if memo == "" + then Nothing + else Just memo) + ] + policy BC.writeBChan chan $ TickMsg "Transaction ready, sending to Zebra..." case res of Left e -> BC.writeBChan chan $ TickMsg $ show e diff --git a/src/Zenith/Core.hs b/src/Zenith/Core.hs index dc6300b..f2becf0 100644 --- a/src/Zenith/Core.hs +++ b/src/Zenith/Core.hs @@ -750,7 +750,7 @@ shieldTransparentNotes :: -> ZcashNet -> ZcashAccountId -> Int - -> NoLoggingT IO (Either TxError HexString) + -> NoLoggingT IO [Either TxError HexString] shieldTransparentNotes pool zebraHost zebraPort znet za bh = do accRead <- liftIO $ getAccountById pool za logDebugN $ T.pack $ "Target block: " ++ show bh @@ -760,41 +760,50 @@ shieldTransparentNotes pool zebraHost zebraPort znet za bh = do case accRead of Nothing -> do logErrorN "Can't find Account" - return $ Left ZHError + return [Left ZHError] Just acc -> do - trNotes <- liftIO $ getWalletUnspentTrNotes pool za - let noteTotal = getTotalAmount (trNotes, [], []) - let fee = calculateTxFee (trNotes, [], []) 4 - tSpends <- - liftIO $ - prepTSpends - (getTranSK $ zcashAccountTPrivateKey $ entityVal acc) - trNotes - chgAddr <- getInternalAddresses pool $ entityKey acc - let internalUA = getUA $ walletAddressUAddress $ entityVal $ head chgAddr - let oRcvr = - fromJust $ o_rec =<< isValidUnifiedAddress (E.encodeUtf8 internalUA) - let snote = - OutgoingNote - 4 - (getBytes $ getOrchSK $ zcashAccountOrchSpendKey $ entityVal acc) - (getBytes oRcvr) - (fromIntegral $ noteTotal - fee) - "" - True - let tx = - createTransaction - (Just sT) - (Just oT) - tSpends - [] - [] - [snote] - znet - (bh + 3) - True - logDebugN $ T.pack $ show tx - return tx + trNotes' <- liftIO $ getWalletUnspentTrNotes pool za + dRecvs <- liftIO $ getReceivers pool trNotes' + let fNotes = + map + (\x -> + filter (\y -> walletTrNoteAddress (entityVal y) == x) trNotes') + dRecvs + forM fNotes $ \trNotes -> do + let noteTotal = getTotalAmount (trNotes, [], []) + let fee = calculateTxFee (trNotes, [], []) 4 + tSpends <- + liftIO $ + prepTSpends + (getTranSK $ zcashAccountTPrivateKey $ entityVal acc) + trNotes + chgAddr <- getInternalAddresses pool $ entityKey acc + let internalUA = + getUA $ walletAddressUAddress $ entityVal $ head chgAddr + let oRcvr = + fromJust $ + o_rec =<< isValidUnifiedAddress (E.encodeUtf8 internalUA) + let snote = + OutgoingNote + 4 + (getBytes $ getOrchSK $ zcashAccountOrchSpendKey $ entityVal acc) + (getBytes oRcvr) + (fromIntegral $ noteTotal - fee) + "" + True + let tx = + createTransaction + (Just sT) + (Just oT) + tSpends + [] + [] + [snote] + znet + (bh + 3) + True + logDebugN $ T.pack $ show tx + return tx where getTotalAmount :: ( [Entity WalletTrNote] diff --git a/src/Zenith/DB.hs b/src/Zenith/DB.hs index d94a060..b84f344 100644 --- a/src/Zenith/DB.hs +++ b/src/Zenith/DB.hs @@ -2430,6 +2430,19 @@ saveConfs pool b c = do set bl [ZcashBlockConf =. val c] where_ $ bl ^. ZcashBlockHeight ==. val b +getReceivers :: ConnectionPool -> [Entity WalletTrNote] -> IO [WalletAddressId] +getReceivers pool ns = do + r <- + runNoLoggingT $ + PS.retryOnBusy $ + flip PS.runSqlPool pool $ do + select $ + distinct $ do + t <- from $ table @WalletTrNote + where_ (t ^. WalletTrNoteId `in_` valList (map entityKey ns)) + return (t ^. WalletTrNoteAddress) + return $ map (\(Value x) -> x) r + -- | Helper function to extract a Unified Address from the database readUnifiedAddressDB :: WalletAddress -> Maybe UnifiedAddress readUnifiedAddressDB =