RPC Server #103

Merged
pitmutt merged 129 commits from rav001 into milestone3 2024-11-21 15:30:22 +00:00
5 changed files with 250 additions and 227 deletions
Showing only changes of commit 2f3362e900 - Show all commits

View file

@ -83,7 +83,6 @@ import Zenith.Types
, RseedDB(..)
, SaplingSpendingKeyDB(..)
, ScopeDB(..)
, TransactionType(..)
, TransparentSpendingKeyDB(..)
, UnifiedAddressDB(..)
, ValidAddressAPI(..)
@ -728,6 +727,114 @@ prepareTx pool zebraHost zebraPort zn za bh amt ua memo = do
getHex $ walletOrchNoteWitness $ entityVal $ head notes
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
prepareTxV2 ::
ConnectionPool
@ -738,9 +845,8 @@ prepareTxV2 ::
-> Int
-> [ProposedNote]
-> PrivacyPolicy
-> TransactionType
-> 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
let recipients = map extractReceiver pnotes
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
--logDebugN $ T.pack $ "calculated fee " ++ show fee
notePlan <-
case txType of
Normal ->
liftIO $
selectUnspentNotesV2
pool
za
(zats + 10000)
(map (\(x, _, _, _) -> x) recipients)
policy
Shielding ->
liftIO $ selectUnspentNotesV2 pool za (zats + 10000) [3] Medium
Deshielding ->
liftIO $ selectUnspentNotesV2 pool za (zats + 10000) [1] None
liftIO $
selectUnspentNotesV2
pool
za
(zats + 10000)
(map (\(x, _, _, _) -> x) recipients)
policy
case notePlan of
Right (tList, sList, oList) -> do
logDebugN "selected notes"
@ -803,7 +903,7 @@ prepareTxV2 pool zebraHost zebraPort zn za bh pnotes policy txType = do
--print oSpends
dummy' <-
liftIO $
makeOutgoing acc recipients (noteTotal - 5000 - zats) policy txType
makeOutgoing acc recipients (noteTotal - 5000 - zats) policy
case dummy' of
Left e -> return $ Left e
Right dummy -> do
@ -826,21 +926,13 @@ prepareTxV2 pool zebraHost zebraPort zn za bh pnotes policy txType = do
fromIntegral
(runGet getInt64le $ LBS.fromStrict $ toBytes fee)
finalNotePlan <-
case txType of
Normal ->
liftIO $
selectUnspentNotesV2
pool
za
(zats + feeAmt)
(map (\(x, _, _, _) -> x) recipients)
policy
Shielding ->
liftIO $
selectUnspentNotesV2 pool za (zats + feeAmt) [3] Medium
Deshielding ->
liftIO $
selectUnspentNotesV2 pool za (zats + feeAmt) [1] None
liftIO $
selectUnspentNotesV2
pool
za
(zats + feeAmt)
(map (\(x, _, _, _) -> x) recipients)
policy
case finalNotePlan of
Right (tList1, sList1, oList1) -> do
logDebugN $
@ -871,7 +963,6 @@ prepareTxV2 pool zebraHost zebraPort zn za bh pnotes policy txType = do
recipients
(noteTotal1 - feeAmt - zats)
policy
txType
logDebugN $ T.pack $ show outgoing'
case outgoing' of
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)]
-> Integer
-> PrivacyPolicy
-> TransactionType
-> IO (Either TxError [OutgoingNote])
makeOutgoing acc recvs chg pol tt = do
makeOutgoing acc recvs chg pol = do
let k = map (\(x, _, _, _) -> x) recvs
let j = map (\(_, _, x, _) -> x) recvs
chgAddr <- runNoLoggingT $ getInternalAddresses pool $ entityKey acc
let internalUA = getUA $ walletAddressUAddress $ entityVal $ head chgAddr
case tt of
Deshielding -> do
let chgRcvr =
fromJust $
o_rec =<< isValidUnifiedAddress (E.encodeUtf8 internalUA)
let trRcvr =
fromJust $
t_rec =<< isValidUnifiedAddress (E.encodeUtf8 internalUA)
let cnote =
OutgoingNote
4
(getBytes $
getOrchSK $ zcashAccountOrchSpendKey $ entityVal acc)
(getBytes chgRcvr)
(fromIntegral chg)
""
True
let tnote =
OutgoingNote
1
BS.empty
(toBytes $ tr_bytes trRcvr)
(fromIntegral $ head j)
""
True
return $ Right [cnote, tnote]
Shielding -> do
let chgRcvr =
fromJust $
t_rec =<< isValidUnifiedAddress (E.encodeUtf8 internalUA)
let oRcvr =
fromJust $
o_rec =<< isValidUnifiedAddress (E.encodeUtf8 internalUA)
let cnote =
OutgoingNote
1
BS.empty
(toBytes $ tr_bytes chgRcvr)
(fromIntegral chg)
""
True
let snote =
OutgoingNote
4
(getBytes $
getOrchSK $ zcashAccountOrchSpendKey $ entityVal acc)
(getBytes oRcvr)
(fromIntegral $ head j)
""
True
return $ Right [cnote, snote]
Normal ->
case pol of
Full ->
if elem 1 k || elem 2 k || elem 5 k || elem 6 k
then return $
Left $
PrivacyPolicyError
"Receiver not compatible with privacy policy"
else if elem 3 k && elem 4 k
then return $
Left $
PrivacyPolicyError
"Multiple shielded pulls not allowed for Full privacy"
else if 3 `elem` k
then do
let chgRcvr =
fromJust $
s_rec =<<
isValidUnifiedAddress
(E.encodeUtf8 internalUA)
let cnote =
OutgoingNote
3
(getBytes $
getSapSK $
zcashAccountSapSpendKey $ entityVal acc)
(getBytes chgRcvr)
(fromIntegral chg)
""
True
let onotes =
map
(prepareOutgoingNote (entityVal acc))
recvs
return $ Right $ cnote : onotes
else if 4 `elem` k
then 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
else return $ Left ZHError
Medium ->
if elem 1 k || elem 2 k || 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
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
case pol of
Full ->
if elem 1 k || elem 2 k || elem 5 k || elem 6 k
then return $
Left $
PrivacyPolicyError
"Receiver not compatible with privacy policy"
else if elem 3 k && elem 4 k
then return $
Left $
PrivacyPolicyError
"Multiple shielded pools not allowed for Full privacy"
else if 3 `elem` k
then do
let chgRcvr =
fromJust $
s_rec =<<
isValidUnifiedAddress
(E.encodeUtf8 internalUA)
let cnote =
OutgoingNote
3
(getBytes $
getSapSK $
zcashAccountSapSpendKey $ entityVal acc)
(getBytes chgRcvr)
(fromIntegral chg)
""
True
let onotes =
map
(prepareOutgoingNote (entityVal acc))
recvs
return $ Right $ cnote : onotes
else if 4 `elem` k
then 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
else return $ Left ZHError
Medium ->
if elem 1 k || elem 2 k || 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
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 ::
( [Entity WalletTrNote]
, [Entity WalletSapNote]
@ -1218,7 +1252,7 @@ prepareTxV2 pool zebraHost zebraPort zn za bh pnotes policy txType = do
syncWallet ::
Config -- ^ configuration parameters
-> Entity ZcashWallet
-> LoggingT IO ()
-> NoLoggingT IO ()
syncWallet config w = do
startTime <- liftIO getCurrentTime
let walletDb = c_dbPath config

View file

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

View file

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

View file

@ -238,7 +238,7 @@ clearSync config = do
w <- getWallets pool $ zgb_net chainInfo
liftIO $ mapM_ (updateWalletSync pool 0 . entityKey) w
w' <- liftIO $ getWallets pool $ zgb_net chainInfo
r <- runFileLoggingT "zenith.log" $ mapM (syncWallet config) w'
r <- runNoLoggingT $ mapM (syncWallet config) w'
liftIO $ print r
-- | Detect chain re-orgs

View file

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