From 4a874897cf94b9d1367348efe9cad27f4aa5cb7a Mon Sep 17 00:00:00 2001 From: Rene Vergara Date: Mon, 16 Sep 2024 11:52:57 -0500 Subject: [PATCH] feat: draft new `prepareTxV2` function --- src/Zenith/Core.hs | 248 +++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 248 insertions(+) diff --git a/src/Zenith/Core.hs b/src/Zenith/Core.hs index 9d9a7c4..4e27207 100644 --- a/src/Zenith/Core.hs +++ b/src/Zenith/Core.hs @@ -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