Vergara_Tech/zenith
Vergara_Tech/zenith
2
0
Fork 0
Code Issues 21 Pull requests Projects Releases 6 Packages Wiki Activity

RPC Server #103

Merged
pitmutt merged 129 commits from rav001 into milestone3 2024-11-21 15:30:22 +00:00
Conversation 0 Commits 129 Files changed 22 +250 -227
5 changed files with 250 additions and 227 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files
Showing only changes of commit 2f3362e900 - Show all commits

458
src/Zenith/Core.hs
View file

@ -83,7 +83,6 @@ import Zenith.Types
, RseedDB(..) , RseedDB(..)
, SaplingSpendingKeyDB(..) , SaplingSpendingKeyDB(..)
, ScopeDB(..) , ScopeDB(..)
, TransactionType(..)
, TransparentSpendingKeyDB(..) , TransparentSpendingKeyDB(..)
, UnifiedAddressDB(..) , UnifiedAddressDB(..)
, ValidAddressAPI(..) , ValidAddressAPI(..)
@ -728,6 +727,114 @@ prepareTx pool zebraHost zebraPort zn za bh amt ua memo = do
getHex $ walletOrchNoteWitness $ entityVal $ head notes getHex $ walletOrchNoteWitness $ entityVal $ head notes
else Nothing else Nothing
deshieldNotes ::
ConnectionPool
-> T.Text
-> Int
-> ZcashNet
-> ZcashAccountId
-> Int
-> ProposedNote
-> NoLoggingT IO (Either TxError HexString)
deshieldNotes pool zebraHost zebraPort znet za bh pnote = do
bal <- liftIO $ getShieldedBalance pool za
let zats = ceilingFloatInteger $ pn_amt pnote * (10 ^ 8)
if bal > (20000 + zats)
then prepareTxV2 pool zebraHost zebraPort znet za bh [pnote] Low
else return $ Left InsufficientFunds
shieldTransparentNotes ::
ConnectionPool
-> T.Text
-> Int
-> ZcashNet
-> ZcashAccountId
-> Int
-> 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
trees <- liftIO $ getCommitmentTrees zebraHost zebraPort bh
let sT = SaplingCommitmentTree $ ztiSapling trees
let oT = OrchardCommitmentTree $ ztiOrchard trees
case accRead of
Nothing -> do
logErrorN "Can't find Account"
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
where
getTotalAmount ::
( [Entity WalletTrNote]
, [Entity WalletSapNote]
, [Entity WalletOrchNote])
-> Integer
getTotalAmount (t, s, o) =
sum (map (fromIntegral . walletTrNoteValue . entityVal) t) +
sum (map (fromIntegral . walletSapNoteValue . entityVal) s) +
sum (map (fromIntegral . walletOrchNoteValue . entityVal) o)
prepTSpends ::
TransparentSpendingKey
-> [Entity WalletTrNote]
-> IO [TransparentTxSpend]
prepTSpends sk notes = do
forM notes $ \n -> do
tAddRead <- getAddressById pool $ walletTrNoteAddress $ entityVal n
case tAddRead of
Nothing -> throwIO $ userError "Couldn't read t-address"
Just tAdd -> do
(XPrvKey _ _ _ _ (SecKey xp_key)) <-
genTransparentSecretKey
(walletAddressIndex $ entityVal tAdd)
(getScope $ walletAddressScope $ entityVal tAdd)
sk
mReverseTxId <- getWalletTxId pool $ walletTrNoteTx $ entityVal n
case mReverseTxId of
Nothing -> throwIO $ userError "failed to get tx ID"
Just (ESQ.Value reverseTxId) -> do
let flipTxId = BS.reverse $ toBytes $ getHex reverseTxId
return $
TransparentTxSpend
xp_key
(RawOutPoint
flipTxId
(fromIntegral $ walletTrNotePosition $ entityVal n))
(RawTxOut
(fromIntegral $ walletTrNoteValue $ entityVal n)
(walletTrNoteScript $ entityVal n))
-- | Prepare a transaction for sending -- | Prepare a transaction for sending
prepareTxV2 :: prepareTxV2 ::
ConnectionPool ConnectionPool
@ -738,9 +845,8 @@ prepareTxV2 ::
-> Int -> Int
-> [ProposedNote] -> [ProposedNote]
-> PrivacyPolicy -> PrivacyPolicy
-> TransactionType
-> NoLoggingT IO (Either TxError HexString) -> NoLoggingT IO (Either TxError HexString)
prepareTxV2 pool zebraHost zebraPort zn za bh pnotes policy txType = 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
logDebugN $ T.pack $ show recipients logDebugN $ T.pack $ show recipients
@ -762,19 +868,13 @@ prepareTxV2 pool zebraHost zebraPort zn za bh pnotes policy txType = do
--let fee = calculateTxFee firstPass $ fst recipient --let fee = calculateTxFee firstPass $ fst recipient
--logDebugN $ T.pack $ "calculated fee " ++ show fee --logDebugN $ T.pack $ "calculated fee " ++ show fee
notePlan <- notePlan <-
case txType of liftIO $
Normal -> selectUnspentNotesV2
liftIO $ pool
selectUnspentNotesV2 za
pool (zats + 10000)
za (map (\(x, _, _, _) -> x) recipients)
(zats + 10000) policy
(map (\(x, _, _, _) -> x) recipients)
policy
Shielding ->
liftIO $ selectUnspentNotesV2 pool za (zats + 10000) [3] Medium
Deshielding ->
liftIO $ selectUnspentNotesV2 pool za (zats + 10000) [1] None
case notePlan of case notePlan of
Right (tList, sList, oList) -> do Right (tList, sList, oList) -> do
logDebugN "selected notes" logDebugN "selected notes"
@ -803,7 +903,7 @@ prepareTxV2 pool zebraHost zebraPort zn za bh pnotes policy txType = do
--print oSpends --print oSpends
dummy' <- dummy' <-
liftIO $ liftIO $
makeOutgoing acc recipients (noteTotal - 5000 - zats) policy txType makeOutgoing acc recipients (noteTotal - 5000 - zats) policy
case dummy' of case dummy' of
Left e -> return $ Left e Left e -> return $ Left e
Right dummy -> do Right dummy -> do
@ -826,21 +926,13 @@ prepareTxV2 pool zebraHost zebraPort zn za bh pnotes policy txType = do
fromIntegral fromIntegral
(runGet getInt64le $ LBS.fromStrict $ toBytes fee) (runGet getInt64le $ LBS.fromStrict $ toBytes fee)
finalNotePlan <- finalNotePlan <-
case txType of liftIO $
Normal -> selectUnspentNotesV2
liftIO $ pool
selectUnspentNotesV2 za
pool (zats + feeAmt)
za (map (\(x, _, _, _) -> x) recipients)
(zats + feeAmt) policy
(map (\(x, _, _, _) -> x) recipients)
policy
Shielding ->
liftIO $
selectUnspentNotesV2 pool za (zats + feeAmt) [3] Medium
Deshielding ->
liftIO $
selectUnspentNotesV2 pool za (zats + feeAmt) [1] None
case finalNotePlan of case finalNotePlan of
Right (tList1, sList1, oList1) -> do Right (tList1, sList1, oList1) -> do
logDebugN $ logDebugN $
@ -871,7 +963,6 @@ prepareTxV2 pool zebraHost zebraPort zn za bh pnotes policy txType = do
recipients recipients
(noteTotal1 - feeAmt - zats) (noteTotal1 - feeAmt - zats)
policy policy
txType
logDebugN $ T.pack $ show outgoing' logDebugN $ T.pack $ show outgoing'
case outgoing' of case outgoing' of
Left e -> return $ Left e Left e -> return $ Left e
@ -948,189 +1039,132 @@ prepareTxV2 pool zebraHost zebraPort zn za bh pnotes policy txType = do
-> [(Int, BS.ByteString, Int, T.Text)] -> [(Int, BS.ByteString, Int, T.Text)]
-> Integer -> Integer
-> PrivacyPolicy -> PrivacyPolicy
-> TransactionType
-> IO (Either TxError [OutgoingNote]) -> IO (Either TxError [OutgoingNote])
makeOutgoing acc recvs chg pol tt = do makeOutgoing acc recvs chg pol = do
let k = map (\(x, _, _, _) -> x) recvs let k = map (\(x, _, _, _) -> x) recvs
let j = map (\(_, _, x, _) -> x) recvs let j = map (\(_, _, x, _) -> x) recvs
chgAddr <- runNoLoggingT $ getInternalAddresses pool $ entityKey acc chgAddr <- runNoLoggingT $ getInternalAddresses pool $ entityKey acc
let internalUA = getUA $ walletAddressUAddress $ entityVal $ head chgAddr let internalUA = getUA $ walletAddressUAddress $ entityVal $ head chgAddr
case tt of case pol of
Deshielding -> do Full ->
let chgRcvr = if elem 1 k || elem 2 k || elem 5 k || elem 6 k
fromJust $ then return $
o_rec =<< isValidUnifiedAddress (E.encodeUtf8 internalUA) Left $
let trRcvr = PrivacyPolicyError
fromJust $ "Receiver not compatible with privacy policy"
t_rec =<< isValidUnifiedAddress (E.encodeUtf8 internalUA) else if elem 3 k && elem 4 k
let cnote = then return $
OutgoingNote Left $
4 PrivacyPolicyError
(getBytes $ "Multiple shielded pools not allowed for Full privacy"
getOrchSK $ zcashAccountOrchSpendKey $ entityVal acc) else if 3 `elem` k
(getBytes chgRcvr) then do
(fromIntegral chg) let chgRcvr =
"" fromJust $
True s_rec =<<
let tnote = isValidUnifiedAddress
OutgoingNote (E.encodeUtf8 internalUA)
1 let cnote =
BS.empty OutgoingNote
(toBytes $ tr_bytes trRcvr) 3
(fromIntegral $ head j) (getBytes $
"" getSapSK $
True zcashAccountSapSpendKey $ entityVal acc)
return $ Right [cnote, tnote] (getBytes chgRcvr)
Shielding -> do (fromIntegral chg)
let chgRcvr = ""
fromJust $ True
t_rec =<< isValidUnifiedAddress (E.encodeUtf8 internalUA) let onotes =
let oRcvr = map
fromJust $ (prepareOutgoingNote (entityVal acc))
o_rec =<< isValidUnifiedAddress (E.encodeUtf8 internalUA) recvs
let cnote = return $ Right $ cnote : onotes
OutgoingNote else if 4 `elem` k
1 then do
BS.empty let chgRcvr =
(toBytes $ tr_bytes chgRcvr) fromJust $
(fromIntegral chg) o_rec =<<
"" isValidUnifiedAddress
True (E.encodeUtf8 internalUA)
let snote = let cnote =
OutgoingNote OutgoingNote
4 4
(getBytes $ (getBytes $
getOrchSK $ zcashAccountOrchSpendKey $ entityVal acc) getOrchSK $
(getBytes oRcvr) zcashAccountOrchSpendKey $
(fromIntegral $ head j) entityVal acc)
"" (getBytes chgRcvr)
True (fromIntegral chg)
return $ Right [cnote, snote] ""
Normal -> True
case pol of let onotes =
Full -> map
if elem 1 k || elem 2 k || elem 5 k || elem 6 k (prepareOutgoingNote (entityVal acc))
then return $ recvs
Left $ return $ Right $ cnote : onotes
PrivacyPolicyError else return $ Left ZHError
"Receiver not compatible with privacy policy" Medium ->
else if elem 3 k && elem 4 k if elem 1 k || elem 2 k || elem 5 k || elem 6 k
then return $ then return $
Left $ Left $
PrivacyPolicyError PrivacyPolicyError
"Multiple shielded pulls not allowed for Full privacy" "Receiver not compatible with privacy policy"
else if 3 `elem` k else do
then do let chgRcvr =
let chgRcvr = fromJust $
fromJust $ o_rec =<< isValidUnifiedAddress (E.encodeUtf8 internalUA)
s_rec =<< let cnote =
isValidUnifiedAddress OutgoingNote
(E.encodeUtf8 internalUA) 4
let cnote = (getBytes $
OutgoingNote getOrchSK $ zcashAccountOrchSpendKey $ entityVal acc)
3 (getBytes chgRcvr)
(getBytes $ (fromIntegral chg)
getSapSK $ ""
zcashAccountSapSpendKey $ entityVal acc) True
(getBytes chgRcvr) let onotes = map (prepareOutgoingNote (entityVal acc)) recvs
(fromIntegral chg) return $ Right $ cnote : onotes
"" Low ->
True if elem 5 k || elem 6 k
let onotes = then return $
map Left $
(prepareOutgoingNote (entityVal acc)) PrivacyPolicyError
recvs "Receiver not compatible with privacy policy"
return $ Right $ cnote : onotes else do
else if 4 `elem` k let chgRcvr =
then do fromJust $
let chgRcvr = o_rec =<< isValidUnifiedAddress (E.encodeUtf8 internalUA)
fromJust $ let cnote =
o_rec =<< OutgoingNote
isValidUnifiedAddress 4
(E.encodeUtf8 internalUA) (getBytes $
let cnote = getOrchSK $ zcashAccountOrchSpendKey $ entityVal acc)
OutgoingNote (getBytes chgRcvr)
4 (fromIntegral chg)
(getBytes $ ""
getOrchSK $ True
zcashAccountOrchSpendKey $ let onotes = map (prepareOutgoingNote (entityVal acc)) recvs
entityVal acc) return $ Right $ cnote : onotes
(getBytes chgRcvr) None ->
(fromIntegral chg) if elem 3 k || elem 4 k
"" then return $
True Left $
let onotes = PrivacyPolicyError
map "Receiver not compatible with privacy policy"
(prepareOutgoingNote else do
(entityVal acc)) let chgRcvr =
recvs fromJust $
return $ Right $ cnote : onotes t_rec =<< isValidUnifiedAddress (E.encodeUtf8 internalUA)
else return $ Left ZHError let cnote =
Medium -> OutgoingNote
if elem 1 k || elem 2 k || elem 5 k || elem 6 k 1
then return $ BS.empty
Left $ (toBytes $ tr_bytes chgRcvr)
PrivacyPolicyError (fromIntegral chg)
"Receiver not compatible with privacy policy" ""
else do True
let chgRcvr = let onotes = map (prepareOutgoingNote (entityVal acc)) recvs
fromJust $ return $ Right $ cnote : onotes
o_rec =<<
isValidUnifiedAddress (E.encodeUtf8 internalUA)
let cnote =
OutgoingNote
4
(getBytes $
getOrchSK $ zcashAccountOrchSpendKey $ entityVal acc)
(getBytes chgRcvr)
(fromIntegral chg)
""
True
let onotes = map (prepareOutgoingNote (entityVal acc)) recvs
return $ Right $ cnote : onotes
Low ->
if elem 5 k || elem 6 k
then return $
Left $
PrivacyPolicyError
"Receiver not compatible with privacy policy"
else do
let chgRcvr =
fromJust $
o_rec =<<
isValidUnifiedAddress (E.encodeUtf8 internalUA)
let cnote =
OutgoingNote
4
(getBytes $
getOrchSK $ zcashAccountOrchSpendKey $ entityVal acc)
(getBytes chgRcvr)
(fromIntegral chg)
""
True
let onotes = map (prepareOutgoingNote (entityVal acc)) recvs
return $ Right $ cnote : onotes
None ->
if elem 3 k || elem 4 k
then return $
Left $
PrivacyPolicyError
"Receiver not compatible with privacy policy"
else do
let chgRcvr =
fromJust $
t_rec =<<
isValidUnifiedAddress (E.encodeUtf8 internalUA)
let cnote =
OutgoingNote
1
BS.empty
(toBytes $ tr_bytes chgRcvr)
(fromIntegral chg)
""
True
let onotes = map (prepareOutgoingNote (entityVal acc)) recvs
return $ Right $ cnote : onotes
getTotalAmount :: getTotalAmount ::
( [Entity WalletTrNote] ( [Entity WalletTrNote]
, [Entity WalletSapNote] , [Entity WalletSapNote]
@ -1218,7 +1252,7 @@ prepareTxV2 pool zebraHost zebraPort zn za bh pnotes policy txType = 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
let walletDb = c_dbPath config let walletDb = c_dbPath config

8
src/Zenith/GUI.hs
View file

@ -1106,7 +1106,6 @@ handleEvent wenv node model evt =
(model ^. sendRecipient) (model ^. sendRecipient)
(model ^. sendMemo) (model ^. sendMemo)
(model ^. privacyChoice) (model ^. privacyChoice)
Normal
, Event CancelSend , Event CancelSend
] ]
CancelSend -> CancelSend ->
@ -1258,8 +1257,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
runFileLoggingT "zenith.log" $ runNoLoggingT $ syncWallet (model ^. configuration) cW
syncWallet (model ^. configuration) cW
pool <- pool <-
runNoLoggingT $ runNoLoggingT $
initPool $ c_dbPath $ model ^. configuration initPool $ c_dbPath $ model ^. configuration
@ -1560,10 +1558,9 @@ sendTransaction ::
-> T.Text -> T.Text
-> T.Text -> T.Text
-> PrivacyPolicy -> PrivacyPolicy
-> TransactionType
-> (AppEvent -> IO ()) -> (AppEvent -> IO ())
-> IO () -> IO ()
sendTransaction config znet accId bl amt ua memo policy txType sendMsg = do sendTransaction config znet accId bl amt ua memo policy sendMsg = do
sendMsg $ ShowModal "Preparing transaction..." sendMsg $ ShowModal "Preparing transaction..."
case parseAddress (E.encodeUtf8 ua) of case parseAddress (E.encodeUtf8 ua) of
Nothing -> sendMsg $ ShowError "Incorrect address" Nothing -> sendMsg $ ShowError "Incorrect address"
@ -1589,7 +1586,6 @@ sendTransaction config znet accId bl amt ua memo policy txType sendMsg = do
else Just memo) else Just memo)
] ]
policy policy
txType
case res of case res of
Left e -> sendMsg $ ShowError $ T.pack $ show e Left e -> sendMsg $ ShowError $ T.pack $ show e
Right rawTx -> do Right rawTx -> do

3
src/Zenith/RPC.hs
View file

@ -98,7 +98,6 @@ import Zenith.Types
, PhraseDB(..) , PhraseDB(..)
, PrivacyPolicy(..) , PrivacyPolicy(..)
, ProposedNote(..) , ProposedNote(..)
, ValidAddressAPI(..)
, ZcashAccountAPI(..) , ZcashAccountAPI(..)
, ZcashAddressAPI(..) , ZcashAddressAPI(..)
, ZcashNetDB(..) , ZcashNetDB(..)
@ -910,7 +909,7 @@ scanZebra dbPath zHost zPort net = do
return () return ()
Right _ -> do Right _ -> do
wals <- getWallets pool net wals <- getWallets pool net
runStderrLoggingT $ runNoLoggingT $
mapM_ mapM_
(syncWallet (Config dbPath zHost zPort "user" "pwd" 8080)) (syncWallet (Config dbPath zHost zPort "user" "pwd" 8080))
wals wals

2
src/Zenith/Scanner.hs
View file

@ -238,7 +238,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 <- runFileLoggingT "zenith.log" $ mapM (syncWallet config) w' r <- runNoLoggingT $ mapM (syncWallet config) w'
liftIO $ print r liftIO $ print r
-- | Detect chain re-orgs -- | Detect chain re-orgs

6
src/Zenith/Types.hs
View file

@ -262,12 +262,6 @@ instance ToJSON ProposedNote where
toJSON (ProposedNote a n m) = toJSON (ProposedNote a n m) =
object ["address" .= a, "amount" .= n, "memo" .= m] object ["address" .= a, "amount" .= n, "memo" .= m]
data TransactionType
= Normal
| Shielding
| Deshielding
deriving (Eq, Prelude.Show)
data ShieldDeshieldOp data ShieldDeshieldOp
= Shield = Shield
| Deshield | Deshield