776 lines
26 KiB
Haskell
776 lines
26 KiB
Haskell
{-# LANGUAGE OverloadedStrings #-}
|
|
|
|
-- | Core wallet functionality for Zenith
|
|
module Zenith.Core where
|
|
|
|
import Control.Exception (throwIO, try)
|
|
import Control.Monad (forM, 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(..)
|
|
, 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)
|
|
|
|
-- * 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
|
|
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
|
|
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
|
|
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
|
|
(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
|
|
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 <- runNoLoggingT $ getMaxBlock pool
|
|
let lastBlock = zcashWalletLastSync $ entityVal w
|
|
let startBlock =
|
|
if lastBlock > 0
|
|
then lastBlock
|
|
else zcashWalletBirthdayHeight $ entityVal w
|
|
mapM_ (liftIO . findTransparentNotes pool startBlock) addrs
|
|
mapM_ (liftIO . findTransparentNotes pool startBlock) 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
|
|
|
|
testSync :: Config -> IO ()
|
|
testSync config = do
|
|
let dbPath = c_dbPath config
|
|
_ <- initDb dbPath
|
|
pool <- runNoLoggingT $ initPool dbPath
|
|
w <- getWallets pool TestNet
|
|
r <- mapM (syncWallet config) w
|
|
liftIO $ print r
|
|
{-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-}
|
|
|
|
{-testSend :: IO ()-}
|
|
{-testSend = do-}
|
|
clearSync :: Config -> IO ()
|
|
clearSync config = do
|
|
let dbPath = c_dbPath config
|
|
pool <- runNoLoggingT $ initPool dbPath
|
|
_ <- initDb dbPath
|
|
_ <- clearWalletTransactions pool
|
|
w <- getWallets pool TestNet
|
|
liftIO $ mapM_ (updateWalletSync pool 0 . entityKey) w
|
|
w' <- liftIO $ getWallets pool TestNet
|
|
r <- mapM (syncWallet config) w'
|
|
liftIO $ print r
|