Vergara_Tech/zenith
Vergara_Tech/zenith
2
0
Fork 0
Code Issues 21 Pull requests Projects Releases 6 Packages Wiki Activity

Compare commits

base: Vergara_Tech:c0031e91fd1d100bec8419267ca46652687ab695
Branches Tags
Vergara_Tech:master
Vergara_Tech:milestone3
Vergara_Tech:rav001
Vergara_Tech:rvv001
Vergara_Tech:zrpc-docker
Vergara_Tech:rvv041
Vergara_Tech:zenith-install
Vergara_Tech:milestone2
Vergara_Tech:dev041
Vergara_Tech:legacy
Vergara_Tech:0.7.0.0-beta
Vergara_Tech:0.6.0.0-beta
Vergara_Tech:0.5.3.1-beta
Vergara_Tech:0.5.3.0-beta
Vergara_Tech:0.5.2.0-beta
Vergara_Tech:0.5.1.0-beta.1
Vergara_Tech:0.5.1.0-beta
Vergara_Tech:0.4.0
Vergara_Tech:0.3.4
Vergara_Tech:0.3.2
Vergara_Tech:0.3.1.0
Vergara_Tech:0.3.0.0
Vergara_Tech:0.2.0.0
Vergara_Tech:0.1.0.0
...
compare: Vergara_Tech:5f2859194ba519bd67b972a4b8c4a15567f988bb
Branches Tags
Vergara_Tech:master
Vergara_Tech:milestone3
Vergara_Tech:rav001
Vergara_Tech:rvv001
Vergara_Tech:zrpc-docker
Vergara_Tech:rvv041
Vergara_Tech:zenith-install
Vergara_Tech:milestone2
Vergara_Tech:dev041
Vergara_Tech:legacy
Vergara_Tech:0.7.0.0-beta
Vergara_Tech:0.6.0.0-beta
Vergara_Tech:0.5.3.1-beta
Vergara_Tech:0.5.3.0-beta
Vergara_Tech:0.5.2.0-beta
Vergara_Tech:0.5.1.0-beta.1
Vergara_Tech:0.5.1.0-beta
Vergara_Tech:0.4.0
Vergara_Tech:0.3.4
Vergara_Tech:0.3.2
Vergara_Tech:0.3.1.0
Vergara_Tech:0.3.0.0
Vergara_Tech:0.2.0.0
Vergara_Tech:0.1.0.0

3 commits
c0031e91fd ... 5f2859194b

Author SHA1 Message Date
Rene Vergara
5f2859194b
fix: correct rewind for brand new wallets 2024-10-23 16:26:18 -05:00
Rene Vergara
9d1416dd9d
feat: implement Scientific 2024-10-23 15:51:05 -05:00
Rene Vergara
d72f355981
feat: update amount reading to Scientific 2024-10-22 07:21:12 -05:00
8 changed files with 451 additions and 320 deletions
Show stats Expand all files Collapse all files

33
src/Zenith/CLI.hs
View file

@ -75,6 +75,7 @@ import Control.Monad.Logger
import Data.Aeson import Data.Aeson
import Data.HexString (HexString(..), toText) import Data.HexString (HexString(..), toText)
import Data.Maybe import Data.Maybe
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.Time.Clock.POSIX (posixSecondsToUTCTime) import Data.Time.Clock.POSIX (posixSecondsToUTCTime)
@ -119,10 +120,10 @@ import Zenith.Types
import Zenith.Utils import Zenith.Utils
( displayTaz ( displayTaz
, displayZec , displayZec
, getChainTip
, isRecipientValid , isRecipientValid
, isRecipientValidGUI , isRecipientValidGUI
, jsonNumber , jsonNumber
, parseAddressUA
, showAddress , showAddress
, validBarValue , validBarValue
) )
@ -159,7 +160,7 @@ makeLenses ''DialogInput
data SendInput = SendInput data SendInput = SendInput
{ _sendTo :: !T.Text { _sendTo :: !T.Text
, _sendAmt :: !Float , _sendAmt :: !Scientific
, _sendMemo :: !T.Text , _sendMemo :: !T.Text
, _policyField :: !PrivacyPolicy , _policyField :: !PrivacyPolicy
} deriving (Show) } deriving (Show)
@ -174,7 +175,7 @@ data AdrBookEntry = AdrBookEntry
makeLenses ''AdrBookEntry makeLenses ''AdrBookEntry
newtype ShDshEntry = ShDshEntry newtype ShDshEntry = ShDshEntry
{ _shAmt :: Float { _shAmt :: Scientific
} deriving (Show) } deriving (Show)
makeLenses ''ShDshEntry makeLenses ''ShDshEntry
@ -701,8 +702,8 @@ mkSendForm bal =
, label "Memo: " @@= editTextField sendMemo MemoField (Just 1) , label "Memo: " @@= editTextField sendMemo MemoField (Just 1)
] ]
where where
isAmountValid :: Integer -> Float -> Bool isAmountValid :: Integer -> Scientific -> Bool
isAmountValid b i = (fromIntegral b / 100000000.0) >= i isAmountValid b i = fromIntegral b >= (i * scientific 1 8)
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
@ -713,8 +714,8 @@ mkDeshieldForm tbal =
editShowableFieldWithValidate shAmt AmtField (isAmountValid tbal) editShowableFieldWithValidate shAmt AmtField (isAmountValid tbal)
] ]
where where
isAmountValid :: Integer -> Float -> Bool isAmountValid :: Integer -> Scientific -> Bool
isAmountValid b i = (fromIntegral b / 100000000.0) >= i isAmountValid b i = fromIntegral b >= (i * scientific 1 8)
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
@ -839,11 +840,11 @@ scanZebra dbP zHost zPort b eChan znet = do
logDebugN $ logDebugN $
"dbBlock: " <> "dbBlock: " <>
T.pack (show dbBlock) <> " chkBlock: " <> T.pack (show chkBlock) T.pack (show dbBlock) <> " chkBlock: " <> T.pack (show chkBlock)
when (chkBlock /= dbBlock) $ rewindWalletData pool chkBlock
let sb = let sb =
if chkBlock == dbBlock if chkBlock == dbBlock
then max dbBlock b then max dbBlock b
else max chkBlock b else max chkBlock b
when (chkBlock /= dbBlock && chkBlock /= 1) $ rewindWalletData pool sb
if sb > zgb_blocks bStatus || sb < 1 if sb > zgb_blocks bStatus || sb < 1
then do then do
liftIO $ liftIO $
@ -1201,7 +1202,8 @@ appEvent (BT.VtyEvent e) = do
Just (_k, w) -> return w Just (_k, w) -> return w
fs1 <- BT.zoom txForm $ BT.gets formState fs1 <- BT.zoom txForm $ BT.gets formState
bl <- bl <-
liftIO $ getLastSyncBlock pool $ entityKey selWal liftIO $
getChainTip (s ^. zebraHost) (s ^. zebraPort)
_ <- _ <-
liftIO $ liftIO $
forkIO $ forkIO $
@ -1212,7 +1214,7 @@ appEvent (BT.VtyEvent e) = do
(s ^. zebraPort) (s ^. zebraPort)
(s ^. network) (s ^. network)
(entityKey selAcc) (entityKey selAcc)
bl (bl + 5)
(fs1 ^. sendAmt) (fs1 ^. sendAmt)
(fs1 ^. sendTo) (fs1 ^. sendTo)
(fs1 ^. sendMemo) (fs1 ^. sendMemo)
@ -1292,7 +1294,8 @@ appEvent (BT.VtyEvent e) = do
getUA . walletAddressUAddress) getUA . walletAddressUAddress)
(entityVal selAddr))) (entityVal selAddr)))
bl <- bl <-
liftIO $ getLastSyncBlock pool $ entityKey selWal liftIO $
getChainTip (s ^. zebraHost) (s ^. zebraPort)
case tAddrMaybe of case tAddrMaybe of
Nothing -> do Nothing -> do
BT.modify $ BT.modify $
@ -1994,7 +1997,7 @@ sendTransaction ::
-> ZcashNet -> ZcashNet
-> ZcashAccountId -> ZcashAccountId
-> Int -> Int
-> Float -> Scientific
-> T.Text -> T.Text
-> T.Text -> T.Text
-> PrivacyPolicy -> PrivacyPolicy
@ -2005,7 +2008,7 @@ sendTransaction pool chan zHost zPort znet accId bl amt ua memo policy = do
Nothing -> BC.writeBChan chan $ TickMsg "Incorrect address" Nothing -> BC.writeBChan chan $ TickMsg "Incorrect address"
Just outUA -> do Just outUA -> do
res <- res <-
runNoLoggingT $ runStderrLoggingT $
prepareTxV2 prepareTxV2
pool pool
zHost zHost
@ -2021,10 +2024,10 @@ sendTransaction pool chan zHost zPort znet accId bl amt ua memo policy = do
else Just memo) else Just memo)
] ]
policy policy
BC.writeBChan chan $ TickMsg "Transaction ready, sending to Zebra..."
case res of case res of
Left e -> BC.writeBChan chan $ TickMsg $ show e Left e -> BC.writeBChan chan $ TickMsg $ show e
Right rawTx -> do Right rawTx -> do
BC.writeBChan chan $ TickMsg "Transaction ready, sending to Zebra..."
resp <- resp <-
makeZebraCall makeZebraCall
zHost zHost
@ -2073,7 +2076,7 @@ deshieldTransaction ::
-> IO () -> IO ()
deshieldTransaction pool chan zHost zPort znet accId bl pnote = do deshieldTransaction pool chan zHost zPort znet accId bl pnote = do
BC.writeBChan chan $ TickMsg "Deshielding funds..." BC.writeBChan chan $ TickMsg "Deshielding funds..."
res <- runNoLoggingT $ deshieldNotes pool zHost zPort znet accId bl pnote res <- runStderrLoggingT $ deshieldNotes pool zHost zPort znet accId bl pnote
case res of case res of
Left e -> BC.writeBChan chan $ TickMsg $ show e Left e -> BC.writeBChan chan $ TickMsg $ show e
Right rawTx -> do Right rawTx -> do

201
src/Zenith/Core.hs
View file

@ -23,11 +23,11 @@ import Data.Aeson
import Data.Binary.Get hiding (getBytes) 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.HexString (HexString, toBytes, toText)
import Data.HexString (HexString, hexString, toBytes, toText) import Data.Int (Int64)
import Data.List import Data.List
import Data.Maybe (fromJust, fromMaybe) import Data.Maybe (fromJust, fromMaybe)
import Data.Pool (Pool) import Data.Scientific (Scientific, scientific, toBoundedInteger)
import qualified Data.Text as T import qualified Data.Text as T
import qualified Data.Text.Encoding as E import qualified Data.Text.Encoding as E
import Data.Time import Data.Time
@ -116,17 +116,22 @@ checkBlockChain nodeHost nodePort = do
-- | Get commitment trees from Zebra -- | Get commitment trees from Zebra
getCommitmentTrees :: getCommitmentTrees ::
T.Text -- ^ Host where `zebrad` is avaiable ConnectionPool
-> T.Text -- ^ Host where `zebrad` is avaiable
-> Int -- ^ Port where `zebrad` is available -> Int -- ^ Port where `zebrad` is available
-> Int -- ^ Block height -> Int -- ^ Block height
-> IO ZebraTreeInfo -> IO ZebraTreeInfo
getCommitmentTrees nodeHost nodePort block = do getCommitmentTrees pool nodeHost nodePort block = do
bh' <- getBlockHash pool block
case bh' of
Nothing -> throwIO $ userError "couldn't get block hash"
Just bh -> do
r <- r <-
makeZebraCall makeZebraCall
nodeHost nodeHost
nodePort nodePort
"z_gettreestate" "z_gettreestate"
[Data.Aeson.String $ T.pack $ show block] [Data.Aeson.String $ toText bh]
case r of case r of
Left e -> throwIO $ userError e Left e -> throwIO $ userError e
Right zti -> return zti Right zti -> return zti
@ -280,7 +285,7 @@ findSaplingOutputs ::
-> Int -- ^ the starting block -> Int -- ^ the starting block
-> ZcashNetDB -- ^ The network -> ZcashNetDB -- ^ The network
-> Entity ZcashAccount -- ^ The account to use -> Entity ZcashAccount -- ^ The account to use
-> LoggingT IO () -> NoLoggingT IO ()
findSaplingOutputs config b znet za = do findSaplingOutputs config b znet za = do
let dbPath = c_dbPath config let dbPath = c_dbPath config
let zebraHost = c_zebraHost config let zebraHost = c_zebraHost config
@ -288,7 +293,7 @@ findSaplingOutputs config b znet za = do
let zn = getNet znet let zn = getNet znet
pool <- liftIO $ runNoLoggingT $ initPool dbPath pool <- liftIO $ runNoLoggingT $ initPool dbPath
tList <- liftIO $ getShieldedOutputs pool b znet tList <- liftIO $ getShieldedOutputs pool b znet
trees <- liftIO $ getCommitmentTrees zebraHost zebraPort (b - 1) trees <- liftIO $ getCommitmentTrees pool zebraHost zebraPort (b - 1)
logDebugN "getting Sapling frontier" logDebugN "getting Sapling frontier"
let sT = getSaplingFrontier $ SaplingCommitmentTree $ ztiSapling trees let sT = getSaplingFrontier $ SaplingCommitmentTree $ ztiSapling trees
case sT of case sT of
@ -307,7 +312,7 @@ findSaplingOutputs config b znet za = do
-> ZcashNet -> ZcashNet
-> ConnectionPool -> ConnectionPool
-> [(Entity ZcashTransaction, Entity ShieldOutput)] -> [(Entity ZcashTransaction, Entity ShieldOutput)]
-> LoggingT IO () -> NoLoggingT IO ()
decryptNotes _ _ _ [] = return () decryptNotes _ _ _ [] = return ()
decryptNotes st n pool ((zt, o):txs) = do decryptNotes st n pool ((zt, o):txs) = do
let updatedTree = let updatedTree =
@ -395,7 +400,7 @@ findOrchardActions config b znet za = do
let zn = getNet znet let zn = getNet znet
pool <- runNoLoggingT $ initPool dbPath pool <- runNoLoggingT $ initPool dbPath
tList <- getOrchardActions pool b znet tList <- getOrchardActions pool b znet
trees <- getCommitmentTrees zebraHost zebraPort (b - 1) trees <- getCommitmentTrees pool zebraHost zebraPort (b - 1)
let sT = getOrchardFrontier $ OrchardCommitmentTree $ ztiOrchard trees let sT = getOrchardFrontier $ OrchardCommitmentTree $ ztiOrchard trees
case sT of case sT of
Nothing -> throwIO $ userError "Failed to read Orchard commitment tree" Nothing -> throwIO $ userError "Failed to read Orchard commitment tree"
@ -478,7 +483,7 @@ updateSaplingWitnesses pool = do
updateOneNote maxId n = do updateOneNote maxId n = do
let noteSync = walletSapNoteWitPos $ entityVal n let noteSync = walletSapNoteWitPos $ entityVal n
when (noteSync < maxId) $ do when (noteSync < maxId) $ do
cmus <- liftIO $ getSaplingCmus pool $ walletSapNoteWitPos $ entityVal n cmus <- liftIO $ getSaplingCmus pool noteSync maxId
let cmuList = map (\(ESQ.Value x) -> getHex x) cmus let cmuList = map (\(ESQ.Value x) -> getHex x) cmus
let newWitness = let newWitness =
updateSaplingWitness updateSaplingWitness
@ -496,7 +501,7 @@ updateOrchardWitnesses pool = do
updateOneNote maxId n = do updateOneNote maxId n = do
let noteSync = walletOrchNoteWitPos $ entityVal n let noteSync = walletOrchNoteWitPos $ entityVal n
when (noteSync < maxId) $ do when (noteSync < maxId) $ do
cmxs <- liftIO $ getOrchardCmxs pool noteSync cmxs <- liftIO $ getOrchardCmxs pool noteSync maxId
let cmxList = map (\(ESQ.Value x) -> getHex x) cmxs let cmxList = map (\(ESQ.Value x) -> getHex x) cmxs
let newWitness = let newWitness =
updateOrchardWitness updateOrchardWitness
@ -534,7 +539,7 @@ prepareTx ::
-> ZcashNet -> ZcashNet
-> ZcashAccountId -> ZcashAccountId
-> Int -> Int
-> Float -> Scientific
-> UnifiedAddress -> UnifiedAddress
-> T.Text -> T.Text
-> LoggingT IO (Either TxError HexString) -> LoggingT IO (Either TxError HexString)
@ -555,7 +560,7 @@ prepareTx pool zebraHost zebraPort zn za bh amt ua memo = do
Just r1 -> (4, getBytes r1) Just r1 -> (4, getBytes r1)
logDebugN $ T.pack $ show recipient logDebugN $ T.pack $ show recipient
logDebugN $ T.pack $ "Target block: " ++ show bh logDebugN $ T.pack $ "Target block: " ++ show bh
trees <- liftIO $ getCommitmentTrees zebraHost zebraPort bh trees <- liftIO $ getCommitmentTrees pool 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
@ -564,12 +569,16 @@ prepareTx pool zebraHost zebraPort zn za bh amt ua memo = do
return $ Left ZHError return $ Left ZHError
Just acc -> do Just acc -> do
logDebugN $ T.pack $ show acc logDebugN $ T.pack $ show acc
let zats = floorFloatInteger $ amt * (10 ^ 8) let zats' = toBoundedInteger $ amt * scientific 1 8
logDebugN $ T.pack $ show zats case zats' of
Nothing -> return $ Left ZHError
Just zats -> do
logDebugN $ T.pack $ show (zats :: Int64)
{-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
(tList, sList, oList) <- liftIO $ selectUnspentNotes pool za (zats + 5000) (tList, sList, oList) <-
liftIO $ selectUnspentNotes pool za (fromIntegral $ zats + 5000)
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
@ -577,18 +586,29 @@ prepareTx pool zebraHost zebraPort zn za bh amt ua memo = do
let noteTotal = getTotalAmount (tList, sList, oList) let noteTotal = getTotalAmount (tList, sList, oList)
tSpends <- tSpends <-
liftIO $ liftIO $
prepTSpends (getTranSK $ zcashAccountTPrivateKey $ entityVal acc) tList prepTSpends
(getTranSK $ zcashAccountTPrivateKey $ entityVal acc)
tList
--print tSpends --print tSpends
sSpends <- sSpends <-
liftIO $ liftIO $
prepSSpends (getSapSK $ zcashAccountSapSpendKey $ entityVal acc) sList prepSSpends
(getSapSK $ zcashAccountSapSpendKey $ entityVal acc)
sList
--print sSpends --print sSpends
oSpends <- oSpends <-
liftIO $ liftIO $
prepOSpends (getOrchSK $ zcashAccountOrchSpendKey $ entityVal acc) oList prepOSpends
(getOrchSK $ zcashAccountOrchSpendKey $ entityVal acc)
oList
--print oSpends --print oSpends
dummy <- dummy <-
liftIO $ makeOutgoing acc recipient zats (noteTotal - 5000 - zats) liftIO $
makeOutgoing
acc
recipient
zats
(fromInteger noteTotal - 5000 - zats)
logDebugN "Calculating fee" logDebugN "Calculating fee"
let feeResponse = let feeResponse =
createTransaction createTransaction
@ -599,21 +619,27 @@ prepareTx pool zebraHost zebraPort zn za bh amt ua memo = do
oSpends oSpends
dummy dummy
zn zn
(bh + 3) bh
False False
case feeResponse of case feeResponse of
Left e1 -> return $ Left Fee Left e1 -> return $ Left Fee
Right fee -> do Right fee -> do
let feeAmt = let feeAmt =
fromIntegral (runGet getInt64le $ LBS.fromStrict $ toBytes fee) fromIntegral
(runGet getInt64le $ LBS.fromStrict $ toBytes fee)
(tList1, sList1, oList1) <- (tList1, sList1, oList1) <-
liftIO $ selectUnspentNotes pool za (zats + feeAmt) liftIO $ selectUnspentNotes pool za (fromIntegral zats + feeAmt)
logDebugN $ T.pack $ "selected notes with fee" ++ show feeAmt logDebugN $ T.pack $ "selected notes with fee" ++ show feeAmt
logDebugN $ T.pack $ show tList logDebugN $ T.pack $ show tList
logDebugN $ T.pack $ show sList logDebugN $ T.pack $ show sList
logDebugN $ T.pack $ show oList logDebugN $ T.pack $ show oList
outgoing <- outgoing <-
liftIO $ makeOutgoing acc recipient zats (noteTotal - feeAmt - zats) liftIO $
makeOutgoing
acc
recipient
zats
(fromInteger noteTotal - fromInteger feeAmt - zats)
logDebugN $ T.pack $ show outgoing logDebugN $ T.pack $ show outgoing
let tx = let tx =
createTransaction createTransaction
@ -624,7 +650,7 @@ prepareTx pool zebraHost zebraPort zn za bh amt ua memo = do
oSpends oSpends
outgoing outgoing
zn zn
(bh + 3) bh
True True
logDebugN $ T.pack $ show tx logDebugN $ T.pack $ show tx
return tx return tx
@ -632,8 +658,8 @@ prepareTx pool zebraHost zebraPort zn za bh amt ua memo = do
makeOutgoing :: makeOutgoing ::
Entity ZcashAccount Entity ZcashAccount
-> (Int, BS.ByteString) -> (Int, BS.ByteString)
-> Integer -> Int64
-> Integer -> Int64
-> 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 <- runNoLoggingT $ getInternalAddresses pool $ entityKey acc
@ -752,11 +778,11 @@ deshieldNotes ::
-> ZcashAccountId -> ZcashAccountId
-> Int -> Int
-> ProposedNote -> ProposedNote
-> NoLoggingT IO (Either TxError HexString) -> LoggingT IO (Either TxError HexString)
deshieldNotes pool zebraHost zebraPort znet za bh pnote = do deshieldNotes pool zebraHost zebraPort znet za bh pnote = do
bal <- liftIO $ getShieldedBalance pool za bal <- liftIO $ getShieldedBalance pool za
let zats = ceilingFloatInteger $ pn_amt pnote * (10 ^ 8) let zats = pn_amt pnote * scientific 1 8
if bal > (20000 + zats) if fromInteger bal > (scientific 2 4 + zats)
then prepareTxV2 pool zebraHost zebraPort znet za bh [pnote] Low then prepareTxV2 pool zebraHost zebraPort znet za bh [pnote] Low
else return $ Left InsufficientFunds else return $ Left InsufficientFunds
@ -771,9 +797,11 @@ shieldTransparentNotes ::
shieldTransparentNotes pool zebraHost zebraPort znet za bh = do shieldTransparentNotes pool zebraHost zebraPort znet za bh = do
accRead <- liftIO $ getAccountById pool za accRead <- liftIO $ getAccountById pool za
logDebugN $ T.pack $ "Target block: " ++ show bh logDebugN $ T.pack $ "Target block: " ++ show bh
trees <- liftIO $ getCommitmentTrees zebraHost zebraPort bh {-
let sT = SaplingCommitmentTree $ ztiSapling trees -trees <- liftIO $ getCommitmentTrees zebraHost zebraPort bh
let oT = OrchardCommitmentTree $ ztiOrchard trees -let sT = SaplingCommitmentTree $ ztiSapling trees
-let oT = OrchardCommitmentTree $ ztiOrchard trees
-}
case accRead of case accRead of
Nothing -> do Nothing -> do
logErrorN "Can't find Account" logErrorN "Can't find Account"
@ -810,8 +838,8 @@ shieldTransparentNotes pool zebraHost zebraPort znet za bh = do
True True
let tx = let tx =
createTransaction createTransaction
(Just sT) Nothing
(Just oT) Nothing
tSpends tSpends
[] []
[] []
@ -871,15 +899,17 @@ prepareTxV2 ::
-> Int -> Int
-> [ProposedNote] -> [ProposedNote]
-> PrivacyPolicy -> PrivacyPolicy
-> NoLoggingT IO (Either TxError HexString) -> LoggingT IO (Either TxError HexString)
prepareTxV2 pool zebraHost zebraPort zn za bh pnotes policy = do prepareTxV2 pool zebraHost zebraPort zn za bh pnotes policy = do
accRead <- liftIO $ getAccountById pool za accRead <- liftIO $ getAccountById pool za
let recipients = map extractReceiver pnotes let recipients = map extractReceiver pnotes
logDebugN $ T.pack $ show recipients logDebugN $ T.pack $ show recipients
logDebugN $ T.pack $ "Target block: " ++ show bh logDebugN $ T.pack $ "Target block: " ++ show bh
trees <- liftIO $ getCommitmentTrees zebraHost zebraPort bh {-
let sT = SaplingCommitmentTree $ ztiSapling trees -trees <- liftIO $ getCommitmentTrees zebraHost zebraPort bh
let oT = OrchardCommitmentTree $ ztiOrchard trees -let sT = SaplingCommitmentTree $ ztiSapling trees
-let oT = OrchardCommitmentTree $ ztiOrchard trees
-}
case accRead of case accRead of
Nothing -> do Nothing -> do
logErrorN "Can't find Account" logErrorN "Can't find Account"
@ -887,7 +917,12 @@ prepareTxV2 pool zebraHost zebraPort zn za bh pnotes policy = do
Just acc -> do Just acc -> do
logDebugN $ T.pack $ show acc logDebugN $ T.pack $ show acc
let amt = foldl' (\x y -> x + pn_amt y) 0 pnotes let amt = foldl' (\x y -> x + pn_amt y) 0 pnotes
let zats = ceilingFloatInteger $ amt * (10 ^ 8) let zats' = toBoundedInteger $ amt * scientific 1 8
case zats' of
Nothing -> do
logErrorN "Failed to parse amount into zats"
return $ Left ZHError
Just zats -> do
logDebugN $ "amt: " <> T.pack (show amt) logDebugN $ "amt: " <> T.pack (show amt)
logDebugN $ "zats: " <> T.pack (show zats) logDebugN $ "zats: " <> T.pack (show zats)
{-firstPass <- liftIO $ selectUnspentNotes pool za zats-} {-firstPass <- liftIO $ selectUnspentNotes pool za zats-}
@ -929,15 +964,19 @@ prepareTxV2 pool zebraHost zebraPort zn za bh pnotes policy = do
--print oSpends --print oSpends
dummy' <- dummy' <-
liftIO $ liftIO $
makeOutgoing acc recipients (noteTotal - 5000 - zats) policy makeOutgoing
acc
recipients
(noteTotal - 5000 - fromIntegral zats)
policy
case dummy' of case dummy' of
Left e -> return $ Left e Left e -> return $ Left e
Right dummy -> do Right dummy -> do
logDebugN "Calculating fee" logDebugN "Calculating fee"
let feeResponse = let feeResponse =
createTransaction createTransaction
(Just sT) Nothing
(Just oT) Nothing
tSpends tSpends
sSpends sSpends
oSpends oSpends
@ -956,7 +995,7 @@ prepareTxV2 pool zebraHost zebraPort zn za bh pnotes policy = do
selectUnspentNotesV2 selectUnspentNotesV2
pool pool
za za
(zats + feeAmt) (fromIntegral zats + feeAmt)
(map (\(x, _, _, _) -> x) recipients) (map (\(x, _, _, _) -> x) recipients)
policy policy
case finalNotePlan of case finalNotePlan of
@ -969,25 +1008,29 @@ prepareTxV2 pool zebraHost zebraPort zn za bh pnotes policy = do
tSpends1 <- tSpends1 <-
liftIO $ liftIO $
prepTSpends prepTSpends
(getTranSK $ zcashAccountTPrivateKey $ entityVal acc) (getTranSK $
zcashAccountTPrivateKey $ entityVal acc)
tList1 tList1
sSpends1 <- sSpends1 <-
liftIO $ liftIO $
prepSSpends prepSSpends
(getSapSK $ zcashAccountSapSpendKey $ entityVal acc) (getSapSK $
zcashAccountSapSpendKey $ entityVal acc)
sList1 sList1
oSpends1 <- oSpends1 <-
liftIO $ liftIO $
prepOSpends prepOSpends
(getOrchSK $ zcashAccountOrchSpendKey $ entityVal acc) (getOrchSK $
zcashAccountOrchSpendKey $ entityVal acc)
oList1 oList1
let noteTotal1 = getTotalAmount (tList1, sList1, oList1) let noteTotal1 =
getTotalAmount (tList1, sList1, oList1)
outgoing' <- outgoing' <-
liftIO $ liftIO $
makeOutgoing makeOutgoing
acc acc
recipients recipients
(noteTotal1 - feeAmt - zats) (noteTotal1 - feeAmt - fromIntegral zats)
policy policy
logDebugN $ T.pack $ show outgoing' logDebugN $ T.pack $ show outgoing'
case outgoing' of case outgoing' of
@ -995,8 +1038,8 @@ prepareTxV2 pool zebraHost zebraPort zn za bh pnotes policy = do
Right outgoing -> do Right outgoing -> do
let tx = let tx =
createTransaction createTransaction
(Just sT) Nothing
(Just oT) Nothing
tSpends1 tSpends1
sSpends1 sSpends1
oSpends1 oSpends1
@ -1011,10 +1054,13 @@ prepareTxV2 pool zebraHost zebraPort zn za bh pnotes policy = do
logErrorN $ T.pack $ show e logErrorN $ T.pack $ show e
return $ Left e return $ Left e
where where
extractReceiver :: ProposedNote -> (Int, BS.ByteString, Int, T.Text) extractReceiver :: ProposedNote -> (Int, BS.ByteString, Int64, T.Text)
extractReceiver (ProposedNote (ValidAddressAPI va) amt m) = extractReceiver (ProposedNote (ValidAddressAPI va) amt m) =
let zats = fromIntegral $ floorFloatInteger $ amt * (10 ^ 8) let zats' = toBoundedInteger $ amt * scientific 1 8
in case va of in case zats' of
Nothing -> (0, "", 0, "")
Just zats ->
case va of
Unified ua -> Unified ua ->
case o_rec ua of case o_rec ua of
Nothing -> Nothing ->
@ -1025,26 +1071,45 @@ prepareTxV2 pool zebraHost zebraPort zn za bh pnotes policy = do
Just r3 -> Just r3 ->
case tr_type r3 of case tr_type r3 of
P2PKH -> P2PKH ->
(1, toBytes $ tr_bytes r3, zats, fromMaybe "" m) ( 1
, toBytes $ tr_bytes r3
, zats
, fromMaybe "" m)
P2SH -> P2SH ->
(2, toBytes $ tr_bytes r3, zats, fromMaybe "" m) ( 2
, toBytes $ tr_bytes r3
, zats
, fromMaybe "" m)
Just r2 -> (3, getBytes r2, zats, fromMaybe "" m) Just r2 -> (3, getBytes r2, zats, fromMaybe "" m)
Just r1 -> (4, getBytes r1, zats, fromMaybe "" m) Just r1 -> (4, getBytes r1, zats, fromMaybe "" m)
Sapling sa -> (3, getBytes $ sa_receiver sa, zats, fromMaybe "" m) Sapling sa ->
(3, getBytes $ sa_receiver sa, zats, fromMaybe "" m)
Transparent ta -> Transparent ta ->
case tr_type (ta_receiver ta) of case tr_type (ta_receiver ta) of
P2PKH -> P2PKH ->
(1, toBytes $ tr_bytes (ta_receiver ta), zats, fromMaybe "" m) ( 1
, toBytes $ tr_bytes (ta_receiver ta)
, zats
, fromMaybe "" m)
P2SH -> P2SH ->
(2, toBytes $ tr_bytes (ta_receiver ta), zats, fromMaybe "" m) ( 2
, toBytes $ tr_bytes (ta_receiver ta)
, zats
, fromMaybe "" m)
Exchange ea -> Exchange ea ->
case tr_type (ex_address ea) of case tr_type (ex_address ea) of
P2PKH -> P2PKH ->
(5, toBytes $ tr_bytes (ex_address ea), zats, fromMaybe "" m) ( 5
, toBytes $ tr_bytes (ex_address ea)
, zats
, fromMaybe "" m)
P2SH -> P2SH ->
(6, toBytes $ tr_bytes (ex_address ea), zats, fromMaybe "" m) ( 6
, toBytes $ tr_bytes (ex_address ea)
, zats
, fromMaybe "" m)
prepareOutgoingNote :: prepareOutgoingNote ::
ZcashAccount -> (Int, BS.ByteString, Int, T.Text) -> OutgoingNote ZcashAccount -> (Int, BS.ByteString, Int64, T.Text) -> OutgoingNote
prepareOutgoingNote zac (k, r, a, m) = prepareOutgoingNote zac (k, r, a, m) =
OutgoingNote OutgoingNote
(if k == 5 (if k == 5
@ -1062,8 +1127,8 @@ prepareTxV2 pool zebraHost zebraPort zn za bh pnotes policy = do
False False
makeOutgoing :: makeOutgoing ::
Entity ZcashAccount Entity ZcashAccount
-> [(Int, BS.ByteString, Int, T.Text)] -> [(Int, BS.ByteString, Int64, T.Text)]
-> Integer -> Int64
-> PrivacyPolicy -> PrivacyPolicy
-> IO (Either TxError [OutgoingNote]) -> IO (Either TxError [OutgoingNote])
makeOutgoing acc recvs chg pol = do makeOutgoing acc recvs chg pol = do
@ -1195,7 +1260,7 @@ prepareTxV2 pool zebraHost zebraPort zn za bh pnotes policy = do
( [Entity WalletTrNote] ( [Entity WalletTrNote]
, [Entity WalletSapNote] , [Entity WalletSapNote]
, [Entity WalletOrchNote]) , [Entity WalletOrchNote])
-> Integer -> Int64
getTotalAmount (t, s, o) = getTotalAmount (t, s, o) =
sum (map (fromIntegral . walletTrNoteValue . entityVal) t) + sum (map (fromIntegral . walletTrNoteValue . entityVal) t) +
sum (map (fromIntegral . walletSapNoteValue . entityVal) s) + sum (map (fromIntegral . walletSapNoteValue . entityVal) s) +
@ -1300,13 +1365,15 @@ syncWallet config w = do
let startBlock = let startBlock =
if lastBlock > 0 if lastBlock > 0
then lastBlock then lastBlock
else zcashWalletBirthdayHeight $ entityVal w else 1 + zcashWalletBirthdayHeight (entityVal w)
logDebugN $ "start block: " <> T.pack (show startBlock) 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
logDebugN "processed transparent notes" logDebugN "processed transparent notes"
mapM_ (liftIO . findTransparentSpends pool . entityKey) accs mapM_ (liftIO . findTransparentSpends pool . entityKey) accs
logDebugN "processed transparent spends" logDebugN "processed transparent spends"
liftIO $
runNoLoggingT $
mapM_ mapM_
(findSaplingOutputs config startBlock (zcashWalletNetwork $ entityVal w)) (findSaplingOutputs config startBlock (zcashWalletNetwork $ entityVal w))
accs accs

34
src/Zenith/DB.hs
View file

@ -698,6 +698,7 @@ saveAddress pool w =
runNoLoggingT $ runNoLoggingT $
PS.retryOnBusy $ flip PS.runSqlPool pool $ insertUniqueEntity w PS.retryOnBusy $ flip PS.runSqlPool pool $ insertUniqueEntity w
-- * Block
-- | Save a block to the database -- | Save a block to the database
saveBlock :: ConnectionPool -> ZcashBlock -> IO (Key ZcashBlock) saveBlock :: ConnectionPool -> ZcashBlock -> IO (Key ZcashBlock)
saveBlock pool b = saveBlock pool b =
@ -714,6 +715,20 @@ getBlock pool b =
where_ $ bl ^. ZcashBlockHeight ==. val b where_ $ bl ^. ZcashBlockHeight ==. val b
pure bl pure bl
getBlockHash :: ConnectionPool -> Int -> IO (Maybe HexString)
getBlockHash pool b = do
r <-
runNoLoggingT $
PS.retryOnBusy $
flip PS.runSqlPool pool $ do
selectOne $ do
bl <- from $ table @ZcashBlock
where_ $ bl ^. ZcashBlockHeight ==. val b
pure $ bl ^. ZcashBlockHash
case r of
Nothing -> return Nothing
Just (Value h) -> return $ Just $ getHex h
-- | Save a transaction to the data model -- | Save a transaction to the data model
saveTransaction :: saveTransaction ::
ConnectionPool -- ^ the database path ConnectionPool -- ^ the database path
@ -1776,12 +1791,16 @@ getUnspentSapNotes pool = do
where_ (n ^. WalletSapNoteSpent ==. val False) where_ (n ^. WalletSapNoteSpent ==. val False)
pure n pure n
getSaplingCmus :: Pool SqlBackend -> ShieldOutputId -> IO [Value HexStringDB] getSaplingCmus ::
getSaplingCmus pool zt = do ConnectionPool
-> ShieldOutputId
-> ShieldOutputId
-> IO [Value HexStringDB]
getSaplingCmus pool zt m = do
PS.runSqlPool PS.runSqlPool
(select $ do (select $ do
n <- from $ table @ShieldOutput n <- from $ table @ShieldOutput
where_ (n ^. ShieldOutputId >. val zt) where_ (n ^. ShieldOutputId >. val zt &&. n ^. ShieldOutputId <=. val m)
orderBy [asc $ n ^. ShieldOutputId] orderBy [asc $ n ^. ShieldOutputId]
pure $ n ^. ShieldOutputCmu) pure $ n ^. ShieldOutputCmu)
pool pool
@ -1840,12 +1859,13 @@ getUnspentOrchNotes pool = do
where_ (n ^. WalletOrchNoteSpent ==. val False) where_ (n ^. WalletOrchNoteSpent ==. val False)
pure n pure n
getOrchardCmxs :: Pool SqlBackend -> OrchActionId -> IO [Value HexStringDB] getOrchardCmxs ::
getOrchardCmxs pool zt = do ConnectionPool -> OrchActionId -> OrchActionId -> IO [Value HexStringDB]
getOrchardCmxs pool zt m = do
PS.runSqlPool PS.runSqlPool
(select $ do (select $ do
n <- from $ table @OrchAction n <- from $ table @OrchAction
where_ (n ^. OrchActionId >. val zt) where_ (n ^. OrchActionId >. val zt &&. n ^. OrchActionId <=. val m)
orderBy [asc $ n ^. OrchActionId] orderBy [asc $ n ^. OrchActionId]
pure $ n ^. OrchActionCmx) pure $ n ^. OrchActionCmx)
pool pool
@ -2339,7 +2359,7 @@ selectUnspentNotes pool za amt = do
selectUnspentNotesV2 :: selectUnspentNotesV2 ::
ConnectionPool ConnectionPool
-> ZcashAccountId -> ZcashAccountId
-> Integer -> Int64
-> [Int] -> [Int]
-> PrivacyPolicy -> PrivacyPolicy
-> IO -> IO

11
src/Zenith/GUI.hs
View file

@ -17,6 +17,7 @@ import Data.Aeson
import qualified Data.ByteString as BS import qualified Data.ByteString as BS
import Data.HexString (toText) import Data.HexString (toText)
import Data.Maybe (fromMaybe, isJust, isNothing) import Data.Maybe (fromMaybe, isJust, isNothing)
import Data.Scientific (Scientific, fromFloatDigits)
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)
@ -1244,7 +1245,7 @@ handleEvent wenv node model evt =
(model ^. network) (model ^. network)
(entityKey acc) (entityKey acc)
(zcashWalletLastSync $ entityVal wal) (zcashWalletLastSync $ entityVal wal)
(model ^. sendAmount) (fromFloatDigits $ model ^. sendAmount)
(model ^. sendRecipient) (model ^. sendRecipient)
(model ^. sendMemo) (model ^. sendMemo)
(model ^. privacyChoice) (model ^. privacyChoice)
@ -1631,12 +1632,12 @@ scanZebra dbPath zHost zPort net sendMsg = do
if syncChk if syncChk
then sendMsg (ShowError "Sync already in progress") then sendMsg (ShowError "Sync already in progress")
else do else do
unless (chkBlock == dbBlock) $
runStderrLoggingT $ rewindWalletData pool chkBlock
let sb = let sb =
if chkBlock == dbBlock if chkBlock == dbBlock
then max dbBlock b then max dbBlock b
else max chkBlock b else max chkBlock b
unless (chkBlock == dbBlock || chkBlock == 1) $
runStderrLoggingT $ rewindWalletData pool sb
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
@ -1701,7 +1702,7 @@ sendTransaction ::
-> ZcashNet -> ZcashNet
-> ZcashAccountId -> ZcashAccountId
-> Int -> Int
-> Float -> Scientific
-> T.Text -> T.Text
-> T.Text -> T.Text
-> PrivacyPolicy -> PrivacyPolicy
@ -1717,7 +1718,7 @@ sendTransaction config znet accId bl amt ua memo policy sendMsg = do
let zPort = c_zebraPort config let zPort = c_zebraPort config
pool <- runNoLoggingT $ initPool dbPath pool <- runNoLoggingT $ initPool dbPath
res <- res <-
runNoLoggingT $ runStderrLoggingT $
prepareTxV2 prepareTxV2
pool pool
zHost zHost

6
src/Zenith/RPC.hs
View file

@ -833,7 +833,7 @@ zenithServer state = getinfo :<|> handleRPC
forkIO $ do forkIO $ do
res <- res <-
liftIO $ liftIO $
runNoLoggingT $ runStderrLoggingT $
prepareTxV2 prepareTxV2
pool pool
zHost zHost
@ -892,12 +892,12 @@ scanZebra dbPath zHost zPort net = do
chkBlock <- checkIntegrity dbPath zHost zPort dbBlock 1 chkBlock <- checkIntegrity dbPath zHost zPort dbBlock 1
syncChk <- isSyncing pool syncChk <- isSyncing pool
unless syncChk $ do unless syncChk $ do
unless (chkBlock == dbBlock) $
runStderrLoggingT $ rewindWalletData pool chkBlock
let sb = let sb =
if chkBlock == dbBlock if chkBlock == dbBlock
then max dbBlock b then max dbBlock b
else max chkBlock b else max chkBlock b
unless (chkBlock == dbBlock || chkBlock == 1) $
runStderrLoggingT $ rewindWalletData pool sb
unless (sb > zgb_blocks bStatus || sb < 1) $ do unless (sb > zgb_blocks bStatus || sb < 1) $ do
let bList = [(sb + 1) .. (zgb_blocks bStatus)] let bList = [(sb + 1) .. (zgb_blocks bStatus)]
unless (null bList) $ do unless (null bList) $ do

3
src/Zenith/Types.hs
View file

@ -17,6 +17,7 @@ import qualified Data.ByteString.Char8 as C
import Data.HexString import Data.HexString
import Data.Int (Int64) import Data.Int (Int64)
import Data.Maybe (fromMaybe) import Data.Maybe (fromMaybe)
import Data.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.Text.Encoding.Error (lenientDecode) import Data.Text.Encoding.Error (lenientDecode)
@ -241,7 +242,7 @@ instance ToJSON ValidAddressAPI where
data ProposedNote = ProposedNote data ProposedNote = ProposedNote
{ pn_addr :: !ValidAddressAPI { pn_addr :: !ValidAddressAPI
, pn_amt :: !Float , pn_amt :: !Scientific
, pn_memo :: !(Maybe T.Text) , pn_memo :: !(Maybe T.Text)
} deriving (Eq, Prelude.Show) } deriving (Eq, Prelude.Show)

34
src/Zenith/Utils.hs
View file

@ -13,26 +13,31 @@ import qualified Data.Text.Encoding as E
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
, parseAddress
)
import ZcashHaskell.Sapling (decodeSaplingAddress, isValidShieldedAddress) import ZcashHaskell.Sapling (decodeSaplingAddress, isValidShieldedAddress)
import ZcashHaskell.Transparent import ZcashHaskell.Transparent
( decodeExchangeAddress ( decodeExchangeAddress
, decodeTransparentAddress , decodeTransparentAddress
) )
import ZcashHaskell.Types import ZcashHaskell.Types
( SaplingAddress(..) ( ExchangeAddress(..)
, SaplingAddress(..)
, TransparentAddress(..) , TransparentAddress(..)
, UnifiedAddress(..) , UnifiedAddress(..)
, ZcashNet(..)
, ValidAddress(..) , ValidAddress(..)
, ExchangeAddress(..) , ZcashNet(..)
) )
import ZcashHaskell.Utils (makeZebraCall)
import Zenith.Types import Zenith.Types
( AddressGroup(..) ( AddressGroup(..)
, PrivacyPolicy(..)
, UnifiedAddressDB(..) , UnifiedAddressDB(..)
, ZcashAddress(..) , ZcashAddress(..)
, ZcashPool(..) , ZcashPool(..)
, PrivacyPolicy(..)
) )
-- | Helper function to convert numbers into JSON -- | Helper function to convert numbers into JSON
@ -150,21 +155,24 @@ isRecipientValidGUI :: PrivacyPolicy -> T.Text -> Bool
isRecipientValidGUI p a = do isRecipientValidGUI p a = do
let adr = parseAddress (E.encodeUtf8 a) let adr = parseAddress (E.encodeUtf8 a)
case p of case p of
Full -> case adr of Full ->
case adr of
Just a -> Just a ->
case a of case a of
Unified ua -> True Unified ua -> True
Sapling sa -> True Sapling sa -> True
_ -> False _ -> False
Nothing -> False Nothing -> False
Medium -> case adr of Medium ->
case adr of
Just a -> Just a ->
case a of case a of
Unified ua -> True Unified ua -> True
Sapling sa -> True Sapling sa -> True
_ -> False _ -> False
Nothing -> False Nothing -> False
Low -> case adr of Low ->
case adr of
Just a -> Just a ->
case a of case a of
Unified ua -> True Unified ua -> True
@ -172,7 +180,8 @@ isRecipientValidGUI p a = do
Transparent ta -> True Transparent ta -> True
_ -> False _ -> False
Nothing -> False Nothing -> False
None -> case adr of None ->
case adr of
Just a -> Just a ->
case a of case a of
Transparent ta -> True Transparent ta -> True
@ -232,3 +241,10 @@ padWithZero n s
isEmpty :: [a] -> Bool isEmpty :: [a] -> Bool
isEmpty [] = True isEmpty [] = True
isEmpty _ = False isEmpty _ = False
getChainTip :: T.Text -> Int -> IO Int
getChainTip zHost zPort = do
r <- makeZebraCall zHost zPort "getblockcount" []
case r of
Left e1 -> pure 0
Right i -> pure i

23
test/Spec.hs
View file

@ -2,6 +2,7 @@
import Control.Monad (when) import Control.Monad (when)
import Control.Monad.Logger (runFileLoggingT, runNoLoggingT) import Control.Monad.Logger (runFileLoggingT, runNoLoggingT)
import Data.Aeson
import Data.HexString import Data.HexString
import Data.Maybe (fromJust) import Data.Maybe (fromJust)
import qualified Data.Text.Encoding as E import qualified Data.Text.Encoding as E
@ -33,8 +34,10 @@ import ZcashHaskell.Types
, Scope(..) , Scope(..)
, ShieldedOutput(..) , ShieldedOutput(..)
, TxError(..) , TxError(..)
, ValidAddress(..)
, ZcashNet(..) , ZcashNet(..)
) )
import ZcashHaskell.Utils (makeZebraCall, readZebraTransaction)
import Zenith.Core import Zenith.Core
import Zenith.DB import Zenith.DB
import Zenith.Types import Zenith.Types
@ -182,6 +185,12 @@ main = do
a `shouldBe` a `shouldBe`
Just Just
"ztestsapling1tgjr4zppwk4ne8xy6gdq4z2gwq7dmf5jq8z2ctpn8nlmtse0a74fa5z0m8z383gmpgqz6q6duu4" "ztestsapling1tgjr4zppwk4ne8xy6gdq4z2gwq7dmf5jq8z2ctpn8nlmtse0a74fa5z0m8z383gmpgqz6q6duu4"
describe "Witnesses" $ do
describe "Sapling" $ do
it "max output id" $ do
pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
sId <- getMaxSaplingNote pool
sId `shouldBe` toSqlKey 0
describe "Notes" $ do describe "Notes" $ do
xit "Check Orchard notes" $ do xit "Check Orchard notes" $ do
pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db" pool <- runNoLoggingT $ initPool "/home/rav/Zenith/zenith.db"
@ -573,3 +582,17 @@ main = do
case tx of case tx of
Left e -> assertFailure $ show e Left e -> assertFailure $ show e
Right h -> h `shouldNotBe` (hexString "deadbeef") Right h -> h `shouldNotBe` (hexString "deadbeef")
describe "Quick tests" $ do
it "validate comm trees" $ do
blockTree <- getCommitmentTrees "localhost" 18232 3034848
hashTree <-
makeZebraCall
"localhost"
18232
"z_gettreestate"
[ Data.Aeson.String
"000f8a912c6c5caf476e70fa0616c17ab4e7e8c1f42e24bddeacda275d545473"
]
case hashTree of
Left e -> assertFailure e
Right hT -> blockTree `shouldBe` hT