RPC Server #103

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

View file

@ -83,6 +83,7 @@ import Zenith.Types
, RseedDB(..) , RseedDB(..)
, SaplingSpendingKeyDB(..) , SaplingSpendingKeyDB(..)
, ScopeDB(..) , ScopeDB(..)
, TransactionType(..)
, TransparentSpendingKeyDB(..) , TransparentSpendingKeyDB(..)
, UnifiedAddressDB(..) , UnifiedAddressDB(..)
, ValidAddressAPI(..) , ValidAddressAPI(..)
@ -737,8 +738,9 @@ 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 = do prepareTxV2 pool zebraHost zebraPort zn za bh pnotes policy txType = 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
@ -760,13 +762,19 @@ prepareTxV2 pool zebraHost zebraPort zn za bh pnotes policy = 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 <-
liftIO $ case txType of
selectUnspentNotesV2 Normal ->
pool liftIO $
za selectUnspentNotesV2
(zats + 10000) pool
(map (\(x, _, _, _) -> x) recipients) za
policy (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
case notePlan of case notePlan of
Right (tList, sList, oList) -> do Right (tList, sList, oList) -> do
logDebugN "selected notes" logDebugN "selected notes"
@ -795,7 +803,7 @@ prepareTxV2 pool zebraHost zebraPort zn za bh pnotes policy = do
--print oSpends --print oSpends
dummy' <- dummy' <-
liftIO $ liftIO $
makeOutgoing acc recipients (noteTotal - 5000 - zats) policy makeOutgoing acc recipients (noteTotal - 5000 - zats) policy txType
case dummy' of case dummy' of
Left e -> return $ Left e Left e -> return $ Left e
Right dummy -> do Right dummy -> do
@ -818,13 +826,21 @@ prepareTxV2 pool zebraHost zebraPort zn za bh pnotes policy = do
fromIntegral fromIntegral
(runGet getInt64le $ LBS.fromStrict $ toBytes fee) (runGet getInt64le $ LBS.fromStrict $ toBytes fee)
finalNotePlan <- finalNotePlan <-
liftIO $ case txType of
selectUnspentNotesV2 Normal ->
pool liftIO $
za selectUnspentNotesV2
(zats + feeAmt) pool
(map (\(x, _, _, _) -> x) recipients) za
policy (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
case finalNotePlan of case finalNotePlan of
Right (tList1, sList1, oList1) -> do Right (tList1, sList1, oList1) -> do
logDebugN $ logDebugN $
@ -855,6 +871,7 @@ prepareTxV2 pool zebraHost zebraPort zn za bh pnotes policy = 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
@ -931,131 +948,189 @@ prepareTxV2 pool zebraHost zebraPort zn za bh pnotes policy = 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 = do makeOutgoing acc recvs chg pol tt = do
let k = map (\(x, _, _, _) -> x) recvs let k = 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 pol of case tt of
Full -> Deshielding -> do
if elem 1 k || elem 2 k || elem 5 k || elem 6 k let chgRcvr =
then return $ fromJust $
Left $ o_rec =<< isValidUnifiedAddress (E.encodeUtf8 internalUA)
PrivacyPolicyError let trRcvr =
"Receiver not compatible with privacy policy" fromJust $
else if elem 3 k && elem 4 k t_rec =<< isValidUnifiedAddress (E.encodeUtf8 internalUA)
then return $ let cnote =
Left $ OutgoingNote
PrivacyPolicyError 4
"Multiple shielded pulls not allowed for Full privacy" (getBytes $
else if 3 `elem` k getOrchSK $ zcashAccountOrchSpendKey $ entityVal acc)
then do (getBytes chgRcvr)
let chgRcvr = (fromIntegral chg)
fromJust $ ""
s_rec =<< True
isValidUnifiedAddress let tnote =
(E.encodeUtf8 internalUA) OutgoingNote
let cnote = 1
OutgoingNote BS.empty
3 (toBytes $ tr_bytes trRcvr)
(getBytes $ (fromIntegral $ head j)
getSapSK $ ""
zcashAccountSapSpendKey $ entityVal acc) True
(getBytes chgRcvr) return $ Right [cnote, tnote]
(fromIntegral chg) Shielding -> do
"" let chgRcvr =
True fromJust $
let onotes = t_rec =<< isValidUnifiedAddress (E.encodeUtf8 internalUA)
map let oRcvr =
(prepareOutgoingNote (entityVal acc)) fromJust $
recvs o_rec =<< isValidUnifiedAddress (E.encodeUtf8 internalUA)
return $ Right $ cnote : onotes let cnote =
else if 4 `elem` k OutgoingNote
then do 1
let chgRcvr = BS.empty
fromJust $ (toBytes $ tr_bytes chgRcvr)
o_rec =<< (fromIntegral chg)
isValidUnifiedAddress ""
(E.encodeUtf8 internalUA) True
let cnote = let snote =
OutgoingNote OutgoingNote
4 4
(getBytes $ (getBytes $
getOrchSK $ getOrchSK $ zcashAccountOrchSpendKey $ entityVal acc)
zcashAccountOrchSpendKey $ (getBytes oRcvr)
entityVal acc) (fromIntegral $ head j)
(getBytes chgRcvr) ""
(fromIntegral chg) True
"" return $ Right [cnote, snote]
True Normal ->
let onotes = case pol of
map Full ->
(prepareOutgoingNote (entityVal acc)) if elem 1 k || elem 2 k || elem 5 k || elem 6 k
recvs then return $
return $ Right $ cnote : onotes Left $
else return $ Left ZHError PrivacyPolicyError
Medium -> "Receiver not compatible with privacy policy"
if elem 1 k || elem 2 k || elem 5 k || elem 6 k else if elem 3 k && elem 4 k
then return $ then return $
Left $ Left $
PrivacyPolicyError PrivacyPolicyError
"Receiver not compatible with privacy policy" "Multiple shielded pulls not allowed for Full privacy"
else do else if 3 `elem` k
let chgRcvr = then do
fromJust $ let chgRcvr =
o_rec =<< isValidUnifiedAddress (E.encodeUtf8 internalUA) fromJust $
let cnote = s_rec =<<
OutgoingNote isValidUnifiedAddress
4 (E.encodeUtf8 internalUA)
(getBytes $ let cnote =
getOrchSK $ zcashAccountOrchSpendKey $ entityVal acc) OutgoingNote
(getBytes chgRcvr) 3
(fromIntegral chg) (getBytes $
"" getSapSK $
True zcashAccountSapSpendKey $ entityVal acc)
let onotes = map (prepareOutgoingNote (entityVal acc)) recvs (getBytes chgRcvr)
return $ Right $ cnote : onotes (fromIntegral chg)
Low -> ""
if elem 5 k || elem 6 k True
then return $ let onotes =
Left $ map
PrivacyPolicyError (prepareOutgoingNote (entityVal acc))
"Receiver not compatible with privacy policy" recvs
else do return $ Right $ cnote : onotes
let chgRcvr = else if 4 `elem` k
fromJust $ then do
o_rec =<< isValidUnifiedAddress (E.encodeUtf8 internalUA) let chgRcvr =
let cnote = fromJust $
OutgoingNote o_rec =<<
4 isValidUnifiedAddress
(getBytes $ (E.encodeUtf8 internalUA)
getOrchSK $ zcashAccountOrchSpendKey $ entityVal acc) let cnote =
(getBytes chgRcvr) OutgoingNote
(fromIntegral chg) 4
"" (getBytes $
True getOrchSK $
let onotes = map (prepareOutgoingNote (entityVal acc)) recvs zcashAccountOrchSpendKey $
return $ Right $ cnote : onotes entityVal acc)
None -> (getBytes chgRcvr)
if elem 3 k || elem 4 k (fromIntegral chg)
then return $ ""
Left $ True
PrivacyPolicyError let onotes =
"Receiver not compatible with privacy policy" map
else do (prepareOutgoingNote
let chgRcvr = (entityVal acc))
fromJust $ recvs
t_rec =<< isValidUnifiedAddress (E.encodeUtf8 internalUA) return $ Right $ cnote : onotes
let cnote = else return $ Left ZHError
OutgoingNote Medium ->
1 if elem 1 k || elem 2 k || elem 5 k || elem 6 k
BS.empty then return $
(toBytes $ tr_bytes chgRcvr) Left $
(fromIntegral chg) PrivacyPolicyError
"" "Receiver not compatible with privacy policy"
True else do
let onotes = map (prepareOutgoingNote (entityVal acc)) recvs let chgRcvr =
return $ Right $ cnote : onotes 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 :: getTotalAmount ::
( [Entity WalletTrNote] ( [Entity WalletTrNote]
, [Entity WalletSapNote] , [Entity WalletSapNote]

View file

@ -1106,6 +1106,7 @@ handleEvent wenv node model evt =
(model ^. sendRecipient) (model ^. sendRecipient)
(model ^. sendMemo) (model ^. sendMemo)
(model ^. privacyChoice) (model ^. privacyChoice)
Normal
, Event CancelSend , Event CancelSend
] ]
CancelSend -> CancelSend ->
@ -1559,9 +1560,10 @@ 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 sendMsg = do sendTransaction config znet accId bl amt ua memo policy txType 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"
@ -1579,8 +1581,15 @@ sendTransaction config znet accId bl amt ua memo policy sendMsg = do
znet znet
accId accId
bl bl
[ProposedNote (ValidAddressAPI addr) amt (Just memo)] [ ProposedNote
(ValidAddressAPI addr)
amt
(if memo == ""
then Nothing
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

View file

@ -262,6 +262,12 @@ 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)
-- ** `zebrad` -- ** `zebrad`
-- | Type for modeling the tree state response -- | Type for modeling the tree state response
data ZebraTreeInfo = ZebraTreeInfo data ZebraTreeInfo = ZebraTreeInfo