Compare commits

..

No commits in common. "0d5161cdb284d9a12593c57e7e4764d9575d363d" and "abe30db2feff23c2fdcaaadc312acff9cad08fb3" have entirely different histories.

12 changed files with 385 additions and 992 deletions

View file

@ -24,8 +24,6 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0
### Changed ### Changed
- Detection of changes in database schema for automatic re-scan - Detection of changes in database schema for automatic re-scan
- Block tracking for chain re-org detection
- Refactored `ZcashPool`
## [0.6.0.0-beta] ## [0.6.0.0-beta]

View file

@ -230,7 +230,6 @@ main = do
"gui" -> runZenithGUI myConfig "gui" -> runZenithGUI myConfig
"tui" -> runZenithTUI myConfig "tui" -> runZenithTUI myConfig
"rescan" -> rescanZebra zebraHost zebraPort dbFilePath "rescan" -> rescanZebra zebraHost zebraPort dbFilePath
"resync" -> clearSync myConfig
_ -> printUsage _ -> printUsage
else printUsage else printUsage

View file

@ -62,14 +62,9 @@ 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 (throw, throwIO, try) import Control.Exception (throw, throwIO, try)
import Control.Monad (forever, unless, void, when) import Control.Monad (forever, void, when)
import Control.Monad.IO.Class (liftIO) import Control.Monad.IO.Class (liftIO)
import Control.Monad.Logger import Control.Monad.Logger (runFileLoggingT, runNoLoggingT)
( LoggingT
, logDebugN
, runFileLoggingT
, runNoLoggingT
)
import Data.Aeson import Data.Aeson
import Data.HexString (HexString(..), toText) import Data.HexString (HexString(..), toText)
import Data.Maybe import Data.Maybe
@ -94,10 +89,9 @@ import ZcashHaskell.Types
import ZcashHaskell.Utils (getBlockTime, makeZebraCall) import ZcashHaskell.Utils (getBlockTime, makeZebraCall)
import Zenith.Core import Zenith.Core
import Zenith.DB import Zenith.DB
import Zenith.Scanner (checkIntegrity, processTx, rescanZebra, updateConfs) import Zenith.Scanner (processTx, rescanZebra, updateConfs)
import Zenith.Types import Zenith.Types
( Config(..) ( Config(..)
, HexStringDB(..)
, PhraseDB(..) , PhraseDB(..)
, UnifiedAddressDB(..) , UnifiedAddressDB(..)
, ZcashNetDB(..) , ZcashNetDB(..)
@ -108,7 +102,7 @@ import Zenith.Utils
, displayZec , displayZec
, isRecipientValid , isRecipientValid
, jsonNumber , jsonNumber
, parseAddressUA , parseAddress
, showAddress , showAddress
, validBarValue , validBarValue
) )
@ -618,16 +612,16 @@ mkInputForm =
mkSendForm :: Integer -> SendInput -> Form SendInput e Name mkSendForm :: Integer -> SendInput -> Form SendInput e Name
mkSendForm bal = mkSendForm bal =
newForm newForm
[ label "Privacy Level :" @@= [ label "To: " @@= editTextField sendTo RecField (Just 1)
radioField policyField [ (Full, PrivacyFullField, "Full")
, (Medium, PrivacyMediumField, "Medium")
, (Low, PrivacyLowField, "Low")
, (None, PrivacyNoneField, "None")
]
, label "To: " @@= editTextField sendTo RecField (Just 1)
, label "Amount: " @@= , label "Amount: " @@=
editShowableFieldWithValidate sendAmt AmtField (isAmountValid bal) editShowableFieldWithValidate sendAmt AmtField (isAmountValid bal)
, label "Memo: " @@= editTextField sendMemo MemoField (Just 1) , label "Memo: " @@= editTextField sendMemo MemoField (Just 1)
, label "Privacy Level :" @@=
radioField policyField [ (None, PrivacyNoneField, "None")
, (Low, PrivacyLowField, "Low")
, (Medium, PrivacyMediumField, "Medium")
, (Full, PrivacyFullField, "Full")
]
] ]
where where
isAmountValid :: Integer -> Float -> Bool isAmountValid :: Integer -> Float -> Bool
@ -737,42 +731,31 @@ abMBarAttr :: A.AttrName
abMBarAttr = A.attrName "menubar" abMBarAttr = A.attrName "menubar"
scanZebra :: scanZebra ::
T.Text T.Text -> T.Text -> Int -> Int -> BC.BChan Tick -> ZcashNet -> IO ()
-> T.Text
-> Int
-> Int
-> BC.BChan Tick
-> ZcashNet
-> LoggingT IO ()
scanZebra dbP zHost zPort b eChan znet = do scanZebra dbP zHost zPort b eChan znet = do
bStatus <- liftIO $ checkBlockChain zHost zPort bStatus <- liftIO $ checkBlockChain zHost zPort
pool <- liftIO $ runNoLoggingT $ initPool dbP pool <- runNoLoggingT $ initPool dbP
dbBlock <- liftIO $ getMaxBlock pool $ ZcashNetDB znet dbBlock <- getMaxBlock pool $ ZcashNetDB znet
chkBlock <- liftIO $ checkIntegrity dbP zHost zPort dbBlock 1 confUp <- try $ updateConfs zHost zPort pool :: IO (Either IOError ())
logDebugN $ case confUp of
"dbBlock: " <> Left _e0 ->
T.pack (show dbBlock) <> " chkBlock: " <> T.pack (show chkBlock) liftIO $
BC.writeBChan eChan $ TickMsg "Failed to update unconfirmed transactions"
Right _ -> do
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" liftIO $
BC.writeBChan eChan $ TickMsg "Invalid starting block for scan"
else do else do
let bList = [(sb + 1) .. (zgb_blocks bStatus)] let bList = [(sb + 1) .. (zgb_blocks bStatus)]
if not (null bList) if not (null bList)
then do then do
let step = let step =
(1.0 :: Float) / fromIntegral (zgb_blocks bStatus - (sb + 1)) (1.0 :: Float) /
mapM_ (liftIO . processBlock pool step) bList fromIntegral (zgb_blocks bStatus - (sb + 1))
mapM_ (processBlock pool step) bList
else liftIO $ BC.writeBChan eChan $ TickVal 1.0 else liftIO $ BC.writeBChan eChan $ TickVal 1.0
confUp <-
liftIO $ try $ updateConfs zHost zPort pool :: LoggingT
IO
(Either IOError ())
case confUp of
Left _e0 ->
liftIO $
BC.writeBChan eChan $ TickMsg "Failed to update unconfirmed transactions"
Right _ -> return ()
where where
processBlock :: ConnectionPool -> Float -> Int -> IO () processBlock :: ConnectionPool -> Float -> Int -> IO ()
processBlock pool step bl = do processBlock pool step bl = do
@ -797,16 +780,16 @@ scanZebra dbP zHost zPort b eChan znet = do
Left e2 -> liftIO $ BC.writeBChan eChan $ TickMsg e2 Left e2 -> liftIO $ BC.writeBChan eChan $ TickMsg e2
Right hb -> do Right hb -> do
let blockTime = getBlockTime hb let blockTime = getBlockTime hb
bi <- mapM_ (processTx zHost zPort blockTime pool (ZcashNetDB znet)) $
saveBlock pool $ bl_txs $ addTime blk blockTime
ZcashBlock
(fromIntegral $ bl_height blk)
(HexStringDB $ bl_hash blk)
(fromIntegral $ bl_confirmations blk)
blockTime
(ZcashNetDB znet)
mapM_ (processTx zHost zPort bi pool) $ bl_txs blk
liftIO $ BC.writeBChan eChan $ TickVal step liftIO $ BC.writeBChan eChan $ TickVal step
addTime :: BlockResponse -> Int -> BlockResponse
addTime bl t =
BlockResponse
(bl_confirmations bl)
(bl_height bl)
(fromIntegral t)
(bl_txs bl)
appEvent :: BT.BrickEvent Name Tick -> BT.EventM Name State () appEvent :: BT.BrickEvent Name Tick -> BT.EventM Name State ()
appEvent (BT.AppEvent t) = do appEvent (BT.AppEvent t) = do
@ -851,7 +834,6 @@ appEvent (BT.AppEvent t) = do
Just (_k, w) -> return w Just (_k, w) -> return w
_ <- _ <-
liftIO $ liftIO $
runFileLoggingT "zenith.log" $
syncWallet syncWallet
(Config (Config
(s ^. dbPath) (s ^. dbPath)
@ -888,7 +870,6 @@ appEvent (BT.AppEvent t) = do
_ <- _ <-
liftIO $ liftIO $
forkIO $ forkIO $
runFileLoggingT "zenith.log" $
scanZebra scanZebra
(s ^. dbPath) (s ^. dbPath)
(s ^. zebraHost) (s ^. zebraHost)
@ -1160,7 +1141,7 @@ appEvent (BT.VtyEvent e) = do
(addressBookAbaddress (entityVal a)) (addressBookAbaddress (entityVal a))
0.0 0.0
"" ""
Full) None)
BT.modify $ set dialogBox SendTx BT.modify $ set dialogBox SendTx
_ -> do _ -> do
BT.modify $ BT.modify $
@ -1332,7 +1313,7 @@ appEvent (BT.VtyEvent e) = do
V.EvKey (V.KChar 's') [] -> do V.EvKey (V.KChar 's') [] -> do
BT.modify $ BT.modify $
set txForm $ set txForm $
mkSendForm (s ^. balance) (SendInput "" 0.0 "" Full) mkSendForm (s ^. balance) (SendInput "" 0.0 "" None)
BT.modify $ set dialogBox SendTx BT.modify $ set dialogBox SendTx
V.EvKey (V.KChar 'b') [] -> V.EvKey (V.KChar 'b') [] ->
BT.modify $ set dialogBox AdrBook BT.modify $ set dialogBox AdrBook
@ -1467,7 +1448,7 @@ runZenithTUI config = do
1.0 1.0
eventChan eventChan
0 0
(mkSendForm 0 $ SendInput "" 0.0 "" Full) (mkSendForm 0 $ SendInput "" 0.0 "" None)
(L.list ABList (Vec.fromList abookList) 1) (L.list ABList (Vec.fromList abookList) 1)
(mkNewABForm (AdrBookEntry "" "")) (mkNewABForm (AdrBookEntry "" ""))
"" ""
@ -1689,7 +1670,7 @@ sendTransaction ::
-> IO () -> IO ()
sendTransaction pool chan zHost zPort znet accId bl amt ua memo = do sendTransaction pool chan zHost zPort znet accId bl amt ua memo = do
BC.writeBChan chan $ TickMsg "Preparing transaction..." BC.writeBChan chan $ TickMsg "Preparing transaction..."
case parseAddressUA ua znet of case parseAddress ua znet of
Nothing -> BC.writeBChan chan $ TickMsg "Incorrect address" Nothing -> BC.writeBChan chan $ TickMsg "Incorrect address"
Just outUA -> do Just outUA -> do
res <- res <-

View file

@ -772,11 +772,7 @@ prepareTxV2 pool zebraHost zebraPort zn za bh amt va memo policy = do
{-firstPass <- liftIO $ selectUnspentNotes pool za zats-} {-firstPass <- liftIO $ selectUnspentNotes pool za zats-}
--let fee = calculateTxFee firstPass $ fst recipient --let fee = calculateTxFee firstPass $ fst recipient
--logDebugN $ T.pack $ "calculated fee " ++ show fee --logDebugN $ T.pack $ "calculated fee " ++ show fee
notePlan <- (tList, sList, oList) <- liftIO $ selectUnspentNotes pool za (zats + 5000)
liftIO $
selectUnspentNotesV2 pool za (zats + 10000) (fst recipient) policy
case notePlan of
Right (tList, sList, oList) -> do
logDebugN "selected notes" logDebugN "selected notes"
logDebugN $ T.pack $ show tList logDebugN $ T.pack $ show tList
logDebugN $ T.pack $ show sList logDebugN $ T.pack $ show sList
@ -784,28 +780,18 @@ prepareTxV2 pool zebraHost zebraPort zn za bh amt va memo policy = do
let noteTotal = getTotalAmount (tList, sList, oList) let noteTotal = getTotalAmount (tList, sList, oList)
tSpends <- tSpends <-
liftIO $ liftIO $
prepTSpends prepTSpends (getTranSK $ zcashAccountTPrivateKey $ entityVal acc) tList
(getTranSK $ zcashAccountTPrivateKey $ entityVal acc)
tList
--print tSpends --print tSpends
sSpends <- sSpends <-
liftIO $ liftIO $
prepSSpends prepSSpends (getSapSK $ zcashAccountSapSpendKey $ entityVal acc) sList
(getSapSK $ zcashAccountSapSpendKey $ entityVal acc)
sList
--print sSpends --print sSpends
oSpends <- oSpends <-
liftIO $ liftIO $
prepOSpends prepOSpends (getOrchSK $ zcashAccountOrchSpendKey $ entityVal acc) oList
(getOrchSK $ zcashAccountOrchSpendKey $ entityVal acc)
oList
--print oSpends --print oSpends
dummy' <- dummy <-
liftIO $ liftIO $ makeOutgoing acc recipient zats (noteTotal - 5000 - zats)
makeOutgoing acc recipient zats (noteTotal - 5000 - zats) policy
case dummy' of
Left e -> return $ Left e
Right dummy -> do
logDebugN "Calculating fee" logDebugN "Calculating fee"
let feeResponse = let feeResponse =
createTransaction createTransaction
@ -822,204 +808,62 @@ prepareTxV2 pool zebraHost zebraPort zn za bh amt va memo policy = do
Left e1 -> return $ Left Fee Left e1 -> return $ Left Fee
Right fee -> do Right fee -> do
let feeAmt = let feeAmt =
fromIntegral fromIntegral (runGet getInt64le $ LBS.fromStrict $ toBytes fee)
(runGet getInt64le $ LBS.fromStrict $ toBytes fee) (tList1, sList1, oList1) <-
finalNotePlan <- liftIO $ selectUnspentNotes pool za (zats + feeAmt)
liftIO $ logDebugN $ T.pack $ "selected notes with fee" ++ show feeAmt
selectUnspentNotesV2 logDebugN $ T.pack $ show tList
pool logDebugN $ T.pack $ show sList
za logDebugN $ T.pack $ show oList
(zats + feeAmt) outgoing <-
(fst recipient) liftIO $ makeOutgoing acc recipient zats (noteTotal - feeAmt - zats)
policy logDebugN $ T.pack $ show outgoing
case finalNotePlan of
Right (tList1, sList1, oList1) -> do
logDebugN $
T.pack $ "selected notes with fee" ++ show feeAmt
logDebugN $ T.pack $ show tList1
logDebugN $ T.pack $ show sList1
logDebugN $ T.pack $ show oList1
tSpends1 <-
liftIO $
prepTSpends
(getTranSK $ zcashAccountTPrivateKey $ entityVal acc)
tList1
sSpends1 <-
liftIO $
prepSSpends
(getSapSK $ zcashAccountSapSpendKey $ entityVal acc)
sList1
oSpends1 <-
liftIO $
prepOSpends
(getOrchSK $ zcashAccountOrchSpendKey $ entityVal acc)
oList1
let noteTotal1 = getTotalAmount (tList1, sList1, oList1)
outgoing' <-
liftIO $
makeOutgoing
acc
recipient
zats
(noteTotal1 - feeAmt - zats)
policy
logDebugN $ T.pack $ show outgoing'
case outgoing' of
Left e -> return $ Left e
Right outgoing -> do
let tx = let tx =
createTransaction createTransaction
(Just sT) (Just sT)
(Just oT) (Just oT)
tSpends1 tSpends
sSpends1 sSpends
oSpends1 oSpends
outgoing outgoing
zn zn
(bh + 3) (bh + 3)
True True
logDebugN $ T.pack $ show tx logDebugN $ T.pack $ show tx
return tx return tx
Left e -> return $ Left e
Left e -> do
logErrorN $ T.pack $ show e
return $ Left e
where where
makeOutgoing :: makeOutgoing ::
Entity ZcashAccount Entity ZcashAccount
-> (Int, BS.ByteString) -> (Int, BS.ByteString)
-> Integer -> Integer
-> Integer -> Integer
-> PrivacyPolicy -> IO [OutgoingNote]
-> IO (Either TxError [OutgoingNote]) makeOutgoing acc (k, recvr) zats chg = do
makeOutgoing acc (k, recvr) zats chg policy = do
chgAddr <- runNoLoggingT $ getInternalAddresses pool $ entityKey acc chgAddr <- runNoLoggingT $ getInternalAddresses pool $ entityKey acc
let internalUA = getUA $ walletAddressUAddress $ entityVal $ head chgAddr let internalUA = getUA $ walletAddressUAddress $ entityVal $ head chgAddr
case k of let chgRcvr =
fromJust $ o_rec =<< isValidUnifiedAddress (E.encodeUtf8 internalUA)
return
[ OutgoingNote
4
(getBytes $ getOrchSK $ zcashAccountOrchSpendKey $ entityVal acc)
(getBytes chgRcvr)
(fromIntegral chg)
""
True
, OutgoingNote
(fromIntegral k)
(case k of
4 -> 4 ->
case policy of getBytes $ getOrchSK $ zcashAccountOrchSpendKey $ entityVal acc
None ->
return $
Left $
PrivacyPolicyError "Recipient not allowed by privacy policy"
_anyOther -> do
let chgRcvr =
fromJust $
o_rec =<< isValidUnifiedAddress (E.encodeUtf8 internalUA)
return $
Right
[ OutgoingNote
4
(getBytes $
getOrchSK $ zcashAccountOrchSpendKey $ entityVal acc)
(getBytes chgRcvr)
(fromIntegral chg)
""
True
, OutgoingNote
4
(getBytes $
getOrchSK $ zcashAccountOrchSpendKey $ entityVal acc)
recvr
(fromIntegral zats)
(E.encodeUtf8 memo)
False
]
3 -> 3 ->
case policy of getBytes $ getSapSK $ zcashAccountSapSpendKey $ entityVal acc
None -> _ -> "")
return $
Left $
PrivacyPolicyError "Receiver not compatible with privacy policy"
Full -> do
let chgRcvr =
fromJust $
s_rec =<< isValidUnifiedAddress (E.encodeUtf8 internalUA)
return $
Right
[ OutgoingNote
3
(getBytes $
getSapSK $ zcashAccountSapSpendKey $ entityVal acc)
(getBytes chgRcvr)
(fromIntegral chg)
""
True
, OutgoingNote
3
(getBytes $
getSapSK $ zcashAccountSapSpendKey $ entityVal acc)
recvr recvr
(fromIntegral zats) (fromIntegral zats)
(E.encodeUtf8 memo) (E.encodeUtf8 memo)
False False
] ]
_anyOther -> do
let chgRcvr =
fromJust $
o_rec =<< isValidUnifiedAddress (E.encodeUtf8 internalUA)
return $
Right
[ OutgoingNote
4
(getBytes $
getOrchSK $ zcashAccountOrchSpendKey $ entityVal acc)
(getBytes chgRcvr)
(fromIntegral chg)
""
True
, OutgoingNote
3
(getBytes $
getSapSK $ zcashAccountSapSpendKey $ entityVal acc)
recvr
(fromIntegral zats)
(E.encodeUtf8 memo)
False
]
2 ->
if policy <= Low
then do
let chgRcvr =
fromJust $
t_rec =<< isValidUnifiedAddress (E.encodeUtf8 internalUA)
return $
Right
[ OutgoingNote
1
BS.empty
(toBytes $ tr_bytes chgRcvr)
(fromIntegral chg)
""
True
, OutgoingNote 2 BS.empty recvr (fromIntegral zats) "" False
]
else return $
Left $
PrivacyPolicyError
"Receiver not compatible with privacy policy"
1 ->
if policy <= Low
then do
let chgRcvr =
fromJust $
t_rec =<< isValidUnifiedAddress (E.encodeUtf8 internalUA)
return $
Right
[ OutgoingNote
1
BS.empty
(toBytes $ tr_bytes chgRcvr)
(fromIntegral chg)
""
True
, OutgoingNote 1 BS.empty recvr (fromIntegral zats) "" False
]
else return $
Left $
PrivacyPolicyError
"Receiver not compatible with privacy policy"
_anyOther -> return $ Left ZHError
getTotalAmount :: getTotalAmount ::
( [Entity WalletTrNote] ( [Entity WalletTrNote]
, [Entity WalletSapNote] , [Entity WalletSapNote]
@ -1107,30 +951,22 @@ prepareTxV2 pool zebraHost zebraPort zn za bh amt va memo policy = do
syncWallet :: syncWallet ::
Config -- ^ configuration parameters Config -- ^ configuration parameters
-> Entity ZcashWallet -> Entity ZcashWallet
-> LoggingT IO () -> IO ()
syncWallet config w = do syncWallet config w = do
startTime <- liftIO getCurrentTime startTime <- liftIO getCurrentTime
let walletDb = c_dbPath config let walletDb = c_dbPath config
let znet = zcashWalletNetwork $ entityVal w let znet = zcashWalletNetwork $ entityVal w
pool <- liftIO $ runNoLoggingT $ initPool walletDb pool <- runNoLoggingT $ initPool walletDb
accs <- liftIO $ runNoLoggingT $ getAccounts pool $ entityKey w accs <- runNoLoggingT $ getAccounts pool $ entityKey w
logDebugN $ "Accounts: " <> T.pack (show accs) addrs <- concat <$> mapM (runNoLoggingT . getAddresses pool . entityKey) accs
addrs <-
concat <$>
mapM (liftIO . runNoLoggingT . getAddresses pool . entityKey) accs
logDebugN $ "addrs: " <> T.pack (show addrs)
intAddrs <- intAddrs <-
concat <$> concat <$> mapM (runNoLoggingT . getInternalAddresses pool . entityKey) accs
mapM (liftIO . runNoLoggingT . getInternalAddresses pool . entityKey) accs chainTip <- getMaxBlock pool znet
chainTip <- liftIO $ getMaxBlock pool znet
logDebugN $ "chain tip: " <> T.pack (show chainTip)
let lastBlock = zcashWalletLastSync $ entityVal w let lastBlock = zcashWalletLastSync $ entityVal w
logDebugN $ "last block: " <> T.pack (show lastBlock)
let startBlock = let startBlock =
if lastBlock > 0 if lastBlock > 0
then lastBlock then lastBlock
else zcashWalletBirthdayHeight $ entityVal w else zcashWalletBirthdayHeight $ entityVal w
logDebugN $ "start block: " <> T.pack (show startBlock)
mapM_ (liftIO . findTransparentNotes pool startBlock znet) addrs mapM_ (liftIO . findTransparentNotes pool startBlock znet) addrs
mapM_ (liftIO . findTransparentNotes pool startBlock znet) intAddrs mapM_ (liftIO . findTransparentNotes pool startBlock znet) intAddrs
mapM_ (liftIO . findTransparentSpends pool . entityKey) accs mapM_ (liftIO . findTransparentSpends pool . entityKey) accs
@ -1144,7 +980,7 @@ syncWallet config w = do
mapM mapM
(findOrchardActions config startBlock (zcashWalletNetwork $ entityVal w)) (findOrchardActions config startBlock (zcashWalletNetwork $ entityVal w))
accs accs
_ <- liftIO $ updateSaplingWitnesses pool _ <- updateSaplingWitnesses pool
_ <- liftIO $ updateOrchardWitnesses pool _ <- updateOrchardWitnesses pool
_ <- liftIO $ updateWalletSync pool chainTip (entityKey w) _ <- liftIO $ updateWalletSync pool chainTip (entityKey w)
mapM_ (liftIO . runNoLoggingT . getWalletTransactions pool) addrs mapM_ (runNoLoggingT . getWalletTransactions pool) addrs

View file

@ -18,7 +18,7 @@
module Zenith.DB where module Zenith.DB where
import Control.Exception (SomeException(..), throw, throwIO, try) import Control.Exception (SomeException(..), throwIO, try)
import Control.Monad (when) import Control.Monad (when)
import Control.Monad.IO.Class (MonadIO, liftIO) import Control.Monad.IO.Class (MonadIO, liftIO)
import Control.Monad.Logger (NoLoggingT, runNoLoggingT) import Control.Monad.Logger (NoLoggingT, runNoLoggingT)
@ -69,7 +69,6 @@ import ZcashHaskell.Types
, TransparentAddress(..) , TransparentAddress(..)
, TransparentBundle(..) , TransparentBundle(..)
, TransparentReceiver(..) , TransparentReceiver(..)
, TxError(..)
, UnifiedAddress(..) , UnifiedAddress(..)
, ValidAddress(..) , ValidAddress(..)
, ZcashNet(..) , ZcashNet(..)
@ -79,7 +78,6 @@ import Zenith.Types
, HexStringDB(..) , HexStringDB(..)
, OrchardSpendingKeyDB(..) , OrchardSpendingKeyDB(..)
, PhraseDB(..) , PhraseDB(..)
, PrivacyPolicy(..)
, RseedDB(..) , RseedDB(..)
, SaplingSpendingKeyDB(..) , SaplingSpendingKeyDB(..)
, ScopeDB(..) , ScopeDB(..)
@ -204,28 +202,23 @@ share
value Int64 value Int64
UniqueOrchSpend tx accId UniqueOrchSpend tx accId
deriving Show Eq deriving Show Eq
ZcashBlock ZcashTransaction
height Int block Int
hash HexStringDB txId HexStringDB
conf Int conf Int
time Int time Int
network ZcashNetDB network ZcashNetDB
UniqueBlock height network UniqueTx block txId network
deriving Show Eq
ZcashTransaction
blockId ZcashBlockId OnDeleteCascade OnUpdateCascade
txId HexStringDB
UniqueTx blockId txId
deriving Show Eq deriving Show Eq
TransparentNote TransparentNote
tx ZcashTransactionId OnDeleteCascade OnUpdateCascade tx ZcashTransactionId
value Int64 value Int64
script BS.ByteString script BS.ByteString
position Int position Int
UniqueTNPos tx position UniqueTNPos tx position
deriving Show Eq deriving Show Eq
TransparentSpend TransparentSpend
tx ZcashTransactionId OnDeleteCascade OnUpdateCascade tx ZcashTransactionId
outPointHash HexStringDB outPointHash HexStringDB
outPointIndex Word64 outPointIndex Word64
script BS.ByteString script BS.ByteString
@ -234,7 +227,7 @@ share
UniqueTSPos tx position UniqueTSPos tx position
deriving Show Eq deriving Show Eq
OrchAction OrchAction
tx ZcashTransactionId OnDeleteCascade OnUpdateCascade tx ZcashTransactionId
nf HexStringDB nf HexStringDB
rk HexStringDB rk HexStringDB
cmx HexStringDB cmx HexStringDB
@ -247,7 +240,7 @@ share
UniqueOAPos tx position UniqueOAPos tx position
deriving Show Eq deriving Show Eq
ShieldOutput ShieldOutput
tx ZcashTransactionId OnDeleteCascade OnUpdateCascade tx ZcashTransactionId
cv HexStringDB cv HexStringDB
cmu HexStringDB cmu HexStringDB
ephKey HexStringDB ephKey HexStringDB
@ -258,7 +251,7 @@ share
UniqueSOPos tx position UniqueSOPos tx position
deriving Show Eq deriving Show Eq
ShieldSpend ShieldSpend
tx ZcashTransactionId OnDeleteCascade OnUpdateCascade tx ZcashTransactionId
cv HexStringDB cv HexStringDB
anchor HexStringDB anchor HexStringDB
nullifier HexStringDB nullifier HexStringDB
@ -347,7 +340,7 @@ trToZcashNoteAPI pool n = do
return $ return $
ZcashNoteAPI ZcashNoteAPI
(getHex $ walletTransactionTxId $ entityVal t') -- tx ID (getHex $ walletTransactionTxId $ entityVal t') -- tx ID
Zenith.Types.TransparentPool -- pool Zenith.Types.Transparent -- pool
(fromIntegral (walletTrNoteValue (entityVal n)) / 100000000.0) -- zec (fromIntegral (walletTrNoteValue (entityVal n)) / 100000000.0) -- zec
(walletTrNoteValue $ entityVal n) -- zats (walletTrNoteValue $ entityVal n) -- zats
"" -- memo "" -- memo
@ -368,7 +361,7 @@ sapToZcashNoteAPI pool n = do
return $ return $
ZcashNoteAPI ZcashNoteAPI
(getHex $ walletTransactionTxId $ entityVal t') -- tx ID (getHex $ walletTransactionTxId $ entityVal t') -- tx ID
Zenith.Types.SaplingPool -- pool Zenith.Types.Sapling -- pool
(fromIntegral (walletSapNoteValue (entityVal n)) / 100000000.0) -- zec (fromIntegral (walletSapNoteValue (entityVal n)) / 100000000.0) -- zec
(walletSapNoteValue $ entityVal n) -- zats (walletSapNoteValue $ entityVal n) -- zats
(walletSapNoteMemo $ entityVal n) -- memo (walletSapNoteMemo $ entityVal n) -- memo
@ -389,7 +382,7 @@ orchToZcashNoteAPI pool n = do
return $ return $
ZcashNoteAPI ZcashNoteAPI
(getHex $ walletTransactionTxId $ entityVal t') -- tx ID (getHex $ walletTransactionTxId $ entityVal t') -- tx ID
OrchardPool Orchard
(fromIntegral (walletOrchNoteValue (entityVal n)) / 100000000.0) -- zec (fromIntegral (walletOrchNoteValue (entityVal n)) / 100000000.0) -- zec
(walletOrchNoteValue $ entityVal n) -- zats (walletOrchNoteValue $ entityVal n) -- zats
(walletOrchNoteMemo $ entityVal n) -- memo (walletOrchNoteMemo $ entityVal n) -- memo
@ -444,10 +437,10 @@ initDb dbName = do
clearWalletTransactions pool clearWalletTransactions pool
clearWalletData pool clearWalletData pool
m <- m <-
try $ PS.runSqlite dbName $ runMigrationUnsafeQuiet migrateAll :: IO try $ PS.runSqlite dbName $ runMigrationQuiet migrateAll :: IO
(Either SomeException [T.Text]) (Either SomeException [T.Text])
case m of case m of
Left e2 -> return $ Left $ "Failed to migrate data tables" ++ show e2 Left _e2 -> return $ Left "Failed to migrate data tables"
Right _ -> return $ Right True Right _ -> return $ Right True
Right _ -> return $ Right False Right _ -> return $ Right False
@ -586,13 +579,14 @@ getMaxBlock pool net = do
PS.retryOnBusy $ PS.retryOnBusy $
flip PS.runSqlPool pool $ do flip PS.runSqlPool pool $ do
selectOne $ do selectOne $ do
bls <- from $ table @ZcashBlock txs <- from $ table @ZcashTransaction
where_ (bls ^. ZcashBlockNetwork ==. val net) where_ (txs ^. ZcashTransactionBlock >. val 0)
orderBy [desc $ bls ^. ZcashBlockHeight] where_ (txs ^. ZcashTransactionNetwork ==. val net)
pure bls orderBy [desc $ txs ^. ZcashTransactionBlock]
pure txs
case b of case b of
Nothing -> return $ -1 Nothing -> return $ -1
Just x -> return $ zcashBlockHeight $ entityVal x Just x -> return $ zcashTransactionBlock $ entityVal x
-- | Returns a list of addresses associated with the given account -- | Returns a list of addresses associated with the given account
getAddresses :: getAddresses ::
@ -683,33 +677,20 @@ saveAddress pool w =
runNoLoggingT $ runNoLoggingT $
PS.retryOnBusy $ flip PS.runSqlPool pool $ insertUniqueEntity w PS.retryOnBusy $ flip PS.runSqlPool pool $ insertUniqueEntity w
-- | Save a block to the database
saveBlock :: ConnectionPool -> ZcashBlock -> IO (Key ZcashBlock)
saveBlock pool b =
runNoLoggingT $ PS.retryOnBusy $ flip PS.runSqlPool pool $ do insert b
-- | Read a block by height
getBlock :: ConnectionPool -> Int -> IO (Maybe (Entity ZcashBlock))
getBlock pool b =
runNoLoggingT $
PS.retryOnBusy $
flip PS.runSqlPool pool $ do
selectOne $ do
bl <- from $ table @ZcashBlock
where_ $ bl ^. ZcashBlockHeight ==. val b
pure bl
-- | Save a transaction to the data model -- | Save a transaction to the data model
saveTransaction :: saveTransaction ::
ConnectionPool -- ^ the database path ConnectionPool -- ^ the database path
-> ZcashBlockId -- ^ The block the transaction is in -> Int -- ^ block time
-> ZcashNetDB -- ^ the network
-> Transaction -- ^ The transaction to save -> Transaction -- ^ The transaction to save
-> NoLoggingT IO (Key ZcashTransaction) -> NoLoggingT IO (Key ZcashTransaction)
saveTransaction pool bi wt = saveTransaction pool t n wt =
PS.retryOnBusy $ PS.retryOnBusy $
flip PS.runSqlPool pool $ do flip PS.runSqlPool pool $ do
let ix = [0 ..] let ix = [0 ..]
w <- insert $ ZcashTransaction bi (HexStringDB $ tx_id wt) w <-
insert $
ZcashTransaction (tx_height wt) (HexStringDB $ tx_id wt) (tx_conf wt) t n
when (isJust $ tx_transpBundle wt) $ do when (isJust $ tx_transpBundle wt) $ do
_ <- _ <-
insertMany_ $ insertMany_ $
@ -795,13 +776,10 @@ getZcashTransactions pool b net =
PS.retryOnBusy $ PS.retryOnBusy $
flip PS.runSqlPool pool $ do flip PS.runSqlPool pool $ do
select $ do select $ do
(blks :& txs) <- txs <- from $ table @ZcashTransaction
from $ table @ZcashBlock `innerJoin` table @ZcashTransaction `on` where_ (txs ^. ZcashTransactionBlock >. val b)
(\(blks :& txs) -> where_ (txs ^. ZcashTransactionNetwork ==. val (ZcashNetDB net))
blks ^. ZcashBlockId ==. txs ^. ZcashTransactionBlockId) orderBy [asc $ txs ^. ZcashTransactionBlock]
where_ (blks ^. ZcashBlockHeight >. val b)
where_ (blks ^. ZcashBlockNetwork ==. val (ZcashNetDB net))
orderBy [asc $ blks ^. ZcashBlockHeight]
return txs return txs
-- ** QR codes -- ** QR codes
@ -898,23 +876,14 @@ saveWalletTransaction pool za zt = do
runNoLoggingT $ runNoLoggingT $
PS.retryOnBusy $ PS.retryOnBusy $
flip PS.runSqlPool pool $ do flip PS.runSqlPool pool $ do
b <-
selectOne $ do
blks <- from $ table @ZcashBlock
where_ (blks ^. ZcashBlockId ==. val (zcashTransactionBlockId zT'))
pure blks
case b of
Nothing ->
throw $ userError "invalid block for saving wallet transaction"
Just blk -> do
t <- t <-
upsert upsert
(WalletTransaction (WalletTransaction
(zcashTransactionTxId zT') (zcashTransactionTxId zT')
za za
(zcashBlockHeight $ entityVal blk) (zcashTransactionBlock zT')
(zcashBlockConf $ entityVal blk) (zcashTransactionConf zT')
(zcashBlockTime $ entityVal blk)) (zcashTransactionTime zT'))
[] []
return $ entityKey t return $ entityKey t
@ -1007,17 +976,14 @@ findTransparentNotes pool b net t = do
PS.retryOnBusy $ PS.retryOnBusy $
flip PS.runSqlPool pool $ do flip PS.runSqlPool pool $ do
select $ do select $ do
(blks :& txs :& tNotes) <- (txs :& tNotes) <-
from $ table @ZcashBlock `innerJoin` table @ZcashTransaction `on` from $ table @ZcashTransaction `innerJoin` table @TransparentNote `on`
(\(blks :& txs) -> (\(txs :& tNotes) ->
blks ^. ZcashBlockId ==. txs ^. ZcashTransactionBlockId) `innerJoin`
table @TransparentNote `on`
(\(_ :& txs :& tNotes) ->
txs ^. ZcashTransactionId ==. tNotes ^. TransparentNoteTx) txs ^. ZcashTransactionId ==. tNotes ^. TransparentNoteTx)
where_ (blks ^. ZcashBlockHeight >. val b) where_ (txs ^. ZcashTransactionBlock >. val b)
where_ (blks ^. ZcashBlockNetwork ==. val net) where_ (txs ^. ZcashTransactionNetwork ==. val net)
where_ (tNotes ^. TransparentNoteScript ==. val s) where_ (tNotes ^. TransparentNoteScript ==. val s)
pure (blks, txs, tNotes) pure (txs, tNotes)
mapM_ mapM_
(saveWalletTrNote (saveWalletTrNote
pool pool
@ -1033,11 +999,10 @@ saveWalletTrNote ::
-> Scope -> Scope
-> ZcashAccountId -> ZcashAccountId
-> WalletAddressId -> WalletAddressId
-> (Entity ZcashBlock, Entity ZcashTransaction, Entity TransparentNote) -> (Entity ZcashTransaction, Entity TransparentNote)
-> IO () -> IO ()
saveWalletTrNote pool ch za wa (blk, zt, tn) = do saveWalletTrNote pool ch za wa (zt, tn) = do
let zT' = entityVal zt let zT' = entityVal zt
let b = entityVal blk
runNoLoggingT $ runNoLoggingT $
PS.retryOnBusy $ PS.retryOnBusy $
flip PS.runSqlPool pool $ do flip PS.runSqlPool pool $ do
@ -1046,9 +1011,9 @@ saveWalletTrNote pool ch za wa (blk, zt, tn) = do
(WalletTransaction (WalletTransaction
(zcashTransactionTxId zT') (zcashTransactionTxId zT')
za za
(zcashBlockHeight b) (zcashTransactionBlock zT')
(zcashBlockConf b) (zcashTransactionConf zT')
(zcashBlockTime b)) (zcashTransactionTime zT'))
[] []
insert_ $ insert_ $
WalletTrNote WalletTrNote
@ -1077,15 +1042,12 @@ getShieldedOutputs pool b net =
PS.retryOnBusy $ PS.retryOnBusy $
flip PS.runSqlPool pool $ do flip PS.runSqlPool pool $ do
select $ do select $ do
(blks :& txs :& sOutputs) <- (txs :& sOutputs) <-
from $ table @ZcashBlock `innerJoin` table @ZcashTransaction `on` from $ table @ZcashTransaction `innerJoin` table @ShieldOutput `on`
(\(blks :& txs) -> (\(txs :& sOutputs) ->
blks ^. ZcashBlockId ==. txs ^. ZcashTransactionBlockId) `innerJoin`
table @ShieldOutput `on`
(\(_ :& txs :& sOutputs) ->
txs ^. ZcashTransactionId ==. sOutputs ^. ShieldOutputTx) txs ^. ZcashTransactionId ==. sOutputs ^. ShieldOutputTx)
where_ (blks ^. ZcashBlockHeight >=. val b) where_ (txs ^. ZcashTransactionBlock >=. val b)
where_ (blks ^. ZcashBlockNetwork ==. val net) where_ (txs ^. ZcashTransactionNetwork ==. val net)
orderBy orderBy
[ asc $ txs ^. ZcashTransactionId [ asc $ txs ^. ZcashTransactionId
, asc $ sOutputs ^. ShieldOutputPosition , asc $ sOutputs ^. ShieldOutputPosition
@ -1103,15 +1065,12 @@ getOrchardActions pool b net =
PS.retryOnBusy $ PS.retryOnBusy $
flip PS.runSqlPool pool $ do flip PS.runSqlPool pool $ do
select $ do select $ do
(blks :& txs :& oActions) <- (txs :& oActions) <-
from $ table @ZcashBlock `innerJoin` table @ZcashTransaction `on` from $ table @ZcashTransaction `innerJoin` table @OrchAction `on`
(\(blks :& txs) -> (\(txs :& oActions) ->
blks ^. ZcashBlockId ==. txs ^. ZcashTransactionBlockId) `innerJoin`
table @OrchAction `on`
(\(_ :& txs :& oActions) ->
txs ^. ZcashTransactionId ==. oActions ^. OrchActionTx) txs ^. ZcashTransactionId ==. oActions ^. OrchActionTx)
where_ (blks ^. ZcashBlockHeight >=. val b) where_ (txs ^. ZcashTransactionBlock >=. val b)
where_ (blks ^. ZcashBlockNetwork ==. val net) where_ (txs ^. ZcashTransactionNetwork ==. val net)
orderBy orderBy
[asc $ txs ^. ZcashTransactionId, asc $ oActions ^. OrchActionPosition] [asc $ txs ^. ZcashTransactionId, asc $ oActions ^. OrchActionPosition]
pure (txs, oActions) pure (txs, oActions)
@ -1611,24 +1570,10 @@ getOrchardCmxs pool zt = do
getMaxOrchardNote :: Pool SqlBackend -> IO OrchActionId getMaxOrchardNote :: Pool SqlBackend -> IO OrchActionId
getMaxOrchardNote pool = do getMaxOrchardNote pool = do
flip PS.runSqlPool pool $ do flip PS.runSqlPool pool $ do
maxBlock <-
selectOne $ do
blks <- from $ table @ZcashBlock
where_ $ blks ^. ZcashBlockHeight >. val 0
pure $ blks ^. ZcashBlockHeight
case maxBlock of
Nothing -> return $ toSqlKey 0
Just (Value mb) -> do
x <- x <-
selectOne $ do selectOne $ do
(blks :& txs :& n) <- n <- from $ table @OrchAction
from $ table @ZcashBlock `innerJoin` table @ZcashTransaction `on` where_ (n ^. OrchActionId >. val (toSqlKey 0))
(\(blks :& txs) ->
blks ^. ZcashBlockId ==. txs ^. ZcashTransactionBlockId) `innerJoin`
table @OrchAction `on`
(\(_ :& txs :& n) ->
txs ^. ZcashTransactionId ==. n ^. OrchActionTx)
where_ (blks ^. ZcashBlockHeight <=. val (mb - 5))
orderBy [desc $ n ^. OrchActionId] orderBy [desc $ n ^. OrchActionId]
pure (n ^. OrchActionId) pure (n ^. OrchActionId)
case x of case x of
@ -1695,22 +1640,14 @@ upsertWalTx ::
=> ZcashTransaction => ZcashTransaction
-> ZcashAccountId -> ZcashAccountId
-> SqlPersistT m (Entity WalletTransaction) -> SqlPersistT m (Entity WalletTransaction)
upsertWalTx zt za = do upsertWalTx zt za =
blk <-
selectOne $ do
blks <- from $ table @ZcashBlock
where_ (blks ^. ZcashBlockId ==. val (zcashTransactionBlockId zt))
pure blks
case blk of
Nothing -> throw $ userError "Invalid block for transaction"
Just b ->
upsert upsert
(WalletTransaction (WalletTransaction
(zcashTransactionTxId zt) (zcashTransactionTxId zt)
za za
(zcashBlockHeight $ entityVal b) (zcashTransactionBlock zt)
(zcashBlockConf $ entityVal b) (zcashTransactionConf zt)
(zcashBlockTime $ entityVal b)) (zcashTransactionTime zt))
[] []
getSaplingOutIndex :: ConnectionPool -> ShieldOutputId -> IO Int getSaplingOutIndex :: ConnectionPool -> ShieldOutputId -> IO Int
@ -1864,9 +1801,6 @@ clearWalletData pool = do
delete $ do delete $ do
_ <- from $ table @ZcashTransaction _ <- from $ table @ZcashTransaction
return () return ()
delete $ do
_ <- from $ table @ZcashBlock
return ()
getWalletUnspentTrNotes :: getWalletUnspentTrNotes ::
ConnectionPool -> ZcashAccountId -> IO [Entity WalletTrNote] ConnectionPool -> ZcashAccountId -> IO [Entity WalletTrNote]
@ -2048,130 +1982,6 @@ selectUnspentNotes pool za amt = do
, n : snd (checkOrchard (x - walletOrchNoteValue (entityVal n)) ns)) , n : snd (checkOrchard (x - walletOrchNoteValue (entityVal n)) ns))
else (0, [n]) else (0, [n])
selectUnspentNotesV2 ::
ConnectionPool
-> ZcashAccountId
-> Integer
-> Int
-> PrivacyPolicy
-> IO
(Either
TxError
( [Entity WalletTrNote]
, [Entity WalletSapNote]
, [Entity WalletOrchNote]))
selectUnspentNotesV2 pool za amt recv policy = do
case policy of
Full ->
case recv of
4 -> do
orchNotes <- getWalletUnspentOrchNotes pool za
let (a1, oList) = checkOrchard (fromIntegral amt) orchNotes
if a1 > 0
then return $
Left $ PrivacyPolicyError "Not enough notes for Full privacy"
else return $ Right ([], [], oList)
3 -> do
sapNotes <- getWalletUnspentSapNotes pool za
let (a2, sList) = checkSapling (fromIntegral amt) sapNotes
if a2 > 0
then return $
Left $ PrivacyPolicyError "Not enough notes for Full privacy"
else return $ Right ([], sList, [])
_anyOther ->
return $
Left $ PrivacyPolicyError "Receiver not capable of Full privacy"
Medium ->
if recv > 2
then do
orchNotes <- getWalletUnspentOrchNotes pool za
let (a1, oList) = checkOrchard (fromIntegral amt) orchNotes
if a1 > 0
then do
sapNotes <- getWalletUnspentSapNotes pool za
let (a2, sList) = checkSapling a1 sapNotes
if a2 > 0
then return $
Left $
PrivacyPolicyError "Not enough notes for Medium privacy"
else return $ Right ([], sList, oList)
else return $ Right ([], [], oList)
else return $
Left $ PrivacyPolicyError "Receiver not capable of Medium privacy"
Low ->
if recv == 0
then return $ Left ZHError
else do
case recv of
3 -> do
sapNotes <- getWalletUnspentSapNotes pool za
let (a1, sList) = checkSapling (fromIntegral amt) sapNotes
if a1 > 0
then do
orchNotes <- getWalletUnspentOrchNotes pool za
let (a2, oList) = checkOrchard a1 orchNotes
if a2 > 0
then return $
Left $
PrivacyPolicyError "Not enough notes for Low privacy"
else return $ Right ([], sList, oList)
else return $ Right ([], sList, [])
_anyOther -> do
orchNotes <- getWalletUnspentOrchNotes pool za
let (a1, oList) = checkOrchard (fromIntegral amt) orchNotes
if a1 > 0
then do
sapNotes <- getWalletUnspentSapNotes pool za
let (a2, sList) = checkSapling a1 sapNotes
if a2 > 0
then return $
Left $
PrivacyPolicyError "Not enough notes for Low privacy"
else return $ Right ([], sList, oList)
else return $ Right ([], [], oList)
None -> do
orchNotes <- getWalletUnspentOrchNotes pool za
let (a1, oList) = checkOrchard (fromIntegral amt) orchNotes
if a1 > 0
then do
sapNotes <- getWalletUnspentSapNotes pool za
let (a2, sList) = checkSapling a1 sapNotes
if a2 > 0
then do
trNotes <- getWalletUnspentTrNotes pool za
let (a3, tList) = checkTransparent a2 trNotes
if a3 > 0
then return $ Left InsufficientFunds
else return $ Right (tList, sList, oList)
else return $ Right ([], sList, oList)
else return $ Right ([], [], oList)
where
checkTransparent ::
Int64 -> [Entity WalletTrNote] -> (Int64, [Entity WalletTrNote])
checkTransparent x [] = (x, [])
checkTransparent x (n:ns) =
if walletTrNoteValue (entityVal n) < x
then ( fst (checkTransparent (x - walletTrNoteValue (entityVal n)) ns)
, n :
snd (checkTransparent (x - walletTrNoteValue (entityVal n)) ns))
else (0, [n])
checkSapling ::
Int64 -> [Entity WalletSapNote] -> (Int64, [Entity WalletSapNote])
checkSapling x [] = (x, [])
checkSapling x (n:ns) =
if walletSapNoteValue (entityVal n) < x
then ( fst (checkSapling (x - walletSapNoteValue (entityVal n)) ns)
, n : snd (checkSapling (x - walletSapNoteValue (entityVal n)) ns))
else (0, [n])
checkOrchard ::
Int64 -> [Entity WalletOrchNote] -> (Int64, [Entity WalletOrchNote])
checkOrchard x [] = (x, [])
checkOrchard x (n:ns) =
if walletOrchNoteValue (entityVal n) < x
then ( fst (checkOrchard (x - walletOrchNoteValue (entityVal n)) ns)
, n : snd (checkOrchard (x - walletOrchNoteValue (entityVal n)) ns))
else (0, [n])
getWalletTxId :: getWalletTxId ::
ConnectionPool -> WalletTransactionId -> IO (Maybe (Value HexStringDB)) ConnectionPool -> WalletTransactionId -> IO (Maybe (Value HexStringDB))
getWalletTxId pool wId = do getWalletTxId pool wId = do
@ -2203,9 +2013,6 @@ saveConfs pool b c = do
update $ \t -> do update $ \t -> do
set t [WalletTransactionConf =. val c] set t [WalletTransactionConf =. val c]
where_ $ t ^. WalletTransactionBlock ==. val b where_ $ t ^. WalletTransactionBlock ==. val b
update $ \bl -> do
set bl [ZcashBlockConf =. val c]
where_ $ bl ^. ZcashBlockHeight ==. val b
-- | Helper function to extract a Unified Address from the database -- | Helper function to extract a Unified Address from the database
readUnifiedAddressDB :: WalletAddress -> Maybe UnifiedAddress readUnifiedAddressDB :: WalletAddress -> Maybe UnifiedAddress
@ -2298,14 +2105,3 @@ finalizeOperation pool op status result = do
, OperationResult =. val (Just result) , OperationResult =. val (Just result)
] ]
where_ (ops ^. OperationId ==. val op) where_ (ops ^. OperationId ==. val op)
-- | Rewind the data store to a given block height
rewindWalletData :: ConnectionPool -> Int -> IO ()
rewindWalletData pool b = do
runNoLoggingT $
PS.retryOnBusy $
flip PS.runSqlPool pool $
delete $ do
blk <- from $ table @ZcashBlock
where_ $ blk ^. ZcashBlockHeight >=. val b
clearWalletTransactions pool

View file

@ -10,7 +10,7 @@ import Codec.QRCode
import Codec.QRCode.JuicyPixels import Codec.QRCode.JuicyPixels
import Control.Concurrent (threadDelay) import Control.Concurrent (threadDelay)
import Control.Exception (throwIO, try) import Control.Exception (throwIO, try)
import Control.Monad (unless, when) import Control.Monad (when)
import Control.Monad.IO.Class (liftIO) import Control.Monad.IO.Class (liftIO)
import Control.Monad.Logger (runFileLoggingT, runNoLoggingT) import Control.Monad.Logger (runFileLoggingT, runNoLoggingT)
import Data.Aeson import Data.Aeson
@ -47,19 +47,20 @@ import ZcashHaskell.Utils (getBlockTime, makeZebraCall)
import Zenith.Core import Zenith.Core
import Zenith.DB import Zenith.DB
import Zenith.GUI.Theme import Zenith.GUI.Theme
import Zenith.Scanner (checkIntegrity, processTx, rescanZebra, updateConfs) import Zenith.Scanner (processTx, rescanZebra, updateConfs)
import Zenith.Types hiding (ZcashAddress(..)) import Zenith.Types hiding (ZcashAddress(..))
import Zenith.Utils import Zenith.Utils
( displayAmount ( displayAmount
, getZenithPath
, isEmpty
, isRecipientValid , isRecipientValid
, isRecipientValidGUI
, isZecAddressValid
, isValidString , isValidString
, jsonNumber , jsonNumber
, padWithZero , padWithZero
, parseAddressUA , parseAddress
, showAddress , showAddress
, validBarValue , validBarValue
, validateAddressBool
) )
data AppEvent data AppEvent
@ -115,6 +116,7 @@ data AppEvent
| CheckValidAddress !T.Text | CheckValidAddress !T.Text
| CheckValidDescrip !T.Text | CheckValidDescrip !T.Text
| SaveNewABEntry | SaveNewABEntry
| SaveABDescription !T.Text
| UpdateABEntry !T.Text !T.Text | UpdateABEntry !T.Text !T.Text
| CloseUpdABEntry | CloseUpdABEntry
| ShowMessage !T.Text | ShowMessage !T.Text
@ -123,7 +125,6 @@ data AppEvent
| CopyABAdress !T.Text | CopyABAdress !T.Text
| DeleteABEntry !T.Text | DeleteABEntry !T.Text
| UpdateABDescrip !T.Text !T.Text | UpdateABDescrip !T.Text !T.Text
| ResetRecipientValid
deriving (Eq, Show) deriving (Eq, Show)
data AppModel = AppModel data AppModel = AppModel
@ -417,43 +418,43 @@ buildUI wenv model = widgetTree
[ vstack [ vstack
[ tooltip "Unified" $ [ tooltip "Unified" $
box_ box_
[onClick (SetPool OrchardPool)] [onClick (SetPool Orchard)]
(remixIcon remixShieldCheckFill `styleBasic` (remixIcon remixShieldCheckFill `styleBasic`
[ textSize 14 [ textSize 14
, padding 4 , padding 4
, styleIf , styleIf
(model ^. selPool == OrchardPool) (model ^. selPool == Orchard)
(bgColor btnColor) (bgColor btnColor)
, styleIf , styleIf
(model ^. selPool == OrchardPool) (model ^. selPool == Orchard)
(textColor white) (textColor white)
]) ])
, filler , filler
, tooltip "Legacy Shielded" $ , tooltip "Legacy Shielded" $
box_ box_
[onClick (SetPool SaplingPool)] [onClick (SetPool Sapling)]
(remixIcon remixShieldLine `styleBasic` (remixIcon remixShieldLine `styleBasic`
[ textSize 14 [ textSize 14
, padding 4 , padding 4
, styleIf , styleIf
(model ^. selPool == SaplingPool) (model ^. selPool == Sapling)
(bgColor btnColor) (bgColor btnColor)
, styleIf , styleIf
(model ^. selPool == SaplingPool) (model ^. selPool == Sapling)
(textColor white) (textColor white)
]) ])
, filler , filler
, tooltip "Transparent" $ , tooltip "Transparent" $
box_ box_
[onClick (SetPool TransparentPool)] [onClick (SetPool Transparent)]
(remixIcon remixEyeLine `styleBasic` (remixIcon remixEyeLine `styleBasic`
[ textSize 14 [ textSize 14
, padding 4 , padding 4
, styleIf , styleIf
(model ^. selPool == TransparentPool) (model ^. selPool == Transparent)
(bgColor btnColor) (bgColor btnColor)
, styleIf , styleIf
(model ^. selPool == TransparentPool) (model ^. selPool == Transparent)
(textColor white) (textColor white)
]) ])
] `styleBasic` ] `styleBasic`
@ -466,10 +467,10 @@ buildUI wenv model = widgetTree
(hstack (hstack
[ label [ label
(case model ^. selPool of (case model ^. selPool of
OrchardPool -> "Unified" Orchard -> "Unified"
SaplingPool -> "Legacy Shielded" Sapling -> "Legacy Shielded"
TransparentPool -> "Transparent" Transparent -> "Transparent"
SproutPool -> "Unknown") `styleBasic` Sprout -> "Unknown") `styleBasic`
[textColor white] [textColor white]
, remixIcon remixFileCopyFill `styleBasic` , remixIcon remixFileCopyFill `styleBasic`
[textSize 14, padding 4, textColor white] [textSize 14, padding 4, textColor white]
@ -605,28 +606,7 @@ buildUI wenv model = widgetTree
, separatorLine `styleBasic` [fgColor btnColor] , separatorLine `styleBasic` [fgColor btnColor]
, spacer , spacer
, hstack , hstack
[ [ label "To:" `styleBasic` [width 50]
label "Privacy Level:" `styleBasic` [width 70, textFont "Bold"]
, spacer
, label "Full " `styleBasic` [width 40]
, radio Full privacyChoice
, spacer
, label "Medium " `styleBasic` [width 40]
, radio Medium privacyChoice
]
, hstack
[
label " " `styleBasic` [width 70, textFont "Bold"]
, spacer
, label "Low " `styleBasic` [width 40]
, radio Low privacyChoice
, spacer
, label "None " `styleBasic` [width 40]
, radio None privacyChoice
]
, spacer
, hstack
[ label "To:" `styleBasic` [width 50, textFont "Bold"]
, spacer , spacer
, textField_ sendRecipient [onChange CheckRecipient] `styleBasic` , textField_ sendRecipient [onChange CheckRecipient] `styleBasic`
[ width 150 [ width 150
@ -636,7 +616,7 @@ buildUI wenv model = widgetTree
] ]
] ]
, hstack , hstack
[ label "Amount:" `styleBasic` [width 50, textFont "Bold"] [ label "Amount:" `styleBasic` [width 50]
, spacer , spacer
, numericField_ , numericField_
sendAmount sendAmount
@ -654,13 +634,35 @@ buildUI wenv model = widgetTree
] ]
] ]
, hstack , hstack
[ label "Memo:" `styleBasic` [width 50, textFont "Bold"] [ label "Memo:" `styleBasic` [width 50]
, spacer , spacer
, textArea sendMemo `styleBasic` , textArea sendMemo `styleBasic`
[width 150, height 40] [width 150, height 40]
] ]
, spacer , spacer
-- Radio button group for privacy level -- Radio button group for privacy level
, hstack
[
label "Privacy Level:" `styleBasic` [width 70]
, spacer
, label "None " `styleBasic` [width 40]
, radio None privacyChoice
, spacer
, label "Low " `styleBasic` [width 40]
, radio Low privacyChoice
]
, hstack
[
label " " `styleBasic` [width 70]
, spacer
, label "Medium " `styleBasic` [width 40]
, radio Medium privacyChoice
, spacer
, label "Full " `styleBasic` [width 40]
, radio Full privacyChoice
]
, spacer
, box_ , box_
[alignMiddle] [alignMiddle]
(hstack (hstack
@ -970,9 +972,9 @@ generateQRCodes config = do
if not (null s) if not (null s)
then return () then return ()
else do else do
generateOneQr pool OrchardPool wAddr generateOneQr pool Orchard wAddr
generateOneQr pool SaplingPool wAddr generateOneQr pool Sapling wAddr
generateOneQr pool TransparentPool wAddr generateOneQr pool Transparent wAddr
generateOneQr :: generateOneQr ::
ConnectionPool -> ZcashPool -> Entity WalletAddress -> IO () ConnectionPool -> ZcashPool -> Entity WalletAddress -> IO ()
generateOneQr p zp wAddr = generateOneQr p zp wAddr =
@ -1007,7 +1009,7 @@ generateQRCodes config = do
dispAddr :: ZcashPool -> WalletAddress -> Maybe T.Text dispAddr :: ZcashPool -> WalletAddress -> Maybe T.Text
dispAddr zp w = dispAddr zp w =
case zp of case zp of
TransparentPool -> Transparent ->
T.append "zcash:" . T.append "zcash:" .
encodeTransparentReceiver encodeTransparentReceiver
(maybe (maybe
@ -1019,12 +1021,11 @@ generateQRCodes config = do
(t_rec =<< (t_rec =<<
(isValidUnifiedAddress . E.encodeUtf8 . getUA . walletAddressUAddress) (isValidUnifiedAddress . E.encodeUtf8 . getUA . walletAddressUAddress)
w) w)
SaplingPool -> Sapling ->
T.append "zcash:" <$> T.append "zcash:" <$>
(getSaplingFromUA . E.encodeUtf8 . getUA . walletAddressUAddress) w (getSaplingFromUA . E.encodeUtf8 . getUA . walletAddressUAddress) w
OrchardPool -> Orchard -> Just $ (T.append "zcash:" . getUA . walletAddressUAddress) w
Just $ (T.append "zcash:" . getUA . walletAddressUAddress) w Sprout -> Nothing
SproutPool -> Nothing
handleEvent :: handleEvent ::
WidgetEnv AppModel AppEvent WidgetEnv AppModel AppEvent
@ -1079,7 +1080,7 @@ handleEvent wenv node model evt =
] ]
ConfirmCancel -> [Model $ model & confirmTitle .~ Nothing & mainInput .~ ""] ConfirmCancel -> [Model $ model & confirmTitle .~ Nothing & mainInput .~ ""]
ShowSeed -> [Model $ model & showSeed .~ True & menuPopup .~ False] ShowSeed -> [Model $ model & showSeed .~ True & menuPopup .~ False]
ShowSend -> [Model $ model & openSend .~ True & privacyChoice .~ Full & recipientValid .~ False] ShowSend -> [Model $ model & openSend .~ True]
SendTx -> SendTx ->
case currentAccount of case currentAccount of
Nothing -> [Event $ ShowError "No account available", Event CancelSend] Nothing -> [Event $ ShowError "No account available", Event CancelSend]
@ -1138,7 +1139,7 @@ handleEvent wenv node model evt =
Just wAddr -> getUserTx dbPool $ entityKey wAddr Just wAddr -> getUserTx dbPool $ entityKey wAddr
] ]
SwitchQr q -> [Model $ model & qrCodeWidget .~ q] SwitchQr q -> [Model $ model & qrCodeWidget .~ q]
SwitchAddr i -> [Model $ model & selAddr .~ i, Event $ SetPool OrchardPool] SwitchAddr i -> [Model $ model & selAddr .~ i, Event $ SetPool Orchard]
SwitchAcc i -> SwitchAcc i ->
[ Model $ model & selAcc .~ i [ Model $ model & selAcc .~ i
, Task $ , Task $
@ -1156,7 +1157,7 @@ handleEvent wenv node model evt =
b <- getBalance dbPool $ entityKey acc b <- getBalance dbPool $ entityKey acc
u <- getUnconfirmedBalance dbPool $ entityKey acc u <- getUnconfirmedBalance dbPool $ entityKey acc
return (b, u) return (b, u)
, Event $ SetPool OrchardPool , Event $ SetPool Orchard
] ]
SwitchWal i -> SwitchWal i ->
[ Model $ model & selWallet .~ i & selAcc .~ 0 & selAddr .~ 0 [ Model $ model & selWallet .~ i & selAcc .~ 0 & selAddr .~ 0
@ -1179,15 +1180,14 @@ handleEvent wenv node model evt =
, setClipboardData $ , setClipboardData $
ClipboardText $ ClipboardText $
case model ^. selPool of case model ^. selPool of
OrchardPool -> Orchard -> maybe "None" (getUA . walletAddressUAddress . entityVal) a
maybe "None" (getUA . walletAddressUAddress . entityVal) a Sapling ->
SaplingPool ->
fromMaybe "None" $ fromMaybe "None" $
(getSaplingFromUA . (getSaplingFromUA .
E.encodeUtf8 . getUA . walletAddressUAddress . entityVal) =<< E.encodeUtf8 . getUA . walletAddressUAddress . entityVal) =<<
a a
SproutPool -> "None" Sprout -> "None"
TransparentPool -> Transparent ->
maybe "None" (encodeTransparentReceiver (model ^. network)) $ maybe "None" (encodeTransparentReceiver (model ^. network)) $
t_rec =<< t_rec =<<
(isValidUnifiedAddress . (isValidUnifiedAddress .
@ -1210,7 +1210,7 @@ handleEvent wenv node model evt =
if not (null a) if not (null a)
then [ Model $ model & addresses .~ a then [ Model $ model & addresses .~ a
, Event $ SwitchAddr $ model ^. selAddr , Event $ SwitchAddr $ model ^. selAddr
, Event $ SetPool OrchardPool , Event $ SetPool Orchard
] ]
else [Event $ NewAddress currentAccount] else [Event $ NewAddress currentAccount]
LoadAccs a -> LoadAccs a ->
@ -1248,7 +1248,6 @@ handleEvent wenv node model evt =
case currentWallet of case currentWallet of
Nothing -> return $ ShowError "No wallet available" Nothing -> return $ ShowError "No wallet available"
Just cW -> do Just cW -> do
runFileLoggingT "zenith.log" $
syncWallet (model ^. configuration) cW syncWallet (model ^. configuration) cW
pool <- pool <-
runNoLoggingT $ runNoLoggingT $
@ -1262,10 +1261,7 @@ handleEvent wenv node model evt =
("Wallet Sync: " <> ("Wallet Sync: " <>
T.pack (printf "%.2f%%" (model ^. barValue * 100))) T.pack (printf "%.2f%%" (model ^. barValue * 100)))
] ]
ResetRecipientValid -> [Model $ model & recipientValid .~ False] CheckRecipient a -> [Model $ model & recipientValid .~ isRecipientValid a]
CheckRecipient a -> [Model $
model & recipientValid .~ isRecipientValidGUI (model ^.privacyChoice) a ]
-- model & recipientValid .~ ((model ^. privacyChoice) == Low) ]
CheckAmount i -> CheckAmount i ->
[ Model $ [ Model $
model & amountValid .~ model & amountValid .~
@ -1276,7 +1272,7 @@ handleEvent wenv node model evt =
-- | Address Book Events -- | Address Book Events
-- | -- |
CheckValidAddress a -> CheckValidAddress a ->
[Model $ model & abAddressValid .~ isZecAddressValid a] [Model $ model & abAddressValid .~ isRecipientValid a]
CheckValidDescrip a -> [Model $ model & abDescripValid .~ isValidString a] CheckValidDescrip a -> [Model $ model & abDescripValid .~ isValidString a]
ShowAdrBook -> ShowAdrBook ->
if null (model ^. abaddressList) if null (model ^. abaddressList)
@ -1471,12 +1467,11 @@ scanZebra dbPath zHost zPort net sendMsg = do
pool <- runNoLoggingT $ initPool dbPath pool <- runNoLoggingT $ initPool dbPath
b <- liftIO $ getMinBirthdayHeight pool b <- liftIO $ getMinBirthdayHeight pool
dbBlock <- getMaxBlock pool $ ZcashNetDB net dbBlock <- getMaxBlock pool $ ZcashNetDB net
chkBlock <- checkIntegrity dbPath zHost zPort dbBlock 1 let sb = max dbBlock b
unless (chkBlock == dbBlock) $ rewindWalletData pool chkBlock confUp <- try $ updateConfs zHost zPort pool :: IO (Either IOError ())
let sb = case confUp of
if chkBlock == dbBlock Left _e0 -> sendMsg (ShowError "Failed to update unconfirmed transactions")
then max dbBlock b Right _ -> do
else max chkBlock b
if sb > zgb_blocks bStatus || sb < 1 if sb > zgb_blocks bStatus || sb < 1
then sendMsg (ShowError "Invalid starting block for scan") then sendMsg (ShowError "Invalid starting block for scan")
else do else do
@ -1486,10 +1481,6 @@ scanZebra dbPath zHost zPort net sendMsg = do
let step = (1.0 :: Float) / fromIntegral (length bList) let step = (1.0 :: Float) / fromIntegral (length bList)
mapM_ (processBlock pool step) bList mapM_ (processBlock pool step) bList
else sendMsg (SyncVal 1.0) else sendMsg (SyncVal 1.0)
confUp <- try $ updateConfs zHost zPort pool :: IO (Either IOError ())
case confUp of
Left _e0 -> sendMsg (ShowError "Failed to update unconfirmed transactions")
Right _ -> return ()
where where
processBlock :: ConnectionPool -> Float -> Int -> IO () processBlock :: ConnectionPool -> Float -> Int -> IO ()
processBlock pool step bl = do processBlock pool step bl = do
@ -1514,16 +1505,16 @@ scanZebra dbPath zHost zPort net sendMsg = do
Left e2 -> sendMsg (ShowError $ showt e2) Left e2 -> sendMsg (ShowError $ showt e2)
Right hb -> do Right hb -> do
let blockTime = getBlockTime hb let blockTime = getBlockTime hb
bi <- mapM_ (processTx zHost zPort blockTime pool (ZcashNetDB net)) $
saveBlock pool $ bl_txs $ addTime blk blockTime
ZcashBlock
(fromIntegral $ bl_height blk)
(HexStringDB $ bl_hash blk)
(fromIntegral $ bl_confirmations blk)
blockTime
(ZcashNetDB net)
mapM_ (processTx zHost zPort bi pool) $ bl_txs blk
sendMsg (SyncVal step) sendMsg (SyncVal step)
addTime :: BlockResponse -> Int -> BlockResponse
addTime bl t =
BlockResponse
(bl_confirmations bl)
(bl_height bl)
(fromIntegral t)
(bl_txs bl)
sendTransaction :: sendTransaction ::
Config Config
@ -1537,7 +1528,7 @@ sendTransaction ::
-> IO () -> IO ()
sendTransaction config znet accId bl amt ua memo sendMsg = do sendTransaction config znet accId bl amt ua memo sendMsg = do
sendMsg $ ShowModal "Preparing transaction..." sendMsg $ ShowModal "Preparing transaction..."
case parseAddressUA ua znet of case parseAddress ua znet of
Nothing -> sendMsg $ ShowError "Incorrect address" Nothing -> sendMsg $ ShowError "Incorrect address"
Just outUA -> do Just outUA -> do
let dbPath = c_dbPath config let dbPath = c_dbPath config
@ -1615,8 +1606,7 @@ runZenithGUI config = do
else return [] else return []
qr <- qr <-
if not (null addrList) if not (null addrList)
then getQrCode pool OrchardPool $ then getQrCode pool Orchard $ entityKey $ head addrList
entityKey $ head addrList
else return Nothing else return Nothing
bal <- bal <-
if not (null accList) if not (null accList)
@ -1645,7 +1635,7 @@ runZenithGUI config = do
(if unconfBal == 0 (if unconfBal == 0
then Nothing then Nothing
else Just unconfBal) else Just unconfBal)
OrchardPool Orchard
qr qr
False False
False False
@ -1683,7 +1673,7 @@ runZenithGUI config = do
Nothing Nothing
False False
False False
Full None
startApp model handleEvent buildUI (params hD) startApp model handleEvent buildUI (params hD)
Left _e -> print "Zebra not available" Left _e -> print "Zebra not available"
where where

View file

@ -6,13 +6,7 @@ import Control.Concurrent.Async (concurrently_, withAsync)
import Control.Exception (throwIO, try) import Control.Exception (throwIO, try)
import Control.Monad (when) import Control.Monad (when)
import Control.Monad.IO.Class (liftIO) import Control.Monad.IO.Class (liftIO)
import Control.Monad.Logger import Control.Monad.Logger (NoLoggingT, logErrorN, logInfoN, runNoLoggingT)
( NoLoggingT
, logErrorN
, logInfoN
, runFileLoggingT
, runNoLoggingT
)
import Data.Aeson import Data.Aeson
import Data.HexString import Data.HexString
import qualified Data.Text as T import qualified Data.Text as T
@ -33,23 +27,19 @@ import ZcashHaskell.Types
import ZcashHaskell.Utils (getBlockTime, makeZebraCall, readZebraTransaction) import ZcashHaskell.Utils (getBlockTime, makeZebraCall, readZebraTransaction)
import Zenith.Core (checkBlockChain, syncWallet) import Zenith.Core (checkBlockChain, syncWallet)
import Zenith.DB import Zenith.DB
( ZcashBlock(..) ( clearWalletData
, ZcashBlockId
, clearWalletData
, clearWalletTransactions , clearWalletTransactions
, getBlock
, getMaxBlock , getMaxBlock
, getMinBirthdayHeight , getMinBirthdayHeight
, getUnconfirmedBlocks , getUnconfirmedBlocks
, getWallets , getWallets
, initDb , initDb
, initPool , initPool
, saveBlock
, saveConfs , saveConfs
, saveTransaction , saveTransaction
, updateWalletSync , updateWalletSync
) )
import Zenith.Types (Config(..), HexStringDB(..), ZcashNetDB(..)) import Zenith.Types (Config(..), ZcashNetDB(..))
import Zenith.Utils (jsonNumber) import Zenith.Utils (jsonNumber)
-- | Function to scan the Zcash blockchain through the Zebra node and populate the Zenith database -- | Function to scan the Zcash blockchain through the Zebra node and populate the Zenith database
@ -67,8 +57,8 @@ rescanZebra host port dbFilePath = do
Right bStatus -> do Right bStatus -> do
let znet = ZcashNetDB $ zgb_net bStatus let znet = ZcashNetDB $ zgb_net bStatus
pool1 <- runNoLoggingT $ initPool dbFilePath pool1 <- runNoLoggingT $ initPool dbFilePath
{-pool2 <- runNoLoggingT $ initPool dbFilePath-} pool2 <- runNoLoggingT $ initPool dbFilePath
{-pool3 <- runNoLoggingT $ initPool dbFilePath-} pool3 <- runNoLoggingT $ initPool dbFilePath
clearWalletTransactions pool1 clearWalletTransactions pool1
clearWalletData pool1 clearWalletData pool1
dbBlock <- getMaxBlock pool1 znet dbBlock <- getMaxBlock pool1 znet
@ -129,26 +119,28 @@ processBlock host port pool pg net b = do
Left e2 -> liftIO $ throwIO $ userError e2 Left e2 -> liftIO $ throwIO $ userError e2
Right hb -> do Right hb -> do
let blockTime = getBlockTime hb let blockTime = getBlockTime hb
bi <- mapM_ (processTx host port blockTime pool net) $
saveBlock pool $ bl_txs $ addTime blk blockTime
ZcashBlock
(fromIntegral $ bl_height blk)
(HexStringDB $ bl_hash blk)
(fromIntegral $ bl_confirmations blk)
blockTime
net
mapM_ (processTx host port bi pool) $ bl_txs blk
liftIO $ tick pg liftIO $ tick pg
where
addTime :: BlockResponse -> Int -> BlockResponse
addTime bl t =
BlockResponse
(bl_confirmations bl)
(bl_height bl)
(fromIntegral t)
(bl_txs bl)
-- | Function to process a raw transaction -- | Function to process a raw transaction
processTx :: processTx ::
T.Text -- ^ Host name for `zebrad` T.Text -- ^ Host name for `zebrad`
-> Int -- ^ Port for `zebrad` -> Int -- ^ Port for `zebrad`
-> ZcashBlockId -- ^ Block ID -> Int -- ^ Block time
-> ConnectionPool -- ^ DB file path -> ConnectionPool -- ^ DB file path
-> ZcashNetDB -- ^ the network
-> HexString -- ^ transaction id -> HexString -- ^ transaction id
-> IO () -> IO ()
processTx host port bt pool t = do processTx host port bt pool net t = do
r <- r <-
liftIO $ liftIO $
makeZebraCall makeZebraCall
@ -164,7 +156,7 @@ processTx host port bt pool t = do
Just rzt -> do Just rzt -> do
_ <- _ <-
runNoLoggingT $ runNoLoggingT $
saveTransaction pool bt $ saveTransaction pool bt net $
Transaction Transaction
t t
(ztr_blockheight rawTx) (ztr_blockheight rawTx)
@ -219,35 +211,5 @@ clearSync config = do
w <- getWallets pool $ zgb_net chainInfo w <- getWallets pool $ zgb_net chainInfo
liftIO $ mapM_ (updateWalletSync pool 0 . entityKey) w liftIO $ mapM_ (updateWalletSync pool 0 . entityKey) w
w' <- liftIO $ getWallets pool $ zgb_net chainInfo w' <- liftIO $ getWallets pool $ zgb_net chainInfo
r <- runFileLoggingT "zenith.log" $ mapM (syncWallet config) w' r <- mapM (syncWallet config) w'
liftIO $ print r liftIO $ print r
-- | Detect chain re-orgs
checkIntegrity ::
T.Text -- ^ Database path
-> T.Text -- ^ Zebra host
-> Int -- ^ Zebra port
-> Int -- ^ The block to start the check
-> Int -- ^ depth
-> IO Int
checkIntegrity dbP zHost zPort b d =
if b < 1
then return 1
else do
r <-
makeZebraCall
zHost
zPort
"getblock"
[Data.Aeson.String $ T.pack $ show b, jsonNumber 1]
case r of
Left e -> throwIO $ userError e
Right blk -> do
pool <- runNoLoggingT $ initPool dbP
dbBlk <- getBlock pool b
case dbBlk of
Nothing -> throwIO $ userError "Block mismatch, rescan needed"
Just dbBlk' ->
if bl_hash blk == getHex (zcashBlockHash $ entityVal dbBlk')
then return b
else checkIntegrity dbP zHost zPort (b - 5 * d) (d + 1)

View file

@ -104,10 +104,10 @@ data Config = Config
} deriving (Eq, Prelude.Show) } deriving (Eq, Prelude.Show)
data ZcashPool data ZcashPool
= TransparentPool = Transparent
| SproutPool | Sprout
| SaplingPool | Sapling
| OrchardPool | Orchard
deriving (Show, Read, Eq) deriving (Show, Read, Eq)
derivePersistField "ZcashPool" derivePersistField "ZcashPool"
@ -115,18 +115,18 @@ derivePersistField "ZcashPool"
instance ToJSON ZcashPool where instance ToJSON ZcashPool where
toJSON zp = toJSON zp =
case zp of case zp of
TransparentPool -> Data.Aeson.String "p2pkh" Transparent -> Data.Aeson.String "p2pkh"
SproutPool -> Data.Aeson.String "sprout" Sprout -> Data.Aeson.String "sprout"
SaplingPool -> Data.Aeson.String "sapling" Sapling -> Data.Aeson.String "sapling"
OrchardPool -> Data.Aeson.String "orchard" Orchard -> Data.Aeson.String "orchard"
instance FromJSON ZcashPool where instance FromJSON ZcashPool where
parseJSON = parseJSON =
withText "ZcashPool" $ \case withText "ZcashPool" $ \case
"p2pkh" -> return TransparentPool "p2pkh" -> return Transparent
"sprout" -> return SproutPool "sprout" -> return Sprout
"sapling" -> return SaplingPool "sapling" -> return Sapling
"orchard" -> return OrchardPool "orchard" -> return Orchard
_ -> fail "Not a known Zcash pool" _ -> fail "Not a known Zcash pool"
newtype ZenithUuid = ZenithUuid newtype ZenithUuid = ZenithUuid
@ -199,10 +199,10 @@ $(deriveJSON defaultOptions ''ZenithStatus)
derivePersistField "ZenithStatus" derivePersistField "ZenithStatus"
data PrivacyPolicy data PrivacyPolicy
= None = Full
| Low
| Medium | Medium
| Full | Low
| None
deriving (Eq, Show, Read, Ord) deriving (Eq, Show, Read, Ord)
$(deriveJSON defaultOptions ''PrivacyPolicy) $(deriveJSON defaultOptions ''PrivacyPolicy)
@ -298,8 +298,7 @@ instance FromJSON AddressGroup where
Nothing -> return [] Nothing -> return []
Just x -> do Just x -> do
x' <- x .:? "addresses" x' <- x .:? "addresses"
return $ return $ maybe [] (map (ZcashAddress s1 [Transparent] Nothing)) x'
maybe [] (map (ZcashAddress s1 [TransparentPool] Nothing)) x'
processSapling k s2 = processSapling k s2 =
case k of case k of
Nothing -> return [] Nothing -> return []
@ -307,7 +306,7 @@ instance FromJSON AddressGroup where
where processOneSapling sx = where processOneSapling sx =
withObject "Sapling" $ \oS -> do withObject "Sapling" $ \oS -> do
oS' <- oS .: "addresses" oS' <- oS .: "addresses"
return $ map (ZcashAddress sx [SaplingPool] Nothing) oS' return $ map (ZcashAddress sx [Sapling] Nothing) oS'
processUnified u = processUnified u =
case u of case u of
Nothing -> return [] Nothing -> return []

View file

@ -3,17 +3,17 @@
module Zenith.Utils where module Zenith.Utils where
import Data.Aeson import Data.Aeson
import Data.Char (isAlphaNum, isSpace)
import Data.Functor (void) import Data.Functor (void)
import Data.Maybe import Data.Maybe
import Data.Ord (clamp) import Data.Ord (clamp)
import Data.Scientific (Scientific(..), scientific) import Data.Scientific (Scientific(..), scientific)
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.Char (isAlphaNum, isSpace)
import System.Directory import System.Directory
import System.Process (createProcess_, shell) import System.Process (createProcess_, shell)
import Text.Regex.Posix import Text.Regex.Posix
import ZcashHaskell.Orchard (encodeUnifiedAddress, isValidUnifiedAddress, parseAddress) import ZcashHaskell.Orchard (encodeUnifiedAddress, isValidUnifiedAddress)
import ZcashHaskell.Sapling (decodeSaplingAddress, isValidShieldedAddress) import ZcashHaskell.Sapling (decodeSaplingAddress, isValidShieldedAddress)
import ZcashHaskell.Transparent import ZcashHaskell.Transparent
( decodeExchangeAddress ( decodeExchangeAddress
@ -24,15 +24,12 @@ import ZcashHaskell.Types
, TransparentAddress(..) , TransparentAddress(..)
, UnifiedAddress(..) , UnifiedAddress(..)
, ZcashNet(..) , ZcashNet(..)
, ValidAddress(..)
, ExchangeAddress(..)
) )
import Zenith.Types import Zenith.Types
( AddressGroup(..) ( AddressGroup(..)
, UnifiedAddressDB(..) , UnifiedAddressDB(..)
, ZcashAddress(..) , ZcashAddress(..)
, ZcashPool(..) , ZcashPool(..)
, PrivacyPolicy(..)
) )
-- | Helper function to convert numbers into JSON -- | Helper function to convert numbers into JSON
@ -74,9 +71,9 @@ getAddresses ag = agtransparent ag <> agsapling ag <> agunified ag
-- | Helper function to validate potential Zcash addresses -- | Helper function to validate potential Zcash addresses
validateAddress :: T.Text -> Maybe ZcashPool validateAddress :: T.Text -> Maybe ZcashPool
validateAddress txt --(tReg || sReg && isJust chk) || (uReg && isJust chk) validateAddress txt --(tReg || sReg && isJust chk) || (uReg && isJust chk)
| tReg = Just TransparentPool | tReg = Just Transparent
| sReg && chkS = Just SaplingPool | sReg && chkS = Just Sapling
| uReg && chk = Just OrchardPool | uReg && chk = Just Orchard
| otherwise = Nothing | otherwise = Nothing
where where
transparentRegex = "^t1[a-zA-Z0-9]{33}$" :: String transparentRegex = "^t1[a-zA-Z0-9]{33}$" :: String
@ -113,7 +110,7 @@ validBarValue :: Float -> Float
validBarValue = clamp (0, 1) validBarValue = clamp (0, 1)
isRecipientValid :: T.Text -> Bool isRecipientValid :: T.Text -> Bool
isRecipientValid a = do isRecipientValid a =
case isValidUnifiedAddress (E.encodeUtf8 a) of case isValidUnifiedAddress (E.encodeUtf8 a) of
Just _a1 -> True Just _a1 -> True
Nothing -> Nothing ->
@ -125,78 +122,8 @@ isRecipientValid a = do
Just _a4 -> True Just _a4 -> True
Nothing -> False) Nothing -> False)
isUnifiedAddressValid :: T.Text -> Bool parseAddress :: T.Text -> ZcashNet -> Maybe UnifiedAddress
isUnifiedAddressValid ua = parseAddress a znet =
case isValidUnifiedAddress (E.encodeUtf8 ua) of
Just _a1 -> True
Nothing -> False
isSaplingAddressValid :: T.Text -> Bool
isSaplingAddressValid sa = isValidShieldedAddress (E.encodeUtf8 sa)
isTransparentAddressValid :: T.Text -> Bool
isTransparentAddressValid ta =
case decodeTransparentAddress (E.encodeUtf8 ta) of
Just _a3 -> True
Nothing -> False
isExchangeAddressValid :: T.Text -> Bool
isExchangeAddressValid xa =
case decodeExchangeAddress (E.encodeUtf8 xa) of
Just _a4 -> True
Nothing -> False
isRecipientValidGUI :: PrivacyPolicy -> T.Text -> Bool
isRecipientValidGUI p a = do
let adr = parseAddress (E.encodeUtf8 a)
case p of
Full -> case adr of
Just a ->
case a of
Unified ua -> True
Sapling sa -> True
_ -> False
Nothing -> False
Medium -> case adr of
Just a ->
case a of
Unified ua -> True
Sapling sa -> True
_ -> False
Nothing -> False
Low -> case adr of
Just a ->
case a of
Unified ua -> True
Sapling sa -> True
Transparent ta -> True
Exchange ea -> True
_ -> False
Nothing -> False
None -> case adr of
Just a ->
case a of
Transparent ta -> True
Exchange ea -> True
_ -> False
Nothing -> False
isZecAddressValid :: T.Text -> Bool
isZecAddressValid a = do
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 (E.encodeUtf8 a) of
Just _a4 -> True
Nothing -> False)
parseAddressUA :: T.Text -> ZcashNet -> Maybe UnifiedAddress
parseAddressUA a znet =
case isValidUnifiedAddress (E.encodeUtf8 a) of case isValidUnifiedAddress (E.encodeUtf8 a) of
Just a1 -> Just a1 Just a1 -> Just a1
Nothing -> Nothing ->
@ -234,3 +161,4 @@ padWithZero n s
isEmpty :: [a] -> Bool isEmpty :: [a] -> Bool
isEmpty [] = True isEmpty [] = True
isEmpty _ = False isEmpty _ = False

View file

@ -123,10 +123,9 @@ sendTx user pwd fromAddy toAddy amount memo = do
if source fromAddy /= ImportedWatchOnly if source fromAddy /= ImportedWatchOnly
then do then do
let privacyPolicy let privacyPolicy
| valAdd == Just TransparentPool = "AllowRevealedRecipients" | valAdd == Just Transparent = "AllowRevealedRecipients"
| isNothing (account fromAddy) && | isNothing (account fromAddy) &&
elem TransparentPool (pool fromAddy) = elem Transparent (pool fromAddy) = "AllowRevealedSenders"
"AllowRevealedSenders"
| otherwise = "AllowRevealedAmounts" | otherwise = "AllowRevealedAmounts"
let pd = let pd =
case memo of case memo of
@ -302,7 +301,7 @@ sendWithUri user pwd fromAddy uri repTo = do
let addType = validateAddress $ T.pack parsedAddress let addType = validateAddress $ T.pack parsedAddress
case addType of case addType of
Nothing -> putStrLn " Invalid address" Nothing -> putStrLn " Invalid address"
Just TransparentPool -> do Just Transparent -> do
putStrLn $ " Address is valid: " ++ parsedAddress putStrLn $ " Address is valid: " ++ parsedAddress
case (readMaybe parsedAmount :: Maybe Double) of case (readMaybe parsedAmount :: Maybe Double) of
Nothing -> putStrLn " Invalid amount." Nothing -> putStrLn " Invalid amount."

View file

@ -1,16 +1,15 @@
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
import Control.Monad (when) import Control.Monad (when)
import Control.Monad.Logger (runFileLoggingT, runNoLoggingT) import Control.Monad.Logger (runNoLoggingT)
import Data.HexString import Data.HexString
import Data.Maybe (fromJust)
import qualified Data.Text.Encoding as E 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
import Test.HUnit import Test.HUnit
import Test.Hspec import Test.Hspec
import ZcashHaskell.Orchard (isValidUnifiedAddress, parseAddress) import ZcashHaskell.Orchard (isValidUnifiedAddress)
import ZcashHaskell.Sapling import ZcashHaskell.Sapling
( decodeSaplingOutputEsk ( decodeSaplingOutputEsk
, encodeSaplingAddress , encodeSaplingAddress
@ -173,15 +172,15 @@ 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 "/home/rav/Zenith/zenith.db" pool <- runNoLoggingT $ initPool "zenith.db"
res <- selectUnspentNotes pool (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 "/home/rav/Zenith/zenith.db" pool <- runNoLoggingT $ initPool "zenith.db"
let res = selectUnspentNotes pool (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 "/home/rav/Zenith/zenith.db" pool <- runNoLoggingT $ initPool "zenith.db"
res <- selectUnspentNotes pool (toSqlKey 1) 14000000 res <- selectUnspentNotes pool (toSqlKey 1) 14000000
calculateTxFee res 3 `shouldBe` 20000 calculateTxFee res 3 `shouldBe` 20000
describe "Testing validation" $ do describe "Testing validation" $ do
@ -210,7 +209,7 @@ main = do
(case decodeTransparentAddress (E.encodeUtf8 a) of (case decodeTransparentAddress (E.encodeUtf8 a) of
Just _a3 -> True Just _a3 -> True
Nothing -> Nothing ->
case decodeExchangeAddress (E.encodeUtf8 a) of case decodeExchangeAddress (En.encodeUtf8 a) of
Just _a4 -> True Just _a4 -> True
Nothing -> False)) Nothing -> False))
it "Transparent" $ do it "Transparent" $ do
@ -234,115 +233,21 @@ main = do
a `shouldBe` a `shouldBe`
Just Just
"ztestsapling1tgjr4zppwk4ne8xy6gdq4z2gwq7dmf5jq8z2ctpn8nlmtse0a74fa5z0m8z383gmpgqz6q6duu4" "ztestsapling1tgjr4zppwk4ne8xy6gdq4z2gwq7dmf5jq8z2ctpn8nlmtse0a74fa5z0m8z383gmpgqz6q6duu4"
describe "Notes" $ do {-describe "Creating Tx" $ do-}
it "Check Orchard notes" $ do {-xit "To Orchard" $ do-}
pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db" {-let uaRead =-}
oNotes <- getWalletUnspentOrchNotes pool (toSqlKey 1) {-isValidUnifiedAddress-}
oNotes `shouldBe` [] {-"utest1dl54utt6prjj5e0dnlknwumnxq9hycdjpkfr0sy6e6h522remqee8axe9zax0wsjrwpj76v555pdhvj9rnargpfyycs0vpkapq98xcdhem99gc4wchzn0ggepq3y6nz3a9sscwgqxgsh9vzhcad402y3x9szfregck5gslkya3c79d86xx0l33tpk8gnn7ew9vw37w43zh22u8dgdax"-}
it "Check Sapling notes" $ do {-case uaRead of-}
pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db" {-Nothing -> assertFailure "wrong address"-}
oNotes <- getWalletUnspentSapNotes pool (toSqlKey 4) {-Just ua -> do-}
oNotes `shouldBe` [] {-tx <--}
it "Check transparent notes" $ do {-prepareTx-}
pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db" {-"zenith.db"-}
oNotes <- getWalletUnspentTrNotes pool (toSqlKey 1) {-TestNet-}
oNotes `shouldBe` [] {-(toSqlKey 1)-}
describe "Creating Tx" $ do {-2819811-}
describe "Full" $ do {-0.04-}
it "To Orchard" $ do {-ua-}
let uaRead = {-"sent with Zenith, test"-}
parseAddress {-tx `shouldBe` Right (hexString "deadbeef")-}
"utest1dl54utt6prjj5e0dnlknwumnxq9hycdjpkfr0sy6e6h522remqee8axe9zax0wsjrwpj76v555pdhvj9rnargpfyycs0vpkapq98xcdhem99gc4wchzn0ggepq3y6nz3a9sscwgqxgsh9vzhcad402y3x9szfregck5gslkya3c79d86xx0l33tpk8gnn7ew9vw37w43zh22u8dgdax"
case uaRead of
Nothing -> assertFailure "wrong address"
Just ua -> do
pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
tx <-
runFileLoggingT "zenith.log" $
prepareTxV2
pool
"localhost"
18232
TestNet
(toSqlKey 1)
3001230
0.005
(fromJust uaRead)
"Sending memo to orchard"
Full
case tx of
Left e -> assertFailure $ show e
Right h -> h `shouldNotBe` (hexString "deadbeef")
it "To Sapling" $ do
let uaRead =
parseAddress
"ztestsapling136jp8z89v2jh6kqd5rs4dtvlxym90m43svzdwzxaplyvc5ttzppytpvx80ncllcsqzpmukxjl3y"
case uaRead of
Nothing -> assertFailure "wrong address"
Just ua -> do
pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
tx <-
runFileLoggingT "zenith.log" $
prepareTxV2
pool
"localhost"
18232
TestNet
(toSqlKey 4)
3001230
0.005
(fromJust uaRead)
"Sending memo to sapling"
Full
case tx of
Left e -> assertFailure $ show e
Right h -> h `shouldNotBe` (hexString "deadbeef")
describe "Medium" $ do
xit "To Orchard" $ do
let uaRead =
parseAddress
"utest1dl54utt6prjj5e0dnlknwumnxq9hycdjpkfr0sy6e6h522remqee8axe9zax0wsjrwpj76v555pdhvj9rnargpfyycs0vpkapq98xcdhem99gc4wchzn0ggepq3y6nz3a9sscwgqxgsh9vzhcad402y3x9szfregck5gslkya3c79d86xx0l33tpk8gnn7ew9vw37w43zh22u8dgdax"
case uaRead of
Nothing -> assertFailure "wrong address"
Just ua -> do
pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
tx <-
runFileLoggingT "zenith.log" $
prepareTxV2
pool
"localhost"
18232
TestNet
(toSqlKey 1)
3000789
0.005
(fromJust uaRead)
"Sending memo to orchard"
Medium
case tx of
Left e -> assertFailure $ show e
Right h -> h `shouldNotBe` (hexString "deadbeef")
xit "To Sapling" $ do
let uaRead =
parseAddress
"ztestsapling136jp8z89v2jh6kqd5rs4dtvlxym90m43svzdwzxaplyvc5ttzppytpvx80ncllcsqzpmukxjl3y"
case uaRead of
Nothing -> assertFailure "wrong address"
Just ua -> do
pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
tx <-
runFileLoggingT "zenith.log" $
prepareTxV2
pool
"localhost"
18232
TestNet
(toSqlKey 1)
3000789
0.005
(fromJust uaRead)
"Sending memo to orchard"
Medium
case tx of
Left e -> assertFailure $ show e
Right h -> h `shouldNotBe` (hexString "deadbeef")

@ -1 +1 @@
Subproject commit 12296026a0ebb9a5afe0904b251c5d31080eab18 Subproject commit 7965dc38c48da348f503a52ee10042fffc43f32c