Publish Zenith beta version #80
10 changed files with 1348 additions and 779 deletions
|
|
@ -18,7 +18,7 @@ import System.IO
|
|||
import Text.Read (readMaybe)
|
||||
import ZcashHaskell.Types
|
||||
import Zenith.CLI
|
||||
import Zenith.Core (clearSync, testSend, testSync)
|
||||
import Zenith.Core (clearSync, testSync)
|
||||
import Zenith.Types (Config(..), ZcashAddress(..), ZcashPool(..), ZcashTx(..))
|
||||
import Zenith.Utils
|
||||
import Zenith.Zcashd
|
||||
|
|
@ -223,7 +223,6 @@ main = do
|
|||
"cli" -> runZenithCLI myConfig
|
||||
"sync" -> testSync myConfig
|
||||
"rescan" -> clearSync myConfig
|
||||
"testsend" -> testSend
|
||||
_ -> printUsage
|
||||
else printUsage
|
||||
|
||||
|
|
|
|||
|
|
@ -2,6 +2,7 @@
|
|||
|
||||
module ZenScan where
|
||||
|
||||
import Control.Monad.Logger (runNoLoggingT)
|
||||
import Data.Configurator
|
||||
import Zenith.Scanner (scanZebra)
|
||||
|
||||
|
|
@ -11,4 +12,4 @@ main = do
|
|||
dbFilePath <- require config "dbFilePath"
|
||||
zebraPort <- require config "zebraPort"
|
||||
zebraHost <- require config "zebraHost"
|
||||
scanZebra 2762066 zebraHost zebraPort dbFilePath
|
||||
runNoLoggingT $ scanZebra 2762066 zebraHost zebraPort dbFilePath
|
||||
|
|
|
|||
|
|
@ -11,11 +11,15 @@ import qualified Brick.Focus as F
|
|||
import Brick.Forms
|
||||
( Form(..)
|
||||
, (@@=)
|
||||
, allFieldsValid
|
||||
, editShowableFieldWithValidate
|
||||
, editTextField
|
||||
, focusedFormInputAttr
|
||||
, handleFormEvent
|
||||
, invalidFormInputAttr
|
||||
, newForm
|
||||
, renderForm
|
||||
, setFieldValid
|
||||
, updateFormState
|
||||
)
|
||||
import qualified Brick.Main as M
|
||||
|
|
@ -49,29 +53,38 @@ import Brick.Widgets.Core
|
|||
, withBorderStyle
|
||||
)
|
||||
import qualified Brick.Widgets.Dialog as D
|
||||
import qualified Brick.Widgets.Edit as E
|
||||
import qualified Brick.Widgets.List as L
|
||||
import qualified Brick.Widgets.ProgressBar as P
|
||||
import Control.Concurrent (forkIO, threadDelay)
|
||||
import Control.Exception (catch, throw, throwIO, try)
|
||||
import Control.Monad (forever, void)
|
||||
import Control.Monad.IO.Class (liftIO)
|
||||
import Control.Monad.Logger (runFileLoggingT)
|
||||
import Control.Monad.Logger (LoggingT, runFileLoggingT, runNoLoggingT)
|
||||
import Data.Aeson
|
||||
import Data.HexString (toText)
|
||||
import Data.Maybe
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.Text.Encoding as E
|
||||
import Data.Time.Clock.POSIX (posixSecondsToUTCTime)
|
||||
import qualified Data.Vector as Vec
|
||||
import Database.Persist
|
||||
import Database.Persist.Sqlite
|
||||
import qualified Graphics.Vty as V
|
||||
import qualified Graphics.Vty.CrossPlatform as VC
|
||||
import Lens.Micro ((&), (.~), (^.), set)
|
||||
import Lens.Micro.Mtl
|
||||
import Lens.Micro.TH
|
||||
import System.Hclip
|
||||
import Text.Wrap (FillScope(..), FillStrategy(..), WrapSettings(..), wrapText)
|
||||
import ZcashHaskell.Keys (generateWalletSeedPhrase, getWalletSeed)
|
||||
import ZcashHaskell.Orchard (getSaplingFromUA, isValidUnifiedAddress)
|
||||
import ZcashHaskell.Transparent (encodeTransparentReceiver)
|
||||
import ZcashHaskell.Sapling (decodeSaplingAddress, isValidShieldedAddress)
|
||||
import ZcashHaskell.Transparent
|
||||
( decodeExchangeAddress
|
||||
, decodeTransparentAddress
|
||||
, encodeTransparentReceiver
|
||||
)
|
||||
import ZcashHaskell.Types
|
||||
import ZcashHaskell.Utils (getBlockTime, makeZebraCall)
|
||||
import Zenith.Core
|
||||
|
|
@ -92,6 +105,9 @@ data Name
|
|||
| TList
|
||||
| HelpDialog
|
||||
| DialogInputField
|
||||
| RecField
|
||||
| AmtField
|
||||
| MemoField
|
||||
deriving (Eq, Show, Ord)
|
||||
|
||||
data DialogInput = DialogInput
|
||||
|
|
@ -100,12 +116,21 @@ data DialogInput = DialogInput
|
|||
|
||||
makeLenses ''DialogInput
|
||||
|
||||
data SendInput = SendInput
|
||||
{ _sendTo :: !T.Text
|
||||
, _sendAmt :: !Float
|
||||
, _sendMemo :: !T.Text
|
||||
} deriving (Show)
|
||||
|
||||
makeLenses ''SendInput
|
||||
|
||||
data DialogType
|
||||
= WName
|
||||
| AName
|
||||
| AdName
|
||||
| WSelect
|
||||
| ASelect
|
||||
| SendTx
|
||||
| Blank
|
||||
|
||||
data DisplayType
|
||||
|
|
@ -114,10 +139,12 @@ data DisplayType
|
|||
| PhraseDisplay
|
||||
| TxDisplay
|
||||
| SyncDisplay
|
||||
| SendDisplay
|
||||
| BlankDisplay
|
||||
|
||||
data Tick =
|
||||
Tick
|
||||
data Tick
|
||||
= TickVal !Float
|
||||
| TickMsg !String
|
||||
|
||||
data State = State
|
||||
{ _network :: !ZcashNet
|
||||
|
|
@ -140,6 +167,8 @@ data State = State
|
|||
, _balance :: !Integer
|
||||
, _barValue :: !Float
|
||||
, _eventDispatch :: !(BC.BChan Tick)
|
||||
, _timer :: !Int
|
||||
, _txForm :: !(Form SendInput () Name)
|
||||
}
|
||||
|
||||
makeLenses ''State
|
||||
|
|
@ -178,13 +207,14 @@ drawUI s = [splashDialog s, helpDialog s, displayDialog s, inputDialog s, ui s]
|
|||
listAddressBox "Addresses" (st ^. addresses) <+>
|
||||
B.vBorder <+>
|
||||
(C.hCenter (str ("Last block seen: " ++ show (st ^. syncBlock))) <=>
|
||||
listTxBox "Transactions" (st ^. transactions))) <=>
|
||||
listTxBox "Transactions" (st ^. network) (st ^. transactions))) <=>
|
||||
C.hCenter
|
||||
(hBox
|
||||
[ capCommand "W" "allets"
|
||||
, capCommand "A" "ccounts"
|
||||
, capCommand "V" "iew address"
|
||||
, capCommand "Q" "uit"
|
||||
, str $ show (st ^. timer)
|
||||
])
|
||||
listBox :: Show e => String -> L.List Name e -> Widget Name
|
||||
listBox titleLabel l =
|
||||
|
|
@ -218,17 +248,28 @@ drawUI s = [splashDialog s, helpDialog s, displayDialog s, inputDialog s, ui s]
|
|||
(B.borderWithLabel (str titleLabel) $
|
||||
hLimit 40 $ vLimit 15 $ L.renderList listDrawAddress True a)
|
||||
, 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 titleLabel tx =
|
||||
listTxBox ::
|
||||
String -> ZcashNet -> L.List Name (Entity UserTx) -> Widget Name
|
||||
listTxBox titleLabel znet tx =
|
||||
C.vCenter $
|
||||
vBox
|
||||
[ C.hCenter
|
||||
(B.borderWithLabel (str titleLabel) $
|
||||
hLimit 40 $ vLimit 15 $ L.renderList listDrawTx True tx)
|
||||
hLimit 50 $ vLimit 15 $ L.renderList (listDrawTx znet) True tx)
|
||||
, str " "
|
||||
, C.hCenter $ str "Use arrows to select"
|
||||
, C.hCenter
|
||||
(hBox
|
||||
[ capCommand "↑↓ " "move"
|
||||
, capCommand "T" "x Display"
|
||||
, capCommand "Tab " "<-"
|
||||
])
|
||||
]
|
||||
helpDialog :: State -> Widget Name
|
||||
helpDialog st =
|
||||
|
|
@ -288,6 +329,12 @@ drawUI s = [splashDialog s, helpDialog s, displayDialog s, inputDialog s, ui s]
|
|||
, capCommand "N" "ew"
|
||||
, xCommand
|
||||
]))
|
||||
SendTx ->
|
||||
D.renderDialog
|
||||
(D.dialog (Just (str "Send Transaction")) Nothing 50)
|
||||
(renderForm (st ^. txForm) <=>
|
||||
C.hCenter
|
||||
(hBox [capCommand "↲ " "Send", capCommand "<esc> " "Cancel"]))
|
||||
Blank -> emptyWidget
|
||||
splashDialog :: State -> Widget Name
|
||||
splashDialog st =
|
||||
|
|
@ -337,7 +384,15 @@ drawUI s = [splashDialog s, helpDialog s, displayDialog s, inputDialog s, ui s]
|
|||
t_rec =<<
|
||||
(isValidUnifiedAddress .
|
||||
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
|
||||
PhraseDisplay ->
|
||||
case L.listSelectedElement $ st ^. wallets of
|
||||
|
|
@ -398,6 +453,11 @@ drawUI s = [splashDialog s, helpDialog s, displayDialog s, inputDialog s, ui s]
|
|||
(P.progressBar
|
||||
(Just $ show (st ^. barValue * 100))
|
||||
(_barValue st))))
|
||||
SendDisplay ->
|
||||
withBorderStyle unicodeBold $
|
||||
D.renderDialog
|
||||
(D.dialog (Just $ txt "Sending Transaction") Nothing 50)
|
||||
(padAll 1 (str $ st ^. msg))
|
||||
BlankDisplay -> emptyWidget
|
||||
|
||||
mkInputForm :: DialogInput -> Form DialogInput e Name
|
||||
|
|
@ -408,6 +468,33 @@ mkInputForm =
|
|||
label s w =
|
||||
padBottom (Pad 1) $ vLimit 1 (hLimit 15 $ str s <+> fill ' ') <+> w
|
||||
|
||||
mkSendForm :: Integer -> SendInput -> Form SendInput e Name
|
||||
mkSendForm bal =
|
||||
newForm
|
||||
[ label "To: " @@= editTextField sendTo RecField (Just 1)
|
||||
, label "Amount: " @@=
|
||||
editShowableFieldWithValidate sendAmt AmtField (isAmountValid bal)
|
||||
, label "Memo: " @@= editTextField sendMemo MemoField (Just 1)
|
||||
]
|
||||
where
|
||||
isAmountValid :: Integer -> Float -> Bool
|
||||
isAmountValid b i = (fromIntegral b * 100000000.0) >= i
|
||||
label s w =
|
||||
padBottom (Pad 1) $ vLimit 1 (hLimit 15 $ str s <+> fill ' ') <+> w
|
||||
|
||||
isRecipientValid :: T.Text -> Bool
|
||||
isRecipientValid a =
|
||||
case isValidUnifiedAddress (E.encodeUtf8 a) of
|
||||
Just _a1 -> True
|
||||
Nothing ->
|
||||
isValidShieldedAddress (E.encodeUtf8 a) ||
|
||||
(case decodeTransparentAddress (E.encodeUtf8 a) of
|
||||
Just _a3 -> True
|
||||
Nothing ->
|
||||
case decodeExchangeAddress a of
|
||||
Just _a4 -> True
|
||||
Nothing -> False)
|
||||
|
||||
listDrawElement :: (Show a) => Bool -> a -> Widget Name
|
||||
listDrawElement sel a =
|
||||
let selStr s =
|
||||
|
|
@ -443,18 +530,22 @@ listDrawAddress sel w =
|
|||
walletAddressName (entityVal w) <>
|
||||
": " <> showAddress (walletAddressUAddress (entityVal w))
|
||||
|
||||
listDrawTx :: Bool -> Entity UserTx -> Widget Name
|
||||
listDrawTx sel tx =
|
||||
listDrawTx :: ZcashNet -> Bool -> Entity UserTx -> Widget Name
|
||||
listDrawTx znet sel tx =
|
||||
selStr $
|
||||
T.pack
|
||||
(show $ posixSecondsToUTCTime (fromIntegral (userTxTime $ entityVal tx))) <>
|
||||
" " <> fmtAmt
|
||||
" " <> T.pack fmtAmt
|
||||
where
|
||||
amt = fromIntegral (userTxAmount $ entityVal tx) / 100000000
|
||||
amt = fromIntegral $ userTxAmount $ entityVal tx
|
||||
dispAmount =
|
||||
if znet == MainNet
|
||||
then displayZec amt
|
||||
else displayTaz amt
|
||||
fmtAmt =
|
||||
if amt > 0
|
||||
then "↘" <> T.pack (show amt) <> " "
|
||||
else " " <> T.pack (show amt) <> "↗"
|
||||
then "↘" <> dispAmount <> " "
|
||||
else " " <> dispAmount <> "↗"
|
||||
selStr s =
|
||||
if sel
|
||||
then withAttr customAttr (txt $ "> " <> s)
|
||||
|
|
@ -481,60 +572,49 @@ barToDoAttr = A.attrName "remaining"
|
|||
validBarValue :: Float -> Float
|
||||
validBarValue = clamp 0 1
|
||||
|
||||
scanZebra :: Int -> BT.EventM Name State ()
|
||||
scanZebra b = do
|
||||
s <- BT.get
|
||||
_ <- liftIO $ initDb $ s ^. dbPath
|
||||
bStatus <- liftIO $ checkBlockChain (s ^. zebraHost) (s ^. zebraPort)
|
||||
dbBlock <- liftIO $ getMaxBlock $ s ^. dbPath
|
||||
scanZebra :: T.Text -> T.Text -> Int -> Int -> BC.BChan Tick -> IO ()
|
||||
scanZebra dbP zHost zPort b eChan = do
|
||||
_ <- liftIO $ initDb dbP
|
||||
bStatus <- liftIO $ checkBlockChain zHost zPort
|
||||
pool <- runNoLoggingT $ initPool dbP
|
||||
dbBlock <- runNoLoggingT $ getMaxBlock pool
|
||||
let sb = max dbBlock b
|
||||
if sb > zgb_blocks bStatus || sb < 1
|
||||
then do
|
||||
BT.modify $ set msg "Invalid starting block for scan"
|
||||
BT.modify $ set displayBox MsgDisplay
|
||||
liftIO $ BC.writeBChan eChan $ TickMsg "Invalid starting block for scan"
|
||||
else do
|
||||
let bList = [(sb + 1) .. (zgb_blocks bStatus)]
|
||||
let step = (1.0 :: Float) / fromIntegral (zgb_blocks bStatus - (sb + 1))
|
||||
mapM_ (processBlock step) bList
|
||||
mapM_ (processBlock pool step) bList
|
||||
where
|
||||
processBlock :: Float -> Int -> BT.EventM Name State ()
|
||||
processBlock step bl = do
|
||||
s <- BT.get
|
||||
processBlock :: ConnectionPool -> Float -> Int -> IO ()
|
||||
processBlock pool step bl = do
|
||||
r <-
|
||||
liftIO $
|
||||
makeZebraCall
|
||||
(s ^. zebraHost)
|
||||
(s ^. zebraPort)
|
||||
zHost
|
||||
zPort
|
||||
"getblock"
|
||||
[Data.Aeson.String $ T.pack $ show bl, jsonNumber 1]
|
||||
case r of
|
||||
Left e1 -> do
|
||||
BT.modify $ set msg e1
|
||||
BT.modify $ set displayBox MsgDisplay
|
||||
liftIO $ BC.writeBChan eChan $ TickMsg e1
|
||||
Right blk -> do
|
||||
r2 <-
|
||||
liftIO $
|
||||
makeZebraCall
|
||||
(s ^. zebraHost)
|
||||
(s ^. zebraPort)
|
||||
zHost
|
||||
zPort
|
||||
"getblock"
|
||||
[Data.Aeson.String $ T.pack $ show bl, jsonNumber 0]
|
||||
case r2 of
|
||||
Left e2 -> do
|
||||
BT.modify $ set msg e2
|
||||
BT.modify $ set displayBox MsgDisplay
|
||||
liftIO $ BC.writeBChan eChan $ TickMsg e2
|
||||
Right hb -> do
|
||||
let blockTime = getBlockTime hb
|
||||
liftIO $
|
||||
mapM_
|
||||
(processTx
|
||||
(s ^. zebraHost)
|
||||
(s ^. zebraPort)
|
||||
blockTime
|
||||
(s ^. dbPath)) $
|
||||
mapM_ (runNoLoggingT . processTx zHost zPort blockTime pool) $
|
||||
bl_txs $ addTime blk blockTime
|
||||
BT.modify $ set barValue $ validBarValue (s ^. barValue + step)
|
||||
BT.modify $ set displayBox SyncDisplay
|
||||
liftIO $ BC.writeBChan eChan $ TickVal step
|
||||
addTime :: BlockResponse -> Int -> BlockResponse
|
||||
addTime bl t =
|
||||
BlockResponse
|
||||
|
|
@ -544,14 +624,78 @@ scanZebra b = do
|
|||
(bl_txs bl)
|
||||
|
||||
appEvent :: BT.BrickEvent Name Tick -> BT.EventM Name State ()
|
||||
appEvent (BT.AppEvent Tick) = do
|
||||
appEvent (BT.AppEvent t) = do
|
||||
s <- BT.get
|
||||
case s ^. displayBox of
|
||||
SyncDisplay -> do
|
||||
if s ^. barValue == 1.0
|
||||
then BT.modify $ set displayBox BlankDisplay
|
||||
else BT.modify $ set displayBox SyncDisplay
|
||||
_ -> return ()
|
||||
pool <- liftIO $ runNoLoggingT $ initPool $ s ^. dbPath
|
||||
case t of
|
||||
TickMsg m -> do
|
||||
case s ^. displayBox of
|
||||
AddrDisplay -> return ()
|
||||
MsgDisplay -> return ()
|
||||
PhraseDisplay -> return ()
|
||||
TxDisplay -> return ()
|
||||
SyncDisplay -> return ()
|
||||
SendDisplay -> do
|
||||
BT.modify $ set msg m
|
||||
BlankDisplay -> return ()
|
||||
TickVal v -> do
|
||||
case s ^. displayBox of
|
||||
AddrDisplay -> return ()
|
||||
MsgDisplay -> return ()
|
||||
PhraseDisplay -> return ()
|
||||
TxDisplay -> return ()
|
||||
SendDisplay -> return ()
|
||||
SyncDisplay -> do
|
||||
if s ^. barValue == 1.0
|
||||
then do
|
||||
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
|
||||
_ <-
|
||||
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 ()
|
||||
SendTx -> 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
|
||||
r <- F.focusGetCurrent <$> use focusRing
|
||||
s <- BT.get
|
||||
|
|
@ -565,33 +709,63 @@ appEvent (BT.VtyEvent e) = do
|
|||
_ev -> return ()
|
||||
else do
|
||||
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
|
||||
BT.modify $
|
||||
set msg $
|
||||
"Copied Unified Address <" ++
|
||||
T.unpack (walletAddressName (entityVal a)) ++ ">!"
|
||||
BT.modify $ set displayBox MsgDisplay
|
||||
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
|
||||
BT.modify $
|
||||
set msg $
|
||||
"Copied Sapling Address <" ++
|
||||
T.unpack (walletAddressName (entityVal a)) ++ ">!"
|
||||
BT.modify $ set displayBox MsgDisplay
|
||||
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)
|
||||
BT.modify $
|
||||
set msg $
|
||||
"Copied Transparent Address <" ++
|
||||
T.unpack (walletAddressName (entityVal a)) ++ ">!"
|
||||
BT.modify $ set displayBox MsgDisplay
|
||||
Nothing -> return ()
|
||||
_ev -> return ()
|
||||
MsgDisplay -> BT.modify $ set displayBox BlankDisplay
|
||||
PhraseDisplay -> BT.modify $ set displayBox BlankDisplay
|
||||
TxDisplay -> BT.modify $ set displayBox BlankDisplay
|
||||
SyncDisplay -> do
|
||||
if s ^. barValue == 1.0
|
||||
then BT.modify $ set displayBox BlankDisplay
|
||||
else do
|
||||
sBlock <- liftIO $ getMinBirthdayHeight $ s ^. dbPath
|
||||
selWallet <-
|
||||
do case L.listSelectedElement $ s ^. wallets of
|
||||
Nothing -> do
|
||||
let fWall =
|
||||
L.listSelectedElement $
|
||||
L.listMoveToBeginning $ s ^. wallets
|
||||
case fWall of
|
||||
Nothing ->
|
||||
throw $ userError "Failed to select wallet"
|
||||
Just (_j, w1) -> return w1
|
||||
Just (_k, w) -> return w
|
||||
scanZebra sBlock
|
||||
liftIO $
|
||||
runFileLoggingT "zenith.log" $
|
||||
syncWallet
|
||||
(Config (s ^. dbPath) (s ^. zebraHost) (s ^. zebraPort))
|
||||
selWallet
|
||||
BT.modify $ set displayBox SyncDisplay
|
||||
SendDisplay -> BT.modify $ set displayBox BlankDisplay
|
||||
SyncDisplay -> BT.modify $ set displayBox BlankDisplay
|
||||
BlankDisplay -> do
|
||||
case s ^. dialogBox of
|
||||
WName -> do
|
||||
|
|
@ -675,6 +849,71 @@ appEvent (BT.VtyEvent e) = do
|
|||
s ^. inputForm
|
||||
BT.modify $ set dialogBox AName
|
||||
ev -> BT.zoom accounts $ L.handleListEvent ev
|
||||
SendTx -> do
|
||||
case e of
|
||||
V.EvKey V.KEsc [] -> BT.modify $ set dialogBox Blank
|
||||
V.EvKey V.KEnter [] -> do
|
||||
if allFieldsValid (s ^. txForm)
|
||||
then do
|
||||
pool <-
|
||||
liftIO $ runNoLoggingT $ initPool $ s ^. dbPath
|
||||
selWal <-
|
||||
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
|
||||
selAcc <-
|
||||
do case L.listSelectedElement $ s ^. accounts of
|
||||
Nothing -> do
|
||||
let fAcc =
|
||||
L.listSelectedElement $
|
||||
L.listMoveToBeginning $
|
||||
s ^. accounts
|
||||
case fAcc of
|
||||
Nothing ->
|
||||
throw $
|
||||
userError "Failed to select wallet"
|
||||
Just (_j, w1) -> return w1
|
||||
Just (_k, w) -> return w
|
||||
fs1 <- BT.zoom txForm $ BT.gets formState
|
||||
bl <-
|
||||
liftIO $ getLastSyncBlock pool $ entityKey selWal
|
||||
_ <-
|
||||
liftIO $
|
||||
forkIO $
|
||||
sendTransaction
|
||||
pool
|
||||
(s ^. eventDispatch)
|
||||
(s ^. zebraHost)
|
||||
(s ^. zebraPort)
|
||||
(s ^. network)
|
||||
(entityKey selAcc)
|
||||
bl
|
||||
(fs1 ^. sendAmt)
|
||||
(fs1 ^. sendTo)
|
||||
(fs1 ^. sendMemo)
|
||||
BT.modify $ set msg "Preparing transaction..."
|
||||
BT.modify $ set displayBox SendDisplay
|
||||
BT.modify $ set dialogBox Blank
|
||||
else do
|
||||
BT.modify $ set msg "Invalid inputs"
|
||||
BT.modify $ set displayBox MsgDisplay
|
||||
BT.modify $ set dialogBox Blank
|
||||
ev -> do
|
||||
BT.zoom txForm $ do
|
||||
handleFormEvent (BT.VtyEvent ev)
|
||||
fs <- BT.gets formState
|
||||
BT.modify $
|
||||
setFieldValid
|
||||
(isRecipientValid (fs ^. sendTo))
|
||||
RecField
|
||||
Blank -> do
|
||||
case e of
|
||||
V.EvKey (V.KChar '\t') [] -> focusRing %= F.focusNext
|
||||
|
|
@ -694,8 +933,10 @@ appEvent (BT.VtyEvent e) = do
|
|||
V.EvKey (V.KChar 'a') [] ->
|
||||
BT.modify $ set dialogBox ASelect
|
||||
V.EvKey (V.KChar 's') [] -> do
|
||||
BT.modify $ set barValue 0.0
|
||||
BT.modify $ set displayBox SyncDisplay
|
||||
BT.modify $
|
||||
set txForm $
|
||||
mkSendForm (s ^. balance) (SendInput "" 0.0 "")
|
||||
BT.modify $ set dialogBox SendTx
|
||||
ev ->
|
||||
case r of
|
||||
Just AList ->
|
||||
|
|
@ -720,6 +961,9 @@ theMap =
|
|||
, (titleAttr, V.withStyle (fg V.brightGreen) V.bold)
|
||||
, (blinkAttr, style V.blink)
|
||||
, (focusedFormInputAttr, V.white `on` V.blue)
|
||||
, (invalidFormInputAttr, V.red `on` V.black)
|
||||
, (E.editAttr, V.white `on` V.blue)
|
||||
, (E.editFocusedAttr, V.blue `on` V.white)
|
||||
, (baseAttr, bg V.brightBlack)
|
||||
, (barDoneAttr, V.white `on` V.blue)
|
||||
, (barToDoAttr, V.white `on` V.black)
|
||||
|
|
@ -740,6 +984,7 @@ runZenithCLI config = do
|
|||
let host = c_zebraHost config
|
||||
let port = c_zebraPort config
|
||||
let dbFilePath = c_dbPath config
|
||||
pool <- runNoLoggingT $ initPool dbFilePath
|
||||
w <- try $ checkZebra host port :: IO (Either IOError ZebraGetInfo)
|
||||
case w of
|
||||
Right zebra -> do
|
||||
|
|
@ -750,18 +995,18 @@ runZenithCLI config = do
|
|||
Left e1 -> throwIO e1
|
||||
Right chainInfo -> do
|
||||
initDb dbFilePath
|
||||
walList <- getWallets dbFilePath $ zgb_net chainInfo
|
||||
walList <- getWallets pool $ zgb_net chainInfo
|
||||
accList <-
|
||||
if not (null walList)
|
||||
then getAccounts dbFilePath $ entityKey $ head walList
|
||||
then runNoLoggingT $ getAccounts pool $ entityKey $ head walList
|
||||
else return []
|
||||
addrList <-
|
||||
if not (null accList)
|
||||
then getAddresses dbFilePath $ entityKey $ head accList
|
||||
then runNoLoggingT $ getAddresses pool $ entityKey $ head accList
|
||||
else return []
|
||||
txList <-
|
||||
if not (null addrList)
|
||||
then getUserTx dbFilePath $ entityKey $ head addrList
|
||||
then getUserTx pool $ entityKey $ head addrList
|
||||
else return []
|
||||
let block =
|
||||
if not (null walList)
|
||||
|
|
@ -769,9 +1014,14 @@ runZenithCLI config = do
|
|||
else 0
|
||||
bal <-
|
||||
if not (null accList)
|
||||
then getBalance dbFilePath $ entityKey $ head accList
|
||||
then getBalance pool $ entityKey $ head accList
|
||||
else return 0
|
||||
eventChan <- BC.newBChan 10
|
||||
_ <-
|
||||
forkIO $
|
||||
forever $ do
|
||||
BC.writeBChan eventChan (TickVal 0.0)
|
||||
threadDelay 1000000
|
||||
let buildVty = VC.mkVty V.defaultConfig
|
||||
initialVty <- buildVty
|
||||
void $
|
||||
|
|
@ -800,6 +1050,8 @@ runZenithCLI config = do
|
|||
bal
|
||||
1.0
|
||||
eventChan
|
||||
0
|
||||
(mkSendForm 0 $ SendInput "" 0.0 "")
|
||||
Left e -> do
|
||||
print $
|
||||
"No Zebra node available on port " <>
|
||||
|
|
@ -807,34 +1059,38 @@ runZenithCLI config = do
|
|||
|
||||
refreshWallet :: State -> IO State
|
||||
refreshWallet s = do
|
||||
selWallet <-
|
||||
pool <- runNoLoggingT $ initPool $ s ^. dbPath
|
||||
walList <- getWallets pool $ s ^. network
|
||||
(ix, 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
|
||||
aL <- getAccounts (s ^. dbPath) $ entityKey selWallet
|
||||
Just (j, w1) -> return (j, w1)
|
||||
Just (k, w) -> return (k, w)
|
||||
aL <- runNoLoggingT $ getAccounts pool $ entityKey selWallet
|
||||
let bl = zcashWalletLastSync $ entityVal selWallet
|
||||
addrL <-
|
||||
if not (null aL)
|
||||
then getAddresses (s ^. dbPath) $ entityKey $ head aL
|
||||
then runNoLoggingT $ getAddresses pool $ entityKey $ head aL
|
||||
else return []
|
||||
bal <-
|
||||
if not (null aL)
|
||||
then getBalance (s ^. dbPath) $ entityKey $ head aL
|
||||
then getBalance pool $ entityKey $ head aL
|
||||
else return 0
|
||||
txL <-
|
||||
if not (null addrL)
|
||||
then getUserTx (s ^. dbPath) $ entityKey $ head addrL
|
||||
then getUserTx pool $ entityKey $ head addrL
|
||||
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 addrL' = L.listReplace (Vec.fromList addrL) (Just 0) (s ^. addresses)
|
||||
let txL' = L.listReplace (Vec.fromList txL) (Just 0) (s ^. transactions)
|
||||
return $
|
||||
(s & accounts .~ aL') & syncBlock .~ bl & balance .~ bal & addresses .~
|
||||
s & wallets .~ wL & accounts .~ aL' & syncBlock .~ bl & balance .~ bal &
|
||||
addresses .~
|
||||
addrL' &
|
||||
transactions .~
|
||||
txL' &
|
||||
|
|
@ -845,16 +1101,15 @@ refreshWallet s = do
|
|||
addNewWallet :: T.Text -> State -> IO State
|
||||
addNewWallet n s = do
|
||||
sP <- generateWalletSeedPhrase
|
||||
pool <- runNoLoggingT $ initPool $ s ^. dbPath
|
||||
let bH = s ^. startBlock
|
||||
let netName = s ^. network
|
||||
r <-
|
||||
saveWallet (s ^. dbPath) $
|
||||
ZcashWallet n (ZcashNetDB netName) (PhraseDB sP) bH 0
|
||||
r <- saveWallet pool $ ZcashWallet n (ZcashNetDB netName) (PhraseDB sP) bH 0
|
||||
case r of
|
||||
Nothing -> do
|
||||
return $ s & msg .~ ("Wallet already exists: " ++ T.unpack n)
|
||||
Just _ -> do
|
||||
wL <- getWallets (s ^. dbPath) netName
|
||||
wL <- getWallets pool netName
|
||||
let aL =
|
||||
L.listFindBy (\x -> zcashWalletName (entityVal x) == n) $
|
||||
L.listReplace (Vec.fromList wL) (Just 0) (s ^. wallets)
|
||||
|
|
@ -862,6 +1117,7 @@ addNewWallet n s = do
|
|||
|
||||
addNewAccount :: T.Text -> State -> IO State
|
||||
addNewAccount n s = do
|
||||
pool <- runNoLoggingT $ initPool $ s ^. dbPath
|
||||
selWallet <-
|
||||
do case L.listSelectedElement $ s ^. wallets of
|
||||
Nothing -> do
|
||||
|
|
@ -871,19 +1127,19 @@ addNewAccount n s = do
|
|||
Nothing -> throw $ userError "Failed to select wallet"
|
||||
Just (_j, w1) -> return w1
|
||||
Just (_k, w) -> return w
|
||||
aL' <- getMaxAccount (s ^. dbPath) (entityKey selWallet)
|
||||
aL' <- getMaxAccount pool (entityKey selWallet)
|
||||
zA <-
|
||||
try $ createZcashAccount n (aL' + 1) selWallet :: IO
|
||||
(Either IOError ZcashAccount)
|
||||
case zA of
|
||||
Left e -> return $ s & msg .~ ("Error: " ++ show e)
|
||||
Right zA' -> do
|
||||
r <- saveAccount (s ^. dbPath) zA'
|
||||
r <- saveAccount pool zA'
|
||||
case r of
|
||||
Nothing ->
|
||||
return $ s & msg .~ ("Account already exists: " ++ T.unpack n)
|
||||
Just x -> do
|
||||
aL <- getAccounts (s ^. dbPath) (entityKey selWallet)
|
||||
aL <- runNoLoggingT $ getAccounts pool (entityKey selWallet)
|
||||
let nL =
|
||||
L.listMoveToElement x $
|
||||
L.listReplace (Vec.fromList aL) (Just 0) (s ^. accounts)
|
||||
|
|
@ -892,6 +1148,7 @@ addNewAccount n s = do
|
|||
|
||||
refreshAccount :: State -> IO State
|
||||
refreshAccount s = do
|
||||
pool <- runNoLoggingT $ initPool $ s ^. dbPath
|
||||
selAccount <-
|
||||
do case L.listSelectedElement $ s ^. accounts of
|
||||
Nothing -> do
|
||||
|
|
@ -901,8 +1158,8 @@ refreshAccount s = do
|
|||
Nothing -> throw $ userError "Failed to select account"
|
||||
Just (_j, w1) -> return w1
|
||||
Just (_k, w) -> return w
|
||||
aL <- getAddresses (s ^. dbPath) $ entityKey selAccount
|
||||
bal <- getBalance (s ^. dbPath) $ entityKey selAccount
|
||||
aL <- runNoLoggingT $ getAddresses pool $ entityKey selAccount
|
||||
bal <- getBalance pool $ entityKey selAccount
|
||||
let aL' = L.listReplace (Vec.fromList aL) (Just 0) (s ^. addresses)
|
||||
selAddress <-
|
||||
do case L.listSelectedElement aL' of
|
||||
|
|
@ -916,7 +1173,7 @@ refreshAccount s = do
|
|||
s & balance .~ bal & addresses .~ aL' & msg .~ "Switched to account: " ++
|
||||
T.unpack (zcashAccountName $ entityVal selAccount)
|
||||
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)
|
||||
return $
|
||||
s & balance .~ bal & addresses .~ aL' & transactions .~ tL' & msg .~
|
||||
|
|
@ -925,6 +1182,7 @@ refreshAccount s = do
|
|||
|
||||
refreshTxs :: State -> IO State
|
||||
refreshTxs s = do
|
||||
pool <- runNoLoggingT $ initPool $ s ^. dbPath
|
||||
selAddress <-
|
||||
do case L.listSelectedElement $ s ^. addresses of
|
||||
Nothing -> do
|
||||
|
|
@ -935,12 +1193,13 @@ refreshTxs s = do
|
|||
case selAddress of
|
||||
Nothing -> return s
|
||||
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)
|
||||
return $ s & transactions .~ tL'
|
||||
|
||||
addNewAddress :: T.Text -> Scope -> State -> IO State
|
||||
addNewAddress n scope s = do
|
||||
pool <- runNoLoggingT $ initPool $ s ^. dbPath
|
||||
selAccount <-
|
||||
do case L.listSelectedElement $ s ^. accounts of
|
||||
Nothing -> do
|
||||
|
|
@ -950,19 +1209,19 @@ addNewAddress n scope s = do
|
|||
Nothing -> throw $ userError "Failed to select account"
|
||||
Just (_j, a1) -> return a1
|
||||
Just (_k, a) -> return a
|
||||
maxAddr <- getMaxAddress (s ^. dbPath) (entityKey selAccount) scope
|
||||
maxAddr <- getMaxAddress pool (entityKey selAccount) scope
|
||||
uA <-
|
||||
try $ createWalletAddress n (maxAddr + 1) (s ^. network) scope selAccount :: IO
|
||||
(Either IOError WalletAddress)
|
||||
case uA of
|
||||
Left e -> return $ s & msg .~ ("Error: " ++ show e)
|
||||
Right uA' -> do
|
||||
nAddr <- saveAddress (s ^. dbPath) uA'
|
||||
nAddr <- saveAddress pool uA'
|
||||
case nAddr of
|
||||
Nothing ->
|
||||
return $ s & msg .~ ("Address already exists: " ++ T.unpack n)
|
||||
Just x -> do
|
||||
addrL <- getAddresses (s ^. dbPath) (entityKey selAccount)
|
||||
addrL <- runNoLoggingT $ getAddresses pool (entityKey selAccount)
|
||||
let nL =
|
||||
L.listMoveToElement x $
|
||||
L.listReplace (Vec.fromList addrL) (Just 0) (s ^. addresses)
|
||||
|
|
@ -971,3 +1230,51 @@ addNewAddress n scope s = do
|
|||
T.unpack n ++
|
||||
"(" ++
|
||||
T.unpack (showAddress $ walletAddressUAddress $ entityVal x) ++ ")"
|
||||
|
||||
sendTransaction ::
|
||||
ConnectionPool
|
||||
-> BC.BChan Tick
|
||||
-> T.Text
|
||||
-> Int
|
||||
-> ZcashNet
|
||||
-> ZcashAccountId
|
||||
-> Int
|
||||
-> Float
|
||||
-> T.Text
|
||||
-> T.Text
|
||||
-> IO ()
|
||||
sendTransaction pool chan zHost zPort znet accId bl amt ua memo = do
|
||||
BC.writeBChan chan $ TickMsg "Preparing transaction..."
|
||||
outUA <- parseAddress ua
|
||||
res <-
|
||||
runFileLoggingT "zenith.log" $
|
||||
prepareTx pool zHost zPort znet accId bl amt outUA memo
|
||||
BC.writeBChan chan $ TickMsg "Transaction ready, sending to Zebra..."
|
||||
case res of
|
||||
Left e -> BC.writeBChan chan $ TickMsg $ show e
|
||||
Right rawTx -> do
|
||||
resp <-
|
||||
makeZebraCall
|
||||
zHost
|
||||
zPort
|
||||
"sendrawtransaction"
|
||||
[Data.Aeson.String $ toText rawTx]
|
||||
case resp of
|
||||
Left e1 -> BC.writeBChan chan $ TickMsg $ "Zebra error: " ++ show e1
|
||||
Right txId -> BC.writeBChan chan $ TickMsg $ "Tx ID: " ++ txId
|
||||
where
|
||||
parseAddress :: T.Text -> IO UnifiedAddress
|
||||
parseAddress a =
|
||||
case isValidUnifiedAddress (E.encodeUtf8 a) of
|
||||
Just a1 -> return a1
|
||||
Nothing ->
|
||||
case decodeSaplingAddress (E.encodeUtf8 a) of
|
||||
Just a2 ->
|
||||
return $
|
||||
UnifiedAddress znet Nothing (Just $ sa_receiver a2) Nothing
|
||||
Nothing ->
|
||||
case decodeTransparentAddress (E.encodeUtf8 a) of
|
||||
Just a3 ->
|
||||
return $
|
||||
UnifiedAddress znet Nothing Nothing (Just $ ta_receiver a3)
|
||||
Nothing -> throwIO $ userError "Incorrect address"
|
||||
|
|
|
|||
|
|
@ -9,13 +9,18 @@ import Control.Monad.IO.Class (liftIO)
|
|||
import Control.Monad.Logger
|
||||
( LoggingT
|
||||
, MonadLoggerIO
|
||||
, NoLoggingT
|
||||
, logDebugN
|
||||
, logErrorN
|
||||
, logInfoN
|
||||
, logWarnN
|
||||
, runFileLoggingT
|
||||
, runNoLoggingT
|
||||
, runStdoutLoggingT
|
||||
)
|
||||
import Crypto.Secp256k1 (SecKey(..))
|
||||
import Data.Aeson
|
||||
import Data.Binary.Get hiding (getBytes)
|
||||
import qualified Data.ByteString as BS
|
||||
import qualified Data.ByteString.Lazy as LBS
|
||||
import Data.Digest.Pure.MD5
|
||||
|
|
@ -31,6 +36,7 @@ import Database.Persist
|
|||
import Database.Persist.Sqlite
|
||||
import GHC.Float.RealFracMethods (floorFloatInteger)
|
||||
import Haskoin.Crypto.Keys (XPrvKey(..))
|
||||
import Lens.Micro ((&), (.~), (^.), set)
|
||||
import Network.HTTP.Client
|
||||
import ZcashHaskell.Keys
|
||||
import ZcashHaskell.Orchard
|
||||
|
|
@ -230,22 +236,24 @@ findSaplingOutputs config b znet za = do
|
|||
let zebraHost = c_zebraHost config
|
||||
let zebraPort = c_zebraPort config
|
||||
let zn = getNet znet
|
||||
tList <- getShieldedOutputs dbPath b
|
||||
pool <- runNoLoggingT $ initPool dbPath
|
||||
tList <- getShieldedOutputs pool b
|
||||
trees <- getCommitmentTrees zebraHost zebraPort (b - 1)
|
||||
let sT = SaplingCommitmentTree $ ztiSapling trees
|
||||
decryptNotes sT zn tList
|
||||
sapNotes <- getWalletSapNotes dbPath (entityKey za)
|
||||
findSapSpends dbPath (entityKey za) sapNotes
|
||||
decryptNotes sT zn pool tList
|
||||
sapNotes <- getWalletSapNotes pool (entityKey za)
|
||||
findSapSpends pool (entityKey za) sapNotes
|
||||
where
|
||||
sk :: SaplingSpendingKeyDB
|
||||
sk = zcashAccountSapSpendKey $ entityVal za
|
||||
decryptNotes ::
|
||||
SaplingCommitmentTree
|
||||
-> ZcashNet
|
||||
-> ConnectionPool
|
||||
-> [(Entity ZcashTransaction, Entity ShieldOutput)]
|
||||
-> IO ()
|
||||
decryptNotes _ _ [] = return ()
|
||||
decryptNotes st n ((zt, o):txs) = do
|
||||
decryptNotes _ _ _ [] = return ()
|
||||
decryptNotes st n pool ((zt, o):txs) = do
|
||||
let updatedTree =
|
||||
updateSaplingCommitmentTree
|
||||
st
|
||||
|
|
@ -262,15 +270,11 @@ findSaplingOutputs config b znet za = do
|
|||
Nothing -> do
|
||||
case decodeShOut Internal n nP o of
|
||||
Nothing -> do
|
||||
decryptNotes uT n txs
|
||||
decryptNotes uT n pool txs
|
||||
Just dn1 -> do
|
||||
wId <-
|
||||
saveWalletTransaction
|
||||
(c_dbPath config)
|
||||
(entityKey za)
|
||||
zt
|
||||
wId <- saveWalletTransaction pool (entityKey za) zt
|
||||
saveWalletSapNote
|
||||
(c_dbPath config)
|
||||
pool
|
||||
wId
|
||||
nP
|
||||
(fromJust noteWitness)
|
||||
|
|
@ -278,12 +282,11 @@ findSaplingOutputs config b znet za = do
|
|||
(entityKey za)
|
||||
(entityKey o)
|
||||
dn1
|
||||
decryptNotes uT n txs
|
||||
decryptNotes uT n pool txs
|
||||
Just dn0 -> do
|
||||
wId <-
|
||||
saveWalletTransaction (c_dbPath config) (entityKey za) zt
|
||||
wId <- saveWalletTransaction pool (entityKey za) zt
|
||||
saveWalletSapNote
|
||||
(c_dbPath config)
|
||||
pool
|
||||
wId
|
||||
nP
|
||||
(fromJust noteWitness)
|
||||
|
|
@ -291,7 +294,7 @@ findSaplingOutputs config b znet za = do
|
|||
(entityKey za)
|
||||
(entityKey o)
|
||||
dn0
|
||||
decryptNotes uT n txs
|
||||
decryptNotes uT n pool txs
|
||||
decodeShOut ::
|
||||
Scope
|
||||
-> ZcashNet
|
||||
|
|
@ -324,20 +327,22 @@ findOrchardActions config b znet za = do
|
|||
let zebraHost = c_zebraHost config
|
||||
let zebraPort = c_zebraPort config
|
||||
let zn = getNet znet
|
||||
tList <- getOrchardActions dbPath b
|
||||
pool <- runNoLoggingT $ initPool dbPath
|
||||
tList <- getOrchardActions pool b
|
||||
trees <- getCommitmentTrees zebraHost zebraPort (b - 1)
|
||||
let sT = OrchardCommitmentTree $ ztiOrchard trees
|
||||
decryptNotes sT zn tList
|
||||
orchNotes <- getWalletOrchNotes dbPath (entityKey za)
|
||||
findOrchSpends dbPath (entityKey za) orchNotes
|
||||
decryptNotes sT zn pool tList
|
||||
orchNotes <- getWalletOrchNotes pool (entityKey za)
|
||||
findOrchSpends pool (entityKey za) orchNotes
|
||||
where
|
||||
decryptNotes ::
|
||||
OrchardCommitmentTree
|
||||
-> ZcashNet
|
||||
-> ConnectionPool
|
||||
-> [(Entity ZcashTransaction, Entity OrchAction)]
|
||||
-> IO ()
|
||||
decryptNotes _ _ [] = return ()
|
||||
decryptNotes ot n ((zt, o):txs) = do
|
||||
decryptNotes _ _ _ [] = return ()
|
||||
decryptNotes ot n pool ((zt, o):txs) = do
|
||||
let updatedTree =
|
||||
updateOrchardCommitmentTree
|
||||
ot
|
||||
|
|
@ -353,15 +358,11 @@ findOrchardActions config b znet za = do
|
|||
case decodeOrchAction External nP o of
|
||||
Nothing ->
|
||||
case decodeOrchAction Internal nP o of
|
||||
Nothing -> decryptNotes uT n txs
|
||||
Nothing -> decryptNotes uT n pool txs
|
||||
Just dn1 -> do
|
||||
wId <-
|
||||
saveWalletTransaction
|
||||
(c_dbPath config)
|
||||
(entityKey za)
|
||||
zt
|
||||
wId <- saveWalletTransaction pool (entityKey za) zt
|
||||
saveWalletOrchNote
|
||||
(c_dbPath config)
|
||||
pool
|
||||
wId
|
||||
nP
|
||||
(fromJust noteWitness)
|
||||
|
|
@ -369,12 +370,11 @@ findOrchardActions config b znet za = do
|
|||
(entityKey za)
|
||||
(entityKey o)
|
||||
dn1
|
||||
decryptNotes uT n txs
|
||||
decryptNotes uT n pool txs
|
||||
Just dn -> do
|
||||
wId <-
|
||||
saveWalletTransaction (c_dbPath config) (entityKey za) zt
|
||||
wId <- saveWalletTransaction pool (entityKey za) zt
|
||||
saveWalletOrchNote
|
||||
(c_dbPath config)
|
||||
pool
|
||||
wId
|
||||
nP
|
||||
(fromJust noteWitness)
|
||||
|
|
@ -382,7 +382,7 @@ findOrchardActions config b znet za = do
|
|||
(entityKey za)
|
||||
(entityKey o)
|
||||
dn
|
||||
decryptNotes uT n txs
|
||||
decryptNotes uT n pool txs
|
||||
sk :: OrchardSpendingKeyDB
|
||||
sk = zcashAccountOrchSpendKey $ entityVal za
|
||||
decodeOrchAction ::
|
||||
|
|
@ -399,56 +399,41 @@ findOrchardActions config b znet za = do
|
|||
(getHex $ orchActionCv $ entityVal o)
|
||||
(getHex $ orchActionAuth $ entityVal o)
|
||||
|
||||
updateSaplingWitnesses :: T.Text -> LoggingT IO ()
|
||||
updateSaplingWitnesses dbPath = do
|
||||
sapNotes <- liftIO $ getUnspentSapNotes dbPath
|
||||
pool <- createSqlitePool dbPath 5
|
||||
updateSaplingWitnesses :: ConnectionPool -> IO ()
|
||||
updateSaplingWitnesses pool = do
|
||||
sapNotes <- getUnspentSapNotes pool
|
||||
maxId <- liftIO $ getMaxSaplingNote pool
|
||||
mapM_ (updateOneNote pool maxId) sapNotes
|
||||
mapM_ (updateOneNote maxId) sapNotes
|
||||
where
|
||||
updateOneNote ::
|
||||
Pool SqlBackend
|
||||
-> ShieldOutputId
|
||||
-> Entity WalletSapNote
|
||||
-> LoggingT IO ()
|
||||
updateOneNote pool maxId n = do
|
||||
updateOneNote :: ShieldOutputId -> Entity WalletSapNote -> IO ()
|
||||
updateOneNote maxId n = do
|
||||
let noteSync = walletSapNoteWitPos $ entityVal n
|
||||
if noteSync < maxId
|
||||
then do
|
||||
cmus <-
|
||||
liftIO $ getSaplingCmus pool $ walletSapNoteWitPos $ entityVal n
|
||||
let cmuList = map (\(ESQ.Value x) -> getHex x) cmus
|
||||
let newWitness =
|
||||
updateSaplingWitness
|
||||
(SaplingWitness $ getHex $ walletSapNoteWitness $ entityVal n)
|
||||
cmuList
|
||||
liftIO $ updateSapNoteRecord pool (entityKey n) newWitness maxId
|
||||
else logInfoN "Witness up to date"
|
||||
when (noteSync < maxId) $ do
|
||||
cmus <- liftIO $ getSaplingCmus pool $ walletSapNoteWitPos $ entityVal n
|
||||
let cmuList = map (\(ESQ.Value x) -> getHex x) cmus
|
||||
let newWitness =
|
||||
updateSaplingWitness
|
||||
(SaplingWitness $ getHex $ walletSapNoteWitness $ entityVal n)
|
||||
cmuList
|
||||
liftIO $ updateSapNoteRecord pool (entityKey n) newWitness maxId
|
||||
|
||||
updateOrchardWitnesses :: T.Text -> LoggingT IO ()
|
||||
updateOrchardWitnesses dbPath = do
|
||||
orchNotes <- liftIO $ getUnspentOrchNotes dbPath
|
||||
pool <- createSqlitePool dbPath 5
|
||||
maxId <- liftIO $ getMaxOrchardNote pool
|
||||
mapM_ (updateOneNote pool maxId) orchNotes
|
||||
updateOrchardWitnesses :: ConnectionPool -> IO ()
|
||||
updateOrchardWitnesses pool = do
|
||||
orchNotes <- getUnspentOrchNotes pool
|
||||
maxId <- getMaxOrchardNote pool
|
||||
mapM_ (updateOneNote maxId) orchNotes
|
||||
where
|
||||
updateOneNote ::
|
||||
Pool SqlBackend
|
||||
-> OrchActionId
|
||||
-> Entity WalletOrchNote
|
||||
-> LoggingT IO ()
|
||||
updateOneNote pool maxId n = do
|
||||
updateOneNote :: OrchActionId -> Entity WalletOrchNote -> IO ()
|
||||
updateOneNote maxId n = do
|
||||
let noteSync = walletOrchNoteWitPos $ entityVal n
|
||||
if noteSync < maxId
|
||||
then do
|
||||
cmxs <- liftIO $ getOrchardCmxs pool noteSync
|
||||
let cmxList = map (\(ESQ.Value x) -> getHex x) cmxs
|
||||
let newWitness =
|
||||
updateOrchardWitness
|
||||
(OrchardWitness $ getHex $ walletOrchNoteWitness $ entityVal n)
|
||||
cmxList
|
||||
liftIO $ updateOrchNoteRecord pool (entityKey n) newWitness maxId
|
||||
else logInfoN "Witness up to date"
|
||||
when (noteSync < maxId) $ do
|
||||
cmxs <- liftIO $ getOrchardCmxs pool noteSync
|
||||
let cmxList = map (\(ESQ.Value x) -> getHex x) cmxs
|
||||
let newWitness =
|
||||
updateOrchardWitness
|
||||
(OrchardWitness $ getHex $ walletOrchNoteWitness $ entityVal n)
|
||||
cmxList
|
||||
liftIO $ updateOrchNoteRecord pool (entityKey n) newWitness maxId
|
||||
|
||||
-- | Calculate fee per ZIP-317
|
||||
calculateTxFee ::
|
||||
|
|
@ -460,21 +445,21 @@ calculateTxFee (t, s, o) i =
|
|||
(5000 * (max (length t) tout + max (length s) sout + length o + oout))
|
||||
where
|
||||
tout =
|
||||
if i == 1
|
||||
if i == 1 || i == 2
|
||||
then 1
|
||||
else 0
|
||||
sout =
|
||||
if i == 2
|
||||
if i == 3
|
||||
then 1
|
||||
else 0
|
||||
oout =
|
||||
if i == 3
|
||||
then 2
|
||||
else 1
|
||||
if i == 4
|
||||
then 1
|
||||
else 0
|
||||
|
||||
-- | Prepare a transaction for sending
|
||||
prepareTx ::
|
||||
T.Text
|
||||
ConnectionPool
|
||||
-> T.Text
|
||||
-> Int
|
||||
-> ZcashNet
|
||||
|
|
@ -483,9 +468,9 @@ prepareTx ::
|
|||
-> Float
|
||||
-> UnifiedAddress
|
||||
-> T.Text
|
||||
-> IO (Either TxError HexString)
|
||||
prepareTx dbPath zebraHost zebraPort zn za bh amt ua memo = do
|
||||
accRead <- getAccountById dbPath za
|
||||
-> LoggingT IO (Either TxError HexString)
|
||||
prepareTx pool zebraHost zebraPort zn za bh amt ua memo = do
|
||||
accRead <- liftIO $ getAccountById pool za
|
||||
let recipient =
|
||||
case o_rec ua of
|
||||
Nothing ->
|
||||
|
|
@ -499,63 +484,97 @@ prepareTx dbPath zebraHost zebraPort zn za bh amt ua memo = do
|
|||
P2SH -> (2, toBytes $ tr_bytes r3)
|
||||
Just r2 -> (3, getBytes r2)
|
||||
Just r1 -> (4, getBytes r1)
|
||||
print recipient
|
||||
trees <- getCommitmentTrees zebraHost zebraPort bh
|
||||
logDebugN $ T.pack $ show recipient
|
||||
logDebugN $ T.pack $ "Target block: " ++ show bh
|
||||
trees <- liftIO $ getCommitmentTrees zebraHost zebraPort bh
|
||||
let sT = SaplingCommitmentTree $ ztiSapling trees
|
||||
let oT = OrchardCommitmentTree $ ztiOrchard trees
|
||||
case accRead of
|
||||
Nothing -> throwIO $ userError "Can't find Account"
|
||||
Nothing -> do
|
||||
logErrorN "Can't find Account"
|
||||
return $ Left ZHError
|
||||
Just acc -> do
|
||||
print acc
|
||||
spParams <- BS.readFile "sapling-spend.params"
|
||||
outParams <- BS.readFile "sapling-output.params"
|
||||
logDebugN $ T.pack $ show acc
|
||||
spParams <- liftIO $ BS.readFile "sapling-spend.params"
|
||||
outParams <- liftIO $ BS.readFile "sapling-output.params"
|
||||
if show (md5 $ LBS.fromStrict spParams) /=
|
||||
"0f44c12ef115ae019decf18ade583b20"
|
||||
then throwIO $ userError "Can't validate sapling parameters"
|
||||
else print "Valid Sapling spend params"
|
||||
then logErrorN "Can't validate sapling parameters"
|
||||
else logInfoN "Valid Sapling spend params"
|
||||
if show (md5 $ LBS.fromStrict outParams) /=
|
||||
"924daf81b87a81bbbb9c7d18562046c8"
|
||||
then throwIO $ userError "Can't validate sapling parameters"
|
||||
else print "Valid Sapling output params"
|
||||
print $ BS.length spParams
|
||||
print $ BS.length outParams
|
||||
print "Read Sapling params"
|
||||
then logErrorN "Can't validate sapling parameters"
|
||||
else logInfoN "Valid Sapling output params"
|
||||
--print $ BS.length spParams
|
||||
--print $ BS.length outParams
|
||||
logDebugN "Read Sapling params"
|
||||
let zats = fromIntegral $ floorFloatInteger $ amt * (10 ^ 8)
|
||||
firstPass <- selectUnspentNotes dbPath za zats
|
||||
let fee = calculateTxFee firstPass 3
|
||||
print "calculated fee"
|
||||
print fee
|
||||
(tList, sList, oList) <- selectUnspentNotes dbPath za (zats + fee)
|
||||
print "selected notes"
|
||||
print tList
|
||||
print sList
|
||||
print oList
|
||||
logDebugN $ T.pack $ show zats
|
||||
{-firstPass <- liftIO $ selectUnspentNotes pool za zats-}
|
||||
--let fee = calculateTxFee firstPass $ fst recipient
|
||||
--logDebugN $ T.pack $ "calculated fee " ++ show fee
|
||||
(tList, sList, oList) <- liftIO $ selectUnspentNotes pool za (zats + 5000)
|
||||
logDebugN "selected notes"
|
||||
logDebugN $ T.pack $ show tList
|
||||
logDebugN $ T.pack $ show sList
|
||||
logDebugN $ T.pack $ show oList
|
||||
let noteTotal = getTotalAmount (tList, sList, oList)
|
||||
print noteTotal
|
||||
tSpends <-
|
||||
liftIO $
|
||||
prepTSpends (getTranSK $ zcashAccountTPrivateKey $ entityVal acc) tList
|
||||
print tSpends
|
||||
--print tSpends
|
||||
sSpends <-
|
||||
liftIO $
|
||||
prepSSpends (getSapSK $ zcashAccountSapSpendKey $ entityVal acc) sList
|
||||
print sSpends
|
||||
--print sSpends
|
||||
oSpends <-
|
||||
liftIO $
|
||||
prepOSpends (getOrchSK $ zcashAccountOrchSpendKey $ entityVal acc) oList
|
||||
print oSpends
|
||||
outgoing <- makeOutgoing acc recipient zats (noteTotal - fee - zats)
|
||||
print outgoing
|
||||
let tx =
|
||||
--print oSpends
|
||||
dummy <-
|
||||
liftIO $ makeOutgoing acc recipient zats (noteTotal - 5000 - zats)
|
||||
logDebugN "Calculating fee"
|
||||
let feeResponse =
|
||||
createTransaction
|
||||
(Just sT)
|
||||
(Just oT)
|
||||
tSpends
|
||||
sSpends
|
||||
oSpends
|
||||
outgoing
|
||||
dummy
|
||||
(SaplingSpendParams spParams)
|
||||
(SaplingOutputParams outParams)
|
||||
zn
|
||||
(bh + 3)
|
||||
return tx
|
||||
False
|
||||
case feeResponse of
|
||||
Left e1 -> return $ Left Fee
|
||||
Right fee -> do
|
||||
let feeAmt =
|
||||
fromIntegral (runGet getInt64le $ LBS.fromStrict $ toBytes fee)
|
||||
(tList1, sList1, oList1) <-
|
||||
liftIO $ selectUnspentNotes pool za (zats + feeAmt)
|
||||
logDebugN $ T.pack $ "selected notes with fee" ++ show feeAmt
|
||||
logDebugN $ T.pack $ show tList
|
||||
logDebugN $ T.pack $ show sList
|
||||
logDebugN $ T.pack $ show oList
|
||||
outgoing <-
|
||||
liftIO $ makeOutgoing acc recipient zats (noteTotal - feeAmt - zats)
|
||||
logDebugN $ T.pack $ show outgoing
|
||||
let tx =
|
||||
createTransaction
|
||||
(Just sT)
|
||||
(Just oT)
|
||||
tSpends
|
||||
sSpends
|
||||
oSpends
|
||||
outgoing
|
||||
(SaplingSpendParams spParams)
|
||||
(SaplingOutputParams outParams)
|
||||
zn
|
||||
(bh + 3)
|
||||
True
|
||||
return tx
|
||||
where
|
||||
makeOutgoing ::
|
||||
Entity ZcashAccount
|
||||
|
|
@ -564,7 +583,7 @@ prepareTx dbPath zebraHost zebraPort zn za bh amt ua memo = do
|
|||
-> Integer
|
||||
-> IO [OutgoingNote]
|
||||
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 chgRcvr =
|
||||
fromJust $ o_rec =<< isValidUnifiedAddress (E.encodeUtf8 internalUA)
|
||||
|
|
@ -604,8 +623,7 @@ prepareTx dbPath zebraHost zebraPort zn za bh amt ua memo = do
|
|||
-> IO [TransparentTxSpend]
|
||||
prepTSpends sk notes = do
|
||||
forM notes $ \n -> do
|
||||
tAddRead <- getAddressById dbPath $ walletTrNoteAddress $ entityVal n
|
||||
print n
|
||||
tAddRead <- getAddressById pool $ walletTrNoteAddress $ entityVal n
|
||||
case tAddRead of
|
||||
Nothing -> throwIO $ userError "Couldn't read t-address"
|
||||
Just tAdd -> do
|
||||
|
|
@ -614,7 +632,7 @@ prepareTx dbPath zebraHost zebraPort zn za bh amt ua memo = do
|
|||
(walletAddressIndex $ entityVal tAdd)
|
||||
(getScope $ walletAddressScope $ entityVal tAdd)
|
||||
sk
|
||||
mReverseTxId <- getWalletTxId dbPath $ walletTrNoteTx $ entityVal n
|
||||
mReverseTxId <- getWalletTxId pool $ walletTrNoteTx $ entityVal n
|
||||
case mReverseTxId of
|
||||
Nothing -> throwIO $ userError "failed to get tx ID"
|
||||
Just (ESQ.Value reverseTxId) -> do
|
||||
|
|
@ -632,7 +650,6 @@ prepareTx dbPath zebraHost zebraPort zn za bh amt ua memo = do
|
|||
SaplingSpendingKey -> [Entity WalletSapNote] -> IO [SaplingTxSpend]
|
||||
prepSSpends sk notes = do
|
||||
forM notes $ \n -> do
|
||||
print n
|
||||
return $
|
||||
SaplingTxSpend
|
||||
(getBytes sk)
|
||||
|
|
@ -648,7 +665,6 @@ prepareTx dbPath zebraHost zebraPort zn za bh amt ua memo = do
|
|||
OrchardSpendingKey -> [Entity WalletOrchNote] -> IO [OrchardTxSpend]
|
||||
prepOSpends sk notes = do
|
||||
forM notes $ \n -> do
|
||||
print n
|
||||
return $
|
||||
OrchardTxSpend
|
||||
(getBytes sk)
|
||||
|
|
@ -679,22 +695,24 @@ prepareTx dbPath zebraHost zebraPort zn za bh amt ua memo = do
|
|||
syncWallet ::
|
||||
Config -- ^ configuration parameters
|
||||
-> Entity ZcashWallet
|
||||
-> LoggingT IO ()
|
||||
-> IO ()
|
||||
syncWallet config w = do
|
||||
startTime <- liftIO getCurrentTime
|
||||
let walletDb = c_dbPath config
|
||||
accs <- liftIO $ getAccounts walletDb $ entityKey w
|
||||
addrs <- liftIO $ concat <$> mapM (getAddresses walletDb . entityKey) accs
|
||||
pool <- runNoLoggingT $ initPool walletDb
|
||||
accs <- runNoLoggingT $ getAccounts pool $ entityKey w
|
||||
addrs <- concat <$> mapM (runNoLoggingT . getAddresses pool . entityKey) accs
|
||||
intAddrs <-
|
||||
liftIO $ concat <$> mapM (getInternalAddresses walletDb . entityKey) accs
|
||||
chainTip <- liftIO $ getMaxBlock walletDb
|
||||
concat <$> mapM (runNoLoggingT . getInternalAddresses pool . entityKey) accs
|
||||
chainTip <- runNoLoggingT $ getMaxBlock pool
|
||||
let lastBlock = zcashWalletLastSync $ entityVal w
|
||||
let startBlock =
|
||||
if lastBlock > 0
|
||||
then lastBlock
|
||||
else zcashWalletBirthdayHeight $ entityVal w
|
||||
mapM_ (liftIO . findTransparentNotes walletDb startBlock) addrs
|
||||
mapM_ (liftIO . findTransparentNotes walletDb startBlock) intAddrs
|
||||
mapM_ (liftIO . findTransparentSpends walletDb . entityKey) accs
|
||||
mapM_ (liftIO . findTransparentNotes pool startBlock) addrs
|
||||
mapM_ (liftIO . findTransparentNotes pool startBlock) intAddrs
|
||||
mapM_ (liftIO . findTransparentSpends pool . entityKey) accs
|
||||
sapNotes <-
|
||||
liftIO $
|
||||
mapM
|
||||
|
|
@ -705,52 +723,52 @@ syncWallet config w = do
|
|||
mapM
|
||||
(findOrchardActions config startBlock (zcashWalletNetwork $ entityVal w))
|
||||
accs
|
||||
_ <- updateSaplingWitnesses walletDb
|
||||
_ <- updateOrchardWitnesses walletDb
|
||||
_ <- liftIO $ updateWalletSync walletDb chainTip (entityKey w)
|
||||
_ <- liftIO $ mapM_ (getWalletTransactions walletDb) addrs
|
||||
logInfoN "Synced wallet"
|
||||
_ <- updateSaplingWitnesses pool
|
||||
_ <- updateOrchardWitnesses pool
|
||||
_ <- liftIO $ updateWalletSync pool chainTip (entityKey w)
|
||||
mapM_ (runNoLoggingT . getWalletTransactions pool) addrs
|
||||
|
||||
testSync :: Config -> IO ()
|
||||
testSync config = do
|
||||
let dbPath = c_dbPath config
|
||||
_ <- initDb dbPath
|
||||
w <- getWallets dbPath TestNet
|
||||
r <- runFileLoggingT "zenith.log" $ mapM (syncWallet config) w
|
||||
pool <- runNoLoggingT $ initPool dbPath
|
||||
w <- getWallets pool TestNet
|
||||
r <- mapM (syncWallet config) w
|
||||
liftIO $ print r
|
||||
{-let uaRead =-}
|
||||
{-isValidUnifiedAddress-}
|
||||
{-"utest1dl54utt6prjj5e0dnlknwumnxq9hycdjpkfr0sy6e6h522remqee8axe9zax0wsjrwpj76v555pdhvj9rnargpfyycs0vpkapq98xcdhem99gc4wchzn0ggepq3y6nz3a9sscwgqxgsh9vzhcad402y3x9szfregck5gslkya3c79d86xx0l33tpk8gnn7ew9vw37w43zh22u8dgdax"-}
|
||||
{-case uaRead of-}
|
||||
{-Nothing -> print "wrong address"-}
|
||||
{-Just ua -> do-}
|
||||
{-startTime <- getCurrentTime-}
|
||||
{-print startTime-}
|
||||
{-tx <--}
|
||||
{-prepareTx-}
|
||||
{-"zenith.db"-}
|
||||
{-"127.0.0.1"-}
|
||||
{-18232-}
|
||||
{-TestNet-}
|
||||
{-(toSqlKey 1)-}
|
||||
{-2820897-}
|
||||
{-0.04-}
|
||||
{-ua-}
|
||||
{-"sent with Zenith, test"-}
|
||||
{-print tx-}
|
||||
{-endTime <- getCurrentTime-}
|
||||
{-print endTime-}
|
||||
|
||||
testSend :: IO ()
|
||||
testSend = do
|
||||
let uaRead =
|
||||
isValidUnifiedAddress
|
||||
"utest1dl54utt6prjj5e0dnlknwumnxq9hycdjpkfr0sy6e6h522remqee8axe9zax0wsjrwpj76v555pdhvj9rnargpfyycs0vpkapq98xcdhem99gc4wchzn0ggepq3y6nz3a9sscwgqxgsh9vzhcad402y3x9szfregck5gslkya3c79d86xx0l33tpk8gnn7ew9vw37w43zh22u8dgdax"
|
||||
case uaRead of
|
||||
Nothing -> print "wrong address"
|
||||
Just ua -> do
|
||||
startTime <- getCurrentTime
|
||||
print startTime
|
||||
tx <-
|
||||
prepareTx
|
||||
"zenith.db"
|
||||
"127.0.0.1"
|
||||
18232
|
||||
TestNet
|
||||
(toSqlKey 1)
|
||||
2820897
|
||||
0.04
|
||||
ua
|
||||
"sent with Zenith, test"
|
||||
print tx
|
||||
endTime <- getCurrentTime
|
||||
print endTime
|
||||
|
||||
{-testSend :: IO ()-}
|
||||
{-testSend = do-}
|
||||
clearSync :: Config -> IO ()
|
||||
clearSync config = do
|
||||
let dbPath = c_dbPath config
|
||||
pool <- runNoLoggingT $ initPool dbPath
|
||||
_ <- initDb dbPath
|
||||
_ <- clearWalletTransactions dbPath
|
||||
w <- getWallets dbPath TestNet
|
||||
liftIO $ mapM_ (updateWalletSync dbPath 0 . entityKey) w
|
||||
w' <- liftIO $ getWallets dbPath TestNet
|
||||
r <- runFileLoggingT "zenith.log" $ mapM (syncWallet config) w'
|
||||
_ <- clearWalletTransactions pool
|
||||
w <- getWallets pool TestNet
|
||||
liftIO $ mapM_ (updateWalletSync pool 0 . entityKey) w
|
||||
w' <- liftIO $ getWallets pool TestNet
|
||||
r <- mapM (syncWallet config) w'
|
||||
liftIO $ print r
|
||||
|
|
|
|||
1036
src/Zenith/DB.hs
1036
src/Zenith/DB.hs
File diff suppressed because it is too large
Load diff
|
|
@ -3,11 +3,23 @@
|
|||
module Zenith.Scanner where
|
||||
|
||||
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.HexString
|
||||
import Data.Maybe
|
||||
import qualified Data.Text as T
|
||||
import Data.Time (getCurrentTime)
|
||||
import Database.Persist.Sqlite
|
||||
import GHC.Utils.Monad (concatMapM)
|
||||
import Lens.Micro ((&), (.~), (^.), set)
|
||||
import System.Console.AsciiProgress
|
||||
import ZcashHaskell.Types
|
||||
( BlockResponse(..)
|
||||
|
|
@ -30,64 +42,77 @@ scanZebra ::
|
|||
-> T.Text -- ^ Host
|
||||
-> Int -- ^ Port
|
||||
-> T.Text -- ^ Path to database file
|
||||
-> IO ()
|
||||
-> NoLoggingT IO ()
|
||||
scanZebra b host port dbFilePath = do
|
||||
_ <- initDb dbFilePath
|
||||
_ <- liftIO $ initDb dbFilePath
|
||||
startTime <- liftIO getCurrentTime
|
||||
logInfoN $ "Started sync: " <> T.pack (show startTime)
|
||||
bc <-
|
||||
try $ checkBlockChain host port :: IO
|
||||
liftIO $ try $ checkBlockChain host port :: NoLoggingT
|
||||
IO
|
||||
(Either IOError ZebraGetBlockChainInfo)
|
||||
case bc of
|
||||
Left e -> print e
|
||||
Left e -> logErrorN $ T.pack (show e)
|
||||
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
|
||||
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
|
||||
print $
|
||||
liftIO $
|
||||
print $
|
||||
"Scanning from " ++
|
||||
show (sb + 1) ++ " to " ++ show (zgb_blocks bStatus)
|
||||
let bList = [(sb + 1) .. (zgb_blocks bStatus)]
|
||||
displayConsoleRegions $ do
|
||||
pg <- newProgressBar def {pgTotal = fromIntegral $ length bList}
|
||||
pg <-
|
||||
liftIO $
|
||||
newProgressBar def {pgTotal = fromIntegral $ length bList}
|
||||
txList <-
|
||||
try $ mapM_ (processBlock host port dbFilePath pg) bList :: IO
|
||||
CM.try $ mapM_ (processBlock host port pool pg) bList :: NoLoggingT
|
||||
IO
|
||||
(Either IOError ())
|
||||
case txList of
|
||||
Left e1 -> print e1
|
||||
Right txList' -> print txList'
|
||||
Left e1 -> logErrorN $ T.pack (show e1)
|
||||
Right txList' -> logInfoN "Finished scan"
|
||||
|
||||
-- | Function to process a raw block and extract the transaction information
|
||||
processBlock ::
|
||||
T.Text -- ^ Host name for `zebrad`
|
||||
-> Int -- ^ Port for `zebrad`
|
||||
-> T.Text -- ^ DB file path
|
||||
-> ConnectionPool -- ^ DB file path
|
||||
-> ProgressBar -- ^ Progress bar
|
||||
-> Int -- ^ The block number to process
|
||||
-> IO ()
|
||||
processBlock host port dbFp pg b = do
|
||||
-> NoLoggingT IO ()
|
||||
processBlock host port pool pg b = do
|
||||
r <-
|
||||
liftIO $
|
||||
makeZebraCall
|
||||
host
|
||||
port
|
||||
"getblock"
|
||||
[Data.Aeson.String $ T.pack $ show b, jsonNumber 1]
|
||||
case r of
|
||||
Left e -> throwIO $ userError e
|
||||
Left e -> liftIO $ throwIO $ userError e
|
||||
Right blk -> do
|
||||
r2 <-
|
||||
liftIO $
|
||||
makeZebraCall
|
||||
host
|
||||
port
|
||||
"getblock"
|
||||
[Data.Aeson.String $ T.pack $ show b, jsonNumber 0]
|
||||
case r2 of
|
||||
Left e2 -> throwIO $ userError e2
|
||||
Left e2 -> liftIO $ throwIO $ userError e2
|
||||
Right hb -> do
|
||||
let blockTime = getBlockTime hb
|
||||
mapM_ (processTx host port blockTime dbFp) $
|
||||
mapM_ (processTx host port blockTime pool) $
|
||||
bl_txs $ addTime blk blockTime
|
||||
tick pg
|
||||
liftIO $ tick pg
|
||||
where
|
||||
addTime :: BlockResponse -> Int -> BlockResponse
|
||||
addTime bl t =
|
||||
|
|
@ -102,24 +127,25 @@ processTx ::
|
|||
T.Text -- ^ Host name for `zebrad`
|
||||
-> Int -- ^ Port for `zebrad`
|
||||
-> Int -- ^ Block time
|
||||
-> T.Text -- ^ DB file path
|
||||
-> ConnectionPool -- ^ DB file path
|
||||
-> HexString -- ^ transaction id
|
||||
-> IO ()
|
||||
processTx host port bt dbFp t = do
|
||||
-> NoLoggingT IO ()
|
||||
processTx host port bt pool t = do
|
||||
r <-
|
||||
liftIO $
|
||||
makeZebraCall
|
||||
host
|
||||
port
|
||||
"getrawtransaction"
|
||||
[Data.Aeson.String $ toText t, jsonNumber 1]
|
||||
case r of
|
||||
Left e -> throwIO $ userError e
|
||||
Left e -> liftIO $ throwIO $ userError e
|
||||
Right rawTx -> do
|
||||
case readZebraTransaction (ztr_hex rawTx) of
|
||||
Nothing -> return ()
|
||||
Just rzt -> do
|
||||
_ <-
|
||||
saveTransaction dbFp bt $
|
||||
saveTransaction pool bt $
|
||||
Transaction
|
||||
t
|
||||
(ztr_blockheight rawTx)
|
||||
|
|
|
|||
|
|
@ -26,17 +26,17 @@ jsonNumber i = Number $ scientific (fromIntegral i) 0
|
|||
-- | Helper function to display small amounts of ZEC
|
||||
displayZec :: Integer -> String
|
||||
displayZec s
|
||||
| s < 100 = show s ++ " zats "
|
||||
| s < 100000 = show (fromIntegral s / 100) ++ " μZEC "
|
||||
| s < 100000000 = show (fromIntegral s / 100000) ++ " mZEC "
|
||||
| abs s < 100 = show s ++ " zats "
|
||||
| abs s < 100000 = show (fromIntegral s / 100) ++ " μZEC "
|
||||
| abs s < 100000000 = show (fromIntegral s / 100000) ++ " mZEC "
|
||||
| otherwise = show (fromIntegral s / 100000000) ++ " ZEC "
|
||||
|
||||
-- | Helper function to display small amounts of ZEC
|
||||
displayTaz :: Integer -> String
|
||||
displayTaz s
|
||||
| s < 100 = show s ++ " tazs "
|
||||
| s < 100000 = show (fromIntegral s / 100) ++ " μTAZ "
|
||||
| s < 100000000 = show (fromIntegral s / 100000) ++ " mTAZ "
|
||||
| abs s < 100 = show s ++ " tazs "
|
||||
| abs s < 100000 = show (fromIntegral s / 100) ++ " μTAZ "
|
||||
| abs s < 100000000 = show (fromIntegral s / 100000) ++ " mTAZ "
|
||||
| otherwise = show (fromIntegral s / 100000000) ++ " TAZ "
|
||||
|
||||
-- | Helper function to display abbreviated Unified Address
|
||||
|
|
|
|||
115
test/Spec.hs
115
test/Spec.hs
|
|
@ -1,7 +1,9 @@
|
|||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
import Control.Monad (when)
|
||||
import Control.Monad.Logger (runNoLoggingT)
|
||||
import Data.HexString
|
||||
import qualified Data.Text.Encoding as E
|
||||
import Database.Persist
|
||||
import Database.Persist.Sqlite
|
||||
import System.Directory
|
||||
|
|
@ -10,15 +12,22 @@ import Test.Hspec
|
|||
import ZcashHaskell.Orchard (isValidUnifiedAddress)
|
||||
import ZcashHaskell.Sapling
|
||||
( decodeSaplingOutputEsk
|
||||
, encodeSaplingAddress
|
||||
, getSaplingNotePosition
|
||||
, getSaplingWitness
|
||||
, isValidShieldedAddress
|
||||
, updateSaplingCommitmentTree
|
||||
)
|
||||
import ZcashHaskell.Transparent
|
||||
( decodeExchangeAddress
|
||||
, decodeTransparentAddress
|
||||
)
|
||||
import ZcashHaskell.Types
|
||||
( DecodedNote(..)
|
||||
, OrchardSpendingKey(..)
|
||||
, Phrase(..)
|
||||
, SaplingCommitmentTree(..)
|
||||
, SaplingReceiver(..)
|
||||
, SaplingSpendingKey(..)
|
||||
, Scope(..)
|
||||
, ShieldedOutput(..)
|
||||
|
|
@ -72,8 +81,9 @@ main = do
|
|||
"None" `shouldBe` maybe "None" zcashWalletName s
|
||||
describe "Wallet function tests:" $ do
|
||||
it "Save Wallet:" $ do
|
||||
pool <- runNoLoggingT $ initPool "test.db"
|
||||
zw <-
|
||||
saveWallet "test.db" $
|
||||
saveWallet pool $
|
||||
ZcashWallet
|
||||
"Testing"
|
||||
(ZcashNetDB MainNet)
|
||||
|
|
@ -84,19 +94,19 @@ main = do
|
|||
0
|
||||
zw `shouldNotBe` Nothing
|
||||
it "Save Account:" $ do
|
||||
pool <- runNoLoggingT $ initPool "test.db"
|
||||
s <-
|
||||
runSqlite "test.db" $ do
|
||||
selectList [ZcashWalletName ==. "Testing"] []
|
||||
za <-
|
||||
saveAccount "test.db" =<<
|
||||
createZcashAccount "TestAccount" 0 (head s)
|
||||
za <- saveAccount pool =<< createZcashAccount "TestAccount" 0 (head s)
|
||||
za `shouldNotBe` Nothing
|
||||
it "Save address:" $ do
|
||||
pool <- runNoLoggingT $ initPool "test.db"
|
||||
acList <-
|
||||
runSqlite "test.db" $
|
||||
selectList [ZcashAccountName ==. "TestAccount"] []
|
||||
zAdd <-
|
||||
saveAddress "test.db" =<<
|
||||
saveAddress pool =<<
|
||||
createWalletAddress "Personal123" 0 MainNet External (head acList)
|
||||
addList <-
|
||||
runSqlite "test.db" $
|
||||
|
|
@ -162,29 +172,82 @@ main = do
|
|||
"6c5d1413c63a9a88db71c3f41dc12cd60197ee742fc75b217215e7144db48bd3"
|
||||
describe "Note selection for Tx" $ do
|
||||
it "Value less than balance" $ do
|
||||
res <- selectUnspentNotes "zenith.db" (toSqlKey 1) 14000000
|
||||
pool <- runNoLoggingT $ initPool "zenith.db"
|
||||
res <- selectUnspentNotes pool (toSqlKey 1) 14000000
|
||||
res `shouldNotBe` ([], [], [])
|
||||
it "Value greater than balance" $ do
|
||||
let res = selectUnspentNotes "zenith.db" (toSqlKey 1) 84000000
|
||||
pool <- runNoLoggingT $ initPool "zenith.db"
|
||||
let res = selectUnspentNotes pool (toSqlKey 1) 84000000
|
||||
res `shouldThrow` anyIOException
|
||||
it "Fee calculation" $ do
|
||||
res <- selectUnspentNotes "zenith.db" (toSqlKey 1) 14000000
|
||||
pool <- runNoLoggingT $ initPool "zenith.db"
|
||||
res <- selectUnspentNotes pool (toSqlKey 1) 14000000
|
||||
calculateTxFee res 3 `shouldBe` 20000
|
||||
describe "Creating Tx" $ do
|
||||
xit "To Orchard" $ do
|
||||
let uaRead =
|
||||
isValidUnifiedAddress
|
||||
"utest1dl54utt6prjj5e0dnlknwumnxq9hycdjpkfr0sy6e6h522remqee8axe9zax0wsjrwpj76v555pdhvj9rnargpfyycs0vpkapq98xcdhem99gc4wchzn0ggepq3y6nz3a9sscwgqxgsh9vzhcad402y3x9szfregck5gslkya3c79d86xx0l33tpk8gnn7ew9vw37w43zh22u8dgdax"
|
||||
case uaRead of
|
||||
Nothing -> assertFailure "wrong address"
|
||||
Just ua -> do
|
||||
tx <-
|
||||
prepareTx
|
||||
"zenith.db"
|
||||
TestNet
|
||||
(toSqlKey 1)
|
||||
2819811
|
||||
0.04
|
||||
ua
|
||||
"sent with Zenith, test"
|
||||
tx `shouldBe` Right (hexString "deadbeef")
|
||||
describe "Testing validation" $ do
|
||||
it "Unified" $ do
|
||||
let a =
|
||||
"utest1zfnw84xuxg0ytzqc008gz0qntr8cvwu4qjsccgtxwdrjywra7uj85x8ldymjc2jd3jvvvhyj3xwsunyvwkr5084t6p5gmvzwdgvwpflrpd6a3squ2dp8vt7cxngmwk30l44wkmvyfegypqmezxfnqj572lr779gkqj5xekp66uv4jga58alnc5j7tuank758zd96ap4f09udg6y6pxu"
|
||||
True `shouldBe`
|
||||
(case isValidUnifiedAddress (E.encodeUtf8 a) of
|
||||
Just _a1 -> True
|
||||
Nothing ->
|
||||
isValidShieldedAddress (E.encodeUtf8 a) ||
|
||||
(case decodeTransparentAddress (E.encodeUtf8 a) of
|
||||
Just _a3 -> True
|
||||
Nothing ->
|
||||
case decodeExchangeAddress a of
|
||||
Just _a4 -> True
|
||||
Nothing -> False))
|
||||
it "Sapling" $ do
|
||||
let a =
|
||||
"ztestsapling1tgjr4zppwk4ne8xy6gdq4z2gwq7dmf5jq8z2ctpn8nlmtse0a74fa5z0m8z383gmpgqz6q6duu4"
|
||||
True `shouldBe`
|
||||
(case isValidUnifiedAddress (E.encodeUtf8 a) of
|
||||
Just _a1 -> True
|
||||
Nothing ->
|
||||
isValidShieldedAddress (E.encodeUtf8 a) ||
|
||||
(case decodeTransparentAddress (E.encodeUtf8 a) of
|
||||
Just _a3 -> True
|
||||
Nothing ->
|
||||
case decodeExchangeAddress a of
|
||||
Just _a4 -> True
|
||||
Nothing -> False))
|
||||
it "Transparent" $ do
|
||||
let a = "tmGfVZHuGVJ5vcLAgBdkUU4w7fLTRE5nXm3"
|
||||
True `shouldBe`
|
||||
(case isValidUnifiedAddress (E.encodeUtf8 a) of
|
||||
Just _a1 -> True
|
||||
Nothing ->
|
||||
isValidShieldedAddress (E.encodeUtf8 a) ||
|
||||
(case decodeTransparentAddress (E.encodeUtf8 a) of
|
||||
Just _a3 -> True
|
||||
Nothing ->
|
||||
case decodeExchangeAddress a of
|
||||
Just _a4 -> True
|
||||
Nothing -> False))
|
||||
it "Check Sapling Address" $ do
|
||||
let a =
|
||||
encodeSaplingAddress TestNet $
|
||||
SaplingReceiver
|
||||
"Z$:\136!u\171<\156\196\210\SUB\n\137Hp<\221\166\146\SOH\196\172,3<\255\181\195/\239\170\158\208O\217\197\DC3\197\ESC\n\NUL-"
|
||||
a `shouldBe`
|
||||
Just
|
||||
"ztestsapling1tgjr4zppwk4ne8xy6gdq4z2gwq7dmf5jq8z2ctpn8nlmtse0a74fa5z0m8z383gmpgqz6q6duu4"
|
||||
{-describe "Creating Tx" $ do-}
|
||||
{-xit "To Orchard" $ do-}
|
||||
{-let uaRead =-}
|
||||
{-isValidUnifiedAddress-}
|
||||
{-"utest1dl54utt6prjj5e0dnlknwumnxq9hycdjpkfr0sy6e6h522remqee8axe9zax0wsjrwpj76v555pdhvj9rnargpfyycs0vpkapq98xcdhem99gc4wchzn0ggepq3y6nz3a9sscwgqxgsh9vzhcad402y3x9szfregck5gslkya3c79d86xx0l33tpk8gnn7ew9vw37w43zh22u8dgdax"-}
|
||||
{-case uaRead of-}
|
||||
{-Nothing -> assertFailure "wrong address"-}
|
||||
{-Just ua -> do-}
|
||||
{-tx <--}
|
||||
{-prepareTx-}
|
||||
{-"zenith.db"-}
|
||||
{-TestNet-}
|
||||
{-(toSqlKey 1)-}
|
||||
{-2819811-}
|
||||
{-0.04-}
|
||||
{-ua-}
|
||||
{-"sent with Zenith, test"-}
|
||||
{-tx `shouldBe` Right (hexString "deadbeef")-}
|
||||
|
|
|
|||
|
|
@ -1 +1 @@
|
|||
Subproject commit 22c0fe374976d9f2323a8b7cd42f941423d45111
|
||||
Subproject commit 9dddb42bb3ab78ed0c4d44efb00960ac112c2ce6
|
||||
|
|
@ -46,6 +46,8 @@ library
|
|||
, bytestring
|
||||
, esqueleto
|
||||
, resource-pool
|
||||
, binary
|
||||
, exceptions
|
||||
, monad-logger
|
||||
, vty-crossplatform
|
||||
, secp256k1-haskell
|
||||
|
|
@ -61,6 +63,7 @@ library
|
|||
, microlens-th
|
||||
, mtl
|
||||
, persistent
|
||||
, Hclip
|
||||
, persistent-sqlite
|
||||
, persistent-template
|
||||
, process
|
||||
|
|
@ -105,6 +108,7 @@ executable zenscan
|
|||
build-depends:
|
||||
base >=4.12 && <5
|
||||
, configurator
|
||||
, monad-logger
|
||||
, zenith
|
||||
pkgconfig-depends: rustzcash_wrapper
|
||||
default-language: Haskell2010
|
||||
|
|
@ -119,6 +123,7 @@ test-suite zenith-tests
|
|||
base >=4.12 && <5
|
||||
, bytestring
|
||||
, configurator
|
||||
, monad-logger
|
||||
, data-default
|
||||
, sort
|
||||
, text
|
||||
|
|
|
|||
Loading…
Reference in a new issue