Merge pull request 'Implement transaction creation' (#77) from rav001 into dev041

Reviewed-on: #77
This commit is contained in:
pitmutt 2024-05-03 12:15:11 +00:00 committed by Vergara Technologies LLC
commit 1ba188ec24
Signed by: Vergara Technologies LLC
GPG key ID: 99DB473BB4715618
11 changed files with 803 additions and 61 deletions

View file

@ -5,6 +5,12 @@ All notable changes to this project will be documented in this file.
The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.0.0/),
and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0.html).
## [0.5.0.0]
### Added
- Core functions for sending transactions
## [0.4.6.0]
### Added

View file

@ -18,7 +18,7 @@ import System.IO
import Text.Read (readMaybe)
import ZcashHaskell.Types
import Zenith.CLI
import Zenith.Core (clearSync, testSync)
import Zenith.Core (clearSync, testSend, testSync)
import Zenith.Types (Config(..), ZcashAddress(..), ZcashPool(..), ZcashTx(..))
import Zenith.Utils
import Zenith.Zcashd
@ -223,6 +223,7 @@ main = do
"cli" -> runZenithCLI myConfig
"sync" -> testSync myConfig
"rescan" -> clearSync myConfig
"testsend" -> testSend
_ -> printUsage
else printUsage

BIN
sapling-output.params Normal file

Binary file not shown.

BIN
sapling-spend.params Normal file

Binary file not shown.

View file

@ -6,6 +6,7 @@
module Zenith.CLI where
import qualified Brick.AttrMap as A
import qualified Brick.BChan as BC
import qualified Brick.Focus as F
import Brick.Forms
( Form(..)
@ -20,7 +21,7 @@ import Brick.Forms
import qualified Brick.Main as M
import qualified Brick.Types as BT
import Brick.Types (Widget)
import Brick.Util (fg, on, style)
import Brick.Util (bg, clamp, fg, on, style)
import qualified Brick.Widgets.Border as B
import Brick.Widgets.Border.Style (unicode, unicodeBold)
import qualified Brick.Widgets.Center as C
@ -41,6 +42,7 @@ import Brick.Widgets.Core
, txt
, txtWrap
, txtWrapWith
, updateAttrMap
, vBox
, vLimit
, withAttr
@ -48,9 +50,13 @@ import Brick.Widgets.Core
)
import qualified Brick.Widgets.Dialog as D
import qualified Brick.Widgets.List as L
import qualified Brick.Widgets.ProgressBar as P
import Control.Concurrent (forkIO, threadDelay)
import Control.Exception (catch, throw, throwIO, try)
import Control.Monad (void)
import Control.Monad (forever, void)
import Control.Monad.IO.Class (liftIO)
import Control.Monad.Logger (runFileLoggingT)
import Data.Aeson
import Data.Maybe
import qualified Data.Text as T
import qualified Data.Text.Encoding as E
@ -58,6 +64,7 @@ import Data.Time.Clock.POSIX (posixSecondsToUTCTime)
import qualified Data.Vector as Vec
import Database.Persist
import qualified Graphics.Vty as V
import qualified Graphics.Vty.CrossPlatform as VC
import Lens.Micro ((&), (.~), (^.), set)
import Lens.Micro.Mtl
import Lens.Micro.TH
@ -66,15 +73,17 @@ import ZcashHaskell.Keys (generateWalletSeedPhrase, getWalletSeed)
import ZcashHaskell.Orchard (getSaplingFromUA, isValidUnifiedAddress)
import ZcashHaskell.Transparent (encodeTransparentReceiver)
import ZcashHaskell.Types
import ZcashHaskell.Utils (getBlockTime, makeZebraCall)
import Zenith.Core
import Zenith.DB
import Zenith.Scanner (processTx)
import Zenith.Types
( Config(..)
, PhraseDB(..)
, UnifiedAddressDB(..)
, ZcashNetDB(..)
)
import Zenith.Utils (displayTaz, displayZec, showAddress)
import Zenith.Utils (displayTaz, displayZec, jsonNumber, showAddress)
data Name
= WList
@ -104,8 +113,12 @@ data DisplayType
| MsgDisplay
| PhraseDisplay
| TxDisplay
| SyncDisplay
| BlankDisplay
data Tick =
Tick
data State = State
{ _network :: !ZcashNet
, _wallets :: !(L.List Name (Entity ZcashWallet))
@ -120,9 +133,13 @@ data State = State
, _focusRing :: !(F.FocusRing Name)
, _startBlock :: !Int
, _dbPath :: !T.Text
, _zebraHost :: !T.Text
, _zebraPort :: !Int
, _displayBox :: !DisplayType
, _syncBlock :: !Int
, _balance :: !Integer
, _barValue :: !Float
, _eventDispatch :: !(BC.BChan Tick)
}
makeLenses ''State
@ -282,7 +299,7 @@ drawUI s = [splashDialog s, helpDialog s, displayDialog s, inputDialog s, ui s]
titleAttr
(str
" _____ _ _ _ \n|__ /___ _ __ (_) |_| |__\n / // _ \\ '_ \\| | __| '_ \\\n / /| __/ | | | | |_| | | |\n/____\\___|_| |_|_|\\__|_| |_|") <=>
C.hCenter (withAttr titleAttr (str "Zcash Wallet v0.4.6.0")) <=>
C.hCenter (withAttr titleAttr (str "Zcash Wallet v0.5.0.0")) <=>
C.hCenter (withAttr blinkAttr $ str "Press any key..."))
else emptyWidget
capCommand :: String -> String -> Widget Name
@ -367,6 +384,20 @@ drawUI s = [splashDialog s, helpDialog s, displayDialog s, inputDialog s, ui s]
txtWrapWith
(WrapSettings False True NoFill FillAfterFirst)
(userTxMemo (entityVal tx)))))
SyncDisplay ->
withBorderStyle unicodeBold $
D.renderDialog
(D.dialog (Just $ txt "Sync") Nothing 50)
(padAll
1
(updateAttrMap
(A.mapAttrNames
[ (barDoneAttr, P.progressCompleteAttr)
, (barToDoAttr, P.progressIncompleteAttr)
])
(P.progressBar
(Just $ show (st ^. barValue * 100))
(_barValue st))))
BlankDisplay -> emptyWidget
mkInputForm :: DialogInput -> Form DialogInput e Name
@ -438,7 +469,89 @@ titleAttr = A.attrName "title"
blinkAttr :: A.AttrName
blinkAttr = A.attrName "blink"
appEvent :: BT.BrickEvent Name e -> BT.EventM Name State ()
baseAttr :: A.AttrName
baseAttr = A.attrName "base"
barDoneAttr :: A.AttrName
barDoneAttr = A.attrName "done"
barToDoAttr :: A.AttrName
barToDoAttr = A.attrName "remaining"
validBarValue :: Float -> Float
validBarValue = clamp 0 1
scanZebra :: Int -> BT.EventM Name State ()
scanZebra b = do
s <- BT.get
_ <- liftIO $ initDb $ s ^. dbPath
bStatus <- liftIO $ checkBlockChain (s ^. zebraHost) (s ^. zebraPort)
dbBlock <- liftIO $ getMaxBlock $ s ^. dbPath
let sb = max dbBlock b
if sb > zgb_blocks bStatus || sb < 1
then do
BT.modify $ set msg "Invalid starting block for scan"
BT.modify $ set displayBox MsgDisplay
else do
let bList = [(sb + 1) .. (zgb_blocks bStatus)]
let step = (1.0 :: Float) / fromIntegral (zgb_blocks bStatus - (sb + 1))
mapM_ (processBlock step) bList
where
processBlock :: Float -> Int -> BT.EventM Name State ()
processBlock step bl = do
s <- BT.get
r <-
liftIO $
makeZebraCall
(s ^. zebraHost)
(s ^. zebraPort)
"getblock"
[Data.Aeson.String $ T.pack $ show bl, jsonNumber 1]
case r of
Left e1 -> do
BT.modify $ set msg e1
BT.modify $ set displayBox MsgDisplay
Right blk -> do
r2 <-
liftIO $
makeZebraCall
(s ^. zebraHost)
(s ^. zebraPort)
"getblock"
[Data.Aeson.String $ T.pack $ show bl, jsonNumber 0]
case r2 of
Left e2 -> do
BT.modify $ set msg e2
BT.modify $ set displayBox MsgDisplay
Right hb -> do
let blockTime = getBlockTime hb
liftIO $
mapM_
(processTx
(s ^. zebraHost)
(s ^. zebraPort)
blockTime
(s ^. dbPath)) $
bl_txs $ addTime blk blockTime
BT.modify $ set barValue $ validBarValue (s ^. barValue + step)
BT.modify $ set displayBox SyncDisplay
addTime :: BlockResponse -> Int -> BlockResponse
addTime bl t =
BlockResponse
(bl_confirmations bl)
(bl_height bl)
(fromIntegral t)
(bl_txs bl)
appEvent :: BT.BrickEvent Name Tick -> BT.EventM Name State ()
appEvent (BT.AppEvent Tick) = do
s <- BT.get
case s ^. displayBox of
SyncDisplay -> do
if s ^. barValue == 1.0
then BT.modify $ set displayBox BlankDisplay
else BT.modify $ set displayBox SyncDisplay
_ -> return ()
appEvent (BT.VtyEvent e) = do
r <- F.focusGetCurrent <$> use focusRing
s <- BT.get
@ -456,6 +569,29 @@ appEvent (BT.VtyEvent e) = do
MsgDisplay -> BT.modify $ set displayBox BlankDisplay
PhraseDisplay -> BT.modify $ set displayBox BlankDisplay
TxDisplay -> BT.modify $ set displayBox BlankDisplay
SyncDisplay -> do
if s ^. barValue == 1.0
then BT.modify $ set displayBox BlankDisplay
else do
sBlock <- liftIO $ getMinBirthdayHeight $ s ^. dbPath
selWallet <-
do case L.listSelectedElement $ s ^. wallets of
Nothing -> do
let fWall =
L.listSelectedElement $
L.listMoveToBeginning $ s ^. wallets
case fWall of
Nothing ->
throw $ userError "Failed to select wallet"
Just (_j, w1) -> return w1
Just (_k, w) -> return w
scanZebra sBlock
liftIO $
runFileLoggingT "zenith.log" $
syncWallet
(Config (s ^. dbPath) (s ^. zebraHost) (s ^. zebraPort))
selWallet
BT.modify $ set displayBox SyncDisplay
BlankDisplay -> do
case s ^. dialogBox of
WName -> do
@ -557,6 +693,9 @@ appEvent (BT.VtyEvent e) = do
BT.modify $ set displayBox TxDisplay
V.EvKey (V.KChar 'a') [] ->
BT.modify $ set dialogBox ASelect
V.EvKey (V.KChar 's') [] -> do
BT.modify $ set barValue 0.0
BT.modify $ set displayBox SyncDisplay
ev ->
case r of
Just AList ->
@ -581,9 +720,12 @@ theMap =
, (titleAttr, V.withStyle (fg V.brightGreen) V.bold)
, (blinkAttr, style V.blink)
, (focusedFormInputAttr, V.white `on` V.blue)
, (baseAttr, bg V.brightBlack)
, (barDoneAttr, V.white `on` V.blue)
, (barToDoAttr, V.white `on` V.black)
]
theApp :: M.App State e Name
theApp :: M.App State Tick Name
theApp =
M.App
{ M.appDraw = drawUI
@ -629,8 +771,11 @@ runZenithCLI config = do
if not (null accList)
then getBalance dbFilePath $ entityKey $ head accList
else return 0
eventChan <- BC.newBChan 10
let buildVty = VC.mkVty V.defaultConfig
initialVty <- buildVty
void $
M.defaultMain theApp $
M.customMain initialVty buildVty (Just eventChan) theApp $
State
(zgb_net chainInfo)
(L.list WList (Vec.fromList walList) 1)
@ -648,9 +793,13 @@ runZenithCLI config = do
(F.focusRing [AList, TList])
(zgb_blocks chainInfo)
dbFilePath
host
port
MsgDisplay
block
bal
1.0
eventChan
Left e -> do
print $
"No Zebra node available on port " <>

View file

@ -4,13 +4,33 @@
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
, logInfoN
, logWarnN
, runFileLoggingT
, runStdoutLoggingT
)
import Crypto.Secp256k1 (SecKey(..))
import Data.Aeson
import Data.HexString (hexString)
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
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 Network.HTTP.Client
import ZcashHaskell.Keys
import ZcashHaskell.Orchard
@ -20,7 +40,9 @@ import ZcashHaskell.Orchard
, genOrchardSpendingKey
, getOrchardNotePosition
, getOrchardWitness
, isValidUnifiedAddress
, updateOrchardCommitmentTree
, updateOrchardWitness
)
import ZcashHaskell.Sapling
( decodeSaplingOutputEsk
@ -30,8 +52,13 @@ import ZcashHaskell.Sapling
, getSaplingNotePosition
, getSaplingWitness
, updateSaplingCommitmentTree
, updateSaplingWitness
)
import ZcashHaskell.Transparent
( genTransparentPrvKey
, genTransparentReceiver
, genTransparentSecretKey
)
import ZcashHaskell.Transparent (genTransparentPrvKey, genTransparentReceiver)
import ZcashHaskell.Types
import ZcashHaskell.Utils
import Zenith.DB
@ -40,6 +67,7 @@ import Zenith.Types
, HexStringDB(..)
, OrchardSpendingKeyDB(..)
, PhraseDB(..)
, RseedDB(..)
, SaplingSpendingKeyDB(..)
, ScopeDB(..)
, TransparentSpendingKeyDB(..)
@ -236,7 +264,6 @@ findSaplingOutputs config b znet za = do
Nothing -> do
decryptNotes uT n txs
Just dn1 -> do
print dn1
wId <-
saveWalletTransaction
(c_dbPath config)
@ -249,10 +276,10 @@ findSaplingOutputs config b znet za = do
(fromJust noteWitness)
True
(entityKey za)
(entityKey o)
dn1
decryptNotes uT n txs
Just dn0 -> do
print dn0
wId <-
saveWalletTransaction (c_dbPath config) (entityKey za) zt
saveWalletSapNote
@ -262,6 +289,7 @@ findSaplingOutputs config b znet za = do
(fromJust noteWitness)
False
(entityKey za)
(entityKey o)
dn0
decryptNotes uT n txs
decodeShOut ::
@ -327,7 +355,6 @@ findOrchardActions config b znet za = do
case decodeOrchAction Internal nP o of
Nothing -> decryptNotes uT n txs
Just dn1 -> do
print dn1
wId <-
saveWalletTransaction
(c_dbPath config)
@ -340,10 +367,10 @@ findOrchardActions config b znet za = do
(fromJust noteWitness)
True
(entityKey za)
(entityKey o)
dn1
decryptNotes uT n txs
Just dn -> do
print dn
wId <-
saveWalletTransaction (c_dbPath config) (entityKey za) zt
saveWalletOrchNote
@ -353,6 +380,7 @@ findOrchardActions config b znet za = do
(fromJust noteWitness)
False
(entityKey za)
(entityKey o)
dn
decryptNotes uT n txs
sk :: OrchardSpendingKeyDB
@ -371,44 +399,350 @@ findOrchardActions config b znet za = do
(getHex $ orchActionCv $ entityVal o)
(getHex $ orchActionAuth $ entityVal o)
updateSaplingWitnesses :: T.Text -> LoggingT IO ()
updateSaplingWitnesses dbPath = do
sapNotes <- liftIO $ getUnspentSapNotes dbPath
pool <- createSqlitePool dbPath 5
maxId <- liftIO $ getMaxSaplingNote pool
mapM_ (updateOneNote pool maxId) sapNotes
where
updateOneNote ::
Pool SqlBackend
-> ShieldOutputId
-> Entity WalletSapNote
-> LoggingT IO ()
updateOneNote pool maxId n = do
let noteSync = walletSapNoteWitPos $ entityVal n
if noteSync < maxId
then 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
else logInfoN "Witness up to date"
updateOrchardWitnesses :: T.Text -> LoggingT IO ()
updateOrchardWitnesses dbPath = do
orchNotes <- liftIO $ getUnspentOrchNotes dbPath
pool <- createSqlitePool dbPath 5
maxId <- liftIO $ getMaxOrchardNote pool
mapM_ (updateOneNote pool maxId) orchNotes
where
updateOneNote ::
Pool SqlBackend
-> OrchActionId
-> Entity WalletOrchNote
-> LoggingT IO ()
updateOneNote pool maxId n = do
let noteSync = walletOrchNoteWitPos $ entityVal n
if noteSync < maxId
then 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
else logInfoN "Witness up to date"
-- | 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
then 1
else 0
sout =
if i == 2
then 1
else 0
oout =
if i == 3
then 2
else 1
-- | Prepare a transaction for sending
prepareTx ::
T.Text
-> T.Text
-> Int
-> ZcashNet
-> ZcashAccountId
-> Int
-> Float
-> UnifiedAddress
-> T.Text
-> IO (Either TxError HexString)
prepareTx dbPath zebraHost zebraPort zn za bh amt ua memo = do
accRead <- getAccountById dbPath 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)
print recipient
trees <- getCommitmentTrees zebraHost zebraPort bh
let sT = SaplingCommitmentTree $ ztiSapling trees
let oT = OrchardCommitmentTree $ ztiOrchard trees
case accRead of
Nothing -> throwIO $ userError "Can't find Account"
Just acc -> do
print acc
spParams <- BS.readFile "sapling-spend.params"
outParams <- BS.readFile "sapling-output.params"
if show (md5 $ LBS.fromStrict spParams) /=
"0f44c12ef115ae019decf18ade583b20"
then throwIO $ userError "Can't validate sapling parameters"
else print "Valid Sapling spend params"
if show (md5 $ LBS.fromStrict outParams) /=
"924daf81b87a81bbbb9c7d18562046c8"
then throwIO $ userError "Can't validate sapling parameters"
else print "Valid Sapling output params"
print $ BS.length spParams
print $ BS.length outParams
print "Read Sapling params"
let zats = fromIntegral $ floorFloatInteger $ amt * (10 ^ 8)
firstPass <- selectUnspentNotes dbPath za zats
let fee = calculateTxFee firstPass 3
print "calculated fee"
print fee
(tList, sList, oList) <- selectUnspentNotes dbPath za (zats + fee)
print "selected notes"
print tList
print sList
print oList
let noteTotal = getTotalAmount (tList, sList, oList)
print noteTotal
tSpends <-
prepTSpends (getTranSK $ zcashAccountTPrivateKey $ entityVal acc) tList
print tSpends
sSpends <-
prepSSpends (getSapSK $ zcashAccountSapSpendKey $ entityVal acc) sList
print sSpends
oSpends <-
prepOSpends (getOrchSK $ zcashAccountOrchSpendKey $ entityVal acc) oList
print oSpends
outgoing <- makeOutgoing acc recipient zats (noteTotal - fee - zats)
print outgoing
let tx =
createTransaction
(Just sT)
(Just oT)
tSpends
sSpends
oSpends
outgoing
(SaplingSpendParams spParams)
(SaplingOutputParams outParams)
zn
(bh + 3)
return tx
where
makeOutgoing ::
Entity ZcashAccount
-> (Int, BS.ByteString)
-> Integer
-> Integer
-> IO [OutgoingNote]
makeOutgoing acc (k, recvr) zats chg = do
chgAddr <- getInternalAddresses dbPath $ 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 dbPath $ walletTrNoteAddress $ entityVal n
print 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 dbPath $ 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
print n
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
print n
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 String
-> LoggingT IO ()
syncWallet config w = do
let walletDb = c_dbPath config
accs <- getAccounts walletDb $ entityKey w
addrs <- concat <$> mapM (getAddresses walletDb . entityKey) accs
intAddrs <- concat <$> mapM (getInternalAddresses walletDb . entityKey) accs
chainTip <- getMaxBlock walletDb
accs <- liftIO $ getAccounts walletDb $ entityKey w
addrs <- liftIO $ concat <$> mapM (getAddresses walletDb . entityKey) accs
intAddrs <-
liftIO $ concat <$> mapM (getInternalAddresses walletDb . entityKey) accs
chainTip <- liftIO $ getMaxBlock walletDb
let lastBlock = zcashWalletLastSync $ entityVal w
let startBlock =
if lastBlock > 0
then lastBlock
else zcashWalletBirthdayHeight $ entityVal w
mapM_ (findTransparentNotes walletDb startBlock) addrs
mapM_ (findTransparentNotes walletDb startBlock) intAddrs
mapM_ (findTransparentSpends walletDb . entityKey) accs
mapM_ (liftIO . findTransparentNotes walletDb startBlock) addrs
mapM_ (liftIO . findTransparentNotes walletDb startBlock) intAddrs
mapM_ (liftIO . findTransparentSpends walletDb . entityKey) accs
sapNotes <-
liftIO $
mapM
(findSaplingOutputs config startBlock (zcashWalletNetwork $ entityVal w))
accs
orchNotes <-
liftIO $
mapM
(findOrchardActions config startBlock (zcashWalletNetwork $ entityVal w))
accs
updateWalletSync walletDb chainTip (entityKey w)
mapM_ (getWalletTransactions walletDb) addrs
return "Testing"
_ <- updateSaplingWitnesses walletDb
_ <- updateOrchardWitnesses walletDb
_ <- liftIO $ updateWalletSync walletDb chainTip (entityKey w)
_ <- liftIO $ mapM_ (getWalletTransactions walletDb) addrs
logInfoN "Synced wallet"
testSync :: Config -> IO ()
testSync config = do
let dbPath = c_dbPath config
_ <- initDb dbPath
w <- getWallets dbPath TestNet
r <- mapM (syncWallet config) w
print r
r <- runFileLoggingT "zenith.log" $ mapM (syncWallet config) w
liftIO $ print r
testSend :: IO ()
testSend = do
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
clearSync :: Config -> IO ()
clearSync config = do
@ -416,7 +750,7 @@ clearSync config = do
_ <- initDb dbPath
_ <- clearWalletTransactions dbPath
w <- getWallets dbPath TestNet
mapM_ (updateWalletSync dbPath 0 . entityKey) w
w' <- getWallets dbPath TestNet
r <- mapM (syncWallet config) w'
print r
liftIO $ mapM_ (updateWalletSync dbPath 0 . entityKey) w
w' <- liftIO $ getWallets dbPath TestNet
r <- runFileLoggingT "zenith.log" $ mapM (syncWallet config) w'
liftIO $ print r

View file

@ -21,10 +21,12 @@ module Zenith.DB where
import Control.Exception (throwIO)
import Control.Monad (forM_, when)
import Control.Monad.IO.Class (MonadIO, liftIO)
import Data.Bifunctor (bimap)
import qualified Data.ByteString as BS
import Data.HexString
import Data.List (group, sort)
import Data.Maybe (catMaybes, fromJust, isJust)
import Data.Pool (Pool)
import qualified Data.Text as T
import qualified Data.Text.Encoding as TE
import Data.Word
@ -67,6 +69,7 @@ import Zenith.Types
, HexStringDB(..)
, OrchardSpendingKeyDB(..)
, PhraseDB(..)
, RseedDB(..)
, SaplingSpendingKeyDB(..)
, ScopeDB(..)
, TransparentSpendingKeyDB
@ -123,6 +126,7 @@ share
WalletTrNote
tx WalletTransactionId OnDeleteCascade OnUpdateCascade
accId ZcashAccountId
address WalletAddressId
value Word64
spent Bool
script BS.ByteString
@ -147,6 +151,8 @@ share
position Word64
witness HexStringDB
change Bool
witPos ShieldOutputId OnDeleteIgnore OnUpdateIgnore
rseed RseedDB
UniqueSapNote tx nullifier
deriving Show Eq
WalletSapSpend
@ -166,6 +172,9 @@ share
position Word64
witness HexStringDB
change Bool
witPos OrchActionId OnDeleteIgnore OnUpdateIgnore
rho BS.ByteString
rseed RseedDB
UniqueOrchNote tx nullifier
deriving Show Eq
WalletOrchSpend
@ -285,6 +294,14 @@ getAccounts dbFp w =
where_ (accs ^. ZcashAccountWalletId ==. val w)
pure accs
getAccountById :: T.Text -> ZcashAccountId -> IO (Maybe (Entity ZcashAccount))
getAccountById dbPath za = do
PS.runSqlite dbPath $
selectOne $ do
accs <- from $ table @ZcashAccount
where_ (accs ^. ZcashAccountId ==. val za)
pure accs
-- | Returns the largest account index for the given wallet
getMaxAccount ::
T.Text -- ^ The database path
@ -338,6 +355,14 @@ getAddresses dbFp a =
where_ (addrs ^. WalletAddressScope ==. val (ScopeDB External))
pure addrs
getAddressById :: T.Text -> WalletAddressId -> IO (Maybe (Entity WalletAddress))
getAddressById dbPath a = do
PS.runSqlite dbPath $
selectOne $ do
addr <- from $ table @WalletAddress
where_ (addr ^. WalletAddressId ==. val a)
pure addr
-- | Returns a list of change addresses associated with the given account
getInternalAddresses ::
T.Text -- ^ The database path
@ -503,6 +528,19 @@ getMaxWalletBlock dbPath = do
Nothing -> return $ -1
Just x -> return $ walletTransactionBlock $ entityVal x
getMinBirthdayHeight :: T.Text -> IO Int
getMinBirthdayHeight dbPath = do
b <-
PS.runSqlite dbPath $
selectOne $ do
w <- from $ table @ZcashWallet
where_ (w ^. ZcashWalletBirthdayHeight >. val 0)
orderBy [asc $ w ^. ZcashWalletBirthdayHeight]
pure w
case b of
Nothing -> return 0
Just x -> return $ zcashWalletBirthdayHeight $ entityVal x
-- | Save a @WalletTransaction@
saveWalletTransaction ::
T.Text
@ -531,9 +569,10 @@ saveWalletSapNote ::
-> SaplingWitness -- ^ the Sapling incremental witness
-> Bool -- ^ change flag
-> ZcashAccountId
-> ShieldOutputId
-> DecodedNote -- The decoded Sapling note
-> IO ()
saveWalletSapNote dbPath wId pos wit ch za dn = do
saveWalletSapNote dbPath wId pos wit ch za zt dn = do
PS.runSqlite dbPath $ do
_ <-
upsert
@ -547,7 +586,9 @@ saveWalletSapNote dbPath wId pos wit ch za dn = do
(HexStringDB $ a_nullifier dn)
(fromIntegral pos)
(HexStringDB $ sapWit wit)
ch)
ch
zt
(RseedDB $ a_rseed dn))
[]
return ()
@ -559,9 +600,10 @@ saveWalletOrchNote ::
-> OrchardWitness
-> Bool
-> ZcashAccountId
-> OrchActionId
-> DecodedNote
-> IO ()
saveWalletOrchNote dbPath wId pos wit ch za dn = do
saveWalletOrchNote dbPath wId pos wit ch za zt dn = do
PS.runSqlite dbPath $ do
_ <-
upsert
@ -575,7 +617,10 @@ saveWalletOrchNote dbPath wId pos wit ch za dn = do
(HexStringDB $ a_nullifier dn)
(fromIntegral pos)
(HexStringDB $ orchWit wit)
ch)
ch
zt
(a_rho dn)
(RseedDB $ a_rseed dn))
[]
return ()
@ -609,7 +654,8 @@ findTransparentNotes dbPath b t = do
(saveWalletTrNote
dbPath
(getScope $ walletAddressScope $ entityVal t)
(walletAddressAccId $ entityVal t))
(walletAddressAccId $ entityVal t)
(entityKey t))
tN
Nothing -> return ()
@ -618,9 +664,10 @@ saveWalletTrNote ::
T.Text -- ^ the database path
-> Scope
-> ZcashAccountId
-> WalletAddressId
-> (Entity ZcashTransaction, Entity TransparentNote)
-> IO ()
saveWalletTrNote dbPath ch za (zt, tn) = do
saveWalletTrNote dbPath ch za wa (zt, tn) = do
let zT' = entityVal zt
PS.runSqlite dbPath $ do
t <-
@ -636,6 +683,7 @@ saveWalletTrNote dbPath ch za (zt, tn) = do
WalletTrNote
(entityKey t)
za
wa
(transparentNoteValue $ entityVal tn)
False
(transparentNoteScript $ entityVal tn)
@ -917,6 +965,9 @@ findTransparentSpends dbPath za = do
case mReverseTxId of
Nothing -> throwIO $ userError "failed to get tx ID"
Just (Value reverseTxId) -> do
let flipTxId =
HexStringDB $
HexString $ BS.reverse $ toBytes $ getHex reverseTxId
s <-
PS.runSqlite dbPath $ do
select $ do
@ -926,7 +977,7 @@ findTransparentSpends dbPath za = do
(\(tx :& trSpends) ->
tx ^. ZcashTransactionId ==. trSpends ^. TransparentSpendTx)
where_
(trSpends ^. TransparentSpendOutPointHash ==. val reverseTxId)
(trSpends ^. TransparentSpendOutPointHash ==. val flipTxId)
where_
(trSpends ^. TransparentSpendOutPointIndex ==.
val (walletTrNotePosition $ entityVal n))
@ -995,6 +1046,100 @@ getWalletOrchNotes dbPath za = do
where_ (n ^. WalletOrchNoteAccId ==. val za)
pure n
getUnspentSapNotes :: T.Text -> IO [Entity WalletSapNote]
getUnspentSapNotes dbPath = do
PS.runSqlite dbPath $ do
select $ do
n <- from $ table @WalletSapNote
where_ (n ^. WalletSapNoteSpent ==. val False)
pure n
getSaplingCmus :: Pool SqlBackend -> ShieldOutputId -> IO [Value HexStringDB]
getSaplingCmus pool zt = do
PS.runSqlPool
(select $ do
n <- from $ table @ShieldOutput
where_ (n ^. ShieldOutputId >. val zt)
orderBy [asc $ n ^. ShieldOutputId]
pure $ n ^. ShieldOutputCmu)
pool
getMaxSaplingNote :: Pool SqlBackend -> IO ShieldOutputId
getMaxSaplingNote pool = do
flip PS.runSqlPool pool $ do
x <-
selectOne $ do
n <- from $ table @ShieldOutput
where_ (n ^. ShieldOutputId >. val (toSqlKey 0))
orderBy [desc $ n ^. ShieldOutputId]
pure (n ^. ShieldOutputId)
case x of
Nothing -> return $ toSqlKey 0
Just (Value y) -> return y
updateSapNoteRecord ::
Pool SqlBackend
-> WalletSapNoteId
-> SaplingWitness
-> ShieldOutputId
-> IO ()
updateSapNoteRecord pool n w o = do
flip PS.runSqlPool pool $ do
update $ \x -> do
set
x
[ WalletSapNoteWitness =. val (HexStringDB $ sapWit w)
, WalletSapNoteWitPos =. val o
]
where_ (x ^. WalletSapNoteId ==. val n)
getUnspentOrchNotes :: T.Text -> IO [Entity WalletOrchNote]
getUnspentOrchNotes dbPath = do
PS.runSqlite dbPath $ do
select $ do
n <- from $ table @WalletOrchNote
where_ (n ^. WalletOrchNoteSpent ==. val False)
pure n
getOrchardCmxs :: Pool SqlBackend -> OrchActionId -> IO [Value HexStringDB]
getOrchardCmxs pool zt = do
PS.runSqlPool
(select $ do
n <- from $ table @OrchAction
where_ (n ^. OrchActionId >. val zt)
orderBy [asc $ n ^. OrchActionId]
pure $ n ^. OrchActionCmx)
pool
getMaxOrchardNote :: Pool SqlBackend -> IO OrchActionId
getMaxOrchardNote pool = do
flip PS.runSqlPool pool $ do
x <-
selectOne $ do
n <- from $ table @OrchAction
where_ (n ^. OrchActionId >. val (toSqlKey 0))
orderBy [desc $ n ^. OrchActionId]
pure (n ^. OrchActionId)
case x of
Nothing -> return $ toSqlKey 0
Just (Value y) -> return y
updateOrchNoteRecord ::
Pool SqlBackend
-> WalletOrchNoteId
-> OrchardWitness
-> OrchActionId
-> IO ()
updateOrchNoteRecord pool n w o = do
flip PS.runSqlPool pool $ do
update $ \x -> do
set
x
[ WalletOrchNoteWitness =. val (HexStringDB $ orchWit w)
, WalletOrchNoteWitPos =. val o
]
where_ (x ^. WalletOrchNoteId ==. val n)
findOrchSpends :: T.Text -> ZcashAccountId -> [Entity WalletOrchNote] -> IO ()
findOrchSpends _ _ [] = return ()
findOrchSpends dbPath za (n:notes) = do
@ -1043,31 +1188,13 @@ upsertWalTx zt za =
getBalance :: T.Text -> ZcashAccountId -> IO Integer
getBalance dbPath za = do
trNotes <-
PS.runSqlite dbPath $ do
select $ do
n <- from $ table @WalletTrNote
where_ (n ^. WalletTrNoteAccId ==. val za)
where_ (n ^. WalletTrNoteSpent ==. val False)
pure n
trNotes <- getWalletUnspentTrNotes dbPath za
let tAmts = map (walletTrNoteValue . entityVal) trNotes
let tBal = sum tAmts
sapNotes <-
PS.runSqlite dbPath $ do
select $ do
n1 <- from $ table @WalletSapNote
where_ (n1 ^. WalletSapNoteAccId ==. val za)
where_ (n1 ^. WalletSapNoteSpent ==. val False)
pure n1
sapNotes <- getWalletUnspentSapNotes dbPath za
let sAmts = map (walletSapNoteValue . entityVal) sapNotes
let sBal = sum sAmts
orchNotes <-
PS.runSqlite dbPath $ do
select $ do
n2 <- from $ table @WalletOrchNote
where_ (n2 ^. WalletOrchNoteAccId ==. val za)
where_ (n2 ^. WalletOrchNoteSpent ==. val False)
pure n2
orchNotes <- getWalletUnspentOrchNotes dbPath za
let oAmts = map (walletOrchNoteValue . entityVal) orchNotes
let oBal = sum oAmts
return . fromIntegral $ tBal + sBal + oBal
@ -1100,6 +1227,91 @@ clearWalletTransactions dbPath = do
_ <- from $ table @UserTx
return ()
getWalletUnspentTrNotes :: T.Text -> ZcashAccountId -> IO [Entity WalletTrNote]
getWalletUnspentTrNotes dbPath za = do
PS.runSqlite dbPath $ do
select $ do
n <- from $ table @WalletTrNote
where_ (n ^. WalletTrNoteAccId ==. val za)
where_ (n ^. WalletTrNoteSpent ==. val False)
pure n
getWalletUnspentSapNotes ::
T.Text -> ZcashAccountId -> IO [Entity WalletSapNote]
getWalletUnspentSapNotes dbPath za = do
PS.runSqlite dbPath $ do
select $ do
n1 <- from $ table @WalletSapNote
where_ (n1 ^. WalletSapNoteAccId ==. val za)
where_ (n1 ^. WalletSapNoteSpent ==. val False)
pure n1
getWalletUnspentOrchNotes ::
T.Text -> ZcashAccountId -> IO [Entity WalletOrchNote]
getWalletUnspentOrchNotes dbPath za = do
PS.runSqlite dbPath $ do
select $ do
n2 <- from $ table @WalletOrchNote
where_ (n2 ^. WalletOrchNoteAccId ==. val za)
where_ (n2 ^. WalletOrchNoteSpent ==. val False)
pure n2
selectUnspentNotes ::
T.Text
-> ZcashAccountId
-> Integer
-> IO ([Entity WalletTrNote], [Entity WalletSapNote], [Entity WalletOrchNote])
selectUnspentNotes dbPath za amt = do
trNotes <- getWalletUnspentTrNotes dbPath za
let (a1, tList) = checkTransparent (fromIntegral amt) trNotes
if a1 > 0
then do
sapNotes <- getWalletUnspentSapNotes dbPath za
let (a2, sList) = checkSapling a1 sapNotes
if a2 > 0
then do
orchNotes <- getWalletUnspentOrchNotes dbPath za
let (a3, oList) = checkOrchard a2 orchNotes
if a3 > 0
then throwIO $ userError "Not enough funds"
else return (tList, sList, oList)
else return (tList, sList, [])
else return (tList, [], [])
where
checkTransparent ::
Word64 -> [Entity WalletTrNote] -> (Word64, [Entity WalletTrNote])
checkTransparent x [] = (x, [])
checkTransparent x (n:ns) =
if walletTrNoteValue (entityVal n) < x
then ( fst (checkTransparent (x - walletTrNoteValue (entityVal n)) ns)
, n :
snd (checkTransparent (x - walletTrNoteValue (entityVal n)) ns))
else (0, [n])
checkSapling ::
Word64 -> [Entity WalletSapNote] -> (Word64, [Entity WalletSapNote])
checkSapling x [] = (x, [])
checkSapling x (n:ns) =
if walletSapNoteValue (entityVal n) < x
then ( fst (checkSapling (x - walletSapNoteValue (entityVal n)) ns)
, n : snd (checkSapling (x - walletSapNoteValue (entityVal n)) ns))
else (0, [n])
checkOrchard ::
Word64 -> [Entity WalletOrchNote] -> (Word64, [Entity WalletOrchNote])
checkOrchard x [] = (x, [])
checkOrchard x (n:ns) =
if walletOrchNoteValue (entityVal n) < x
then ( fst (checkOrchard (x - walletOrchNoteValue (entityVal n)) ns)
, n : snd (checkOrchard (x - walletOrchNoteValue (entityVal n)) ns))
else (0, [n])
getWalletTxId :: T.Text -> WalletTransactionId -> IO (Maybe (Value HexStringDB))
getWalletTxId dbPath wId = do
PS.runSqlite dbPath $ do
selectOne $ do
wtx <- from $ table @WalletTransaction
where_ (wtx ^. WalletTransactionId ==. val wId)
pure $ wtx ^. WalletTransactionTxId
-- | Helper function to extract a Unified Address from the database
readUnifiedAddressDB :: WalletAddress -> Maybe UnifiedAddress
readUnifiedAddressDB =

View file

@ -23,6 +23,7 @@ import GHC.Generics
import ZcashHaskell.Types
( OrchardSpendingKey(..)
, Phrase(..)
, Rseed(..)
, SaplingSpendingKey(..)
, Scope(..)
, TransparentSpendingKey
@ -79,6 +80,12 @@ newtype TransparentSpendingKeyDB = TransparentSpendingKeyDB
derivePersistField "TransparentSpendingKeyDB"
newtype RseedDB = RseedDB
{ getRseed :: Rseed
} deriving newtype (Eq, Show, Read)
derivePersistField "RseedDB"
-- * RPC
-- | Type for Configuration parameters
data Config = Config

View file

@ -160,3 +160,31 @@ main = do
a_nullifier d `shouldBe`
hexString
"6c5d1413c63a9a88db71c3f41dc12cd60197ee742fc75b217215e7144db48bd3"
describe "Note selection for Tx" $ do
it "Value less than balance" $ do
res <- selectUnspentNotes "zenith.db" (toSqlKey 1) 14000000
res `shouldNotBe` ([], [], [])
it "Value greater than balance" $ do
let res = selectUnspentNotes "zenith.db" (toSqlKey 1) 84000000
res `shouldThrow` anyIOException
it "Fee calculation" $ do
res <- selectUnspentNotes "zenith.db" (toSqlKey 1) 14000000
calculateTxFee res 3 `shouldBe` 20000
describe "Creating Tx" $ do
xit "To Orchard" $ do
let uaRead =
isValidUnifiedAddress
"utest1dl54utt6prjj5e0dnlknwumnxq9hycdjpkfr0sy6e6h522remqee8axe9zax0wsjrwpj76v555pdhvj9rnargpfyycs0vpkapq98xcdhem99gc4wchzn0ggepq3y6nz3a9sscwgqxgsh9vzhcad402y3x9szfregck5gslkya3c79d86xx0l33tpk8gnn7ew9vw37w43zh22u8dgdax"
case uaRead of
Nothing -> assertFailure "wrong address"
Just ua -> do
tx <-
prepareTx
"zenith.db"
TestNet
(toSqlKey 1)
2819811
0.04
ua
"sent with Zenith, test"
tx `shouldBe` Right (hexString "deadbeef")

@ -1 +1 @@
Subproject commit 00400c433dd8a584ef19af58fcab7fdd108d4110
Subproject commit 22c0fe374976d9f2323a8b7cd42f941423d45111

View file

@ -1,6 +1,6 @@
cabal-version: 3.0
name: zenith
version: 0.4.6.0
version: 0.5.0.0
license: MIT
license-file: LICENSE
author: Rene Vergara
@ -45,6 +45,11 @@ library
, brick
, bytestring
, esqueleto
, resource-pool
, monad-logger
, vty-crossplatform
, secp256k1-haskell
, pureMD5
, ghc
, haskoin-core
, hexstring