RPC Server #103

Merged
pitmutt merged 129 commits from rav001 into milestone3 2024-11-21 15:30:22 +00:00
3 changed files with 105 additions and 46 deletions
Showing only changes of commit f1daf576cc - Show all commits

View file

@ -66,6 +66,7 @@ import Control.Monad (forever, unless, void, when)
import Control.Monad.IO.Class (liftIO) import Control.Monad.IO.Class (liftIO)
import Control.Monad.Logger import Control.Monad.Logger
( LoggingT ( LoggingT
, NoLoggingT
, logDebugN , logDebugN
, runFileLoggingT , runFileLoggingT
, runNoLoggingT , runNoLoggingT
@ -88,7 +89,11 @@ import System.Hclip
import Text.Printf import Text.Printf
import Text.Wrap (FillScope(..), FillStrategy(..), WrapSettings(..)) import Text.Wrap (FillScope(..), FillStrategy(..), WrapSettings(..))
import ZcashHaskell.Keys (generateWalletSeedPhrase) import ZcashHaskell.Keys (generateWalletSeedPhrase)
import ZcashHaskell.Orchard (getSaplingFromUA, isValidUnifiedAddress) import ZcashHaskell.Orchard
( getSaplingFromUA
, isValidUnifiedAddress
, parseAddress
)
import ZcashHaskell.Transparent (encodeTransparentReceiver) import ZcashHaskell.Transparent (encodeTransparentReceiver)
import ZcashHaskell.Types import ZcashHaskell.Types
import ZcashHaskell.Utils (getBlockTime, makeZebraCall) import ZcashHaskell.Utils (getBlockTime, makeZebraCall)
@ -100,8 +105,10 @@ import Zenith.Types
, HexStringDB(..) , HexStringDB(..)
, PhraseDB(..) , PhraseDB(..)
, PrivacyPolicy(..) , PrivacyPolicy(..)
, ProposedNote(..)
, ShieldDeshieldOp(..) , ShieldDeshieldOp(..)
, UnifiedAddressDB(..) , UnifiedAddressDB(..)
, ValidAddressAPI(..)
, ZcashNetDB(..) , ZcashNetDB(..)
, ZenithStatus(..) , ZenithStatus(..)
) )
@ -805,7 +812,7 @@ scanZebra ::
-> Int -> Int
-> BC.BChan Tick -> BC.BChan Tick
-> ZcashNet -> ZcashNet
-> LoggingT IO () -> NoLoggingT IO ()
scanZebra dbP zHost zPort b eChan znet = do scanZebra dbP zHost zPort b eChan znet = do
bStatus <- liftIO $ checkBlockChain zHost zPort bStatus <- liftIO $ checkBlockChain zHost zPort
pool <- liftIO $ runNoLoggingT $ initPool dbP pool <- liftIO $ runNoLoggingT $ initPool dbP
@ -837,7 +844,7 @@ scanZebra dbP zHost zPort b eChan znet = do
_ <- liftIO $ startSync pool _ <- liftIO $ startSync pool
mapM_ (liftIO . processBlock pool step) bList mapM_ (liftIO . processBlock pool step) bList
confUp <- confUp <-
liftIO $ try $ updateConfs zHost zPort pool :: LoggingT liftIO $ try $ updateConfs zHost zPort pool :: NoLoggingT
IO IO
(Either IOError ()) (Either IOError ())
case confUp of case confUp of
@ -932,7 +939,7 @@ appEvent (BT.AppEvent t) = do
Just (_k, w) -> return w Just (_k, w) -> return w
_ <- _ <-
liftIO $ liftIO $
runFileLoggingT "zenith.log" $ runNoLoggingT $
syncWallet syncWallet
(Config (Config
(s ^. dbPath) (s ^. dbPath)
@ -970,7 +977,7 @@ appEvent (BT.AppEvent t) = do
_ <- _ <-
liftIO $ liftIO $
forkIO $ forkIO $
runFileLoggingT "zenith.log" $ runNoLoggingT $
scanZebra scanZebra
(s ^. dbPath) (s ^. dbPath)
(s ^. zebraHost) (s ^. zebraHost)
@ -1194,6 +1201,7 @@ appEvent (BT.VtyEvent e) = do
(fs1 ^. sendAmt) (fs1 ^. sendAmt)
(fs1 ^. sendTo) (fs1 ^. sendTo)
(fs1 ^. sendMemo) (fs1 ^. sendMemo)
(fs1 ^. policyField)
BT.modify $ set msg "Preparing transaction..." BT.modify $ set msg "Preparing transaction..."
BT.modify $ set displayBox SendDisplay BT.modify $ set displayBox SendDisplay
BT.modify $ set dialogBox Blank BT.modify $ set dialogBox Blank
@ -1233,7 +1241,7 @@ appEvent (BT.VtyEvent e) = do
"Address copied to Clipboard from >>\n" ++ "Address copied to Clipboard from >>\n" ++
T.unpack (addressBookAbdescrip (entityVal a)) T.unpack (addressBookAbdescrip (entityVal a))
BT.modify $ set displayBox MsgDisplay BT.modify $ set displayBox MsgDisplay
_ -> do _any -> do
BT.modify $ BT.modify $
set msg "Error while copying the address!!" set msg "Error while copying the address!!"
BT.modify $ set displayBox MsgDisplay BT.modify $ set displayBox MsgDisplay
@ -1425,7 +1433,21 @@ appEvent (BT.VtyEvent e) = do
BT.modify $ set dialogBox SendTx BT.modify $ set dialogBox SendTx
V.EvKey (V.KChar 'b') [] -> V.EvKey (V.KChar 'b') [] ->
BT.modify $ set dialogBox AdrBook 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 BT.modify $ set dialogBox ShieldDeshieldForm
ev -> ev ->
case r of case r of
@ -1781,15 +1803,30 @@ sendTransaction ::
-> Float -> Float
-> T.Text -> T.Text
-> T.Text -> T.Text
-> PrivacyPolicy
-> IO () -> 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..." BC.writeBChan chan $ TickMsg "Preparing transaction..."
case parseAddressUA ua znet of case parseAddress (E.encodeUtf8 ua) of
Nothing -> BC.writeBChan chan $ TickMsg "Incorrect address" Nothing -> BC.writeBChan chan $ TickMsg "Incorrect address"
Just outUA -> do Just outUA -> do
res <- res <-
runFileLoggingT "zenith.log" $ runNoLoggingT $
prepareTx pool zHost zPort znet accId bl amt outUA memo 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..." BC.writeBChan chan $ TickMsg "Transaction ready, sending to Zebra..."
case res of case res of
Left e -> BC.writeBChan chan $ TickMsg $ show e Left e -> BC.writeBChan chan $ TickMsg $ show e

View file

@ -750,7 +750,7 @@ shieldTransparentNotes ::
-> ZcashNet -> ZcashNet
-> ZcashAccountId -> ZcashAccountId
-> Int -> Int
-> NoLoggingT IO (Either TxError HexString) -> NoLoggingT IO [Either TxError HexString]
shieldTransparentNotes pool zebraHost zebraPort znet za bh = do shieldTransparentNotes pool zebraHost zebraPort znet za bh = do
accRead <- liftIO $ getAccountById pool za accRead <- liftIO $ getAccountById pool za
logDebugN $ T.pack $ "Target block: " ++ show bh logDebugN $ T.pack $ "Target block: " ++ show bh
@ -760,9 +760,16 @@ shieldTransparentNotes pool zebraHost zebraPort znet za bh = do
case accRead of case accRead of
Nothing -> do Nothing -> do
logErrorN "Can't find Account" logErrorN "Can't find Account"
return $ Left ZHError return [Left ZHError]
Just acc -> do Just acc -> do
trNotes <- liftIO $ getWalletUnspentTrNotes pool za 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 noteTotal = getTotalAmount (trNotes, [], [])
let fee = calculateTxFee (trNotes, [], []) 4 let fee = calculateTxFee (trNotes, [], []) 4
tSpends <- tSpends <-
@ -771,9 +778,11 @@ shieldTransparentNotes pool zebraHost zebraPort znet za bh = do
(getTranSK $ zcashAccountTPrivateKey $ entityVal acc) (getTranSK $ zcashAccountTPrivateKey $ entityVal acc)
trNotes trNotes
chgAddr <- getInternalAddresses pool $ entityKey acc chgAddr <- getInternalAddresses pool $ entityKey acc
let internalUA = getUA $ walletAddressUAddress $ entityVal $ head chgAddr let internalUA =
getUA $ walletAddressUAddress $ entityVal $ head chgAddr
let oRcvr = let oRcvr =
fromJust $ o_rec =<< isValidUnifiedAddress (E.encodeUtf8 internalUA) fromJust $
o_rec =<< isValidUnifiedAddress (E.encodeUtf8 internalUA)
let snote = let snote =
OutgoingNote OutgoingNote
4 4

View file

@ -2430,6 +2430,19 @@ saveConfs pool b c = do
set bl [ZcashBlockConf =. val c] set bl [ZcashBlockConf =. val c]
where_ $ bl ^. ZcashBlockHeight ==. val b 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 -- | Helper function to extract a Unified Address from the database
readUnifiedAddressDB :: WalletAddress -> Maybe UnifiedAddress readUnifiedAddressDB :: WalletAddress -> Maybe UnifiedAddress
readUnifiedAddressDB = readUnifiedAddressDB =