RPC Server #103

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

2
.gitmodules vendored
View file

@ -1,4 +1,4 @@
[submodule "zcash-haskell"] [submodule "zcash-haskell"]
path = zcash-haskell path = zcash-haskell
url = https://git.vergara.tech/Vergara_Tech/zcash-haskell.git url = https://git.vergara.tech/Vergara_Tech/zcash-haskell.git
branch = milestone2 branch = master

View file

@ -22,6 +22,7 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0
- `getoperationstatus` RPC method - `getoperationstatus` RPC method
- `sendmany` RPC method - `sendmany` RPC method
- Function `prepareTxV2` implementing `PrivacyPolicy` - Function `prepareTxV2` implementing `PrivacyPolicy`
- Support for TEX addresses
- Functionality to shield transparent balance - Functionality to shield transparent balance
- Functionality to de-shield shielded notes - Functionality to de-shield shielded notes
- Native commitment trees - Native commitment trees

View file

@ -528,7 +528,7 @@ drawUI s = [splashDialog s, helpDialog s, displayDialog s, inputDialog s, ui s]
(str (str
" _____ _ _ _ \n|__ /___ _ __ (_) |_| |__\n / // _ \\ '_ \\| | __| '_ \\\n / /| __/ | | | | |_| | | |\n/____\\___|_| |_|_|\\__|_| |_|") <=> " _____ _ _ _ \n|__ /___ _ __ (_) |_| |__\n / // _ \\ '_ \\| | __| '_ \\\n / /| __/ | | | | |_| | | |\n/____\\___|_| |_|_|\\__|_| |_|") <=>
C.hCenter C.hCenter
(withAttr titleAttr (str "Zcash Wallet v0.6.0.0-beta")) <=> (withAttr titleAttr (str "Zcash Wallet v0.7.0.0-beta")) <=>
C.hCenter (withAttr blinkAttr $ str "Press any key...")) C.hCenter (withAttr blinkAttr $ str "Press any key..."))
else emptyWidget else emptyWidget
capCommand3 :: String -> String -> String -> Widget Name capCommand3 :: String -> String -> String -> Widget Name
@ -827,7 +827,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
@ -860,7 +860,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
@ -940,7 +940,7 @@ appEvent (BT.AppEvent t) = do
Just (_k, w) -> return w Just (_k, w) -> return w
_ <- _ <-
liftIO $ liftIO $
runStderrLoggingT $ runNoLoggingT $
syncWallet syncWallet
(Config (Config
(s ^. dbPath) (s ^. dbPath)
@ -1006,7 +1006,7 @@ appEvent (BT.AppEvent t) = do
_ <- _ <-
liftIO $ liftIO $
forkIO $ forkIO $
runStderrLoggingT $ runNoLoggingT $
scanZebra scanZebra
(s ^. dbPath) (s ^. dbPath)
(s ^. zebraHost) (s ^. zebraHost)
@ -2021,7 +2021,7 @@ sendTransaction pool chan zHost zPort znet accId bl amt ua memo policy = do
Nothing -> BC.writeBChan chan $ TickMsg "Incorrect address" Nothing -> BC.writeBChan chan $ TickMsg "Incorrect address"
Just outUA -> do Just outUA -> do
res <- res <-
runStderrLoggingT $ runNoLoggingT $
prepareTxV2 prepareTxV2
pool pool
zHost zHost
@ -2089,7 +2089,7 @@ deshieldTransaction ::
-> IO () -> IO ()
deshieldTransaction pool chan zHost zPort znet accId bl pnote = do deshieldTransaction pool chan zHost zPort znet accId bl pnote = do
BC.writeBChan chan $ TickMsg "Deshielding funds..." BC.writeBChan chan $ TickMsg "Deshielding funds..."
res <- runStderrLoggingT $ deshieldNotes pool zHost zPort znet accId bl pnote res <- runNoLoggingT $ deshieldNotes pool zHost zPort znet accId bl pnote
case res of case res of
Left e -> BC.writeBChan chan $ TickMsg $ show e Left e -> BC.writeBChan chan $ TickMsg $ show e
Right rawTx -> do Right rawTx -> do

View file

@ -8,21 +8,15 @@ import Control.Monad (forM, unless, when)
import Control.Monad.IO.Class (liftIO) import Control.Monad.IO.Class (liftIO)
import Control.Monad.Logger import Control.Monad.Logger
( LoggingT ( LoggingT
, MonadLoggerIO
, NoLoggingT , NoLoggingT
, logDebugN , logDebugN
, logErrorN , logErrorN
, logInfoN , logInfoN
, logWarnN
, runFileLoggingT
, runNoLoggingT , runNoLoggingT
, runStdoutLoggingT
) )
import Crypto.Secp256k1 (SecKey(..)) import Crypto.Secp256k1 (SecKey(..))
import Data.Aeson import Data.Aeson
import Data.Binary.Get hiding (getBytes)
import qualified Data.ByteString as BS import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as LBS
import Data.HexString (HexString, hexBytes, hexString, toBytes, toText) import Data.HexString (HexString, hexBytes, hexString, toBytes, toText)
import Data.Int (Int32, Int64) import Data.Int (Int32, Int64)
import Data.List import Data.List
@ -34,14 +28,8 @@ import Data.Time
import qualified Database.Esqueleto.Experimental as ESQ import qualified Database.Esqueleto.Experimental as ESQ
import Database.Persist import Database.Persist
import Database.Persist.Sqlite import Database.Persist.Sqlite
import GHC.Float.RealFracMethods
( ceilingFloatInteger
, floorFloatInt
, floorFloatInteger
)
import Haskoin.Crypto.Keys (XPrvKey(..)) import Haskoin.Crypto.Keys (XPrvKey(..))
import Lens.Micro ((&), (.~), (^.), set) import Lens.Micro ((&), (.~), (^.), set)
import Network.HTTP.Client
import ZcashHaskell.Keys import ZcashHaskell.Keys
import ZcashHaskell.Orchard import ZcashHaskell.Orchard
( decryptOrchardActionSK ( decryptOrchardActionSK
@ -759,7 +747,7 @@ deshieldNotes ::
-> ZcashAccountId -> ZcashAccountId
-> Int -> Int
-> ProposedNote -> ProposedNote
-> LoggingT IO (Either TxError HexString) -> NoLoggingT IO (Either TxError HexString)
deshieldNotes pool zebraHost zebraPort znet za bh pnote = do deshieldNotes pool zebraHost zebraPort znet za bh pnote = do
bal <- liftIO $ getShieldedBalance pool za bal <- liftIO $ getShieldedBalance pool za
let zats = pn_amt pnote * scientific 1 8 let zats = pn_amt pnote * scientific 1 8
@ -886,7 +874,7 @@ prepareTxV2 ::
-> Int -> Int
-> [ProposedNote] -> [ProposedNote]
-> PrivacyPolicy -> PrivacyPolicy
-> LoggingT IO (Either TxError HexString) -> NoLoggingT IO (Either TxError HexString)
prepareTxV2 pool zebraHost zebraPort zn za bh pnotes policy = do prepareTxV2 pool zebraHost zebraPort zn za bh pnotes policy = do
accRead <- liftIO $ getAccountById pool za accRead <- liftIO $ getAccountById pool za
let recipients = map extractReceiver pnotes let recipients = map extractReceiver pnotes
@ -1297,7 +1285,7 @@ prepareTxV2 pool zebraHost zebraPort zn za bh pnotes policy = do
syncWallet :: syncWallet ::
Config -- ^ configuration parameters Config -- ^ configuration parameters
-> Entity ZcashWallet -> Entity ZcashWallet
-> LoggingT IO () -> NoLoggingT IO ()
syncWallet config w = do syncWallet config w = do
startTime <- liftIO getCurrentTime startTime <- liftIO getCurrentTime
logDebugN $ T.pack $ show startTime logDebugN $ T.pack $ show startTime
@ -1343,7 +1331,7 @@ syncWallet config w = do
-- | Update commitment trees -- | Update commitment trees
updateCommitmentTrees :: updateCommitmentTrees ::
ConnectionPool -> T.Text -> Int -> ZcashNetDB -> LoggingT IO () ConnectionPool -> T.Text -> Int -> ZcashNetDB -> NoLoggingT IO ()
updateCommitmentTrees pool zHost zPort zNet = do updateCommitmentTrees pool zHost zPort zNet = do
sTdb <- liftIO $ getSaplingTree pool sTdb <- liftIO $ getSaplingTree pool
oTdb <- liftIO $ getOrchardTree pool oTdb <- liftIO $ getOrchardTree pool

View file

@ -2680,7 +2680,7 @@ completeSync pool st = do
return () return ()
-- | Rewind the data store to a given block height -- | Rewind the data store to a given block height
rewindWalletData :: ConnectionPool -> Int -> ZcashNetDB -> LoggingT IO () rewindWalletData :: ConnectionPool -> Int -> ZcashNetDB -> NoLoggingT IO ()
rewindWalletData pool b net = do rewindWalletData pool b net = do
logDebugN "Starting transaction rewind" logDebugN "Starting transaction rewind"
liftIO $ rewindWalletTransactions pool b liftIO $ rewindWalletTransactions pool b

View file

@ -15,6 +15,7 @@ import Control.Monad (forM_, unless, 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
, runNoLoggingT , runNoLoggingT
, runStderrLoggingT , runStderrLoggingT
@ -1395,7 +1396,7 @@ handleEvent wenv node model evt =
model & timer .~ 0 & barValue .~ 0.0 & modalMsg ?~ model & timer .~ 0 & barValue .~ 0.0 & modalMsg ?~
"Downloading blocks..." "Downloading blocks..."
, Producer $ , Producer $
runStderrLoggingT . runNoLoggingT .
scanZebra scanZebra
(c_dbPath $ model ^. configuration) (c_dbPath $ model ^. configuration)
(c_zebraHost $ model ^. configuration) (c_zebraHost $ model ^. configuration)
@ -1411,7 +1412,7 @@ handleEvent wenv node model evt =
case currentWallet of case currentWallet of
Nothing -> return $ ShowError "No wallet available" Nothing -> return $ ShowError "No wallet available"
Just cW -> do Just cW -> do
runStderrLoggingT $ syncWallet (model ^. configuration) cW runNoLoggingT $ syncWallet (model ^. configuration) cW
pool <- pool <-
runNoLoggingT $ initPool $ c_dbPath $ model ^. configuration runNoLoggingT $ initPool $ c_dbPath $ model ^. configuration
wL <- getWallets pool (model ^. network) wL <- getWallets pool (model ^. network)
@ -1668,7 +1669,7 @@ scanZebra ::
-> Int -> Int
-> ZcashNet -> ZcashNet
-> (AppEvent -> IO ()) -> (AppEvent -> IO ())
-> LoggingT IO () -> NoLoggingT IO ()
scanZebra dbPath zHost zPort net sendMsg = do scanZebra dbPath zHost zPort net sendMsg = do
bStatus <- liftIO $ checkBlockChain zHost zPort bStatus <- liftIO $ checkBlockChain zHost zPort
pool <- liftIO $ runNoLoggingT $ initPool dbPath pool <- liftIO $ runNoLoggingT $ initPool dbPath
@ -1697,7 +1698,7 @@ scanZebra dbPath zHost zPort net sendMsg = 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
@ -1806,7 +1807,7 @@ deshieldTransaction config znet accId addR pnote sendMsg = do
Nothing -> sendMsg $ ShowError "No transparent address available" Nothing -> sendMsg $ ShowError "No transparent address available"
Just tAddr -> do Just tAddr -> do
res <- res <-
runStderrLoggingT $ runNoLoggingT $
deshieldNotes deshieldNotes
pool pool
zHost zHost
@ -1850,7 +1851,7 @@ sendTransaction config znet accId bl amt ua memo policy sendMsg = do
let zPort = c_zebraPort config let zPort = c_zebraPort config
pool <- runNoLoggingT $ initPool dbPath pool <- runNoLoggingT $ initPool dbPath
res <- res <-
runStderrLoggingT $ runNoLoggingT $
prepareTxV2 prepareTxV2
pool pool
zHost zHost

View file

@ -834,7 +834,7 @@ zenithServer state = getinfo :<|> handleRPC
forkIO $ do forkIO $ do
res <- res <-
liftIO $ liftIO $
runStderrLoggingT $ runNoLoggingT $
prepareTxV2 prepareTxV2
pool pool
zHost zHost
@ -898,7 +898,7 @@ scanZebra dbPath zHost zPort net = do
then max dbBlock b then max dbBlock b
else max chkBlock b else max chkBlock b
unless (chkBlock == dbBlock || chkBlock == 1) $ unless (chkBlock == dbBlock || chkBlock == 1) $
runStderrLoggingT $ rewindWalletData pool sb $ ZcashNetDB net runNoLoggingT $ rewindWalletData pool sb $ ZcashNetDB net
unless (sb > zgb_blocks bStatus || sb < 1) $ do unless (sb > zgb_blocks bStatus || sb < 1) $ do
let bList = [(sb + 1) .. (zgb_blocks bStatus)] let bList = [(sb + 1) .. (zgb_blocks bStatus)]
unless (null bList) $ do unless (null bList) $ do
@ -912,9 +912,9 @@ scanZebra dbPath zHost zPort net = do
Right _ -> do Right _ -> do
wals <- getWallets pool net wals <- getWallets pool net
_ <- _ <-
runStderrLoggingT $ runNoLoggingT $
updateCommitmentTrees pool zHost zPort $ ZcashNetDB net updateCommitmentTrees pool zHost zPort $ ZcashNetDB net
runStderrLoggingT $ runNoLoggingT $
mapM_ mapM_
(syncWallet (Config dbPath zHost zPort "user" "pwd" 8080)) (syncWallet (Config dbPath zHost zPort "user" "pwd" 8080))
wals wals

View file

@ -108,7 +108,7 @@ rescanZebra host port dbFilePath = do
{-mapM_ (processBlock host port pool3 pg3 znet) bl3-} {-mapM_ (processBlock host port pool3 pg3 znet) bl3-}
print "Please wait..." print "Please wait..."
_ <- completeSync pool1 Successful _ <- completeSync pool1 Successful
_ <- runStderrLoggingT $ updateCommitmentTrees pool1 host port znet _ <- runNoLoggingT $ updateCommitmentTrees pool1 host port znet
print "Rescan complete" print "Rescan complete"
-- | Function to process a raw block and extract the transaction information -- | Function to process a raw block and extract the transaction information
@ -239,7 +239,7 @@ clearSync config = do
w <- getWallets pool $ zgb_net chainInfo w <- getWallets pool $ zgb_net chainInfo
liftIO $ mapM_ (updateWalletSync pool 0 . entityKey) w liftIO $ mapM_ (updateWalletSync pool 0 . entityKey) w
w' <- liftIO $ getWallets pool $ zgb_net chainInfo w' <- liftIO $ getWallets pool $ zgb_net chainInfo
r <- runStderrLoggingT $ mapM (syncWallet config) w' r <- runNoLoggingT $ mapM (syncWallet config) w'
liftIO $ print r liftIO $ print r
-- | Detect chain re-orgs -- | Detect chain re-orgs

View file

@ -9,7 +9,7 @@
module Zenith.Tree where module Zenith.Tree where
import Codec.Borsh import Codec.Borsh
import Control.Monad.Logger (LoggingT, logDebugN) import Control.Monad.Logger (NoLoggingT, logDebugN)
import Data.HexString import Data.HexString
import Data.Int (Int32, Int64, Int8) import Data.Int (Int32, Int64, Int8)
import Data.Maybe (fromJust, isNothing) import Data.Maybe (fromJust, isNothing)
@ -18,12 +18,7 @@ import qualified GHC.Generics as GHC
import qualified Generics.SOP as SOP import qualified Generics.SOP as SOP
import ZcashHaskell.Orchard (combineOrchardNodes, getOrchardNodeValue) import ZcashHaskell.Orchard (combineOrchardNodes, getOrchardNodeValue)
import ZcashHaskell.Sapling (combineSaplingNodes, getSaplingNodeValue) import ZcashHaskell.Sapling (combineSaplingNodes, getSaplingNodeValue)
import ZcashHaskell.Types import ZcashHaskell.Types (MerklePath(..), OrchardTree(..), SaplingTree(..))
( MerklePath(..)
, OrchardFrontier(..)
, OrchardTree(..)
, SaplingTree(..)
)
type Level = Int8 type Level = Int8
@ -181,7 +176,7 @@ getNotePosition (Branch _ x y) i
| otherwise = Nothing | otherwise = Nothing
getNotePosition _ _ = Nothing getNotePosition _ _ = Nothing
truncateTree :: Monoid v => Node v => Tree v -> Int64 -> LoggingT IO (Tree v) truncateTree :: Monoid v => Node v => Tree v -> Int64 -> NoLoggingT IO (Tree v)
truncateTree (Branch s x y) i truncateTree (Branch s x y) i
| getLevel s == 1 && getIndex (value x) == i = do | getLevel s == 1 && getIndex (value x) == i = do
logDebugN $ T.pack $ show (getLevel s) ++ " Trunc to left leaf" logDebugN $ T.pack $ show (getLevel s) ++ " Trunc to left leaf"

@ -1 +1 @@
Subproject commit dea960c2acf7479eeb42845c07b482449d538aae Subproject commit d45bd7dcf3c3cf4e893900a1774d24b14bf56591