Compare commits

..

No commits in common. "f71426d69fb7055ae485dedb8727ce19d148e7aa" and "1ba188ec248e2f8140262f67eb95dc35c48d80b9" have entirely different histories.

10 changed files with 780 additions and 1349 deletions

View file

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

View file

@ -2,7 +2,6 @@
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)
@ -12,4 +11,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"
runNoLoggingT $ scanZebra 2762066 zebraHost zebraPort dbFilePath scanZebra 2762066 zebraHost zebraPort dbFilePath

View file

@ -11,15 +11,11 @@ import qualified Brick.Focus as F
import Brick.Forms import Brick.Forms
( Form(..) ( Form(..)
, (@@=) , (@@=)
, allFieldsValid
, editShowableFieldWithValidate
, editTextField , editTextField
, focusedFormInputAttr , focusedFormInputAttr
, handleFormEvent , handleFormEvent
, invalidFormInputAttr
, newForm , newForm
, renderForm , renderForm
, setFieldValid
, updateFormState , updateFormState
) )
import qualified Brick.Main as M import qualified Brick.Main as M
@ -53,38 +49,29 @@ import Brick.Widgets.Core
, withBorderStyle , withBorderStyle
) )
import qualified Brick.Widgets.Dialog as D 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.List as L
import qualified Brick.Widgets.ProgressBar as P import qualified Brick.Widgets.ProgressBar as P
import Control.Concurrent (forkIO, threadDelay) 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 (LoggingT, runFileLoggingT, runNoLoggingT) import Control.Monad.Logger (runFileLoggingT)
import Data.Aeson import Data.Aeson
import Data.HexString (toText)
import Data.Maybe import Data.Maybe
import qualified Data.Text as T import qualified Data.Text as T
import qualified Data.Text.Encoding as E import qualified Data.Text.Encoding as E
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)
import ZcashHaskell.Sapling (decodeSaplingAddress, isValidShieldedAddress) import ZcashHaskell.Transparent (encodeTransparentReceiver)
import ZcashHaskell.Transparent
( decodeExchangeAddress
, decodeTransparentAddress
, encodeTransparentReceiver
)
import ZcashHaskell.Types import ZcashHaskell.Types
import ZcashHaskell.Utils (getBlockTime, makeZebraCall) import ZcashHaskell.Utils (getBlockTime, makeZebraCall)
import Zenith.Core import Zenith.Core
@ -105,9 +92,6 @@ data Name
| TList | TList
| HelpDialog | HelpDialog
| DialogInputField | DialogInputField
| RecField
| AmtField
| MemoField
deriving (Eq, Show, Ord) deriving (Eq, Show, Ord)
data DialogInput = DialogInput data DialogInput = DialogInput
@ -116,21 +100,12 @@ data DialogInput = DialogInput
makeLenses ''DialogInput makeLenses ''DialogInput
data SendInput = SendInput
{ _sendTo :: !T.Text
, _sendAmt :: !Float
, _sendMemo :: !T.Text
} deriving (Show)
makeLenses ''SendInput
data DialogType data DialogType
= WName = WName
| AName | AName
| AdName | AdName
| WSelect | WSelect
| ASelect | ASelect
| SendTx
| Blank | Blank
data DisplayType data DisplayType
@ -139,12 +114,10 @@ data DisplayType
| PhraseDisplay | PhraseDisplay
| TxDisplay | TxDisplay
| SyncDisplay | SyncDisplay
| SendDisplay
| BlankDisplay | BlankDisplay
data Tick data Tick =
= TickVal !Float Tick
| TickMsg !String
data State = State data State = State
{ _network :: !ZcashNet { _network :: !ZcashNet
@ -167,8 +140,6 @@ data State = State
, _balance :: !Integer , _balance :: !Integer
, _barValue :: !Float , _barValue :: !Float
, _eventDispatch :: !(BC.BChan Tick) , _eventDispatch :: !(BC.BChan Tick)
, _timer :: !Int
, _txForm :: !(Form SendInput () Name)
} }
makeLenses ''State makeLenses ''State
@ -207,14 +178,13 @@ drawUI s = [splashDialog s, helpDialog s, displayDialog s, inputDialog s, ui s]
listAddressBox "Addresses" (st ^. addresses) <+> listAddressBox "Addresses" (st ^. addresses) <+>
B.vBorder <+> B.vBorder <+>
(C.hCenter (str ("Last block seen: " ++ show (st ^. syncBlock))) <=> (C.hCenter (str ("Last block seen: " ++ show (st ^. syncBlock))) <=>
listTxBox "Transactions" (st ^. network) (st ^. transactions))) <=> listTxBox "Transactions" (st ^. transactions))) <=>
C.hCenter C.hCenter
(hBox (hBox
[ capCommand "W" "allets" [ capCommand "W" "allets"
, 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 =
@ -248,28 +218,17 @@ 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 , C.hCenter $ str "Use arrows to select"
(hBox
[ capCommand "↑↓ " "move"
, capCommand "" "select"
, capCommand "Tab " "->"
])
] ]
listTxBox :: listTxBox :: String -> L.List Name (Entity UserTx) -> Widget Name
String -> ZcashNet -> L.List Name (Entity UserTx) -> Widget Name listTxBox titleLabel tx =
listTxBox titleLabel znet tx =
C.vCenter $ C.vCenter $
vBox vBox
[ C.hCenter [ C.hCenter
(B.borderWithLabel (str titleLabel) $ (B.borderWithLabel (str titleLabel) $
hLimit 50 $ vLimit 15 $ L.renderList (listDrawTx znet) True tx) hLimit 40 $ vLimit 15 $ L.renderList listDrawTx True tx)
, str " " , str " "
, C.hCenter , C.hCenter $ str "Use arrows to select"
(hBox
[ capCommand "↑↓ " "move"
, capCommand "T" "x Display"
, capCommand "Tab " "<-"
])
] ]
helpDialog :: State -> Widget Name helpDialog :: State -> Widget Name
helpDialog st = helpDialog st =
@ -329,12 +288,6 @@ drawUI s = [splashDialog s, helpDialog s, displayDialog s, inputDialog s, ui s]
, capCommand "N" "ew" , capCommand "N" "ew"
, xCommand , 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 Blank -> emptyWidget
splashDialog :: State -> Widget Name splashDialog :: State -> Widget Name
splashDialog st = splashDialog st =
@ -384,15 +337,7 @@ 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
@ -453,11 +398,6 @@ drawUI s = [splashDialog s, helpDialog s, displayDialog s, inputDialog s, ui s]
(P.progressBar (P.progressBar
(Just $ show (st ^. barValue * 100)) (Just $ show (st ^. barValue * 100))
(_barValue st)))) (_barValue st))))
SendDisplay ->
withBorderStyle unicodeBold $
D.renderDialog
(D.dialog (Just $ txt "Sending Transaction") Nothing 50)
(padAll 1 (str $ st ^. msg))
BlankDisplay -> emptyWidget BlankDisplay -> emptyWidget
mkInputForm :: DialogInput -> Form DialogInput e Name mkInputForm :: DialogInput -> Form DialogInput e Name
@ -468,33 +408,6 @@ mkInputForm =
label s w = label s w =
padBottom (Pad 1) $ vLimit 1 (hLimit 15 $ str s <+> fill ' ') <+> 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 :: (Show a) => Bool -> a -> Widget Name
listDrawElement sel a = listDrawElement sel a =
let selStr s = let selStr s =
@ -530,22 +443,18 @@ listDrawAddress sel w =
walletAddressName (entityVal w) <> walletAddressName (entityVal w) <>
": " <> showAddress (walletAddressUAddress (entityVal w)) ": " <> showAddress (walletAddressUAddress (entityVal w))
listDrawTx :: ZcashNet -> Bool -> Entity UserTx -> Widget Name listDrawTx :: Bool -> Entity UserTx -> Widget Name
listDrawTx znet sel tx = listDrawTx sel tx =
selStr $ selStr $
T.pack T.pack
(show $ posixSecondsToUTCTime (fromIntegral (userTxTime $ entityVal tx))) <> (show $ posixSecondsToUTCTime (fromIntegral (userTxTime $ entityVal tx))) <>
" " <> T.pack fmtAmt " " <> fmtAmt
where where
amt = fromIntegral $ userTxAmount $ entityVal tx amt = fromIntegral (userTxAmount $ entityVal tx) / 100000000
dispAmount =
if znet == MainNet
then displayZec amt
else displayTaz amt
fmtAmt = fmtAmt =
if amt > 0 if amt > 0
then "" <> dispAmount <> " " then "" <> T.pack (show amt) <> " "
else " " <> dispAmount <> "" else " " <> T.pack (show amt) <> ""
selStr s = selStr s =
if sel if sel
then withAttr customAttr (txt $ "> " <> s) then withAttr customAttr (txt $ "> " <> s)
@ -572,49 +481,60 @@ barToDoAttr = A.attrName "remaining"
validBarValue :: Float -> Float validBarValue :: Float -> Float
validBarValue = clamp 0 1 validBarValue = clamp 0 1
scanZebra :: T.Text -> T.Text -> Int -> Int -> BC.BChan Tick -> IO () scanZebra :: Int -> BT.EventM Name State ()
scanZebra dbP zHost zPort b eChan = do scanZebra b = do
_ <- liftIO $ initDb dbP s <- BT.get
bStatus <- liftIO $ checkBlockChain zHost zPort _ <- liftIO $ initDb $ s ^. dbPath
pool <- runNoLoggingT $ initPool dbP bStatus <- liftIO $ checkBlockChain (s ^. zebraHost) (s ^. zebraPort)
dbBlock <- runNoLoggingT $ getMaxBlock pool dbBlock <- liftIO $ getMaxBlock $ s ^. dbPath
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
liftIO $ BC.writeBChan eChan $ TickMsg "Invalid starting block for scan" BT.modify $ set msg "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 pool step) bList mapM_ (processBlock step) bList
where where
processBlock :: ConnectionPool -> Float -> Int -> IO () processBlock :: Float -> Int -> BT.EventM Name State ()
processBlock pool step bl = do processBlock step bl = do
s <- BT.get
r <- r <-
liftIO $ liftIO $
makeZebraCall makeZebraCall
zHost (s ^. zebraHost)
zPort (s ^. zebraPort)
"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
liftIO $ BC.writeBChan eChan $ TickMsg e1 BT.modify $ set msg e1
BT.modify $ set displayBox MsgDisplay
Right blk -> do Right blk -> do
r2 <- r2 <-
liftIO $ liftIO $
makeZebraCall makeZebraCall
zHost (s ^. zebraHost)
zPort (s ^. zebraPort)
"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
liftIO $ BC.writeBChan eChan $ TickMsg e2 BT.modify $ set msg e2
BT.modify $ set displayBox MsgDisplay
Right hb -> do Right hb -> do
let blockTime = getBlockTime hb let blockTime = getBlockTime hb
mapM_ (runNoLoggingT . processTx zHost zPort blockTime pool) $ liftIO $
mapM_
(processTx
(s ^. zebraHost)
(s ^. zebraPort)
blockTime
(s ^. dbPath)) $
bl_txs $ addTime blk blockTime bl_txs $ addTime blk blockTime
liftIO $ BC.writeBChan eChan $ TickVal step BT.modify $ set barValue $ validBarValue (s ^. barValue + step)
BT.modify $ set displayBox SyncDisplay
addTime :: BlockResponse -> Int -> BlockResponse addTime :: BlockResponse -> Int -> BlockResponse
addTime bl t = addTime bl t =
BlockResponse BlockResponse
@ -624,78 +544,14 @@ scanZebra dbP zHost zPort b eChan = 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 t) = do appEvent (BT.AppEvent Tick) = do
s <- BT.get s <- BT.get
pool <- liftIO $ runNoLoggingT $ initPool $ s ^. dbPath
case t of
TickMsg m -> do
case s ^. displayBox of 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 SyncDisplay -> do
if s ^. barValue == 1.0 if s ^. barValue == 1.0
then do then BT.modify $ set displayBox BlankDisplay
selWallet <- else BT.modify $ set displayBox SyncDisplay
do case L.listSelectedElement $ s ^. wallets of _ -> return ()
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 appEvent (BT.VtyEvent e) = do
r <- F.focusGetCurrent <$> use focusRing r <- F.focusGetCurrent <$> use focusRing
s <- BT.get s <- BT.get
@ -709,63 +565,33 @@ appEvent (BT.VtyEvent e) = do
_ev -> return () _ev -> return ()
else do else do
case s ^. displayBox of case s ^. displayBox of
AddrDisplay -> do AddrDisplay -> BT.modify $ set displayBox BlankDisplay
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 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
SendDisplay -> 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
@ -849,71 +675,6 @@ appEvent (BT.VtyEvent e) = do
s ^. inputForm s ^. inputForm
BT.modify $ set dialogBox AName BT.modify $ set dialogBox AName
ev -> BT.zoom accounts $ L.handleListEvent ev 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 Blank -> do
case e of case e of
V.EvKey (V.KChar '\t') [] -> focusRing %= F.focusNext V.EvKey (V.KChar '\t') [] -> focusRing %= F.focusNext
@ -933,10 +694,8 @@ appEvent (BT.VtyEvent e) = do
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 V.EvKey (V.KChar 's') [] -> do
BT.modify $ BT.modify $ set barValue 0.0
set txForm $ BT.modify $ set displayBox SyncDisplay
mkSendForm (s ^. balance) (SendInput "" 0.0 "")
BT.modify $ set dialogBox SendTx
ev -> ev ->
case r of case r of
Just AList -> Just AList ->
@ -961,9 +720,6 @@ theMap =
, (titleAttr, V.withStyle (fg V.brightGreen) V.bold) , (titleAttr, V.withStyle (fg V.brightGreen) V.bold)
, (blinkAttr, style V.blink) , (blinkAttr, style V.blink)
, (focusedFormInputAttr, V.white `on` V.blue) , (focusedFormInputAttr, V.white `on` V.blue)
, (invalidFormInputAttr, V.red `on` V.black)
, (E.editAttr, V.white `on` V.blue)
, (E.editFocusedAttr, V.blue `on` V.white)
, (baseAttr, bg V.brightBlack) , (baseAttr, bg V.brightBlack)
, (barDoneAttr, V.white `on` V.blue) , (barDoneAttr, V.white `on` V.blue)
, (barToDoAttr, V.white `on` V.black) , (barToDoAttr, V.white `on` V.black)
@ -984,7 +740,6 @@ 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
@ -995,18 +750,18 @@ runZenithCLI config = do
Left e1 -> throwIO e1 Left e1 -> throwIO e1
Right chainInfo -> do Right chainInfo -> do
initDb dbFilePath initDb dbFilePath
walList <- getWallets pool $ zgb_net chainInfo walList <- getWallets dbFilePath $ zgb_net chainInfo
accList <- accList <-
if not (null walList) if not (null walList)
then runNoLoggingT $ getAccounts pool $ entityKey $ head walList then getAccounts dbFilePath $ entityKey $ head walList
else return [] else return []
addrList <- addrList <-
if not (null accList) if not (null accList)
then runNoLoggingT $ getAddresses pool $ entityKey $ head accList then getAddresses dbFilePath $ entityKey $ head accList
else return [] else return []
txList <- txList <-
if not (null addrList) if not (null addrList)
then getUserTx pool $ entityKey $ head addrList then getUserTx dbFilePath $ entityKey $ head addrList
else return [] else return []
let block = let block =
if not (null walList) if not (null walList)
@ -1014,14 +769,9 @@ runZenithCLI config = do
else 0 else 0
bal <- bal <-
if not (null accList) if not (null accList)
then getBalance pool $ entityKey $ head accList then getBalance dbFilePath $ 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 $
@ -1050,8 +800,6 @@ runZenithCLI config = do
bal bal
1.0 1.0
eventChan eventChan
0
(mkSendForm 0 $ SendInput "" 0.0 "")
Left e -> do Left e -> do
print $ print $
"No Zebra node available on port " <> "No Zebra node available on port " <>
@ -1059,38 +807,34 @@ runZenithCLI config = do
refreshWallet :: State -> IO State refreshWallet :: State -> IO State
refreshWallet s = do refreshWallet s = do
pool <- runNoLoggingT $ initPool $ s ^. dbPath selWallet <-
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 (j, w1) Just (_j, w1) -> return w1
Just (k, w) -> return (k, w) Just (_k, w) -> return w
aL <- runNoLoggingT $ getAccounts pool $ entityKey selWallet aL <- getAccounts (s ^. dbPath) $ entityKey selWallet
let bl = zcashWalletLastSync $ entityVal selWallet let bl = zcashWalletLastSync $ entityVal selWallet
addrL <- addrL <-
if not (null aL) if not (null aL)
then runNoLoggingT $ getAddresses pool $ entityKey $ head aL then getAddresses (s ^. dbPath) $ entityKey $ head aL
else return [] else return []
bal <- bal <-
if not (null aL) if not (null aL)
then getBalance pool $ entityKey $ head aL then getBalance (s ^. dbPath) $ entityKey $ head aL
else return 0 else return 0
txL <- txL <-
if not (null addrL) if not (null addrL)
then getUserTx pool $ entityKey $ head addrL then getUserTx (s ^. dbPath) $ 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 & wallets .~ wL & accounts .~ aL' & syncBlock .~ bl & balance .~ bal & (s & accounts .~ aL') & syncBlock .~ bl & balance .~ bal & addresses .~
addresses .~
addrL' & addrL' &
transactions .~ transactions .~
txL' & txL' &
@ -1101,15 +845,16 @@ 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 <- saveWallet pool $ ZcashWallet n (ZcashNetDB netName) (PhraseDB sP) bH 0 r <-
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 pool netName wL <- getWallets (s ^. dbPath) 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)
@ -1117,7 +862,6 @@ 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
@ -1127,19 +871,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 pool (entityKey selWallet) aL' <- getMaxAccount (s ^. dbPath) (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 pool zA' r <- saveAccount (s ^. dbPath) 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 <- runNoLoggingT $ getAccounts pool (entityKey selWallet) aL <- getAccounts (s ^. dbPath) (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)
@ -1148,7 +892,6 @@ 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
@ -1158,8 +901,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 <- runNoLoggingT $ getAddresses pool $ entityKey selAccount aL <- getAddresses (s ^. dbPath) $ entityKey selAccount
bal <- getBalance pool $ entityKey selAccount bal <- getBalance (s ^. dbPath) $ 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
@ -1173,7 +916,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 pool $ entityKey a tList <- getUserTx (s ^. dbPath) $ 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 .~
@ -1182,7 +925,6 @@ 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
@ -1193,13 +935,12 @@ 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 pool $ entityKey a tList <- getUserTx (s ^. dbPath) $ 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
@ -1209,19 +950,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 pool (entityKey selAccount) scope maxAddr <- getMaxAddress (s ^. dbPath) (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 pool uA' nAddr <- saveAddress (s ^. dbPath) 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 <- runNoLoggingT $ getAddresses pool (entityKey selAccount) addrL <- getAddresses (s ^. dbPath) (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)
@ -1230,51 +971,3 @@ addNewAddress n scope s = do
T.unpack n ++ T.unpack n ++
"(" ++ "(" ++
T.unpack (showAddress $ walletAddressUAddress $ entityVal x) ++ ")" 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"

View file

@ -9,18 +9,13 @@ import Control.Monad.IO.Class (liftIO)
import Control.Monad.Logger import Control.Monad.Logger
( LoggingT ( LoggingT
, MonadLoggerIO , MonadLoggerIO
, NoLoggingT
, logDebugN
, logErrorN
, logInfoN , logInfoN
, logWarnN , logWarnN
, runFileLoggingT , runFileLoggingT
, runNoLoggingT
, runStdoutLoggingT , runStdoutLoggingT
) )
import Crypto.Secp256k1 (SecKey(..)) import Crypto.Secp256k1 (SecKey(..))
import Data.Aeson import Data.Aeson
import Data.Binary.Get hiding (getBytes)
import qualified Data.ByteString as BS import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as LBS import qualified Data.ByteString.Lazy as LBS
import Data.Digest.Pure.MD5 import Data.Digest.Pure.MD5
@ -36,7 +31,6 @@ 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
@ -236,24 +230,22 @@ 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
pool <- runNoLoggingT $ initPool dbPath tList <- getShieldedOutputs dbPath b
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 pool tList decryptNotes sT zn tList
sapNotes <- getWalletSapNotes pool (entityKey za) sapNotes <- getWalletSapNotes dbPath (entityKey za)
findSapSpends pool (entityKey za) sapNotes findSapSpends dbPath (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 pool ((zt, o):txs) = do decryptNotes st n ((zt, o):txs) = do
let updatedTree = let updatedTree =
updateSaplingCommitmentTree updateSaplingCommitmentTree
st st
@ -270,11 +262,15 @@ 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 pool txs decryptNotes uT n txs
Just dn1 -> do Just dn1 -> do
wId <- saveWalletTransaction pool (entityKey za) zt wId <-
saveWalletTransaction
(c_dbPath config)
(entityKey za)
zt
saveWalletSapNote saveWalletSapNote
pool (c_dbPath config)
wId wId
nP nP
(fromJust noteWitness) (fromJust noteWitness)
@ -282,11 +278,12 @@ findSaplingOutputs config b znet za = do
(entityKey za) (entityKey za)
(entityKey o) (entityKey o)
dn1 dn1
decryptNotes uT n pool txs decryptNotes uT n txs
Just dn0 -> do Just dn0 -> do
wId <- saveWalletTransaction pool (entityKey za) zt wId <-
saveWalletTransaction (c_dbPath config) (entityKey za) zt
saveWalletSapNote saveWalletSapNote
pool (c_dbPath config)
wId wId
nP nP
(fromJust noteWitness) (fromJust noteWitness)
@ -294,7 +291,7 @@ findSaplingOutputs config b znet za = do
(entityKey za) (entityKey za)
(entityKey o) (entityKey o)
dn0 dn0
decryptNotes uT n pool txs decryptNotes uT n txs
decodeShOut :: decodeShOut ::
Scope Scope
-> ZcashNet -> ZcashNet
@ -327,22 +324,20 @@ 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
pool <- runNoLoggingT $ initPool dbPath tList <- getOrchardActions dbPath b
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 pool tList decryptNotes sT zn tList
orchNotes <- getWalletOrchNotes pool (entityKey za) orchNotes <- getWalletOrchNotes dbPath (entityKey za)
findOrchSpends pool (entityKey za) orchNotes findOrchSpends dbPath (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 pool ((zt, o):txs) = do decryptNotes ot n ((zt, o):txs) = do
let updatedTree = let updatedTree =
updateOrchardCommitmentTree updateOrchardCommitmentTree
ot ot
@ -358,11 +353,15 @@ 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 pool txs Nothing -> decryptNotes uT n txs
Just dn1 -> do Just dn1 -> do
wId <- saveWalletTransaction pool (entityKey za) zt wId <-
saveWalletTransaction
(c_dbPath config)
(entityKey za)
zt
saveWalletOrchNote saveWalletOrchNote
pool (c_dbPath config)
wId wId
nP nP
(fromJust noteWitness) (fromJust noteWitness)
@ -370,11 +369,12 @@ findOrchardActions config b znet za = do
(entityKey za) (entityKey za)
(entityKey o) (entityKey o)
dn1 dn1
decryptNotes uT n pool txs decryptNotes uT n txs
Just dn -> do Just dn -> do
wId <- saveWalletTransaction pool (entityKey za) zt wId <-
saveWalletTransaction (c_dbPath config) (entityKey za) zt
saveWalletOrchNote saveWalletOrchNote
pool (c_dbPath config)
wId wId
nP nP
(fromJust noteWitness) (fromJust noteWitness)
@ -382,7 +382,7 @@ findOrchardActions config b znet za = do
(entityKey za) (entityKey za)
(entityKey o) (entityKey o)
dn dn
decryptNotes uT n pool txs decryptNotes uT n txs
sk :: OrchardSpendingKeyDB sk :: OrchardSpendingKeyDB
sk = zcashAccountOrchSpendKey $ entityVal za sk = zcashAccountOrchSpendKey $ entityVal za
decodeOrchAction :: decodeOrchAction ::
@ -399,34 +399,48 @@ findOrchardActions config b znet za = do
(getHex $ orchActionCv $ entityVal o) (getHex $ orchActionCv $ entityVal o)
(getHex $ orchActionAuth $ entityVal o) (getHex $ orchActionAuth $ entityVal o)
updateSaplingWitnesses :: ConnectionPool -> IO () updateSaplingWitnesses :: T.Text -> LoggingT IO ()
updateSaplingWitnesses pool = do updateSaplingWitnesses dbPath = do
sapNotes <- getUnspentSapNotes pool sapNotes <- liftIO $ getUnspentSapNotes dbPath
pool <- createSqlitePool dbPath 5
maxId <- liftIO $ getMaxSaplingNote pool maxId <- liftIO $ getMaxSaplingNote pool
mapM_ (updateOneNote maxId) sapNotes mapM_ (updateOneNote pool maxId) sapNotes
where where
updateOneNote :: ShieldOutputId -> Entity WalletSapNote -> IO () updateOneNote ::
updateOneNote maxId n = do Pool SqlBackend
-> ShieldOutputId
-> Entity WalletSapNote
-> LoggingT IO ()
updateOneNote pool maxId n = do
let noteSync = walletSapNoteWitPos $ entityVal n let noteSync = walletSapNoteWitPos $ entityVal n
when (noteSync < maxId) $ do if noteSync < maxId
cmus <- liftIO $ getSaplingCmus pool $ walletSapNoteWitPos $ entityVal n then do
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 :: ConnectionPool -> IO () updateOrchardWitnesses :: T.Text -> LoggingT IO ()
updateOrchardWitnesses pool = do updateOrchardWitnesses dbPath = do
orchNotes <- getUnspentOrchNotes pool orchNotes <- liftIO $ getUnspentOrchNotes dbPath
maxId <- getMaxOrchardNote pool pool <- createSqlitePool dbPath 5
mapM_ (updateOneNote maxId) orchNotes maxId <- liftIO $ getMaxOrchardNote pool
mapM_ (updateOneNote pool maxId) orchNotes
where where
updateOneNote :: OrchActionId -> Entity WalletOrchNote -> IO () updateOneNote ::
updateOneNote maxId n = do Pool SqlBackend
-> OrchActionId
-> Entity WalletOrchNote
-> LoggingT IO ()
updateOneNote pool maxId n = do
let noteSync = walletOrchNoteWitPos $ entityVal n let noteSync = walletOrchNoteWitPos $ entityVal n
when (noteSync < maxId) $ do if noteSync < maxId
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 =
@ -434,6 +448,7 @@ updateOrchardWitnesses pool = 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 ::
@ -445,21 +460,21 @@ calculateTxFee (t, s, o) i =
(5000 * (max (length t) tout + max (length s) sout + length o + oout)) (5000 * (max (length t) tout + max (length s) sout + length o + oout))
where where
tout = tout =
if i == 1 || i == 2 if i == 1
then 1 then 1
else 0 else 0
sout = sout =
if i == 3 if i == 2
then 1 then 1
else 0 else 0
oout = oout =
if i == 4 if i == 3
then 1 then 2
else 0 else 1
-- | Prepare a transaction for sending -- | Prepare a transaction for sending
prepareTx :: prepareTx ::
ConnectionPool T.Text
-> T.Text -> T.Text
-> Int -> Int
-> ZcashNet -> ZcashNet
@ -468,9 +483,9 @@ prepareTx ::
-> Float -> Float
-> UnifiedAddress -> UnifiedAddress
-> T.Text -> T.Text
-> LoggingT IO (Either TxError HexString) -> IO (Either TxError HexString)
prepareTx pool zebraHost zebraPort zn za bh amt ua memo = do prepareTx dbPath zebraHost zebraPort zn za bh amt ua memo = do
accRead <- liftIO $ getAccountById pool za accRead <- getAccountById dbPath za
let recipient = let recipient =
case o_rec ua of case o_rec ua of
Nothing -> Nothing ->
@ -484,83 +499,50 @@ prepareTx pool zebraHost zebraPort zn za bh amt ua memo = do
P2SH -> (2, toBytes $ tr_bytes r3) P2SH -> (2, toBytes $ tr_bytes r3)
Just r2 -> (3, getBytes r2) Just r2 -> (3, getBytes r2)
Just r1 -> (4, getBytes r1) Just r1 -> (4, getBytes r1)
logDebugN $ T.pack $ show recipient print recipient
logDebugN $ T.pack $ "Target block: " ++ show bh trees <- getCommitmentTrees zebraHost zebraPort bh
trees <- liftIO $ getCommitmentTrees zebraHost zebraPort bh
let sT = SaplingCommitmentTree $ ztiSapling trees let sT = SaplingCommitmentTree $ ztiSapling trees
let oT = OrchardCommitmentTree $ ztiOrchard trees let oT = OrchardCommitmentTree $ ztiOrchard trees
case accRead of case accRead of
Nothing -> do Nothing -> throwIO $ userError "Can't find Account"
logErrorN "Can't find Account"
return $ Left ZHError
Just acc -> do Just acc -> do
logDebugN $ T.pack $ show acc print acc
spParams <- liftIO $ BS.readFile "sapling-spend.params" spParams <- BS.readFile "sapling-spend.params"
outParams <- liftIO $ BS.readFile "sapling-output.params" outParams <- BS.readFile "sapling-output.params"
if show (md5 $ LBS.fromStrict spParams) /= if show (md5 $ LBS.fromStrict spParams) /=
"0f44c12ef115ae019decf18ade583b20" "0f44c12ef115ae019decf18ade583b20"
then logErrorN "Can't validate sapling parameters" then throwIO $ userError "Can't validate sapling parameters"
else logInfoN "Valid Sapling spend params" else print "Valid Sapling spend params"
if show (md5 $ LBS.fromStrict outParams) /= if show (md5 $ LBS.fromStrict outParams) /=
"924daf81b87a81bbbb9c7d18562046c8" "924daf81b87a81bbbb9c7d18562046c8"
then logErrorN "Can't validate sapling parameters" then throwIO $ userError "Can't validate sapling parameters"
else logInfoN "Valid Sapling output params" else print "Valid Sapling output params"
--print $ BS.length spParams print $ BS.length spParams
--print $ BS.length outParams print $ BS.length outParams
logDebugN "Read Sapling params" print "Read Sapling params"
let zats = fromIntegral $ floorFloatInteger $ amt * (10 ^ 8) let zats = fromIntegral $ floorFloatInteger $ amt * (10 ^ 8)
logDebugN $ T.pack $ show zats firstPass <- selectUnspentNotes dbPath za zats
{-firstPass <- liftIO $ selectUnspentNotes pool za zats-} let fee = calculateTxFee firstPass 3
--let fee = calculateTxFee firstPass $ fst recipient print "calculated fee"
--logDebugN $ T.pack $ "calculated fee " ++ show fee print fee
(tList, sList, oList) <- liftIO $ selectUnspentNotes pool za (zats + 5000) (tList, sList, oList) <- selectUnspentNotes dbPath za (zats + fee)
logDebugN "selected notes" print "selected notes"
logDebugN $ T.pack $ show tList print tList
logDebugN $ T.pack $ show sList print sList
logDebugN $ T.pack $ show oList print oList
let noteTotal = getTotalAmount (tList, sList, oList) let noteTotal = getTotalAmount (tList, sList, oList)
print noteTotal
tSpends <- tSpends <-
liftIO $
prepTSpends (getTranSK $ zcashAccountTPrivateKey $ entityVal acc) tList prepTSpends (getTranSK $ zcashAccountTPrivateKey $ entityVal acc) tList
--print tSpends print tSpends
sSpends <- sSpends <-
liftIO $
prepSSpends (getSapSK $ zcashAccountSapSpendKey $ entityVal acc) sList prepSSpends (getSapSK $ zcashAccountSapSpendKey $ entityVal acc) sList
--print sSpends print sSpends
oSpends <- oSpends <-
liftIO $
prepOSpends (getOrchSK $ zcashAccountOrchSpendKey $ entityVal acc) oList prepOSpends (getOrchSK $ zcashAccountOrchSpendKey $ entityVal acc) oList
--print oSpends print oSpends
dummy <- outgoing <- makeOutgoing acc recipient zats (noteTotal - fee - zats)
liftIO $ makeOutgoing acc recipient zats (noteTotal - 5000 - zats) print outgoing
logDebugN "Calculating fee"
let feeResponse =
createTransaction
(Just sT)
(Just oT)
tSpends
sSpends
oSpends
dummy
(SaplingSpendParams spParams)
(SaplingOutputParams outParams)
zn
(bh + 3)
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 = let tx =
createTransaction createTransaction
(Just sT) (Just sT)
@ -573,7 +555,6 @@ prepareTx pool zebraHost zebraPort zn za bh amt ua memo = do
(SaplingOutputParams outParams) (SaplingOutputParams outParams)
zn zn
(bh + 3) (bh + 3)
True
return tx return tx
where where
makeOutgoing :: makeOutgoing ::
@ -583,7 +564,7 @@ prepareTx pool 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 <- runNoLoggingT $ getInternalAddresses pool $ entityKey acc chgAddr <- getInternalAddresses dbPath $ 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)
@ -623,7 +604,8 @@ prepareTx pool 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 pool $ walletTrNoteAddress $ entityVal n tAddRead <- getAddressById dbPath $ walletTrNoteAddress $ entityVal 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"
Just tAdd -> do Just tAdd -> do
@ -632,7 +614,7 @@ prepareTx pool 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 pool $ walletTrNoteTx $ entityVal n mReverseTxId <- getWalletTxId dbPath $ 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
@ -650,6 +632,7 @@ prepareTx pool zebraHost zebraPort zn za bh amt ua memo = do
SaplingSpendingKey -> [Entity WalletSapNote] -> IO [SaplingTxSpend] SaplingSpendingKey -> [Entity WalletSapNote] -> IO [SaplingTxSpend]
prepSSpends sk notes = do prepSSpends sk notes = do
forM notes $ \n -> do forM notes $ \n -> do
print n
return $ return $
SaplingTxSpend SaplingTxSpend
(getBytes sk) (getBytes sk)
@ -665,6 +648,7 @@ prepareTx pool zebraHost zebraPort zn za bh amt ua memo = do
OrchardSpendingKey -> [Entity WalletOrchNote] -> IO [OrchardTxSpend] OrchardSpendingKey -> [Entity WalletOrchNote] -> IO [OrchardTxSpend]
prepOSpends sk notes = do prepOSpends sk notes = do
forM notes $ \n -> do forM notes $ \n -> do
print n
return $ return $
OrchardTxSpend OrchardTxSpend
(getBytes sk) (getBytes sk)
@ -695,24 +679,22 @@ prepareTx pool zebraHost zebraPort zn za bh amt ua memo = do
syncWallet :: syncWallet ::
Config -- ^ configuration parameters Config -- ^ configuration parameters
-> Entity ZcashWallet -> Entity ZcashWallet
-> IO () -> LoggingT IO ()
syncWallet config w = do syncWallet config w = do
startTime <- liftIO getCurrentTime
let walletDb = c_dbPath config let walletDb = c_dbPath config
pool <- runNoLoggingT $ initPool walletDb accs <- liftIO $ getAccounts walletDb $ entityKey w
accs <- runNoLoggingT $ getAccounts pool $ entityKey w addrs <- liftIO $ concat <$> mapM (getAddresses walletDb . entityKey) accs
addrs <- concat <$> mapM (runNoLoggingT . getAddresses pool . entityKey) accs
intAddrs <- intAddrs <-
concat <$> mapM (runNoLoggingT . getInternalAddresses pool . entityKey) accs liftIO $ concat <$> mapM (getInternalAddresses walletDb . entityKey) accs
chainTip <- runNoLoggingT $ getMaxBlock pool chainTip <- liftIO $ getMaxBlock walletDb
let lastBlock = zcashWalletLastSync $ entityVal w let lastBlock = zcashWalletLastSync $ entityVal w
let startBlock = let startBlock =
if lastBlock > 0 if lastBlock > 0
then lastBlock then lastBlock
else zcashWalletBirthdayHeight $ entityVal w else zcashWalletBirthdayHeight $ entityVal w
mapM_ (liftIO . findTransparentNotes pool startBlock) addrs mapM_ (liftIO . findTransparentNotes walletDb startBlock) addrs
mapM_ (liftIO . findTransparentNotes pool startBlock) intAddrs mapM_ (liftIO . findTransparentNotes walletDb startBlock) intAddrs
mapM_ (liftIO . findTransparentSpends pool . entityKey) accs mapM_ (liftIO . findTransparentSpends walletDb . entityKey) accs
sapNotes <- sapNotes <-
liftIO $ liftIO $
mapM mapM
@ -723,52 +705,52 @@ syncWallet config w = do
mapM mapM
(findOrchardActions config startBlock (zcashWalletNetwork $ entityVal w)) (findOrchardActions config startBlock (zcashWalletNetwork $ entityVal w))
accs accs
_ <- updateSaplingWitnesses pool _ <- updateSaplingWitnesses walletDb
_ <- updateOrchardWitnesses pool _ <- updateOrchardWitnesses walletDb
_ <- liftIO $ updateWalletSync pool chainTip (entityKey w) _ <- liftIO $ updateWalletSync walletDb chainTip (entityKey w)
mapM_ (runNoLoggingT . getWalletTransactions pool) addrs _ <- liftIO $ mapM_ (getWalletTransactions walletDb) addrs
logInfoN "Synced wallet"
testSync :: Config -> IO () testSync :: Config -> IO ()
testSync config = do testSync config = do
let dbPath = c_dbPath config let dbPath = c_dbPath config
_ <- initDb dbPath _ <- initDb dbPath
pool <- runNoLoggingT $ initPool dbPath w <- getWallets dbPath TestNet
w <- getWallets pool TestNet r <- runFileLoggingT "zenith.log" $ mapM (syncWallet config) w
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 pool _ <- clearWalletTransactions dbPath
w <- getWallets pool TestNet w <- getWallets dbPath TestNet
liftIO $ mapM_ (updateWalletSync pool 0 . entityKey) w liftIO $ mapM_ (updateWalletSync dbPath 0 . entityKey) w
w' <- liftIO $ getWallets pool TestNet w' <- liftIO $ getWallets dbPath TestNet
r <- mapM (syncWallet config) w' r <- runFileLoggingT "zenith.log" $ mapM (syncWallet config) w'
liftIO $ print r liftIO $ print r

File diff suppressed because it is too large Load diff

View file

@ -3,23 +3,11 @@
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(..)
@ -42,77 +30,64 @@ scanZebra ::
-> T.Text -- ^ Host -> T.Text -- ^ Host
-> Int -- ^ Port -> Int -- ^ Port
-> T.Text -- ^ Path to database file -> T.Text -- ^ Path to database file
-> NoLoggingT IO () -> IO ()
scanZebra b host port dbFilePath = do scanZebra b host port dbFilePath = do
_ <- liftIO $ initDb dbFilePath _ <- initDb dbFilePath
startTime <- liftIO getCurrentTime
logInfoN $ "Started sync: " <> T.pack (show startTime)
bc <- bc <-
liftIO $ try $ checkBlockChain host port :: NoLoggingT try $ checkBlockChain host port :: IO
IO
(Either IOError ZebraGetBlockChainInfo) (Either IOError ZebraGetBlockChainInfo)
case bc of case bc of
Left e -> logErrorN $ T.pack (show e) Left e -> print e
Right bStatus -> do Right bStatus -> do
let dbInfo = dbBlock <- getMaxBlock dbFilePath
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 liftIO $ throwIO $ userError "Invalid starting block for scan" then 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 <- pg <- newProgressBar def {pgTotal = fromIntegral $ length bList}
liftIO $
newProgressBar def {pgTotal = fromIntegral $ length bList}
txList <- txList <-
CM.try $ mapM_ (processBlock host port pool pg) bList :: NoLoggingT try $ mapM_ (processBlock host port dbFilePath pg) bList :: IO
IO
(Either IOError ()) (Either IOError ())
case txList of case txList of
Left e1 -> logErrorN $ T.pack (show e1) Left e1 -> print e1
Right txList' -> logInfoN "Finished scan" Right txList' -> print txList'
-- | 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`
-> ConnectionPool -- ^ DB file path -> T.Text -- ^ DB file path
-> ProgressBar -- ^ Progress bar -> ProgressBar -- ^ Progress bar
-> Int -- ^ The block number to process -> Int -- ^ The block number to process
-> NoLoggingT IO () -> IO ()
processBlock host port pool pg b = do processBlock host port dbFp 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 -> liftIO $ throwIO $ userError e Left e -> 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 -> liftIO $ throwIO $ userError e2 Left e2 -> throwIO $ userError e2
Right hb -> do Right hb -> do
let blockTime = getBlockTime hb let blockTime = getBlockTime hb
mapM_ (processTx host port blockTime pool) $ mapM_ (processTx host port blockTime dbFp) $
bl_txs $ addTime blk blockTime bl_txs $ addTime blk blockTime
liftIO $ tick pg tick pg
where where
addTime :: BlockResponse -> Int -> BlockResponse addTime :: BlockResponse -> Int -> BlockResponse
addTime bl t = addTime bl t =
@ -127,25 +102,24 @@ 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
-> ConnectionPool -- ^ DB file path -> T.Text -- ^ DB file path
-> HexString -- ^ transaction id -> HexString -- ^ transaction id
-> NoLoggingT IO () -> IO ()
processTx host port bt pool t = do processTx host port bt dbFp 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 -> liftIO $ throwIO $ userError e Left e -> 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 pool bt $ saveTransaction dbFp bt $
Transaction Transaction
t t
(ztr_blockheight rawTx) (ztr_blockheight rawTx)

View file

@ -26,17 +26,17 @@ jsonNumber i = Number $ scientific (fromIntegral i) 0
-- | Helper function to display small amounts of ZEC -- | Helper function to display small amounts of ZEC
displayZec :: Integer -> String displayZec :: Integer -> String
displayZec s displayZec s
| abs s < 100 = show s ++ " zats " | s < 100 = show s ++ " zats "
| abs s < 100000 = show (fromIntegral s / 100) ++ " μZEC " | s < 100000 = show (fromIntegral s / 100) ++ " μZEC "
| abs s < 100000000 = show (fromIntegral s / 100000) ++ " mZEC " | s < 100000000 = show (fromIntegral s / 100000) ++ " mZEC "
| otherwise = show (fromIntegral s / 100000000) ++ " ZEC " | otherwise = show (fromIntegral s / 100000000) ++ " ZEC "
-- | Helper function to display small amounts of ZEC -- | Helper function to display small amounts of ZEC
displayTaz :: Integer -> String displayTaz :: Integer -> String
displayTaz s displayTaz s
| abs s < 100 = show s ++ " tazs " | s < 100 = show s ++ " tazs "
| abs s < 100000 = show (fromIntegral s / 100) ++ " μTAZ " | s < 100000 = show (fromIntegral s / 100) ++ " μTAZ "
| abs s < 100000000 = show (fromIntegral s / 100000) ++ " mTAZ " | s < 100000000 = show (fromIntegral s / 100000) ++ " mTAZ "
| otherwise = show (fromIntegral s / 100000000) ++ " TAZ " | otherwise = show (fromIntegral s / 100000000) ++ " TAZ "
-- | Helper function to display abbreviated Unified Address -- | Helper function to display abbreviated Unified Address

View file

@ -1,9 +1,7 @@
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
import Control.Monad (when) import Control.Monad (when)
import Control.Monad.Logger (runNoLoggingT)
import Data.HexString import Data.HexString
import qualified Data.Text.Encoding as E
import Database.Persist import Database.Persist
import Database.Persist.Sqlite import Database.Persist.Sqlite
import System.Directory import System.Directory
@ -12,22 +10,15 @@ import Test.Hspec
import ZcashHaskell.Orchard (isValidUnifiedAddress) import ZcashHaskell.Orchard (isValidUnifiedAddress)
import ZcashHaskell.Sapling import ZcashHaskell.Sapling
( decodeSaplingOutputEsk ( decodeSaplingOutputEsk
, encodeSaplingAddress
, getSaplingNotePosition , getSaplingNotePosition
, getSaplingWitness , getSaplingWitness
, isValidShieldedAddress
, updateSaplingCommitmentTree , updateSaplingCommitmentTree
) )
import ZcashHaskell.Transparent
( decodeExchangeAddress
, decodeTransparentAddress
)
import ZcashHaskell.Types import ZcashHaskell.Types
( DecodedNote(..) ( DecodedNote(..)
, OrchardSpendingKey(..) , OrchardSpendingKey(..)
, Phrase(..) , Phrase(..)
, SaplingCommitmentTree(..) , SaplingCommitmentTree(..)
, SaplingReceiver(..)
, SaplingSpendingKey(..) , SaplingSpendingKey(..)
, Scope(..) , Scope(..)
, ShieldedOutput(..) , ShieldedOutput(..)
@ -81,9 +72,8 @@ main = do
"None" `shouldBe` maybe "None" zcashWalletName s "None" `shouldBe` maybe "None" zcashWalletName s
describe "Wallet function tests:" $ do describe "Wallet function tests:" $ do
it "Save Wallet:" $ do it "Save Wallet:" $ do
pool <- runNoLoggingT $ initPool "test.db"
zw <- zw <-
saveWallet pool $ saveWallet "test.db" $
ZcashWallet ZcashWallet
"Testing" "Testing"
(ZcashNetDB MainNet) (ZcashNetDB MainNet)
@ -94,19 +84,19 @@ main = do
0 0
zw `shouldNotBe` Nothing zw `shouldNotBe` Nothing
it "Save Account:" $ do it "Save Account:" $ do
pool <- runNoLoggingT $ initPool "test.db"
s <- s <-
runSqlite "test.db" $ do runSqlite "test.db" $ do
selectList [ZcashWalletName ==. "Testing"] [] selectList [ZcashWalletName ==. "Testing"] []
za <- saveAccount pool =<< createZcashAccount "TestAccount" 0 (head s) za <-
saveAccount "test.db" =<<
createZcashAccount "TestAccount" 0 (head s)
za `shouldNotBe` Nothing za `shouldNotBe` Nothing
it "Save address:" $ do it "Save address:" $ do
pool <- runNoLoggingT $ initPool "test.db"
acList <- acList <-
runSqlite "test.db" $ runSqlite "test.db" $
selectList [ZcashAccountName ==. "TestAccount"] [] selectList [ZcashAccountName ==. "TestAccount"] []
zAdd <- zAdd <-
saveAddress pool =<< saveAddress "test.db" =<<
createWalletAddress "Personal123" 0 MainNet External (head acList) createWalletAddress "Personal123" 0 MainNet External (head acList)
addList <- addList <-
runSqlite "test.db" $ runSqlite "test.db" $
@ -172,82 +162,29 @@ main = do
"6c5d1413c63a9a88db71c3f41dc12cd60197ee742fc75b217215e7144db48bd3" "6c5d1413c63a9a88db71c3f41dc12cd60197ee742fc75b217215e7144db48bd3"
describe "Note selection for Tx" $ do describe "Note selection for Tx" $ do
it "Value less than balance" $ do it "Value less than balance" $ do
pool <- runNoLoggingT $ initPool "zenith.db" res <- selectUnspentNotes "zenith.db" (toSqlKey 1) 14000000
res <- selectUnspentNotes pool (toSqlKey 1) 14000000
res `shouldNotBe` ([], [], []) res `shouldNotBe` ([], [], [])
it "Value greater than balance" $ do it "Value greater than balance" $ do
pool <- runNoLoggingT $ initPool "zenith.db" let res = selectUnspentNotes "zenith.db" (toSqlKey 1) 84000000
let res = selectUnspentNotes pool (toSqlKey 1) 84000000
res `shouldThrow` anyIOException res `shouldThrow` anyIOException
it "Fee calculation" $ do it "Fee calculation" $ do
pool <- runNoLoggingT $ initPool "zenith.db" res <- selectUnspentNotes "zenith.db" (toSqlKey 1) 14000000
res <- selectUnspentNotes pool (toSqlKey 1) 14000000
calculateTxFee res 3 `shouldBe` 20000 calculateTxFee res 3 `shouldBe` 20000
describe "Testing validation" $ do describe "Creating Tx" $ do
it "Unified" $ do xit "To Orchard" $ do
let a = let uaRead =
"utest1zfnw84xuxg0ytzqc008gz0qntr8cvwu4qjsccgtxwdrjywra7uj85x8ldymjc2jd3jvvvhyj3xwsunyvwkr5084t6p5gmvzwdgvwpflrpd6a3squ2dp8vt7cxngmwk30l44wkmvyfegypqmezxfnqj572lr779gkqj5xekp66uv4jga58alnc5j7tuank758zd96ap4f09udg6y6pxu" isValidUnifiedAddress
True `shouldBe` "utest1dl54utt6prjj5e0dnlknwumnxq9hycdjpkfr0sy6e6h522remqee8axe9zax0wsjrwpj76v555pdhvj9rnargpfyycs0vpkapq98xcdhem99gc4wchzn0ggepq3y6nz3a9sscwgqxgsh9vzhcad402y3x9szfregck5gslkya3c79d86xx0l33tpk8gnn7ew9vw37w43zh22u8dgdax"
(case isValidUnifiedAddress (E.encodeUtf8 a) of case uaRead of
Just _a1 -> True Nothing -> assertFailure "wrong address"
Nothing -> Just ua -> do
isValidShieldedAddress (E.encodeUtf8 a) || tx <-
(case decodeTransparentAddress (E.encodeUtf8 a) of prepareTx
Just _a3 -> True "zenith.db"
Nothing -> TestNet
case decodeExchangeAddress a of (toSqlKey 1)
Just _a4 -> True 2819811
Nothing -> False)) 0.04
it "Sapling" $ do ua
let a = "sent with Zenith, test"
"ztestsapling1tgjr4zppwk4ne8xy6gdq4z2gwq7dmf5jq8z2ctpn8nlmtse0a74fa5z0m8z383gmpgqz6q6duu4" tx `shouldBe` Right (hexString "deadbeef")
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 9dddb42bb3ab78ed0c4d44efb00960ac112c2ce6 Subproject commit 22c0fe374976d9f2323a8b7cd42f941423d45111

View file

@ -46,8 +46,6 @@ library
, bytestring , bytestring
, esqueleto , esqueleto
, resource-pool , resource-pool
, binary
, exceptions
, monad-logger , monad-logger
, vty-crossplatform , vty-crossplatform
, secp256k1-haskell , secp256k1-haskell
@ -63,7 +61,6 @@ library
, microlens-th , microlens-th
, mtl , mtl
, persistent , persistent
, Hclip
, persistent-sqlite , persistent-sqlite
, persistent-template , persistent-template
, process , process
@ -108,7 +105,6 @@ 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
@ -123,7 +119,6 @@ test-suite zenith-tests
base >=4.12 && <5 base >=4.12 && <5
, bytestring , bytestring
, configurator , configurator
, monad-logger
, data-default , data-default
, sort , sort
, text , text