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/), 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). 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] ## [0.4.6.0]
### Added ### Added

View file

@ -18,7 +18,7 @@ import System.IO
import Text.Read (readMaybe) import Text.Read (readMaybe)
import ZcashHaskell.Types import ZcashHaskell.Types
import Zenith.CLI import Zenith.CLI
import Zenith.Core (clearSync, testSync) import Zenith.Core (clearSync, testSend, testSync)
import Zenith.Types (Config(..), ZcashAddress(..), ZcashPool(..), ZcashTx(..)) import Zenith.Types (Config(..), ZcashAddress(..), ZcashPool(..), ZcashTx(..))
import Zenith.Utils import Zenith.Utils
import Zenith.Zcashd import Zenith.Zcashd
@ -223,6 +223,7 @@ main = do
"cli" -> runZenithCLI myConfig "cli" -> runZenithCLI myConfig
"sync" -> testSync myConfig "sync" -> testSync myConfig
"rescan" -> clearSync myConfig "rescan" -> clearSync myConfig
"testsend" -> testSend
_ -> printUsage _ -> printUsage
else 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 module Zenith.CLI where
import qualified Brick.AttrMap as A import qualified Brick.AttrMap as A
import qualified Brick.BChan as BC
import qualified Brick.Focus as F import qualified Brick.Focus as F
import Brick.Forms import Brick.Forms
( Form(..) ( Form(..)
@ -20,7 +21,7 @@ import Brick.Forms
import qualified Brick.Main as M import qualified Brick.Main as M
import qualified Brick.Types as BT import qualified Brick.Types as BT
import Brick.Types (Widget) 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 qualified Brick.Widgets.Border as B
import Brick.Widgets.Border.Style (unicode, unicodeBold) import Brick.Widgets.Border.Style (unicode, unicodeBold)
import qualified Brick.Widgets.Center as C import qualified Brick.Widgets.Center as C
@ -41,6 +42,7 @@ import Brick.Widgets.Core
, txt , txt
, txtWrap , txtWrap
, txtWrapWith , txtWrapWith
, updateAttrMap
, vBox , vBox
, vLimit , vLimit
, withAttr , withAttr
@ -48,9 +50,13 @@ import Brick.Widgets.Core
) )
import qualified Brick.Widgets.Dialog as D import qualified Brick.Widgets.Dialog as D
import qualified Brick.Widgets.List as L 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.Exception (catch, throw, throwIO, try)
import Control.Monad (void) import Control.Monad (forever, void)
import Control.Monad.IO.Class (liftIO) import Control.Monad.IO.Class (liftIO)
import Control.Monad.Logger (runFileLoggingT)
import Data.Aeson
import Data.Maybe import Data.Maybe
import qualified Data.Text as T import qualified Data.Text as T
import qualified Data.Text.Encoding as E import qualified Data.Text.Encoding as E
@ -58,6 +64,7 @@ import Data.Time.Clock.POSIX (posixSecondsToUTCTime)
import qualified Data.Vector as Vec import qualified Data.Vector as Vec
import Database.Persist import Database.Persist
import qualified Graphics.Vty as V import qualified Graphics.Vty as V
import qualified Graphics.Vty.CrossPlatform as VC
import Lens.Micro ((&), (.~), (^.), set) import Lens.Micro ((&), (.~), (^.), set)
import Lens.Micro.Mtl import Lens.Micro.Mtl
import Lens.Micro.TH import Lens.Micro.TH
@ -66,15 +73,17 @@ import ZcashHaskell.Keys (generateWalletSeedPhrase, getWalletSeed)
import ZcashHaskell.Orchard (getSaplingFromUA, isValidUnifiedAddress) import ZcashHaskell.Orchard (getSaplingFromUA, isValidUnifiedAddress)
import ZcashHaskell.Transparent (encodeTransparentReceiver) import ZcashHaskell.Transparent (encodeTransparentReceiver)
import ZcashHaskell.Types import ZcashHaskell.Types
import ZcashHaskell.Utils (getBlockTime, makeZebraCall)
import Zenith.Core import Zenith.Core
import Zenith.DB import Zenith.DB
import Zenith.Scanner (processTx)
import Zenith.Types import Zenith.Types
( Config(..) ( Config(..)
, PhraseDB(..) , PhraseDB(..)
, UnifiedAddressDB(..) , UnifiedAddressDB(..)
, ZcashNetDB(..) , ZcashNetDB(..)
) )
import Zenith.Utils (displayTaz, displayZec, showAddress) import Zenith.Utils (displayTaz, displayZec, jsonNumber, showAddress)
data Name data Name
= WList = WList
@ -104,8 +113,12 @@ data DisplayType
| MsgDisplay | MsgDisplay
| PhraseDisplay | PhraseDisplay
| TxDisplay | TxDisplay
| SyncDisplay
| BlankDisplay | BlankDisplay
data Tick =
Tick
data State = State data State = State
{ _network :: !ZcashNet { _network :: !ZcashNet
, _wallets :: !(L.List Name (Entity ZcashWallet)) , _wallets :: !(L.List Name (Entity ZcashWallet))
@ -120,9 +133,13 @@ data State = State
, _focusRing :: !(F.FocusRing Name) , _focusRing :: !(F.FocusRing Name)
, _startBlock :: !Int , _startBlock :: !Int
, _dbPath :: !T.Text , _dbPath :: !T.Text
, _zebraHost :: !T.Text
, _zebraPort :: !Int
, _displayBox :: !DisplayType , _displayBox :: !DisplayType
, _syncBlock :: !Int , _syncBlock :: !Int
, _balance :: !Integer , _balance :: !Integer
, _barValue :: !Float
, _eventDispatch :: !(BC.BChan Tick)
} }
makeLenses ''State makeLenses ''State
@ -282,7 +299,7 @@ drawUI s = [splashDialog s, helpDialog s, displayDialog s, inputDialog s, ui s]
titleAttr titleAttr
(str (str
" _____ _ _ _ \n|__ /___ _ __ (_) |_| |__\n / // _ \\ '_ \\| | __| '_ \\\n / /| __/ | | | | |_| | | |\n/____\\___|_| |_|_|\\__|_| |_|") <=> " _____ _ _ _ \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...")) C.hCenter (withAttr blinkAttr $ str "Press any key..."))
else emptyWidget else emptyWidget
capCommand :: String -> String -> Widget Name capCommand :: String -> String -> Widget Name
@ -367,6 +384,20 @@ drawUI s = [splashDialog s, helpDialog s, displayDialog s, inputDialog s, ui s]
txtWrapWith txtWrapWith
(WrapSettings False True NoFill FillAfterFirst) (WrapSettings False True NoFill FillAfterFirst)
(userTxMemo (entityVal tx))))) (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 BlankDisplay -> emptyWidget
mkInputForm :: DialogInput -> Form DialogInput e Name mkInputForm :: DialogInput -> Form DialogInput e Name
@ -438,7 +469,89 @@ titleAttr = A.attrName "title"
blinkAttr :: A.AttrName blinkAttr :: A.AttrName
blinkAttr = A.attrName "blink" 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 appEvent (BT.VtyEvent e) = do
r <- F.focusGetCurrent <$> use focusRing r <- F.focusGetCurrent <$> use focusRing
s <- BT.get s <- BT.get
@ -456,6 +569,29 @@ appEvent (BT.VtyEvent e) = do
MsgDisplay -> BT.modify $ set displayBox BlankDisplay MsgDisplay -> BT.modify $ set displayBox BlankDisplay
PhraseDisplay -> BT.modify $ set displayBox BlankDisplay PhraseDisplay -> BT.modify $ set displayBox BlankDisplay
TxDisplay -> 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 BlankDisplay -> do
case s ^. dialogBox of case s ^. dialogBox of
WName -> do WName -> do
@ -557,6 +693,9 @@ appEvent (BT.VtyEvent e) = do
BT.modify $ set displayBox TxDisplay BT.modify $ set displayBox TxDisplay
V.EvKey (V.KChar 'a') [] -> V.EvKey (V.KChar 'a') [] ->
BT.modify $ set dialogBox ASelect BT.modify $ set dialogBox ASelect
V.EvKey (V.KChar 's') [] -> do
BT.modify $ set barValue 0.0
BT.modify $ set displayBox SyncDisplay
ev -> ev ->
case r of case r of
Just AList -> Just AList ->
@ -581,9 +720,12 @@ theMap =
, (titleAttr, V.withStyle (fg V.brightGreen) V.bold) , (titleAttr, V.withStyle (fg V.brightGreen) V.bold)
, (blinkAttr, style V.blink) , (blinkAttr, style V.blink)
, (focusedFormInputAttr, V.white `on` V.blue) , (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 = theApp =
M.App M.App
{ M.appDraw = drawUI { M.appDraw = drawUI
@ -629,8 +771,11 @@ runZenithCLI config = do
if not (null accList) if not (null accList)
then getBalance dbFilePath $ entityKey $ head accList then getBalance dbFilePath $ entityKey $ head accList
else return 0 else return 0
eventChan <- BC.newBChan 10
let buildVty = VC.mkVty V.defaultConfig
initialVty <- buildVty
void $ void $
M.defaultMain theApp $ M.customMain initialVty buildVty (Just eventChan) theApp $
State State
(zgb_net chainInfo) (zgb_net chainInfo)
(L.list WList (Vec.fromList walList) 1) (L.list WList (Vec.fromList walList) 1)
@ -648,9 +793,13 @@ runZenithCLI config = do
(F.focusRing [AList, TList]) (F.focusRing [AList, TList])
(zgb_blocks chainInfo) (zgb_blocks chainInfo)
dbFilePath dbFilePath
host
port
MsgDisplay MsgDisplay
block block
bal bal
1.0
eventChan
Left e -> do Left e -> do
print $ print $
"No Zebra node available on port " <> "No Zebra node available on port " <>

View file

@ -4,13 +4,33 @@
module Zenith.Core where module Zenith.Core where
import Control.Exception (throwIO, try) 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.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.Maybe (fromJust)
import Data.Pool (Pool)
import qualified Data.Text as T import qualified Data.Text as T
import qualified Data.Text.Encoding as E import qualified Data.Text.Encoding as E
import Data.Time
import qualified Database.Esqueleto.Experimental as ESQ
import Database.Persist import Database.Persist
import Database.Persist.Sqlite import Database.Persist.Sqlite
import GHC.Float.RealFracMethods (floorFloatInteger)
import Haskoin.Crypto.Keys (XPrvKey(..))
import Network.HTTP.Client import Network.HTTP.Client
import ZcashHaskell.Keys import ZcashHaskell.Keys
import ZcashHaskell.Orchard import ZcashHaskell.Orchard
@ -20,7 +40,9 @@ import ZcashHaskell.Orchard
, genOrchardSpendingKey , genOrchardSpendingKey
, getOrchardNotePosition , getOrchardNotePosition
, getOrchardWitness , getOrchardWitness
, isValidUnifiedAddress
, updateOrchardCommitmentTree , updateOrchardCommitmentTree
, updateOrchardWitness
) )
import ZcashHaskell.Sapling import ZcashHaskell.Sapling
( decodeSaplingOutputEsk ( decodeSaplingOutputEsk
@ -30,8 +52,13 @@ import ZcashHaskell.Sapling
, getSaplingNotePosition , getSaplingNotePosition
, getSaplingWitness , getSaplingWitness
, updateSaplingCommitmentTree , updateSaplingCommitmentTree
, updateSaplingWitness
)
import ZcashHaskell.Transparent
( genTransparentPrvKey
, genTransparentReceiver
, genTransparentSecretKey
) )
import ZcashHaskell.Transparent (genTransparentPrvKey, genTransparentReceiver)
import ZcashHaskell.Types import ZcashHaskell.Types
import ZcashHaskell.Utils import ZcashHaskell.Utils
import Zenith.DB import Zenith.DB
@ -40,6 +67,7 @@ import Zenith.Types
, HexStringDB(..) , HexStringDB(..)
, OrchardSpendingKeyDB(..) , OrchardSpendingKeyDB(..)
, PhraseDB(..) , PhraseDB(..)
, RseedDB(..)
, SaplingSpendingKeyDB(..) , SaplingSpendingKeyDB(..)
, ScopeDB(..) , ScopeDB(..)
, TransparentSpendingKeyDB(..) , TransparentSpendingKeyDB(..)
@ -236,7 +264,6 @@ findSaplingOutputs config b znet za = do
Nothing -> do Nothing -> do
decryptNotes uT n txs decryptNotes uT n txs
Just dn1 -> do Just dn1 -> do
print dn1
wId <- wId <-
saveWalletTransaction saveWalletTransaction
(c_dbPath config) (c_dbPath config)
@ -249,10 +276,10 @@ findSaplingOutputs config b znet za = do
(fromJust noteWitness) (fromJust noteWitness)
True True
(entityKey za) (entityKey za)
(entityKey o)
dn1 dn1
decryptNotes uT n txs decryptNotes uT n txs
Just dn0 -> do Just dn0 -> do
print dn0
wId <- wId <-
saveWalletTransaction (c_dbPath config) (entityKey za) zt saveWalletTransaction (c_dbPath config) (entityKey za) zt
saveWalletSapNote saveWalletSapNote
@ -262,6 +289,7 @@ findSaplingOutputs config b znet za = do
(fromJust noteWitness) (fromJust noteWitness)
False False
(entityKey za) (entityKey za)
(entityKey o)
dn0 dn0
decryptNotes uT n txs decryptNotes uT n txs
decodeShOut :: decodeShOut ::
@ -327,7 +355,6 @@ findOrchardActions config b znet za = do
case decodeOrchAction Internal nP o of case decodeOrchAction Internal nP o of
Nothing -> decryptNotes uT n txs Nothing -> decryptNotes uT n txs
Just dn1 -> do Just dn1 -> do
print dn1
wId <- wId <-
saveWalletTransaction saveWalletTransaction
(c_dbPath config) (c_dbPath config)
@ -340,10 +367,10 @@ findOrchardActions config b znet za = do
(fromJust noteWitness) (fromJust noteWitness)
True True
(entityKey za) (entityKey za)
(entityKey o)
dn1 dn1
decryptNotes uT n txs decryptNotes uT n txs
Just dn -> do Just dn -> do
print dn
wId <- wId <-
saveWalletTransaction (c_dbPath config) (entityKey za) zt saveWalletTransaction (c_dbPath config) (entityKey za) zt
saveWalletOrchNote saveWalletOrchNote
@ -353,6 +380,7 @@ findOrchardActions config b znet za = do
(fromJust noteWitness) (fromJust noteWitness)
False False
(entityKey za) (entityKey za)
(entityKey o)
dn dn
decryptNotes uT n txs decryptNotes uT n txs
sk :: OrchardSpendingKeyDB sk :: OrchardSpendingKeyDB
@ -371,44 +399,350 @@ findOrchardActions config b znet za = do
(getHex $ orchActionCv $ entityVal o) (getHex $ orchActionCv $ entityVal o)
(getHex $ orchActionAuth $ 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 -- | Sync the wallet with the data store
syncWallet :: syncWallet ::
Config -- ^ configuration parameters Config -- ^ configuration parameters
-> Entity ZcashWallet -> Entity ZcashWallet
-> IO String -> LoggingT IO ()
syncWallet config w = do syncWallet config w = do
let walletDb = c_dbPath config let walletDb = c_dbPath config
accs <- getAccounts walletDb $ entityKey w accs <- liftIO $ getAccounts walletDb $ entityKey w
addrs <- concat <$> mapM (getAddresses walletDb . entityKey) accs addrs <- liftIO $ concat <$> mapM (getAddresses walletDb . entityKey) accs
intAddrs <- concat <$> mapM (getInternalAddresses walletDb . entityKey) accs intAddrs <-
chainTip <- getMaxBlock walletDb liftIO $ concat <$> mapM (getInternalAddresses walletDb . entityKey) accs
chainTip <- liftIO $ getMaxBlock walletDb
let lastBlock = zcashWalletLastSync $ entityVal w let lastBlock = zcashWalletLastSync $ entityVal w
let startBlock = let startBlock =
if lastBlock > 0 if lastBlock > 0
then lastBlock then lastBlock
else zcashWalletBirthdayHeight $ entityVal w else zcashWalletBirthdayHeight $ entityVal w
mapM_ (findTransparentNotes walletDb startBlock) addrs mapM_ (liftIO . findTransparentNotes walletDb startBlock) addrs
mapM_ (findTransparentNotes walletDb startBlock) intAddrs mapM_ (liftIO . findTransparentNotes walletDb startBlock) intAddrs
mapM_ (findTransparentSpends walletDb . entityKey) accs mapM_ (liftIO . findTransparentSpends walletDb . entityKey) accs
sapNotes <- sapNotes <-
liftIO $
mapM mapM
(findSaplingOutputs config startBlock (zcashWalletNetwork $ entityVal w)) (findSaplingOutputs config startBlock (zcashWalletNetwork $ entityVal w))
accs accs
orchNotes <- orchNotes <-
liftIO $
mapM mapM
(findOrchardActions config startBlock (zcashWalletNetwork $ entityVal w)) (findOrchardActions config startBlock (zcashWalletNetwork $ entityVal w))
accs accs
updateWalletSync walletDb chainTip (entityKey w) _ <- updateSaplingWitnesses walletDb
mapM_ (getWalletTransactions walletDb) addrs _ <- updateOrchardWitnesses walletDb
return "Testing" _ <- liftIO $ updateWalletSync walletDb chainTip (entityKey w)
_ <- liftIO $ mapM_ (getWalletTransactions walletDb) addrs
logInfoN "Synced wallet"
testSync :: Config -> IO () testSync :: Config -> IO ()
testSync config = do testSync config = do
let dbPath = c_dbPath config let dbPath = c_dbPath config
_ <- initDb dbPath _ <- initDb dbPath
w <- getWallets dbPath TestNet w <- getWallets dbPath TestNet
r <- mapM (syncWallet config) w r <- runFileLoggingT "zenith.log" $ mapM (syncWallet config) w
print r 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 -> IO ()
clearSync config = do clearSync config = do
@ -416,7 +750,7 @@ clearSync config = do
_ <- initDb dbPath _ <- initDb dbPath
_ <- clearWalletTransactions dbPath _ <- clearWalletTransactions dbPath
w <- getWallets dbPath TestNet w <- getWallets dbPath TestNet
mapM_ (updateWalletSync dbPath 0 . entityKey) w liftIO $ mapM_ (updateWalletSync dbPath 0 . entityKey) w
w' <- getWallets dbPath TestNet w' <- liftIO $ getWallets dbPath TestNet
r <- mapM (syncWallet config) w' r <- runFileLoggingT "zenith.log" $ mapM (syncWallet config) w'
print r liftIO $ print r

View file

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

View file

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

View file

@ -160,3 +160,31 @@ main = do
a_nullifier d `shouldBe` a_nullifier d `shouldBe`
hexString hexString
"6c5d1413c63a9a88db71c3f41dc12cd60197ee742fc75b217215e7144db48bd3" "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 cabal-version: 3.0
name: zenith name: zenith
version: 0.4.6.0 version: 0.5.0.0
license: MIT license: MIT
license-file: LICENSE license-file: LICENSE
author: Rene Vergara author: Rene Vergara
@ -45,6 +45,11 @@ library
, brick , brick
, bytestring , bytestring
, esqueleto , esqueleto
, resource-pool
, monad-logger
, vty-crossplatform
, secp256k1-haskell
, pureMD5
, ghc , ghc
, haskoin-core , haskoin-core
, hexstring , hexstring