zenith/src/Zenith/Core.hs

775 lines
26 KiB
Haskell
Raw Normal View History

{-# LANGUAGE OverloadedStrings #-}
-- | Core wallet functionality for Zenith
module Zenith.Core where
2024-04-18 01:28:47 +00:00
import Control.Exception (throwIO, try)
2024-05-03 12:10:08 +00:00
import Control.Monad (forM, when)
import Control.Monad.IO.Class (liftIO)
import Control.Monad.Logger
( LoggingT
, MonadLoggerIO
2024-05-05 14:49:55 +00:00
, NoLoggingT
2024-05-09 15:44:07 +00:00
, logDebugN
, logErrorN
2024-05-03 12:10:08 +00:00
, logInfoN
, logWarnN
, runFileLoggingT
2024-05-05 14:49:55 +00:00
, runNoLoggingT
2024-05-03 12:10:08 +00:00
, runStdoutLoggingT
)
import Crypto.Secp256k1 (SecKey(..))
import Data.Aeson
2024-05-09 15:44:07 +00:00
import Data.Binary.Get hiding (getBytes)
2024-05-03 12:10:08 +00:00
import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as LBS
import Data.Digest.Pure.MD5
import Data.HexString (HexString, hexString, toBytes)
import Data.List
2024-04-18 01:28:47 +00:00
import Data.Maybe (fromJust)
2024-05-03 12:10:08 +00:00
import Data.Pool (Pool)
import qualified Data.Text as T
2024-04-18 01:28:47 +00:00
import qualified Data.Text.Encoding as E
2024-05-03 12:10:08 +00:00
import Data.Time
import qualified Database.Esqueleto.Experimental as ESQ
import Database.Persist
2024-04-18 01:28:47 +00:00
import Database.Persist.Sqlite
2024-05-03 12:10:08 +00:00
import GHC.Float.RealFracMethods (floorFloatInteger)
import Haskoin.Crypto.Keys (XPrvKey(..))
2024-05-05 14:49:55 +00:00
import Lens.Micro ((&), (.~), (^.), set)
import Network.HTTP.Client
import ZcashHaskell.Keys
import ZcashHaskell.Orchard
2024-04-18 01:28:47 +00:00
( decryptOrchardActionSK
, encodeUnifiedAddress
2024-03-17 12:17:52 +00:00
, genOrchardReceiver
, genOrchardSpendingKey
2024-04-18 01:28:47 +00:00
, getOrchardNotePosition
, getOrchardWitness
2024-05-03 12:10:08 +00:00
, isValidUnifiedAddress
2024-04-18 01:28:47 +00:00
, updateOrchardCommitmentTree
2024-05-03 12:10:08 +00:00
, updateOrchardWitness
2024-03-17 12:17:52 +00:00
)
import ZcashHaskell.Sapling
2024-04-18 01:28:47 +00:00
( decodeSaplingOutputEsk
, genSaplingInternalAddress
2024-03-17 12:17:52 +00:00
, genSaplingPaymentAddress
, genSaplingSpendingKey
2024-04-18 01:28:47 +00:00
, getSaplingNotePosition
, getSaplingWitness
, updateSaplingCommitmentTree
2024-05-03 12:10:08 +00:00
, updateSaplingWitness
)
import ZcashHaskell.Transparent
( genTransparentPrvKey
, genTransparentReceiver
, genTransparentSecretKey
2024-03-17 12:17:52 +00:00
)
import ZcashHaskell.Types
import ZcashHaskell.Utils
import Zenith.DB
2024-03-17 12:17:52 +00:00
import Zenith.Types
2024-04-18 01:28:47 +00:00
( Config(..)
, HexStringDB(..)
, OrchardSpendingKeyDB(..)
2024-03-17 12:17:52 +00:00
, PhraseDB(..)
2024-05-03 12:10:08 +00:00
, RseedDB(..)
2024-03-17 12:17:52 +00:00
, SaplingSpendingKeyDB(..)
, ScopeDB(..)
, TransparentSpendingKeyDB(..)
, UnifiedAddressDB(..)
, ZcashNetDB(..)
2024-04-09 18:32:39 +00:00
, ZebraTreeInfo(..)
2024-03-17 12:17:52 +00:00
)
-- * Zebra Node interaction
-- | Checks the status of the `zebrad` node
checkZebra ::
2024-02-14 18:03:18 +00:00
T.Text -- ^ Host where `zebrad` is available
-> Int -- ^ Port where `zebrad` is available
-> IO ZebraGetInfo
2024-02-28 21:12:57 +00:00
checkZebra nodeHost nodePort = do
res <- makeZebraCall nodeHost nodePort "getinfo" []
case res of
Left e -> throwIO $ userError e
Right bi -> return bi
-- | Checks the status of the Zcash blockchain
checkBlockChain ::
2024-02-14 18:03:18 +00:00
T.Text -- ^ Host where `zebrad` is available
-> Int -- ^ Port where `zebrad` is available
-> IO ZebraGetBlockChainInfo
2024-02-28 21:12:57 +00:00
checkBlockChain nodeHost nodePort = do
r <- makeZebraCall nodeHost nodePort "getblockchaininfo" []
case r of
Left e -> throwIO $ userError e
Right bci -> return bci
2024-04-09 18:32:39 +00:00
-- | Get commitment trees from Zebra
getCommitmentTrees ::
T.Text -- ^ Host where `zebrad` is avaiable
-> Int -- ^ Port where `zebrad` is available
-> Int -- ^ Block height
-> IO ZebraTreeInfo
getCommitmentTrees nodeHost nodePort block = do
r <-
makeZebraCall
nodeHost
nodePort
"z_gettreestate"
[Data.Aeson.String $ T.pack $ show block]
case r of
Left e -> throwIO $ userError e
Right zti -> return zti
-- * Spending Keys
-- | Create an Orchard Spending Key for the given wallet and account index
2024-03-17 12:17:52 +00:00
createOrchardSpendingKey :: ZcashWallet -> Int -> IO OrchardSpendingKey
createOrchardSpendingKey zw i = do
2024-03-17 12:17:52 +00:00
let s = getWalletSeed $ getPhrase $ zcashWalletSeedPhrase zw
case s of
Nothing -> throwIO $ userError "Unable to generate seed"
Just s' -> do
let coinType =
2024-03-17 12:17:52 +00:00
case getNet $ zcashWalletNetwork zw of
MainNet -> MainNetCoin
TestNet -> TestNetCoin
RegTestNet -> RegTestNetCoin
let r = genOrchardSpendingKey s' coinType i
case r of
Nothing -> throwIO $ userError "Unable to generate Orchard spending key"
Just sk -> return sk
2024-03-17 12:17:52 +00:00
-- | Create a Sapling spending key for the given wallet and account index
createSaplingSpendingKey :: ZcashWallet -> Int -> IO SaplingSpendingKey
createSaplingSpendingKey zw i = do
let s = getWalletSeed $ getPhrase $ zcashWalletSeedPhrase zw
case s of
Nothing -> throwIO $ userError "Unable to generate seed"
Just s' -> do
let coinType =
case getNet $ zcashWalletNetwork zw of
MainNet -> MainNetCoin
TestNet -> TestNetCoin
RegTestNet -> RegTestNetCoin
let r = genSaplingSpendingKey s' coinType i
case r of
Nothing -> throwIO $ userError "Unable to generate Sapling spending key"
Just sk -> return sk
createTransparentSpendingKey :: ZcashWallet -> Int -> IO TransparentSpendingKey
createTransparentSpendingKey zw i = do
let s = getWalletSeed $ getPhrase $ zcashWalletSeedPhrase zw
case s of
Nothing -> throwIO $ userError "Unable to generate seed"
Just s' -> do
let coinType =
case getNet $ zcashWalletNetwork zw of
MainNet -> MainNetCoin
TestNet -> TestNetCoin
RegTestNet -> RegTestNetCoin
genTransparentPrvKey s' coinType i
-- * Accounts
-- | Create an account for the given wallet and account index
createZcashAccount ::
T.Text -- ^ The account's name
-> Int -- ^ The account's index
-> Entity ZcashWallet -- ^ The Zcash wallet that this account will be attached to
-> IO ZcashAccount
createZcashAccount n i zw = do
orSk <- createOrchardSpendingKey (entityVal zw) i
2024-03-17 12:17:52 +00:00
sapSk <- createSaplingSpendingKey (entityVal zw) i
tSk <- createTransparentSpendingKey (entityVal zw) i
return $
ZcashAccount
i
(entityKey zw)
n
(OrchardSpendingKeyDB orSk)
(SaplingSpendingKeyDB sapSk)
(TransparentSpendingKeyDB tSk)
2024-03-07 20:20:06 +00:00
-- * Addresses
2024-03-17 12:17:52 +00:00
-- | Create an external unified address for the given account and index
2024-03-07 20:20:06 +00:00
createWalletAddress ::
T.Text -- ^ The address nickname
-> Int -- ^ The address' index
-> ZcashNet -- ^ The network for this address
2024-03-17 12:17:52 +00:00
-> Scope -- ^ External or Internal
2024-03-07 20:20:06 +00:00
-> Entity ZcashAccount -- ^ The Zcash account that the address will be attached to
-> IO WalletAddress
2024-03-17 12:17:52 +00:00
createWalletAddress n i zNet scope za = do
let oRec =
genOrchardReceiver i scope $
getOrchSK $ zcashAccountOrchSpendKey $ entityVal za
let sRec =
case scope of
External ->
genSaplingPaymentAddress i $
getSapSK $ zcashAccountSapSpendKey $ entityVal za
Internal ->
genSaplingInternalAddress $
getSapSK $ zcashAccountSapSpendKey $ entityVal za
tRec <-
genTransparentReceiver i scope $
getTranSK $ zcashAccountTPrivateKey $ entityVal za
2024-03-07 20:20:06 +00:00
return $
WalletAddress
i
(entityKey za)
n
2024-03-17 12:17:52 +00:00
(UnifiedAddressDB $
encodeUnifiedAddress $ UnifiedAddress zNet oRec sRec (Just tRec))
(ScopeDB scope)
2024-04-04 18:21:55 +00:00
-- * Wallet
2024-04-18 01:28:47 +00:00
-- | Find the Sapling notes that match the given spending key
findSaplingOutputs ::
Config -- ^ the configuration parameters
-> Int -- ^ the starting block
-> ZcashNetDB -- ^ The network
2024-04-24 12:42:35 +00:00
-> Entity ZcashAccount -- ^ The account to use
2024-04-18 01:28:47 +00:00
-> IO ()
2024-04-24 12:42:35 +00:00
findSaplingOutputs config b znet za = do
2024-04-18 01:28:47 +00:00
let dbPath = c_dbPath config
let zebraHost = c_zebraHost config
let zebraPort = c_zebraPort config
let zn = getNet znet
2024-05-05 14:49:55 +00:00
pool <- runNoLoggingT $ initPool dbPath
tList <- getShieldedOutputs pool b
2024-04-18 01:28:47 +00:00
trees <- getCommitmentTrees zebraHost zebraPort (b - 1)
let sT = SaplingCommitmentTree $ ztiSapling trees
2024-05-05 14:49:55 +00:00
decryptNotes sT zn pool tList
sapNotes <- getWalletSapNotes pool (entityKey za)
findSapSpends pool (entityKey za) sapNotes
2024-04-18 01:28:47 +00:00
where
2024-04-24 12:42:35 +00:00
sk :: SaplingSpendingKeyDB
sk = zcashAccountSapSpendKey $ entityVal za
2024-04-18 01:28:47 +00:00
decryptNotes ::
SaplingCommitmentTree
-> ZcashNet
2024-05-05 14:49:55 +00:00
-> ConnectionPool
2024-04-18 01:28:47 +00:00
-> [(Entity ZcashTransaction, Entity ShieldOutput)]
-> IO ()
2024-05-05 14:49:55 +00:00
decryptNotes _ _ _ [] = return ()
decryptNotes st n pool ((zt, o):txs) = do
2024-04-18 01:28:47 +00:00
let updatedTree =
updateSaplingCommitmentTree
st
(getHex $ shieldOutputCmu $ entityVal o)
case updatedTree of
Nothing -> throwIO $ userError "Failed to update commitment tree"
Just uT -> do
let noteWitness = getSaplingWitness uT
let notePos = getSaplingNotePosition <$> noteWitness
case notePos of
Nothing -> throwIO $ userError "Failed to obtain note position"
Just nP -> do
case decodeShOut External n nP o of
Nothing -> do
case decodeShOut Internal n nP o of
Nothing -> do
2024-05-05 14:49:55 +00:00
decryptNotes uT n pool txs
2024-04-18 01:28:47 +00:00
Just dn1 -> do
2024-05-05 14:49:55 +00:00
wId <- saveWalletTransaction pool (entityKey za) zt
2024-04-18 01:28:47 +00:00
saveWalletSapNote
2024-05-05 14:49:55 +00:00
pool
2024-04-18 01:28:47 +00:00
wId
nP
(fromJust noteWitness)
2024-04-21 12:07:51 +00:00
True
2024-04-24 12:42:35 +00:00
(entityKey za)
2024-05-03 12:10:08 +00:00
(entityKey o)
2024-04-18 01:28:47 +00:00
dn1
2024-05-05 14:49:55 +00:00
decryptNotes uT n pool txs
2024-04-18 01:28:47 +00:00
Just dn0 -> do
2024-05-05 14:49:55 +00:00
wId <- saveWalletTransaction pool (entityKey za) zt
2024-04-18 01:28:47 +00:00
saveWalletSapNote
2024-05-05 14:49:55 +00:00
pool
2024-04-18 01:28:47 +00:00
wId
nP
(fromJust noteWitness)
2024-04-21 12:07:51 +00:00
False
2024-04-24 12:42:35 +00:00
(entityKey za)
2024-05-03 12:10:08 +00:00
(entityKey o)
2024-04-18 01:28:47 +00:00
dn0
2024-05-05 14:49:55 +00:00
decryptNotes uT n pool txs
2024-04-18 01:28:47 +00:00
decodeShOut ::
Scope
-> ZcashNet
-> Integer
-> Entity ShieldOutput
-> Maybe DecodedNote
decodeShOut scope n pos s = do
decodeSaplingOutputEsk
(getSapSK sk)
(ShieldedOutput
(getHex $ shieldOutputCv $ entityVal s)
(getHex $ shieldOutputCmu $ entityVal s)
(getHex $ shieldOutputEphKey $ entityVal s)
(getHex $ shieldOutputEncCipher $ entityVal s)
(getHex $ shieldOutputOutCipher $ entityVal s)
(getHex $ shieldOutputProof $ entityVal s))
n
scope
pos
-- | Get Orchard actions
findOrchardActions ::
Config -- ^ the configuration parameters
-> Int -- ^ the starting block
-> ZcashNetDB -- ^ The network
2024-04-24 12:42:35 +00:00
-> Entity ZcashAccount -- ^ The account to use
2024-04-18 01:28:47 +00:00
-> IO ()
2024-04-24 12:42:35 +00:00
findOrchardActions config b znet za = do
2024-04-18 01:28:47 +00:00
let dbPath = c_dbPath config
let zebraHost = c_zebraHost config
let zebraPort = c_zebraPort config
let zn = getNet znet
2024-05-05 14:49:55 +00:00
pool <- runNoLoggingT $ initPool dbPath
tList <- getOrchardActions pool b
2024-04-18 01:28:47 +00:00
trees <- getCommitmentTrees zebraHost zebraPort (b - 1)
let sT = OrchardCommitmentTree $ ztiOrchard trees
2024-05-05 14:49:55 +00:00
decryptNotes sT zn pool tList
orchNotes <- getWalletOrchNotes pool (entityKey za)
findOrchSpends pool (entityKey za) orchNotes
2024-04-18 01:28:47 +00:00
where
decryptNotes ::
OrchardCommitmentTree
-> ZcashNet
2024-05-05 14:49:55 +00:00
-> ConnectionPool
2024-04-18 01:28:47 +00:00
-> [(Entity ZcashTransaction, Entity OrchAction)]
-> IO ()
2024-05-05 14:49:55 +00:00
decryptNotes _ _ _ [] = return ()
decryptNotes ot n pool ((zt, o):txs) = do
2024-04-18 01:28:47 +00:00
let updatedTree =
updateOrchardCommitmentTree
ot
(getHex $ orchActionCmx $ entityVal o)
case updatedTree of
Nothing -> throwIO $ userError "Failed to update commitment tree"
Just uT -> do
let noteWitness = getOrchardWitness uT
let notePos = getOrchardNotePosition <$> noteWitness
case notePos of
Nothing -> throwIO $ userError "Failed to obtain note position"
Just nP ->
case decodeOrchAction External nP o of
Nothing ->
case decodeOrchAction Internal nP o of
2024-05-05 14:49:55 +00:00
Nothing -> decryptNotes uT n pool txs
2024-04-18 01:28:47 +00:00
Just dn1 -> do
2024-05-05 14:49:55 +00:00
wId <- saveWalletTransaction pool (entityKey za) zt
2024-04-18 01:28:47 +00:00
saveWalletOrchNote
2024-05-05 14:49:55 +00:00
pool
2024-04-18 01:28:47 +00:00
wId
nP
(fromJust noteWitness)
2024-04-21 12:07:51 +00:00
True
2024-04-24 12:42:35 +00:00
(entityKey za)
2024-05-03 12:10:08 +00:00
(entityKey o)
2024-04-18 01:28:47 +00:00
dn1
2024-05-05 14:49:55 +00:00
decryptNotes uT n pool txs
2024-04-18 01:28:47 +00:00
Just dn -> do
2024-05-05 14:49:55 +00:00
wId <- saveWalletTransaction pool (entityKey za) zt
2024-04-18 01:28:47 +00:00
saveWalletOrchNote
2024-05-05 14:49:55 +00:00
pool
2024-04-18 01:28:47 +00:00
wId
nP
(fromJust noteWitness)
2024-04-21 12:07:51 +00:00
False
2024-04-24 12:42:35 +00:00
(entityKey za)
2024-05-03 12:10:08 +00:00
(entityKey o)
2024-04-18 01:28:47 +00:00
dn
2024-05-05 14:49:55 +00:00
decryptNotes uT n pool txs
2024-04-24 12:42:35 +00:00
sk :: OrchardSpendingKeyDB
sk = zcashAccountOrchSpendKey $ entityVal za
2024-04-18 01:28:47 +00:00
decodeOrchAction ::
Scope -> Integer -> Entity OrchAction -> Maybe DecodedNote
decodeOrchAction scope pos o =
decryptOrchardActionSK (getOrchSK sk) scope $
OrchardAction
(getHex $ orchActionNf $ entityVal o)
(getHex $ orchActionRk $ entityVal o)
(getHex $ orchActionCmx $ entityVal o)
(getHex $ orchActionEphKey $ entityVal o)
(getHex $ orchActionEncCipher $ entityVal o)
(getHex $ orchActionOutCipher $ entityVal o)
(getHex $ orchActionCv $ entityVal o)
(getHex $ orchActionAuth $ entityVal o)
2024-05-05 14:49:55 +00:00
updateSaplingWitnesses :: ConnectionPool -> IO ()
updateSaplingWitnesses pool = do
sapNotes <- getUnspentSapNotes pool
2024-05-03 12:10:08 +00:00
maxId <- liftIO $ getMaxSaplingNote pool
2024-05-05 14:49:55 +00:00
mapM_ (updateOneNote maxId) sapNotes
2024-05-03 12:10:08 +00:00
where
2024-05-05 14:49:55 +00:00
updateOneNote :: ShieldOutputId -> Entity WalletSapNote -> IO ()
updateOneNote maxId n = do
2024-05-03 12:10:08 +00:00
let noteSync = walletSapNoteWitPos $ entityVal n
2024-05-05 14:49:55 +00:00
when (noteSync < maxId) $ do
cmus <- liftIO $ getSaplingCmus pool $ walletSapNoteWitPos $ entityVal n
let cmuList = map (\(ESQ.Value x) -> getHex x) cmus
let newWitness =
updateSaplingWitness
(SaplingWitness $ getHex $ walletSapNoteWitness $ entityVal n)
cmuList
liftIO $ updateSapNoteRecord pool (entityKey n) newWitness maxId
2024-05-03 12:10:08 +00:00
2024-05-05 14:49:55 +00:00
updateOrchardWitnesses :: ConnectionPool -> IO ()
updateOrchardWitnesses pool = do
orchNotes <- getUnspentOrchNotes pool
maxId <- getMaxOrchardNote pool
mapM_ (updateOneNote maxId) orchNotes
2024-05-03 12:10:08 +00:00
where
2024-05-05 14:49:55 +00:00
updateOneNote :: OrchActionId -> Entity WalletOrchNote -> IO ()
updateOneNote maxId n = do
2024-05-03 12:10:08 +00:00
let noteSync = walletOrchNoteWitPos $ entityVal n
2024-05-05 14:49:55 +00:00
when (noteSync < maxId) $ do
cmxs <- liftIO $ getOrchardCmxs pool noteSync
let cmxList = map (\(ESQ.Value x) -> getHex x) cmxs
let newWitness =
updateOrchardWitness
(OrchardWitness $ getHex $ walletOrchNoteWitness $ entityVal n)
cmxList
liftIO $ updateOrchNoteRecord pool (entityKey n) newWitness maxId
2024-05-03 12:10:08 +00:00
-- | Calculate fee per ZIP-317
calculateTxFee ::
([Entity WalletTrNote], [Entity WalletSapNote], [Entity WalletOrchNote])
-> Int
-> Integer
calculateTxFee (t, s, o) i =
fromIntegral
(5000 * (max (length t) tout + max (length s) sout + length o + oout))
where
tout =
2024-05-09 15:44:07 +00:00
if i == 1 || i == 2
2024-05-03 12:10:08 +00:00
then 1
else 0
sout =
2024-05-09 15:44:07 +00:00
if i == 3
2024-05-03 12:10:08 +00:00
then 1
else 0
oout =
2024-05-09 15:44:07 +00:00
if i == 4
then 1
else 0
2024-05-03 12:10:08 +00:00
-- | Prepare a transaction for sending
prepareTx ::
2024-05-05 14:49:55 +00:00
ConnectionPool
2024-05-03 12:10:08 +00:00
-> T.Text
-> Int
-> ZcashNet
-> ZcashAccountId
-> Int
-> Float
-> UnifiedAddress
-> T.Text
2024-05-09 15:44:07 +00:00
-> LoggingT IO (Either TxError HexString)
2024-05-05 14:49:55 +00:00
prepareTx pool zebraHost zebraPort zn za bh amt ua memo = do
2024-05-09 15:44:07 +00:00
accRead <- liftIO $ getAccountById pool za
2024-05-03 12:10:08 +00:00
let recipient =
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)
2024-05-09 15:44:07 +00:00
logDebugN $ T.pack $ show recipient
logDebugN $ T.pack $ "Target block: " ++ show bh
trees <- liftIO $ getCommitmentTrees zebraHost zebraPort bh
2024-05-03 12:10:08 +00:00
let sT = SaplingCommitmentTree $ ztiSapling trees
let oT = OrchardCommitmentTree $ ztiOrchard trees
case accRead of
2024-05-09 15:44:07 +00:00
Nothing -> do
logErrorN "Can't find Account"
return $ Left ZHError
2024-05-03 12:10:08 +00:00
Just acc -> do
2024-05-09 15:44:07 +00:00
logDebugN $ T.pack $ show acc
spParams <- liftIO $ BS.readFile "sapling-spend.params"
outParams <- liftIO $ BS.readFile "sapling-output.params"
2024-05-03 12:10:08 +00:00
if show (md5 $ LBS.fromStrict spParams) /=
"0f44c12ef115ae019decf18ade583b20"
2024-05-09 15:44:07 +00:00
then logErrorN "Can't validate sapling parameters"
else logInfoN "Valid Sapling spend params"
2024-05-03 12:10:08 +00:00
if show (md5 $ LBS.fromStrict outParams) /=
"924daf81b87a81bbbb9c7d18562046c8"
2024-05-09 15:44:07 +00:00
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"
2024-05-03 12:10:08 +00:00
let zats = fromIntegral $ floorFloatInteger $ amt * (10 ^ 8)
2024-05-09 15:44:07 +00:00
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
2024-05-03 12:10:08 +00:00
let noteTotal = getTotalAmount (tList, sList, oList)
tSpends <-
2024-05-09 15:44:07 +00:00
liftIO $
2024-05-03 12:10:08 +00:00
prepTSpends (getTranSK $ zcashAccountTPrivateKey $ entityVal acc) tList
2024-05-09 15:44:07 +00:00
--print tSpends
2024-05-03 12:10:08 +00:00
sSpends <-
2024-05-09 15:44:07 +00:00
liftIO $
2024-05-03 12:10:08 +00:00
prepSSpends (getSapSK $ zcashAccountSapSpendKey $ entityVal acc) sList
2024-05-09 15:44:07 +00:00
--print sSpends
2024-05-03 12:10:08 +00:00
oSpends <-
2024-05-09 15:44:07 +00:00
liftIO $
2024-05-03 12:10:08 +00:00
prepOSpends (getOrchSK $ zcashAccountOrchSpendKey $ entityVal acc) oList
2024-05-09 15:44:07 +00:00
--print oSpends
dummy <-
liftIO $ makeOutgoing acc recipient zats (noteTotal - 5000 - zats)
logDebugN "Calculating fee"
let feeResponse =
2024-05-03 12:10:08 +00:00
createTransaction
(Just sT)
(Just oT)
tSpends
sSpends
oSpends
2024-05-09 15:44:07 +00:00
dummy
2024-05-03 12:10:08 +00:00
(SaplingSpendParams spParams)
(SaplingOutputParams outParams)
zn
(bh + 3)
2024-05-09 15:44:07 +00:00
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
return tx
2024-05-03 12:10:08 +00:00
where
makeOutgoing ::
Entity ZcashAccount
-> (Int, BS.ByteString)
-> Integer
-> Integer
-> IO [OutgoingNote]
makeOutgoing acc (k, recvr) zats chg = do
2024-05-05 14:49:55 +00:00
chgAddr <- runNoLoggingT $ getInternalAddresses pool $ entityKey acc
2024-05-03 12:10:08 +00:00
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
2024-05-05 14:49:55 +00:00
tAddRead <- getAddressById pool $ walletTrNoteAddress $ entityVal n
2024-05-03 12:10:08 +00:00
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
2024-05-05 14:49:55 +00:00
mReverseTxId <- getWalletTxId pool $ walletTrNoteTx $ entityVal n
2024-05-03 12:10:08 +00:00
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
(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
2024-04-04 18:21:55 +00:00
-- | Sync the wallet with the data store
syncWallet ::
2024-04-18 01:28:47 +00:00
Config -- ^ configuration parameters
2024-04-04 18:21:55 +00:00
-> Entity ZcashWallet
2024-05-05 14:49:55 +00:00
-> IO ()
2024-04-18 01:28:47 +00:00
syncWallet config w = do
2024-05-05 14:49:55 +00:00
startTime <- liftIO getCurrentTime
2024-04-18 01:28:47 +00:00
let walletDb = c_dbPath config
2024-05-05 14:49:55 +00:00
pool <- runNoLoggingT $ initPool walletDb
accs <- runNoLoggingT $ getAccounts pool $ entityKey w
addrs <- concat <$> mapM (runNoLoggingT . getAddresses pool . entityKey) accs
2024-05-03 12:10:08 +00:00
intAddrs <-
2024-05-05 14:49:55 +00:00
concat <$> mapM (runNoLoggingT . getInternalAddresses pool . entityKey) accs
chainTip <- runNoLoggingT $ getMaxBlock pool
2024-04-24 12:42:35 +00:00
let lastBlock = zcashWalletLastSync $ entityVal w
2024-04-18 01:28:47 +00:00
let startBlock =
if lastBlock > 0
then lastBlock
else zcashWalletBirthdayHeight $ entityVal w
2024-05-05 14:49:55 +00:00
mapM_ (liftIO . findTransparentNotes pool startBlock) addrs
mapM_ (liftIO . findTransparentNotes pool startBlock) intAddrs
mapM_ (liftIO . findTransparentSpends pool . entityKey) accs
2024-04-08 20:51:14 +00:00
sapNotes <-
2024-05-03 12:10:08 +00:00
liftIO $
2024-04-08 20:51:14 +00:00
mapM
2024-04-24 12:42:35 +00:00
(findSaplingOutputs config startBlock (zcashWalletNetwork $ entityVal w))
2024-04-08 20:51:14 +00:00
accs
2024-04-18 01:28:47 +00:00
orchNotes <-
2024-05-03 12:10:08 +00:00
liftIO $
2024-04-18 01:28:47 +00:00
mapM
2024-04-24 12:42:35 +00:00
(findOrchardActions config startBlock (zcashWalletNetwork $ entityVal w))
2024-04-18 01:28:47 +00:00
accs
2024-05-05 14:49:55 +00:00
_ <- updateSaplingWitnesses pool
_ <- updateOrchardWitnesses pool
_ <- liftIO $ updateWalletSync pool chainTip (entityKey w)
mapM_ (runNoLoggingT . getWalletTransactions pool) addrs
2024-04-18 01:28:47 +00:00
testSync :: Config -> IO ()
testSync config = do
let dbPath = c_dbPath config
2024-04-24 12:42:35 +00:00
_ <- initDb dbPath
2024-05-05 14:49:55 +00:00
pool <- runNoLoggingT $ initPool dbPath
w <- getWallets pool TestNet
r <- mapM (syncWallet config) w
2024-05-03 12:10:08 +00:00
liftIO $ print r
2024-05-05 14:49:55 +00:00
{-let uaRead =-}
{-isValidUnifiedAddress-}
{-"utest1dl54utt6prjj5e0dnlknwumnxq9hycdjpkfr0sy6e6h522remqee8axe9zax0wsjrwpj76v555pdhvj9rnargpfyycs0vpkapq98xcdhem99gc4wchzn0ggepq3y6nz3a9sscwgqxgsh9vzhcad402y3x9szfregck5gslkya3c79d86xx0l33tpk8gnn7ew9vw37w43zh22u8dgdax"-}
{-case uaRead of-}
{-Nothing -> print "wrong address"-}
{-Just ua -> do-}
{-startTime <- getCurrentTime-}
{-print startTime-}
{-tx <--}
{-prepareTx-}
{-"zenith.db"-}
{-"127.0.0.1"-}
{-18232-}
{-TestNet-}
{-(toSqlKey 1)-}
{-2820897-}
{-0.04-}
{-ua-}
{-"sent with Zenith, test"-}
{-print tx-}
{-endTime <- getCurrentTime-}
{-print endTime-}
2024-05-03 12:10:08 +00:00
2024-05-05 14:49:55 +00:00
{-testSend :: IO ()-}
{-testSend = do-}
2024-04-24 12:42:35 +00:00
clearSync :: Config -> IO ()
clearSync config = do
let dbPath = c_dbPath config
2024-05-05 14:49:55 +00:00
pool <- runNoLoggingT $ initPool dbPath
2024-04-24 12:42:35 +00:00
_ <- initDb dbPath
2024-05-05 14:49:55 +00:00
_ <- clearWalletTransactions pool
w <- getWallets pool TestNet
liftIO $ mapM_ (updateWalletSync pool 0 . entityKey) w
w' <- liftIO $ getWallets pool TestNet
r <- mapM (syncWallet config) w'
2024-05-03 12:10:08 +00:00
liftIO $ print r