RPC Server #103
3 changed files with 229 additions and 139 deletions
|
@ -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]
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
Loading…
Reference in a new issue