Rene Vergara
0e14228a0e
Adds new `ZcashBlock` table to database to track block information and creates a relationship between `ZcashTransaction` records and the block they belong to. Database getters and setters are updated to use the block record for confirmations, height, time data.
1143 lines
40 KiB
Haskell
1143 lines
40 KiB
Haskell
{-# LANGUAGE OverloadedStrings #-}
|
|
|
|
-- | Core wallet functionality for Zenith
|
|
module Zenith.Core where
|
|
|
|
import Control.Exception (throwIO, try)
|
|
import Control.Monad (forM, unless, when)
|
|
import Control.Monad.IO.Class (liftIO)
|
|
import Control.Monad.Logger
|
|
( LoggingT
|
|
, MonadLoggerIO
|
|
, NoLoggingT
|
|
, logDebugN
|
|
, logErrorN
|
|
, logInfoN
|
|
, logWarnN
|
|
, runFileLoggingT
|
|
, runNoLoggingT
|
|
, runStdoutLoggingT
|
|
)
|
|
import Crypto.Secp256k1 (SecKey(..))
|
|
import Data.Aeson
|
|
import Data.Binary.Get hiding (getBytes)
|
|
import qualified Data.ByteString as BS
|
|
import qualified Data.ByteString.Lazy as LBS
|
|
import Data.Digest.Pure.MD5
|
|
import Data.HexString (HexString, hexString, toBytes, toText)
|
|
import Data.List
|
|
import Data.Maybe (fromJust)
|
|
import Data.Pool (Pool)
|
|
import qualified Data.Text as T
|
|
import qualified Data.Text.Encoding as E
|
|
import Data.Time
|
|
import qualified Database.Esqueleto.Experimental as ESQ
|
|
import Database.Persist
|
|
import Database.Persist.Sqlite
|
|
import GHC.Float.RealFracMethods (floorFloatInteger)
|
|
import Haskoin.Crypto.Keys (XPrvKey(..))
|
|
import Lens.Micro ((&), (.~), (^.), set)
|
|
import Network.HTTP.Client
|
|
import ZcashHaskell.Keys
|
|
import ZcashHaskell.Orchard
|
|
( decryptOrchardActionSK
|
|
, encodeUnifiedAddress
|
|
, genOrchardReceiver
|
|
, genOrchardSpendingKey
|
|
, getOrchardNotePosition
|
|
, getOrchardWitness
|
|
, isValidUnifiedAddress
|
|
, updateOrchardCommitmentTree
|
|
, updateOrchardWitness
|
|
)
|
|
import ZcashHaskell.Sapling
|
|
( decodeSaplingOutputEsk
|
|
, genSaplingInternalAddress
|
|
, genSaplingPaymentAddress
|
|
, genSaplingSpendingKey
|
|
, getSaplingNotePosition
|
|
, getSaplingWitness
|
|
, updateSaplingCommitmentTree
|
|
, updateSaplingWitness
|
|
)
|
|
import ZcashHaskell.Transparent
|
|
( genTransparentPrvKey
|
|
, genTransparentReceiver
|
|
, genTransparentSecretKey
|
|
)
|
|
import ZcashHaskell.Types
|
|
import ZcashHaskell.Utils
|
|
import Zenith.DB
|
|
import Zenith.Types
|
|
( Config(..)
|
|
, HexStringDB(..)
|
|
, OrchardSpendingKeyDB(..)
|
|
, PhraseDB(..)
|
|
, PrivacyPolicy(..)
|
|
, RseedDB(..)
|
|
, SaplingSpendingKeyDB(..)
|
|
, ScopeDB(..)
|
|
, TransparentSpendingKeyDB(..)
|
|
, UnifiedAddressDB(..)
|
|
, ZcashNetDB(..)
|
|
, ZebraTreeInfo(..)
|
|
)
|
|
|
|
-- * Zebra Node interaction
|
|
-- | Checks the status of the `zebrad` node
|
|
checkZebra ::
|
|
T.Text -- ^ Host where `zebrad` is available
|
|
-> Int -- ^ Port where `zebrad` is available
|
|
-> IO ZebraGetInfo
|
|
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 ::
|
|
T.Text -- ^ Host where `zebrad` is available
|
|
-> Int -- ^ Port where `zebrad` is available
|
|
-> IO ZebraGetBlockChainInfo
|
|
checkBlockChain nodeHost nodePort = do
|
|
r <- makeZebraCall nodeHost nodePort "getblockchaininfo" []
|
|
case r of
|
|
Left e -> throwIO $ userError e
|
|
Right bci -> return bci
|
|
|
|
-- | 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
|
|
createOrchardSpendingKey :: ZcashWallet -> Int -> IO OrchardSpendingKey
|
|
createOrchardSpendingKey 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 = genOrchardSpendingKey s' coinType i
|
|
case r of
|
|
Nothing -> throwIO $ userError "Unable to generate Orchard spending key"
|
|
Just sk -> return sk
|
|
|
|
-- | 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
|
|
sapSk <- createSaplingSpendingKey (entityVal zw) i
|
|
tSk <- createTransparentSpendingKey (entityVal zw) i
|
|
return $
|
|
ZcashAccount
|
|
i
|
|
(entityKey zw)
|
|
n
|
|
(OrchardSpendingKeyDB orSk)
|
|
(SaplingSpendingKeyDB sapSk)
|
|
(TransparentSpendingKeyDB tSk)
|
|
|
|
-- * Addresses
|
|
-- | Create an external unified address for the given account and index
|
|
createWalletAddress ::
|
|
T.Text -- ^ The address nickname
|
|
-> Int -- ^ The address' index
|
|
-> ZcashNet -- ^ The network for this address
|
|
-> Scope -- ^ External or Internal
|
|
-> Entity ZcashAccount -- ^ The Zcash account that the address will be attached to
|
|
-> IO WalletAddress
|
|
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
|
|
return $
|
|
WalletAddress
|
|
i
|
|
(entityKey za)
|
|
n
|
|
(UnifiedAddressDB $
|
|
encodeUnifiedAddress $ UnifiedAddress zNet oRec sRec (Just tRec))
|
|
(ScopeDB scope)
|
|
|
|
-- | Create an external unified address for the given account and index with custom receivers
|
|
createCustomWalletAddress ::
|
|
T.Text -- ^ The address nickname
|
|
-> Int -- ^ The address' index
|
|
-> ZcashNet -- ^ The network for this address
|
|
-> Scope -- ^ External or Internal
|
|
-> Entity ZcashAccount -- ^ The Zcash account that the address will be attached to
|
|
-> Bool -- ^ Exclude Sapling
|
|
-> Bool -- ^ Exclude Transparent
|
|
-> IO WalletAddress
|
|
createCustomWalletAddress n i zNet scope za exSap exTr = do
|
|
let oRec =
|
|
genOrchardReceiver i scope $
|
|
getOrchSK $ zcashAccountOrchSpendKey $ entityVal za
|
|
let sRec =
|
|
if exSap
|
|
then Nothing
|
|
else case scope of
|
|
External ->
|
|
genSaplingPaymentAddress i $
|
|
getSapSK $ zcashAccountSapSpendKey $ entityVal za
|
|
Internal ->
|
|
genSaplingInternalAddress $
|
|
getSapSK $ zcashAccountSapSpendKey $ entityVal za
|
|
tRec <-
|
|
if exTr
|
|
then return Nothing
|
|
else Just <$>
|
|
genTransparentReceiver
|
|
i
|
|
scope
|
|
(getTranSK $ zcashAccountTPrivateKey $ entityVal za)
|
|
return $
|
|
WalletAddress
|
|
i
|
|
(entityKey za)
|
|
n
|
|
(UnifiedAddressDB $
|
|
encodeUnifiedAddress $ UnifiedAddress zNet oRec sRec tRec)
|
|
(ScopeDB scope)
|
|
|
|
-- * Wallet
|
|
-- | Find the Sapling notes that match the given spending key
|
|
findSaplingOutputs ::
|
|
Config -- ^ the configuration parameters
|
|
-> Int -- ^ the starting block
|
|
-> ZcashNetDB -- ^ The network
|
|
-> Entity ZcashAccount -- ^ The account to use
|
|
-> IO ()
|
|
findSaplingOutputs config b znet za = do
|
|
let dbPath = c_dbPath config
|
|
let zebraHost = c_zebraHost config
|
|
let zebraPort = c_zebraPort config
|
|
let zn = getNet znet
|
|
pool <- runNoLoggingT $ initPool dbPath
|
|
tList <- getShieldedOutputs pool b znet
|
|
trees <- getCommitmentTrees zebraHost zebraPort (b - 1)
|
|
let sT = SaplingCommitmentTree $ ztiSapling trees
|
|
decryptNotes sT zn pool tList
|
|
sapNotes <- getWalletSapNotes pool (entityKey za)
|
|
findSapSpends pool (entityKey za) sapNotes
|
|
where
|
|
sk :: SaplingSpendingKeyDB
|
|
sk = zcashAccountSapSpendKey $ entityVal za
|
|
decryptNotes ::
|
|
SaplingCommitmentTree
|
|
-> ZcashNet
|
|
-> ConnectionPool
|
|
-> [(Entity ZcashTransaction, Entity ShieldOutput)]
|
|
-> IO ()
|
|
decryptNotes _ _ _ [] = return ()
|
|
decryptNotes st n pool ((zt, o):txs) = do
|
|
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
|
|
decryptNotes uT n pool txs
|
|
Just dn1 -> do
|
|
wId <- saveWalletTransaction pool (entityKey za) zt
|
|
saveWalletSapNote
|
|
pool
|
|
wId
|
|
nP
|
|
(fromJust noteWitness)
|
|
True
|
|
(entityKey za)
|
|
(entityKey o)
|
|
dn1
|
|
decryptNotes uT n pool txs
|
|
Just dn0 -> do
|
|
wId <- saveWalletTransaction pool (entityKey za) zt
|
|
saveWalletSapNote
|
|
pool
|
|
wId
|
|
nP
|
|
(fromJust noteWitness)
|
|
False
|
|
(entityKey za)
|
|
(entityKey o)
|
|
dn0
|
|
decryptNotes uT n pool txs
|
|
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
|
|
-> Entity ZcashAccount -- ^ The account to use
|
|
-> IO ()
|
|
findOrchardActions config b znet za = do
|
|
let dbPath = c_dbPath config
|
|
let zebraHost = c_zebraHost config
|
|
let zebraPort = c_zebraPort config
|
|
let zn = getNet znet
|
|
pool <- runNoLoggingT $ initPool dbPath
|
|
tList <- getOrchardActions pool b znet
|
|
trees <- getCommitmentTrees zebraHost zebraPort (b - 1)
|
|
let sT = OrchardCommitmentTree $ ztiOrchard trees
|
|
decryptNotes sT zn pool tList
|
|
orchNotes <- getWalletOrchNotes pool (entityKey za)
|
|
findOrchSpends pool (entityKey za) orchNotes
|
|
where
|
|
decryptNotes ::
|
|
OrchardCommitmentTree
|
|
-> ZcashNet
|
|
-> ConnectionPool
|
|
-> [(Entity ZcashTransaction, Entity OrchAction)]
|
|
-> IO ()
|
|
decryptNotes _ _ _ [] = return ()
|
|
decryptNotes ot n pool ((zt, o):txs) = do
|
|
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
|
|
Nothing -> decryptNotes uT n pool txs
|
|
Just dn1 -> do
|
|
wId <- saveWalletTransaction pool (entityKey za) zt
|
|
saveWalletOrchNote
|
|
pool
|
|
wId
|
|
nP
|
|
(fromJust noteWitness)
|
|
True
|
|
(entityKey za)
|
|
(entityKey o)
|
|
dn1
|
|
decryptNotes uT n pool txs
|
|
Just dn -> do
|
|
wId <- saveWalletTransaction pool (entityKey za) zt
|
|
saveWalletOrchNote
|
|
pool
|
|
wId
|
|
nP
|
|
(fromJust noteWitness)
|
|
False
|
|
(entityKey za)
|
|
(entityKey o)
|
|
dn
|
|
decryptNotes uT n pool txs
|
|
sk :: OrchardSpendingKeyDB
|
|
sk = zcashAccountOrchSpendKey $ entityVal za
|
|
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)
|
|
|
|
updateSaplingWitnesses :: ConnectionPool -> IO ()
|
|
updateSaplingWitnesses pool = do
|
|
sapNotes <- getUnspentSapNotes pool
|
|
maxId <- liftIO $ getMaxSaplingNote pool
|
|
mapM_ (updateOneNote maxId) sapNotes
|
|
where
|
|
updateOneNote :: ShieldOutputId -> Entity WalletSapNote -> IO ()
|
|
updateOneNote maxId n = do
|
|
let noteSync = walletSapNoteWitPos $ entityVal n
|
|
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
|
|
|
|
updateOrchardWitnesses :: ConnectionPool -> IO ()
|
|
updateOrchardWitnesses pool = do
|
|
orchNotes <- getUnspentOrchNotes pool
|
|
maxId <- getMaxOrchardNote pool
|
|
mapM_ (updateOneNote maxId) orchNotes
|
|
where
|
|
updateOneNote :: OrchActionId -> Entity WalletOrchNote -> IO ()
|
|
updateOneNote maxId n = do
|
|
let noteSync = walletOrchNoteWitPos $ entityVal n
|
|
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
|
|
|
|
-- | 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 =
|
|
if i == 1 || i == 2
|
|
then 1
|
|
else 0
|
|
sout =
|
|
if i == 3
|
|
then 1
|
|
else 0
|
|
oout =
|
|
if i == 4
|
|
then 1
|
|
else 0
|
|
|
|
-- | Prepare a transaction for sending
|
|
prepareTx ::
|
|
ConnectionPool
|
|
-> T.Text
|
|
-> Int
|
|
-> ZcashNet
|
|
-> ZcashAccountId
|
|
-> Int
|
|
-> Float
|
|
-> UnifiedAddress
|
|
-> T.Text
|
|
-> LoggingT IO (Either TxError HexString)
|
|
prepareTx pool zebraHost zebraPort zn za bh amt ua memo = do
|
|
accRead <- liftIO $ getAccountById pool za
|
|
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)
|
|
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
|
|
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
|
|
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
|
|
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
|
|
|
|
-- | 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
|
|
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
|
|
notePlan <-
|
|
liftIO $
|
|
selectUnspentNotesV2 pool za (zats + 10000) (fst recipient) policy
|
|
case notePlan of
|
|
Right (tList, sList, oList) -> do
|
|
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) policy
|
|
case dummy' of
|
|
Left e -> return $ Left e
|
|
Right dummy -> do
|
|
logDebugN "Calculating fee"
|
|
let feeResponse =
|
|
createTransaction
|
|
(Just sT)
|
|
(Just oT)
|
|
tSpends
|
|
sSpends
|
|
oSpends
|
|
dummy
|
|
zn
|
|
(bh + 3)
|
|
False
|
|
case feeResponse of
|
|
Left e1 -> return $ Left Fee
|
|
Right fee -> do
|
|
let feeAmt =
|
|
fromIntegral
|
|
(runGet getInt64le $ LBS.fromStrict $ toBytes fee)
|
|
finalNotePlan <-
|
|
liftIO $
|
|
selectUnspentNotesV2
|
|
pool
|
|
za
|
|
(zats + feeAmt)
|
|
(fst recipient)
|
|
policy
|
|
case finalNotePlan of
|
|
Right (tList1, sList1, oList1) -> do
|
|
logDebugN $
|
|
T.pack $ "selected notes with fee" ++ show feeAmt
|
|
logDebugN $ T.pack $ show tList1
|
|
logDebugN $ T.pack $ show sList1
|
|
logDebugN $ T.pack $ show oList1
|
|
tSpends1 <-
|
|
liftIO $
|
|
prepTSpends
|
|
(getTranSK $ zcashAccountTPrivateKey $ entityVal acc)
|
|
tList1
|
|
sSpends1 <-
|
|
liftIO $
|
|
prepSSpends
|
|
(getSapSK $ zcashAccountSapSpendKey $ entityVal acc)
|
|
sList1
|
|
oSpends1 <-
|
|
liftIO $
|
|
prepOSpends
|
|
(getOrchSK $ zcashAccountOrchSpendKey $ entityVal acc)
|
|
oList1
|
|
let noteTotal1 = getTotalAmount (tList1, sList1, oList1)
|
|
outgoing' <-
|
|
liftIO $
|
|
makeOutgoing
|
|
acc
|
|
recipient
|
|
zats
|
|
(noteTotal1 - feeAmt - zats)
|
|
policy
|
|
logDebugN $ T.pack $ show outgoing'
|
|
case outgoing' of
|
|
Left e -> return $ Left e
|
|
Right outgoing -> do
|
|
let tx =
|
|
createTransaction
|
|
(Just sT)
|
|
(Just oT)
|
|
tSpends1
|
|
sSpends1
|
|
oSpends1
|
|
outgoing
|
|
zn
|
|
(bh + 3)
|
|
True
|
|
logDebugN $ T.pack $ show tx
|
|
return tx
|
|
Left e -> return $ Left e
|
|
Left e -> do
|
|
logErrorN $ T.pack $ show e
|
|
return $ Left e
|
|
where
|
|
makeOutgoing ::
|
|
Entity ZcashAccount
|
|
-> (Int, BS.ByteString)
|
|
-> Integer
|
|
-> Integer
|
|
-> PrivacyPolicy
|
|
-> IO (Either TxError [OutgoingNote])
|
|
makeOutgoing acc (k, recvr) zats chg policy = do
|
|
chgAddr <- runNoLoggingT $ getInternalAddresses pool $ entityKey acc
|
|
let internalUA = getUA $ walletAddressUAddress $ entityVal $ head chgAddr
|
|
case k of
|
|
4 ->
|
|
case policy of
|
|
None ->
|
|
return $
|
|
Left $
|
|
PrivacyPolicyError "Recipient not allowed by privacy policy"
|
|
_anyOther -> do
|
|
let chgRcvr =
|
|
fromJust $
|
|
o_rec =<< isValidUnifiedAddress (E.encodeUtf8 internalUA)
|
|
return $
|
|
Right
|
|
[ OutgoingNote
|
|
4
|
|
(getBytes $
|
|
getOrchSK $ zcashAccountOrchSpendKey $ entityVal acc)
|
|
(getBytes chgRcvr)
|
|
(fromIntegral chg)
|
|
""
|
|
True
|
|
, OutgoingNote
|
|
4
|
|
(getBytes $
|
|
getOrchSK $ zcashAccountOrchSpendKey $ entityVal acc)
|
|
recvr
|
|
(fromIntegral zats)
|
|
(E.encodeUtf8 memo)
|
|
False
|
|
]
|
|
3 ->
|
|
case policy of
|
|
None ->
|
|
return $
|
|
Left $
|
|
PrivacyPolicyError "Receiver not compatible with privacy policy"
|
|
Full -> do
|
|
let chgRcvr =
|
|
fromJust $
|
|
s_rec =<< isValidUnifiedAddress (E.encodeUtf8 internalUA)
|
|
return $
|
|
Right
|
|
[ OutgoingNote
|
|
3
|
|
(getBytes $
|
|
getSapSK $ zcashAccountSapSpendKey $ entityVal acc)
|
|
(getBytes chgRcvr)
|
|
(fromIntegral chg)
|
|
""
|
|
True
|
|
, OutgoingNote
|
|
3
|
|
(getBytes $
|
|
getSapSK $ zcashAccountSapSpendKey $ entityVal acc)
|
|
recvr
|
|
(fromIntegral zats)
|
|
(E.encodeUtf8 memo)
|
|
False
|
|
]
|
|
_anyOther -> do
|
|
let chgRcvr =
|
|
fromJust $
|
|
o_rec =<< isValidUnifiedAddress (E.encodeUtf8 internalUA)
|
|
return $
|
|
Right
|
|
[ OutgoingNote
|
|
4
|
|
(getBytes $
|
|
getOrchSK $ zcashAccountOrchSpendKey $ entityVal acc)
|
|
(getBytes chgRcvr)
|
|
(fromIntegral chg)
|
|
""
|
|
True
|
|
, OutgoingNote
|
|
3
|
|
(getBytes $
|
|
getSapSK $ zcashAccountSapSpendKey $ entityVal acc)
|
|
recvr
|
|
(fromIntegral zats)
|
|
(E.encodeUtf8 memo)
|
|
False
|
|
]
|
|
2 ->
|
|
if policy <= Low
|
|
then do
|
|
let chgRcvr =
|
|
fromJust $
|
|
t_rec =<< isValidUnifiedAddress (E.encodeUtf8 internalUA)
|
|
return $
|
|
Right
|
|
[ OutgoingNote
|
|
1
|
|
BS.empty
|
|
(toBytes $ tr_bytes chgRcvr)
|
|
(fromIntegral chg)
|
|
""
|
|
True
|
|
, OutgoingNote 2 BS.empty recvr (fromIntegral zats) "" False
|
|
]
|
|
else return $
|
|
Left $
|
|
PrivacyPolicyError
|
|
"Receiver not compatible with privacy policy"
|
|
1 ->
|
|
if policy <= Low
|
|
then do
|
|
let chgRcvr =
|
|
fromJust $
|
|
t_rec =<< isValidUnifiedAddress (E.encodeUtf8 internalUA)
|
|
return $
|
|
Right
|
|
[ OutgoingNote
|
|
1
|
|
BS.empty
|
|
(toBytes $ tr_bytes chgRcvr)
|
|
(fromIntegral chg)
|
|
""
|
|
True
|
|
, OutgoingNote 1 BS.empty recvr (fromIntegral zats) "" False
|
|
]
|
|
else return $
|
|
Left $
|
|
PrivacyPolicyError
|
|
"Receiver not compatible with privacy policy"
|
|
_anyOther -> return $ Left ZHError
|
|
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
|
|
-> Entity ZcashWallet
|
|
-> IO ()
|
|
syncWallet config w = do
|
|
startTime <- liftIO getCurrentTime
|
|
let walletDb = c_dbPath config
|
|
let znet = zcashWalletNetwork $ entityVal w
|
|
pool <- runNoLoggingT $ initPool walletDb
|
|
accs <- runNoLoggingT $ getAccounts pool $ entityKey w
|
|
addrs <- concat <$> mapM (runNoLoggingT . getAddresses pool . entityKey) accs
|
|
intAddrs <-
|
|
concat <$> mapM (runNoLoggingT . getInternalAddresses pool . entityKey) accs
|
|
chainTip <- getMaxBlock pool znet
|
|
let lastBlock = zcashWalletLastSync $ entityVal w
|
|
let startBlock =
|
|
if lastBlock > 0
|
|
then lastBlock
|
|
else zcashWalletBirthdayHeight $ entityVal w
|
|
mapM_ (liftIO . findTransparentNotes pool startBlock znet) addrs
|
|
mapM_ (liftIO . findTransparentNotes pool startBlock znet) intAddrs
|
|
mapM_ (liftIO . findTransparentSpends pool . entityKey) accs
|
|
sapNotes <-
|
|
liftIO $
|
|
mapM
|
|
(findSaplingOutputs config startBlock (zcashWalletNetwork $ entityVal w))
|
|
accs
|
|
orchNotes <-
|
|
liftIO $
|
|
mapM
|
|
(findOrchardActions config startBlock (zcashWalletNetwork $ entityVal w))
|
|
accs
|
|
_ <- updateSaplingWitnesses pool
|
|
_ <- updateOrchardWitnesses pool
|
|
_ <- liftIO $ updateWalletSync pool chainTip (entityKey w)
|
|
mapM_ (runNoLoggingT . getWalletTransactions pool) addrs
|