Implement background sync
This commit is contained in:
parent
1ba188ec24
commit
dcbb2fac4a
7 changed files with 916 additions and 687 deletions
|
@ -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, testSend, testSync)
|
import Zenith.Core (clearSync, 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,7 +223,6 @@ 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
|
||||||
|
|
||||||
|
|
|
@ -2,6 +2,7 @@
|
||||||
|
|
||||||
module ZenScan where
|
module ZenScan where
|
||||||
|
|
||||||
|
import Control.Monad.Logger (runNoLoggingT)
|
||||||
import Data.Configurator
|
import Data.Configurator
|
||||||
import Zenith.Scanner (scanZebra)
|
import Zenith.Scanner (scanZebra)
|
||||||
|
|
||||||
|
@ -11,4 +12,4 @@ main = do
|
||||||
dbFilePath <- require config "dbFilePath"
|
dbFilePath <- require config "dbFilePath"
|
||||||
zebraPort <- require config "zebraPort"
|
zebraPort <- require config "zebraPort"
|
||||||
zebraHost <- require config "zebraHost"
|
zebraHost <- require config "zebraHost"
|
||||||
scanZebra 2762066 zebraHost zebraPort dbFilePath
|
runNoLoggingT $ scanZebra 2762066 zebraHost zebraPort dbFilePath
|
||||||
|
|
|
@ -55,7 +55,7 @@ import Control.Concurrent (forkIO, threadDelay)
|
||||||
import Control.Exception (catch, throw, throwIO, try)
|
import Control.Exception (catch, throw, throwIO, try)
|
||||||
import Control.Monad (forever, void)
|
import Control.Monad (forever, void)
|
||||||
import Control.Monad.IO.Class (liftIO)
|
import Control.Monad.IO.Class (liftIO)
|
||||||
import Control.Monad.Logger (runFileLoggingT)
|
import Control.Monad.Logger (LoggingT, runFileLoggingT, runNoLoggingT)
|
||||||
import Data.Aeson
|
import Data.Aeson
|
||||||
import Data.Maybe
|
import Data.Maybe
|
||||||
import qualified Data.Text as T
|
import qualified Data.Text as T
|
||||||
|
@ -63,11 +63,13 @@ import qualified Data.Text.Encoding as E
|
||||||
import Data.Time.Clock.POSIX (posixSecondsToUTCTime)
|
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 Database.Persist.Sqlite
|
||||||
import qualified Graphics.Vty as V
|
import qualified Graphics.Vty as V
|
||||||
import qualified Graphics.Vty.CrossPlatform as VC
|
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
|
||||||
|
import System.Hclip
|
||||||
import Text.Wrap (FillScope(..), FillStrategy(..), WrapSettings(..), wrapText)
|
import Text.Wrap (FillScope(..), FillStrategy(..), WrapSettings(..), wrapText)
|
||||||
import ZcashHaskell.Keys (generateWalletSeedPhrase, getWalletSeed)
|
import ZcashHaskell.Keys (generateWalletSeedPhrase, getWalletSeed)
|
||||||
import ZcashHaskell.Orchard (getSaplingFromUA, isValidUnifiedAddress)
|
import ZcashHaskell.Orchard (getSaplingFromUA, isValidUnifiedAddress)
|
||||||
|
@ -116,8 +118,9 @@ data DisplayType
|
||||||
| SyncDisplay
|
| SyncDisplay
|
||||||
| BlankDisplay
|
| BlankDisplay
|
||||||
|
|
||||||
data Tick =
|
data Tick
|
||||||
Tick
|
= TickVal !Float
|
||||||
|
| TickMsg !String
|
||||||
|
|
||||||
data State = State
|
data State = State
|
||||||
{ _network :: !ZcashNet
|
{ _network :: !ZcashNet
|
||||||
|
@ -140,6 +143,7 @@ data State = State
|
||||||
, _balance :: !Integer
|
, _balance :: !Integer
|
||||||
, _barValue :: !Float
|
, _barValue :: !Float
|
||||||
, _eventDispatch :: !(BC.BChan Tick)
|
, _eventDispatch :: !(BC.BChan Tick)
|
||||||
|
, _timer :: !Int
|
||||||
}
|
}
|
||||||
|
|
||||||
makeLenses ''State
|
makeLenses ''State
|
||||||
|
@ -185,6 +189,7 @@ drawUI s = [splashDialog s, helpDialog s, displayDialog s, inputDialog s, ui s]
|
||||||
, capCommand "A" "ccounts"
|
, capCommand "A" "ccounts"
|
||||||
, capCommand "V" "iew address"
|
, capCommand "V" "iew address"
|
||||||
, capCommand "Q" "uit"
|
, capCommand "Q" "uit"
|
||||||
|
, str $ show (st ^. timer)
|
||||||
])
|
])
|
||||||
listBox :: Show e => String -> L.List Name e -> Widget Name
|
listBox :: Show e => String -> L.List Name e -> Widget Name
|
||||||
listBox titleLabel l =
|
listBox titleLabel l =
|
||||||
|
@ -218,7 +223,12 @@ drawUI s = [splashDialog s, helpDialog s, displayDialog s, inputDialog s, ui s]
|
||||||
(B.borderWithLabel (str titleLabel) $
|
(B.borderWithLabel (str titleLabel) $
|
||||||
hLimit 40 $ vLimit 15 $ L.renderList listDrawAddress True a)
|
hLimit 40 $ vLimit 15 $ L.renderList listDrawAddress True a)
|
||||||
, str " "
|
, str " "
|
||||||
, C.hCenter $ str "Use arrows to select"
|
, C.hCenter
|
||||||
|
(hBox
|
||||||
|
[ capCommand "↑↓ " "move"
|
||||||
|
, capCommand "↲ " "select"
|
||||||
|
, capCommand "Tab " "->"
|
||||||
|
])
|
||||||
]
|
]
|
||||||
listTxBox :: String -> L.List Name (Entity UserTx) -> Widget Name
|
listTxBox :: String -> L.List Name (Entity UserTx) -> Widget Name
|
||||||
listTxBox titleLabel tx =
|
listTxBox titleLabel tx =
|
||||||
|
@ -228,7 +238,12 @@ drawUI s = [splashDialog s, helpDialog s, displayDialog s, inputDialog s, ui s]
|
||||||
(B.borderWithLabel (str titleLabel) $
|
(B.borderWithLabel (str titleLabel) $
|
||||||
hLimit 40 $ vLimit 15 $ L.renderList listDrawTx True tx)
|
hLimit 40 $ vLimit 15 $ L.renderList listDrawTx True tx)
|
||||||
, str " "
|
, str " "
|
||||||
, C.hCenter $ str "Use arrows to select"
|
, C.hCenter
|
||||||
|
(hBox
|
||||||
|
[ capCommand "↑↓ " "move"
|
||||||
|
, capCommand "T" "x Display"
|
||||||
|
, capCommand "Tab " "<-"
|
||||||
|
])
|
||||||
]
|
]
|
||||||
helpDialog :: State -> Widget Name
|
helpDialog :: State -> Widget Name
|
||||||
helpDialog st =
|
helpDialog st =
|
||||||
|
@ -337,7 +352,15 @@ drawUI s = [splashDialog s, helpDialog s, displayDialog s, inputDialog s, ui s]
|
||||||
t_rec =<<
|
t_rec =<<
|
||||||
(isValidUnifiedAddress .
|
(isValidUnifiedAddress .
|
||||||
E.encodeUtf8 . getUA . walletAddressUAddress)
|
E.encodeUtf8 . getUA . walletAddressUAddress)
|
||||||
(entityVal a)))
|
(entityVal a)) <=>
|
||||||
|
C.hCenter
|
||||||
|
(hBox
|
||||||
|
[ str "Copy: "
|
||||||
|
, capCommand "U" "nified"
|
||||||
|
, capCommand "S" "apling"
|
||||||
|
, capCommand "T" "ransparent"
|
||||||
|
]) <=>
|
||||||
|
C.hCenter xCommand)
|
||||||
Nothing -> emptyWidget
|
Nothing -> emptyWidget
|
||||||
PhraseDisplay ->
|
PhraseDisplay ->
|
||||||
case L.listSelectedElement $ st ^. wallets of
|
case L.listSelectedElement $ st ^. wallets of
|
||||||
|
@ -481,60 +504,49 @@ barToDoAttr = A.attrName "remaining"
|
||||||
validBarValue :: Float -> Float
|
validBarValue :: Float -> Float
|
||||||
validBarValue = clamp 0 1
|
validBarValue = clamp 0 1
|
||||||
|
|
||||||
scanZebra :: Int -> BT.EventM Name State ()
|
scanZebra :: T.Text -> T.Text -> Int -> Int -> BC.BChan Tick -> IO ()
|
||||||
scanZebra b = do
|
scanZebra dbP zHost zPort b eChan = do
|
||||||
s <- BT.get
|
_ <- liftIO $ initDb dbP
|
||||||
_ <- liftIO $ initDb $ s ^. dbPath
|
bStatus <- liftIO $ checkBlockChain zHost zPort
|
||||||
bStatus <- liftIO $ checkBlockChain (s ^. zebraHost) (s ^. zebraPort)
|
pool <- runNoLoggingT $ initPool dbP
|
||||||
dbBlock <- liftIO $ getMaxBlock $ s ^. dbPath
|
dbBlock <- runNoLoggingT $ getMaxBlock pool
|
||||||
let sb = max dbBlock b
|
let sb = max dbBlock b
|
||||||
if sb > zgb_blocks bStatus || sb < 1
|
if sb > zgb_blocks bStatus || sb < 1
|
||||||
then do
|
then do
|
||||||
BT.modify $ set msg "Invalid starting block for scan"
|
liftIO $ BC.writeBChan eChan $ TickMsg "Invalid starting block for scan"
|
||||||
BT.modify $ set displayBox MsgDisplay
|
|
||||||
else do
|
else do
|
||||||
let bList = [(sb + 1) .. (zgb_blocks bStatus)]
|
let bList = [(sb + 1) .. (zgb_blocks bStatus)]
|
||||||
let step = (1.0 :: Float) / fromIntegral (zgb_blocks bStatus - (sb + 1))
|
let step = (1.0 :: Float) / fromIntegral (zgb_blocks bStatus - (sb + 1))
|
||||||
mapM_ (processBlock step) bList
|
mapM_ (processBlock pool step) bList
|
||||||
where
|
where
|
||||||
processBlock :: Float -> Int -> BT.EventM Name State ()
|
processBlock :: ConnectionPool -> Float -> Int -> IO ()
|
||||||
processBlock step bl = do
|
processBlock pool step bl = do
|
||||||
s <- BT.get
|
|
||||||
r <-
|
r <-
|
||||||
liftIO $
|
liftIO $
|
||||||
makeZebraCall
|
makeZebraCall
|
||||||
(s ^. zebraHost)
|
zHost
|
||||||
(s ^. zebraPort)
|
zPort
|
||||||
"getblock"
|
"getblock"
|
||||||
[Data.Aeson.String $ T.pack $ show bl, jsonNumber 1]
|
[Data.Aeson.String $ T.pack $ show bl, jsonNumber 1]
|
||||||
case r of
|
case r of
|
||||||
Left e1 -> do
|
Left e1 -> do
|
||||||
BT.modify $ set msg e1
|
liftIO $ BC.writeBChan eChan $ TickMsg e1
|
||||||
BT.modify $ set displayBox MsgDisplay
|
|
||||||
Right blk -> do
|
Right blk -> do
|
||||||
r2 <-
|
r2 <-
|
||||||
liftIO $
|
liftIO $
|
||||||
makeZebraCall
|
makeZebraCall
|
||||||
(s ^. zebraHost)
|
zHost
|
||||||
(s ^. zebraPort)
|
zPort
|
||||||
"getblock"
|
"getblock"
|
||||||
[Data.Aeson.String $ T.pack $ show bl, jsonNumber 0]
|
[Data.Aeson.String $ T.pack $ show bl, jsonNumber 0]
|
||||||
case r2 of
|
case r2 of
|
||||||
Left e2 -> do
|
Left e2 -> do
|
||||||
BT.modify $ set msg e2
|
liftIO $ BC.writeBChan eChan $ TickMsg e2
|
||||||
BT.modify $ set displayBox MsgDisplay
|
|
||||||
Right hb -> do
|
Right hb -> do
|
||||||
let blockTime = getBlockTime hb
|
let blockTime = getBlockTime hb
|
||||||
liftIO $
|
mapM_ (runNoLoggingT . processTx zHost zPort blockTime pool) $
|
||||||
mapM_
|
|
||||||
(processTx
|
|
||||||
(s ^. zebraHost)
|
|
||||||
(s ^. zebraPort)
|
|
||||||
blockTime
|
|
||||||
(s ^. dbPath)) $
|
|
||||||
bl_txs $ addTime blk blockTime
|
bl_txs $ addTime blk blockTime
|
||||||
BT.modify $ set barValue $ validBarValue (s ^. barValue + step)
|
liftIO $ BC.writeBChan eChan $ TickVal step
|
||||||
BT.modify $ set displayBox SyncDisplay
|
|
||||||
addTime :: BlockResponse -> Int -> BlockResponse
|
addTime :: BlockResponse -> Int -> BlockResponse
|
||||||
addTime bl t =
|
addTime bl t =
|
||||||
BlockResponse
|
BlockResponse
|
||||||
|
@ -544,14 +556,69 @@ scanZebra b = do
|
||||||
(bl_txs bl)
|
(bl_txs bl)
|
||||||
|
|
||||||
appEvent :: BT.BrickEvent Name Tick -> BT.EventM Name State ()
|
appEvent :: BT.BrickEvent Name Tick -> BT.EventM Name State ()
|
||||||
appEvent (BT.AppEvent Tick) = do
|
appEvent (BT.AppEvent t) = do
|
||||||
s <- BT.get
|
s <- BT.get
|
||||||
|
pool <- liftIO $ runNoLoggingT $ initPool $ s ^. dbPath
|
||||||
|
case t of
|
||||||
|
TickMsg m -> do
|
||||||
|
BT.modify $ set msg m
|
||||||
|
BT.modify $ set displayBox MsgDisplay
|
||||||
|
TickVal v -> do
|
||||||
case s ^. displayBox of
|
case s ^. displayBox of
|
||||||
|
AddrDisplay -> return ()
|
||||||
|
MsgDisplay -> return ()
|
||||||
|
PhraseDisplay -> return ()
|
||||||
|
TxDisplay -> return ()
|
||||||
SyncDisplay -> do
|
SyncDisplay -> do
|
||||||
if s ^. barValue == 1.0
|
if s ^. barValue == 1.0
|
||||||
then BT.modify $ set displayBox BlankDisplay
|
then do
|
||||||
else BT.modify $ set displayBox SyncDisplay
|
selWallet <-
|
||||||
_ -> return ()
|
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
|
||||||
|
_ <-
|
||||||
|
liftIO $
|
||||||
|
syncWallet
|
||||||
|
(Config (s ^. dbPath) (s ^. zebraHost) (s ^. zebraPort))
|
||||||
|
selWallet
|
||||||
|
BT.modify $ set displayBox BlankDisplay
|
||||||
|
BT.modify $ set barValue 0.0
|
||||||
|
updatedState <- BT.get
|
||||||
|
ns <- liftIO $ refreshWallet updatedState
|
||||||
|
BT.put ns
|
||||||
|
else BT.modify $ set barValue $ validBarValue (v + s ^. barValue)
|
||||||
|
BlankDisplay -> do
|
||||||
|
case s ^. dialogBox of
|
||||||
|
AName -> return ()
|
||||||
|
AdName -> return ()
|
||||||
|
WName -> return ()
|
||||||
|
WSelect -> return ()
|
||||||
|
ASelect -> return ()
|
||||||
|
Blank -> do
|
||||||
|
if s ^. timer == 90
|
||||||
|
then do
|
||||||
|
BT.modify $ set barValue 0.0
|
||||||
|
BT.modify $ set displayBox SyncDisplay
|
||||||
|
sBlock <- liftIO $ getMinBirthdayHeight pool
|
||||||
|
_ <-
|
||||||
|
liftIO $
|
||||||
|
forkIO $
|
||||||
|
scanZebra
|
||||||
|
(s ^. dbPath)
|
||||||
|
(s ^. zebraHost)
|
||||||
|
(s ^. zebraPort)
|
||||||
|
sBlock
|
||||||
|
(s ^. eventDispatch)
|
||||||
|
BT.modify $ set timer 0
|
||||||
|
return ()
|
||||||
|
else do
|
||||||
|
BT.modify $ set timer $ 1 + s ^. timer
|
||||||
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
|
||||||
|
@ -565,33 +632,47 @@ appEvent (BT.VtyEvent e) = do
|
||||||
_ev -> return ()
|
_ev -> return ()
|
||||||
else do
|
else do
|
||||||
case s ^. displayBox of
|
case s ^. displayBox of
|
||||||
AddrDisplay -> BT.modify $ set displayBox BlankDisplay
|
AddrDisplay -> do
|
||||||
|
case e of
|
||||||
|
V.EvKey (V.KChar 'x') [] ->
|
||||||
|
BT.modify $ set displayBox BlankDisplay
|
||||||
|
V.EvKey (V.KChar 'u') [] -> do
|
||||||
|
case L.listSelectedElement $ s ^. addresses of
|
||||||
|
Just (_, a) -> do
|
||||||
|
liftIO $
|
||||||
|
setClipboard $
|
||||||
|
T.unpack $
|
||||||
|
getUA $ walletAddressUAddress $ entityVal a
|
||||||
|
Nothing -> return ()
|
||||||
|
V.EvKey (V.KChar 's') [] -> do
|
||||||
|
case L.listSelectedElement $ s ^. addresses of
|
||||||
|
Just (_, a) -> do
|
||||||
|
liftIO $
|
||||||
|
setClipboard $
|
||||||
|
maybe "None" T.unpack $
|
||||||
|
getSaplingFromUA $
|
||||||
|
E.encodeUtf8 $
|
||||||
|
getUA $ walletAddressUAddress $ entityVal a
|
||||||
|
Nothing -> return ()
|
||||||
|
V.EvKey (V.KChar 't') [] -> do
|
||||||
|
case L.listSelectedElement $ s ^. addresses of
|
||||||
|
Just (_, a) -> do
|
||||||
|
liftIO $
|
||||||
|
setClipboard $
|
||||||
|
T.unpack $
|
||||||
|
maybe
|
||||||
|
"None"
|
||||||
|
(encodeTransparentReceiver (s ^. network)) $
|
||||||
|
t_rec =<<
|
||||||
|
(isValidUnifiedAddress .
|
||||||
|
E.encodeUtf8 . getUA . walletAddressUAddress)
|
||||||
|
(entityVal a)
|
||||||
|
Nothing -> return ()
|
||||||
|
_ev -> return ()
|
||||||
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
|
SyncDisplay -> BT.modify $ set displayBox BlankDisplay
|
||||||
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
|
||||||
|
@ -693,9 +774,6 @@ 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 ->
|
||||||
|
@ -740,6 +818,7 @@ runZenithCLI config = do
|
||||||
let host = c_zebraHost config
|
let host = c_zebraHost config
|
||||||
let port = c_zebraPort config
|
let port = c_zebraPort config
|
||||||
let dbFilePath = c_dbPath config
|
let dbFilePath = c_dbPath config
|
||||||
|
pool <- runNoLoggingT $ initPool dbFilePath
|
||||||
w <- try $ checkZebra host port :: IO (Either IOError ZebraGetInfo)
|
w <- try $ checkZebra host port :: IO (Either IOError ZebraGetInfo)
|
||||||
case w of
|
case w of
|
||||||
Right zebra -> do
|
Right zebra -> do
|
||||||
|
@ -750,18 +829,18 @@ runZenithCLI config = do
|
||||||
Left e1 -> throwIO e1
|
Left e1 -> throwIO e1
|
||||||
Right chainInfo -> do
|
Right chainInfo -> do
|
||||||
initDb dbFilePath
|
initDb dbFilePath
|
||||||
walList <- getWallets dbFilePath $ zgb_net chainInfo
|
walList <- getWallets pool $ zgb_net chainInfo
|
||||||
accList <-
|
accList <-
|
||||||
if not (null walList)
|
if not (null walList)
|
||||||
then getAccounts dbFilePath $ entityKey $ head walList
|
then runNoLoggingT $ getAccounts pool $ entityKey $ head walList
|
||||||
else return []
|
else return []
|
||||||
addrList <-
|
addrList <-
|
||||||
if not (null accList)
|
if not (null accList)
|
||||||
then getAddresses dbFilePath $ entityKey $ head accList
|
then runNoLoggingT $ getAddresses pool $ entityKey $ head accList
|
||||||
else return []
|
else return []
|
||||||
txList <-
|
txList <-
|
||||||
if not (null addrList)
|
if not (null addrList)
|
||||||
then getUserTx dbFilePath $ entityKey $ head addrList
|
then getUserTx pool $ entityKey $ head addrList
|
||||||
else return []
|
else return []
|
||||||
let block =
|
let block =
|
||||||
if not (null walList)
|
if not (null walList)
|
||||||
|
@ -769,9 +848,14 @@ runZenithCLI config = do
|
||||||
else 0
|
else 0
|
||||||
bal <-
|
bal <-
|
||||||
if not (null accList)
|
if not (null accList)
|
||||||
then getBalance dbFilePath $ entityKey $ head accList
|
then getBalance pool $ entityKey $ head accList
|
||||||
else return 0
|
else return 0
|
||||||
eventChan <- BC.newBChan 10
|
eventChan <- BC.newBChan 10
|
||||||
|
_ <-
|
||||||
|
forkIO $
|
||||||
|
forever $ do
|
||||||
|
BC.writeBChan eventChan (TickVal 0.0)
|
||||||
|
threadDelay 1000000
|
||||||
let buildVty = VC.mkVty V.defaultConfig
|
let buildVty = VC.mkVty V.defaultConfig
|
||||||
initialVty <- buildVty
|
initialVty <- buildVty
|
||||||
void $
|
void $
|
||||||
|
@ -800,6 +884,7 @@ runZenithCLI config = do
|
||||||
bal
|
bal
|
||||||
1.0
|
1.0
|
||||||
eventChan
|
eventChan
|
||||||
|
0
|
||||||
Left e -> do
|
Left e -> do
|
||||||
print $
|
print $
|
||||||
"No Zebra node available on port " <>
|
"No Zebra node available on port " <>
|
||||||
|
@ -807,34 +892,38 @@ runZenithCLI config = do
|
||||||
|
|
||||||
refreshWallet :: State -> IO State
|
refreshWallet :: State -> IO State
|
||||||
refreshWallet s = do
|
refreshWallet s = do
|
||||||
selWallet <-
|
pool <- runNoLoggingT $ initPool $ s ^. dbPath
|
||||||
|
walList <- getWallets pool $ s ^. network
|
||||||
|
(ix, selWallet) <-
|
||||||
do case L.listSelectedElement $ s ^. wallets of
|
do case L.listSelectedElement $ s ^. wallets of
|
||||||
Nothing -> do
|
Nothing -> do
|
||||||
let fWall =
|
let fWall =
|
||||||
L.listSelectedElement $ L.listMoveToBeginning $ s ^. wallets
|
L.listSelectedElement $ L.listMoveToBeginning $ s ^. wallets
|
||||||
case fWall of
|
case fWall of
|
||||||
Nothing -> throw $ userError "Failed to select wallet"
|
Nothing -> throw $ userError "Failed to select wallet"
|
||||||
Just (_j, w1) -> return w1
|
Just (j, w1) -> return (j, w1)
|
||||||
Just (_k, w) -> return w
|
Just (k, w) -> return (k, w)
|
||||||
aL <- getAccounts (s ^. dbPath) $ entityKey selWallet
|
aL <- runNoLoggingT $ getAccounts pool $ entityKey selWallet
|
||||||
let bl = zcashWalletLastSync $ entityVal selWallet
|
let bl = zcashWalletLastSync $ entityVal selWallet
|
||||||
addrL <-
|
addrL <-
|
||||||
if not (null aL)
|
if not (null aL)
|
||||||
then getAddresses (s ^. dbPath) $ entityKey $ head aL
|
then runNoLoggingT $ getAddresses pool $ entityKey $ head aL
|
||||||
else return []
|
else return []
|
||||||
bal <-
|
bal <-
|
||||||
if not (null aL)
|
if not (null aL)
|
||||||
then getBalance (s ^. dbPath) $ entityKey $ head aL
|
then getBalance pool $ entityKey $ head aL
|
||||||
else return 0
|
else return 0
|
||||||
txL <-
|
txL <-
|
||||||
if not (null addrL)
|
if not (null addrL)
|
||||||
then getUserTx (s ^. dbPath) $ entityKey $ head addrL
|
then getUserTx pool $ entityKey $ head addrL
|
||||||
else return []
|
else return []
|
||||||
|
let wL = L.listReplace (Vec.fromList walList) (Just ix) (s ^. wallets)
|
||||||
let aL' = L.listReplace (Vec.fromList aL) (Just 0) (s ^. accounts)
|
let aL' = L.listReplace (Vec.fromList aL) (Just 0) (s ^. accounts)
|
||||||
let addrL' = L.listReplace (Vec.fromList addrL) (Just 0) (s ^. addresses)
|
let addrL' = L.listReplace (Vec.fromList addrL) (Just 0) (s ^. addresses)
|
||||||
let txL' = L.listReplace (Vec.fromList txL) (Just 0) (s ^. transactions)
|
let txL' = L.listReplace (Vec.fromList txL) (Just 0) (s ^. transactions)
|
||||||
return $
|
return $
|
||||||
(s & accounts .~ aL') & syncBlock .~ bl & balance .~ bal & addresses .~
|
s & wallets .~ wL & accounts .~ aL' & syncBlock .~ bl & balance .~ bal &
|
||||||
|
addresses .~
|
||||||
addrL' &
|
addrL' &
|
||||||
transactions .~
|
transactions .~
|
||||||
txL' &
|
txL' &
|
||||||
|
@ -845,16 +934,15 @@ refreshWallet s = do
|
||||||
addNewWallet :: T.Text -> State -> IO State
|
addNewWallet :: T.Text -> State -> IO State
|
||||||
addNewWallet n s = do
|
addNewWallet n s = do
|
||||||
sP <- generateWalletSeedPhrase
|
sP <- generateWalletSeedPhrase
|
||||||
|
pool <- runNoLoggingT $ initPool $ s ^. dbPath
|
||||||
let bH = s ^. startBlock
|
let bH = s ^. startBlock
|
||||||
let netName = s ^. network
|
let netName = s ^. network
|
||||||
r <-
|
r <- saveWallet pool $ ZcashWallet n (ZcashNetDB netName) (PhraseDB sP) bH 0
|
||||||
saveWallet (s ^. dbPath) $
|
|
||||||
ZcashWallet n (ZcashNetDB netName) (PhraseDB sP) bH 0
|
|
||||||
case r of
|
case r of
|
||||||
Nothing -> do
|
Nothing -> do
|
||||||
return $ s & msg .~ ("Wallet already exists: " ++ T.unpack n)
|
return $ s & msg .~ ("Wallet already exists: " ++ T.unpack n)
|
||||||
Just _ -> do
|
Just _ -> do
|
||||||
wL <- getWallets (s ^. dbPath) netName
|
wL <- getWallets pool netName
|
||||||
let aL =
|
let aL =
|
||||||
L.listFindBy (\x -> zcashWalletName (entityVal x) == n) $
|
L.listFindBy (\x -> zcashWalletName (entityVal x) == n) $
|
||||||
L.listReplace (Vec.fromList wL) (Just 0) (s ^. wallets)
|
L.listReplace (Vec.fromList wL) (Just 0) (s ^. wallets)
|
||||||
|
@ -862,6 +950,7 @@ addNewWallet n s = do
|
||||||
|
|
||||||
addNewAccount :: T.Text -> State -> IO State
|
addNewAccount :: T.Text -> State -> IO State
|
||||||
addNewAccount n s = do
|
addNewAccount n s = do
|
||||||
|
pool <- runNoLoggingT $ initPool $ s ^. dbPath
|
||||||
selWallet <-
|
selWallet <-
|
||||||
do case L.listSelectedElement $ s ^. wallets of
|
do case L.listSelectedElement $ s ^. wallets of
|
||||||
Nothing -> do
|
Nothing -> do
|
||||||
|
@ -871,19 +960,19 @@ addNewAccount n s = do
|
||||||
Nothing -> throw $ userError "Failed to select wallet"
|
Nothing -> throw $ userError "Failed to select wallet"
|
||||||
Just (_j, w1) -> return w1
|
Just (_j, w1) -> return w1
|
||||||
Just (_k, w) -> return w
|
Just (_k, w) -> return w
|
||||||
aL' <- getMaxAccount (s ^. dbPath) (entityKey selWallet)
|
aL' <- getMaxAccount pool (entityKey selWallet)
|
||||||
zA <-
|
zA <-
|
||||||
try $ createZcashAccount n (aL' + 1) selWallet :: IO
|
try $ createZcashAccount n (aL' + 1) selWallet :: IO
|
||||||
(Either IOError ZcashAccount)
|
(Either IOError ZcashAccount)
|
||||||
case zA of
|
case zA of
|
||||||
Left e -> return $ s & msg .~ ("Error: " ++ show e)
|
Left e -> return $ s & msg .~ ("Error: " ++ show e)
|
||||||
Right zA' -> do
|
Right zA' -> do
|
||||||
r <- saveAccount (s ^. dbPath) zA'
|
r <- saveAccount pool zA'
|
||||||
case r of
|
case r of
|
||||||
Nothing ->
|
Nothing ->
|
||||||
return $ s & msg .~ ("Account already exists: " ++ T.unpack n)
|
return $ s & msg .~ ("Account already exists: " ++ T.unpack n)
|
||||||
Just x -> do
|
Just x -> do
|
||||||
aL <- getAccounts (s ^. dbPath) (entityKey selWallet)
|
aL <- runNoLoggingT $ getAccounts pool (entityKey selWallet)
|
||||||
let nL =
|
let nL =
|
||||||
L.listMoveToElement x $
|
L.listMoveToElement x $
|
||||||
L.listReplace (Vec.fromList aL) (Just 0) (s ^. accounts)
|
L.listReplace (Vec.fromList aL) (Just 0) (s ^. accounts)
|
||||||
|
@ -892,6 +981,7 @@ addNewAccount n s = do
|
||||||
|
|
||||||
refreshAccount :: State -> IO State
|
refreshAccount :: State -> IO State
|
||||||
refreshAccount s = do
|
refreshAccount s = do
|
||||||
|
pool <- runNoLoggingT $ initPool $ s ^. dbPath
|
||||||
selAccount <-
|
selAccount <-
|
||||||
do case L.listSelectedElement $ s ^. accounts of
|
do case L.listSelectedElement $ s ^. accounts of
|
||||||
Nothing -> do
|
Nothing -> do
|
||||||
|
@ -901,8 +991,8 @@ refreshAccount s = do
|
||||||
Nothing -> throw $ userError "Failed to select account"
|
Nothing -> throw $ userError "Failed to select account"
|
||||||
Just (_j, w1) -> return w1
|
Just (_j, w1) -> return w1
|
||||||
Just (_k, w) -> return w
|
Just (_k, w) -> return w
|
||||||
aL <- getAddresses (s ^. dbPath) $ entityKey selAccount
|
aL <- runNoLoggingT $ getAddresses pool $ entityKey selAccount
|
||||||
bal <- getBalance (s ^. dbPath) $ entityKey selAccount
|
bal <- getBalance pool $ entityKey selAccount
|
||||||
let aL' = L.listReplace (Vec.fromList aL) (Just 0) (s ^. addresses)
|
let aL' = L.listReplace (Vec.fromList aL) (Just 0) (s ^. addresses)
|
||||||
selAddress <-
|
selAddress <-
|
||||||
do case L.listSelectedElement aL' of
|
do case L.listSelectedElement aL' of
|
||||||
|
@ -916,7 +1006,7 @@ refreshAccount s = do
|
||||||
s & balance .~ bal & addresses .~ aL' & msg .~ "Switched to account: " ++
|
s & balance .~ bal & addresses .~ aL' & msg .~ "Switched to account: " ++
|
||||||
T.unpack (zcashAccountName $ entityVal selAccount)
|
T.unpack (zcashAccountName $ entityVal selAccount)
|
||||||
Just (_i, a) -> do
|
Just (_i, a) -> do
|
||||||
tList <- getUserTx (s ^. dbPath) $ entityKey a
|
tList <- getUserTx pool $ entityKey a
|
||||||
let tL' = L.listReplace (Vec.fromList tList) (Just 0) (s ^. transactions)
|
let tL' = L.listReplace (Vec.fromList tList) (Just 0) (s ^. transactions)
|
||||||
return $
|
return $
|
||||||
s & balance .~ bal & addresses .~ aL' & transactions .~ tL' & msg .~
|
s & balance .~ bal & addresses .~ aL' & transactions .~ tL' & msg .~
|
||||||
|
@ -925,6 +1015,7 @@ refreshAccount s = do
|
||||||
|
|
||||||
refreshTxs :: State -> IO State
|
refreshTxs :: State -> IO State
|
||||||
refreshTxs s = do
|
refreshTxs s = do
|
||||||
|
pool <- runNoLoggingT $ initPool $ s ^. dbPath
|
||||||
selAddress <-
|
selAddress <-
|
||||||
do case L.listSelectedElement $ s ^. addresses of
|
do case L.listSelectedElement $ s ^. addresses of
|
||||||
Nothing -> do
|
Nothing -> do
|
||||||
|
@ -935,12 +1026,13 @@ refreshTxs s = do
|
||||||
case selAddress of
|
case selAddress of
|
||||||
Nothing -> return s
|
Nothing -> return s
|
||||||
Just (_i, a) -> do
|
Just (_i, a) -> do
|
||||||
tList <- getUserTx (s ^. dbPath) $ entityKey a
|
tList <- getUserTx pool $ entityKey a
|
||||||
let tL' = L.listReplace (Vec.fromList tList) (Just 0) (s ^. transactions)
|
let tL' = L.listReplace (Vec.fromList tList) (Just 0) (s ^. transactions)
|
||||||
return $ s & transactions .~ tL'
|
return $ s & transactions .~ tL'
|
||||||
|
|
||||||
addNewAddress :: T.Text -> Scope -> State -> IO State
|
addNewAddress :: T.Text -> Scope -> State -> IO State
|
||||||
addNewAddress n scope s = do
|
addNewAddress n scope s = do
|
||||||
|
pool <- runNoLoggingT $ initPool $ s ^. dbPath
|
||||||
selAccount <-
|
selAccount <-
|
||||||
do case L.listSelectedElement $ s ^. accounts of
|
do case L.listSelectedElement $ s ^. accounts of
|
||||||
Nothing -> do
|
Nothing -> do
|
||||||
|
@ -950,19 +1042,19 @@ addNewAddress n scope s = do
|
||||||
Nothing -> throw $ userError "Failed to select account"
|
Nothing -> throw $ userError "Failed to select account"
|
||||||
Just (_j, a1) -> return a1
|
Just (_j, a1) -> return a1
|
||||||
Just (_k, a) -> return a
|
Just (_k, a) -> return a
|
||||||
maxAddr <- getMaxAddress (s ^. dbPath) (entityKey selAccount) scope
|
maxAddr <- getMaxAddress pool (entityKey selAccount) scope
|
||||||
uA <-
|
uA <-
|
||||||
try $ createWalletAddress n (maxAddr + 1) (s ^. network) scope selAccount :: IO
|
try $ createWalletAddress n (maxAddr + 1) (s ^. network) scope selAccount :: IO
|
||||||
(Either IOError WalletAddress)
|
(Either IOError WalletAddress)
|
||||||
case uA of
|
case uA of
|
||||||
Left e -> return $ s & msg .~ ("Error: " ++ show e)
|
Left e -> return $ s & msg .~ ("Error: " ++ show e)
|
||||||
Right uA' -> do
|
Right uA' -> do
|
||||||
nAddr <- saveAddress (s ^. dbPath) uA'
|
nAddr <- saveAddress pool uA'
|
||||||
case nAddr of
|
case nAddr of
|
||||||
Nothing ->
|
Nothing ->
|
||||||
return $ s & msg .~ ("Address already exists: " ++ T.unpack n)
|
return $ s & msg .~ ("Address already exists: " ++ T.unpack n)
|
||||||
Just x -> do
|
Just x -> do
|
||||||
addrL <- getAddresses (s ^. dbPath) (entityKey selAccount)
|
addrL <- runNoLoggingT $ getAddresses pool (entityKey selAccount)
|
||||||
let nL =
|
let nL =
|
||||||
L.listMoveToElement x $
|
L.listMoveToElement x $
|
||||||
L.listReplace (Vec.fromList addrL) (Just 0) (s ^. addresses)
|
L.listReplace (Vec.fromList addrL) (Just 0) (s ^. addresses)
|
||||||
|
|
|
@ -9,9 +9,11 @@ import Control.Monad.IO.Class (liftIO)
|
||||||
import Control.Monad.Logger
|
import Control.Monad.Logger
|
||||||
( LoggingT
|
( LoggingT
|
||||||
, MonadLoggerIO
|
, MonadLoggerIO
|
||||||
|
, NoLoggingT
|
||||||
, logInfoN
|
, logInfoN
|
||||||
, logWarnN
|
, logWarnN
|
||||||
, runFileLoggingT
|
, runFileLoggingT
|
||||||
|
, runNoLoggingT
|
||||||
, runStdoutLoggingT
|
, runStdoutLoggingT
|
||||||
)
|
)
|
||||||
import Crypto.Secp256k1 (SecKey(..))
|
import Crypto.Secp256k1 (SecKey(..))
|
||||||
|
@ -31,6 +33,7 @@ import Database.Persist
|
||||||
import Database.Persist.Sqlite
|
import Database.Persist.Sqlite
|
||||||
import GHC.Float.RealFracMethods (floorFloatInteger)
|
import GHC.Float.RealFracMethods (floorFloatInteger)
|
||||||
import Haskoin.Crypto.Keys (XPrvKey(..))
|
import Haskoin.Crypto.Keys (XPrvKey(..))
|
||||||
|
import Lens.Micro ((&), (.~), (^.), set)
|
||||||
import Network.HTTP.Client
|
import Network.HTTP.Client
|
||||||
import ZcashHaskell.Keys
|
import ZcashHaskell.Keys
|
||||||
import ZcashHaskell.Orchard
|
import ZcashHaskell.Orchard
|
||||||
|
@ -230,22 +233,24 @@ findSaplingOutputs config b znet za = do
|
||||||
let zebraHost = c_zebraHost config
|
let zebraHost = c_zebraHost config
|
||||||
let zebraPort = c_zebraPort config
|
let zebraPort = c_zebraPort config
|
||||||
let zn = getNet znet
|
let zn = getNet znet
|
||||||
tList <- getShieldedOutputs dbPath b
|
pool <- runNoLoggingT $ initPool dbPath
|
||||||
|
tList <- getShieldedOutputs pool b
|
||||||
trees <- getCommitmentTrees zebraHost zebraPort (b - 1)
|
trees <- getCommitmentTrees zebraHost zebraPort (b - 1)
|
||||||
let sT = SaplingCommitmentTree $ ztiSapling trees
|
let sT = SaplingCommitmentTree $ ztiSapling trees
|
||||||
decryptNotes sT zn tList
|
decryptNotes sT zn pool tList
|
||||||
sapNotes <- getWalletSapNotes dbPath (entityKey za)
|
sapNotes <- getWalletSapNotes pool (entityKey za)
|
||||||
findSapSpends dbPath (entityKey za) sapNotes
|
findSapSpends pool (entityKey za) sapNotes
|
||||||
where
|
where
|
||||||
sk :: SaplingSpendingKeyDB
|
sk :: SaplingSpendingKeyDB
|
||||||
sk = zcashAccountSapSpendKey $ entityVal za
|
sk = zcashAccountSapSpendKey $ entityVal za
|
||||||
decryptNotes ::
|
decryptNotes ::
|
||||||
SaplingCommitmentTree
|
SaplingCommitmentTree
|
||||||
-> ZcashNet
|
-> ZcashNet
|
||||||
|
-> ConnectionPool
|
||||||
-> [(Entity ZcashTransaction, Entity ShieldOutput)]
|
-> [(Entity ZcashTransaction, Entity ShieldOutput)]
|
||||||
-> IO ()
|
-> IO ()
|
||||||
decryptNotes _ _ [] = return ()
|
decryptNotes _ _ _ [] = return ()
|
||||||
decryptNotes st n ((zt, o):txs) = do
|
decryptNotes st n pool ((zt, o):txs) = do
|
||||||
let updatedTree =
|
let updatedTree =
|
||||||
updateSaplingCommitmentTree
|
updateSaplingCommitmentTree
|
||||||
st
|
st
|
||||||
|
@ -262,15 +267,11 @@ findSaplingOutputs config b znet za = do
|
||||||
Nothing -> do
|
Nothing -> do
|
||||||
case decodeShOut Internal n nP o of
|
case decodeShOut Internal n nP o of
|
||||||
Nothing -> do
|
Nothing -> do
|
||||||
decryptNotes uT n txs
|
decryptNotes uT n pool txs
|
||||||
Just dn1 -> do
|
Just dn1 -> do
|
||||||
wId <-
|
wId <- saveWalletTransaction pool (entityKey za) zt
|
||||||
saveWalletTransaction
|
|
||||||
(c_dbPath config)
|
|
||||||
(entityKey za)
|
|
||||||
zt
|
|
||||||
saveWalletSapNote
|
saveWalletSapNote
|
||||||
(c_dbPath config)
|
pool
|
||||||
wId
|
wId
|
||||||
nP
|
nP
|
||||||
(fromJust noteWitness)
|
(fromJust noteWitness)
|
||||||
|
@ -278,12 +279,11 @@ findSaplingOutputs config b znet za = do
|
||||||
(entityKey za)
|
(entityKey za)
|
||||||
(entityKey o)
|
(entityKey o)
|
||||||
dn1
|
dn1
|
||||||
decryptNotes uT n txs
|
decryptNotes uT n pool txs
|
||||||
Just dn0 -> do
|
Just dn0 -> do
|
||||||
wId <-
|
wId <- saveWalletTransaction pool (entityKey za) zt
|
||||||
saveWalletTransaction (c_dbPath config) (entityKey za) zt
|
|
||||||
saveWalletSapNote
|
saveWalletSapNote
|
||||||
(c_dbPath config)
|
pool
|
||||||
wId
|
wId
|
||||||
nP
|
nP
|
||||||
(fromJust noteWitness)
|
(fromJust noteWitness)
|
||||||
|
@ -291,7 +291,7 @@ findSaplingOutputs config b znet za = do
|
||||||
(entityKey za)
|
(entityKey za)
|
||||||
(entityKey o)
|
(entityKey o)
|
||||||
dn0
|
dn0
|
||||||
decryptNotes uT n txs
|
decryptNotes uT n pool txs
|
||||||
decodeShOut ::
|
decodeShOut ::
|
||||||
Scope
|
Scope
|
||||||
-> ZcashNet
|
-> ZcashNet
|
||||||
|
@ -324,20 +324,22 @@ findOrchardActions config b znet za = do
|
||||||
let zebraHost = c_zebraHost config
|
let zebraHost = c_zebraHost config
|
||||||
let zebraPort = c_zebraPort config
|
let zebraPort = c_zebraPort config
|
||||||
let zn = getNet znet
|
let zn = getNet znet
|
||||||
tList <- getOrchardActions dbPath b
|
pool <- runNoLoggingT $ initPool dbPath
|
||||||
|
tList <- getOrchardActions pool b
|
||||||
trees <- getCommitmentTrees zebraHost zebraPort (b - 1)
|
trees <- getCommitmentTrees zebraHost zebraPort (b - 1)
|
||||||
let sT = OrchardCommitmentTree $ ztiOrchard trees
|
let sT = OrchardCommitmentTree $ ztiOrchard trees
|
||||||
decryptNotes sT zn tList
|
decryptNotes sT zn pool tList
|
||||||
orchNotes <- getWalletOrchNotes dbPath (entityKey za)
|
orchNotes <- getWalletOrchNotes pool (entityKey za)
|
||||||
findOrchSpends dbPath (entityKey za) orchNotes
|
findOrchSpends pool (entityKey za) orchNotes
|
||||||
where
|
where
|
||||||
decryptNotes ::
|
decryptNotes ::
|
||||||
OrchardCommitmentTree
|
OrchardCommitmentTree
|
||||||
-> ZcashNet
|
-> ZcashNet
|
||||||
|
-> ConnectionPool
|
||||||
-> [(Entity ZcashTransaction, Entity OrchAction)]
|
-> [(Entity ZcashTransaction, Entity OrchAction)]
|
||||||
-> IO ()
|
-> IO ()
|
||||||
decryptNotes _ _ [] = return ()
|
decryptNotes _ _ _ [] = return ()
|
||||||
decryptNotes ot n ((zt, o):txs) = do
|
decryptNotes ot n pool ((zt, o):txs) = do
|
||||||
let updatedTree =
|
let updatedTree =
|
||||||
updateOrchardCommitmentTree
|
updateOrchardCommitmentTree
|
||||||
ot
|
ot
|
||||||
|
@ -353,15 +355,11 @@ findOrchardActions config b znet za = do
|
||||||
case decodeOrchAction External nP o of
|
case decodeOrchAction External nP o of
|
||||||
Nothing ->
|
Nothing ->
|
||||||
case decodeOrchAction Internal nP o of
|
case decodeOrchAction Internal nP o of
|
||||||
Nothing -> decryptNotes uT n txs
|
Nothing -> decryptNotes uT n pool txs
|
||||||
Just dn1 -> do
|
Just dn1 -> do
|
||||||
wId <-
|
wId <- saveWalletTransaction pool (entityKey za) zt
|
||||||
saveWalletTransaction
|
|
||||||
(c_dbPath config)
|
|
||||||
(entityKey za)
|
|
||||||
zt
|
|
||||||
saveWalletOrchNote
|
saveWalletOrchNote
|
||||||
(c_dbPath config)
|
pool
|
||||||
wId
|
wId
|
||||||
nP
|
nP
|
||||||
(fromJust noteWitness)
|
(fromJust noteWitness)
|
||||||
|
@ -369,12 +367,11 @@ findOrchardActions config b znet za = do
|
||||||
(entityKey za)
|
(entityKey za)
|
||||||
(entityKey o)
|
(entityKey o)
|
||||||
dn1
|
dn1
|
||||||
decryptNotes uT n txs
|
decryptNotes uT n pool txs
|
||||||
Just dn -> do
|
Just dn -> do
|
||||||
wId <-
|
wId <- saveWalletTransaction pool (entityKey za) zt
|
||||||
saveWalletTransaction (c_dbPath config) (entityKey za) zt
|
|
||||||
saveWalletOrchNote
|
saveWalletOrchNote
|
||||||
(c_dbPath config)
|
pool
|
||||||
wId
|
wId
|
||||||
nP
|
nP
|
||||||
(fromJust noteWitness)
|
(fromJust noteWitness)
|
||||||
|
@ -382,7 +379,7 @@ findOrchardActions config b znet za = do
|
||||||
(entityKey za)
|
(entityKey za)
|
||||||
(entityKey o)
|
(entityKey o)
|
||||||
dn
|
dn
|
||||||
decryptNotes uT n txs
|
decryptNotes uT n pool txs
|
||||||
sk :: OrchardSpendingKeyDB
|
sk :: OrchardSpendingKeyDB
|
||||||
sk = zcashAccountOrchSpendKey $ entityVal za
|
sk = zcashAccountOrchSpendKey $ entityVal za
|
||||||
decodeOrchAction ::
|
decodeOrchAction ::
|
||||||
|
@ -399,48 +396,34 @@ 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 :: ConnectionPool -> IO ()
|
||||||
updateSaplingWitnesses dbPath = do
|
updateSaplingWitnesses pool = do
|
||||||
sapNotes <- liftIO $ getUnspentSapNotes dbPath
|
sapNotes <- getUnspentSapNotes pool
|
||||||
pool <- createSqlitePool dbPath 5
|
|
||||||
maxId <- liftIO $ getMaxSaplingNote pool
|
maxId <- liftIO $ getMaxSaplingNote pool
|
||||||
mapM_ (updateOneNote pool maxId) sapNotes
|
mapM_ (updateOneNote maxId) sapNotes
|
||||||
where
|
where
|
||||||
updateOneNote ::
|
updateOneNote :: ShieldOutputId -> Entity WalletSapNote -> IO ()
|
||||||
Pool SqlBackend
|
updateOneNote maxId n = do
|
||||||
-> ShieldOutputId
|
|
||||||
-> Entity WalletSapNote
|
|
||||||
-> LoggingT IO ()
|
|
||||||
updateOneNote pool maxId n = do
|
|
||||||
let noteSync = walletSapNoteWitPos $ entityVal n
|
let noteSync = walletSapNoteWitPos $ entityVal n
|
||||||
if noteSync < maxId
|
when (noteSync < maxId) $ do
|
||||||
then do
|
cmus <- liftIO $ getSaplingCmus pool $ walletSapNoteWitPos $ entityVal n
|
||||||
cmus <-
|
|
||||||
liftIO $ getSaplingCmus pool $ walletSapNoteWitPos $ entityVal n
|
|
||||||
let cmuList = map (\(ESQ.Value x) -> getHex x) cmus
|
let cmuList = map (\(ESQ.Value x) -> getHex x) cmus
|
||||||
let newWitness =
|
let newWitness =
|
||||||
updateSaplingWitness
|
updateSaplingWitness
|
||||||
(SaplingWitness $ getHex $ walletSapNoteWitness $ entityVal n)
|
(SaplingWitness $ getHex $ walletSapNoteWitness $ entityVal n)
|
||||||
cmuList
|
cmuList
|
||||||
liftIO $ updateSapNoteRecord pool (entityKey n) newWitness maxId
|
liftIO $ updateSapNoteRecord pool (entityKey n) newWitness maxId
|
||||||
else logInfoN "Witness up to date"
|
|
||||||
|
|
||||||
updateOrchardWitnesses :: T.Text -> LoggingT IO ()
|
updateOrchardWitnesses :: ConnectionPool -> IO ()
|
||||||
updateOrchardWitnesses dbPath = do
|
updateOrchardWitnesses pool = do
|
||||||
orchNotes <- liftIO $ getUnspentOrchNotes dbPath
|
orchNotes <- getUnspentOrchNotes pool
|
||||||
pool <- createSqlitePool dbPath 5
|
maxId <- getMaxOrchardNote pool
|
||||||
maxId <- liftIO $ getMaxOrchardNote pool
|
mapM_ (updateOneNote maxId) orchNotes
|
||||||
mapM_ (updateOneNote pool maxId) orchNotes
|
|
||||||
where
|
where
|
||||||
updateOneNote ::
|
updateOneNote :: OrchActionId -> Entity WalletOrchNote -> IO ()
|
||||||
Pool SqlBackend
|
updateOneNote maxId n = do
|
||||||
-> OrchActionId
|
|
||||||
-> Entity WalletOrchNote
|
|
||||||
-> LoggingT IO ()
|
|
||||||
updateOneNote pool maxId n = do
|
|
||||||
let noteSync = walletOrchNoteWitPos $ entityVal n
|
let noteSync = walletOrchNoteWitPos $ entityVal n
|
||||||
if noteSync < maxId
|
when (noteSync < maxId) $ do
|
||||||
then do
|
|
||||||
cmxs <- liftIO $ getOrchardCmxs pool noteSync
|
cmxs <- liftIO $ getOrchardCmxs pool noteSync
|
||||||
let cmxList = map (\(ESQ.Value x) -> getHex x) cmxs
|
let cmxList = map (\(ESQ.Value x) -> getHex x) cmxs
|
||||||
let newWitness =
|
let newWitness =
|
||||||
|
@ -448,7 +431,6 @@ updateOrchardWitnesses dbPath = do
|
||||||
(OrchardWitness $ getHex $ walletOrchNoteWitness $ entityVal n)
|
(OrchardWitness $ getHex $ walletOrchNoteWitness $ entityVal n)
|
||||||
cmxList
|
cmxList
|
||||||
liftIO $ updateOrchNoteRecord pool (entityKey n) newWitness maxId
|
liftIO $ updateOrchNoteRecord pool (entityKey n) newWitness maxId
|
||||||
else logInfoN "Witness up to date"
|
|
||||||
|
|
||||||
-- | Calculate fee per ZIP-317
|
-- | Calculate fee per ZIP-317
|
||||||
calculateTxFee ::
|
calculateTxFee ::
|
||||||
|
@ -474,7 +456,7 @@ calculateTxFee (t, s, o) i =
|
||||||
|
|
||||||
-- | Prepare a transaction for sending
|
-- | Prepare a transaction for sending
|
||||||
prepareTx ::
|
prepareTx ::
|
||||||
T.Text
|
ConnectionPool
|
||||||
-> T.Text
|
-> T.Text
|
||||||
-> Int
|
-> Int
|
||||||
-> ZcashNet
|
-> ZcashNet
|
||||||
|
@ -484,8 +466,8 @@ prepareTx ::
|
||||||
-> UnifiedAddress
|
-> UnifiedAddress
|
||||||
-> T.Text
|
-> T.Text
|
||||||
-> IO (Either TxError HexString)
|
-> IO (Either TxError HexString)
|
||||||
prepareTx dbPath zebraHost zebraPort zn za bh amt ua memo = do
|
prepareTx pool zebraHost zebraPort zn za bh amt ua memo = do
|
||||||
accRead <- getAccountById dbPath za
|
accRead <- getAccountById pool za
|
||||||
let recipient =
|
let recipient =
|
||||||
case o_rec ua of
|
case o_rec ua of
|
||||||
Nothing ->
|
Nothing ->
|
||||||
|
@ -521,11 +503,11 @@ prepareTx dbPath zebraHost zebraPort zn za bh amt ua memo = do
|
||||||
print $ BS.length outParams
|
print $ BS.length outParams
|
||||||
print "Read Sapling params"
|
print "Read Sapling params"
|
||||||
let zats = fromIntegral $ floorFloatInteger $ amt * (10 ^ 8)
|
let zats = fromIntegral $ floorFloatInteger $ amt * (10 ^ 8)
|
||||||
firstPass <- selectUnspentNotes dbPath za zats
|
firstPass <- selectUnspentNotes pool za zats
|
||||||
let fee = calculateTxFee firstPass 3
|
let fee = calculateTxFee firstPass 3
|
||||||
print "calculated fee"
|
print "calculated fee"
|
||||||
print fee
|
print fee
|
||||||
(tList, sList, oList) <- selectUnspentNotes dbPath za (zats + fee)
|
(tList, sList, oList) <- selectUnspentNotes pool za (zats + fee)
|
||||||
print "selected notes"
|
print "selected notes"
|
||||||
print tList
|
print tList
|
||||||
print sList
|
print sList
|
||||||
|
@ -564,7 +546,7 @@ prepareTx dbPath zebraHost zebraPort zn za bh amt ua memo = do
|
||||||
-> Integer
|
-> Integer
|
||||||
-> IO [OutgoingNote]
|
-> IO [OutgoingNote]
|
||||||
makeOutgoing acc (k, recvr) zats chg = do
|
makeOutgoing acc (k, recvr) zats chg = do
|
||||||
chgAddr <- getInternalAddresses dbPath $ entityKey acc
|
chgAddr <- runNoLoggingT $ getInternalAddresses pool $ entityKey acc
|
||||||
let internalUA = getUA $ walletAddressUAddress $ entityVal $ head chgAddr
|
let internalUA = getUA $ walletAddressUAddress $ entityVal $ head chgAddr
|
||||||
let chgRcvr =
|
let chgRcvr =
|
||||||
fromJust $ o_rec =<< isValidUnifiedAddress (E.encodeUtf8 internalUA)
|
fromJust $ o_rec =<< isValidUnifiedAddress (E.encodeUtf8 internalUA)
|
||||||
|
@ -604,7 +586,7 @@ prepareTx dbPath zebraHost zebraPort zn za bh amt ua memo = do
|
||||||
-> IO [TransparentTxSpend]
|
-> IO [TransparentTxSpend]
|
||||||
prepTSpends sk notes = do
|
prepTSpends sk notes = do
|
||||||
forM notes $ \n -> do
|
forM notes $ \n -> do
|
||||||
tAddRead <- getAddressById dbPath $ walletTrNoteAddress $ entityVal n
|
tAddRead <- getAddressById pool $ walletTrNoteAddress $ entityVal n
|
||||||
print n
|
print n
|
||||||
case tAddRead of
|
case tAddRead of
|
||||||
Nothing -> throwIO $ userError "Couldn't read t-address"
|
Nothing -> throwIO $ userError "Couldn't read t-address"
|
||||||
|
@ -614,7 +596,7 @@ prepareTx dbPath zebraHost zebraPort zn za bh amt ua memo = do
|
||||||
(walletAddressIndex $ entityVal tAdd)
|
(walletAddressIndex $ entityVal tAdd)
|
||||||
(getScope $ walletAddressScope $ entityVal tAdd)
|
(getScope $ walletAddressScope $ entityVal tAdd)
|
||||||
sk
|
sk
|
||||||
mReverseTxId <- getWalletTxId dbPath $ walletTrNoteTx $ entityVal n
|
mReverseTxId <- getWalletTxId pool $ walletTrNoteTx $ entityVal n
|
||||||
case mReverseTxId of
|
case mReverseTxId of
|
||||||
Nothing -> throwIO $ userError "failed to get tx ID"
|
Nothing -> throwIO $ userError "failed to get tx ID"
|
||||||
Just (ESQ.Value reverseTxId) -> do
|
Just (ESQ.Value reverseTxId) -> do
|
||||||
|
@ -679,22 +661,24 @@ prepareTx dbPath zebraHost zebraPort zn za bh amt ua memo = do
|
||||||
syncWallet ::
|
syncWallet ::
|
||||||
Config -- ^ configuration parameters
|
Config -- ^ configuration parameters
|
||||||
-> Entity ZcashWallet
|
-> Entity ZcashWallet
|
||||||
-> LoggingT IO ()
|
-> IO ()
|
||||||
syncWallet config w = do
|
syncWallet config w = do
|
||||||
|
startTime <- liftIO getCurrentTime
|
||||||
let walletDb = c_dbPath config
|
let walletDb = c_dbPath config
|
||||||
accs <- liftIO $ getAccounts walletDb $ entityKey w
|
pool <- runNoLoggingT $ initPool walletDb
|
||||||
addrs <- liftIO $ concat <$> mapM (getAddresses walletDb . entityKey) accs
|
accs <- runNoLoggingT $ getAccounts pool $ entityKey w
|
||||||
|
addrs <- concat <$> mapM (runNoLoggingT . getAddresses pool . entityKey) accs
|
||||||
intAddrs <-
|
intAddrs <-
|
||||||
liftIO $ concat <$> mapM (getInternalAddresses walletDb . entityKey) accs
|
concat <$> mapM (runNoLoggingT . getInternalAddresses pool . entityKey) accs
|
||||||
chainTip <- liftIO $ getMaxBlock walletDb
|
chainTip <- runNoLoggingT $ getMaxBlock pool
|
||||||
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_ (liftIO . findTransparentNotes walletDb startBlock) addrs
|
mapM_ (liftIO . findTransparentNotes pool startBlock) addrs
|
||||||
mapM_ (liftIO . findTransparentNotes walletDb startBlock) intAddrs
|
mapM_ (liftIO . findTransparentNotes pool startBlock) intAddrs
|
||||||
mapM_ (liftIO . findTransparentSpends walletDb . entityKey) accs
|
mapM_ (liftIO . findTransparentSpends pool . entityKey) accs
|
||||||
sapNotes <-
|
sapNotes <-
|
||||||
liftIO $
|
liftIO $
|
||||||
mapM
|
mapM
|
||||||
|
@ -705,52 +689,52 @@ syncWallet config w = do
|
||||||
mapM
|
mapM
|
||||||
(findOrchardActions config startBlock (zcashWalletNetwork $ entityVal w))
|
(findOrchardActions config startBlock (zcashWalletNetwork $ entityVal w))
|
||||||
accs
|
accs
|
||||||
_ <- updateSaplingWitnesses walletDb
|
_ <- updateSaplingWitnesses pool
|
||||||
_ <- updateOrchardWitnesses walletDb
|
_ <- updateOrchardWitnesses pool
|
||||||
_ <- liftIO $ updateWalletSync walletDb chainTip (entityKey w)
|
_ <- liftIO $ updateWalletSync pool chainTip (entityKey w)
|
||||||
_ <- liftIO $ mapM_ (getWalletTransactions walletDb) addrs
|
mapM_ (runNoLoggingT . getWalletTransactions pool) 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
|
pool <- runNoLoggingT $ initPool dbPath
|
||||||
r <- runFileLoggingT "zenith.log" $ mapM (syncWallet config) w
|
w <- getWallets pool TestNet
|
||||||
|
r <- mapM (syncWallet config) w
|
||||||
liftIO $ print r
|
liftIO $ print r
|
||||||
|
{-let uaRead =-}
|
||||||
|
{-isValidUnifiedAddress-}
|
||||||
|
{-"utest1dl54utt6prjj5e0dnlknwumnxq9hycdjpkfr0sy6e6h522remqee8axe9zax0wsjrwpj76v555pdhvj9rnargpfyycs0vpkapq98xcdhem99gc4wchzn0ggepq3y6nz3a9sscwgqxgsh9vzhcad402y3x9szfregck5gslkya3c79d86xx0l33tpk8gnn7ew9vw37w43zh22u8dgdax"-}
|
||||||
|
{-case uaRead of-}
|
||||||
|
{-Nothing -> print "wrong address"-}
|
||||||
|
{-Just ua -> do-}
|
||||||
|
{-startTime <- getCurrentTime-}
|
||||||
|
{-print startTime-}
|
||||||
|
{-tx <--}
|
||||||
|
{-prepareTx-}
|
||||||
|
{-"zenith.db"-}
|
||||||
|
{-"127.0.0.1"-}
|
||||||
|
{-18232-}
|
||||||
|
{-TestNet-}
|
||||||
|
{-(toSqlKey 1)-}
|
||||||
|
{-2820897-}
|
||||||
|
{-0.04-}
|
||||||
|
{-ua-}
|
||||||
|
{-"sent with Zenith, test"-}
|
||||||
|
{-print tx-}
|
||||||
|
{-endTime <- getCurrentTime-}
|
||||||
|
{-print endTime-}
|
||||||
|
|
||||||
testSend :: IO ()
|
{-testSend :: IO ()-}
|
||||||
testSend = do
|
{-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
|
||||||
let dbPath = c_dbPath config
|
let dbPath = c_dbPath config
|
||||||
|
pool <- runNoLoggingT $ initPool dbPath
|
||||||
_ <- initDb dbPath
|
_ <- initDb dbPath
|
||||||
_ <- clearWalletTransactions dbPath
|
_ <- clearWalletTransactions pool
|
||||||
w <- getWallets dbPath TestNet
|
w <- getWallets pool TestNet
|
||||||
liftIO $ mapM_ (updateWalletSync dbPath 0 . entityKey) w
|
liftIO $ mapM_ (updateWalletSync pool 0 . entityKey) w
|
||||||
w' <- liftIO $ getWallets dbPath TestNet
|
w' <- liftIO $ getWallets pool TestNet
|
||||||
r <- runFileLoggingT "zenith.log" $ mapM (syncWallet config) w'
|
r <- mapM (syncWallet config) w'
|
||||||
liftIO $ print r
|
liftIO $ print r
|
||||||
|
|
462
src/Zenith/DB.hs
462
src/Zenith/DB.hs
|
@ -21,6 +21,7 @@ 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 Control.Monad.Logger (NoLoggingT, runNoLoggingT)
|
||||||
import Data.Bifunctor (bimap)
|
import Data.Bifunctor (bimap)
|
||||||
import qualified Data.ByteString as BS
|
import qualified Data.ByteString as BS
|
||||||
import Data.HexString
|
import Data.HexString
|
||||||
|
@ -40,6 +41,7 @@ import Haskoin.Transaction.Common
|
||||||
, TxOut(..)
|
, TxOut(..)
|
||||||
, txHashToHex
|
, txHashToHex
|
||||||
)
|
)
|
||||||
|
import qualified Lens.Micro as ML ((&), (.~), (^.))
|
||||||
import ZcashHaskell.Orchard (isValidUnifiedAddress)
|
import ZcashHaskell.Orchard (isValidUnifiedAddress)
|
||||||
import ZcashHaskell.Sapling (decodeSaplingOutputEsk)
|
import ZcashHaskell.Sapling (decodeSaplingOutputEsk)
|
||||||
import ZcashHaskell.Types
|
import ZcashHaskell.Types
|
||||||
|
@ -251,6 +253,11 @@ initDb ::
|
||||||
initDb dbName = do
|
initDb dbName = do
|
||||||
PS.runSqlite dbName $ do runMigration migrateAll
|
PS.runSqlite dbName $ do runMigration migrateAll
|
||||||
|
|
||||||
|
initPool :: T.Text -> NoLoggingT IO ConnectionPool
|
||||||
|
initPool dbPath = do
|
||||||
|
let dbInfo = PS.mkSqliteConnectionInfo dbPath
|
||||||
|
PS.createSqlitePoolFromInfo dbInfo 5
|
||||||
|
|
||||||
-- | Upgrade the database
|
-- | Upgrade the database
|
||||||
upgradeDb ::
|
upgradeDb ::
|
||||||
T.Text -- ^ database path
|
T.Text -- ^ database path
|
||||||
|
@ -259,9 +266,11 @@ upgradeDb dbName = do
|
||||||
PS.runSqlite dbName $ do runMigrationUnsafe migrateAll
|
PS.runSqlite dbName $ do runMigrationUnsafe migrateAll
|
||||||
|
|
||||||
-- | Get existing wallets from database
|
-- | Get existing wallets from database
|
||||||
getWallets :: T.Text -> ZcashNet -> IO [Entity ZcashWallet]
|
getWallets :: ConnectionPool -> ZcashNet -> IO [Entity ZcashWallet]
|
||||||
getWallets dbFp n =
|
getWallets pool n =
|
||||||
PS.runSqlite dbFp $
|
runNoLoggingT $
|
||||||
|
PS.retryOnBusy $
|
||||||
|
flip PS.runSqlPool pool $ do
|
||||||
select $ do
|
select $ do
|
||||||
wallets <- from $ table @ZcashWallet
|
wallets <- from $ table @ZcashWallet
|
||||||
where_ (wallets ^. ZcashWalletNetwork ==. val (ZcashNetDB n))
|
where_ (wallets ^. ZcashWalletNetwork ==. val (ZcashNetDB n))
|
||||||
|
@ -269,34 +278,42 @@ getWallets dbFp n =
|
||||||
|
|
||||||
-- | Save a new wallet to the database
|
-- | Save a new wallet to the database
|
||||||
saveWallet ::
|
saveWallet ::
|
||||||
T.Text -- ^ The database path to use
|
ConnectionPool -- ^ The database path to use
|
||||||
-> ZcashWallet -- ^ The wallet to add to the database
|
-> ZcashWallet -- ^ The wallet to add to the database
|
||||||
-> IO (Maybe (Entity ZcashWallet))
|
-> IO (Maybe (Entity ZcashWallet))
|
||||||
saveWallet dbFp w = PS.runSqlite dbFp $ insertUniqueEntity w
|
saveWallet pool w =
|
||||||
|
runNoLoggingT $
|
||||||
|
PS.retryOnBusy $ flip PS.runSqlPool pool $ insertUniqueEntity w
|
||||||
|
|
||||||
-- | Update the last sync block for the wallet
|
-- | Update the last sync block for the wallet
|
||||||
updateWalletSync :: T.Text -> Int -> ZcashWalletId -> IO ()
|
updateWalletSync :: ConnectionPool -> Int -> ZcashWalletId -> IO ()
|
||||||
updateWalletSync dbPath b i = do
|
updateWalletSync pool b i = do
|
||||||
PS.runSqlite dbPath $ do
|
runNoLoggingT $
|
||||||
|
PS.retryOnBusy $
|
||||||
|
flip PS.runSqlPool pool $ do
|
||||||
update $ \w -> do
|
update $ \w -> do
|
||||||
set w [ZcashWalletLastSync =. val b]
|
set w [ZcashWalletLastSync =. val b]
|
||||||
where_ $ w ^. ZcashWalletId ==. val i
|
where_ $ w ^. ZcashWalletId ==. val i
|
||||||
|
|
||||||
-- | Returns a list of accounts associated with the given wallet
|
-- | Returns a list of accounts associated with the given wallet
|
||||||
getAccounts ::
|
getAccounts ::
|
||||||
T.Text -- ^ The database path
|
ConnectionPool -- ^ The database path
|
||||||
-> ZcashWalletId -- ^ The wallet ID to check
|
-> ZcashWalletId -- ^ The wallet ID to check
|
||||||
-> IO [Entity ZcashAccount]
|
-> NoLoggingT IO [Entity ZcashAccount]
|
||||||
getAccounts dbFp w =
|
getAccounts pool w =
|
||||||
PS.runSqlite dbFp $
|
PS.retryOnBusy $
|
||||||
|
flip PS.runSqlPool pool $ do
|
||||||
select $ do
|
select $ do
|
||||||
accs <- from $ table @ZcashAccount
|
accs <- from $ table @ZcashAccount
|
||||||
where_ (accs ^. ZcashAccountWalletId ==. val w)
|
where_ (accs ^. ZcashAccountWalletId ==. val w)
|
||||||
pure accs
|
pure accs
|
||||||
|
|
||||||
getAccountById :: T.Text -> ZcashAccountId -> IO (Maybe (Entity ZcashAccount))
|
getAccountById ::
|
||||||
getAccountById dbPath za = do
|
ConnectionPool -> ZcashAccountId -> IO (Maybe (Entity ZcashAccount))
|
||||||
PS.runSqlite dbPath $
|
getAccountById pool za = do
|
||||||
|
runNoLoggingT $
|
||||||
|
PS.retryOnBusy $
|
||||||
|
flip PS.runSqlPool pool $ do
|
||||||
selectOne $ do
|
selectOne $ do
|
||||||
accs <- from $ table @ZcashAccount
|
accs <- from $ table @ZcashAccount
|
||||||
where_ (accs ^. ZcashAccountId ==. val za)
|
where_ (accs ^. ZcashAccountId ==. val za)
|
||||||
|
@ -304,12 +321,14 @@ getAccountById dbPath za = do
|
||||||
|
|
||||||
-- | 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
|
ConnectionPool -- ^ The database path
|
||||||
-> ZcashWalletId -- ^ The wallet ID to check
|
-> ZcashWalletId -- ^ The wallet ID to check
|
||||||
-> IO Int
|
-> IO Int
|
||||||
getMaxAccount dbFp w = do
|
getMaxAccount pool w = do
|
||||||
a <-
|
a <-
|
||||||
PS.runSqlite dbFp $
|
runNoLoggingT $
|
||||||
|
PS.retryOnBusy $
|
||||||
|
flip PS.runSqlPool pool $ do
|
||||||
selectOne $ do
|
selectOne $ do
|
||||||
accs <- from $ table @ZcashAccount
|
accs <- from $ table @ZcashAccount
|
||||||
where_ (accs ^. ZcashAccountWalletId ==. val w)
|
where_ (accs ^. ZcashAccountWalletId ==. val w)
|
||||||
|
@ -321,18 +340,21 @@ getMaxAccount dbFp w = do
|
||||||
|
|
||||||
-- | Save a new account to the database
|
-- | Save a new account to the database
|
||||||
saveAccount ::
|
saveAccount ::
|
||||||
T.Text -- ^ The database path
|
ConnectionPool -- ^ The database path
|
||||||
-> ZcashAccount -- ^ The account to add to the database
|
-> ZcashAccount -- ^ The account to add to the database
|
||||||
-> IO (Maybe (Entity ZcashAccount))
|
-> IO (Maybe (Entity ZcashAccount))
|
||||||
saveAccount dbFp a = PS.runSqlite dbFp $ insertUniqueEntity a
|
saveAccount pool a =
|
||||||
|
runNoLoggingT $
|
||||||
|
PS.retryOnBusy $ flip PS.runSqlPool pool $ insertUniqueEntity a
|
||||||
|
|
||||||
-- | Returns the largest block in storage
|
-- | Returns the largest block in storage
|
||||||
getMaxBlock ::
|
getMaxBlock ::
|
||||||
T.Text -- ^ The database path
|
Pool SqlBackend -- ^ The database pool
|
||||||
-> IO Int
|
-> NoLoggingT IO Int
|
||||||
getMaxBlock dbPath = do
|
getMaxBlock pool = do
|
||||||
b <-
|
b <-
|
||||||
PS.runSqlite dbPath $
|
PS.retryOnBusy $
|
||||||
|
flip PS.runSqlPool pool $ do
|
||||||
selectOne $ do
|
selectOne $ do
|
||||||
txs <- from $ table @ZcashTransaction
|
txs <- from $ table @ZcashTransaction
|
||||||
where_ (txs ^. ZcashTransactionBlock >. val 0)
|
where_ (txs ^. ZcashTransactionBlock >. val 0)
|
||||||
|
@ -344,20 +366,24 @@ getMaxBlock dbPath = do
|
||||||
|
|
||||||
-- | Returns a list of addresses associated with the given account
|
-- | Returns a list of addresses associated with the given account
|
||||||
getAddresses ::
|
getAddresses ::
|
||||||
T.Text -- ^ The database path
|
ConnectionPool -- ^ The database path
|
||||||
-> ZcashAccountId -- ^ The account ID to check
|
-> ZcashAccountId -- ^ The account ID to check
|
||||||
-> IO [Entity WalletAddress]
|
-> NoLoggingT IO [Entity WalletAddress]
|
||||||
getAddresses dbFp a =
|
getAddresses pool a =
|
||||||
PS.runSqlite dbFp $
|
PS.retryOnBusy $
|
||||||
|
flip PS.runSqlPool pool $ do
|
||||||
select $ do
|
select $ do
|
||||||
addrs <- from $ table @WalletAddress
|
addrs <- from $ table @WalletAddress
|
||||||
where_ (addrs ^. WalletAddressAccId ==. val a)
|
where_ (addrs ^. WalletAddressAccId ==. val 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 ::
|
||||||
getAddressById dbPath a = do
|
ConnectionPool -> WalletAddressId -> IO (Maybe (Entity WalletAddress))
|
||||||
PS.runSqlite dbPath $
|
getAddressById pool a = do
|
||||||
|
runNoLoggingT $
|
||||||
|
PS.retryOnBusy $
|
||||||
|
flip PS.runSqlPool pool $ do
|
||||||
selectOne $ do
|
selectOne $ do
|
||||||
addr <- from $ table @WalletAddress
|
addr <- from $ table @WalletAddress
|
||||||
where_ (addr ^. WalletAddressId ==. val a)
|
where_ (addr ^. WalletAddressId ==. val a)
|
||||||
|
@ -365,11 +391,12 @@ getAddressById dbPath a = do
|
||||||
|
|
||||||
-- | 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
|
ConnectionPool -- ^ The database path
|
||||||
-> ZcashAccountId -- ^ The account ID to check
|
-> ZcashAccountId -- ^ The account ID to check
|
||||||
-> IO [Entity WalletAddress]
|
-> NoLoggingT IO [Entity WalletAddress]
|
||||||
getInternalAddresses dbFp a =
|
getInternalAddresses pool a =
|
||||||
PS.runSqlite dbFp $
|
PS.retryOnBusy $
|
||||||
|
flip PS.runSqlPool pool $ do
|
||||||
select $ do
|
select $ do
|
||||||
addrs <- from $ table @WalletAddress
|
addrs <- from $ table @WalletAddress
|
||||||
where_ (addrs ^. WalletAddressAccId ==. val a)
|
where_ (addrs ^. WalletAddressAccId ==. val a)
|
||||||
|
@ -378,23 +405,25 @@ getInternalAddresses dbFp a =
|
||||||
|
|
||||||
-- | Returns a list of addressess associated with the given wallet
|
-- | Returns a list of addressess associated with the given wallet
|
||||||
getWalletAddresses ::
|
getWalletAddresses ::
|
||||||
T.Text -- ^ The database path
|
ConnectionPool -- ^ The database path
|
||||||
-> ZcashWalletId -- ^ the wallet to search
|
-> ZcashWalletId -- ^ the wallet to search
|
||||||
-> IO [Entity WalletAddress]
|
-> NoLoggingT IO [Entity WalletAddress]
|
||||||
getWalletAddresses dbFp w = do
|
getWalletAddresses pool w = do
|
||||||
accs <- getAccounts dbFp w
|
accs <- getAccounts pool w
|
||||||
addrs <- mapM (getAddresses dbFp . entityKey) accs
|
addrs <- mapM (getAddresses pool . entityKey) accs
|
||||||
return $ concat addrs
|
return $ concat addrs
|
||||||
|
|
||||||
-- | Returns the largest address index for the given account
|
-- | Returns the largest address index for the given account
|
||||||
getMaxAddress ::
|
getMaxAddress ::
|
||||||
T.Text -- ^ The database path
|
ConnectionPool -- ^ The database path
|
||||||
-> ZcashAccountId -- ^ The account ID to check
|
-> ZcashAccountId -- ^ The account ID to check
|
||||||
-> Scope -- ^ The scope of the address
|
-> Scope -- ^ The scope of the address
|
||||||
-> IO Int
|
-> IO Int
|
||||||
getMaxAddress dbFp aw s = do
|
getMaxAddress pool aw s = do
|
||||||
a <-
|
a <-
|
||||||
PS.runSqlite dbFp $
|
runNoLoggingT $
|
||||||
|
PS.retryOnBusy $
|
||||||
|
flip PS.runSqlPool pool $ do
|
||||||
selectOne $ do
|
selectOne $ do
|
||||||
addrs <- from $ table @WalletAddress
|
addrs <- from $ table @WalletAddress
|
||||||
where_ $ addrs ^. WalletAddressAccId ==. val aw
|
where_ $ addrs ^. WalletAddressAccId ==. val aw
|
||||||
|
@ -407,19 +436,22 @@ getMaxAddress dbFp aw s = do
|
||||||
|
|
||||||
-- | Save a new address to the database
|
-- | Save a new address to the database
|
||||||
saveAddress ::
|
saveAddress ::
|
||||||
T.Text -- ^ the database path
|
ConnectionPool -- ^ the database path
|
||||||
-> WalletAddress -- ^ The wallet to add to the database
|
-> WalletAddress -- ^ The wallet to add to the database
|
||||||
-> IO (Maybe (Entity WalletAddress))
|
-> IO (Maybe (Entity WalletAddress))
|
||||||
saveAddress dbFp w = PS.runSqlite dbFp $ insertUniqueEntity w
|
saveAddress pool w =
|
||||||
|
runNoLoggingT $
|
||||||
|
PS.retryOnBusy $ flip PS.runSqlPool pool $ insertUniqueEntity w
|
||||||
|
|
||||||
-- | Save a transaction to the data model
|
-- | Save a transaction to the data model
|
||||||
saveTransaction ::
|
saveTransaction ::
|
||||||
T.Text -- ^ the database path
|
ConnectionPool -- ^ the database path
|
||||||
-> Int -- ^ block time
|
-> Int -- ^ block time
|
||||||
-> Transaction -- ^ The transaction to save
|
-> Transaction -- ^ The transaction to save
|
||||||
-> IO (Key ZcashTransaction)
|
-> NoLoggingT IO (Key ZcashTransaction)
|
||||||
saveTransaction dbFp t wt =
|
saveTransaction pool t wt =
|
||||||
PS.runSqlite dbFp $ do
|
PS.retryOnBusy $
|
||||||
|
flip PS.runSqlPool pool $ do
|
||||||
let ix = [0 ..]
|
let ix = [0 ..]
|
||||||
w <-
|
w <-
|
||||||
insert $
|
insert $
|
||||||
|
@ -500,11 +532,13 @@ saveTransaction dbFp t wt =
|
||||||
|
|
||||||
-- | Get the transactions from a particular block forward
|
-- | Get the transactions from a particular block forward
|
||||||
getZcashTransactions ::
|
getZcashTransactions ::
|
||||||
T.Text -- ^ The database path
|
ConnectionPool -- ^ The database path
|
||||||
-> Int -- ^ Block
|
-> Int -- ^ Block
|
||||||
-> IO [Entity ZcashTransaction]
|
-> IO [Entity ZcashTransaction]
|
||||||
getZcashTransactions dbFp b =
|
getZcashTransactions pool b =
|
||||||
PS.runSqlite dbFp $
|
runNoLoggingT $
|
||||||
|
PS.retryOnBusy $
|
||||||
|
flip PS.runSqlPool pool $ do
|
||||||
select $ do
|
select $ do
|
||||||
txs <- from $ table @ZcashTransaction
|
txs <- from $ table @ZcashTransaction
|
||||||
where_ $ txs ^. ZcashTransactionBlock >. val b
|
where_ $ txs ^. ZcashTransactionBlock >. val b
|
||||||
|
@ -514,11 +548,13 @@ getZcashTransactions dbFp b =
|
||||||
-- * Wallet
|
-- * Wallet
|
||||||
-- | Get the block of the last transaction known to the wallet
|
-- | Get the block of the last transaction known to the wallet
|
||||||
getMaxWalletBlock ::
|
getMaxWalletBlock ::
|
||||||
T.Text -- ^ The database path
|
ConnectionPool -- ^ The database path
|
||||||
-> IO Int
|
-> IO Int
|
||||||
getMaxWalletBlock dbPath = do
|
getMaxWalletBlock pool = do
|
||||||
b <-
|
b <-
|
||||||
PS.runSqlite dbPath $
|
runNoLoggingT $
|
||||||
|
PS.retryOnBusy $
|
||||||
|
flip PS.runSqlPool pool $ do
|
||||||
selectOne $ do
|
selectOne $ do
|
||||||
txs <- from $ table @WalletTransaction
|
txs <- from $ table @WalletTransaction
|
||||||
where_ $ txs ^. WalletTransactionBlock >. val 0
|
where_ $ txs ^. WalletTransactionBlock >. val 0
|
||||||
|
@ -528,10 +564,12 @@ 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 :: ConnectionPool -> IO Int
|
||||||
getMinBirthdayHeight dbPath = do
|
getMinBirthdayHeight pool = do
|
||||||
b <-
|
b <-
|
||||||
PS.runSqlite dbPath $
|
runNoLoggingT $
|
||||||
|
PS.retryOnBusy $
|
||||||
|
flip PS.runSqlPool pool $ do
|
||||||
selectOne $ do
|
selectOne $ do
|
||||||
w <- from $ table @ZcashWallet
|
w <- from $ table @ZcashWallet
|
||||||
where_ (w ^. ZcashWalletBirthdayHeight >. val 0)
|
where_ (w ^. ZcashWalletBirthdayHeight >. val 0)
|
||||||
|
@ -543,13 +581,15 @@ getMinBirthdayHeight dbPath = do
|
||||||
|
|
||||||
-- | Save a @WalletTransaction@
|
-- | Save a @WalletTransaction@
|
||||||
saveWalletTransaction ::
|
saveWalletTransaction ::
|
||||||
T.Text
|
ConnectionPool
|
||||||
-> ZcashAccountId
|
-> ZcashAccountId
|
||||||
-> Entity ZcashTransaction
|
-> Entity ZcashTransaction
|
||||||
-> IO WalletTransactionId
|
-> IO WalletTransactionId
|
||||||
saveWalletTransaction dbPath za zt = do
|
saveWalletTransaction pool za zt = do
|
||||||
let zT' = entityVal zt
|
let zT' = entityVal zt
|
||||||
PS.runSqlite dbPath $ do
|
runNoLoggingT $
|
||||||
|
PS.retryOnBusy $
|
||||||
|
flip PS.runSqlPool pool $ do
|
||||||
t <-
|
t <-
|
||||||
upsert
|
upsert
|
||||||
(WalletTransaction
|
(WalletTransaction
|
||||||
|
@ -563,7 +603,7 @@ saveWalletTransaction dbPath za zt = do
|
||||||
|
|
||||||
-- | Save a @WalletSapNote@
|
-- | Save a @WalletSapNote@
|
||||||
saveWalletSapNote ::
|
saveWalletSapNote ::
|
||||||
T.Text -- ^ The database path
|
ConnectionPool -- ^ The database path
|
||||||
-> WalletTransactionId -- ^ The index for the transaction that contains the note
|
-> WalletTransactionId -- ^ The index for the transaction that contains the note
|
||||||
-> Integer -- ^ note position
|
-> Integer -- ^ note position
|
||||||
-> SaplingWitness -- ^ the Sapling incremental witness
|
-> SaplingWitness -- ^ the Sapling incremental witness
|
||||||
|
@ -572,8 +612,10 @@ saveWalletSapNote ::
|
||||||
-> ShieldOutputId
|
-> ShieldOutputId
|
||||||
-> DecodedNote -- The decoded Sapling note
|
-> DecodedNote -- The decoded Sapling note
|
||||||
-> IO ()
|
-> IO ()
|
||||||
saveWalletSapNote dbPath wId pos wit ch za zt dn = do
|
saveWalletSapNote pool wId pos wit ch za zt dn = do
|
||||||
PS.runSqlite dbPath $ do
|
runNoLoggingT $
|
||||||
|
PS.retryOnBusy $
|
||||||
|
flip PS.runSqlPool pool $ do
|
||||||
_ <-
|
_ <-
|
||||||
upsert
|
upsert
|
||||||
(WalletSapNote
|
(WalletSapNote
|
||||||
|
@ -594,7 +636,7 @@ saveWalletSapNote dbPath wId pos wit ch za zt dn = do
|
||||||
|
|
||||||
-- | Save a @WalletOrchNote@
|
-- | Save a @WalletOrchNote@
|
||||||
saveWalletOrchNote ::
|
saveWalletOrchNote ::
|
||||||
T.Text
|
ConnectionPool
|
||||||
-> WalletTransactionId
|
-> WalletTransactionId
|
||||||
-> Integer
|
-> Integer
|
||||||
-> OrchardWitness
|
-> OrchardWitness
|
||||||
|
@ -603,8 +645,10 @@ saveWalletOrchNote ::
|
||||||
-> OrchActionId
|
-> OrchActionId
|
||||||
-> DecodedNote
|
-> DecodedNote
|
||||||
-> IO ()
|
-> IO ()
|
||||||
saveWalletOrchNote dbPath wId pos wit ch za zt dn = do
|
saveWalletOrchNote pool wId pos wit ch za zt dn = do
|
||||||
PS.runSqlite dbPath $ do
|
runNoLoggingT $
|
||||||
|
PS.retryOnBusy $
|
||||||
|
flip PS.runSqlPool pool $ do
|
||||||
_ <-
|
_ <-
|
||||||
upsert
|
upsert
|
||||||
(WalletOrchNote
|
(WalletOrchNote
|
||||||
|
@ -626,11 +670,11 @@ saveWalletOrchNote dbPath wId pos wit ch za zt dn = do
|
||||||
|
|
||||||
-- | Find the Transparent Notes that match the given transparent receiver
|
-- | Find the Transparent Notes that match the given transparent receiver
|
||||||
findTransparentNotes ::
|
findTransparentNotes ::
|
||||||
T.Text -- ^ The database path
|
ConnectionPool -- ^ The database path
|
||||||
-> Int -- ^ Starting block
|
-> Int -- ^ Starting block
|
||||||
-> Entity WalletAddress
|
-> Entity WalletAddress
|
||||||
-> IO ()
|
-> IO ()
|
||||||
findTransparentNotes dbPath b t = do
|
findTransparentNotes pool b t = do
|
||||||
let tReceiver = t_rec =<< readUnifiedAddressDB (entityVal t)
|
let tReceiver = t_rec =<< readUnifiedAddressDB (entityVal t)
|
||||||
case tReceiver of
|
case tReceiver of
|
||||||
Just tR -> do
|
Just tR -> do
|
||||||
|
@ -641,7 +685,9 @@ findTransparentNotes dbPath b t = do
|
||||||
, BS.pack [0x88, 0xAC]
|
, BS.pack [0x88, 0xAC]
|
||||||
]
|
]
|
||||||
tN <-
|
tN <-
|
||||||
PS.runSqlite dbPath $
|
runNoLoggingT $
|
||||||
|
PS.retryOnBusy $
|
||||||
|
flip PS.runSqlPool pool $ do
|
||||||
select $ do
|
select $ do
|
||||||
(txs :& tNotes) <-
|
(txs :& tNotes) <-
|
||||||
from $ table @ZcashTransaction `innerJoin` table @TransparentNote `on`
|
from $ table @ZcashTransaction `innerJoin` table @TransparentNote `on`
|
||||||
|
@ -652,7 +698,7 @@ findTransparentNotes dbPath b t = do
|
||||||
pure (txs, tNotes)
|
pure (txs, tNotes)
|
||||||
mapM_
|
mapM_
|
||||||
(saveWalletTrNote
|
(saveWalletTrNote
|
||||||
dbPath
|
pool
|
||||||
(getScope $ walletAddressScope $ entityVal t)
|
(getScope $ walletAddressScope $ entityVal t)
|
||||||
(walletAddressAccId $ entityVal t)
|
(walletAddressAccId $ entityVal t)
|
||||||
(entityKey t))
|
(entityKey t))
|
||||||
|
@ -661,15 +707,17 @@ findTransparentNotes dbPath b t = do
|
||||||
|
|
||||||
-- | Add the transparent notes to the wallet
|
-- | Add the transparent notes to the wallet
|
||||||
saveWalletTrNote ::
|
saveWalletTrNote ::
|
||||||
T.Text -- ^ the database path
|
ConnectionPool -- ^ the database path
|
||||||
-> Scope
|
-> Scope
|
||||||
-> ZcashAccountId
|
-> ZcashAccountId
|
||||||
-> WalletAddressId
|
-> WalletAddressId
|
||||||
-> (Entity ZcashTransaction, Entity TransparentNote)
|
-> (Entity ZcashTransaction, Entity TransparentNote)
|
||||||
-> IO ()
|
-> IO ()
|
||||||
saveWalletTrNote dbPath ch za wa (zt, tn) = do
|
saveWalletTrNote pool ch za wa (zt, tn) = do
|
||||||
let zT' = entityVal zt
|
let zT' = entityVal zt
|
||||||
PS.runSqlite dbPath $ do
|
runNoLoggingT $
|
||||||
|
PS.retryOnBusy $
|
||||||
|
flip PS.runSqlPool pool $ do
|
||||||
t <-
|
t <-
|
||||||
upsert
|
upsert
|
||||||
(WalletTransaction
|
(WalletTransaction
|
||||||
|
@ -691,16 +739,19 @@ saveWalletTrNote dbPath ch za wa (zt, tn) = do
|
||||||
(fromIntegral $ transparentNotePosition $ entityVal tn)
|
(fromIntegral $ transparentNotePosition $ entityVal tn)
|
||||||
|
|
||||||
-- | Save a Sapling note to the wallet database
|
-- | Save a Sapling note to the wallet database
|
||||||
saveSapNote :: T.Text -> WalletSapNote -> IO ()
|
saveSapNote :: ConnectionPool -> WalletSapNote -> IO ()
|
||||||
saveSapNote dbPath wsn = PS.runSqlite dbPath $ do insert_ wsn
|
saveSapNote pool wsn =
|
||||||
|
runNoLoggingT $ PS.retryOnBusy $ flip PS.runSqlPool pool $ insert_ wsn
|
||||||
|
|
||||||
-- | Get the shielded outputs from the given blockheight
|
-- | Get the shielded outputs from the given blockheight
|
||||||
getShieldedOutputs ::
|
getShieldedOutputs ::
|
||||||
T.Text -- ^ database path
|
ConnectionPool -- ^ database path
|
||||||
-> Int -- ^ block
|
-> Int -- ^ block
|
||||||
-> IO [(Entity ZcashTransaction, Entity ShieldOutput)]
|
-> IO [(Entity ZcashTransaction, Entity ShieldOutput)]
|
||||||
getShieldedOutputs dbPath b =
|
getShieldedOutputs pool b =
|
||||||
PS.runSqlite dbPath $ do
|
runNoLoggingT $
|
||||||
|
PS.retryOnBusy $
|
||||||
|
flip PS.runSqlPool pool $ do
|
||||||
select $ do
|
select $ do
|
||||||
(txs :& sOutputs) <-
|
(txs :& sOutputs) <-
|
||||||
from $ table @ZcashTransaction `innerJoin` table @ShieldOutput `on`
|
from $ table @ZcashTransaction `innerJoin` table @ShieldOutput `on`
|
||||||
|
@ -715,11 +766,13 @@ getShieldedOutputs dbPath b =
|
||||||
|
|
||||||
-- | Get the Orchard actions from the given blockheight forward
|
-- | Get the Orchard actions from the given blockheight forward
|
||||||
getOrchardActions ::
|
getOrchardActions ::
|
||||||
T.Text -- ^ database path
|
ConnectionPool -- ^ database path
|
||||||
-> Int -- ^ block
|
-> Int -- ^ block
|
||||||
-> IO [(Entity ZcashTransaction, Entity OrchAction)]
|
-> IO [(Entity ZcashTransaction, Entity OrchAction)]
|
||||||
getOrchardActions dbPath b =
|
getOrchardActions pool b =
|
||||||
PS.runSqlite dbPath $ do
|
runNoLoggingT $
|
||||||
|
PS.retryOnBusy $
|
||||||
|
flip PS.runSqlPool pool $ do
|
||||||
select $ do
|
select $ do
|
||||||
(txs :& oActions) <-
|
(txs :& oActions) <-
|
||||||
from $ table @ZcashTransaction `innerJoin` table @OrchAction `on`
|
from $ table @ZcashTransaction `innerJoin` table @OrchAction `on`
|
||||||
|
@ -732,12 +785,12 @@ getOrchardActions dbPath b =
|
||||||
|
|
||||||
-- | Get the transactions belonging to the given address
|
-- | Get the transactions belonging to the given address
|
||||||
getWalletTransactions ::
|
getWalletTransactions ::
|
||||||
T.Text -- ^ database path
|
ConnectionPool -- ^ database path
|
||||||
-> Entity WalletAddress
|
-> Entity WalletAddress
|
||||||
-> IO ()
|
-> NoLoggingT IO ()
|
||||||
getWalletTransactions dbPath w = do
|
getWalletTransactions pool w = do
|
||||||
let w' = entityVal w
|
let w' = entityVal w
|
||||||
chgAddr <- getInternalAddresses dbPath $ walletAddressAccId $ entityVal w
|
chgAddr <- getInternalAddresses pool $ walletAddressAccId $ entityVal w
|
||||||
let ctReceiver = t_rec =<< readUnifiedAddressDB (entityVal $ head chgAddr)
|
let ctReceiver = t_rec =<< readUnifiedAddressDB (entityVal $ head chgAddr)
|
||||||
let csReceiver = s_rec =<< readUnifiedAddressDB (entityVal $ head chgAddr)
|
let csReceiver = s_rec =<< readUnifiedAddressDB (entityVal $ head chgAddr)
|
||||||
let coReceiver = o_rec =<< readUnifiedAddressDB (entityVal $ head chgAddr)
|
let coReceiver = o_rec =<< readUnifiedAddressDB (entityVal $ head chgAddr)
|
||||||
|
@ -754,7 +807,8 @@ getWalletTransactions dbPath w = do
|
||||||
, (toBytes . tr_bytes) tR
|
, (toBytes . tr_bytes) tR
|
||||||
, BS.pack [0x88, 0xAC]
|
, BS.pack [0x88, 0xAC]
|
||||||
]
|
]
|
||||||
PS.runSqlite dbPath $ do
|
PS.retryOnBusy $
|
||||||
|
flip PS.runSqlPool pool $ do
|
||||||
select $ do
|
select $ do
|
||||||
tnotes <- from $ table @WalletTrNote
|
tnotes <- from $ table @WalletTrNote
|
||||||
where_ (tnotes ^. WalletTrNoteScript ==. val s)
|
where_ (tnotes ^. WalletTrNoteScript ==. val s)
|
||||||
|
@ -769,13 +823,15 @@ getWalletTransactions dbPath w = do
|
||||||
, (toBytes . tr_bytes) tR
|
, (toBytes . tr_bytes) tR
|
||||||
, BS.pack [0x88, 0xAC]
|
, BS.pack [0x88, 0xAC]
|
||||||
]
|
]
|
||||||
PS.runSqlite dbPath $ do
|
PS.retryOnBusy $
|
||||||
|
flip PS.runSqlPool pool $ do
|
||||||
select $ do
|
select $ do
|
||||||
tnotes <- from $ table @WalletTrNote
|
tnotes <- from $ table @WalletTrNote
|
||||||
where_ (tnotes ^. WalletTrNoteScript ==. val s1)
|
where_ (tnotes ^. WalletTrNoteScript ==. val s1)
|
||||||
pure tnotes
|
pure tnotes
|
||||||
trSpends <-
|
trSpends <-
|
||||||
PS.runSqlite dbPath $ do
|
PS.retryOnBusy $
|
||||||
|
flip PS.runSqlPool pool $ do
|
||||||
select $ do
|
select $ do
|
||||||
trSpends <- from $ table @WalletTrSpend
|
trSpends <- from $ table @WalletTrSpend
|
||||||
where_
|
where_
|
||||||
|
@ -786,7 +842,8 @@ getWalletTransactions dbPath w = do
|
||||||
case sReceiver of
|
case sReceiver of
|
||||||
Nothing -> return []
|
Nothing -> return []
|
||||||
Just sR -> do
|
Just sR -> do
|
||||||
PS.runSqlite dbPath $ do
|
PS.retryOnBusy $
|
||||||
|
flip PS.runSqlPool pool $ do
|
||||||
select $ do
|
select $ do
|
||||||
snotes <- from $ table @WalletSapNote
|
snotes <- from $ table @WalletSapNote
|
||||||
where_ (snotes ^. WalletSapNoteRecipient ==. val (getBytes sR))
|
where_ (snotes ^. WalletSapNoteRecipient ==. val (getBytes sR))
|
||||||
|
@ -795,7 +852,8 @@ getWalletTransactions dbPath w = do
|
||||||
case csReceiver of
|
case csReceiver of
|
||||||
Nothing -> return []
|
Nothing -> return []
|
||||||
Just sR -> do
|
Just sR -> do
|
||||||
PS.runSqlite dbPath $ do
|
PS.retryOnBusy $
|
||||||
|
flip PS.runSqlPool pool $ do
|
||||||
select $ do
|
select $ do
|
||||||
snotes <- from $ table @WalletSapNote
|
snotes <- from $ table @WalletSapNote
|
||||||
where_ (snotes ^. WalletSapNoteRecipient ==. val (getBytes sR))
|
where_ (snotes ^. WalletSapNoteRecipient ==. val (getBytes sR))
|
||||||
|
@ -805,7 +863,8 @@ getWalletTransactions dbPath w = do
|
||||||
case oReceiver of
|
case oReceiver of
|
||||||
Nothing -> return []
|
Nothing -> return []
|
||||||
Just oR -> do
|
Just oR -> do
|
||||||
PS.runSqlite dbPath $ do
|
PS.retryOnBusy $
|
||||||
|
flip PS.runSqlPool pool $ do
|
||||||
select $ do
|
select $ do
|
||||||
onotes <- from $ table @WalletOrchNote
|
onotes <- from $ table @WalletOrchNote
|
||||||
where_ (onotes ^. WalletOrchNoteRecipient ==. val (getBytes oR))
|
where_ (onotes ^. WalletOrchNoteRecipient ==. val (getBytes oR))
|
||||||
|
@ -814,12 +873,14 @@ getWalletTransactions dbPath w = do
|
||||||
case coReceiver of
|
case coReceiver of
|
||||||
Nothing -> return []
|
Nothing -> return []
|
||||||
Just oR -> do
|
Just oR -> do
|
||||||
PS.runSqlite dbPath $ do
|
PS.retryOnBusy $
|
||||||
|
flip PS.runSqlPool pool $ do
|
||||||
select $ do
|
select $ do
|
||||||
onotes <- from $ table @WalletOrchNote
|
onotes <- from $ table @WalletOrchNote
|
||||||
where_ (onotes ^. WalletOrchNoteRecipient ==. val (getBytes oR))
|
where_ (onotes ^. WalletOrchNoteRecipient ==. val (getBytes oR))
|
||||||
pure onotes
|
pure onotes
|
||||||
orchSpends <- mapM (getOrchSpends . entityKey) (orchNotes <> orchChgNotes)
|
orchSpends <- mapM (getOrchSpends . entityKey) (orchNotes <> orchChgNotes)
|
||||||
|
clearUserTx (entityKey w)
|
||||||
mapM_ addTr trNotes
|
mapM_ addTr trNotes
|
||||||
mapM_ addTr trChgNotes
|
mapM_ addTr trChgNotes
|
||||||
mapM_ addSap sapNotes
|
mapM_ addSap sapNotes
|
||||||
|
@ -830,56 +891,68 @@ getWalletTransactions dbPath w = do
|
||||||
mapM_ subSSpend $ catMaybes sapSpends
|
mapM_ subSSpend $ catMaybes sapSpends
|
||||||
mapM_ subOSpend $ catMaybes orchSpends
|
mapM_ subOSpend $ catMaybes orchSpends
|
||||||
where
|
where
|
||||||
getSapSpends :: WalletSapNoteId -> IO (Maybe (Entity WalletSapSpend))
|
clearUserTx :: WalletAddressId -> NoLoggingT IO ()
|
||||||
|
clearUserTx waId = do
|
||||||
|
PS.retryOnBusy $
|
||||||
|
flip PS.runSqlPool pool $ do
|
||||||
|
delete $ do
|
||||||
|
u <- from $ table @UserTx
|
||||||
|
where_ (u ^. UserTxAddress ==. val waId)
|
||||||
|
return ()
|
||||||
|
getSapSpends ::
|
||||||
|
WalletSapNoteId -> NoLoggingT IO (Maybe (Entity WalletSapSpend))
|
||||||
getSapSpends n = do
|
getSapSpends n = do
|
||||||
PS.runSqlite dbPath $ do
|
PS.retryOnBusy $
|
||||||
|
flip PS.runSqlPool pool $ do
|
||||||
selectOne $ do
|
selectOne $ do
|
||||||
sapSpends <- from $ table @WalletSapSpend
|
sapSpends <- from $ table @WalletSapSpend
|
||||||
where_ (sapSpends ^. WalletSapSpendNote ==. val n)
|
where_ (sapSpends ^. WalletSapSpendNote ==. val n)
|
||||||
pure sapSpends
|
pure sapSpends
|
||||||
getOrchSpends :: WalletOrchNoteId -> IO (Maybe (Entity WalletOrchSpend))
|
getOrchSpends ::
|
||||||
|
WalletOrchNoteId -> NoLoggingT IO (Maybe (Entity WalletOrchSpend))
|
||||||
getOrchSpends n = do
|
getOrchSpends n = do
|
||||||
PS.runSqlite dbPath $ do
|
PS.retryOnBusy $
|
||||||
|
flip PS.runSqlPool pool $ do
|
||||||
selectOne $ do
|
selectOne $ do
|
||||||
orchSpends <- from $ table @WalletOrchSpend
|
orchSpends <- from $ table @WalletOrchSpend
|
||||||
where_ (orchSpends ^. WalletOrchSpendNote ==. val n)
|
where_ (orchSpends ^. WalletOrchSpendNote ==. val n)
|
||||||
pure orchSpends
|
pure orchSpends
|
||||||
addTr :: Entity WalletTrNote -> IO ()
|
addTr :: Entity WalletTrNote -> NoLoggingT IO ()
|
||||||
addTr n =
|
addTr n =
|
||||||
upsertUserTx
|
upsertUserTx
|
||||||
(walletTrNoteTx $ entityVal n)
|
(walletTrNoteTx $ entityVal n)
|
||||||
(entityKey w)
|
(entityKey w)
|
||||||
(fromIntegral $ walletTrNoteValue $ entityVal n)
|
(fromIntegral $ walletTrNoteValue $ entityVal n)
|
||||||
""
|
""
|
||||||
addSap :: Entity WalletSapNote -> IO ()
|
addSap :: Entity WalletSapNote -> NoLoggingT IO ()
|
||||||
addSap n =
|
addSap n =
|
||||||
upsertUserTx
|
upsertUserTx
|
||||||
(walletSapNoteTx $ entityVal n)
|
(walletSapNoteTx $ entityVal n)
|
||||||
(entityKey w)
|
(entityKey w)
|
||||||
(fromIntegral $ walletSapNoteValue $ entityVal n)
|
(fromIntegral $ walletSapNoteValue $ entityVal n)
|
||||||
(walletSapNoteMemo $ entityVal n)
|
(walletSapNoteMemo $ entityVal n)
|
||||||
addOrch :: Entity WalletOrchNote -> IO ()
|
addOrch :: Entity WalletOrchNote -> NoLoggingT IO ()
|
||||||
addOrch n =
|
addOrch n =
|
||||||
upsertUserTx
|
upsertUserTx
|
||||||
(walletOrchNoteTx $ entityVal n)
|
(walletOrchNoteTx $ entityVal n)
|
||||||
(entityKey w)
|
(entityKey w)
|
||||||
(fromIntegral $ walletOrchNoteValue $ entityVal n)
|
(fromIntegral $ walletOrchNoteValue $ entityVal n)
|
||||||
(walletOrchNoteMemo $ entityVal n)
|
(walletOrchNoteMemo $ entityVal n)
|
||||||
subTSpend :: Entity WalletTrSpend -> IO ()
|
subTSpend :: Entity WalletTrSpend -> NoLoggingT IO ()
|
||||||
subTSpend n =
|
subTSpend n =
|
||||||
upsertUserTx
|
upsertUserTx
|
||||||
(walletTrSpendTx $ entityVal n)
|
(walletTrSpendTx $ entityVal n)
|
||||||
(entityKey w)
|
(entityKey w)
|
||||||
(-(fromIntegral $ walletTrSpendValue $ entityVal n))
|
(-(fromIntegral $ walletTrSpendValue $ entityVal n))
|
||||||
""
|
""
|
||||||
subSSpend :: Entity WalletSapSpend -> IO ()
|
subSSpend :: Entity WalletSapSpend -> NoLoggingT IO ()
|
||||||
subSSpend n =
|
subSSpend n =
|
||||||
upsertUserTx
|
upsertUserTx
|
||||||
(walletSapSpendTx $ entityVal n)
|
(walletSapSpendTx $ entityVal n)
|
||||||
(entityKey w)
|
(entityKey w)
|
||||||
(-(fromIntegral $ walletSapSpendValue $ entityVal n))
|
(-(fromIntegral $ walletSapSpendValue $ entityVal n))
|
||||||
""
|
""
|
||||||
subOSpend :: Entity WalletOrchSpend -> IO ()
|
subOSpend :: Entity WalletOrchSpend -> NoLoggingT IO ()
|
||||||
subOSpend n =
|
subOSpend n =
|
||||||
upsertUserTx
|
upsertUserTx
|
||||||
(walletOrchSpendTx $ entityVal n)
|
(walletOrchSpendTx $ entityVal n)
|
||||||
|
@ -887,16 +960,22 @@ getWalletTransactions dbPath w = do
|
||||||
(-(fromIntegral $ walletOrchSpendValue $ entityVal n))
|
(-(fromIntegral $ walletOrchSpendValue $ entityVal n))
|
||||||
""
|
""
|
||||||
upsertUserTx ::
|
upsertUserTx ::
|
||||||
WalletTransactionId -> WalletAddressId -> Int -> T.Text -> IO ()
|
WalletTransactionId
|
||||||
|
-> WalletAddressId
|
||||||
|
-> Int
|
||||||
|
-> T.Text
|
||||||
|
-> NoLoggingT IO ()
|
||||||
upsertUserTx tId wId amt memo = do
|
upsertUserTx tId wId amt memo = do
|
||||||
tr <-
|
tr <-
|
||||||
PS.runSqlite dbPath $ do
|
PS.retryOnBusy $
|
||||||
|
flip PS.runSqlPool pool $ do
|
||||||
select $ do
|
select $ do
|
||||||
tx <- from $ table @WalletTransaction
|
tx <- from $ table @WalletTransaction
|
||||||
where_ (tx ^. WalletTransactionId ==. val tId)
|
where_ (tx ^. WalletTransactionId ==. val tId)
|
||||||
pure tx
|
pure tx
|
||||||
existingUtx <-
|
existingUtx <-
|
||||||
PS.runSqlite dbPath $ do
|
PS.retryOnBusy $
|
||||||
|
flip PS.runSqlPool pool $ do
|
||||||
selectOne $ do
|
selectOne $ do
|
||||||
ut <- from $ table @UserTx
|
ut <- from $ table @UserTx
|
||||||
where_
|
where_
|
||||||
|
@ -907,7 +986,8 @@ getWalletTransactions dbPath w = do
|
||||||
case existingUtx of
|
case existingUtx of
|
||||||
Nothing -> do
|
Nothing -> do
|
||||||
_ <-
|
_ <-
|
||||||
PS.runSqlite dbPath $ do
|
PS.retryOnBusy $
|
||||||
|
flip PS.runSqlPool pool $ do
|
||||||
upsert
|
upsert
|
||||||
(UserTx
|
(UserTx
|
||||||
(walletTransactionTxId $ entityVal $ head tr)
|
(walletTransactionTxId $ entityVal $ head tr)
|
||||||
|
@ -919,7 +999,8 @@ getWalletTransactions dbPath w = do
|
||||||
return ()
|
return ()
|
||||||
Just uTx -> do
|
Just uTx -> do
|
||||||
_ <-
|
_ <-
|
||||||
PS.runSqlite dbPath $ do
|
PS.retryOnBusy $
|
||||||
|
flip PS.runSqlPool pool $ do
|
||||||
update $ \t -> do
|
update $ \t -> do
|
||||||
set
|
set
|
||||||
t
|
t
|
||||||
|
@ -930,33 +1011,40 @@ getWalletTransactions dbPath w = do
|
||||||
where_ (t ^. UserTxId ==. val (entityKey uTx))
|
where_ (t ^. UserTxId ==. val (entityKey uTx))
|
||||||
return ()
|
return ()
|
||||||
|
|
||||||
getUserTx :: T.Text -> WalletAddressId -> IO [Entity UserTx]
|
getUserTx :: ConnectionPool -> WalletAddressId -> IO [Entity UserTx]
|
||||||
getUserTx dbPath aId = do
|
getUserTx pool aId = do
|
||||||
PS.runSqlite dbPath $ do
|
runNoLoggingT $
|
||||||
|
PS.retryOnBusy $
|
||||||
|
flip PS.runSqlPool pool $ do
|
||||||
select $ do
|
select $ do
|
||||||
uTxs <- from $ table @UserTx
|
uTxs <- from $ table @UserTx
|
||||||
where_ (uTxs ^. UserTxAddress ==. val aId)
|
where_ (uTxs ^. UserTxAddress ==. val aId)
|
||||||
|
orderBy [asc $ uTxs ^. UserTxTime]
|
||||||
return uTxs
|
return uTxs
|
||||||
|
|
||||||
-- | Get wallet transparent notes by account
|
-- | Get wallet transparent notes by account
|
||||||
getWalletTrNotes :: T.Text -> ZcashAccountId -> IO [Entity WalletTrNote]
|
getWalletTrNotes :: ConnectionPool -> ZcashAccountId -> IO [Entity WalletTrNote]
|
||||||
getWalletTrNotes dbPath za = do
|
getWalletTrNotes pool za = do
|
||||||
PS.runSqlite dbPath $ do
|
runNoLoggingT $
|
||||||
|
PS.retryOnBusy $
|
||||||
|
flip PS.runSqlPool pool $ do
|
||||||
select $ do
|
select $ do
|
||||||
n <- from $ table @WalletTrNote
|
n <- from $ table @WalletTrNote
|
||||||
where_ (n ^. WalletTrNoteAccId ==. val za)
|
where_ (n ^. WalletTrNoteAccId ==. val za)
|
||||||
pure n
|
pure n
|
||||||
|
|
||||||
-- | find Transparent spends
|
-- | find Transparent spends
|
||||||
findTransparentSpends :: T.Text -> ZcashAccountId -> IO ()
|
findTransparentSpends :: ConnectionPool -> ZcashAccountId -> IO ()
|
||||||
findTransparentSpends dbPath za = do
|
findTransparentSpends pool za = do
|
||||||
notes <- getWalletTrNotes dbPath za
|
notes <- getWalletTrNotes pool za
|
||||||
mapM_ findOneTrSpend notes
|
mapM_ findOneTrSpend notes
|
||||||
where
|
where
|
||||||
findOneTrSpend :: Entity WalletTrNote -> IO ()
|
findOneTrSpend :: Entity WalletTrNote -> IO ()
|
||||||
findOneTrSpend n = do
|
findOneTrSpend n = do
|
||||||
mReverseTxId <-
|
mReverseTxId <-
|
||||||
PS.runSqlite dbPath $ do
|
runNoLoggingT $
|
||||||
|
PS.retryOnBusy $
|
||||||
|
flip PS.runSqlPool pool $ do
|
||||||
selectOne $ do
|
selectOne $ do
|
||||||
wtx <- from $ table @WalletTransaction
|
wtx <- from $ table @WalletTransaction
|
||||||
where_
|
where_
|
||||||
|
@ -969,7 +1057,9 @@ findTransparentSpends dbPath za = do
|
||||||
HexStringDB $
|
HexStringDB $
|
||||||
HexString $ BS.reverse $ toBytes $ getHex reverseTxId
|
HexString $ BS.reverse $ toBytes $ getHex reverseTxId
|
||||||
s <-
|
s <-
|
||||||
PS.runSqlite dbPath $ do
|
runNoLoggingT $
|
||||||
|
PS.retryOnBusy $
|
||||||
|
flip PS.runSqlPool pool $ do
|
||||||
select $ do
|
select $ do
|
||||||
(tx :& trSpends) <-
|
(tx :& trSpends) <-
|
||||||
from $
|
from $
|
||||||
|
@ -985,7 +1075,9 @@ findTransparentSpends dbPath za = do
|
||||||
if null s
|
if null s
|
||||||
then return ()
|
then return ()
|
||||||
else do
|
else do
|
||||||
PS.runSqlite dbPath $ do
|
runNoLoggingT $
|
||||||
|
PS.retryOnBusy $
|
||||||
|
flip PS.runSqlPool pool $ do
|
||||||
_ <-
|
_ <-
|
||||||
update $ \w -> do
|
update $ \w -> do
|
||||||
set w [WalletTrNoteSpent =. val True]
|
set w [WalletTrNoteSpent =. val True]
|
||||||
|
@ -998,20 +1090,26 @@ findTransparentSpends dbPath za = do
|
||||||
za
|
za
|
||||||
(walletTrNoteValue $ entityVal n)
|
(walletTrNoteValue $ entityVal n)
|
||||||
|
|
||||||
getWalletSapNotes :: T.Text -> ZcashAccountId -> IO [Entity WalletSapNote]
|
getWalletSapNotes ::
|
||||||
getWalletSapNotes dbPath za = do
|
ConnectionPool -> ZcashAccountId -> IO [Entity WalletSapNote]
|
||||||
PS.runSqlite dbPath $ do
|
getWalletSapNotes pool za = do
|
||||||
|
runNoLoggingT $
|
||||||
|
PS.retryOnBusy $
|
||||||
|
flip PS.runSqlPool pool $ do
|
||||||
select $ do
|
select $ do
|
||||||
n <- from $ table @WalletSapNote
|
n <- from $ table @WalletSapNote
|
||||||
where_ (n ^. WalletSapNoteAccId ==. val za)
|
where_ (n ^. WalletSapNoteAccId ==. val za)
|
||||||
pure n
|
pure n
|
||||||
|
|
||||||
-- | Sapling DAG-aware spend tracking
|
-- | Sapling DAG-aware spend tracking
|
||||||
findSapSpends :: T.Text -> ZcashAccountId -> [Entity WalletSapNote] -> IO ()
|
findSapSpends ::
|
||||||
|
ConnectionPool -> ZcashAccountId -> [Entity WalletSapNote] -> IO ()
|
||||||
findSapSpends _ _ [] = return ()
|
findSapSpends _ _ [] = return ()
|
||||||
findSapSpends dbPath za (n:notes) = do
|
findSapSpends pool za (n:notes) = do
|
||||||
s <-
|
s <-
|
||||||
PS.runSqlite dbPath $ do
|
runNoLoggingT $
|
||||||
|
PS.retryOnBusy $
|
||||||
|
flip PS.runSqlPool pool $ do
|
||||||
select $ do
|
select $ do
|
||||||
(tx :& sapSpends) <-
|
(tx :& sapSpends) <-
|
||||||
from $ table @ZcashTransaction `innerJoin` table @ShieldSpend `on`
|
from $ table @ZcashTransaction `innerJoin` table @ShieldSpend `on`
|
||||||
|
@ -1022,9 +1120,11 @@ findSapSpends dbPath za (n:notes) = do
|
||||||
val (walletSapNoteNullifier (entityVal n)))
|
val (walletSapNoteNullifier (entityVal n)))
|
||||||
pure (tx, sapSpends)
|
pure (tx, sapSpends)
|
||||||
if null s
|
if null s
|
||||||
then findSapSpends dbPath za notes
|
then findSapSpends pool za notes
|
||||||
else do
|
else do
|
||||||
PS.runSqlite dbPath $ do
|
runNoLoggingT $
|
||||||
|
PS.retryOnBusy $
|
||||||
|
flip PS.runSqlPool pool $ do
|
||||||
_ <-
|
_ <-
|
||||||
update $ \w -> do
|
update $ \w -> do
|
||||||
set w [WalletSapNoteSpent =. val True]
|
set w [WalletSapNoteSpent =. val True]
|
||||||
|
@ -1036,19 +1136,24 @@ findSapSpends dbPath za (n:notes) = do
|
||||||
(entityKey n)
|
(entityKey n)
|
||||||
za
|
za
|
||||||
(walletSapNoteValue $ entityVal n)
|
(walletSapNoteValue $ entityVal n)
|
||||||
findSapSpends dbPath za notes
|
findSapSpends pool za notes
|
||||||
|
|
||||||
getWalletOrchNotes :: T.Text -> ZcashAccountId -> IO [Entity WalletOrchNote]
|
getWalletOrchNotes ::
|
||||||
getWalletOrchNotes dbPath za = do
|
ConnectionPool -> ZcashAccountId -> IO [Entity WalletOrchNote]
|
||||||
PS.runSqlite dbPath $ do
|
getWalletOrchNotes pool za = do
|
||||||
|
runNoLoggingT $
|
||||||
|
PS.retryOnBusy $
|
||||||
|
flip PS.runSqlPool pool $ do
|
||||||
select $ do
|
select $ do
|
||||||
n <- from $ table @WalletOrchNote
|
n <- from $ table @WalletOrchNote
|
||||||
where_ (n ^. WalletOrchNoteAccId ==. val za)
|
where_ (n ^. WalletOrchNoteAccId ==. val za)
|
||||||
pure n
|
pure n
|
||||||
|
|
||||||
getUnspentSapNotes :: T.Text -> IO [Entity WalletSapNote]
|
getUnspentSapNotes :: ConnectionPool -> IO [Entity WalletSapNote]
|
||||||
getUnspentSapNotes dbPath = do
|
getUnspentSapNotes pool = do
|
||||||
PS.runSqlite dbPath $ do
|
runNoLoggingT $
|
||||||
|
PS.retryOnBusy $
|
||||||
|
flip PS.runSqlPool pool $ do
|
||||||
select $ do
|
select $ do
|
||||||
n <- from $ table @WalletSapNote
|
n <- from $ table @WalletSapNote
|
||||||
where_ (n ^. WalletSapNoteSpent ==. val False)
|
where_ (n ^. WalletSapNoteSpent ==. val False)
|
||||||
|
@ -1093,9 +1198,11 @@ updateSapNoteRecord pool n w o = do
|
||||||
]
|
]
|
||||||
where_ (x ^. WalletSapNoteId ==. val n)
|
where_ (x ^. WalletSapNoteId ==. val n)
|
||||||
|
|
||||||
getUnspentOrchNotes :: T.Text -> IO [Entity WalletOrchNote]
|
getUnspentOrchNotes :: ConnectionPool -> IO [Entity WalletOrchNote]
|
||||||
getUnspentOrchNotes dbPath = do
|
getUnspentOrchNotes pool = do
|
||||||
PS.runSqlite dbPath $ do
|
runNoLoggingT $
|
||||||
|
PS.retryOnBusy $
|
||||||
|
flip PS.runSqlPool pool $ do
|
||||||
select $ do
|
select $ do
|
||||||
n <- from $ table @WalletOrchNote
|
n <- from $ table @WalletOrchNote
|
||||||
where_ (n ^. WalletOrchNoteSpent ==. val False)
|
where_ (n ^. WalletOrchNoteSpent ==. val False)
|
||||||
|
@ -1140,11 +1247,14 @@ updateOrchNoteRecord pool n w o = do
|
||||||
]
|
]
|
||||||
where_ (x ^. WalletOrchNoteId ==. val n)
|
where_ (x ^. WalletOrchNoteId ==. val n)
|
||||||
|
|
||||||
findOrchSpends :: T.Text -> ZcashAccountId -> [Entity WalletOrchNote] -> IO ()
|
findOrchSpends ::
|
||||||
|
ConnectionPool -> ZcashAccountId -> [Entity WalletOrchNote] -> IO ()
|
||||||
findOrchSpends _ _ [] = return ()
|
findOrchSpends _ _ [] = return ()
|
||||||
findOrchSpends dbPath za (n:notes) = do
|
findOrchSpends pool za (n:notes) = do
|
||||||
s <-
|
s <-
|
||||||
PS.runSqlite dbPath $ do
|
runNoLoggingT $
|
||||||
|
PS.retryOnBusy $
|
||||||
|
flip PS.runSqlPool pool $ do
|
||||||
select $ do
|
select $ do
|
||||||
(tx :& orchSpends) <-
|
(tx :& orchSpends) <-
|
||||||
from $ table @ZcashTransaction `innerJoin` table @OrchAction `on`
|
from $ table @ZcashTransaction `innerJoin` table @OrchAction `on`
|
||||||
|
@ -1155,9 +1265,11 @@ findOrchSpends dbPath za (n:notes) = do
|
||||||
val (walletOrchNoteNullifier (entityVal n)))
|
val (walletOrchNoteNullifier (entityVal n)))
|
||||||
pure (tx, orchSpends)
|
pure (tx, orchSpends)
|
||||||
if null s
|
if null s
|
||||||
then findOrchSpends dbPath za notes
|
then findOrchSpends pool za notes
|
||||||
else do
|
else do
|
||||||
PS.runSqlite dbPath $ do
|
runNoLoggingT $
|
||||||
|
PS.retryOnBusy $
|
||||||
|
flip PS.runSqlPool pool $ do
|
||||||
_ <-
|
_ <-
|
||||||
update $ \w -> do
|
update $ \w -> do
|
||||||
set w [WalletOrchNoteSpent =. val True]
|
set w [WalletOrchNoteSpent =. val True]
|
||||||
|
@ -1169,7 +1281,7 @@ findOrchSpends dbPath za (n:notes) = do
|
||||||
(entityKey n)
|
(entityKey n)
|
||||||
za
|
za
|
||||||
(walletOrchNoteValue $ entityVal n)
|
(walletOrchNoteValue $ entityVal n)
|
||||||
findOrchSpends dbPath za notes
|
findOrchSpends pool za notes
|
||||||
|
|
||||||
upsertWalTx ::
|
upsertWalTx ::
|
||||||
MonadIO m
|
MonadIO m
|
||||||
|
@ -1186,22 +1298,24 @@ upsertWalTx zt za =
|
||||||
(zcashTransactionTime zt))
|
(zcashTransactionTime zt))
|
||||||
[]
|
[]
|
||||||
|
|
||||||
getBalance :: T.Text -> ZcashAccountId -> IO Integer
|
getBalance :: ConnectionPool -> ZcashAccountId -> IO Integer
|
||||||
getBalance dbPath za = do
|
getBalance pool za = do
|
||||||
trNotes <- getWalletUnspentTrNotes dbPath za
|
trNotes <- getWalletUnspentTrNotes pool za
|
||||||
let tAmts = map (walletTrNoteValue . entityVal) trNotes
|
let tAmts = map (walletTrNoteValue . entityVal) trNotes
|
||||||
let tBal = sum tAmts
|
let tBal = sum tAmts
|
||||||
sapNotes <- getWalletUnspentSapNotes dbPath za
|
sapNotes <- getWalletUnspentSapNotes pool za
|
||||||
let sAmts = map (walletSapNoteValue . entityVal) sapNotes
|
let sAmts = map (walletSapNoteValue . entityVal) sapNotes
|
||||||
let sBal = sum sAmts
|
let sBal = sum sAmts
|
||||||
orchNotes <- getWalletUnspentOrchNotes dbPath za
|
orchNotes <- getWalletUnspentOrchNotes pool za
|
||||||
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
|
||||||
|
|
||||||
clearWalletTransactions :: T.Text -> IO ()
|
clearWalletTransactions :: ConnectionPool -> IO ()
|
||||||
clearWalletTransactions dbPath = do
|
clearWalletTransactions pool = do
|
||||||
PS.runSqlite dbPath $ do
|
runNoLoggingT $
|
||||||
|
PS.retryOnBusy $
|
||||||
|
flip PS.runSqlPool pool $ do
|
||||||
delete $ do
|
delete $ do
|
||||||
_ <- from $ table @WalletOrchSpend
|
_ <- from $ table @WalletOrchSpend
|
||||||
return ()
|
return ()
|
||||||
|
@ -1227,9 +1341,12 @@ clearWalletTransactions dbPath = do
|
||||||
_ <- from $ table @UserTx
|
_ <- from $ table @UserTx
|
||||||
return ()
|
return ()
|
||||||
|
|
||||||
getWalletUnspentTrNotes :: T.Text -> ZcashAccountId -> IO [Entity WalletTrNote]
|
getWalletUnspentTrNotes ::
|
||||||
getWalletUnspentTrNotes dbPath za = do
|
ConnectionPool -> ZcashAccountId -> IO [Entity WalletTrNote]
|
||||||
PS.runSqlite dbPath $ do
|
getWalletUnspentTrNotes pool za = do
|
||||||
|
runNoLoggingT $
|
||||||
|
PS.retryOnBusy $
|
||||||
|
flip PS.runSqlPool pool $ do
|
||||||
select $ do
|
select $ do
|
||||||
n <- from $ table @WalletTrNote
|
n <- from $ table @WalletTrNote
|
||||||
where_ (n ^. WalletTrNoteAccId ==. val za)
|
where_ (n ^. WalletTrNoteAccId ==. val za)
|
||||||
|
@ -1237,9 +1354,11 @@ getWalletUnspentTrNotes dbPath za = do
|
||||||
pure n
|
pure n
|
||||||
|
|
||||||
getWalletUnspentSapNotes ::
|
getWalletUnspentSapNotes ::
|
||||||
T.Text -> ZcashAccountId -> IO [Entity WalletSapNote]
|
ConnectionPool -> ZcashAccountId -> IO [Entity WalletSapNote]
|
||||||
getWalletUnspentSapNotes dbPath za = do
|
getWalletUnspentSapNotes pool za = do
|
||||||
PS.runSqlite dbPath $ do
|
runNoLoggingT $
|
||||||
|
PS.retryOnBusy $
|
||||||
|
flip PS.runSqlPool pool $ do
|
||||||
select $ do
|
select $ do
|
||||||
n1 <- from $ table @WalletSapNote
|
n1 <- from $ table @WalletSapNote
|
||||||
where_ (n1 ^. WalletSapNoteAccId ==. val za)
|
where_ (n1 ^. WalletSapNoteAccId ==. val za)
|
||||||
|
@ -1247,9 +1366,11 @@ getWalletUnspentSapNotes dbPath za = do
|
||||||
pure n1
|
pure n1
|
||||||
|
|
||||||
getWalletUnspentOrchNotes ::
|
getWalletUnspentOrchNotes ::
|
||||||
T.Text -> ZcashAccountId -> IO [Entity WalletOrchNote]
|
ConnectionPool -> ZcashAccountId -> IO [Entity WalletOrchNote]
|
||||||
getWalletUnspentOrchNotes dbPath za = do
|
getWalletUnspentOrchNotes pool za = do
|
||||||
PS.runSqlite dbPath $ do
|
runNoLoggingT $
|
||||||
|
PS.retryOnBusy $
|
||||||
|
flip PS.runSqlPool pool $ do
|
||||||
select $ do
|
select $ do
|
||||||
n2 <- from $ table @WalletOrchNote
|
n2 <- from $ table @WalletOrchNote
|
||||||
where_ (n2 ^. WalletOrchNoteAccId ==. val za)
|
where_ (n2 ^. WalletOrchNoteAccId ==. val za)
|
||||||
|
@ -1257,20 +1378,20 @@ getWalletUnspentOrchNotes dbPath za = do
|
||||||
pure n2
|
pure n2
|
||||||
|
|
||||||
selectUnspentNotes ::
|
selectUnspentNotes ::
|
||||||
T.Text
|
ConnectionPool
|
||||||
-> ZcashAccountId
|
-> ZcashAccountId
|
||||||
-> Integer
|
-> Integer
|
||||||
-> IO ([Entity WalletTrNote], [Entity WalletSapNote], [Entity WalletOrchNote])
|
-> IO ([Entity WalletTrNote], [Entity WalletSapNote], [Entity WalletOrchNote])
|
||||||
selectUnspentNotes dbPath za amt = do
|
selectUnspentNotes pool za amt = do
|
||||||
trNotes <- getWalletUnspentTrNotes dbPath za
|
trNotes <- getWalletUnspentTrNotes pool za
|
||||||
let (a1, tList) = checkTransparent (fromIntegral amt) trNotes
|
let (a1, tList) = checkTransparent (fromIntegral amt) trNotes
|
||||||
if a1 > 0
|
if a1 > 0
|
||||||
then do
|
then do
|
||||||
sapNotes <- getWalletUnspentSapNotes dbPath za
|
sapNotes <- getWalletUnspentSapNotes pool za
|
||||||
let (a2, sList) = checkSapling a1 sapNotes
|
let (a2, sList) = checkSapling a1 sapNotes
|
||||||
if a2 > 0
|
if a2 > 0
|
||||||
then do
|
then do
|
||||||
orchNotes <- getWalletUnspentOrchNotes dbPath za
|
orchNotes <- getWalletUnspentOrchNotes pool za
|
||||||
let (a3, oList) = checkOrchard a2 orchNotes
|
let (a3, oList) = checkOrchard a2 orchNotes
|
||||||
if a3 > 0
|
if a3 > 0
|
||||||
then throwIO $ userError "Not enough funds"
|
then throwIO $ userError "Not enough funds"
|
||||||
|
@ -1304,9 +1425,12 @@ selectUnspentNotes dbPath za amt = do
|
||||||
, n : snd (checkOrchard (x - walletOrchNoteValue (entityVal n)) ns))
|
, n : snd (checkOrchard (x - walletOrchNoteValue (entityVal n)) ns))
|
||||||
else (0, [n])
|
else (0, [n])
|
||||||
|
|
||||||
getWalletTxId :: T.Text -> WalletTransactionId -> IO (Maybe (Value HexStringDB))
|
getWalletTxId ::
|
||||||
getWalletTxId dbPath wId = do
|
ConnectionPool -> WalletTransactionId -> IO (Maybe (Value HexStringDB))
|
||||||
PS.runSqlite dbPath $ do
|
getWalletTxId pool wId = do
|
||||||
|
runNoLoggingT $
|
||||||
|
PS.retryOnBusy $
|
||||||
|
flip PS.runSqlPool pool $ do
|
||||||
selectOne $ do
|
selectOne $ do
|
||||||
wtx <- from $ table @WalletTransaction
|
wtx <- from $ table @WalletTransaction
|
||||||
where_ (wtx ^. WalletTransactionId ==. val wId)
|
where_ (wtx ^. WalletTransactionId ==. val wId)
|
||||||
|
|
|
@ -3,11 +3,23 @@
|
||||||
module Zenith.Scanner where
|
module Zenith.Scanner where
|
||||||
|
|
||||||
import Control.Exception (throwIO, try)
|
import Control.Exception (throwIO, try)
|
||||||
|
import qualified Control.Monad.Catch as CM (try)
|
||||||
|
import Control.Monad.IO.Class (liftIO)
|
||||||
|
import Control.Monad.Logger
|
||||||
|
( LoggingT
|
||||||
|
, NoLoggingT
|
||||||
|
, logErrorN
|
||||||
|
, logInfoN
|
||||||
|
, runNoLoggingT
|
||||||
|
)
|
||||||
import Data.Aeson
|
import Data.Aeson
|
||||||
import Data.HexString
|
import Data.HexString
|
||||||
import Data.Maybe
|
import Data.Maybe
|
||||||
import qualified Data.Text as T
|
import qualified Data.Text as T
|
||||||
|
import Data.Time (getCurrentTime)
|
||||||
|
import Database.Persist.Sqlite
|
||||||
import GHC.Utils.Monad (concatMapM)
|
import GHC.Utils.Monad (concatMapM)
|
||||||
|
import Lens.Micro ((&), (.~), (^.), set)
|
||||||
import System.Console.AsciiProgress
|
import System.Console.AsciiProgress
|
||||||
import ZcashHaskell.Types
|
import ZcashHaskell.Types
|
||||||
( BlockResponse(..)
|
( BlockResponse(..)
|
||||||
|
@ -30,64 +42,77 @@ scanZebra ::
|
||||||
-> T.Text -- ^ Host
|
-> T.Text -- ^ Host
|
||||||
-> Int -- ^ Port
|
-> Int -- ^ Port
|
||||||
-> T.Text -- ^ Path to database file
|
-> T.Text -- ^ Path to database file
|
||||||
-> IO ()
|
-> NoLoggingT IO ()
|
||||||
scanZebra b host port dbFilePath = do
|
scanZebra b host port dbFilePath = do
|
||||||
_ <- initDb dbFilePath
|
_ <- liftIO $ initDb dbFilePath
|
||||||
|
startTime <- liftIO getCurrentTime
|
||||||
|
logInfoN $ "Started sync: " <> T.pack (show startTime)
|
||||||
bc <-
|
bc <-
|
||||||
try $ checkBlockChain host port :: IO
|
liftIO $ try $ checkBlockChain host port :: NoLoggingT
|
||||||
|
IO
|
||||||
(Either IOError ZebraGetBlockChainInfo)
|
(Either IOError ZebraGetBlockChainInfo)
|
||||||
case bc of
|
case bc of
|
||||||
Left e -> print e
|
Left e -> logErrorN $ T.pack (show e)
|
||||||
Right bStatus -> do
|
Right bStatus -> do
|
||||||
dbBlock <- getMaxBlock dbFilePath
|
let dbInfo =
|
||||||
|
mkSqliteConnectionInfo dbFilePath & extraPragmas .~
|
||||||
|
["read_uncommited = true"]
|
||||||
|
pool <- createSqlitePoolFromInfo dbInfo 5
|
||||||
|
dbBlock <- getMaxBlock pool
|
||||||
let sb = max dbBlock b
|
let sb = max dbBlock b
|
||||||
if sb > zgb_blocks bStatus || sb < 1
|
if sb > zgb_blocks bStatus || sb < 1
|
||||||
then throwIO $ userError "Invalid starting block for scan"
|
then liftIO $ throwIO $ userError "Invalid starting block for scan"
|
||||||
else do
|
else do
|
||||||
|
liftIO $
|
||||||
print $
|
print $
|
||||||
"Scanning from " ++
|
"Scanning from " ++
|
||||||
show (sb + 1) ++ " to " ++ show (zgb_blocks bStatus)
|
show (sb + 1) ++ " to " ++ show (zgb_blocks bStatus)
|
||||||
let bList = [(sb + 1) .. (zgb_blocks bStatus)]
|
let bList = [(sb + 1) .. (zgb_blocks bStatus)]
|
||||||
displayConsoleRegions $ do
|
displayConsoleRegions $ do
|
||||||
pg <- newProgressBar def {pgTotal = fromIntegral $ length bList}
|
pg <-
|
||||||
|
liftIO $
|
||||||
|
newProgressBar def {pgTotal = fromIntegral $ length bList}
|
||||||
txList <-
|
txList <-
|
||||||
try $ mapM_ (processBlock host port dbFilePath pg) bList :: IO
|
CM.try $ mapM_ (processBlock host port pool pg) bList :: NoLoggingT
|
||||||
|
IO
|
||||||
(Either IOError ())
|
(Either IOError ())
|
||||||
case txList of
|
case txList of
|
||||||
Left e1 -> print e1
|
Left e1 -> logErrorN $ T.pack (show e1)
|
||||||
Right txList' -> print txList'
|
Right txList' -> logInfoN "Finished scan"
|
||||||
|
|
||||||
-- | Function to process a raw block and extract the transaction information
|
-- | Function to process a raw block and extract the transaction information
|
||||||
processBlock ::
|
processBlock ::
|
||||||
T.Text -- ^ Host name for `zebrad`
|
T.Text -- ^ Host name for `zebrad`
|
||||||
-> Int -- ^ Port for `zebrad`
|
-> Int -- ^ Port for `zebrad`
|
||||||
-> T.Text -- ^ DB file path
|
-> ConnectionPool -- ^ DB file path
|
||||||
-> ProgressBar -- ^ Progress bar
|
-> ProgressBar -- ^ Progress bar
|
||||||
-> Int -- ^ The block number to process
|
-> Int -- ^ The block number to process
|
||||||
-> IO ()
|
-> NoLoggingT IO ()
|
||||||
processBlock host port dbFp pg b = do
|
processBlock host port pool pg b = do
|
||||||
r <-
|
r <-
|
||||||
|
liftIO $
|
||||||
makeZebraCall
|
makeZebraCall
|
||||||
host
|
host
|
||||||
port
|
port
|
||||||
"getblock"
|
"getblock"
|
||||||
[Data.Aeson.String $ T.pack $ show b, jsonNumber 1]
|
[Data.Aeson.String $ T.pack $ show b, jsonNumber 1]
|
||||||
case r of
|
case r of
|
||||||
Left e -> throwIO $ userError e
|
Left e -> liftIO $ throwIO $ userError e
|
||||||
Right blk -> do
|
Right blk -> do
|
||||||
r2 <-
|
r2 <-
|
||||||
|
liftIO $
|
||||||
makeZebraCall
|
makeZebraCall
|
||||||
host
|
host
|
||||||
port
|
port
|
||||||
"getblock"
|
"getblock"
|
||||||
[Data.Aeson.String $ T.pack $ show b, jsonNumber 0]
|
[Data.Aeson.String $ T.pack $ show b, jsonNumber 0]
|
||||||
case r2 of
|
case r2 of
|
||||||
Left e2 -> throwIO $ userError e2
|
Left e2 -> liftIO $ throwIO $ userError e2
|
||||||
Right hb -> do
|
Right hb -> do
|
||||||
let blockTime = getBlockTime hb
|
let blockTime = getBlockTime hb
|
||||||
mapM_ (processTx host port blockTime dbFp) $
|
mapM_ (processTx host port blockTime pool) $
|
||||||
bl_txs $ addTime blk blockTime
|
bl_txs $ addTime blk blockTime
|
||||||
tick pg
|
liftIO $ tick pg
|
||||||
where
|
where
|
||||||
addTime :: BlockResponse -> Int -> BlockResponse
|
addTime :: BlockResponse -> Int -> BlockResponse
|
||||||
addTime bl t =
|
addTime bl t =
|
||||||
|
@ -102,24 +127,25 @@ processTx ::
|
||||||
T.Text -- ^ Host name for `zebrad`
|
T.Text -- ^ Host name for `zebrad`
|
||||||
-> Int -- ^ Port for `zebrad`
|
-> Int -- ^ Port for `zebrad`
|
||||||
-> Int -- ^ Block time
|
-> Int -- ^ Block time
|
||||||
-> T.Text -- ^ DB file path
|
-> ConnectionPool -- ^ DB file path
|
||||||
-> HexString -- ^ transaction id
|
-> HexString -- ^ transaction id
|
||||||
-> IO ()
|
-> NoLoggingT IO ()
|
||||||
processTx host port bt dbFp t = do
|
processTx host port bt pool t = do
|
||||||
r <-
|
r <-
|
||||||
|
liftIO $
|
||||||
makeZebraCall
|
makeZebraCall
|
||||||
host
|
host
|
||||||
port
|
port
|
||||||
"getrawtransaction"
|
"getrawtransaction"
|
||||||
[Data.Aeson.String $ toText t, jsonNumber 1]
|
[Data.Aeson.String $ toText t, jsonNumber 1]
|
||||||
case r of
|
case r of
|
||||||
Left e -> throwIO $ userError e
|
Left e -> liftIO $ throwIO $ userError e
|
||||||
Right rawTx -> do
|
Right rawTx -> do
|
||||||
case readZebraTransaction (ztr_hex rawTx) of
|
case readZebraTransaction (ztr_hex rawTx) of
|
||||||
Nothing -> return ()
|
Nothing -> return ()
|
||||||
Just rzt -> do
|
Just rzt -> do
|
||||||
_ <-
|
_ <-
|
||||||
saveTransaction dbFp bt $
|
saveTransaction pool bt $
|
||||||
Transaction
|
Transaction
|
||||||
t
|
t
|
||||||
(ztr_blockheight rawTx)
|
(ztr_blockheight rawTx)
|
||||||
|
|
|
@ -46,6 +46,7 @@ library
|
||||||
, bytestring
|
, bytestring
|
||||||
, esqueleto
|
, esqueleto
|
||||||
, resource-pool
|
, resource-pool
|
||||||
|
, exceptions
|
||||||
, monad-logger
|
, monad-logger
|
||||||
, vty-crossplatform
|
, vty-crossplatform
|
||||||
, secp256k1-haskell
|
, secp256k1-haskell
|
||||||
|
@ -61,6 +62,7 @@ library
|
||||||
, microlens-th
|
, microlens-th
|
||||||
, mtl
|
, mtl
|
||||||
, persistent
|
, persistent
|
||||||
|
, Hclip
|
||||||
, persistent-sqlite
|
, persistent-sqlite
|
||||||
, persistent-template
|
, persistent-template
|
||||||
, process
|
, process
|
||||||
|
@ -105,6 +107,7 @@ executable zenscan
|
||||||
build-depends:
|
build-depends:
|
||||||
base >=4.12 && <5
|
base >=4.12 && <5
|
||||||
, configurator
|
, configurator
|
||||||
|
, monad-logger
|
||||||
, zenith
|
, zenith
|
||||||
pkgconfig-depends: rustzcash_wrapper
|
pkgconfig-depends: rustzcash_wrapper
|
||||||
default-language: Haskell2010
|
default-language: Haskell2010
|
||||||
|
|
Loading…
Reference in a new issue