feat: draft new prepareTxV2 function
This commit is contained in:
parent
befc3e46cc
commit
4a874897cf
GPG key ID:
65122AD495A7F5B2
1 changed files with 248 additions and 0 deletions
|
|
@ -73,6 +73,7 @@ import Zenith.Types
|
|||
, HexStringDB(..)
|
||||
, OrchardSpendingKeyDB(..)
|
||||
, PhraseDB(..)
|
||||
, PrivacyPolicy(..)
|
||||
, RseedDB(..)
|
||||
, SaplingSpendingKeyDB(..)
|
||||
, ScopeDB(..)
|
||||
|
|
@ -733,6 +734,253 @@ prepareTx pool zebraHost zebraPort zn za bh amt ua memo = do
|
|||
getHex $ walletOrchNoteWitness $ entityVal $ head notes
|
||||
else Nothing
|
||||
|
||||
-- | Prepare a transaction for sending
|
||||
prepareTxV2 ::
|
||||
ConnectionPool
|
||||
-> T.Text
|
||||
-> Int
|
||||
-> ZcashNet
|
||||
-> ZcashAccountId
|
||||
-> Int
|
||||
-> Float
|
||||
-> ValidAddress
|
||||
-> T.Text
|
||||
-> PrivacyPolicy
|
||||
-> LoggingT IO (Either TxError HexString)
|
||||
prepareTxV2 pool zebraHost zebraPort zn za bh amt va memo policy = do
|
||||
accRead <- liftIO $ getAccountById pool za
|
||||
let recipient =
|
||||
case va of
|
||||
Unified ua ->
|
||||
case o_rec ua of
|
||||
Nothing ->
|
||||
case s_rec ua of
|
||||
Nothing ->
|
||||
case t_rec ua of
|
||||
Nothing -> (0, "")
|
||||
Just r3 ->
|
||||
case tr_type r3 of
|
||||
P2PKH -> (1, toBytes $ tr_bytes r3)
|
||||
P2SH -> (2, toBytes $ tr_bytes r3)
|
||||
Just r2 -> (3, getBytes r2)
|
||||
Just r1 -> (4, getBytes r1)
|
||||
Sapling sa -> (3, getBytes $ sa_receiver sa)
|
||||
Transparent ta ->
|
||||
case tr_type (ta_receiver ta) of
|
||||
P2PKH -> (1, toBytes $ tr_bytes (ta_receiver ta))
|
||||
P2SH -> (2, toBytes $ tr_bytes (ta_receiver ta))
|
||||
Exchange ea ->
|
||||
case tr_type (ex_address ea) of
|
||||
P2PKH -> (1, toBytes $ tr_bytes (ex_address ea))
|
||||
P2SH -> (2, toBytes $ tr_bytes (ex_address ea))
|
||||
logDebugN $ T.pack $ show recipient
|
||||
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
|
||||
logDebugN $ T.pack $ show acc
|
||||
spParams <- liftIO $ BS.readFile "sapling-spend.params"
|
||||
outParams <- liftIO $ BS.readFile "sapling-output.params"
|
||||
if show (md5 $ LBS.fromStrict spParams) /=
|
||||
"0f44c12ef115ae019decf18ade583b20"
|
||||
then logErrorN "Can't validate sapling parameters"
|
||||
else logInfoN "Valid Sapling spend params"
|
||||
if show (md5 $ LBS.fromStrict outParams) /=
|
||||
"924daf81b87a81bbbb9c7d18562046c8"
|
||||
then logErrorN "Can't validate sapling parameters"
|
||||
else logInfoN "Valid Sapling output params"
|
||||
--print $ BS.length spParams
|
||||
--print $ BS.length outParams
|
||||
logDebugN "Read Sapling params"
|
||||
let zats = fromIntegral $ floorFloatInteger $ amt * (10 ^ 8)
|
||||
logDebugN $ T.pack $ show zats
|
||||
{-firstPass <- liftIO $ selectUnspentNotes pool za zats-}
|
||||
--let fee = calculateTxFee firstPass $ fst recipient
|
||||
--logDebugN $ T.pack $ "calculated fee " ++ show fee
|
||||
(tList, sList, oList) <- liftIO $ selectUnspentNotes pool za (zats + 5000)
|
||||
logDebugN "selected notes"
|
||||
logDebugN $ T.pack $ show tList
|
||||
logDebugN $ T.pack $ show sList
|
||||
logDebugN $ T.pack $ show oList
|
||||
let noteTotal = getTotalAmount (tList, sList, oList)
|
||||
tSpends <-
|
||||
liftIO $
|
||||
prepTSpends (getTranSK $ zcashAccountTPrivateKey $ entityVal acc) tList
|
||||
--print tSpends
|
||||
sSpends <-
|
||||
liftIO $
|
||||
prepSSpends (getSapSK $ zcashAccountSapSpendKey $ entityVal acc) sList
|
||||
--print sSpends
|
||||
oSpends <-
|
||||
liftIO $
|
||||
prepOSpends (getOrchSK $ zcashAccountOrchSpendKey $ entityVal acc) oList
|
||||
--print oSpends
|
||||
dummy <-
|
||||
liftIO $ makeOutgoing acc recipient zats (noteTotal - 5000 - zats)
|
||||
logDebugN "Calculating fee"
|
||||
let feeResponse =
|
||||
createTransaction
|
||||
(Just sT)
|
||||
(Just oT)
|
||||
tSpends
|
||||
sSpends
|
||||
oSpends
|
||||
dummy
|
||||
(SaplingSpendParams spParams)
|
||||
(SaplingOutputParams outParams)
|
||||
zn
|
||||
(bh + 3)
|
||||
False
|
||||
case feeResponse of
|
||||
Left e1 -> return $ Left Fee
|
||||
Right fee -> do
|
||||
let feeAmt =
|
||||
fromIntegral (runGet getInt64le $ LBS.fromStrict $ toBytes fee)
|
||||
(tList1, sList1, oList1) <-
|
||||
liftIO $ selectUnspentNotes pool za (zats + feeAmt)
|
||||
logDebugN $ T.pack $ "selected notes with fee" ++ show feeAmt
|
||||
logDebugN $ T.pack $ show tList
|
||||
logDebugN $ T.pack $ show sList
|
||||
logDebugN $ T.pack $ show oList
|
||||
outgoing <-
|
||||
liftIO $ makeOutgoing acc recipient zats (noteTotal - feeAmt - zats)
|
||||
logDebugN $ T.pack $ show outgoing
|
||||
let tx =
|
||||
createTransaction
|
||||
(Just sT)
|
||||
(Just oT)
|
||||
tSpends
|
||||
sSpends
|
||||
oSpends
|
||||
outgoing
|
||||
(SaplingSpendParams spParams)
|
||||
(SaplingOutputParams outParams)
|
||||
zn
|
||||
(bh + 3)
|
||||
True
|
||||
logDebugN $ T.pack $ show tx
|
||||
return tx
|
||||
where
|
||||
makeOutgoing ::
|
||||
Entity ZcashAccount
|
||||
-> (Int, BS.ByteString)
|
||||
-> Integer
|
||||
-> Integer
|
||||
-> IO [OutgoingNote]
|
||||
makeOutgoing acc (k, recvr) zats chg = do
|
||||
chgAddr <- runNoLoggingT $ getInternalAddresses pool $ entityKey acc
|
||||
let internalUA = getUA $ walletAddressUAddress $ entityVal $ head chgAddr
|
||||
let chgRcvr =
|
||||
fromJust $ o_rec =<< isValidUnifiedAddress (E.encodeUtf8 internalUA)
|
||||
return
|
||||
[ OutgoingNote
|
||||
4
|
||||
(getBytes $ getOrchSK $ zcashAccountOrchSpendKey $ entityVal acc)
|
||||
(getBytes chgRcvr)
|
||||
(fromIntegral chg)
|
||||
""
|
||||
True
|
||||
, OutgoingNote
|
||||
(fromIntegral k)
|
||||
(case k of
|
||||
4 ->
|
||||
getBytes $ getOrchSK $ zcashAccountOrchSpendKey $ entityVal acc
|
||||
3 ->
|
||||
getBytes $ getSapSK $ zcashAccountSapSpendKey $ entityVal acc
|
||||
_ -> "")
|
||||
recvr
|
||||
(fromIntegral zats)
|
||||
(E.encodeUtf8 memo)
|
||||
False
|
||||
]
|
||||
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))
|
||||
prepSSpends ::
|
||||
SaplingSpendingKey -> [Entity WalletSapNote] -> IO [SaplingTxSpend]
|
||||
prepSSpends sk notes = do
|
||||
forM notes $ \n -> do
|
||||
return $
|
||||
SaplingTxSpend
|
||||
(getBytes sk)
|
||||
(DecodedNote
|
||||
(fromIntegral $ walletSapNoteValue $ entityVal n)
|
||||
(walletSapNoteRecipient $ entityVal n)
|
||||
(E.encodeUtf8 $ walletSapNoteMemo $ entityVal n)
|
||||
(getHex $ walletSapNoteNullifier $ entityVal n)
|
||||
""
|
||||
(getRseed $ walletSapNoteRseed $ entityVal n))
|
||||
(toBytes $ getHex $ walletSapNoteWitness $ entityVal n)
|
||||
prepOSpends ::
|
||||
OrchardSpendingKey -> [Entity WalletOrchNote] -> IO [OrchardTxSpend]
|
||||
prepOSpends sk notes = do
|
||||
forM notes $ \n -> do
|
||||
return $
|
||||
OrchardTxSpend
|
||||
(getBytes sk)
|
||||
(DecodedNote
|
||||
(fromIntegral $ walletOrchNoteValue $ entityVal n)
|
||||
(walletOrchNoteRecipient $ entityVal n)
|
||||
(E.encodeUtf8 $ walletOrchNoteMemo $ entityVal n)
|
||||
(getHex $ walletOrchNoteNullifier $ entityVal n)
|
||||
(walletOrchNoteRho $ entityVal n)
|
||||
(getRseed $ walletOrchNoteRseed $ entityVal n))
|
||||
(toBytes $ getHex $ walletOrchNoteWitness $ entityVal n)
|
||||
sapAnchor :: [Entity WalletSapNote] -> Maybe SaplingWitness
|
||||
sapAnchor notes =
|
||||
if not (null notes)
|
||||
then Just $
|
||||
SaplingWitness $
|
||||
getHex $ walletSapNoteWitness $ entityVal $ head notes
|
||||
else Nothing
|
||||
orchAnchor :: [Entity WalletOrchNote] -> Maybe OrchardWitness
|
||||
orchAnchor notes =
|
||||
if not (null notes)
|
||||
then Just $
|
||||
OrchardWitness $
|
||||
getHex $ walletOrchNoteWitness $ entityVal $ head notes
|
||||
else Nothing
|
||||
|
||||
-- | Sync the wallet with the data store
|
||||
syncWallet ::
|
||||
Config -- ^ configuration parameters
|
||||
|
|
|
|||
Loading…
Reference in a new issue