RPC Server #103
5 changed files with 250 additions and 227 deletions
|
@ -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,8 +868,6 @@ 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
|
||||
|
@ -771,10 +875,6 @@ prepareTxV2 pool zebraHost zebraPort zn za bh pnotes policy txType = do
|
|||
(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
|
||||
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,8 +926,6 @@ 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
|
||||
|
@ -835,12 +933,6 @@ prepareTxV2 pool zebraHost zebraPort zn za bh pnotes policy txType = do
|
|||
(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
|
||||
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,65 +1039,12 @@ 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
|
||||
|
@ -1018,7 +1056,7 @@ prepareTxV2 pool zebraHost zebraPort zn za bh pnotes policy txType = do
|
|||
then return $
|
||||
Left $
|
||||
PrivacyPolicyError
|
||||
"Multiple shielded pulls not allowed for Full privacy"
|
||||
"Multiple shielded pools not allowed for Full privacy"
|
||||
else if 3 `elem` k
|
||||
then do
|
||||
let chgRcvr =
|
||||
|
@ -1061,8 +1099,7 @@ prepareTxV2 pool zebraHost zebraPort zn za bh pnotes policy txType = do
|
|||
True
|
||||
let onotes =
|
||||
map
|
||||
(prepareOutgoingNote
|
||||
(entityVal acc))
|
||||
(prepareOutgoingNote (entityVal acc))
|
||||
recvs
|
||||
return $ Right $ cnote : onotes
|
||||
else return $ Left ZHError
|
||||
|
@ -1075,8 +1112,7 @@ prepareTxV2 pool zebraHost zebraPort zn za bh pnotes policy txType = do
|
|||
else do
|
||||
let chgRcvr =
|
||||
fromJust $
|
||||
o_rec =<<
|
||||
isValidUnifiedAddress (E.encodeUtf8 internalUA)
|
||||
o_rec =<< isValidUnifiedAddress (E.encodeUtf8 internalUA)
|
||||
let cnote =
|
||||
OutgoingNote
|
||||
4
|
||||
|
@ -1097,8 +1133,7 @@ prepareTxV2 pool zebraHost zebraPort zn za bh pnotes policy txType = do
|
|||
else do
|
||||
let chgRcvr =
|
||||
fromJust $
|
||||
o_rec =<<
|
||||
isValidUnifiedAddress (E.encodeUtf8 internalUA)
|
||||
o_rec =<< isValidUnifiedAddress (E.encodeUtf8 internalUA)
|
||||
let cnote =
|
||||
OutgoingNote
|
||||
4
|
||||
|
@ -1119,8 +1154,7 @@ prepareTxV2 pool zebraHost zebraPort zn za bh pnotes policy txType = do
|
|||
else do
|
||||
let chgRcvr =
|
||||
fromJust $
|
||||
t_rec =<<
|
||||
isValidUnifiedAddress (E.encodeUtf8 internalUA)
|
||||
t_rec =<< isValidUnifiedAddress (E.encodeUtf8 internalUA)
|
||||
let cnote =
|
||||
OutgoingNote
|
||||
1
|
||||
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Reference in a new issue