Merge pull request 'Implement transaction creation' (#77) from rav001 into dev041
Reviewed-on: #77
This commit is contained in:
commit
1ba188ec24
11 changed files with 803 additions and 61 deletions
|
@ -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
|
||||||
|
|
|
@ -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
BIN
sapling-output.params
Normal file
Binary file not shown.
BIN
sapling-spend.params
Normal file
BIN
sapling-spend.params
Normal file
Binary file not shown.
|
@ -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 " <>
|
||||||
|
|
|
@ -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
|
||||||
|
|
268
src/Zenith/DB.hs
268
src/Zenith/DB.hs
|
@ -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 =
|
||||||
|
|
|
@ -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
|
||||||
|
|
28
test/Spec.hs
28
test/Spec.hs
|
@ -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
|
|
@ -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
|
||||||
|
|
Loading…
Reference in a new issue